[fpc-devel] advancedipc fixes

Ondrej Pokorny lazarus at kluug.net
Mon Oct 5 22:58:33 CEST 2015


Hello!

I talked to Mattias about the advancedipc implementation and he noticed 
that the thread ID doesn't have to be necessarily a system-wide unique 
constant (which I didn't know).

Therefore I fixed advancedipc.pp:
1.) Changed GetCurrentThreadID to GetProcessID.
2.) Added a critical section to TIPCBase.GetUniqueRequest and 
moved/renamed it to TIPCClient.CreateUniqueRequest since it is used only 
by TIPCClient.

Other fixes:
3.) Fixed some comments.
4.) Added PeekResponse and DeleteRequest with an optional aRequestID 
parameter.
5.) Some refactoring (also to keep the FPC and Lazarus versions as 
similar as possible).

The public API hasn't changed.

Patches for both the FPC and Lazarus trunks are attached.

Ondrej
-------------- next part --------------
Index: packages/fcl-base/src/advancedipc.pp
===================================================================
--- packages/fcl-base/src/advancedipc.pp	(revision 31954)
+++ packages/fcl-base/src/advancedipc.pp	(working copy)
@@ -69,12 +69,13 @@
     function RequestFileNameToID(const aFileName: string): Integer;
     function RequestExists(const aRequestFileName: string): Boolean;
 
-    function GetUniqueRequest(out outFileName: string): Integer;
     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);
+    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
@@ -82,9 +83,9 @@
       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', '_'] characters
+    //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 users can communicate
+    //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;
@@ -92,8 +93,13 @@
 
   TIPCClient = class(TIPCBase)
   private
-    FLastMsgFileName: string;
+    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
@@ -100,9 +106,15 @@
     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; const aTimeOut: Integer): Boolean;
-    //delete last request from this client
-    procedure DeleteRequest;
+    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;
@@ -131,8 +143,8 @@
     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)
-    procedure DeleteRequest(const aRequestID: Integer);
+    //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);
@@ -163,6 +175,9 @@
 
 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;
@@ -170,6 +185,9 @@
   GLOBAL_RIGHTS = 0;
   {$ENDIF}
 
+var
+  CreateUniqueRequestCritSec: TRTLCriticalSection;
+
 { TIPCBase }
 
 function TIPCBase.CanReadMessage(const aFileName: string; out
@@ -214,15 +232,27 @@
   outMsgLen := xHeader.MsgLen;
 end;
 
-function TIPCBase.GetUniqueRequest(out outFileName: string): Integer;
+function TIPCBase.DoReadMessage(const aFileName: string;
+  const aStream: TStream; out outMsgType: TMessageType): Boolean;
+var
+  xStream: TStream;
+  xMsgLen: Integer;
 begin
-  Randomize;
-  repeat
-    //if Randomize/Random is started from 2 processes at exactly same moment, it returns the same number! -> prevent duplicates by xor GetCurrentThreadId
-    //the result must be of range 0..$7FFFFFFF (High(Integer))
-    Result := Integer((PtrInt(Random($7FFFFFFF)) xor PtrInt(GetCurrentThreadId)) and $7FFFFFFF);
-    outFileName := GetRequestFileName(Result);
-  until not RequestExists(outFileName);
+  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;
@@ -267,9 +297,21 @@
 procedure TIPCBase.DoPostMessage(const aFileName: string;
   const aMsgType: TMessageType; const aStream: TStream);
 var
-  xHeader: TMessageHeader;
   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;
@@ -279,18 +321,14 @@
     xHeader.MsgLen := 0;
   xHeader.MsgVersion := MessageVersion;
 
-  xStream := TFileStream.Create(aFileName, fmCreate or fmShareExclusive, GLOBAL_RIGHTS);
-  try
-    xStream.WriteBuffer(xHeader, SizeOf(xHeader));
-    if Assigned(aStream) and (aStream.Size-aStream.Position > 0) then
-      xStream.CopyFrom(aStream, aStream.Size-aStream.Position);
+  aFileStream.WriteBuffer(xHeader, SizeOf(xHeader));
+  if Assigned(aStream) and (aStream.Size-aStream.Position > 0) then
+    aFileStream.CopyFrom(aStream, aStream.Size-aStream.Position);
 
-    xStream.Position := 0;//unlocking
-    xHeader.FileLock := 0;
-    xStream.WriteBuffer(xHeader, SizeOf(xHeader));
-  finally
-    xStream.Free;
-  end;
+  aFileStream.Position := 0;//unlocking
+  xHeader.FileLock := 0;
+  aFileStream.WriteBuffer(xHeader, SizeOf(xHeader));
+  aFileStream.Seek(0, soEnd);
 end;
 
 function TIPCBase.RequestFileNameToID(const aFileName: string): Integer;
@@ -306,7 +344,7 @@
 class procedure TIPCBase.FindRunningServers(const aServerIDPrefix: string;
   const outServerIDs: TStrings; const aGlobal: Boolean);
 var
-  xRec: TRawByteSearchRec;
+  xRec: TIPCSearchRec;
 begin
   if FindFirst(ServerIDToFileName(aServerIDPrefix+AllFilesMask, aGlobal), faAnyFile, xRec) = 0 then
   begin
@@ -368,45 +406,107 @@
 
 { TIPCClient }
 
-procedure TIPCClient.DeleteRequest;
+constructor TIPCClient.Create(aOwner: TComponent);
 begin
-  if DeleteFile(FLastMsgFileName) then
-    FLastMsgFileName := '';
+  inherited Create(aOwner);
+
+  FLastRequestID := -1;
 end;
 
-function TIPCClient.PeekResponse(const aStream: TStream; out
-  outMsgType: TMessageType; const aTimeOut: Integer): Boolean;
+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;
-  xStream: TStream;
-  xMsgLen: Integer;
-  xFileResponse: string;
 begin
   aStream.Size := 0;
   Result := False;
   xStart := GetTickCount64;
   repeat
-    xFileResponse := GetResponseFileName(FLastMsgFileName);
-    if CanReadMessage(xFileResponse, xStream, outMsgType, xMsgLen) then
-    begin
-      if xMsgLen > 0 then
-        aStream.CopyFrom(xStream, xMsgLen);
-      xStream.Free;
-      aStream.Position := 0;
-      DeleteFile(xFileResponse);
-      Exit(True);
-    end
+    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
-  Result := GetUniqueRequest(FLastMsgFileName);
-  DeleteFile(GetResponseFileName(FLastMsgFileName));//delete old response, if there is any
-  DoPostMessage(FLastMsgFileName, aMsgType, aStream);
+  xRequestFileStream := nil;
+  try
+    Result := CreateUniqueRequest(xRequestFileStream);
+    DoPostMessage(xRequestFileStream, aMsgType, aStream);
+  finally
+    xRequestFileStream.Free;
+  end;
+  FLastRequestID := Result;
 end;
 
 function TIPCClient.SendRequest(const aMsgType: TMessageType;
@@ -455,7 +555,7 @@
 
 procedure TIPCServer.DeletePendingRequests;
 var
-  xRec: TRawByteSearchRec;
+  xRec: TIPCSearchRec;
   xDir: string;
 begin
   xDir := ExtractFilePath(FFileName);
@@ -468,9 +568,9 @@
   FindClose(xRec);
 end;
 
-procedure TIPCServer.DeleteRequest(const aRequestID: Integer);
+function TIPCServer.DeleteRequest(const aRequestID: Integer): Boolean;
 begin
-  DeleteFile(GetPeekedRequestFileName(aRequestID));
+  Result := DeleteFile(GetPeekedRequestFileName(aRequestID));
 end;
 
 constructor TIPCServer.Create(aOwner: TComponent);
@@ -492,7 +592,7 @@
   outStream: TStream; out outMsgType: TMessageType; out outMsgLen: Integer
   ): Integer;
 var
-  xRec: TRawByteSearchRec;
+  xRec: TIPCSearchRec;
 begin
   outFileName := '';
   outStream := nil;
@@ -516,7 +616,7 @@
 
 function TIPCServer.FindHighestPendingRequestId: Integer;
 var
-  xRec: TRawByteSearchRec;
+  xRec: TIPCSearchRec;
   xRequestID: LongInt;
 begin
   Result := -1;
@@ -533,7 +633,7 @@
 
 function TIPCServer.GetPendingRequestCount: Integer;
 var
-  xRec: TRawByteSearchRec;
+  xRec: TIPCSearchRec;
 begin
   Result := 0;
   if FindFirst(GetRequestPrefix+AllFilesMask, faAnyFile, xRec) = 0 then
@@ -555,12 +655,17 @@
 begin
   outMsgType := -1;
   xMsgFileName := '';
-  outRequestID := FindFirstRequest(xMsgFileName, xStream, outMsgType, xMsgLen);
-  Result := outRequestID >= 0;
-  if Result then
-  begin
+  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;
-    RenameFile(xMsgFileName, GetPeekedRequestFileName(xMsgFileName));
   end;
 end;
 
@@ -619,22 +724,9 @@
 function TIPCServer.ReadRequest(const aRequestID: Integer; const aStream: TStream
   ): Boolean;
 var
-  xStream: TStream;
-  xMsgLen: Integer;
   xMsgType: TMessageType;
-  xFileRequest: string;
 begin
-  aStream.Size := 0;
-  xFileRequest := GetPeekedRequestFileName(aRequestID);
-  Result := CanReadMessage(xFileRequest, xStream, xMsgType, xMsgLen);
-  if Result then
-  begin
-    if xMsgLen > 0 then
-      aStream.CopyFrom(xStream, xMsgLen);
-    xStream.Free;
-    aStream.Position := 0;
-    DeleteFile(xFileRequest);
-  end;
+  Result := DoReadMessage(GetPeekedRequestFileName(aRequestID), aStream, xMsgType);
 end;
 
 procedure TIPCServer.SetGlobal(const aGlobal: Boolean);
@@ -680,4 +772,10 @@
   FActive := False;
 end;
 
+initialization
+  InitCriticalSection(CreateUniqueRequestCritSec);
+
+finalization
+  DoneCriticalsection(CreateUniqueRequestCritSec);
+
 end.
-------------- next part --------------
Index: ide/advancedipc.pp
===================================================================
--- ide/advancedipc.pp	(revision 49939)
+++ ide/advancedipc.pp	(working copy)
@@ -19,7 +19,7 @@
 
  **********************************************************************}
 
-unit advancedipc;
+unit AdvancedIPC;
 
 {$mode objfpc}
 {$H+}
@@ -73,12 +73,13 @@
     function RequestFileNameToID(const aFileName: string): Integer;
     function RequestExists(const aRequestFileName: string): Boolean;
 
-    function GetUniqueRequest(out outFileName: string): Integer;
     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);
+    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
@@ -86,9 +87,9 @@
       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', '_'] characters
+    //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 users can communicate
+    //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;
@@ -96,8 +97,13 @@
 
   TIPCClient = class(TIPCBase)
   private
-    FLastMsgFileName: string;
+    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
@@ -104,9 +110,15 @@
     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; const aTimeOut: Integer): Boolean;
-    //delete last request from this client
-    procedure DeleteRequest;
+    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;
@@ -135,8 +147,8 @@
     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)
-    procedure DeleteRequest(const aRequestID: Integer);
+    //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);
@@ -167,6 +179,9 @@
 
 implementation
 
+type
+  TIPCSearchRec = {$IF FPC_FULLVERSION>=20701}TRawByteSearchRec{$ELSE}TSearchRec{$ENDIF};
+
 const
   {$IFDEF UNIX}
   GLOBAL_RIGHTS = S_IRUSR or S_IWUSR or S_IRGRP or S_IWGRP or S_IROTH or S_IWOTH;
@@ -174,6 +189,9 @@
   GLOBAL_RIGHTS = 0;
   {$ENDIF}
 
+var
+  CreateUniqueRequestCritSec: TRTLCriticalSection;
+
 { TIPCBase }
 
 function TIPCBase.CanReadMessage(const aFileName: string; out
@@ -218,15 +236,27 @@
   outMsgLen := xHeader.MsgLen;
 end;
 
-function TIPCBase.GetUniqueRequest(out outFileName: string): Integer;
+function TIPCBase.DoReadMessage(const aFileName: string;
+  const aStream: TStream; out outMsgType: TMessageType): Boolean;
+var
+  xStream: TStream;
+  xMsgLen: Integer;
 begin
-  Randomize;
-  repeat
-    //if Randomize/Random is started from 2 processes at exactly same moment, it returns the same number! -> prevent duplicates by xor GetCurrentThreadId
-    //the result must be of range 0..$7FFFFFFF (High(Integer))
-    Result := Integer((PtrInt(Random($7FFFFFFF)) xor PtrInt(GetCurrentThreadId)) and $7FFFFFFF);
-    outFileName := GetRequestFileName(Result);
-  until not RequestExists(outFileName);
+  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;
@@ -271,9 +301,21 @@
 procedure TIPCBase.DoPostMessage(const aFileName: string;
   const aMsgType: TMessageType; const aStream: TStream);
 var
-  xHeader: TMessageHeader;
   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;
@@ -283,18 +325,14 @@
     xHeader.MsgLen := 0;
   xHeader.MsgVersion := MessageVersion;
 
-  xStream := TFileStream.Create(aFileName, fmCreate or fmShareExclusive, GLOBAL_RIGHTS);
-  try
-    xStream.WriteBuffer(xHeader, SizeOf(xHeader));
-    if Assigned(aStream) and (aStream.Size-aStream.Position > 0) then
-      xStream.CopyFrom(aStream, aStream.Size-aStream.Position);
+  aFileStream.WriteBuffer(xHeader, SizeOf(xHeader));
+  if Assigned(aStream) and (aStream.Size-aStream.Position > 0) then
+    aFileStream.CopyFrom(aStream, aStream.Size-aStream.Position);
 
-    xStream.Position := 0;//unlocking
-    xHeader.FileLock := 0;
-    xStream.WriteBuffer(xHeader, SizeOf(xHeader));
-  finally
-    xStream.Free;
-  end;
+  aFileStream.Position := 0;//unlocking
+  xHeader.FileLock := 0;
+  aFileStream.WriteBuffer(xHeader, SizeOf(xHeader));
+  aFileStream.Seek(0, soEnd);
 end;
 
 function TIPCBase.RequestFileNameToID(const aFileName: string): Integer;
@@ -310,9 +348,9 @@
 class procedure TIPCBase.FindRunningServers(const aServerIDPrefix: string;
   const outServerIDs: TStrings; const aGlobal: Boolean);
 var
-  xRec: {$IF FPC_FULLVERSION>=20701}TRawByteSearchRec{$ELSE}TSearchRec{$ENDIF};
+  xRec: TIPCSearchRec;
 begin
-  if FindFirst(ServerIDToFileName(aServerIDPrefix+'*', aGlobal), faAnyFile, xRec) = 0 then
+  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
@@ -372,45 +410,107 @@
 
 { TIPCClient }
 
-procedure TIPCClient.DeleteRequest;
+constructor TIPCClient.Create(aOwner: TComponent);
 begin
-  if DeleteFile(FLastMsgFileName) then
-    FLastMsgFileName := '';
+  inherited Create(aOwner);
+
+  FLastRequestID := -1;
 end;
 
-function TIPCClient.PeekResponse(const aStream: TStream; out
-  outMsgType: TMessageType; const aTimeOut: Integer): Boolean;
+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;
-  xStream: TStream;
-  xMsgLen: Integer;
-  xFileResponse: string;
 begin
   aStream.Size := 0;
   Result := False;
   xStart := GetTickCount64;
   repeat
-    xFileResponse := GetResponseFileName(FLastMsgFileName);
-    if CanReadMessage(xFileResponse, xStream, outMsgType, xMsgLen) then
-    begin
-      if xMsgLen > 0 then
-        aStream.CopyFrom(xStream, xMsgLen);
-      xStream.Free;
-      aStream.Position := 0;
-      DeleteFile(xFileResponse);
-      Exit(True);
-    end
+    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
-  Result := GetUniqueRequest(FLastMsgFileName);
-  DeleteFile(GetResponseFileName(FLastMsgFileName));//delete old response, if there is any
-  DoPostMessage(FLastMsgFileName, aMsgType, aStream);
+  xRequestFileStream := nil;
+  try
+    Result := CreateUniqueRequest(xRequestFileStream);
+    DoPostMessage(xRequestFileStream, aMsgType, aStream);
+  finally
+    xRequestFileStream.Free;
+  end;
+  FLastRequestID := Result;
 end;
 
 function TIPCClient.SendRequest(const aMsgType: TMessageType;
@@ -459,11 +559,11 @@
 
 procedure TIPCServer.DeletePendingRequests;
 var
-  xRec: {$IF FPC_FULLVERSION>=20701}TRawByteSearchRec{$ELSE}TSearchRec{$ENDIF};
+  xRec: TIPCSearchRec;
   xDir: string;
 begin
   xDir := ExtractFilePath(FFileName);
-  if FindFirst(GetRequestPrefix+'*', faAnyFile, xRec) = 0 then
+  if FindFirst(GetRequestPrefix+AllFilesMask, faAnyFile, xRec) = 0 then
   begin
     repeat
       DeleteFile(xDir+xRec.Name);
@@ -472,9 +572,9 @@
   FindClose(xRec);
 end;
 
-procedure TIPCServer.DeleteRequest(const aRequestID: Integer);
+function TIPCServer.DeleteRequest(const aRequestID: Integer): Boolean;
 begin
-  DeleteFile(GetPeekedRequestFileName(aRequestID));
+  Result := DeleteFile(GetPeekedRequestFileName(aRequestID));
 end;
 
 constructor TIPCServer.Create(aOwner: TComponent);
@@ -496,7 +596,7 @@
   outStream: TStream; out outMsgType: TMessageType; out outMsgLen: Integer
   ): Integer;
 var
-  xRec: {$IF FPC_FULLVERSION>=20701}TRawByteSearchRec{$ELSE}TSearchRec{$ENDIF};
+  xRec: TIPCSearchRec;
 begin
   outFileName := '';
   outStream := nil;
@@ -503,7 +603,7 @@
   outMsgType := -1;
   outMsgLen := 0;
   Result := -1;
-  if FindFirst(GetRequestPrefix+'*', faAnyFile, xRec) = 0 then
+  if FindFirst(GetRequestPrefix+AllFilesMask, faAnyFile, xRec) = 0 then
   begin
     repeat
       Result := RequestFileNameToID(xRec.Name);
@@ -520,11 +620,11 @@
 
 function TIPCServer.FindHighestPendingRequestId: Integer;
 var
-  xRec: {$IF FPC_FULLVERSION>=20701}TRawByteSearchRec{$ELSE}TSearchRec{$ENDIF};
+  xRec: TIPCSearchRec;
   xRequestID: LongInt;
 begin
   Result := -1;
-  if FindFirst(GetRequestPrefix+'*', faAnyFile, xRec) = 0 then
+  if FindFirst(GetRequestPrefix+AllFilesMask, faAnyFile, xRec) = 0 then
   begin
     repeat
       xRequestID := RequestFileNameToID(xRec.Name);
@@ -537,10 +637,10 @@
 
 function TIPCServer.GetPendingRequestCount: Integer;
 var
-  xRec: {$IF FPC_FULLVERSION>=20701}TRawByteSearchRec{$ELSE}TSearchRec{$ENDIF};
+  xRec: TIPCSearchRec;
 begin
   Result := 0;
-  if FindFirst(GetRequestPrefix+'*', faAnyFile, xRec) = 0 then
+  if FindFirst(GetRequestPrefix+AllFilesMask, faAnyFile, xRec) = 0 then
   begin
     repeat
       if RequestFileNameToID(xRec.Name) >= 0 then
@@ -559,12 +659,17 @@
 begin
   outMsgType := -1;
   xMsgFileName := '';
-  outRequestID := FindFirstRequest(xMsgFileName, xStream, outMsgType, xMsgLen);
-  Result := outRequestID >= 0;
-  if Result then
-  begin
+  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;
-    RenameFile(xMsgFileName, GetPeekedRequestFileName(xMsgFileName));
   end;
 end;
 
@@ -623,22 +728,9 @@
 function TIPCServer.ReadRequest(const aRequestID: Integer; const aStream: TStream
   ): Boolean;
 var
-  xStream: TStream;
-  xMsgLen: Integer;
   xMsgType: TMessageType;
-  xFileRequest: string;
 begin
-  aStream.Size := 0;
-  xFileRequest := GetPeekedRequestFileName(aRequestID);
-  Result := CanReadMessage(xFileRequest, xStream, xMsgType, xMsgLen);
-  if Result then
-  begin
-    if xMsgLen > 0 then
-      aStream.CopyFrom(xStream, xMsgLen);
-    xStream.Free;
-    aStream.Position := 0;
-    DeleteFile(xFileRequest);
-  end;
+  Result := DoReadMessage(GetPeekedRequestFileName(aRequestID), aStream, xMsgType);
 end;
 
 procedure TIPCServer.SetGlobal(const aGlobal: Boolean);
@@ -684,4 +776,10 @@
   FActive := False;
 end;
 
+initialization
+  InitCriticalSection(CreateUniqueRequestCritSec);
+
+finalization
+  DoneCriticalsection(CreateUniqueRequestCritSec);
+
 end.


More information about the fpc-devel mailing list