两个EXE文件共享内存数据块

发送数据端程序

代码文件：

1. unit Unit1;
3. interface
5. uses
6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7.   StdCtrls;
9. const
10.   WM_DATA = WM_USER + 1024;
11. type
12.   PShareMem = ^TShareMem;
13.   TShareMem = record
14.     Data: array[0..255] of char;
15.   end;
16.   TForm1 = class(TForm)
17.     Button1: TButton;
18.     procedure Button1Click(Sender: TObject);
19.     procedure FormDestroy(Sender: TObject);
20.     procedure FormCreate(Sender: TObject);
21.   private
22.     { Private declarations }
23.   public
24.     { Public declarations }
26.   end;
28. var
29.   Form1: TForm1;
30.   PShare: PShareMem;
31. implementation
33. {$R *.DFM}
34. var
35.   HMapping: THandle;
36.   HMapMutex: THandle;
37. const
38.   MAPFILESIZE = 1000;
39.   REQUEST_TIMEOUT = 1000;
41. procedure OpenMap;
42. begin
43.    {创建一个文件映射内核对象}
44.   HMapping := CreateFileMapping(
45.     $FFFFFFFF,
46.     nil,
47.     PAGE_READWRITE,
48.     0,
49.     SizeOf(TShareMem),
50.                  {这个文件映射对象的名字用于与其他进程共享该对象,}
51.    pchar('Map Name')
52.     );
53.   if (hMapping = 0) then
54.   begin
55.     ShowMessage('不能创建内存映射文件');
56.     Application.Terminate;
57.     exit;
58.   end;
59.    {将文件数据映射到进程的地址空间}
60.    {当创建了一个文件映射对象之后,仍然必须让系统为文件的数据保留
61.     一个地址空间区域,并将文件的数据作为映射到该区域的物理存储器进行提交。
62.     }
63.   PShare := PShareMem(MapViewOfFile(HMapping, FILE_MAP_ALL_ACCESS, 0, 0, 0));
64.   if PShare = nil then
65.   begin
66.     CloseHandle(HMapping);
67.     ShowMessage('Can''t View Memory Map');
68.     Application.Terminate;
69.     exit;
70.   end;
72.   {既然我们通过pvFile得到了映象视图的起始地址,那么可以对视图做一些操作了}
73. end;
75. procedure CloseMap;
76. begin
77.   if PShare <> nil then
78.     {从进程的地址空间中撤销文件数据的映象}
79.     UnMapViewOfFile(PShare);
80.   if HMapping <> 0 then
81.     CloseHandle(HMapping);
82. end;
84. function LockMap: Boolean;
85. begin
86.   Result := true;
87.    {创建互斥对象}
88.   HMapMutex := CreateMutex(nil, false,
89.     pchar('MY MUTEX NAME GOES HERE'));
90.   if HMapMutex = 0 then
91.   begin
92.     ShowMessage('不能创建互斥对象');
93.     Result := false;
94.   end else begin
95.     if WaitForSingleObject(HMapMutex, REQUEST_TIMEOUT)
96.       = WAIT_FAILED then
97.     begin
98.       ShowMessage('不能对互斥对象加锁!');
99.       Result := false;
100.     end
101.   end
102. end;
104. procedure UnlockMap;
105. begin
106.    {关闭文件映射对象和文件对象}
107.   ReleaseMutex(HMapMutex);
108.   CloseHandle(HMapMutex);
109. end;
111. procedure TForm1.Button1Click(Sender: TObject);
112. var
113.   str: pchar;
114. begin
115.   str := pchar('简单的共享内存的例子');
116.   CopyMemory(@(pShare^.data), Str, Length(str));
117.   {发送消息表明有数据}
118.   PostMessage(FindWindow(nil, 'MyForm'), WM_DATA, 1, 1)
119. end;
121. procedure TForm1.FormDestroy(Sender: TObject);
122. begin
123.   UnlockMap;
124.   CloseMap;
125. end;
127. procedure TForm1.FormCreate(Sender: TObject);
128. begin
129.   OpenMap;
130.   LockMap;
131. end;
133. end.

窗体文件：

1. object Form1: TForm1
2.   Left = 189
3.   Top = 107
4.   Caption = #20869#23384#26144#23556#25991#20214#20363#23376
5.   ClientHeight = 86
6.   ClientWidth = 200
7.   Color = clBtnFace
8.   Font.Charset = GB2312_CHARSET
9.   Font.Color = clWindowText
10.   Font.Height = -13
11.   Font.Name = #23435#20307
12.   Font.Style = []
13.   OldCreateOrder = False
14.   OnCreate = FormCreate
15.   OnDestroy = FormDestroy
16.   PixelsPerInch = 96
17.   TextHeight = 13
18.   object Button1: TButton
19.     Left = 56
20.     Top = 24
21.     Width = 75
22.     Height = 25
23.     Caption = #21457#36865#25968#25454
24.     TabOrder = 0
25.     OnClick = Button1Click
26.   end
27. end

接受数据端程序

代码：

1. unit Unit2;
3. interface
5. uses
6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7.   StdCtrls;
9. const
10.   WM_DATA = WM_USER + 1024;
11. type
12.   PShareMem = ^TShareMem;
13.   TShareMem = record
14.     Data: array[0..255] of char;
15.   end;
16.   TMyForm = class(TForm)
17.     Memo1: TMemo;
18.     Button1: TButton;
19.     procedure FormCreate(Sender: TObject);
20.     procedure Button1Click(Sender: TObject);
21.   private
22.     { Private declarations }
23.   public
24.     { Public declarations }
25.     procedure getShareInfo(var Msg: TMessage); message WM_DATA; {处理WM_DATA}
26.   end;
28. var
29.   MyForm: TMyForm;
30.   PShare: PShareMem;
31.   MapHandle: THandle;
33. implementation
35. {$R *.DFM}
37. procedure TMyForm.getShareInfo(var Msg: TMessage); {处理WM_DATA}
38. begin
39.   if msg.LParam=1 then {是我们设定的消息参数}
40.     Memo1.Text := PShare^.Data;
41. end;
43. procedure TMyForm.FormCreate(Sender: TObject);
44. begin
45.   MapHandle := OpenFileMapping(FILE_MAP_WRITE, {获取完全访问映射文件}
46.     False, {不可继承的}
47.     pchar('Map Name')); {映射文件名字}
48.   if MapHandle = 0 then
49.   begin
50.     ShowMessage('不能定位内存映射文件块!');
51.     Halt;
52.   end;
53.   PShare := PShareMem(MapViewOfFile(MapHandle, FILE_MAP_ALL_ACCESS, 0, 0, 0));
54.   if PShare = nil then
55.   begin
56.     CloseHandle(MapHandle);
57.     ShowMessage('Can''t View Memory Map');
58.     Application.Terminate;
59.     exit;
60.   end;
61.   FillChar(PShare^, SizeOf(TShareMem), 0);
62. end;
64. procedure TMyForm.Button1Click(Sender: TObject);
65. begin
66.   CloseHandle(MapHandle);
67.   close;
68. end;
70. end.

窗体文件：

1. object MyForm: TMyForm
2.   Left = 192
3.   Top = 107
4.   Caption = 'MyForm'
5.   ClientHeight = 108
6.   ClientWidth = 293
7.   Color = clBtnFace
8.   Font.Charset = GB2312_CHARSET
9.   Font.Color = clWindowText
10.   Font.Height = -13
11.   Font.Name = #23435#20307
12.   Font.Style = []
13.   OldCreateOrder = False
14.   OnCreate = FormCreate
15.   PixelsPerInch = 96
16.   TextHeight = 13
17.   object Memo1: TMemo
18.     Left = 8
19.     Top = 8
20.     Width = 185
21.     Height = 89
22.     Lines.Strings = (
23.       'Memo1')
24.     TabOrder = 0
25.   end
26.   object Button1: TButton
27.     Left = 200
28.     Top = 24
29.     Width = 75
30.     Height = 25
31.     Caption = #20851#38381
32.     TabOrder = 1
33.     OnClick = Button1Click
34.   end
35. end