Delphi - Interprozesskommunikation (IPC) mittels Memory Mapped Files (MMF)

Sender:
{
  Author  : http://developer.luckie-online.de
  Date    : 2005-03-07
  License : PUBLIC DOMAIN
}


unit Unit1;

interface

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

type
  TTSender = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

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

const
  WM_MMFNOTIFY = WM_USER + 1;

var
  TSender: TTSender;

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 TTSender.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.
Empf�nger:
{
  Author  : http://developer.luckie-online.de
  Date    : 2005-03-07
  License : PUBLIC DOMAIN
}


unit Unit2;

interface

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

const
  WM_MMFNOTIFY = WM_USER + 1;

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

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

var
  TReceiver: TTReceiver;

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 TTReceiver.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.

2012-01-26T23:14:45 +0100, mail[at]michael[Bindestrich]puff.de