全局原子实现共享数据

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.