mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-27 17:53:43 +02:00
105 lines
2.8 KiB
ObjectPascal
105 lines
2.8 KiB
ObjectPascal
program SITest;
|
|
|
|
{$mode objfpc}
|
|
{$h+}
|
|
|
|
uses
|
|
Classes,
|
|
CustApp, advancedipc, singleinstance;
|
|
|
|
type
|
|
TMyCustomApplication = class(TCustomApplication)
|
|
private
|
|
procedure ServerReceivedParams(Sender: TBaseSingleInstance; aParams: TStringList);
|
|
procedure ServerReceivedCustomRequest(Sender: TBaseSingleInstance; {%H-}MsgID: Integer; aMsgType: TMessageType; MsgData: TStream);
|
|
end;
|
|
|
|
const
|
|
MsgType_Request_No_Response = 1;
|
|
MsgType_Request_With_Response = 2;
|
|
MsgType_Response = 3;
|
|
|
|
{ TMyCustomApplication }
|
|
|
|
procedure TMyCustomApplication.ServerReceivedCustomRequest(
|
|
Sender: TBaseSingleInstance; MsgID: Integer; aMsgType: TMessageType;
|
|
MsgData: TStream);
|
|
var
|
|
xData: AnsiString;
|
|
xStringStream: TStringStream;
|
|
begin
|
|
MsgData.Position := 0;
|
|
SetLength(xData, MsgData.Size div SizeOf(AnsiChar));
|
|
if MsgData.Size > 0 then
|
|
MsgData.ReadBuffer(xData[1], MsgData.Size);
|
|
|
|
WriteLn('Request: ', xData);
|
|
|
|
if aMsgType = MsgType_Request_With_Response then
|
|
begin
|
|
WriteLn('Sending response to client.');
|
|
xStringStream := TStringStream.Create('my response');
|
|
try
|
|
(Sender as TAdvancedSingleInstance).ServerPostCustomResponse(MsgID, MsgType_Response, xStringStream);
|
|
finally
|
|
xStringStream.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMyCustomApplication.ServerReceivedParams(Sender: TBaseSingleInstance;
|
|
aParams: TStringList);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Writeln('-----');
|
|
Writeln('Params:');
|
|
for I := 0 to aParams.Count-1 do
|
|
Writeln(aParams[I]);
|
|
Writeln('-----');
|
|
end;
|
|
|
|
var
|
|
xApp: TMyCustomApplication;
|
|
xStream: TStringStream;
|
|
xMsgType: TMessageType;
|
|
begin
|
|
xApp := TMyCustomApplication.Create(nil);
|
|
try
|
|
xApp.SingleInstanceEnabled := True;
|
|
xApp.SingleInstance.OnServerReceivedParams := @xApp.ServerReceivedParams;
|
|
(xApp.SingleInstance as TAdvancedSingleInstance).OnServerReceivedCustomRequest := @xApp.ServerReceivedCustomRequest;
|
|
xApp.Initialize;
|
|
Writeln(xApp.SingleInstance.StartResult);
|
|
xApp.Run;
|
|
|
|
case xApp.SingleInstance.StartResult of
|
|
siNotResponding: ReadLn;
|
|
siClient:
|
|
begin
|
|
xStream := TStringStream.Create('hello');
|
|
try
|
|
(xApp.SingleInstance as TAdvancedSingleInstance).ClientSendCustomRequest(MsgType_Request_No_Response, xStream);
|
|
finally
|
|
xStream.Free;
|
|
end;
|
|
xStream := TStringStream.Create('I want a response');
|
|
try
|
|
(xApp.SingleInstance as TAdvancedSingleInstance).ClientSendCustomRequest(MsgType_Request_With_Response, xStream);
|
|
xStream.Size := 0;
|
|
if (xApp.SingleInstance as TAdvancedSingleInstance).ClientPeekCustomResponse(xStream, xMsgType) then
|
|
WriteLn('Response: ', xStream.DataString)
|
|
else
|
|
WriteLn('Error: no response');
|
|
finally
|
|
xStream.Free;
|
|
end;
|
|
ReadLn;
|
|
end;
|
|
end;
|
|
finally
|
|
xApp.Free;
|
|
end;
|
|
end.
|
|
|