两个exe共享内存数据

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs,
  StdCtrls;
const
  WM_DATA=WM_USER+;

type
  PShareMem=^TShareMem;
  TShareMem=record
    Data:array[..] of char;
  end;
  TForm1 = class(TForm)
    Button1: TButton;
    edt1: TEdit;
    //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=;
  request_timeout=;

procedure openMap;
begin
  hmapping :=createFileMapping($FFFFFFFF,nil,PAGE_READWRITE,,SizeOf(TShareMem),
  pchar('map pei'));
  if hmapping= then
  begin
    showMessage('创建内存映像文件失败');
    Application.Terminate;
  end;
  //将影像文件映射到进程的地址空间
  pshare := PShareMem(mapviewoffile(hmapping,FILE_MAP_ALL_ACCESS,,,));
  if pshare=nil then
  begin
    closehandle(hmapping);
    showmessage('显示内存映像文件失败');
    application.Terminate;
    exit;
  end;
end;

procedure closeMap;    //关闭共享内存映像
begin
  if pshare<>nil then
    unmapviewoffile(pshare);      // 从进程地址空间中释放映像文件
  if hmapping<> then
     closehandle(hmapping);

end;

function LockMap:boolean;
begin
  result:=true;
  hmapmutex:=createMutex(nil,false,pchar('mutex peidw'));
  if hmapmutex= 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('简单的内存共享例子');
  str:= PChar(edt1.Text);
  copyMemory(@(pshare^.Data),str,length(str));
  postMessage(findWindow(nil,'Form2'),WM_DATA,,);

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  openMap;
  LockMap;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    unLockMap;
    closeMap;
end;

end.

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls;
const
  WM_DATA=WM_USER+;
type
  PShareMem=^TShareMem;
  TShareMem=record
    Data:array[..] of char;
  end;

  TForm2 = class(TForm)
    //Memo1: TMemo;
    Button1: TButton;
    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= then
  begin
    showMessage('定位内存映像文件块失败');
    halt; //异常终止
  end;
 //将影像文件映射到进程的地址空间
  pshare := PShareMem(mapviewoffile(hmapping,FILE_MAP_ALL_ACCESS,,,));
  if pshare=nil then
  begin
    closehandle(hmapping);
    showmessage('将映像映射到进程地址空间失败');
    application.Terminate;
    exit;
  end;
  fillchar(pshare^,sizeof(TShareMem),);//初始化地址空间
end;

procedure  TForm2.getShareInfo(var msg: TMessage);
begin
  if msg.LParam= then
    memo1.Lines.add(pshare^.Data);
end;
end.