/[projects]/dao/DelphiScanner/Components/tpsystools_4.04/examples/Delphi/exmmfcu.pas
ViewVC logotype

Contents of /dao/DelphiScanner/Components/tpsystools_4.04/examples/Delphi/exmmfcu.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2671 - (show annotations) (download)
Tue Aug 25 18:15:15 2015 UTC (8 years, 9 months ago) by torben
File size: 2591 byte(s)
Added tpsystools component
1 (* ***** BEGIN LICENSE BLOCK *****
2 * Version: MPL 1.1
3 *
4 * The contents of this file are subject to the Mozilla Public License Version
5 * 1.1 (the "License"); you may not use this file except in compliance with
6 * the License. You may obtain a copy of the License at
7 * http://www.mozilla.org/MPL/
8 *
9 * Software distributed under the License is distributed on an "AS IS" basis,
10 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
11 * for the specific language governing rights and limitations under the
12 * License.
13 *
14 * The Original Code is TurboPower SysTools
15 *
16 * The Initial Developer of the Original Code is
17 * TurboPower Software
18 *
19 * Portions created by the Initial Developer are Copyright (C) 1996-2002
20 * the Initial Developer. All Rights Reserved.
21 *
22 * Contributor(s):
23 *
24 * ***** END LICENSE BLOCK ***** *)
25
26 unit exmmfcu;
27
28 interface
29
30 uses
31 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
32 StdCtrls, ExtCtrls,
33
34 StStrms;
35
36 type
37 TfrmMain = class(TForm)
38 Edit1: TEdit;
39 btnOpenMMF: TButton;
40 btnCloseMMF: TButton;
41 Timer1: TTimer;
42 Label1: TLabel;
43 procedure btnOpenMMFClick(Sender: TObject);
44 procedure btnCloseMMFClick(Sender: TObject);
45 procedure Timer1Timer(Sender: TObject);
46 procedure FormClose(Sender: TObject; var Action: TCloseAction);
47 private
48 { Private declarations }
49 public
50 { Public declarations }
51
52 AMMFile : TStMemoryMappedFile;
53 Buf : array[0..100] of char;
54 end;
55
56 var
57 frmMain: TfrmMain;
58
59 implementation
60
61 {$R *.DFM}
62
63
64 procedure TfrmMain.btnOpenMMFClick(Sender: TObject);
65 begin
66 AMMFile := TStMemoryMappedFile.Create('', 100, False, True);
67 if (Assigned(AMMFile)) then begin
68 btnOpenMMF.Enabled := False;
69 btnCloseMMF.Enabled := True;
70 Timer1.Enabled := True;
71 Label1.Caption := 'Waiting: ';
72 end else
73 ShowMessage('Unable to open file');
74 end;
75
76 procedure TfrmMain.btnCloseMMFClick(Sender: TObject);
77 begin
78 AMMFile.Free;
79 AMMFile := nil;
80 btnOpenMMF.Enabled := True;
81 btnCloseMMF.Enabled := False;
82 Timer1.Enabled := False;
83 end;
84
85 procedure TfrmMain.Timer1Timer(Sender: TObject);
86 begin
87 Label1.Caption := 'Seeking: ' + IntToStr(AMMFile.DataSize);
88 Timer1.Enabled := False;
89 AMMFile.Seek(0, soFromBeginning);
90 AMMFile.Read(Buf, AMMFile.DataSize);
91 Edit1.Text := StrPas(Buf);
92 Timer1.Enabled := True;
93 end;
94
95 procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
96 begin
97 AMMFile.Free;
98 AMMFile := nil;
99 end;
100
101 end.

  ViewVC Help
Powered by ViewVC 1.1.20