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.