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.