Interprozesskommunikation mitttels Memory Mapped Files

[Matze]

Wie man zwischen zwei selbst geschriebenen Anwendungen kommunizieren kann, zeigt uns Luckie mit seinem folgenden Code:

Sender-Anwendung

Delphi-Quellcode:

{
  Author  : Michael Puff - [url]http://developer.luckie-online.de[/url]
  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));
      UnmapViewOfFile(Mem);
      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-Anwendung

Delphi-Quellcode:

{
  Author  : Michael Puff - [url]http://developer.luckie-online.de[/url]
  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;
      UnmapViewOfFile(Mem);
    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.

Zitat von Luckie:

Will man allerdings nur einen String übergeben und sollte dieser länger als 255 Zeichen sein, dann ist Sir Thornberrys Methode wohl die bessere.

SirThornberrys Methode ist folgende und sendet hier einen Text von dem einen Programmg zum anderen:

Sender-Anwendung

Delphi-Quellcode:

procedure SendText(Text: string);
var LHandle: Cardinal;
begin
  fFileHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, length(Edit1.Text) + 1, 'WunschName');
  if fFileHandle <> 0 then
  begin
    FSpeicher := MapViewOfFile(fFileHandle, FILE_MAP_WRITE, 0, 0, 0);
    StrCopy(FSpeicher, PChar(Text));
    UnmapViewOfFile(FSpeicher);
    LHandle := FindWindow('TAnwendungA', nil);
    if LHandle <> 0 then
    begin
      SendMessage(LHandle, WM_USER + 5, 0, 0);
    end;
    CloseHandle(fFileHandle);
  end;
end;

Empfänger-Anwendung

Delphi-Quellcode:

procedure ReceiveText(var AMessage: TMessage): string;
var LSpeicher: PChar;
    LDest: String;
begin
  fFileHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, 500, 'WunschName');
  if fFileHandle <> 0 then
  begin
    LSpeicher := MapViewOfFile(fFileHandle, FILE_MAP_WRITE, 0, 0, 0);
    setlength(LDest, length(LSpeicher));
    StrCopy(PChar(LDest), LSpeicher);
    UnmapViewOfFile(LSpeicher);
    result := LDest;
    CloseHandle(fFileHandle);
  end;
end;

Eine Demo dazu hat SirThornberry hier angehängt.



Suchworte: IPC MMF

[edit=Chakotay1308]Beitrag klassifiziert. Mfg, Chakotay1308[/edit]
[edit=Matze]Die Anmerkung von Cyberstorm, UnmapViewOfFile() aufzurufen, ergänzt. MfG, Matze[/edit]