--- Merging r31885 into '.':

A    packages/fcl-base/src/advancedipc.pp
U    packages/fcl-base/fpmake.pp
--- Recording mergeinfo for merge of r31885 into '.':
 U   .
--- Merging r31890 into '.':
U    packages/fcl-base/src/advancedipc.pp
--- Recording mergeinfo for merge of r31890 into '.':
 G   .
--- Merging r31925 into '.':
G    packages/fcl-base/src/advancedipc.pp
--- Recording mergeinfo for merge of r31925 into '.':
 G   .
--- Merging r31939 into '.':
A    packages/fcl-base/examples/testipc_client.pp
A    packages/fcl-base/examples/testipc_server.pp
--- Recording mergeinfo for merge of r31939 into '.':
 G   .
--- Merging r31940 into '.':
G    packages/fcl-base/src/advancedipc.pp
--- Recording mergeinfo for merge of r31940 into '.':
 G   .
--- Merging r31955 into '.':
G    packages/fcl-base/src/advancedipc.pp
--- Recording mergeinfo for merge of r31955 into '.':
 G   .
--- Merging r32287 into '.':
A    packages/fcl-base/examples/sitest.pp
G    packages/fcl-base/fpmake.pp
A    packages/fcl-base/src/singleinstance.pp
U    packages/fcl-base/src/custapp.pp
--- Recording mergeinfo for merge of r32287 into '.':
 G   .
--- Merging r32288 into '.':
G    packages/fcl-base/src/custapp.pp
--- Recording mergeinfo for merge of r32288 into '.':
 G   .
--- Merging r32289 into '.':
G    packages/fcl-base/src/custapp.pp
--- Recording mergeinfo for merge of r32289 into '.':
 G   .
--- Merging r32291 into '.':
G    packages/fcl-base/src/custapp.pp
--- Recording mergeinfo for merge of r32291 into '.':
 G   .
--- Merging r32321 into '.':
U    packages/fcl-base/src/contnrs.pp
--- Recording mergeinfo for merge of r32321 into '.':
 G   .
--- Merging r32767 into '.':
G    packages/fcl-base/src/custapp.pp
--- Recording mergeinfo for merge of r32767 into '.':
 G   .
--- Merging r32770 into '.':
G    packages/fcl-base/src/custapp.pp
G    packages/fcl-base/src/advancedipc.pp
U    packages/fcl-base/src/singleinstance.pp
U    packages/fcl-base/examples/sitest.pp
--- Recording mergeinfo for merge of r32770 into '.':
 G   .
--- Merging r32772 into '.':
G    packages/fcl-base/fpmake.pp
--- Recording mergeinfo for merge of r32772 into '.':
 G   .
--- Merging r32773 into '.':
G    packages/fcl-base/fpmake.pp
--- Recording mergeinfo for merge of r32773 into '.':
 G   .
--- Merging r33052 into '.':
G    packages/fcl-base/src/custapp.pp
--- Recording mergeinfo for merge of r33052 into '.':
 G   .

# revisions: 31885,31890,31925,31939,31940,31955,32287,32288,32289,32291,32321,32767,32770,32772,32773,33052

git-svn-id: branches/fixes_3_0@33398 -

.gitattributes

@@ -1940,6 +1940,7 @@ packages/fcl-base/examples/showver.pp svneol=native#text/plain
 packages/fcl-base/examples/showver.rc -text
 packages/fcl-base/examples/showver.res -text
 packages/fcl-base/examples/simple.xml -text
+packages/fcl-base/examples/sitest.pp svneol=native#text/plain
 packages/fcl-base/examples/sockcli.pp svneol=native#text/plain
 packages/fcl-base/examples/socksvr.pp svneol=native#text/plain
 packages/fcl-base/examples/sstream.pp svneol=native#text/plain
@@ -1956,6 +1957,8 @@ packages/fcl-base/examples/testexprpars.pp svneol=native#text/plain
 packages/fcl-base/examples/testez.pp svneol=native#text/plain
 packages/fcl-base/examples/testhres.pp svneol=native#text/plain
 packages/fcl-base/examples/testini.pp svneol=native#text/plain
+packages/fcl-base/examples/testipc_client.pp svneol=native#text/plain
+packages/fcl-base/examples/testipc_server.pp svneol=native#text/plain
 packages/fcl-base/examples/testmime.pp svneol=native#text/plain
 packages/fcl-base/examples/testnres.pp svneol=native#text/plain
 packages/fcl-base/examples/testol.pp svneol=native#text/plain
@@ -1983,6 +1986,7 @@ packages/fcl-base/examples/tstelgtk.pp svneol=native#text/plain
 packages/fcl-base/examples/txmlreg.pp svneol=native#text/plain
 packages/fcl-base/examples/xmldump.pp svneol=native#text/plain
 packages/fcl-base/fpmake.pp svneol=native#text/plain
+packages/fcl-base/src/advancedipc.pp svneol=native#text/plain
 packages/fcl-base/src/ascii85.pp svneol=native#text/plain
 packages/fcl-base/src/avl_tree.pp svneol=native#text/plain
 packages/fcl-base/src/base64.pp svneol=native#text/plain
@@ -2017,6 +2021,7 @@ packages/fcl-base/src/pooledmm.pp svneol=native#text/plain
 packages/fcl-base/src/rtfdata.inc svneol=native#text/plain
 packages/fcl-base/src/rtfpars.pp svneol=native#text/plain
 packages/fcl-base/src/rttiutils.pp svneol=native#text/plain
+packages/fcl-base/src/singleinstance.pp svneol=native#text/plain
 packages/fcl-base/src/streamcoll.pp svneol=native#text/plain
 packages/fcl-base/src/streamex.pp svneol=native#text/plain
 packages/fcl-base/src/streamio.pp svneol=native#text/plain

packages/fcl-base/examples/sitest.pp

@@ -0,0 +1,104 @@
+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: string;
+  xStringStream: TStringStream;
+begin
+  MsgData.Position := 0;
+  SetLength(xData, MsgData.Size div SizeOf(Char));
+  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.
+

packages/fcl-base/examples/testipc_client.pp

@@ -0,0 +1,97 @@
+program testipc_client;
+
+{$MODE ObjFPC}
+{$H+}
+
+uses
+  Classes, SysUtils, AdvancedIPC;
+
+const
+  STRINGMESSAGE_WANTS_RESPONSE = 3;
+  STRINGMESSAGE_NO_RESPONSE = 2;
+  MESSAGE_STOP = 4;
+
+var
+  xClient, xClientNotRunning: TIPCClient;
+  xStream, xResponseStream: TStringStream;
+  xRequestID: Integer;
+  xMsgType: TMessageType;
+  I: Integer;
+begin
+  xClient := nil;
+  xClientNotRunning := nil;
+  xStream := nil;
+  xResponseStream := nil;
+  try
+    xResponseStream := TStringStream.Create('OK');
+
+    //check connection to to the "hello" server (that has to run)
+
+    xClient := TIPCClient.Create(nil);
+    xClient.ServerID := 'hello';
+
+    if not xClient.ServerRunning then
+    begin
+      Writeln('ERROR: Server '+xClient.ServerID+' is not running.');
+      Writeln('Closing');
+      Exit;
+    end;
+
+    //first send some messages to server that is not running
+    xClientNotRunning := TIPCClient.Create(nil);
+    xClientNotRunning.ServerID := 'not_running';
+
+    if xClientNotRunning.ServerRunning then
+    begin
+      Writeln('ERROR: Server '+xClientNotRunning.ServerID+' is running. This test needs that the server doesn''t run.');
+      Writeln('Closing');
+      Exit;
+    end;
+
+    for I := 1 to 10 do
+    begin
+      FreeAndNil(xStream);
+      xStream := TStringStream.Create('Message '+IntToStr(I));
+      xStream.Position := 0;
+      xClientNotRunning.PostRequest(STRINGMESSAGE_NO_RESPONSE, xStream);
+    end;
+
+    FreeAndNil(xClientNotRunning);
+
+    //now send messages to the "hello" server
+    FreeAndNil(xStream);
+    xStream := TStringStream.Create('I want some response.');
+    xStream.Position := 0;
+    if xClient.SendRequest(STRINGMESSAGE_WANTS_RESPONSE, xStream, 100, xRequestID) and
+       xClient.PeekResponse(xResponseStream, xMsgType, 100)
+    then
+      Writeln('Request-response test OK.')
+    else
+      Writeln('ERROR: Request-response test failed.');
+
+    FreeAndNil(xStream);
+    xStream := TStringStream.Create('I do not want any response.');
+    xStream.Position := 0;
+    if xClient.SendRequest(STRINGMESSAGE_NO_RESPONSE, xStream, 100, xRequestID) then
+    begin
+      if xClient.PeekResponse(xResponseStream, xMsgType, 100) then
+        Writeln('ERROR: I received a response even that I didn''t want any. What happened?')
+      else
+        Writeln('Request test OK.');
+    end else
+      Writeln('ERROR: Request test failed.');
+
+    if xClient.SendRequest(MESSAGE_STOP, nil, 100) and
+       not xClient.ServerRunning
+    then
+      Writeln('Server was sucessfully stopped.')
+    else
+      Writeln('ERROR: I could not stop the server.')
+  finally
+    xClient.Free;
+    xClientNotRunning.Free;
+    xStream.Free;
+    xResponseStream.Free;
+  end;
+end.
+

packages/fcl-base/examples/testipc_server.pp

@@ -0,0 +1,105 @@
+program testipc_server;
+
+{$MODE ObjFPC}
+{$H+}
+
+uses
+  Classes, SysUtils, AdvancedIPC;
+
+const
+  STRINGMESSAGE_WANTS_RESPONSE = 3;
+  STRINGMESSAGE_NO_RESPONSE = 2;
+  MESSAGE_STOP = 4;
+
+var
+  xServer: TIPCServer;
+  xStream, xResponseStream: TStringStream;
+  xMsgID: Integer;
+  xMsgType: TMessageType;
+  xNotRunningMessagesCount: Integer;
+begin
+  xServer := nil;
+  xStream := nil;
+  xResponseStream := nil;
+  try
+    xStream := TStringStream.Create('');
+    xResponseStream := TStringStream.Create('OK');
+
+    //first get all messages from the hello server
+    xServer := TIPCServer.Create(nil);
+    xServer.ServerID := 'hello';
+    xServer.StartServer;
+
+    WriteLn('Server ', xServer.ServerID, ' started.');
+    WriteLn('-----');
+
+    while True do
+    begin
+      if xServer.PeekRequest(xMsgID{%H-}, xMsgType{%H-}) then
+      begin
+        case xMsgType of
+          STRINGMESSAGE_WANTS_RESPONSE, STRINGMESSAGE_NO_RESPONSE:
+          begin
+            xServer.ReadRequest(xMsgID, xStream);
+            WriteLn('Received string message:');
+            WriteLn(xStream.DataString);
+            if xMsgType = STRINGMESSAGE_WANTS_RESPONSE then
+            begin
+              xResponseStream.Position := 0;
+              xServer.PostResponse(xMsgID, STRINGMESSAGE_NO_RESPONSE, xResponseStream);
+              WriteLn('Posting response.');
+            end;
+            WriteLn('-----');
+          end;
+          MESSAGE_STOP:
+          begin
+            WriteLn('Stopping '+xServer.ServerID+' server.');
+            WriteLn('-----');
+            Break;
+          end;
+        end;
+      end else
+        Sleep(50);
+    end;
+
+    FreeAndNil(xServer);
+
+    //now try to get all unhandled messages from the not_running server
+    //please see that the messages are not peeked in the order they have been posted (this is correct/designed behavior).
+    xServer := TIPCServer.Create(nil);
+    xServer.ServerID := 'not_running';
+    xServer.StartServer(False);
+
+    WriteLn('');
+    WriteLn('Server ', xServer.ServerID, ' started.');
+    WriteLn('-----');
+
+    xNotRunningMessagesCount := 0;
+    while xServer.PeekRequest(xStream, xMsgID, xMsgType) do
+    begin
+      if xMsgType = STRINGMESSAGE_NO_RESPONSE then
+      begin
+        WriteLn('Received message: ', xStream.DataString);
+        Inc(xNotRunningMessagesCount);
+      end else
+        WriteLn('ERROR: Wrong message type: ', xMsgType);
+
+      WriteLn('-----');
+    end;
+
+    if xNotRunningMessagesCount <> 10 then
+    begin
+      WriteLn('ERROR: Wrong message count: ', xNotRunningMessagesCount);
+      WriteLn('-----');
+    end;
+
+    WriteLn('Stopping '+xServer.ServerID+' server.');
+    WriteLn('-----');
+    FreeAndNil(xServer);
+  finally
+    xServer.Free;
+    xStream.Free;
+    xResponseStream.Free;
+  end;
+end.
+

packages/fcl-base/fpmake.pp

@@ -52,8 +52,11 @@ begin
       T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('contnrs.pp');
       T.ResourceStrings:=true;
+    T:=P.Targets.AddUnit('singleinstance.pp');
     T:=P.Targets.AddUnit('custapp.pp');
       T.ResourceStrings:=true;
+    with T.Dependencies do
+      AddUnit('singleinstance');
     T:=P.Targets.AddUnit('eventlog.pp');
       T.ResourceStrings:=true;
       with T.Dependencies do
@@ -63,7 +66,9 @@ begin
     T:=P.Targets.AddUnit('fptimer.pp',AllWindowsOSes+AllUnixOSes);
     T:=P.Targets.AddUnit('gettext.pp');
     T:=P.Targets.AddUnit('idea.pp');
+
     T:=P.Targets.AddUnit('inicol.pp');
+
       T.ResourceStrings:=true;
       with T.Dependencies do
         begin
@@ -117,6 +122,8 @@ begin
       AddUnit('csvreadwrite');
       AddUnit('contnrs');
       end;
+    T:=P.Targets.addUnit('advancedipc.pp');
+      T.ResourceStrings:=true;
     // Additional sources
     P.Sources.AddSrcFiles('src/win/fclel.*', P.Directory);
     // Install windows resources

packages/fcl-base/src/advancedipc.pp

@@ -0,0 +1,1094 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2015 by Ondrej Pokorny
+
+    Unit implementing two-way (request/response) IPC between 1 server and more
+    clients, based on files.
+    The order of message processing is not deterministic (if there are more
+    pending messages, the server won't process them in the order they have
+    been sent to the server.
+    SendRequest and PostRequest+PeekResponse sequences from 1 client are
+    blocking and processed in correct order.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit AdvancedIPC;
+
+{$mode objfpc}
+{$H+}
+
+interface
+
+uses
+  {$IFDEF UNIX}
+  baseunix,
+  {$endif}
+  sysutils, Classes, singleinstance;
+
+const
+  HEADER_VERSION = 2;
+
+type
+  TMessageType = LongInt;
+  TMessageHeader = packed record
+    HeaderVersion: Byte;
+    FileLock: Byte;//0 = unlocked, 1 = locked
+    MsgType: TMessageType;
+    MsgLen: Integer;
+    MsgVersion: Integer;
+  end;
+
+  TFileHandle = Classes.THandle;
+
+  TReleaseHandleStream = class(THandleStream)
+  public
+    destructor Destroy; override;
+  end;
+
+  TIPCBase = class(TComponent)
+  private
+    FGlobal: Boolean;
+    FFileName: string;
+    FServerID: string;
+    FMessageVersion: Integer;
+  protected
+    class function ServerIDToFileName(const aServerID: string; const aGlobal: Boolean): string;
+    function GetResponseFileName(const aRequestID: Integer): string;
+    function GetResponseFileName(const aRequestFileName: string): string;
+    function GetPeekedRequestFileName(const aRequestID: Integer): string;
+    function GetPeekedRequestFileName(const aRequestFileName: string): string;
+    function GetRequestPrefix: string;
+    function GetRequestFileName(const aRequestID: Integer): string;
+    function RequestFileNameToID(const aFileName: string): Integer;
+    function RequestExists(const aRequestFileName: string): Boolean;
+
+    procedure SetServerID(const aServerID: string); virtual;
+    procedure SetGlobal(const aGlobal: Boolean); virtual;
+
+    function CanReadMessage(const aFileName: string; out outStream: TStream; out outMsgType: TMessageType; out outMsgLen: Integer): Boolean;
+    procedure DoPostMessage(const aFileName: string; const aMsgType: TMessageType; const aStream: TStream); overload;
+    procedure DoPostMessage(const aFileStream: TFileStream; const aMsgType: TMessageType; const aStream: TStream); overload;
+    function DoReadMessage(const aFileName: string; const aStream: TStream; out outMsgType: TMessageType): Boolean;
+
+    property FileName: string read FFileName;
+  public
+    class procedure FindRunningServers(const aServerIDPrefix: string;
+      const outServerIDs: TStrings; const aGlobal: Boolean = False);
+    class function ServerRunning(const aServerID: string; const aGlobal: Boolean = False): Boolean; overload;
+  public
+    //ServerID: name/ID of the server. Use only ['a'..'z', 'A'..'Z', '0'..'9', '_'] characters
+    property ServerID: string read FServerID write SetServerID;
+    //Global: if true, processes from different users can communicate; false, processes only from current user can communicate
+    property Global: Boolean read FGlobal write SetGlobal;
+    //MessageVersion: only messages with the same MessageVersion can be delivered between server/client
+    property MessageVersion: Integer read FMessageVersion write FMessageVersion;
+  end;
+
+  TIPCClient = class(TIPCBase)
+  private
+    FLastRequestID: Integer;
+
+    function CreateUniqueRequest(out outFileStream: TFileStream): Integer;
+    function DoPeekResponse(const aResponseFileName: string; const aStream: TStream; out outMsgType: TMessageType; const aTimeOut: Integer): Boolean;
+  public
+    constructor Create(aOwner: TComponent); override;
+  public
+    //post request to server, do not wait until request is peeked; returns request ID
+    function PostRequest(const aMsgType: TMessageType; const aStream: TStream): Integer;
+    //send request to server, wait until request is peeked; returns True if request was peeked within the aTimeOut limit
+    function SendRequest(const aMsgType: TMessageType; const aStream: TStream; const aTimeOut: Integer): Boolean;
+    function SendRequest(const aMsgType: TMessageType; const aStream: TStream; const aTimeOut: Integer; out outRequestID: Integer): Boolean;
+    //peek a response from last request from this client
+    function PeekResponse(const aStream: TStream; out outMsgType: TMessageType): Boolean; overload;
+    function PeekResponse(const aStream: TStream; out outMsgType: TMessageType; const aTimeOut: Integer): Boolean; overload;
+    //peek a response from request by ID
+    function PeekResponse(const aRequestID: Integer; const aStream: TStream; out outMsgType: TMessageType): Boolean; overload;
+    function PeekResponse(const aRequestID: Integer; const aStream: TStream; out outMsgType: TMessageType; const aTimeOut: Integer): Boolean; overload;
+    //delete last request from this client, returns true if request file existed and was deleted
+    function DeleteRequest: Boolean; overload;
+    //delete request by ID, returns true if request existed file and was deleted
+    function DeleteRequest(const aRequestID: Integer): Boolean; overload;
+    //check if server is running
+    function ServerRunning: Boolean; overload;
+  end;
+
+  TIPCServer = class(TIPCBase)
+  private
+    FFileHandle: TFileHandle;
+    FActive: Boolean;
+
+    function FindFirstRequest(out outFileName: string; out outStream: TStream; out outMsgType: TMessageType; out outMsgLen: Integer): Integer;
+
+  protected
+    procedure SetServerID(const aServerID: string); override;
+    procedure SetGlobal(const aGlobal: Boolean); override;
+  public
+    constructor Create(aOwner: TComponent); override;
+    destructor Destroy; override;
+  public
+    //peek request and read the message into a stream
+    function PeekRequest(const aStream: TStream; out outMsgType: TMessageType): Boolean; overload;
+    function PeekRequest(const aStream: TStream; out outRequestID: Integer; out outMsgType: TMessageType): Boolean; overload;
+    function PeekRequest(const aStream: TStream; out outRequestID: Integer; out outMsgType: TMessageType; const aTimeOut: Integer): Boolean; overload;
+    //only peek request, you have to read/delete the request manually with ReadRequest/DeleteRequest
+    function PeekRequest(out outMsgType: TMessageType): Boolean; overload;
+    function PeekRequest(out outRequestID: Integer; out outMsgType: TMessageType): Boolean; overload;
+    function PeekRequest(out outRequestID: Integer; out outMsgType: TMessageType; const aTimeOut: Integer): Boolean; overload;
+    //read a peeked request (that hasn't been read yet)
+    function ReadRequest(const aRequestID: Integer; const aStream: TStream): Boolean;
+    //delete a peeked request (that hasn't been read yet), returns true if request file existed and was deleted
+    function DeleteRequest(const aRequestID: Integer): Boolean;
+
+    //post response to a request
+    procedure PostResponse(const aRequestID: Integer; const aMsgType: TMessageType; const aStream: TStream);
+
+    //find the highest request ID from all pending requests
+    function FindHighestPendingRequestId: Integer;
+    //get the pending request count
+    function GetPendingRequestCount: Integer;
+
+    //start server: returns true if unique and started
+    function StartServer(const aDeletePendingRequests: Boolean = True): Boolean;
+    //stop server: returns true if stopped
+    function StopServer(const aDeletePendingRequests: Boolean = True): Boolean;
+
+    //delete all pending requests and responses
+    procedure DeletePendingRequests;
+  public
+    //true if server runs (was started)
+    property Active: Boolean read FActive;
+  end;
+
+  EICPException = class(Exception);
+
+  TSingleInstanceReceivedCustomMessage = procedure(Sender: TBaseSingleInstance; MsgID: Integer; MsgType: Integer; 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: Integer; const aStream: TStream);
+  public
+    constructor Create(aOwner: TComponent); override;
+  public
+    function Start: TSingleInstanceStart; override;
+    procedure Stop; override;
+
+    procedure ServerCheckMessages; override;
+    procedure ClientPostParams; override;
+  public
+    function ClientPostCustomRequest(const aMsgType: Integer; const aStream: TStream): Integer;
+    function ClientSendCustomRequest(const aMsgType: Integer; const aStream: TStream): Boolean; overload;
+    function ClientSendCustomRequest(const aMsgType: Integer; const aStream: TStream; out outRequestID: Integer): Boolean; overload;
+    procedure ServerPostCustomResponse(const aRequestID: Integer; const aMsgType: Integer; const aStream: TStream);
+    function ClientPeekCustomResponse(const aStream: TStream; out outMsgType: Integer): Boolean;
+  public
+    property ID: string read FID write SetID;
+    property Global: Boolean read FGlobal write SetGlobal;
+
+    property OnServerReceivedCustomRequest: TSingleInstanceReceivedCustomMessage read FOnServerReceivedCustomRequest write FOnServerReceivedCustomRequest;
+  end;
+
+resourcestring
+  SErrInvalidServerID = 'Invalid server ID "%s". Please use only alphanumerical characters and underlines.';
+  SErrSetGlobalActive = 'You cannot change the global property when the server is active.';
+  SErrSetServerIDActive = 'You cannot change the server ID when the server is active.';
+
+implementation
+
+type
+  TIPCSearchRec = TRawByteSearchRec;
+
+const
+  {$IFDEF UNIX}
+  GLOBAL_RIGHTS = S_IRUSR or S_IWUSR or S_IRGRP or S_IWGRP or S_IROTH or S_IWOTH;
+  {$ELSE}
+  GLOBAL_RIGHTS = 0;
+  {$ENDIF}
+
+var
+  CreateUniqueRequestCritSec: TRTLCriticalSection;
+
+{ TIPCBase }
+
+function TIPCBase.CanReadMessage(const aFileName: string; out
+  outStream: TStream; out outMsgType: TMessageType; out outMsgLen: Integer
+  ): Boolean;
+var
+  xFileHandle: TFileHandle;
+  xHeader: TMessageHeader;
+begin
+  outStream := nil;
+  outMsgType := -1;
+  outMsgLen := 0;
+  Result := FileExists(aFileName);
+  if not Result then
+    Exit;
+
+  xFileHandle := FileOpen(aFileName, fmOpenRead or fmShareExclusive);
+  Result := xFileHandle <> feInvalidHandle;
+  if not Result then
+    Exit;
+
+  outStream := TReleaseHandleStream.Create(xFileHandle);
+
+  Result := (outStream.Size >= SizeOf(xHeader));
+  if not Result then
+  begin
+    FreeAndNil(outStream);
+    Exit;
+  end;
+
+  outStream.ReadBuffer(xHeader{%H-}, SizeOf(xHeader));
+  Result :=
+    (xHeader.HeaderVersion = HEADER_VERSION) and (xHeader.FileLock = 0) and
+    (xHeader.MsgVersion = MessageVersion) and
+    (outStream.Size = Int64(SizeOf(xHeader))+Int64(xHeader.MsgLen));
+  if not Result then
+  begin
+    FreeAndNil(outStream);
+    Exit;
+  end;
+  outMsgType := xHeader.MsgType;
+  outMsgLen := xHeader.MsgLen;
+end;
+
+function TIPCBase.DoReadMessage(const aFileName: string;
+  const aStream: TStream; out outMsgType: TMessageType): Boolean;
+var
+  xStream: TStream;
+  xMsgLen: Integer;
+begin
+  aStream.Size := 0;
+  xStream := nil;
+  try
+    Result := CanReadMessage(aFileName, xStream, outMsgType, xMsgLen);
+    if Result then
+    begin
+      if xMsgLen > 0 then
+        aStream.CopyFrom(xStream, xMsgLen);
+      FreeAndNil(xStream);
+      aStream.Position := 0;
+      DeleteFile(aFileName);
+    end;
+  finally
+    xStream.Free;
+  end;
+end;
+
+function TIPCBase.RequestExists(const aRequestFileName: string): Boolean;
+begin
+  Result :=
+    (FileExists(aRequestFileName) or
+     FileExists(GetResponseFileName(aRequestFileName)) or
+     FileExists(GetPeekedRequestFileName(aRequestFileName)));
+end;
+
+class function TIPCBase.ServerRunning(const aServerID: string;
+  const aGlobal: Boolean): Boolean;
+var
+  xServerFileHandle: TFileHandle;
+  xFileName: String;
+begin
+  xFileName := ServerIDToFileName(aServerID, aGlobal);
+  Result := FileExists(xFileName);
+  if Result then
+  begin//+ check -> we should not be able to access the file
+    xServerFileHandle := FileCreate(xFileName, fmOpenReadWrite or fmShareExclusive, GLOBAL_RIGHTS);
+    Result := (xServerFileHandle=feInvalidHandle);
+    if not Result then
+      FileClose(xServerFileHandle);
+  end;
+end;
+
+class function TIPCBase.ServerIDToFileName(const aServerID: string;
+  const aGlobal: Boolean): string;
+begin
+  Result := GetTempDir(aGlobal)+aServerID;
+end;
+
+procedure TIPCBase.SetGlobal(const aGlobal: Boolean);
+begin
+  if FGlobal = aGlobal then Exit;
+
+  FGlobal := aGlobal;
+  FFileName := ServerIDToFileName(FServerID, FGlobal);
+end;
+
+procedure TIPCBase.DoPostMessage(const aFileName: string;
+  const aMsgType: TMessageType; const aStream: TStream);
+var
+  xStream: TFileStream;
+begin
+  xStream := TFileStream.Create(aFileName, fmCreate or fmShareExclusive, GLOBAL_RIGHTS);
+  try
+    DoPostMessage(xStream, aMsgType, aStream);
+  finally
+    xStream.Free;
+  end;
+end;
+
+procedure TIPCBase.DoPostMessage(const aFileStream: TFileStream;
+  const aMsgType: TMessageType; const aStream: TStream);
+var
+  xHeader: TMessageHeader;
+begin
+  xHeader.HeaderVersion := HEADER_VERSION;
+  xHeader.FileLock := 1;//locking
+  xHeader.MsgType := aMsgType;
+  if Assigned(aStream) then
+    xHeader.MsgLen := aStream.Size-aStream.Position
+  else
+    xHeader.MsgLen := 0;
+  xHeader.MsgVersion := MessageVersion;
+
+  aFileStream.WriteBuffer(xHeader, SizeOf(xHeader));
+  if Assigned(aStream) and (aStream.Size-aStream.Position > 0) then
+    aFileStream.CopyFrom(aStream, aStream.Size-aStream.Position);
+
+  aFileStream.Position := 0;//unlocking
+  xHeader.FileLock := 0;
+  aFileStream.WriteBuffer(xHeader, SizeOf(xHeader));
+  aFileStream.Seek(0, soEnd);
+end;
+
+function TIPCBase.RequestFileNameToID(const aFileName: string): Integer;
+begin
+  //the function prevents all responses/temp files to be handled
+  //only valid response files are returned
+  if (Length(aFileName) > 9) and (aFileName[Length(aFileName)-8] = '-') then
+    Result := StrToIntDef('$'+Copy(aFileName, Length(aFileName)-7, 8), -1)
+  else
+    Result := -1;
+end;
+
+class procedure TIPCBase.FindRunningServers(const aServerIDPrefix: string;
+  const outServerIDs: TStrings; const aGlobal: Boolean);
+var
+  xRec: TIPCSearchRec;
+begin
+  if FindFirst(ServerIDToFileName(aServerIDPrefix+AllFilesMask, aGlobal), faAnyFile, xRec) = 0 then
+  begin
+    repeat
+      if (Pos('-', xRec.Name) = 0) and//file that we found is a pending message
+         ServerRunning(xRec.Name, aGlobal)
+      then
+        outServerIDs.Add(xRec.Name);
+    until FindNext(xRec) <> 0;
+  end;
+  FindClose(xRec);
+end;
+
+function TIPCBase.GetPeekedRequestFileName(const aRequestID: Integer): string;
+begin
+  Result := GetPeekedRequestFileName(GetRequestFileName(aRequestID));
+end;
+
+function TIPCBase.GetPeekedRequestFileName(const aRequestFileName: string
+  ): string;
+begin
+  Result := aRequestFileName+'-t';
+end;
+
+function TIPCBase.GetRequestFileName(const aRequestID: Integer): string;
+begin
+  Result := GetRequestPrefix+IntToHex(aRequestID, 8);
+end;
+
+function TIPCBase.GetRequestPrefix: string;
+begin
+  Result := FFileName+'-';
+end;
+
+function TIPCBase.GetResponseFileName(const aRequestID: Integer): string;
+begin
+  Result := GetResponseFileName(GetRequestFileName(aRequestID));
+end;
+
+function TIPCBase.GetResponseFileName(const aRequestFileName: string): string;
+begin
+  Result := aRequestFileName+'-r';
+end;
+
+procedure TIPCBase.SetServerID(const aServerID: string);
+var
+  I: Integer;
+begin
+  if FServerID = aServerID then Exit;
+
+  for I := 1 to Length(aServerID) do
+  if not (aServerID[I] in ['a'..'z', 'A'..'Z', '0'..'9', '_']) then
+    raise EICPException.CreateFmt(SErrInvalidServerID , [aServerID]);
+
+  FServerID := aServerID;
+
+  FFileName := ServerIDToFileName(FServerID, FGlobal);
+end;
+
+{ TIPCClient }
+
+constructor TIPCClient.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+
+  FLastRequestID := -1;
+end;
+
+function TIPCClient.DeleteRequest(const aRequestID: Integer): Boolean;
+var
+  xRequestFileName: string;
+begin
+  xRequestFileName := GetRequestFileName(aRequestID);
+  Result := DeleteFile(xRequestFileName);
+  if (aRequestID = FLastRequestID) and not FileExists(xRequestFileName) then
+    FLastRequestID := -1;
+end;
+
+function TIPCClient.DeleteRequest: Boolean;
+begin
+  if FLastRequestID >= 0 then
+    Result := DeleteRequest(FLastRequestID)
+  else
+    Result := False;
+end;
+
+function TIPCClient.DoPeekResponse(const aResponseFileName: string;
+  const aStream: TStream; out outMsgType: TMessageType; const aTimeOut: Integer
+  ): Boolean;
+var
+  xStart: QWord;
+begin
+  aStream.Size := 0;
+  Result := False;
+  xStart := GetTickCount64;
+  repeat
+    if DoReadMessage(aResponseFileName, aStream, outMsgType) then
+      Exit(True)
+    else if aTimeOut > 20 then
+      Sleep(10);
+  until (GetTickCount64-xStart > aTimeOut);
+end;
+
+function TIPCClient.CreateUniqueRequest(out outFileStream: TFileStream): Integer;
+var
+  xFileName: string;
+begin
+  outFileStream := nil;
+  EnterCriticalsection(CreateUniqueRequestCritSec);
+  try
+    Randomize;
+    repeat
+      //if Randomize/Random is started from 2 processes at exactly same moment, it returns the same number! -> prevent duplicates by xor GetProcessId
+      //the result must be of range 0..$7FFFFFFF (High(Integer))
+      Result := Integer((PtrInt(Random($7FFFFFFF)) xor PtrInt(GetProcessID)) and $7FFFFFFF);
+      xFileName := GetRequestFileName(Result);
+    until not RequestExists(xFileName);
+
+    outFileStream := TFileStream.Create(xFileName, fmCreate or fmShareExclusive, GLOBAL_RIGHTS);
+  finally
+    LeaveCriticalsection(CreateUniqueRequestCritSec);
+  end;
+end;
+
+function TIPCClient.PeekResponse(const aRequestID: Integer;
+  const aStream: TStream; out outMsgType: TMessageType): Boolean;
+begin
+  Result := DoReadMessage(GetResponseFileName(aRequestID), aStream, outMsgType);
+end;
+
+function TIPCClient.PeekResponse(const aRequestID: Integer;
+  const aStream: TStream; out outMsgType: TMessageType; const aTimeOut: Integer
+  ): Boolean;
+begin
+  Result := DoPeekResponse(GetResponseFileName(aRequestID), aStream, outMsgType, aTimeOut);
+end;
+
+function TIPCClient.PeekResponse(const aStream: TStream; out
+  outMsgType: TMessageType): Boolean;
+begin
+  Result := DoReadMessage(GetResponseFileName(FLastRequestID), aStream, outMsgType);
+end;
+
+function TIPCClient.PeekResponse(const aStream: TStream; out
+  outMsgType: TMessageType; const aTimeOut: Integer): Boolean;
+begin
+  Result := DoPeekResponse(GetResponseFileName(FLastRequestID), aStream, outMsgType, aTimeOut);
+end;
+
+function TIPCClient.PostRequest(const aMsgType: TMessageType;
+  const aStream: TStream): Integer;
+var
+  xRequestFileStream: TFileStream;
+begin
+  xRequestFileStream := nil;
+  try
+    Result := CreateUniqueRequest(xRequestFileStream);
+    DoPostMessage(xRequestFileStream, aMsgType, aStream);
+  finally
+    xRequestFileStream.Free;
+  end;
+  FLastRequestID := Result;
+end;
+
+function TIPCClient.SendRequest(const aMsgType: TMessageType;
+  const aStream: TStream; const aTimeOut: Integer): Boolean;
+var
+  xRequestID: Integer;
+begin
+  Result := SendRequest(aMsgType, aStream, aTimeOut, xRequestID);
+end;
+
+function TIPCClient.SendRequest(const aMsgType: TMessageType;
+  const aStream: TStream; const aTimeOut: Integer; out outRequestID: Integer
+  ): Boolean;
+var
+  xStart: QWord;
+  xRequestFileName: string;
+begin
+  outRequestID := PostRequest(aMsgType, aStream);
+  Result := False;
+
+  xRequestFileName := GetRequestFileName(outRequestID);
+  xStart := GetTickCount64;
+  repeat
+    if not FileExists(xRequestFileName) then
+      Exit(True)
+    else if aTimeOut > 20 then
+      Sleep(10);
+  until (GetTickCount64-xStart > aTimeOut);
+end;
+
+function TIPCClient.ServerRunning: Boolean;
+begin
+  Result := ServerRunning(ServerID, Global);
+end;
+
+{ TReleaseHandleStream }
+
+destructor TReleaseHandleStream.Destroy;
+begin
+  FileClose(Handle);
+
+  inherited Destroy;
+end;
+
+{ TIPCServer }
+
+procedure TIPCServer.DeletePendingRequests;
+var
+  xRec: TIPCSearchRec;
+  xDir: string;
+begin
+  xDir := ExtractFilePath(FFileName);
+  if FindFirst(GetRequestPrefix+AllFilesMask, faAnyFile, xRec) = 0 then
+  begin
+    repeat
+      DeleteFile(xDir+xRec.Name);
+    until FindNext(xRec) <> 0;
+  end;
+  FindClose(xRec);
+end;
+
+function TIPCServer.DeleteRequest(const aRequestID: Integer): Boolean;
+begin
+  Result := DeleteFile(GetPeekedRequestFileName(aRequestID));
+end;
+
+constructor TIPCServer.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+
+  FFileHandle := feInvalidHandle;
+end;
+
+destructor TIPCServer.Destroy;
+begin
+  if Active then
+    StopServer;
+
+  inherited Destroy;
+end;
+
+function TIPCServer.FindFirstRequest(out outFileName: string; out
+  outStream: TStream; out outMsgType: TMessageType; out outMsgLen: Integer
+  ): Integer;
+var
+  xRec: TIPCSearchRec;
+begin
+  outFileName := '';
+  outStream := nil;
+  outMsgType := -1;
+  outMsgLen := 0;
+  Result := -1;
+  if FindFirst(GetRequestPrefix+AllFilesMask, faAnyFile, xRec) = 0 then
+  begin
+    repeat
+      Result := RequestFileNameToID(xRec.Name);
+      if Result >= 0 then
+      begin
+        outFileName := GetRequestFileName(Result);
+        if not CanReadMessage(outFileName, outStream, outMsgType, outMsgLen) then
+          Result := -1;
+      end;
+    until (Result >= 0) or (FindNext(xRec) <> 0);
+  end;
+  FindClose(xRec);
+end;
+
+function TIPCServer.FindHighestPendingRequestId: Integer;
+var
+  xRec: TIPCSearchRec;
+  xRequestID: LongInt;
+begin
+  Result := -1;
+  if FindFirst(GetRequestPrefix+AllFilesMask, faAnyFile, xRec) = 0 then
+  begin
+    repeat
+      xRequestID := RequestFileNameToID(xRec.Name);
+      if xRequestID > Result then
+        Result := xRequestID;
+    until FindNext(xRec) <> 0;
+  end;
+  FindClose(xRec);
+end;
+
+function TIPCServer.GetPendingRequestCount: Integer;
+var
+  xRec: TIPCSearchRec;
+begin
+  Result := 0;
+  if FindFirst(GetRequestPrefix+AllFilesMask, faAnyFile, xRec) = 0 then
+  begin
+    repeat
+      if RequestFileNameToID(xRec.Name) >= 0 then
+        Inc(Result);
+    until FindNext(xRec) <> 0;
+  end;
+  FindClose(xRec);
+end;
+
+function TIPCServer.PeekRequest(out outRequestID: Integer; out
+  outMsgType: TMessageType): Boolean;
+var
+  xStream: TStream;
+  xMsgLen: Integer;
+  xMsgFileName: string;
+begin
+  outMsgType := -1;
+  xMsgFileName := '';
+  xStream := nil;
+  try
+    outRequestID := FindFirstRequest(xMsgFileName, xStream, outMsgType, xMsgLen);
+    Result := outRequestID >= 0;
+    if Result then
+    begin
+      FreeAndNil(xStream);
+      RenameFile(xMsgFileName, GetPeekedRequestFileName(xMsgFileName));
+    end;
+  finally
+    xStream.Free;
+  end;
+end;
+
+function TIPCServer.PeekRequest(out outRequestID: Integer; out
+  outMsgType: TMessageType; const aTimeOut: Integer): Boolean;
+var
+  xStart: QWord;
+begin
+  Result := False;
+  xStart := GetTickCount64;
+  repeat
+    if PeekRequest(outRequestID, outMsgType) then
+      Exit(True)
+    else if aTimeOut > 20 then
+      Sleep(10);
+  until (GetTickCount64-xStart > aTimeOut);
+end;
+
+function TIPCServer.PeekRequest(out outMsgType: TMessageType): Boolean;
+var
+  xRequestID: Integer;
+begin
+  Result := PeekRequest(xRequestID, outMsgType);
+end;
+
+function TIPCServer.PeekRequest(const aStream: TStream; out outRequestID: Integer;
+  out outMsgType: TMessageType): Boolean;
+begin
+  Result := PeekRequest(outRequestID, outMsgType);
+  if Result then
+    Result := ReadRequest(outRequestID, aStream);
+end;
+
+function TIPCServer.PeekRequest(const aStream: TStream; out outRequestID: Integer;
+  out outMsgType: TMessageType; const aTimeOut: Integer): Boolean;
+begin
+  Result := PeekRequest(outRequestID, outMsgType, aTimeOut);
+  if Result then
+    Result := ReadRequest(outRequestID, aStream);
+end;
+
+function TIPCServer.PeekRequest(const aStream: TStream; out
+  outMsgType: TMessageType): Boolean;
+var
+  xRequestID: Integer;
+begin
+  Result := PeekRequest(aStream, xRequestID, outMsgType);
+end;
+
+procedure TIPCServer.PostResponse(const aRequestID: Integer;
+  const aMsgType: TMessageType; const aStream: TStream);
+begin
+  DoPostMessage(GetResponseFileName(aRequestID), aMsgType, aStream);
+end;
+
+function TIPCServer.ReadRequest(const aRequestID: Integer; const aStream: TStream
+  ): Boolean;
+var
+  xMsgType: TMessageType;
+begin
+  Result := DoReadMessage(GetPeekedRequestFileName(aRequestID), aStream, xMsgType);
+end;
+
+procedure TIPCServer.SetGlobal(const aGlobal: Boolean);
+begin
+  if Active then
+    raise EICPException.Create(SErrSetGlobalActive);
+
+  inherited SetGlobal(aGlobal);
+end;
+
+procedure TIPCServer.SetServerID(const aServerID: string);
+begin
+  if Active then
+    raise EICPException.Create(SErrSetServerIDActive);
+
+  inherited SetServerID(aServerID);
+end;
+
+function TIPCServer.StartServer(const aDeletePendingRequests: Boolean): Boolean;
+begin
+  if Active then
+    Exit(True);
+
+  FFileHandle := FileCreate(FFileName, fmCreate or fmShareExclusive, GLOBAL_RIGHTS);
+  Result := (FFileHandle<>feInvalidHandle);
+  FActive := Result;
+  if Result and aDeletePendingRequests then
+    DeletePendingRequests;
+end;
+
+function TIPCServer.StopServer(const aDeletePendingRequests: Boolean): Boolean;
+begin
+  if not Active then
+    Exit(True);
+
+  if FFileHandle<>feInvalidHandle then
+    FileClose(FFileHandle);
+  Result := DeleteFile(FFileName);
+
+  if aDeletePendingRequests then
+    DeletePendingRequests;
+
+  FActive := False;
+end;
+
+Resourcestring
+  SErrSetSingleInstanceIDStarted = 'You cannot change the single instance ID when it''s been started.';
+  SErrSetSingleInstanceGlobalStarted = 'You cannot change the single instance global property when it''s been started.';
+  SErrStartSingleInstanceStarted = 'You cannot start single instance when it''s been already started.';
+  SErrSingleInstanceStartResultNotAvailable = 'Single instance hasn''t been started yet.';
+  SErrSingleInstanceNotClient = 'Current instance is not a client.';
+  SErrSingleInstanceNotServer = 'Current instance is not a server.';
+
+Const
+  MSGTYPE_CHECK = -1;
+  MSGTYPE_CHECKRESPONSE = -2;
+  MSGTYPE_PARAMS = -3;
+  MSGTYPE_WAITFORINSTANCES = -4;
+
+{ TAdvancedSingleInstance }
+
+constructor TAdvancedSingleInstance.Create(aOwner: TComponent);
+var
+  xID: RawByteString;
+  I: Integer;
+begin
+  inherited Create(aOwner);
+
+  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 TAdvancedSingleInstance.ClientPeekCustomResponse(
+  const aStream: TStream; out outMsgType: Integer): Boolean;
+begin
+  if not Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
+
+  Result := FClient.PeekResponse(aStream, outMsgType, TimeOutMessages);
+end;
+
+function TAdvancedSingleInstance.ClientPostCustomRequest(
+  const aMsgType: Integer; const aStream: TStream): Integer;
+begin
+  if not Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
+
+  Result := FClient.PostRequest(aMsgType, aStream);
+end;
+
+procedure TAdvancedSingleInstance.ClientPostParams;
+var
+  xSL: TStringList;
+  xStringStream: TStringStream;
+  I: Integer;
+begin
+  if not Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
+
+  xSL := TStringList.Create;
+  try
+    for I := 0 to ParamCount do
+      xSL.Add(ParamStr(I));
+
+    xStringStream := TStringStream.Create(xSL.DelimitedText);
+    try
+      xStringStream.Position := 0;
+      FClient.PostRequest(MSGTYPE_PARAMS, xStringStream);
+    finally
+      xStringStream.Free;
+    end;
+  finally
+    xSL.Free;
+  end;
+end;
+
+function TAdvancedSingleInstance.ClientSendCustomRequest(
+  const aMsgType: Integer; const aStream: TStream): Boolean;
+begin
+  if not Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
+
+  Result := FClient.SendRequest(aMsgType, aStream, TimeOutMessages);
+end;
+
+function TAdvancedSingleInstance.ClientSendCustomRequest(
+  const aMsgType: Integer; const aStream: TStream; out
+  outRequestID: Integer): Boolean;
+begin
+  if not Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
+
+  Result := FClient.SendRequest(aMsgType, aStream, TimeOutMessages, outRequestID);
+end;
+
+procedure TAdvancedSingleInstance.DoServerReceivedCustomRequest(
+  const aMsgID: Integer; const aMsgType: Integer; const aStream: TStream);
+begin
+  if Assigned(FOnServerReceivedCustomRequest) then
+    FOnServerReceivedCustomRequest(Self, aMsgID, aMsgType, aStream);
+end;
+
+function TAdvancedSingleInstance.GetIsClient: Boolean;
+begin
+  Result := Assigned(FClient);
+end;
+
+function TAdvancedSingleInstance.GetIsServer: Boolean;
+begin
+  Result := Assigned(FServer);
+end;
+
+function TAdvancedSingleInstance.GetStartResult: TSingleInstanceStart;
+begin
+  if not(Assigned(FServer) or Assigned(FClient)) then
+    raise ESingleInstance.Create(SErrSingleInstanceStartResultNotAvailable);
+
+  Result := inherited GetStartResult;
+end;
+
+procedure TAdvancedSingleInstance.ServerCheckMessages;
+var
+  xMsgID: Integer;
+  xMsgType: Integer;
+  xStream: TStream;
+  xStringStream: TStringStream;
+begin
+  if not Assigned(FServer) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotServer);
+
+  if not FServer.PeekRequest(xMsgID, xMsgType) then
+    Exit;
+
+  case xMsgType of
+    MSGTYPE_CHECK:
+    begin
+      FServer.DeleteRequest(xMsgID);
+      FServer.PostResponse(xMsgID, MSGTYPE_CHECKRESPONSE, nil);
+    end;
+    MSGTYPE_PARAMS:
+    begin
+      xStringStream := TStringStream.Create('');
+      try
+        FServer.ReadRequest(xMsgID, xStringStream);
+        DoServerReceivedParams(xStringStream.DataString);
+      finally
+        xStringStream.Free;
+      end;
+    end;
+    MSGTYPE_WAITFORINSTANCES:
+      FServer.DeleteRequest(xMsgID);
+  else
+    xStream := TMemoryStream.Create;
+    try
+      FServer.ReadRequest(xMsgID, xStream);
+      DoServerReceivedCustomRequest(xMsgID, xMsgType, xStream);
+    finally
+      xStream.Free;
+    end;
+  end;
+end;
+
+procedure TAdvancedSingleInstance.ServerPostCustomResponse(
+  const aRequestID: Integer; const aMsgType: Integer;
+  const aStream: TStream);
+begin
+  if not Assigned(FServer) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotServer);
+
+  FServer.PostResponse(aRequestID, aMsgType, aStream);
+end;
+
+procedure TAdvancedSingleInstance.SetGlobal(const aGlobal: Boolean);
+begin
+  if FGlobal = aGlobal then Exit;
+  if Assigned(FServer) or Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSetSingleInstanceGlobalStarted);
+  FGlobal := aGlobal;
+end;
+
+procedure TAdvancedSingleInstance.SetID(const aID: string);
+begin
+  if FID = aID then Exit;
+  if Assigned(FServer) or Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSetSingleInstanceIDStarted);
+  FID := aID;
+end;
+
+function TAdvancedSingleInstance.Start: TSingleInstanceStart;
+  {$IFNDEF MSWINDOWS}
+  procedure UnixWorkaround(var bServerStarted: Boolean);
+  var
+    xWaitRequestID, xLastCount, xNewCount: Integer;
+    xClient: TIPCClient;
+  begin
+    //file locking workaround for UNIX systems -> the server can be started twice if 2 processes are started in parallel
+    //wait some time to see other clients
+    FServer.StopServer(False);
+    xClient := TIPCClient.Create(Self);
+    try
+      xClient.ServerID := FID;
+      xClient.Global := FGlobal;
+      xWaitRequestID := xClient.PostRequest(MSGTYPE_WAITFORINSTANCES, nil);
+      xLastCount := -1;
+      xNewCount := FServer.GetPendingRequestCount;
+      while xLastCount <> xNewCount do
+      begin
+        xLastCount := xNewCount;
+        Sleep(TimeOutWaitForInstances);
+        xNewCount := FServer.GetPendingRequestCount;
+      end;
+    finally
+      FreeAndNil(xClient);
+    end;
+
+    //find highest client that will be the server
+    if FServer.FindHighestPendingRequestId = xWaitRequestID then
+    begin
+      bServerStarted := FServer.StartServer(False);
+    end else
+    begin
+      //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(GetProcessID)) and $3F));//limit to $3F (63)
+      bServerStarted := FServer.StartServer(False) and (FServer.GetPendingRequestCount > 0);
+    end;
+  end;
+  {$ENDIF}
+var
+  xStream: TStream;
+  xMsgType: Integer;
+  xServerStarted: Boolean;
+begin
+  if Assigned(FServer) or Assigned(FClient) then
+    raise ESingleInstance.Create(SErrStartSingleInstanceStarted);
+
+  FServer := TIPCServer.Create(Self);
+  FServer.ServerID := FID;
+  FServer.Global := FGlobal;
+  xServerStarted := FServer.StartServer(False);
+  if xServerStarted then
+  begin//this is single instance -> be server
+    Result := siServer;
+    {$IFNDEF MSWINDOWS}
+    UnixWorkaround(xServerStarted);
+    {$ENDIF}
+  end;
+  if not xServerStarted then
+  begin//instance found -> be client
+    FreeAndNil(FServer);
+    FClient := TIPCClient.Create(Self);
+    FClient.ServerID := FID;
+    FClient.Global := FGlobal;
+    FClient.PostRequest(MSGTYPE_CHECK, nil);
+    xStream := TMemoryStream.Create;
+    try
+      if FClient.PeekResponse(xStream, xMsgType, TimeOutMessages) then
+        Result := siClient
+      else
+        Result := siNotResponding;
+    finally
+      xStream.Free;
+    end;
+  end;
+  SetStartResult(Result);
+end;
+
+procedure TAdvancedSingleInstance.Stop;
+begin
+  FreeAndNil(FServer);
+  FreeAndNil(FClient);
+end;
+
+initialization
+  InitCriticalSection(CreateUniqueRequestCritSec);
+  DefaultSingleInstanceClass:=TAdvancedSingleInstance;
+
+finalization
+  DoneCriticalsection(CreateUniqueRequestCritSec);
+
+end.

packages/fcl-base/src/contnrs.pp

@@ -481,7 +481,7 @@ type
     Function Iterate(aMethod: TObjectIteratorMethod): TObject; virtual;
     Procedure Add(const aKey: string; AItem : TObject); virtual;
     property Items[const index: string]: TObject read GetData write SetData; default;
-    Property OwnsObjects : Boolean Read FOwnsObjects Write FOwnsObjects;
+    Property OwnsObjects : Boolean Read FOwnsObjects;
   end;
 
   EDuplicate = class(Exception);

packages/fcl-base/src/custapp.pp

@@ -18,9 +18,10 @@ unit CustApp;
 
 Interface
 
-uses SysUtils,Classes;
+uses SysUtils,Classes,singleinstance;
 
 Type
+  TStringArray = Array of string;
   TExceptionEvent = Procedure (Sender : TObject; E : Exception) Of Object;
   TEventLogTypes = Set of TEventType;
 
@@ -30,17 +31,25 @@ Type
   Private
     FEventLogFilter: TEventLogTypes;
     FOnException: TExceptionEvent;
+    FSingleInstance: TBaseSingleInstance;
+    FSingleInstanceClass: TBaseSingleInstanceClass; // set before FSingleInstance is created
+    FSingleInstanceEnabled: Boolean; // set before Initialize is called
     FTerminated : Boolean;
     FHelpFile,
     FTitle : String;
     FOptionChar : Char;
     FCaseSensitiveOptions : Boolean;
     FStopOnException : Boolean;
+    FExceptionExitCode : Integer;
     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;
     procedure SetTitle(const AValue: string); Virtual;
     Function GetConsoleApplication : boolean; Virtual;
     Procedure DoRun; Virtual;
@@ -56,10 +65,12 @@ Type
     procedure Run;
     procedure ShowException(E: Exception);virtual;
     procedure Terminate; virtual;
+    procedure Terminate(AExitCode : Integer) ; virtual;
     // Extra methods.
-    function FindOptionIndex(Const S : String; Var Longopt : Boolean) : Integer;
+    function FindOptionIndex(Const S : String; Var Longopt : Boolean; StartAt : Integer = -1) : Integer;
     Function GetOptionValue(Const S : String) : String;
     Function GetOptionValue(Const C: Char; Const S : String) : String;
+    Function GetOptionValues(Const C: Char; Const S : String) : TStringArray;
     Function HasOption(Const S : String) : Boolean;
     Function HasOption(Const C : Char; Const S : String) : Boolean;
     Function CheckOptions(Const ShortOptions : String; Const Longopts : TStrings; Opts,NonOpts : TStrings; AllErrors : Boolean = False) : String;
@@ -67,9 +78,12 @@ Type
     Function CheckOptions(Const ShortOptions : String; Const Longopts : TStrings; AllErrors : Boolean = False) : String;
     Function CheckOptions(Const ShortOptions : String; Const LongOpts : Array of string; AllErrors : Boolean = False) : String;
     Function CheckOptions(Const ShortOptions : String; Const LongOpts : String; AllErrors : Boolean = False) : String;
+    Function GetNonOptions(Const ShortOptions : String; Const Longopts : Array of string) : TStringArray;
+    Procedure GetNonOptions(Const ShortOptions : String; Const Longopts : Array of string; NonOptions : TStrings);
     Procedure GetEnvironmentList(List : TStrings;NamesOnly : Boolean);
     Procedure GetEnvironmentList(List : TStrings);
     Procedure Log(EventType : TEventType; const Msg : String);
+    Procedure Log(EventType : TEventType; const Fmt : String; const Args : array of const);
     // Delphi properties
     property ExeName: string read GetExeName;
     property HelpFile: string read FHelpFile write FHelpFile;
@@ -85,7 +99,11 @@ Type
     Property OptionChar : Char Read FoptionChar Write FOptionChar;
     Property CaseSensitiveOptions : Boolean Read FCaseSensitiveOptions Write FCaseSensitiveOptions;
     Property StopOnException : Boolean Read FStopOnException Write FStopOnException;
+    Property ExceptionExitCode : Longint Read FExceptionExitCode Write FExceptionExitCode;
     Property EventLogFilter : TEventLogTypes Read FEventLogFilter Write FEventLogFilter;
+    Property SingleInstance: TBaseSingleInstance read GetSingleInstance;
+    Property SingleInstanceClass: TBaseSingleInstanceClass read FSingleInstanceClass write SetSingleInstanceClass;
+    Property SingleInstanceEnabled: Boolean read FSingleInstanceEnabled write FSingleInstanceEnabled;
   end;
 
 var CustomApplication : TCustomApplication = nil;
@@ -216,6 +234,17 @@ begin
   Result:=ParamStr(Index);
 end;
 
+function TCustomApplication.GetSingleInstance: TBaseSingleInstance;
+begin
+  if FSingleInstance = nil then
+    begin
+    if FSingleInstanceClass=Nil then
+      Raise ESingleInstance.Create('No single instance provider class set! Include a single-instance class unit such as advsingleinstance');
+    FSingleInstance := FSingleInstanceClass.Create(Self);
+    end;
+  Result := FSingleInstance;
+end;
+
 procedure TCustomApplication.SetTitle(const AValue: string);
 begin
   FTitle:=AValue;
@@ -228,7 +257,11 @@ end;
 
 procedure TCustomApplication.DoRun;
 begin
-  // Do nothing. Override in descendent classes.
+  if Assigned(FSingleInstance) then
+    if FSingleInstance.IsServer then
+      FSingleInstance.ServerCheckMessages;
+
+  // Override in descendent classes.
 end;
 
 procedure TCustomApplication.DoLog(EventType: TEventType; const Msg: String);
@@ -244,12 +277,24 @@ begin
     DoLog(EventType,Msg);
 end;
 
+procedure TCustomApplication.Log(EventType: TEventType; const Fmt: String;
+  const Args: array of const);
+begin
+  try
+    Log(EventType, Format(Fmt, Args));
+  except
+    On E : Exception do
+      Log(etError,Format('Error formatting message "%s" with %d arguments: %s',[Fmt,Length(Args),E.Message]));
+  end  
+end;
+
 constructor TCustomApplication.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FOptionChar:='-';
   FCaseSensitiveOptions:=True;
   FStopOnException:=False;
+  FSingleInstanceClass := DefaultSingleInstanceClass;
 end;
 
 destructor TCustomApplication.Destroy;
@@ -269,13 +314,25 @@ begin
       FOnException(Sender,Exception(ExceptObject));
     end;
   If FStopOnException then
-    FTerminated:=True;
+    Terminate(ExceptionExitCode);
 end;
 
 
 procedure TCustomApplication.Initialize;
 begin
   FTerminated:=False;
+  if FSingleInstanceEnabled then
+  begin
+    case SingleInstance.Start of
+      siClient:
+      begin
+        SingleInstance.ClientPostParams;
+        FTerminated:=True;
+      end;
+      siNotResponding:
+        FTerminated:=True;
+    end;
+  end;
 end;
 
 procedure TCustomApplication.Run;
@@ -290,6 +347,13 @@ begin
   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
@@ -297,10 +361,46 @@ begin
 end;
 
 procedure TCustomApplication.Terminate;
+begin
+  Terminate(0);
+end;
+
+procedure TCustomApplication.Terminate(AExitCode : Integer) ;
+
 begin
   FTerminated:=True;
+  If (AExitCode<>0) then
+    ExitCode:=AExitCode;
 end;
 
+function TCustomApplication.GetOptionAtIndex(AIndex : Integer; IsLong: Boolean): String;
+
+Var
+  P : Integer;
+  O : String;
+
+begin
+  Result:='';
+  If (AIndex=-1) then
+    Exit;
+  If IsLong then
+    begin // Long options have form --option=value
+    O:=Params[AIndex];
+    P:=Pos('=',O);
+   If (P=0) then
+      P:=Length(O);
+    Delete(O,1,P);
+    Result:=O;
+    end
+  else
+    begin // short options have form '-o value'
+    If (AIndex<ParamCount) then
+      if (Copy(Params[AIndex+1],1,1)<>'-') then
+        Result:=Params[AIndex+1];
+    end;
+  end;
+
+
 function TCustomApplication.GetOptionValue(const S: String): String;
 begin
   Result:=GetoptionValue(#255,S);
@@ -311,32 +411,64 @@ function TCustomApplication.GetOptionValue(const C: Char; const S: String
 
 Var
   B : Boolean;
-  I,P : integer;
-  O : String;
+  I : integer;
 
 begin
   Result:='';
   I:=FindOptionIndex(C,B);
   If (I=-1) then
-    I:=FindoptionIndex(S,B);
-  If (I<>-1) then
-    begin
-    If B then
-      begin // Long options have form --option=value
-      O:=Params[I];
-      P:=Pos('=',O);
-      If (P=0) then
-        P:=Length(O);
-      Delete(O,1,P);
-      Result:=O;
-      end
-    else
-      begin // short options have form '-o value'
-      If (I<ParamCount) then
-        if (Copy(Params[I+1],1,1)<>'-') then
-          Result:=Params[I+1];
+    I:=FindOptionIndex(S,B);
+  If I<>-1 then
+    Result:=GetOptionAtIndex(I,B);
+end;
+
+function TCustomApplication.GetOptionValues(const C: Char; const S: String): TStringArray;
+
+Var
+  I,Cnt : Integer;
+  B : Boolean;
+
+begin
+  SetLength(Result,ParamCount);
+  Cnt:=0;
+  Repeat
+    I:=FindOptionIndex(C,B,I);
+    If I<>-1 then
+      begin
+      Inc(Cnt);
+      Dec(I);
       end;
-    end;
+  Until I=-1;
+  Repeat
+    I:=FindOptionIndex(S,B,I);
+    If I<>-1 then
+      begin
+      Inc(Cnt);
+      Dec(I);
+      end;
+  Until I=-1;
+  SetLength(Result,Cnt);
+  Cnt:=0;
+  I:=-1;
+  Repeat
+    I:=FindOptionIndex(C,B,I);
+    If (I<>-1) then
+      begin
+      Result[Cnt]:=GetOptionAtIndex(I,False);
+      Inc(Cnt);
+      Dec(i);
+      end;
+  Until (I=-1);
+  I:=-1;
+  Repeat
+    I:=FindOptionIndex(S,B,I);
+    If I<>-1 then
+      begin
+      Result[Cnt]:=GetOptionAtIndex(I,True);
+      Inc(Cnt);
+      Dec(i);
+      end;
+  Until (I=-1);
 end;
 
 function TCustomApplication.HasOption(const S: String): Boolean;
@@ -349,7 +481,7 @@ begin
 end;
 
 function TCustomApplication.FindOptionIndex(const S: String;
-  var Longopt: Boolean): Integer;
+  var Longopt: Boolean; StartAt : Integer = -1): Integer;
 
 Var
   SO,O : String;
@@ -361,11 +493,14 @@ begin
   else
     SO:=S;
   Result:=-1;
-  I:=ParamCount;
+  I:=StartAt;
+  if (I=-1) then
+    I:=ParamCount;
   While (Result=-1) and (I>0) do
     begin
     O:=Params[i];
-    If (Length(O)>0) and (O[1]=FOptionChar) then
+    // - must be seen as an option value
+    If (Length(O)>1) and (O[1]=FOptionChar) then
       begin
       Delete(O,1,1);
       LongOpt:=(Length(O)>0) and (O[1]=FOptionChar);
@@ -442,11 +577,11 @@ Var
   end;
 
   Procedure AddToResult(Const Msg : string);
-  
+
   begin
     If (Result<>'') then
       Result:=Result+sLineBreak;
-    Result:=Result+Msg;  
+    Result:=Result+Msg;
   end;
 
 begin
@@ -616,4 +751,35 @@ begin
   end;
 end;
 
+function TCustomApplication.GetNonOptions(const ShortOptions: String;
+  const Longopts: array of string): TStringArray;
+
+Var
+  NO : TStrings;
+  I : Integer;
+
+begin
+  No:=TStringList.Create;
+  try
+    GetNonOptions(ShortOptions,LongOpts,No);
+    SetLength(Result,NO.Count);
+    For I:=0 to NO.Count-1 do
+      Result[I]:=NO[i];
+  finally
+    NO.Free;
+  end;
+end;
+
+procedure TCustomApplication.GetNonOptions(const ShortOptions: String;
+  const Longopts: array of string; NonOptions: TStrings);
+
+Var
+  S : String;
+
+begin
+  S:=CheckOptions(ShortOptions,LongOpts,Nil,NonOptions,true);
+  if (S<>'') then
+    Raise EListError.Create(S);
+end;
+
 end.

packages/fcl-base/src/singleinstance.pp

@@ -0,0 +1,122 @@
+unit singleinstance;
+
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2015 by Ondrej Pokorny
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$mode objfpc}
+{$H+}
+
+interface
+
+uses
+  SysUtils, Classes;
+
+type
+
+  TBaseSingleInstance = class;
+
+  //siServer: No other instance is running. The server is started.
+  //siClient: There is another instance running. This instance is used as client.
+  //siNotResponding: There is another instance running but it doesn't respond.
+  TSingleInstanceStart = (siServer, siClient, siNotResponding);
+  TSingleInstanceParamsEvent = procedure(Sender: TBaseSingleInstance; Params: TStringList) of object;
+  TBaseSingleInstance = class(TComponent)
+  private
+    FStartResult: TSingleInstanceStart;
+    FTimeOutMessages: Integer;
+    FTimeOutWaitForInstances: Integer;
+    FOnServerReceivedParams: TSingleInstanceParamsEvent;
+  Protected  
+    function GetIsClient: Boolean; virtual; abstract;
+    function GetIsServer: Boolean; virtual; abstract;
+    function GetStartResult: TSingleInstanceStart; virtual;
+    procedure DoServerReceivedParams(const aParamsDelimitedText: string);
+    Procedure SetStartResult(AValue : TSingleInstanceStart); 
+  public
+    constructor Create(aOwner: TComponent); override;
+    destructor Destroy; override;
+  public
+    //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 TimeOutMessages: Integer read FTimeOutMessages write FTimeOutMessages;
+    property TimeOutWaitForInstances: Integer read FTimeOutWaitForInstances write FTimeOutWaitForInstances;
+    property OnServerReceivedParams: TSingleInstanceParamsEvent read FOnServerReceivedParams write FOnServerReceivedParams;
+  public
+    property StartResult: TSingleInstanceStart read GetStartResult;
+    property IsServer: Boolean read GetIsServer;
+    property IsClient: Boolean read GetIsClient;
+  end;
+  TBaseSingleInstanceClass = class of TBaseSingleInstance;
+
+  ESingleInstance = class(Exception);
+
+Var
+  DefaultSingleInstanceClass : TBaseSingleInstanceClass = Nil;
+
+implementation
+
+{ 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;
+
+Procedure TBaseSingleInstance.SetStartResult(AValue : TSingleInstanceStart);
+
+begin
+  FStartResult:=AValue;
+end;   
+
+end.
+