IPC with Memory Mapped Files

Irgendwann steht jeder Programmierer vor der Aufgabe, Daten zwischen zwei Programmen oder mehreren Prozessen virtuell auszutauschen und merkt, dass diese nicht so einfach zu lösen ist.

Der folgende Code zeigt, wie sich diese Aufgabe mit  MMFs – Memory-Mapped-Files lösen lässt.

MMFs können praktisch als eingelagerte und veränderbare Dateien im Speicher bezeichnet werden, eine genauere Erklärung zu MMFs bekommt man hier: Microsoft

Es werden zwei Units benötigt. 

Unit1:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Image1: TImage;
    Image2: TImage;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

type
  TMyData = record
    Zeichenkette: string[255];
    Zahl: Integer;
    BoolVar: Boolean;
  end;
  PMyData = ^TMyData;

const
  WM_MMFNOTIFY = WM_USER + 1;


implementation

{$R *.dfm}
function WriteToMMF(MyData: PMyData; Filename: string; hWnd: THandle): DWORD;
var
  dwResult: DWORD;
  hFileMapping: THandle;
  Mem: PMyData;
begin
  Mem := nil;
  dwResult := 0;
  hFileMapping := CreateFileMapping(INVALID_HANDLE_VALUE, nil,
    PAGE_READWRITE, 0, sizeof(TMyData), PChar(Filename));
  if hFileMapping <> 0 then
  begin
    Mem := MapViewOfFile(hFileMapping, FILE_MAP_WRITE, 0, 0, 0);
    if Assigned(Mem) then
    begin
      CopyMemory(Mem, MyData, sizeof(TMyData));
      SendMessage(hWnd, WM_MMFNOTIFY, 0, 0);
      CloseHandle(hFileMapping);
    end;
  end
  else
    dwResult := GetLastError;
  result := dwResult;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  s: string;
  MyData: PMyData;
  dwResult: DWORD;
  hReceiver: THandle;
begin
  SetLastError(0);
  hReceiver := FindWindow(nil, 'TReceiver');
  if hReceiver <> 0 then
  begin
    MyData := GetMemory(sizeof(TMyData));
    try
      if Assigned(MyData) then
      begin
        s := 'Hello world';
        MyData.Zeichenkette := PChar(s);
        MyData.Zahl := -3;
        MyData.BoolVar := True;
        dwResult := WriteToMMF(MyData, 'MyFileMapping', hReceiver);
        if dwResult <> ERROR_SUCCESS then
          ShowMessage(SysErrorMessage(dwResult));
      end;
    finally
      FreeMemory(MyData);
    end;
  end
  else
    ShowMessage(SysErrorMessage(GetLastError));
end;

end.

Unit2:

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

const
  WM_MMFNOTIFY = WM_USER + 1;

type
  TForm2 = class(TForm)
    Edit1: TEdit;
    CheckBox1: TCheckBox;
    Edit2: TEdit;
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WMMMFNOTIFY(var msg: TMessage); message WM_MMFNOTIFY;
  end;

var
  Form2: TForm2;

type
  TMyData = record
    Zeichenkette: string[255];
    Zahl: Integer;
    BoolVar: Boolean;
  end;
  PMyData = ^TMyData;

implementation

{$R *.dfm}
function ReadFromMMF(Filename: string): TMyData;
var
  hFileMapping: THandle;
  Mem: PMyData;
begin
  hFileMapping := CreateFileMapping(INVALID_HANDLE_VALUE, nil,
    PAGE_READONLY, 0, sizeof(TMyData), PChar(Filename));
  if hFileMapping <> 0 then
  begin
    Mem := MapViewOfFile(hFileMapping, FILE_MAP_READ, 0, 0, 0);
    if Assigned(Mem) then
    begin
      result.Zeichenkette := Mem.Zeichenkette;
      result.Zahl := Mem.Zahl;
      result.BoolVar := Mem.BoolVar;
    end;
  end
end;

procedure TForm2.WMMMFNOTIFY(var msg: TMessage);
var
  MyData: TMyData;
begin
  MyData := ReadFromMMF('MyFileMapping');
  Edit1.Text := MyData.Zeichenkette;
  CheckBox1.Checked := MyData.BoolVar;
  Edit2.Text := IntToStr(MyData.Zahl);
end;

end.