delphi 实现两个exe文件共享内存映像的代码

创建内存映像的程序

--------------------------------------------------------------------------------------------

unit Unit1;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

const

WM_DATA=WM_USER+1025;

type

PShareMem=^TShareMem;

TShareMem=record

Data:array[0..255] of char;

end;

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

pshare: PShareMem;

implementation

{$R *.dfm}

var

hmapping:THandle;

hmapmutex:THandle;

const

mapfilesize=1000;

request_timeout=1000;

procedure openMap;

begin

hmapping :=createFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TShareMem),

pchar('map pei'));

if hmapping=0 then

begin

showMessage('创建内存映像文件失败');

Application.Terminate;

end;

//将影像文件映射到进程的地址空间

pshare := PShareMem(mapviewoffile(hmapping,FILE_MAP_ALL_ACCESS,0,0,0));

if pshare=nil then

begin

closehandle(hmapping);

showmessage('显示内存映像文件失败');

application.Terminate;

exit;

end;

end;

procedure closeMap; //关闭共享内存映像

begin

if pshare<>nil then

unmapviewoffile(pshare); // 从进程地址空间中释放映像文件

if hmapping<>0 then

closehandle(hmapping);

end;

function LockMap:boolean;

begin

result:=true;

hmapmutex:=createMutex(nil,false,pchar('mutex peidw'));

if hmapmutex=0 then

begin

showmessage('创建互斥对象失败');

result:=false;

end

else

begin

if waitforsingleObject(hmapmutex,request_timeout)=WAIT_FAILED then

begin

showmessage('对互斥对象加锁失败');

result:=false;

end;

end; //if end

end;

procedure unLockMap;//释放互斥对象

begin

releaseMutex(hmapmutex);

closeHandle(hmapmutex);

end;

procedure TForm1.Button1Click(Sender: TObject);

var

str:pchar;

begin

str:=pchar('简单的内存共享例子');

copyMemory(@(pshare^.Data),str,length(str));

postMessage(findWindow(nil,'MyForm'),WM_DATA,1,1);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

openMap;

LockMap;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

unLockMap;

closeMap;

end;

end.

读取内存映像程序

-----------------------------------------------------------------------------

unit Unit2;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

const

WM_DATA=WM_USER+1025;

type

PShareMem=^TShareMem;

TShareMem=record

Data:array[0..255] of char;

end;

TForm2 = class(TForm)

Memo1: TMemo;

Button1: TButton;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

procedure getShareInfo(var msg:TMessage); message WM_DATA;

end;

var

Form2: TForm2;

pshare: PShareMem;

hmapping:THandle;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);

begin

closehandle(hmapping);

close;

end;

procedure TForm2.FormCreate(Sender: TObject);

begin

hmapping :=openFileMapping(File_MAP_WRITE,false,pchar('map pei'));

if hmapping=0 then

begin

showMessage('定位内存映像文件块失败');

halt; //异常终止

end;

//将影像文件映射到进程的地址空间

pshare := PShareMem(mapviewoffile(hmapping,FILE_MAP_ALL_ACCESS,0,0,0));

if pshare=nil then

begin

closehandle(hmapping);

showmessage('将映像映射到进程地址空间失败');

application.Terminate;

exit;

end;

fillchar(pshare^,sizeof(TShareMem),0);//初始化地址空间

end;

procedure TForm2.getShareInfo(var msg: TMessage);

begin

if msg.LParam=1 then

memo1.text:=pshare^.Data;

end;

end.