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.