paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 18:49:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
fcl/inc/simpleipc.pp
View File

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

3
fcl/unix/simpleipc.inc
View File

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

2
fcl/win/simpleipc.inc
View File

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