[fpc-devel] simpleipc issues
Ondrej Pokorny
lazarus at kluug.net
Sun Nov 29 09:01:31 CET 2015
On 11.11.2015 17:47, Michael Van Canneyt wrote:
> I have several remarks:
>
> a) Your TBaseSingleInstance class contains too many methods.
> It assumes you are using advancedipc.
I refactored TBaseSingleInstance so that it doesn't depend on advancedipc.
> I suggest refactoring such a way that advancedipc is in the
> implementation section of the class.
This is unfortunately not possible now because there are no interfaces
(nor abstract classes) for TIPCServer and TIPCClient.
IMO this is not a problem, if you don't want singleinstance.pp to be
dependent on advancedipc.pp at all, TAdvancedSingleInstance can be
easily moved into another unit - e.g. "advancedsingleinstance.pp".
CustApp.pp will need to use "advancedsingleinstance.pp" in
implementation section then.
If you want to have abstract classes for TIPCServer and TIPCClient,
advancedipc.pp would need a bigger refactoring. Adding interfaces for
them seems to be a simpler and better solution for me. - But as I said
before, IMO neither interfaces nor abstract classes are needed for now.
TBaseSingleInstance already introduces the bare minimum of methods needed.
> or introduce TAbstractSingleInstance as a parent of
> TBaseSingleInstance with the bare minimum of methods/properties.
TBaseSingleInstance is now such "TAbstractSingleInstance". You can
rename it to TAbstractSingleInstance if you like.
> b) There is no way to have TCustomApplication create a different
> singleinstance class, for 2 reasons:
> 1. Your property is declared as TCustomSingleInstance.
> It should be TBaseSingleInstance (or TAbstractSingleInstance)
> That means that the 'enabled' property should be in
> TBaseSingleInstance or TAbstractSingleInstance.
The Enabled property doesn't belong into TBaseSingleInstance - it has a
meaning only in TCustomApplication. I solved it by introducing
SingleInstanceEnabled in TCustomApplication.
> 2. You create the instance as TCustomSingleInstance.Create in the
> constructor.
> It should be a function CreateSingleinstance :
> TCustomSingleInstance;
I solved it by introducing SingleInstanceClass. IMO it's better because
SingleInstanceClass can be easily changed without the need to create a
new TCustomApplication descendant and override a virtual function.
Feel free to comment on my changes.
BTW, there are some compiler hints/warnings in CustApp.pp. At least the
one warning should be solved, IMO:
Compile Project, Target: sitest.exe: Success, Warnings: 1, Hints: 8
custapp.pp(175,6) Note: Local variable "l" is assigned but never used
custapp.pp(57,21) Hint: Parameter "EventType" not used
custapp.pp(57,51) Hint: Parameter "Msg" not used
custapp.pp(391,25) Hint: Local variable "B" does not seem to be initialized
custapp.pp(408,29) Warning: Local variable "I" does not seem to be
initialized
custapp.pp(408,27) Hint: Local variable "B" does not seem to be initialized
custapp.pp(453,30) Hint: Local variable "B" does not seem to be initialized
custapp.pp(502,31) Hint: Local variable "B" does not seem to be initialized
custapp.pp(524,8) Note: Local variable "SO" is assigned but never used
Ondrej
-------------- next part --------------
Index: packages/fcl-base/examples/sitest.pp
===================================================================
--- packages/fcl-base/examples/sitest.pp (revision 32548)
+++ packages/fcl-base/examples/sitest.pp (working copy)
@@ -40,7 +40,7 @@
WriteLn('Sending response to client.');
xStringStream := TStringStream.Create('my response');
try
- Sender.ServerPostCustomResponse(MsgID, MsgType_Response, xStringStream);
+ (Sender as TAdvancedSingleInstance).ServerPostCustomResponse(MsgID, MsgType_Response, xStringStream);
finally
xStringStream.Free;
end;
@@ -66,9 +66,9 @@
begin
xApp := TMyCustomApplication.Create(nil);
try
- xApp.SingleInstance.Enabled := True;
+ xApp.SingleInstanceEnabled := True;
xApp.SingleInstance.OnServerReceivedParams := @xApp.ServerReceivedParams;
- xApp.SingleInstance.OnServerReceivedCustomRequest := @xApp.ServerReceivedCustomRequest;
+ (xApp.SingleInstance as TAdvancedSingleInstance).OnServerReceivedCustomRequest := @xApp.ServerReceivedCustomRequest;
xApp.Initialize;
Writeln(xApp.SingleInstance.StartResult);
xApp.Run;
@@ -79,15 +79,15 @@
begin
xStream := TStringStream.Create('hello');
try
- xApp.SingleInstance.ClientSendCustomRequest(MsgType_Request_No_Response, xStream);
+ (xApp.SingleInstance as TAdvancedSingleInstance).ClientSendCustomRequest(MsgType_Request_No_Response, xStream);
finally
xStream.Free;
end;
xStream := TStringStream.Create('I want a response');
try
- xApp.SingleInstance.ClientSendCustomRequest(MsgType_Request_With_Response, xStream);
+ (xApp.SingleInstance as TAdvancedSingleInstance).ClientSendCustomRequest(MsgType_Request_With_Response, xStream);
xStream.Size := 0;
- if xApp.SingleInstance.ClientPeekCustomResponse(xStream, xMsgType) then
+ if (xApp.SingleInstance as TAdvancedSingleInstance).ClientPeekCustomResponse(xStream, xMsgType) then
WriteLn('Response: ', xStream.DataString)
else
WriteLn('Error: no response');
Index: packages/fcl-base/src/custapp.pp
===================================================================
--- packages/fcl-base/src/custapp.pp (revision 32548)
+++ packages/fcl-base/src/custapp.pp (working copy)
@@ -25,9 +25,6 @@
TExceptionEvent = Procedure (Sender : TObject; E : Exception) Of Object;
TEventLogTypes = Set of TEventType;
- TCustomApplication = Class;
- TCustomSingleInstance = Class;
-
{ TCustomApplication }
TCustomApplication = Class(TComponent)
@@ -34,7 +31,9 @@
Private
FEventLogFilter: TEventLogTypes;
FOnException: TExceptionEvent;
- FSingleInstance: TCustomSingleInstance;
+ FSingleInstance: TBaseSingleInstance;
+ FSingleInstanceClass: TBaseSingleInstanceClass; // set before FSingleInstance is created
+ FSingleInstanceEnabled: Boolean; // set before Initialize is called
FTerminated : Boolean;
FHelpFile,
FTitle : String;
@@ -44,6 +43,9 @@
function GetEnvironmentVar(VarName : String): String;
function GetExeName: string;
Function GetLocation : String;
+ function GetSingleInstance: TBaseSingleInstance;
+ procedure SetSingleInstanceClass(
+ const ASingleInstanceClass: TBaseSingleInstanceClass);
function GetTitle: string;
Protected
function GetOptionAtIndex(AIndex: Integer; IsLong: Boolean): String;
@@ -95,17 +97,11 @@
Property CaseSensitiveOptions : Boolean Read FCaseSensitiveOptions Write FCaseSensitiveOptions;
Property StopOnException : Boolean Read FStopOnException Write FStopOnException;
Property EventLogFilter : TEventLogTypes Read FEventLogFilter Write FEventLogFilter;
- Property SingleInstance: TCustomSingleInstance read FSingleInstance;
+ Property SingleInstance: TBaseSingleInstance read GetSingleInstance;
+ Property SingleInstanceClass: TBaseSingleInstanceClass read FSingleInstanceClass write SetSingleInstanceClass;
+ Property SingleInstanceEnabled: Boolean read FSingleInstanceEnabled write FSingleInstanceEnabled;
end;
- TCustomSingleInstance = class(TBaseSingleInstance)
- private
- FEnabled: Boolean;
- public
- //you must set Enabled before CustomApplication.Initialize
- property Enabled: Boolean read FEnabled write FEnabled;
- end;
-
var CustomApplication : TCustomApplication = nil;
Implementation
@@ -234,6 +230,13 @@
Result:=ParamStr(Index);
end;
+function TCustomApplication.GetSingleInstance: TBaseSingleInstance;
+begin
+ if FSingleInstance = nil then
+ FSingleInstance := FSingleInstanceClass.Create(Self);
+ Result := FSingleInstance;
+end;
+
procedure TCustomApplication.SetTitle(const AValue: string);
begin
FTitle:=AValue;
@@ -246,8 +249,9 @@
procedure TCustomApplication.DoRun;
begin
- if FSingleInstance.IsServer then
- FSingleInstance.ServerCheckMessages;
+ if Assigned(FSingleInstance) then
+ if FSingleInstance.IsServer then
+ FSingleInstance.ServerCheckMessages;
// Override in descendent classes.
end;
@@ -271,7 +275,7 @@
FOptionChar:='-';
FCaseSensitiveOptions:=True;
FStopOnException:=False;
- FSingleInstance := TCustomSingleInstance.Create(Self);
+ FSingleInstanceClass := TAdvancedSingleInstance;
end;
destructor TCustomApplication.Destroy;
@@ -298,12 +302,12 @@
procedure TCustomApplication.Initialize;
begin
FTerminated:=False;
- if FSingleInstance.Enabled then
+ if FSingleInstanceEnabled then
begin
- case FSingleInstance.Start of
+ case SingleInstance.Start of
siClient:
begin
- FSingleInstance.ClientPostParams;
+ SingleInstance.ClientPostParams;
FTerminated:=True;
end;
siNotResponding:
@@ -324,6 +328,13 @@
Until FTerminated;
end;
+procedure TCustomApplication.SetSingleInstanceClass(
+ const ASingleInstanceClass: TBaseSingleInstanceClass);
+begin
+ Assert((FSingleInstance = nil) and (ASingleInstanceClass <> nil));
+ FSingleInstanceClass := ASingleInstanceClass;
+end;
+
procedure TCustomApplication.ShowException(E: Exception);
begin
Index: packages/fcl-base/src/singleinstance.pp
===================================================================
--- packages/fcl-base/src/singleinstance.pp (revision 32548)
+++ packages/fcl-base/src/singleinstance.pp (working copy)
@@ -30,62 +30,76 @@
//siNotResponding: There is another instance running but it doesn't respond.
TSingleInstanceStart = (siServer, siClient, siNotResponding);
TSingleInstanceParams = procedure(Sender: TBaseSingleInstance; Params: TStringList) of object;
- TSingleInstanceReceivedCustomMessage = procedure(Sender: TBaseSingleInstance; MsgID: Integer; MsgType: TMessageType; MsgData: TStream) of object;
TBaseSingleInstance = class(TComponent)
private
- FGlobal: Boolean;
- FID: string;
- FServer: TIPCServer;
- FClient: TIPCClient;
FStartResult: TSingleInstanceStart;
FTimeOutMessages: Integer;
FTimeOutWaitForInstances: Integer;
- FOnServerReceivedCustomRequest: TSingleInstanceReceivedCustomMessage;
FOnServerReceivedParams: TSingleInstanceParams;
- function GetIsClient: Boolean;
- function GetIsServer: Boolean;
- function GetStartResult: TSingleInstanceStart;
- procedure SetGlobal(const aGlobal: Boolean);
- procedure SetID(const aID: string);
+ function GetIsClient: Boolean; virtual; abstract;
+ function GetIsServer: Boolean; virtual; abstract;
+ function GetStartResult: TSingleInstanceStart; virtual;
+ protected
procedure DoServerReceivedParams(const aParamsDelimitedText: string);
- procedure DoServerReceivedCustomRequest(const aMsgID: Integer; const aMsgType: TMessageType; const aStream: TStream);
- protected
- //call Start when you want to start single instance checking
- function Start: TSingleInstanceStart;
- //stop single instance server or client
- procedure Stop;
-
- procedure ServerCheckMessages;
- procedure ClientPostParams;
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
public
- function ClientPostCustomRequest(const aMsgType: TMessageType; const aStream: TStream): Integer;
- function ClientSendCustomRequest(const aMsgType: TMessageType; const aStream: TStream): Boolean; overload;
- function ClientSendCustomRequest(const aMsgType: TMessageType; const aStream: TStream; out outRequestID: Integer): Boolean; overload;
- procedure ServerPostCustomResponse(const aRequestID: Integer; const aMsgType: TMessageType; const aStream: TStream);
- function ClientPeekCustomResponse(const aStream: TStream; out outMsgType: TMessageType): Boolean;
+ //call Start when you want to start single instance checking
+ function Start: TSingleInstanceStart; virtual; abstract;
+ //stop single instance server or client
+ procedure Stop; virtual; abstract;
+
+ //check and handle pending messages on server
+ procedure ServerCheckMessages; virtual; abstract;
+ //post cmd parameters from client to server
+ procedure ClientPostParams; virtual; abstract;
public
- property ID: string read FID write SetID;
- property Global: Boolean read FGlobal write SetGlobal;
property TimeOutMessages: Integer read FTimeOutMessages write FTimeOutMessages;
property TimeOutWaitForInstances: Integer read FTimeOutWaitForInstances write FTimeOutWaitForInstances;
property OnServerReceivedParams: TSingleInstanceParams read FOnServerReceivedParams write FOnServerReceivedParams;
- property OnServerReceivedCustomRequest: TSingleInstanceReceivedCustomMessage read FOnServerReceivedCustomRequest write FOnServerReceivedCustomRequest;
public
property StartResult: TSingleInstanceStart read GetStartResult;
property IsServer: Boolean read GetIsServer;
property IsClient: Boolean read GetIsClient;
end;
+ TBaseSingleInstanceClass = class of TBaseSingleInstance;
- TSingleInstance = class(TBaseSingleInstance)
+ TSingleInstanceReceivedCustomMessage = procedure(Sender: TBaseSingleInstance; MsgID: Integer; MsgType: TMessageType; MsgData: TStream) of object;
+
+ TAdvancedSingleInstance = class(TBaseSingleInstance)
+ private
+ FGlobal: Boolean;
+ FID: string;
+ FServer: TIPCServer;
+ FClient: TIPCClient;
+ FOnServerReceivedCustomRequest: TSingleInstanceReceivedCustomMessage;
+ function GetIsClient: Boolean; override;
+ function GetIsServer: Boolean; override;
+ function GetStartResult: TSingleInstanceStart; override;
+ procedure SetGlobal(const aGlobal: Boolean);
+ procedure SetID(const aID: string);
+ protected
+ procedure DoServerReceivedCustomRequest(const aMsgID: Integer; const aMsgType: TMessageType; const aStream: TStream);
public
- function Start: TSingleInstanceStart;
- procedure Stop;
+ constructor Create(aOwner: TComponent); override;
+ public
+ function Start: TSingleInstanceStart; override;
+ procedure Stop; override;
- procedure ServerCheckMessages;
- procedure ClientPostParams;
+ procedure ServerCheckMessages; override;
+ procedure ClientPostParams; override;
+ public
+ function ClientPostCustomRequest(const aMsgType: TMessageType; const aStream: TStream): Integer;
+ function ClientSendCustomRequest(const aMsgType: TMessageType; const aStream: TStream): Boolean; overload;
+ function ClientSendCustomRequest(const aMsgType: TMessageType; const aStream: TStream; out outRequestID: Integer): Boolean; overload;
+ procedure ServerPostCustomResponse(const aRequestID: Integer; const aMsgType: TMessageType; const aStream: TStream);
+ function ClientPeekCustomResponse(const aStream: TStream; out outMsgType: TMessageType): Boolean;
+ public
+ property ID: string read FID write SetID;
+ property Global: Boolean read FGlobal write SetGlobal;
+
+ property OnServerReceivedCustomRequest: TSingleInstanceReceivedCustomMessage read FOnServerReceivedCustomRequest write FOnServerReceivedCustomRequest;
end;
ESingleInstance = class(Exception);
@@ -106,33 +120,28 @@
MSGTYPE_PARAMS = -3;
MSGTYPE_WAITFORINSTANCES = -4;
-{ TSingleInstance }
+{ TAdvancedSingleInstance }
-procedure TSingleInstance.ClientPostParams;
+constructor TAdvancedSingleInstance.Create(aOwner: TComponent);
+var
+ xID: RawByteString;
+ I: Integer;
begin
- inherited ClientPostParams;
-end;
+ inherited Create(aOwner);
-procedure TSingleInstance.ServerCheckMessages;
-begin
- inherited ServerCheckMessages;
+ xID := 'SI_'+ExtractFileName(ParamStr(0));
+ for I := 1 to Length(xID) do
+ case xID[I] of
+ 'a'..'z', 'A'..'Z', '0'..'9', '_': begin end;
+ else
+ xID[I] := '_';
+ end;
+ ID := xID;
end;
-function TSingleInstance.Start: TSingleInstanceStart;
+function TAdvancedSingleInstance.ClientPeekCustomResponse(
+ const aStream: TStream; out outMsgType: TMessageType): Boolean;
begin
- Result := inherited Start;
-end;
-
-procedure TSingleInstance.Stop;
-begin
- inherited Stop;
-end;
-
-{ TBaseSingleInstance }
-
-function TBaseSingleInstance.ClientPeekCustomResponse(const aStream: TStream; out
- outMsgType: TMessageType): Boolean;
-begin
if not Assigned(FClient) then
raise ESingleInstance.Create(SErrSingleInstanceNotClient);
@@ -139,8 +148,8 @@
Result := FClient.PeekResponse(aStream, outMsgType, FTimeOutMessages);
end;
-function TBaseSingleInstance.ClientPostCustomRequest(const aMsgType: TMessageType;
- const aStream: TStream): Integer;
+function TAdvancedSingleInstance.ClientPostCustomRequest(
+ const aMsgType: TMessageType; const aStream: TStream): Integer;
begin
if not Assigned(FClient) then
raise ESingleInstance.Create(SErrSingleInstanceNotClient);
@@ -148,7 +157,7 @@
Result := FClient.PostRequest(aMsgType, aStream);
end;
-procedure TBaseSingleInstance.ClientPostParams;
+procedure TAdvancedSingleInstance.ClientPostParams;
var
xSL: TStringList;
xStringStream: TStringStream;
@@ -174,7 +183,7 @@
end;
end;
-function TBaseSingleInstance.ClientSendCustomRequest(
+function TAdvancedSingleInstance.ClientSendCustomRequest(
const aMsgType: TMessageType; const aStream: TStream): Boolean;
begin
if not Assigned(FClient) then
@@ -183,8 +192,9 @@
Result := FClient.SendRequest(aMsgType, aStream, FTimeOutMessages);
end;
-function TBaseSingleInstance.ClientSendCustomRequest(const aMsgType: TMessageType;
- const aStream: TStream; out outRequestID: Integer): Boolean;
+function TAdvancedSingleInstance.ClientSendCustomRequest(
+ const aMsgType: TMessageType; const aStream: TStream; out
+ outRequestID: Integer): Boolean;
begin
if not Assigned(FClient) then
raise ESingleInstance.Create(SErrSingleInstanceNotClient);
@@ -192,34 +202,7 @@
Result := FClient.SendRequest(aMsgType, aStream, FTimeOutMessages, outRequestID);
end;
-constructor TBaseSingleInstance.Create(aOwner: TComponent);
-var
- xID: RawByteString;
- I: Integer;
-begin
- inherited Create(aOwner);
-
- FTimeOutMessages := 1000;
- FTimeOutWaitForInstances := 100;
-
- xID := 'SI_'+ExtractFileName(ParamStr(0));
- for I := 1 to Length(xID) do
- case xID[I] of
- 'a'..'z', 'A'..'Z', '0'..'9', '_': begin end;
- else
- xID[I] := '_';
- end;
- ID := xID;
-end;
-
-destructor TBaseSingleInstance.Destroy;
-begin
- Stop;
-
- inherited Destroy;
-end;
-
-procedure TBaseSingleInstance.DoServerReceivedCustomRequest(
+procedure TAdvancedSingleInstance.DoServerReceivedCustomRequest(
const aMsgID: Integer; const aMsgType: TMessageType; const aStream: TStream);
begin
if Assigned(FOnServerReceivedCustomRequest) then
@@ -226,42 +209,25 @@
FOnServerReceivedCustomRequest(Self, aMsgID, aMsgType, aStream);
end;
-procedure TBaseSingleInstance.DoServerReceivedParams(
- const aParamsDelimitedText: string);
-var
- xSL: TStringList;
+function TAdvancedSingleInstance.GetIsClient: Boolean;
begin
- if not Assigned(FOnServerReceivedParams) then
- Exit;
-
- xSL := TStringList.Create;
- try
- xSL.DelimitedText := aParamsDelimitedText;
- FOnServerReceivedParams(Self, xSL);
- finally
- xSL.Free;
- end;
-end;
-
-function TBaseSingleInstance.GetIsClient: Boolean;
-begin
Result := Assigned(FClient);
end;
-function TBaseSingleInstance.GetIsServer: Boolean;
+function TAdvancedSingleInstance.GetIsServer: Boolean;
begin
Result := Assigned(FServer);
end;
-function TBaseSingleInstance.GetStartResult: TSingleInstanceStart;
+function TAdvancedSingleInstance.GetStartResult: TSingleInstanceStart;
begin
if not(Assigned(FServer) or Assigned(FClient)) then
raise ESingleInstance.Create(SErrSingleInstanceStartResultNotAvailable);
- Result := FStartResult;
+ Result := inherited GetStartResult;
end;
-procedure TBaseSingleInstance.ServerCheckMessages;
+procedure TAdvancedSingleInstance.ServerCheckMessages;
var
xMsgID: Integer;
xMsgType: TMessageType;
@@ -303,7 +269,7 @@
end;
end;
-procedure TBaseSingleInstance.ServerPostCustomResponse(
+procedure TAdvancedSingleInstance.ServerPostCustomResponse(
const aRequestID: Integer; const aMsgType: TMessageType;
const aStream: TStream);
begin
@@ -313,7 +279,7 @@
FServer.PostResponse(aRequestID, aMsgType, aStream);
end;
-procedure TBaseSingleInstance.SetGlobal(const aGlobal: Boolean);
+procedure TAdvancedSingleInstance.SetGlobal(const aGlobal: Boolean);
begin
if FGlobal = aGlobal then Exit;
if Assigned(FServer) or Assigned(FClient) then
@@ -321,7 +287,7 @@
FGlobal := aGlobal;
end;
-procedure TBaseSingleInstance.SetID(const aID: string);
+procedure TAdvancedSingleInstance.SetID(const aID: string);
begin
if FID = aID then Exit;
if Assigned(FServer) or Assigned(FClient) then
@@ -329,13 +295,7 @@
FID := aID;
end;
-procedure TBaseSingleInstance.Stop;
-begin
- FreeAndNil(FServer);
- FreeAndNil(FClient);
-end;
-
-function TBaseSingleInstance.Start: TSingleInstanceStart;
+function TAdvancedSingleInstance.Start: TSingleInstanceStart;
{$IFNDEF MSWINDOWS}
procedure UnixWorkaround(var bServerStarted: Boolean);
var
@@ -371,7 +331,7 @@
//something went wrong, there are not-deleted waiting requests
//use random sleep as workaround and try to restart the server
Randomize;
- Sleep(Random(($3F+PtrInt(GetCurrentThreadId)) and $3F));//limit to $3F (63)
+ Sleep(Random(($3F+PtrInt(GetProcessID)) and $3F));//limit to $3F (63)
bServerStarted := FServer.StartServer(False) and (FServer.GetPendingRequestCount > 0);
end;
end;
@@ -415,5 +375,50 @@
FStartResult := Result;
end;
+procedure TAdvancedSingleInstance.Stop;
+begin
+ FreeAndNil(FServer);
+ FreeAndNil(FClient);
+end;
+
+{ TBaseSingleInstance }
+
+constructor TBaseSingleInstance.Create(aOwner: TComponent);
+begin
+ inherited Create(aOwner);
+
+ FTimeOutMessages := 1000;
+ FTimeOutWaitForInstances := 100;
+end;
+
+destructor TBaseSingleInstance.Destroy;
+begin
+ Stop;
+
+ inherited Destroy;
+end;
+
+procedure TBaseSingleInstance.DoServerReceivedParams(
+ const aParamsDelimitedText: string);
+var
+ xSL: TStringList;
+begin
+ if not Assigned(FOnServerReceivedParams) then
+ Exit;
+
+ xSL := TStringList.Create;
+ try
+ xSL.DelimitedText := aParamsDelimitedText;
+ FOnServerReceivedParams(Self, xSL);
+ finally
+ xSL.Free;
+ end;
+end;
+
+function TBaseSingleInstance.GetStartResult: TSingleInstanceStart;
+begin
+ Result := FStartResult;
+end;
+
end.
More information about the fpc-devel
mailing list