* Patch from Luiz Americo Pereira Camara to implement proper support for custom messages

git-svn-id: trunk@5986 -
This commit is contained in:
michael 2007-01-15 08:45:17 +00:00
parent 156719af03
commit c9664d3a46
3 changed files with 36 additions and 15 deletions

View File

@ -25,12 +25,16 @@ uses
Const
MsgVersion = 1;
//Message types
mtUnknown = 0;
mtString = 1;
Type
TMessageType = (mtUnknown,mtString); // For now
TMessageType = LongInt;
TMsgHeader = Packed record
Version : Byte;
msgType : TMessageType;
MsgType : TMessageType;
MsgLen : Integer;
end;
@ -80,6 +84,7 @@ Type
private
FGlobal: Boolean;
FOnMessage: TNotifyEvent;
FMsgType: TMessageType;
FMsgData : TStream;
function GetInstanceID: String;
function GetStringMessage: String;
@ -92,12 +97,13 @@ Type
Procedure ReadMessage;
Public
Constructor Create(AOwner : TComponent); override;
Destructor destroy; override;
Destructor Destroy; override;
Procedure StartServer;
Procedure StopServer;
Function PeekMessage(TimeOut : Integer; DoReadMessage : Boolean): Boolean;
Property StringMessage : String Read GetStringMessage;
Procedure GetMessageData(Stream : TStream);
Property MsgType: TMessageType Read FMsgType;
Property MsgData : TStream Read FMsgData;
Property InstanceID : String Read GetInstanceID;
Published
@ -132,13 +138,15 @@ Type
Function CommClass : TIPCClientCommClass; virtual;
Public
Constructor Create(AOwner : TComponent); override;
Destructor destroy; override;
Destructor Destroy; override;
Procedure Connect;
Procedure Disconnect;
Function ServerRunning : Boolean;
Procedure SendMessage(MsgType : TMessageType; Stream: TStream);
Procedure SendStringMessage(Msg : String);
Procedure SendStringmessageFmt(Msg : String; Args : Array of const);
Procedure SendStringMessage(const Msg : String);
Procedure SendStringMessage(MsgType : TMessageType; const Msg : String);
Procedure SendStringMessageFmt(const Msg : String; Args : Array of const);
Procedure SendStringMessageFmt(MsgType : TMessageType; const Msg : String; Args : Array of const);
Property ServerInstance : String Read FServerInstance Write SetServerInstance;
end;
@ -239,11 +247,11 @@ begin
FMsgData:=TStringStream.Create('');
end;
destructor TSimpleIPCServer.destroy;
destructor TSimpleIPCServer.Destroy;
begin
Active:=False;
FreeAndNil(FMsgData);
inherited destroy;
inherited Destroy;
end;
procedure TSimpleIPCServer.SetGlobal(const AValue: Boolean);
@ -402,24 +410,34 @@ begin
end;
end;
procedure TSimpleIPCClient.SendStringMessage(Msg: String);
procedure TSimpleIPCClient.SendStringMessage(const Msg: String);
begin
SendStringMessage(mtString,Msg);
end;
procedure TSimpleIPCClient.SendStringMessage(MsgType: TMessageType; const Msg: String
);
Var
S : TStringStream;
begin
S:=TStringStream.Create(Msg);
try
SendMessage(mtString,S);
SendMessage(MsgType,S);
finally
s.free;
S.free;
end;
end;
procedure TSimpleIPCClient.SendStringmessageFmt(Msg: String;
procedure TSimpleIPCClient.SendStringMessageFmt(const Msg: String;
Args: array of const);
begin
SendStringmessage(Format(Msg,Args));
SendStringMessageFmt(mtString,Msg,Args);
end;
procedure TSimpleIPCClient.SendStringMessageFmt(MsgType: TMessageType;
const Msg: String; Args: array of const);
begin
SendStringMessage(MsgType, Format(Msg,Args));
end;
end.

View File

@ -75,7 +75,7 @@ Var
begin
Hdr.Version:=MsgVersion;
Hdr.msgType:=mtString;
Hdr.msgType:=MsgType;
Hdr.MsgLen:=AStream.Size;
FStream.WriteBuffer(hdr,SizeOf(hdr));
FStream.CopyFrom(AStream,0);
@ -156,6 +156,7 @@ Var
begin
FStream.ReadBuffer(Hdr,SizeOf(Hdr));
Owner.FMsgType:=Hdr.MsgType;
Count:=Hdr.MsgLen;
if count > 0 then
begin

View File

@ -168,6 +168,7 @@ Var
begin
CDS:=PCopyDataStruct(Msg.Lparam);
Owner.FMsgType:=CDS^.dwData;
Owner.FMsgData.Seek(0,soFrombeginning);
Owner.FMsgData.WriteBuffer(CDS^.lpData^,CDS^.cbData);
end;
@ -253,6 +254,7 @@ begin
FMemStr.CopyFrom(Stream,0);
FMemStr.Seek(0,soFromBeginning);
end;
CDS.dwData:=MsgType;
CDS.lpData:=Data.Memory;
CDS.cbData:=Data.Size;
Windows.SendMessage(FHWnd,WM_COPYDATA,0,Integer(@CDS));