Delphi - Zwischen Prozessen kommunizieren

unit UIPC;

interface

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

procedure RegisterMessage(pMessage: string);
procedure CreateCommunicationWindow(MainApp: boolean);
function MyWindowProc(hwnd: HWND; wMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
procedure Subclass;

var
  WM_ISRESTRICTED: UINT;
  WM_TRUE: UINT;
  WM_FALSE: UINT;
  hOldProc: longint;
  hwnd_mywindow: HWND;

  temp_msg: UINT;
  msg_count: integer;

const
  MSG_ISRESTRICTED = 'isrestricted';
  MSG_TRUE = 'true';
  MSG_FALSE = 'false';
  WINDOWTITLE_TEMPAPP = 'wsystem - MainApp';
  WINDOWTITLE_MAINAPP = 'wsystem - TempApp';

implementation

procedure RegisterMessage(pMessage: string);
begin
  if pMessage = MSG_ISRESTRICTED then WM_ISRESTRICTED := RegisterWindowMessage(PChar(MSG_ISRESTRICTED))
  else if pMessage = MSG_TRUE then WM_TRUE := RegisterWindowMessage(PChar(MSG_TRUE))
  else if pMessage = MSG_FALSE then WM_FALSE := RegisterWindowMessage(PChar(MSG_FALSE));
end;

procedure CreateCommunicationWindow(MainApp: boolean);
begin                        
  if MainApp then hwnd_mywindow := CreateWindowEx(0, 'STATIC', PChar(WINDOWTITLE_MAINAPP), 0, 0, 0, 0, 0, 0, 0, hinstance, nil)
  else hwnd_mywindow := CreateWindowEx(0, 'STATIC', PChar(WINDOWTITLE_TEMPAPP), 0, 0, 0, 0, 0, 0, 0, hinstance, nil);
  subclass;
end;

function MyWindowProc(hwnd: HWND; wMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
var
  windowhandle: THandle;
begin
  temp_msg := wMsg;
  msg_count := msg_count + 1;
  //showmessage('fg');
  if wMsg = WM_ISRESTRICTED then begin
    //windowhandle := findwindow(nil, PChar(WINDOWTITLE_TEMPAPP));
    //showmessage(inttostr(windowhandle));
    showmessage('wm_isrestricted')
  end
  else if wMsg = WM_TRUE then showmessage('wm_true')
  else if wMsg = WM_FALSE then showmessage('wm_false')
  else MyWindowProc := CallWindowProc(PChar(hOldProc), hwnd, wMsg, wParam, lParam); //Pass the message to the previous window procedure to handle it
end;

procedure Subclass;
begin
  hOldProc := SetWindowLong(hwnd_mywindow, GWL_WNDPROC, longint(@MyWindowProc));
end;

initialization
  RegisterMessage(MSG_ISRESTRICTED);
  RegisterMessage(MSG_TRUE);
  RegisterMessage(MSG_FALSE);
  hwnd_mywindow := 0;
  hOldProc := 0;
       
  temp_msg := 0;
  msg_count := 0;

finalization
  SetWindowLong(hwnd_mywindow, GWL_WNDPROC, hOldProc);
  destroywindow(hwnd_mywindow);

end.

unit IPC_U;

interface

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

type
  TForm1 = class(TForm)
    chkServer: TCheckBox;
    BtServerToClient: TButton;
    BtClientToServer: TButton;
    Timer1: TTimer;
    Label1: TLabel;
    LbWM_ISRESTRICTED: TLabel;
    Label3: TLabel;
    LbWM_TRUE: TLabel;
    Label5: TLabel;
    LbWM_FALSE: TLabel;
    Label7: TLabel;
    LbhOldProc: TLabel;
    Label9: TLabel;
    Lbhwnd_mywindow: TLabel;
    Label11: TLabel;
    Lbtemp_msg: TLabel;
    Label13: TLabel;
    LbFindwindow: TLabel;
    Label2: TLabel;
    Lbmsg_count: TLabel;
    procedure chkServerClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BtServerToClientClick(Sender: TObject);
    procedure BtClientToServerClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
    wndcreated: boolean;
    windowhandle: HWND;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.chkServerClick(Sender: TObject);
begin
  BtServerToClient.Enabled := not BtServerToClient.Enabled;
  BtClientToServer.Enabled := not BtClientToServer.Enabled;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  wndcreated := false;
  windowhandle := 1;
end;

procedure TForm1.BtServerToClientClick(Sender: TObject);
begin
  if not wndcreated then begin
    createcommunicationwindow(true);
    wndcreated := true;
    chkserver.enabled := false;
    showmessage('CommunicationWindow created');
    exit;
  end;
  if windowhandle <> 0 then windowhandle := findwindow(nil, PChar(WINDOWTITLE_TEMPAPP));
  sendmessage(windowhandle, WM_TRUE, 0, 0);
end;

procedure TForm1.BtClientToServerClick(Sender: TObject);
begin
  if not wndcreated then begin
    createcommunicationwindow(false);
    wndcreated := true;
    chkserver.enabled := false;
    showmessage('CommunicationWindow created');
    exit;
  end;
  if windowhandle <> 0 then windowhandle := findwindow(nil, PChar(WINDOWTITLE_MAINAPP));
  sendmessage(windowhandle, WM_ISRESTRICTED, 0, 0);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  LbWM_ISRESTRICTED.caption := inttostr(WM_ISRESTRICTED);
  LbWM_TRUE.caption := inttostr(WM_TRUE);
  LbWM_FALSE.caption := inttostr(WM_FALSE);
  LbhOldProc.caption := inttostr(hOldProc);
  Lbhwnd_mywindow.caption := inttostr(hwnd_mywindow);
  if temp_msg <> 0 then Lbtemp_msg.caption := inttostr(temp_msg);
  Lbmsg_count.caption := inttostr(msg_count);
  LbFindwindow.caption := inttostr(windowhandle);
end;

end.