全局原子实现共享数据

unit atom;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
function SendInterAppMessage(sClass,sCaption:string;wMsgNum,wCmd:Word;sData:string):Boolean;
type
TfrmAtom = class(TForm)
btn: TButton;
procedure btnClick(Sender: TObject);
private
{ Private declarations }
sMessage:string;

public
{ Public declarations }
procedure WMPrivateMessage(var Msg:TMessage);message WM_USER+21;
end;

var
frmAtom: TfrmAtom;

implementation

{$R *.dfm}
function SendInterAppMessage(sClass,sCaption:string;wMsgNum,wCmd:Word;sData:string):Boolean;
var
AAtom :TAtom;
hWndReceiver:HWND;
begin
Result := True;
if (Length(sClass)>0)and (Length(sCaption)>0) then
begin
hWndReceiver := FindWindow(PChar(sClass),PChar(sCaption));
Result := hWndReceiver<>0;
end;
// 发现指定程序
if Result then
begin
if Length(sData)>0 then
begin
AAtom := GlobalAddAtom(PChar(sData)); // 申请全局原子
SendMessage(hWndReceiver,wMsgNum,wCmd,AAtom);
end
else
begin
SendMessage(hWndReceiver,wMsgNum,wCmd,0);
end
end
else
begin
// 广播消息到全部应用程序
if Length(sData)>0 then
begin
AAtom := GlobalAddAtom(PChar(sData));
SendMessage(HWND_BROADCAST,wMsgNum,wCmd,AAtom);
end
else
begin
SendMessage(HWND_BROADCAST,wMsgNum,wCmd,0);
end;
end;
end;
procedure TfrmAtom.btnClick(Sender: TObject);
begin
//
SendInterAppMessage('TfrmAtom','frmAtom',WM_USER+21,0,'This is just a test!');
end;

procedure TfrmAtom.WMPrivateMessage(var Msg: TMessage);
var
cBuf:array[0..255] of Char;
begin
//
if Msg.LParam<>0 then
begin
GlobalGetAtomName(Msg.LParam,cBuf,255);
sMessage := StrPas(cBuf);
GlobalDeleteAtom(Msg.LParam);
end
else
begin
sMessage := '';
end;
ShowMessage(sMessage);
inherited;
end;

end.