Temporary copy of FPC's advanced IPC lib, to be used for IDE single instance feature.

git-svn-id: trunk@49907 -

.gitattributes

@@ -5562,6 +5562,7 @@ ide/abstractsmethodsdlg.lfm svneol=native#text/plain
 ide/abstractsmethodsdlg.pas svneol=native#text/plain
 ide/addtoprojectdlg.lfm svneol=native#text/plain
 ide/addtoprojectdlg.pas svneol=native#text/pascal
+ide/advancedipc.pp svneol=native#text/pascal
 ide/advhistorylist.pas svneol=native#text/pascal
 ide/allcompileroptions.lfm svneol=native#text/plain
 ide/allcompileroptions.pas svneol=native#text/pascal

ide/advancedipc.pp

@@ -0,0 +1,686 @@
+{
+    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;
+
+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;
+
+    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);
+
+    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', '_'] 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
+    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
+    FLastMsgFileName: string;
+  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; const aTimeOut: Integer): Boolean;
+    //delete last request from this client
+    procedure DeleteRequest;
+    //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)
+    procedure DeleteRequest(const aRequestID: Integer);
+
+    //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);
+
+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
+
+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}
+
+{ 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.GetUniqueRequest(out outFileName: string): Integer;
+begin
+  Randomize;
+  repeat
+    //if Randomize/Random is started from 2 processes at exactly same moment, it returns the same number! -> prevent duplicates by adding GetCurrentThreadId
+    Result := Integer(Int64(Random(High(Integer)))+GetCurrentThreadId);
+    outFileName := GetRequestFileName(Result);
+  until not RequestExists(outFileName);
+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
+  xHeader: TMessageHeader;
+  xStream: TFileStream;
+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;
+
+  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);
+
+    xStream.Position := 0;//unlocking
+    xHeader.FileLock := 0;
+    xStream.WriteBuffer(xHeader, SizeOf(xHeader));
+  finally
+    xStream.Free;
+  end;
+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: TRawByteSearchRec;
+begin
+  if FindFirst(ServerIDToFileName(aServerIDPrefix+'*', 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 }
+
+procedure TIPCClient.DeleteRequest;
+begin
+  if DeleteFile(FLastMsgFileName) then
+    FLastMsgFileName := '';
+end;
+
+function TIPCClient.PeekResponse(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
+    else if aTimeOut > 20 then
+      Sleep(10);
+  until (GetTickCount64-xStart > aTimeOut);
+end;
+
+function TIPCClient.PostRequest(const aMsgType: TMessageType;
+  const aStream: TStream): Integer;
+begin
+  Result := GetUniqueRequest(FLastMsgFileName);
+  DeleteFile(GetResponseFileName(FLastMsgFileName));//delete old response, if there is any
+  DoPostMessage(FLastMsgFileName, aMsgType, aStream);
+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: TRawByteSearchRec;
+  xDir: string;
+begin
+  xDir := ExtractFilePath(FFileName);
+  if FindFirst(GetRequestPrefix+'*', faAnyFile, xRec) = 0 then
+  begin
+    repeat
+      DeleteFile(xDir+xRec.Name);
+    until FindNext(xRec) <> 0;
+  end;
+  FindClose(xRec);
+end;
+
+procedure TIPCServer.DeleteRequest(const aRequestID: Integer);
+begin
+  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: TRawByteSearchRec;
+begin
+  outFileName := '';
+  outStream := nil;
+  outMsgType := -1;
+  outMsgLen := 0;
+  Result := -1;
+  if FindFirst(GetRequestPrefix+'*', 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: TRawByteSearchRec;
+  xRequestID, xHighestId: LongInt;
+begin
+  xHighestId := -1;
+  Result := -1;
+  if FindFirst(GetRequestPrefix+'*', faAnyFile, xRec) = 0 then
+  begin
+    repeat
+      xRequestID := RequestFileNameToID(xRec.Name);
+      if xRequestID > xHighestId then
+      begin
+        xHighestId := xRequestID;
+        Result := xRequestID;
+      end;
+    until FindNext(xRec) <> 0;
+  end;
+  FindClose(xRec);
+end;
+
+function TIPCServer.GetPendingRequestCount: Integer;
+var
+  xRec: TRawByteSearchRec;
+begin
+  Result := 0;
+  if FindFirst(GetRequestPrefix+'*', 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 := '';
+  outRequestID := FindFirstRequest(xMsgFileName, xStream, outMsgType, xMsgLen);
+  Result := outRequestID >= 0;
+  if Result then
+  begin
+    xStream.Free;
+    RenameFile(xMsgFileName, GetPeekedRequestFileName(xMsgFileName));
+  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
+  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;
+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;
+
+end.