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
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.
_______________________________________________
fpc-devel maillist - fpc-devel@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
