View Issue Details

IDProjectCategoryView StatusLast Update
0001681Double CommanderDefaultpublic2020-06-19 21:50
Reporterfedan Assigned ToAlexx2000  
PrioritynormalSeveritytweakReproducibilityalways
Status closedResolutionfixed 
ProjectionnoneETAnone 
PlatformLinuxOSCalculate 
Product Version1.0.0 (trunk) 
Target Version0.7.8Fixed in Version0.7.8 
Summary0001681: Support free pascal >= 3.0.1
DescriptionПатч поддержки сборки для fpc fixes_3_0.
TagsNo tags attached.
Attached Files
udcutils.diff (1,439 bytes)   
Index: src/udcutils.pas
===================================================================
--- src/udcutils.pas	(revision 7296)
+++ src/udcutils.pas	(working copy)
@@ -931,6 +931,24 @@
    Result := ord(pstr1[counter]) - ord(pstr2[counter]);
  end;
 
+function LocalCompareTextWideString(const s1, s2 : WideString): PtrInt;
+begin
+{$if fpc_fullversion >= 30001}
+  Result := WideStringManager.CompareWideStringProc(s1, s2, [coIgnoreCase]);
+{$else fpc_fullversion}
+  Result := WideStringManager.CompareTextWideStringProc(s1, s2);
+{$endif}
+end;
+
+function LocalCompareWideString(const s1, s2 : WideString): PtrInt;
+begin
+{$if fpc_fullversion >= 30001}
+  Result := WideStringManager.CompareWideStringProc(s1, s2, []);
+{$else fpc_fullversion}
+  Result := WideStringManager.CompareTextWideStringProc(s1, s2);
+{$endif}
+end;
+
 function StrFloatCmpW(str1, str2: PWideChar; CaseSensitivity: TCaseSensitivity): PtrInt;
 var
   is_digit1, is_digit2: boolean;
@@ -953,8 +971,8 @@
 begin
   // Set up compare function
   case CaseSensitivity of
-    cstNotSensitive: str_cmp:= WideStringManager.CompareTextWideStringProc;
-    cstLocale:       str_cmp:= WideStringManager.CompareWideStringProc;
+    cstNotSensitive: str_cmp:= @LocalCompareTextWideString;
+    cstLocale:       str_cmp:= @LocalCompareWideString;
     cstCharValue:    str_cmp:= @WideStrComp;
     else
       raise Exception.Create('Invalid CaseSensitivity parameter');
udcutils.diff (1,439 bytes)   
upipeserver+udcutils.diff (32,037 bytes)   
Index: src/platform/unix/simpleipc.inc
===================================================================
--- src/platform/unix/simpleipc.inc	(nonexistent)
+++ src/platform/unix/simpleipc.inc	(working copy)
@@ -0,0 +1,243 @@
+{
+    This file is part of the Free Component library.
+    Copyright (c) 2005 by Michael Van Canneyt, member of
+    the Free Pascal development team
+
+    Unix implementation of one-way IPC between 2 processes
+
+    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.
+
+ **********************************************************************}
+
+{$ifdef ipcunit}
+unit pipesipc;
+
+interface
+
+uses sysutils, classes, simpleipc, baseunix;
+
+{$else}
+
+uses baseunix;
+{$endif}
+
+
+ResourceString
+  SErrFailedToCreatePipe = 'Failed to create named pipe: %s';
+  SErrFailedToRemovePipe = 'Failed to remove named pipe: %s';
+
+{ ---------------------------------------------------------------------
+    TPipeClientComm
+  ---------------------------------------------------------------------}
+
+Type
+  TPipeClientComm = Class(TIPCClientComm)
+  Private
+    FFileName: String;
+    FStream: TFileStream;
+  Public
+    Constructor Create(AOWner : TSimpleIPCClient); override;
+    Procedure Connect; override;
+    Procedure Disconnect; override;
+    Procedure SendMessage(MsgType : TMessageType; AStream : TStream); override;
+    Function  ServerRunning : Boolean; override;
+    Property FileName : String Read FFileName;
+    Property Stream : TFileStream Read FStream;
+  end;
+
+{$ifdef ipcunit}
+implementation
+{$endif}
+
+constructor TPipeClientComm.Create(AOWner: TSimpleIPCClient);
+begin
+  inherited Create(AOWner);
+  FFileName:=Owner.ServerID;
+  If (Owner.ServerInstance<>'') then
+    FFileName:=FFileName+'-'+Owner.ServerInstance;
+  if FFileName[1]<>'/' then
+    FFileName:=GetTempDir(true)+FFileName;
+end;
+
+
+procedure TPipeClientComm.Connect;
+begin
+  If Not ServerRunning then
+    DoError(SErrServerNotActive,[Owner.ServerID]);
+  // Use the sharedenynone line to allow more then one client 
+  // communicating with one server at the same time
+  // see also mantis 15219
+  FStream:=TFileStream.Create(FFileName,fmOpenWrite+fmShareDenyNone);
+  // FStream:=TFileStream.Create(FFileName,fmOpenWrite);
+end;
+
+procedure TPipeClientComm.Disconnect;
+begin
+  FreeAndNil(FStream);
+end;
+
+procedure TPipeClientComm.SendMessage(MsgType : TMessagetype; AStream: TStream);
+
+Var
+  Hdr : TMsgHeader;
+
+begin
+  Hdr.Version:=MsgVersion;
+  Hdr.msgType:=MsgType;
+  Hdr.MsgLen:=AStream.Size;
+  FStream.WriteBuffer(hdr,SizeOf(hdr));
+  FStream.CopyFrom(AStream,0);
+end;
+
+function TPipeClientComm.ServerRunning: Boolean;
+var
+  fd: cint;
+begin
+  Result:=FileExists(FFileName);
+  // it's possible to have a stale file that is not open for reading which will
+  // cause fpOpen to hang/block later when .Active is set to true while it
+  // wait's for the pipe to be opened on the other end
+  if Result then
+  begin
+    // O_WRONLY | O_NONBLOCK causes fpOpen to return -1 if the file is not open for reading
+    // so in fact the 'server' is not running
+    fd := FpOpen(FFileName, O_WRONLY or O_NONBLOCK);
+    if fd = -1 then
+    begin
+      Result := False;
+      // delete the named pipe since it's orphaned
+      FpUnlink(FFileName);
+    end
+    else
+      FpClose(fd);
+  end;
+end;
+
+
+{ ---------------------------------------------------------------------
+    TPipeServerComm
+  ---------------------------------------------------------------------}
+
+Type
+
+  { TPipeServerComm }
+
+  TPipeServerComm = Class(TIPCServerComm)
+  Private
+    FFileName: String;
+    FStream: TFileStream;
+  Protected
+    Procedure DoReadMessage; virtual;
+  Public
+    Constructor Create(AOWner : TSimpleIPCServer); override;
+    Procedure StartServer; override;
+    Procedure StopServer; override;
+    Function  PeekMessage(TimeOut : Integer) : Boolean; override;
+    Procedure ReadMessage ; override;
+    Function GetInstanceID : String;override;
+    Property FileName : String Read FFileName;
+    Property Stream : TFileStream Read FStream;
+  end;
+
+procedure TPipeServerComm.DoReadMessage;
+
+Var
+  Hdr : TMsgHeader;
+
+begin
+  FStream.ReadBuffer(Hdr,SizeOf(Hdr));
+  PushMessage(Hdr,FStream);
+end;
+
+constructor TPipeServerComm.Create(AOWner: TSimpleIPCServer);
+begin
+  inherited Create(AOWner);
+  FFileName:=Owner.ServerID;
+  If Not Owner.Global then
+    FFileName:=FFileName+'-'+IntToStr(fpGetPID);
+  if FFileName[1]<>'/' then
+    FFileName:=GetTempDir(Owner.Global)+FFileName;
+end;
+
+
+procedure TPipeServerComm.StartServer;
+
+const
+  PrivateRights = S_IRUSR or S_IWUSR;
+  GlobalRights  = PrivateRights or S_IRGRP or S_IWGRP or S_IROTH or S_IWOTH;
+  Rights : Array [Boolean] of Integer = (PrivateRights,GlobalRights);  
+    
+begin
+  If not FileExists(FFileName) then
+    If (fpmkFifo(FFileName,438)<>0) then
+      DoError(SErrFailedToCreatePipe,[FFileName]);
+  FStream:=TFileStream.Create(FFileName,fmOpenReadWrite+fmShareDenyNone,Rights[Owner.Global]);
+end;
+
+procedure TPipeServerComm.StopServer;
+begin
+  FreeAndNil(FStream);
+  if Not DeleteFile(FFileName) then
+    DoError(SErrFailedtoRemovePipe,[FFileName]);
+end;
+
+function TPipeServerComm.PeekMessage(TimeOut: Integer): Boolean;
+
+Var
+  FDS : TFDSet;
+
+begin
+  fpfd_zero(FDS);
+  fpfd_set(FStream.Handle,FDS);
+  Result:=False;
+  While fpSelect(FStream.Handle+1,@FDS,Nil,Nil,TimeOut)>0 do
+    begin
+    DoReadMessage;
+    Result:=True;
+    end;
+end;
+
+procedure TPipeServerComm.ReadMessage;
+
+begin
+  DoReadMessage;
+end;
+
+
+function TPipeServerComm.GetInstanceID: String;
+begin
+  Result:=IntToStr(fpGetPID);
+end;
+
+
+{ ---------------------------------------------------------------------
+    Set TSimpleIPCClient / TSimpleIPCServer defaults.
+  ---------------------------------------------------------------------}
+
+{$ifndef ipcunit}
+function TSimpleIPCServer.CommClass: TIPCServerCommClass;
+
+begin
+  if (DefaultIPCServerClass<>Nil) then
+    Result:=DefaultIPCServerClass
+  else
+    Result:=TPipeServerComm;
+end;
+
+function TSimpleIPCClient.CommClass: TIPCClientCommClass;
+begin
+  if (DefaultIPCClientClass<>Nil) then
+    Result:=DefaultIPCClientClass
+  else
+    Result:=TPipeClientComm;
+end;
+
+{$else ipcunit}
+
+end.
+{$endif}
Index: src/platform/unix/simpleipc.pp
===================================================================
--- src/platform/unix/simpleipc.pp	(nonexistent)
+++ src/platform/unix/simpleipc.pp	(working copy)
@@ -0,0 +1,872 @@
+{
+    This file is part of the Free Component library.
+    Copyright (c) 2005 by Michael Van Canneyt, member of
+    the Free Pascal development team
+
+    Unit implementing one-way IPC between 2 processes
+
+    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 simpleipc;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Contnrs, Classes, SysUtils;
+
+Const
+  MsgVersion = 1;
+  DefaultThreadTimeOut = 50;
+
+  //Message types
+  mtUnknown = 0;
+  mtString = 1;
+
+type
+  TIPCMessageOverflowAction = (ipcmoaNone, ipcmoaDiscardOld, ipcmoaDiscardNew, ipcmoaError);
+
+var
+  DefaultIPCMessageOverflowAction: TIPCMessageOverflowAction = ipcmoaNone;
+  DefaultIPCMessageQueueLimit: Integer = 0;
+
+Type
+
+  TMessageType = LongInt;
+  TMsgHeader = Packed record
+    Version : Byte;
+    MsgType : TMessageType;
+    MsgLen  : Integer;
+  end;
+
+  TSimpleIPCServer = class;
+  TSimpleIPCClient = class;
+
+  TIPCServerMsg = class
+  strict private
+    FStream: TStream;
+    FMsgType: TMessageType;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    property Stream: TStream read FStream;
+    property MsgType: TMessageType read FMsgType write FMsgType;
+  end;
+
+  TIPCServerMsgQueue = class
+  strict private
+    FList: TFPObjectList;
+    FMaxCount: Integer;
+    FMaxAction: TIPCMessageOverflowAction;
+    function GetCount: Integer;
+    procedure DeleteAndFree(Index: Integer);
+    function PrepareToPush: Boolean;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Clear;
+    procedure Push(AItem: TIPCServerMsg);
+    function Pop: TIPCServerMsg;
+    property Count: Integer read GetCount;
+    property MaxCount: Integer read FMaxCount write FMaxCount;
+    property MaxAction: TIPCMessageOverflowAction read FMaxAction write FMaxAction;
+  end;
+
+  { TIPCServerComm }
+  
+  TIPCServerComm = Class(TObject)
+  Private
+    FOwner  : TSimpleIPCServer;
+  Protected  
+    Function  GetInstanceID : String; virtual; abstract;
+    Procedure DoError(const Msg : String; const Args : Array of const);
+    Procedure PushMessage(Const Hdr : TMsgHeader; AStream : TStream);
+    Procedure PushMessage(Msg : TIPCServerMsg);
+  Public
+    Constructor Create(AOwner : TSimpleIPCServer); virtual;
+    Property Owner : TSimpleIPCServer read FOwner;
+    Procedure StartServer; virtual; Abstract;
+    Procedure StopServer;virtual; Abstract;
+    // May push messages on the queue
+    Function  PeekMessage(TimeOut : Integer) : Boolean;virtual; Abstract;
+    // Must put message on the queue.
+    Procedure ReadMessage ;virtual; Abstract;
+    Property InstanceID : String read GetInstanceID;
+  end;
+  TIPCServerCommClass = Class of TIPCServerComm;
+
+  { TSimpleIPC }
+  TSimpleIPC = Class(TComponent)
+  Private
+    procedure SetActive(const AValue: Boolean);
+    procedure SetServerID(const AValue: String);
+  Protected
+    FBusy: Boolean;
+    FActive : Boolean;
+    FServerID : String;
+    Procedure DoError(const Msg: String; const Args: array of const);
+    Procedure CheckInactive;
+    Procedure CheckActive;
+    Procedure Activate; virtual; abstract;
+    Procedure Deactivate; virtual; abstract;
+    Procedure Loaded; override;
+    Property Busy : Boolean Read FBusy;
+  Published
+    Property Active : Boolean Read FActive Write SetActive;
+    Property ServerID : String Read FServerID Write SetServerID;
+  end;
+
+  { TSimpleIPCServer }
+
+  TMessageQueueEvent = Procedure(Sender : TObject; Msg : TIPCServerMsg) of object;
+
+  TSimpleIPCServer = Class(TSimpleIPC)
+  protected
+  Private
+    FOnMessageError: TMessageQueueEvent;
+    FOnMessageQueued: TNotifyEvent;
+    FQueue : TIPCServerMsgQueue;
+    FGlobal: Boolean;
+    FOnMessage: TNotifyEvent;
+    FMsgType: TMessageType;
+    FMsgData : TStream;
+    FThreadTimeOut: Integer;
+    FThread : TThread;
+    FLock : TRTLCriticalSection;
+    FErrMsg : TIPCServerMsg;
+    procedure DoMessageQueued;
+    procedure DoMessageError;
+    function GetInstanceID: String;
+    function GetMaxAction: TIPCMessageOverflowAction;
+    function GetMaxQueue: Integer;
+    function GetStringMessage: String;
+    procedure SetGlobal(const AValue: Boolean);
+    procedure SetMaxAction(AValue: TIPCMessageOverflowAction);
+    procedure SetMaxQueue(AValue: Integer);
+  Protected
+    FIPCComm: TIPCServerComm;
+    procedure StartThread; virtual;
+    procedure StopThread; virtual;
+    Function CommClass : TIPCServerCommClass; virtual;
+    Procedure PushMessage(Msg : TIPCServerMsg); virtual;
+    function PopMessage: Boolean; virtual;
+    Procedure Activate; override;
+    Procedure Deactivate; override;
+    Property Queue : TIPCServerMsgQueue Read FQueue;
+    Property Thread : TThread Read FThread;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Procedure StartServer(Threaded : Boolean = False);
+    Procedure StopServer;
+    Function PeekMessage(TimeOut : Integer; DoReadMessage : Boolean): Boolean;
+    Procedure ReadMessage;
+    Property  StringMessage : String Read GetStringMessage;
+    Procedure GetMessageData(Stream : TStream);
+    Property  MsgType: TMessageType Read FMsgType;
+    Property  MsgData : TStream Read FMsgData;
+    Property  InstanceID : String Read GetInstanceID;
+  Published
+    Property ThreadTimeOut : Integer Read FThreadTimeOut Write FThreadTimeOut;
+    Property Global : Boolean Read FGlobal Write SetGlobal;
+    // Called during ReadMessage
+    Property OnMessage : TNotifyEvent Read FOnMessage Write FOnMessage;
+    // Called when a message is pushed on the queue.
+    Property OnMessageQueued : TNotifyEvent Read FOnMessageQueued Write FOnMessageQueued;
+    // Called when the queue overflows and  MaxAction = ipcmoaError.
+    Property OnMessageError : TMessageQueueEvent Read FOnMessageError Write FOnMessageError;
+    // Maximum number of messages to keep in the queue
+    property MaxQueue: Integer read GetMaxQueue write SetMaxQueue;
+    // What to do when the queue overflows
+    property MaxAction: TIPCMessageOverflowAction read GetMaxAction write SetMaxAction;
+  end;
+
+
+  { TIPCClientComm}
+  TIPCClientComm = Class(TObject)
+  private
+    FOwner: TSimpleIPCClient;
+  protected
+    Procedure DoError(const Msg : String; const Args : Array of const);
+  Public
+    Constructor Create(AOwner : TSimpleIPCClient); virtual;
+    Property  Owner : TSimpleIPCClient read FOwner;
+    Procedure Connect; virtual; abstract;
+    Procedure Disconnect; virtual; abstract;
+    Function  ServerRunning : Boolean; virtual; abstract;
+    Procedure SendMessage(MsgType : TMessageType; Stream : TStream);virtual;Abstract;
+  end;
+  TIPCClientCommClass = Class of TIPCClientComm;
+  
+  { TSimpleIPCClient }
+  TSimpleIPCClient = Class(TSimpleIPC)
+  Private
+    FServerInstance: String;
+    procedure SetServerInstance(const AValue: String);
+  Protected
+    FIPCComm : TIPCClientComm;
+    Procedure Activate; override;
+    Procedure Deactivate; override;
+    Function CommClass : TIPCClientCommClass; virtual;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Procedure Connect;
+    Procedure Disconnect;
+    Function  ServerRunning : Boolean;
+    Procedure SendMessage(MsgType : TMessageType; Stream: TStream);
+    Procedure SendStringMessage(const Msg : String);
+    Procedure SendStringMessage(MsgType : TMessageType; const Msg : String);
+    Procedure SendStringMessageFmt(const Msg : String; Args : Array of const);
+    Procedure SendStringMessageFmt(MsgType : TMessageType; const Msg : String; Args : Array of const);
+    Property  ServerInstance : String Read FServerInstance Write SetServerInstance;
+  end;
+
+
+  EIPCError = Class(Exception);
+
+Var
+  DefaultIPCServerClass : TIPCServerCommClass = Nil;
+  DefaultIPCClientClass : TIPCClientCommClass = Nil;
+
+resourcestring
+  SErrServerNotActive = 'Server with ID %s is not active.';
+  SErrActive = 'This operation is illegal when the server is active.';
+  SErrInActive = 'This operation is illegal when the server is inactive.';
+
+
+implementation
+
+{ ---------------------------------------------------------------------
+  Include platform specific implementation. 
+  Should implement the CommClass method of both server and client component, 
+  as well as the communication class itself.
+  
+  This comes first, to allow the uses clause to be set.
+  If the include file defines OSNEEDIPCINITDONE then the unit will
+  call IPCInit and IPCDone in the initialization/finalization code.
+  
+  --------------------------------------------------------------------- }
+{$UNDEF OSNEEDIPCINITDONE}
+
+{$i simpleipc.inc}
+
+Resourcestring
+  SErrMessageQueueOverflow = 'Message queue overflow (limit %s)';
+
+{ ---------------------------------------------------------------------
+    TIPCServerMsg
+  ---------------------------------------------------------------------}
+
+
+constructor TIPCServerMsg.Create;
+begin
+  FMsgType := 0;
+  FStream := TMemoryStream.Create;
+end;
+
+destructor TIPCServerMsg.Destroy;
+begin
+  FStream.Free;
+end;
+
+{ ---------------------------------------------------------------------
+    TIPCServerMsgQueue
+  ---------------------------------------------------------------------}
+
+constructor TIPCServerMsgQueue.Create;
+begin
+  FMaxCount := DefaultIPCMessageQueueLimit;
+  FMaxAction := DefaultIPCMessageOverflowAction;
+  FList := TFPObjectList.Create(False); // FreeObjects = False!
+end;
+
+destructor TIPCServerMsgQueue.Destroy;
+begin
+  Clear;
+  FList.Free;
+end;
+
+procedure TIPCServerMsgQueue.Clear;
+begin
+  while FList.Count > 0 do
+    DeleteAndFree(FList.Count - 1);
+end;
+
+procedure TIPCServerMsgQueue.DeleteAndFree(Index: Integer);
+begin
+  FList[Index].Free; // Free objects manually!
+  FList.Delete(Index);
+end;
+
+function TIPCServerMsgQueue.GetCount: Integer;
+begin
+  Result := FList.Count;
+end;
+
+function TIPCServerMsgQueue.PrepareToPush: Boolean;
+begin
+  Result := True;
+  case FMaxAction of
+    ipcmoaDiscardOld:
+      begin
+        while (FList.Count >= FMaxCount) do
+          DeleteAndFree(FList.Count - 1);
+      end;
+    ipcmoaDiscardNew:
+      begin
+        Result := (FList.Count < FMaxCount);
+      end;
+    ipcmoaError:
+      begin
+        if (FList.Count >= FMaxCount) then
+          // Caller is expected to catch this exception, so not using Owner.DoError()
+          raise EIPCError.CreateFmt(SErrMessageQueueOverflow, [IntToStr(FMaxCount)]);
+      end;
+  end;
+end;
+
+procedure TIPCServerMsgQueue.Push(AItem: TIPCServerMsg);
+begin
+  if PrepareToPush then
+    FList.Insert(0, AItem);
+end;
+
+function TIPCServerMsgQueue.Pop: TIPCServerMsg;
+var
+  Index: Integer;
+begin
+  Index := FList.Count - 1;
+  if Index >= 0 then
+  begin
+    // Caller is responsible for freeing the object.
+    Result := TIPCServerMsg(FList[Index]);
+    FList.Delete(Index);
+  end
+  else
+    Result := nil;
+end;
+
+
+{ ---------------------------------------------------------------------
+    TIPCServerComm
+  ---------------------------------------------------------------------}
+
+constructor TIPCServerComm.Create(AOwner: TSimpleIPCServer);
+begin
+  FOwner:=AOWner;
+end;
+
+procedure TIPCServerComm.DoError(const Msg: String; const Args: array of const);
+
+begin
+  FOwner.DoError(Msg,Args);
+end;
+
+procedure TIPCServerComm.PushMessage(const Hdr: TMsgHeader; AStream: TStream);
+
+Var
+  M : TIPCServerMsg;
+
+begin
+  M:=TIPCServerMsg.Create;
+  try
+    M.MsgType:=Hdr.MsgType;
+    if Hdr.MsgLen>0 then
+      M.Stream.CopyFrom(AStream,Hdr.MsgLen);
+  except
+    M.Free;
+    Raise;
+  end;
+  PushMessage(M);
+end;
+
+procedure TIPCServerComm.PushMessage(Msg: TIPCServerMsg);
+begin
+  FOwner.PushMessage(Msg);
+end;
+
+{ ---------------------------------------------------------------------
+    TIPCClientComm
+  ---------------------------------------------------------------------}
+  
+constructor TIPCClientComm.Create(AOwner: TSimpleIPCClient);
+begin
+  FOwner:=AOwner;
+end;
+
+Procedure TIPCClientComm.DoError(const Msg : String; const Args : Array of const);
+
+begin
+  FOwner.DoError(Msg,Args);
+end;  
+
+{ ---------------------------------------------------------------------
+    TSimpleIPC
+  ---------------------------------------------------------------------}
+
+Procedure TSimpleIPC.DoError(const Msg: String; const Args: array of const);
+var
+  FullMsg: String;
+begin
+  if Length(Name) > 0
+    then FullMsg := Name + ': '
+    else FullMsg := '';
+  FullMsg := FullMsg + Format(Msg, Args);
+  raise EIPCError.Create(FullMsg);
+end;
+
+procedure TSimpleIPC.CheckInactive;
+begin
+  if not (csLoading in ComponentState) then
+    If Active then
+      DoError(SErrActive,[]);
+end;
+
+procedure TSimpleIPC.CheckActive;
+begin
+  if not (csLoading in ComponentState) then
+    If Not Active then
+      DoError(SErrInActive,[]);
+end;
+
+procedure TSimpleIPC.SetActive(const AValue: Boolean);
+begin
+  if (FActive<>AValue) then
+    begin
+    if ([]<>([csLoading,csDesigning]*ComponentState)) then
+      FActive:=AValue
+    else  
+      If AValue then
+        Activate
+      else
+        Deactivate;
+    end;
+end;
+
+procedure TSimpleIPC.SetServerID(const AValue: String);
+begin
+  if (FServerID<>AValue) then
+    begin
+    CheckInactive;
+    FServerID:=AValue
+    end;
+end;
+
+Procedure TSimpleIPC.Loaded; 
+
+Var
+  B : Boolean;
+
+begin
+  Inherited;
+  B:=FActive;
+  if B then
+    begin
+    Factive:=False;
+    Activate;
+    end;
+end;
+
+{ ---------------------------------------------------------------------
+    TSimpleIPCServer
+  ---------------------------------------------------------------------}
+
+constructor TSimpleIPCServer.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FGlobal:=False;
+  FActive:=False;
+  FBusy:=False;
+  FMsgData:=TStringStream.Create('');
+  FQueue:=TIPCServerMsgQueue.Create;
+  FThreadTimeOut:=DefaultThreadTimeOut;
+end;
+
+destructor TSimpleIPCServer.Destroy;
+begin
+  Active:=False;
+  FreeAndNil(FQueue);
+  FreeAndNil(FMsgData);
+  inherited Destroy;
+end;
+
+procedure TSimpleIPCServer.SetGlobal(const AValue: Boolean);
+begin
+  if (FGlobal<>AValue) then
+    begin
+    CheckInactive;
+    FGlobal:=AValue;
+    end;
+end;
+
+procedure TSimpleIPCServer.SetMaxAction(AValue: TIPCMessageOverflowAction);
+begin
+  FQueue.MaxAction:=AValue;
+end;
+
+procedure TSimpleIPCServer.SetMaxQueue(AValue: Integer);
+begin
+  FQueue.MaxCount:=AValue;
+end;
+
+function TSimpleIPCServer.GetInstanceID: String;
+begin
+  Result:=FIPCComm.InstanceID;
+end;
+
+function TSimpleIPCServer.GetMaxAction: TIPCMessageOverflowAction;
+begin
+  Result:=FQueue.MaxAction;
+end;
+
+function TSimpleIPCServer.GetMaxQueue: Integer;
+begin
+  Result:=FQueue.MaxCount;
+end;
+
+
+function TSimpleIPCServer.GetStringMessage: String;
+begin
+  Result:=TStringStream(FMsgData).DataString;
+end;
+
+
+procedure TSimpleIPCServer.StartServer(Threaded : Boolean = False);
+begin
+  if Not Assigned(FIPCComm) then
+    begin
+    If (FServerID='') then
+      FServerID:=ApplicationName;
+    FIPCComm:=CommClass.Create(Self);
+    FIPCComm.StartServer;
+    end;
+  FActive:=True;
+  If Threaded then
+    StartThread;
+end;
+
+Type
+
+  { TServerThread }
+
+  TServerThread = Class(TThread)
+  private
+    FServer: TSimpleIPCServer;
+    FThreadTimeout: Integer;
+  Public
+    Constructor Create(AServer : TSimpleIPCServer; ATimeout : integer);
+    procedure Execute; override;
+    Property Server : TSimpleIPCServer Read FServer;
+    Property ThreadTimeout : Integer Read FThreadTimeout;
+  end;
+
+{ TServerThread }
+
+constructor TServerThread.Create(AServer: TSimpleIPCServer; ATimeout: integer);
+begin
+  FServer:=AServer;
+  FThreadTimeout:=ATimeOut;
+  Inherited Create(False);
+end;
+
+procedure TServerThread.Execute;
+begin
+  While Not Terminated do
+    FServer.PeekMessage(ThreadTimeout,False);
+end;
+
+procedure TSimpleIPCServer.StartThread;
+
+begin
+  InitCriticalSection(FLock);
+  FThread:=TServerThread.Create(Self,ThreadTimeOut);
+end;
+
+procedure TSimpleIPCServer.StopThread;
+
+begin
+  if Assigned(FThread) then
+    begin
+    FThread.Terminate;
+    FThread.WaitFor;
+    FreeAndNil(FThread);
+    DoneCriticalSection(FLock);
+    end;
+end;
+
+procedure TSimpleIPCServer.StopServer;
+begin
+  StopThread;
+  If Assigned(FIPCComm) then
+    begin
+    FIPCComm.StopServer;
+    FreeAndNil(FIPCComm);
+    end;
+  FQueue.Clear;
+  FActive:=False;
+end;
+
+// TimeOut values:
+//   >  0  -- Number of milliseconds to wait
+//   =  0  -- return immediately
+//   = -1  -- wait infinitely
+//   < -1  -- wait infinitely (force to -1)
+function TSimpleIPCServer.PeekMessage(TimeOut: Integer; DoReadMessage: Boolean): Boolean;
+begin
+  CheckActive;
+  Result:=Queue.Count>0;
+  If Not Result then
+    begin
+    if TimeOut < -1 then
+      TimeOut := -1;
+    FBusy:=True;
+    Try
+      Result:=FIPCComm.PeekMessage(Timeout);
+    Finally
+      FBusy:=False;
+    end;
+    end;
+  If Result then
+    If DoReadMessage then
+      Readmessage;
+end;
+
+function TSimpleIPCServer.PopMessage: Boolean;
+
+var
+  MsgItem: TIPCServerMsg;
+  DoLock : Boolean;
+
+begin
+  DoLock:=Assigned(FThread);
+  if DoLock then
+    EnterCriticalsection(Flock);
+  try
+    MsgItem:=FQueue.Pop;
+  finally
+    LeaveCriticalsection(FLock);
+  end;
+  Result:=Assigned(MsgItem);
+  if Result then
+    try
+      FMsgType := MsgItem.MsgType;
+      MsgItem.Stream.Position := 0;
+      FMsgData.Size := 0;
+      FMsgData.CopyFrom(MsgItem.Stream, MsgItem.Stream.Size);
+    finally
+      MsgItem.Free;
+    end;
+end;
+
+procedure TSimpleIPCServer.ReadMessage;
+
+begin
+  CheckActive;
+  FBusy:=True;
+  Try
+    if (FQueue.Count=0) then
+      // Readmessage pushes a message to the queue
+      FIPCComm.ReadMessage;
+    if PopMessage then
+      If Assigned(FOnMessage) then
+        FOnMessage(Self);
+  Finally
+    FBusy:=False;
+  end;
+end;
+
+procedure TSimpleIPCServer.GetMessageData(Stream: TStream);
+begin
+  Stream.CopyFrom(FMsgData,0);
+end;
+
+procedure TSimpleIPCServer.Activate;
+begin
+  StartServer;
+end;
+
+procedure TSimpleIPCServer.Deactivate;
+begin
+  StopServer;
+end;
+
+
+procedure TSimpleIPCServer.DoMessageQueued;
+
+begin
+  if Assigned(FOnMessageQueued) then
+    FOnMessageQueued(Self);
+end;
+
+procedure TSimpleIPCServer.DoMessageError;
+begin
+  try
+    if Assigned(FOnMessageQueued) then
+      FOnMessageError(Self,FErrMsg);
+  finally
+    FreeAndNil(FErrMsg)
+  end;
+end;
+
+procedure TSimpleIPCServer.PushMessage(Msg: TIPCServerMsg);
+
+Var
+  DoLock : Boolean;
+
+begin
+  try
+    DoLock:=Assigned(FThread);
+    If DoLock then
+      EnterCriticalsection(FLock);
+    try
+      Queue.Push(Msg);
+    finally
+      If DoLock then
+        LeaveCriticalsection(FLock);
+    end;
+    if DoLock then
+      TThread.Synchronize(FThread,@DoMessageQueued)
+    else
+      DoMessageQueued;
+  except
+    On E : Exception do
+      FErrMsg:=Msg;
+  end;
+  if Assigned(FErrMsg) then
+    if DoLock then
+      TThread.Synchronize(FThread,@DoMessageError)
+    else
+      DoMessageQueued;
+
+end;
+
+
+
+{ ---------------------------------------------------------------------
+    TSimpleIPCClient
+  ---------------------------------------------------------------------}
+
+procedure TSimpleIPCClient.SetServerInstance(const AValue: String);
+begin
+  CheckInactive;
+  FServerInstance:=AVAlue;
+end;
+
+procedure TSimpleIPCClient.Activate;
+begin
+  Connect;
+end;
+
+procedure TSimpleIPCClient.Deactivate;
+begin
+  DisConnect;
+end;
+constructor TSimpleIPCClient.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+end;
+
+destructor TSimpleIPCClient.destroy;
+begin
+  Active:=False;
+  Inherited;
+end;
+
+procedure TSimpleIPCClient.Connect;
+begin
+  If Not assigned(FIPCComm) then
+    begin
+    FIPCComm:=CommClass.Create(Self);
+    Try
+      FIPCComm.Connect;
+    Except
+      FreeAndNil(FIPCComm);
+      Raise;
+    end;  
+    FActive:=True;
+    end;
+end;
+
+procedure TSimpleIPCClient.Disconnect;
+begin
+  If Assigned(FIPCComm) then
+    Try
+      FIPCComm.DisConnect;
+    Finally
+      FActive:=False;
+      FreeAndNil(FIPCComm);
+    end;  
+end;
+
+function TSimpleIPCClient.ServerRunning: Boolean;
+
+begin
+  If Assigned(FIPCComm) then
+    Result:=FIPCComm.ServerRunning
+  else
+    With CommClass.Create(Self) do
+      Try
+        Result:=ServerRunning;
+      finally
+        Free;
+      end;
+end;
+
+procedure TSimpleIPCClient.SendMessage(MsgType : TMessageType; Stream: TStream);
+
+begin
+  CheckActive;
+  FBusy:=True;
+  Try
+    FIPCComm.SendMessage(MsgType,Stream);
+  Finally
+    FBusy:=False;
+  end;
+end;
+
+procedure TSimpleIPCClient.SendStringMessage(const Msg: String);
+begin
+  SendStringMessage(mtString,Msg);
+end;
+
+procedure TSimpleIPCClient.SendStringMessage(MsgType: TMessageType; const Msg: String
+  );
+Var
+  S : TStringStream;
+begin
+  S:=TStringStream.Create(Msg);
+  try
+    SendMessage(MsgType,S);
+  finally
+    S.free;
+  end;
+end;
+
+procedure TSimpleIPCClient.SendStringMessageFmt(const Msg: String;
+  Args: array of const);
+begin
+  SendStringMessageFmt(mtString,Msg,Args);
+end;
+
+procedure TSimpleIPCClient.SendStringMessageFmt(MsgType: TMessageType;
+  const Msg: String; Args: array of const);
+begin
+  SendStringMessage(MsgType, Format(Msg,Args));
+end;
+
+{$IFDEF OSNEEDIPCINITDONE}
+initialization
+  IPCInit;
+finalization
+  IPCDone;
+{$ENDIF}  
+end.
+
Index: src/platform/unix/upipeserver.pas
===================================================================
--- src/platform/unix/upipeserver.pas	(revision 7296)
+++ src/platform/unix/upipeserver.pas	(working copy)
@@ -36,6 +36,8 @@
     FStream: TFileStream;
   private
     procedure Handler(Sender: TObject);
+  Protected
+    Procedure DoReadMessage; virtual;
   Public
     Constructor Create(AOWner : TSimpleIPCServer); override;
     Procedure StartServer; override;
@@ -65,20 +67,25 @@
 end;
 
 constructor TPipeServerComm.Create(AOWner: TSimpleIPCServer);
-
-Var
-  D : String;
-
 begin
   inherited Create(AOWner);
   FFileName:=Owner.ServerID;
   If Not Owner.Global then
     FFileName:=FFileName+'-'+IntToStr(fpGetPID);
-  D:='/tmp/'; // Change to something better later
-  FFileName:=D+FFileName;
+  if FFileName[1]<>'/' then
+    FFileName:=GetTempDir(Owner.Global)+FFileName;
 end;
 
+procedure TPipeServerComm.DoReadMessage;
 
+Var
+  Hdr : TMsgHeader;
+
+begin
+  FStream.ReadBuffer(Hdr,SizeOf(Hdr));
+  PushMessage(Hdr,FStream);
+end;
+
 procedure TPipeServerComm.StartServer;
 
 const
@@ -110,27 +117,18 @@
 begin
   fpfd_zero(FDS);
   fpfd_set(FStream.Handle,FDS);
-  Result:=fpSelect(FStream.Handle+1,@FDS,Nil,Nil,TimeOut)>0;
+  Result:=False;
+  While fpSelect(FStream.Handle+1,@FDS,Nil,Nil,TimeOut)>0 do
+    begin
+    DoReadMessage;
+    Result:=True;
+    end;
 end;
 
 procedure TPipeServerComm.ReadMessage;
 
-Var
-  Count : Integer;
-  Hdr : TMsgHeader;
-  M : TStream;
 begin
-  FStream.ReadBuffer(Hdr,SizeOf(Hdr));
-  SetMsgType(Hdr.MsgType);
-  Count:=Hdr.MsgLen;
-  M:=MsgData;
-  if count > 0 then
-    begin
-    M.Seek(0,soFrombeginning);
-    M.CopyFrom(FStream,Count);
-    end
-  else
-    M.Size := 0;
+  DoReadMessage;
 end;
 
 function TPipeServerComm.GetInstanceID: String;
Index: src/udcutils.pas
===================================================================
--- src/udcutils.pas	(revision 7296)
+++ src/udcutils.pas	(working copy)
@@ -931,6 +931,24 @@
    Result := ord(pstr1[counter]) - ord(pstr2[counter]);
  end;
 
+function LocalCompareTextWideString(const s1, s2 : WideString): PtrInt;
+begin
+{$if fpc_fullversion >= 30001}
+  Result := WideStringManager.CompareWideStringProc(s1, s2, [coIgnoreCase]);
+{$else fpc_fullversion}
+  Result := WideStringManager.CompareTextWideStringProc(s1, s2);
+{$endif}
+end;
+
+function LocalCompareWideString(const s1, s2 : WideString): PtrInt;
+begin
+{$if fpc_fullversion >= 30001}
+  Result := WideStringManager.CompareWideStringProc(s1, s2, []);
+{$else fpc_fullversion}
+  Result := WideStringManager.CompareTextWideStringProc(s1, s2);
+{$endif}
+end;
+
 function StrFloatCmpW(str1, str2: PWideChar; CaseSensitivity: TCaseSensitivity): PtrInt;
 var
   is_digit1, is_digit2: boolean;
@@ -953,8 +971,8 @@
 begin
   // Set up compare function
   case CaseSensitivity of
-    cstNotSensitive: str_cmp:= WideStringManager.CompareTextWideStringProc;
-    cstLocale:       str_cmp:= WideStringManager.CompareWideStringProc;
+    cstNotSensitive: str_cmp:= @LocalCompareTextWideString;
+    cstLocale:       str_cmp:= @LocalCompareWideString;
     cstCharValue:    str_cmp:= @WideStrComp;
     else
       raise Exception.Create('Invalid CaseSensitivity parameter');
upipeserver+udcutils.diff (32,037 bytes)   
upipeserver+udcutils_v2.diff (21,705 bytes)   
Index: src/platform/unix/simpleipc.inc
===================================================================
--- src/platform/unix/simpleipc.inc	(nonexistent)
+++ src/platform/unix/simpleipc.inc	(working copy)
@@ -0,0 +1,304 @@
+{
+    This file is part of the Free Component library.
+    Copyright (c) 2005 by Michael Van Canneyt, member of
+    the Free Pascal development team
+
+    Unix implementation of one-way IPC between 2 processes
+
+    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.
+
+ **********************************************************************}
+
+{$ifdef ipcunit}
+unit pipesipc;
+
+interface
+
+uses sysutils, classes, simpleipc, baseunix;
+
+{$else}
+
+uses baseunix;
+{$endif}
+
+{$DEFINE OSNEEDIPCINITDONE}
+
+
+
+
+ResourceString
+  SErrFailedToCreatePipe = 'Failed to create named pipe: %s';
+  SErrFailedToRemovePipe = 'Failed to remove named pipe: %s';
+
+{ ---------------------------------------------------------------------
+    TPipeClientComm
+  ---------------------------------------------------------------------}
+
+Type
+  TPipeClientComm = Class(TIPCClientComm)
+  Private
+    FFileName: String;
+    FStream: TFileStream;
+  Public
+    Constructor Create(AOWner : TSimpleIPCClient); override;
+    Procedure Connect; override;
+    Procedure Disconnect; override;
+    Procedure SendMessage(MsgType : TMessageType; AStream : TStream); override;
+    Function  ServerRunning : Boolean; override;
+    Property FileName : String Read FFileName;
+    Property Stream : TFileStream Read FStream;
+  end;
+
+{$ifdef ipcunit}
+implementation
+{$endif}
+
+Var
+  SocketFiles : TStringList;
+
+Procedure IPCInit;
+
+begin
+end;
+
+Procedure IPCDone;
+
+Var
+  I : integer;
+  
+begin
+  if Assigned(SocketFiles) then
+    try
+      For I:=0 to SocketFiles.Count-1 do
+        DeleteFile(SocketFiles[i]);
+    finally  
+      FreeAndNil(SocketFiles);  
+    end;  
+end;
+
+
+Procedure RegisterSocketFile(Const AFileName : String);
+
+begin
+  If Not Assigned(SocketFiles) then
+    begin
+    SocketFiles:=TStringList.Create;
+    SocketFiles.Sorted:=True;
+    end;
+  SocketFiles.Add(AFileName);  
+end;
+
+Procedure UnRegisterSocketFile(Const AFileName : String);
+
+Var
+  I : Integer;
+begin
+  If Assigned(SocketFiles) then
+    begin
+    I:=SocketFiles.IndexOf(AFileName);  
+    If (I<>-1) then
+      SocketFiles.Delete(I);
+    If (SocketFiles.Count=0) then
+      FreeAndNil(SocketFiles);
+    end;
+end;
+
+
+constructor TPipeClientComm.Create(AOWner: TSimpleIPCClient);
+
+Var
+  D : String;
+
+begin
+  inherited Create(AOWner);
+  FFileName:=Owner.ServerID;
+  If (Owner.ServerInstance<>'') then
+    FFileName:=FFileName+'-'+Owner.ServerInstance;
+  D:='/tmp/'; // Change to something better later
+  FFileName:=D+FFileName;
+end;
+
+
+procedure TPipeClientComm.Connect;
+begin
+  If Not ServerRunning then
+    DoError(SErrServerNotActive,[Owner.ServerID]);
+  // Use the sharedenynone line to allow more then one client 
+  // communicating with one server at the same time
+  // see also mantis 15219
+  FStream:=TFileStream.Create(FFileName,fmOpenWrite+fmShareDenyNone);
+  // FStream:=TFileStream.Create(FFileName,fmOpenWrite);
+end;
+
+procedure TPipeClientComm.Disconnect;
+begin
+  FreeAndNil(FStream);
+end;
+
+procedure TPipeClientComm.SendMessage(MsgType : TMessagetype; AStream: TStream);
+
+Var
+  Hdr : TMsgHeader;
+  P,L,Count : Integer;
+
+begin
+  Hdr.Version:=MsgVersion;
+  Hdr.msgType:=MsgType;
+  Hdr.MsgLen:=AStream.Size;
+  FStream.WriteBuffer(hdr,SizeOf(hdr));
+  FStream.CopyFrom(AStream,0);
+end;
+
+function TPipeClientComm.ServerRunning: Boolean;
+var
+  fd: cint;
+begin
+  Result:=FileExists(FFileName);
+  // it's possible to have a stale file that is not open for reading which will
+  // cause fpOpen to hang/block later when .Active is set to true while it
+  // wait's for the pipe to be opened on the other end
+  if Result then
+  begin
+    // O_WRONLY | O_NONBLOCK causes fpOpen to return -1 if the file is not open for reading
+    // so in fact the 'server' is not running
+    fd := FpOpen(FFileName, O_WRONLY or O_NONBLOCK);
+    if fd = -1 then
+    begin
+      Result := False;
+      // delete the named pipe since it's orphaned
+      FpUnlink(FFileName);
+    end
+    else
+      FpClose(fd);
+  end;
+end;
+
+
+{ ---------------------------------------------------------------------
+    TPipeServerComm
+  ---------------------------------------------------------------------}
+
+Type
+  TPipeServerComm = Class(TIPCServerComm)
+  Private
+    FFileName: String;
+    FStream: TFileStream;
+  Public
+    Constructor Create(AOWner : TSimpleIPCServer); override;
+    Procedure StartServer; override;
+    Procedure StopServer; override;
+    Function  PeekMessage(TimeOut : Integer) : Boolean; override;
+    Procedure ReadMessage ; override;
+    Function GetInstanceID : String;override;
+    Property FileName : String Read FFileName;
+    Property Stream : TFileStream Read FStream;
+  end;
+
+constructor TPipeServerComm.Create(AOWner: TSimpleIPCServer);
+
+Var
+  D : String;
+
+begin
+  inherited Create(AOWner);
+  FFileName:=Owner.ServerID;
+  If Not Owner.Global then
+    FFileName:=FFileName+'-'+IntToStr(fpGetPID);
+  D:='/tmp/'; // Change to something better later
+  FFileName:=D+FFileName;
+end;
+
+
+procedure TPipeServerComm.StartServer;
+
+const
+  PrivateRights = S_IRUSR or S_IWUSR;
+  GlobalRights  = PrivateRights or S_IRGRP or S_IWGRP or S_IROTH or S_IWOTH;
+  Rights : Array [Boolean] of Integer = (PrivateRights,GlobalRights);  
+    
+begin
+  If not FileExists(FFileName) then
+    If (fpmkFifo(FFileName,438)<>0) then
+      DoError(SErrFailedToCreatePipe,[FFileName]);
+  FStream:=TFileStream.Create(FFileName,fmOpenReadWrite+fmShareDenyNone,Rights[Owner.Global]);
+  RegisterSocketFile(FFileName);
+end;
+
+procedure TPipeServerComm.StopServer;
+begin
+  UnregisterSocketFile(FFileName);
+  FreeAndNil(FStream);
+  if Not DeleteFile(FFileName) then
+    DoError(SErrFailedtoRemovePipe,[FFileName]);
+end;
+
+function TPipeServerComm.PeekMessage(TimeOut: Integer): Boolean;
+
+Var
+  FDS : TFDSet;
+
+begin
+  fpfd_zero(FDS);
+  fpfd_set(FStream.Handle,FDS);
+  Result:=fpSelect(FStream.Handle+1,@FDS,Nil,Nil,TimeOut)>0;
+end;
+
+procedure TPipeServerComm.ReadMessage;
+
+Var
+  L,P,Count : Integer;
+  Hdr : TMsgHeader;
+  M : TStream;
+begin
+  FStream.ReadBuffer(Hdr,SizeOf(Hdr));
+  SetMsgType(Hdr.MsgType);
+  Count:=Hdr.MsgLen;
+  M:=MsgData;
+  if count > 0 then
+    begin
+    M.Seek(0,soFrombeginning);
+    M.CopyFrom(FStream,Count);
+    end
+  else
+    M.Size := 0;
+end;
+
+function TPipeServerComm.GetInstanceID: String;
+begin
+  Result:=IntToStr(fpGetPID);
+end;
+
+{ ---------------------------------------------------------------------
+    Set TSimpleIPCClient / TSimpleIPCServer defaults.
+  ---------------------------------------------------------------------}
+{$ifndef ipcunit}
+Function TSimpleIPCServer.CommClass : TIPCServerCommClass;
+
+begin
+  if (DefaultIPCServerClass<>Nil) then
+    Result:=DefaultIPCServerClass
+  else
+    Result:=TPipeServerComm;
+end;
+
+function TSimpleIPCClient.CommClass: TIPCClientCommClass;
+begin
+  if (DefaultIPCClientClass<>Nil) then
+    Result:=DefaultIPCClientClass
+  else
+    Result:=TPipeClientComm;
+end;
+
+{$else ipcunit}
+initialization
+  IPCInit;
+  
+Finalization
+  IPCDone;  
+end.
+{$endif}
Index: src/platform/unix/simpleipc.pp
===================================================================
--- src/platform/unix/simpleipc.pp	(nonexistent)
+++ src/platform/unix/simpleipc.pp	(working copy)
@@ -0,0 +1,496 @@
+{
+    This file is part of the Free Component library.
+    Copyright (c) 2005 by Michael Van Canneyt, member of
+    the Free Pascal development team
+
+    Unit implementing one-way IPC between 2 processes
+
+    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 simpleipc;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+Const
+  MsgVersion = 1;
+  
+  //Message types
+  mtUnknown = 0;
+  mtString = 1;
+  
+Type
+
+  TMessageType = LongInt;
+  TMsgHeader = Packed record
+    Version : Byte;
+    MsgType : TMessageType;
+    MsgLen  : Integer;
+  end;
+
+  TSimpleIPCServer = class;
+  TSimpleIPCClient = class;
+
+  { TIPCServerComm }
+  
+  TIPCServerComm = Class(TObject)
+  Private
+    FOwner  : TSimpleIPCServer;
+  Protected  
+    Function  GetInstanceID : String; virtual; abstract;
+    Procedure DoError(Msg : String; Args : Array of const);
+    Procedure SetMsgType(AMsgType: TMessageType); 
+    Function MsgData : TStream;
+  Public
+    Constructor Create(AOwner : TSimpleIPCServer); virtual;
+    Property Owner : TSimpleIPCServer read FOwner;
+    Procedure StartServer; virtual; Abstract;
+    Procedure StopServer;virtual; Abstract;
+    Function  PeekMessage(TimeOut : Integer) : Boolean;virtual; Abstract;
+    Procedure ReadMessage ;virtual; Abstract;
+    Property InstanceID : String read GetInstanceID;
+  end;
+  TIPCServerCommClass = Class of TIPCServerComm;
+
+  { TSimpleIPC }
+  TSimpleIPC = Class(TComponent)
+  Private
+    procedure SetActive(const AValue: Boolean);
+    procedure SetServerID(const AValue: String);
+  Protected
+    FBusy: Boolean;
+    FActive : Boolean;
+    FServerID : String;
+    Procedure DoError(Msg : String; Args : Array of const);
+    Procedure CheckInactive;
+    Procedure CheckActive;
+    Procedure Activate; virtual; abstract;
+    Procedure Deactivate; virtual; abstract;
+    Property Busy : Boolean Read FBusy;
+  Published
+    Property Active : Boolean Read FActive Write SetActive;
+    Property ServerID : String Read FServerID Write SetServerID;
+  end;
+
+  { TSimpleIPCServer }
+
+  TSimpleIPCServer = Class(TSimpleIPC)
+  private
+    FGlobal: Boolean;
+    FOnMessage: TNotifyEvent;
+    FMsgType: TMessageType;
+    FMsgData : TStream;
+    function GetInstanceID: String;
+    function GetStringMessage: String;
+    procedure SetGlobal(const AValue: Boolean);
+  Protected
+    FIPCComm: TIPCServerComm;
+    Function CommClass : TIPCServerCommClass; virtual;
+    Procedure Activate; override;
+    Procedure Deactivate; override;
+    Procedure ReadMessage;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Procedure StartServer;
+    Procedure StopServer;
+    Function PeekMessage(TimeOut : Integer; DoReadMessage : Boolean): Boolean;
+    Property  StringMessage : String Read GetStringMessage;
+    Procedure GetMessageData(Stream : TStream);
+    Property  MsgType: TMessageType Read FMsgType;
+    Property  MsgData : TStream Read FMsgData;
+    Property  InstanceID : String Read GetInstanceID;
+  Published
+    Property Global : Boolean Read FGlobal Write SetGlobal;
+    Property OnMessage : TNotifyEvent Read FOnMessage Write FOnMessage;
+  end;
+
+
+  { TIPCClientComm}
+  TIPCClientComm = Class(TObject)
+  private
+    FOwner: TSimpleIPCClient;
+  protected
+   Procedure DoError(Msg : String; Args : Array of const);
+  Public
+    Constructor Create(AOwner : TSimpleIPCClient); virtual;
+    Property  Owner : TSimpleIPCClient read FOwner;
+    Procedure Connect; virtual; abstract;
+    Procedure Disconnect; virtual; abstract;
+    Function  ServerRunning : Boolean; virtual; abstract;
+    Procedure SendMessage(MsgType : TMessageType; Stream : TStream);virtual;Abstract;
+  end;
+  TIPCClientCommClass = Class of TIPCClientComm;
+  
+  { TSimpleIPCClient }
+  TSimpleIPCClient = Class(TSimpleIPC)
+  Private
+    FServerInstance: String;
+    procedure SetServerInstance(const AValue: String);
+  Protected
+    FIPCComm : TIPCClientComm;
+    Procedure Activate; override;
+    Procedure Deactivate; override;
+    Function CommClass : TIPCClientCommClass; virtual;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Procedure Connect;
+    Procedure Disconnect;
+    Function  ServerRunning : Boolean;
+    Procedure SendMessage(MsgType : TMessageType; Stream: TStream);
+    Procedure SendStringMessage(const Msg : String);
+    Procedure SendStringMessage(MsgType : TMessageType; const Msg : String);
+    Procedure SendStringMessageFmt(const Msg : String; Args : Array of const);
+    Procedure SendStringMessageFmt(MsgType : TMessageType; const Msg : String; Args : Array of const);
+    Property  ServerInstance : String Read FServerInstance Write SetServerInstance;
+  end;
+
+
+  EIPCError = Class(Exception);
+
+Var
+  DefaultIPCServerClass : TIPCServerCommClass = Nil;
+  DefaultIPCClientClass : TIPCClientCommClass = Nil;
+
+resourcestring
+  SErrServerNotActive = 'Server with ID %s is not active.';
+  SErrActive = 'This operation is illegal when the server is active.';
+  SErrInActive = 'This operation is illegal when the server is inactive.';
+
+
+implementation
+
+{ ---------------------------------------------------------------------
+  Include platform specific implementation. 
+  Should implement the CommClass method of both server and client component, 
+  as well as the communication class itself.
+  
+  This comes first, to allow the uses clause to be set.
+  If the include file defines OSNEEDIPCINITDONE then the unit will
+  call IPCInit and IPCDone in the initialization/finalization code.
+  
+  --------------------------------------------------------------------- }
+{$UNDEF OSNEEDIPCINITDONE}
+
+{$i simpleipc.inc}
+
+{ ---------------------------------------------------------------------
+    TIPCServerComm
+  ---------------------------------------------------------------------}
+
+constructor TIPCServerComm.Create(AOwner: TSimpleIPCServer);
+begin
+  FOwner:=AOWner;
+end;
+
+Procedure TIPCServerComm.DoError(Msg : String; Args : Array of const);
+
+begin
+  FOwner.DoError(Msg,Args);
+end;  
+
+Function TIPCServerComm.MsgData : TStream;
+
+begin
+  Result:=FOwner.FMsgData;
+end;
+
+Procedure TIPCServerComm.SetMsgType(AMsgType: TMessageType); 
+
+begin
+  Fowner.FMsgType:=AMsgType;
+end;
+
+{ ---------------------------------------------------------------------
+    TIPCClientComm
+  ---------------------------------------------------------------------}
+  
+constructor TIPCClientComm.Create(AOwner: TSimpleIPCClient);
+begin
+  FOwner:=AOwner;
+end;
+
+Procedure TIPCClientComm.DoError(Msg : String; Args : Array of const);
+
+begin
+  FOwner.DoError(Msg,Args);
+end;  
+
+{ ---------------------------------------------------------------------
+    TSimpleIPC
+  ---------------------------------------------------------------------}
+
+procedure TSimpleIPC.DoError(Msg: String; Args: array of const);
+begin
+  Raise EIPCError.Create(Name+': '+Format(Msg,Args));
+end;
+
+procedure TSimpleIPC.CheckInactive;
+begin
+  If Active then
+    DoError(SErrActive,[]);
+end;
+
+procedure TSimpleIPC.CheckActive;
+begin
+  If Not Active then
+    DoError(SErrInActive,[]);
+end;
+
+procedure TSimpleIPC.SetActive(const AValue: Boolean);
+begin
+  if (FActive<>AValue) then
+    begin
+    If AValue then
+      Activate
+    else
+      Deactivate;
+    end;
+end;
+
+procedure TSimpleIPC.SetServerID(const AValue: String);
+begin
+  if (FServerID<>AValue) then
+    begin
+    CheckInactive;
+    FServerID:=AValue
+    end;
+end;
+
+{ ---------------------------------------------------------------------
+    TSimpleIPCServer
+  ---------------------------------------------------------------------}
+
+constructor TSimpleIPCServer.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FGlobal:=False;
+  FActive:=False;
+  FBusy:=False;
+  FMsgData:=TStringStream.Create('');
+end;
+
+destructor TSimpleIPCServer.Destroy;
+begin
+  Active:=False;
+  FreeAndNil(FMsgData);
+  inherited Destroy;
+end;
+
+procedure TSimpleIPCServer.SetGlobal(const AValue: Boolean);
+begin
+  if (FGlobal<>AValue) then
+    begin
+    CheckInactive;
+    FGlobal:=AValue;
+    end;
+end;
+
+function TSimpleIPCServer.GetInstanceID: String;
+begin
+  Result:=FIPCComm.InstanceID;
+end;
+
+
+function TSimpleIPCServer.GetStringMessage: String;
+begin
+  Result:=TStringStream(FMsgData).DataString;
+end;
+
+
+procedure TSimpleIPCServer.StartServer;
+begin
+  if Not Assigned(FIPCComm) then
+    begin
+    If (FServerID='') then
+      FServerID:=ApplicationName;
+    FIPCComm:=CommClass.Create(Self);
+    FIPCComm.StartServer;
+    end;
+  FActive:=True;
+end;
+
+procedure TSimpleIPCServer.StopServer;
+begin
+  If Assigned(FIPCComm) then
+    begin
+    FIPCComm.StopServer;
+    FreeAndNil(FIPCComm);
+    end;
+  FActive:=False;
+end;
+
+function TSimpleIPCServer.PeekMessage(TimeOut: Integer; DoReadMessage: Boolean
+  ): Boolean;
+begin
+  CheckActive;
+  FBusy:=True;
+  Try
+    Result:=FIPCComm.PeekMessage(Timeout);
+  Finally
+    FBusy:=False;
+  end;
+  If Result then
+    If DoReadMessage then
+      Readmessage;
+end;
+
+procedure TSimpleIPCServer.ReadMessage;
+begin
+  CheckActive;
+  FBusy:=True;
+  Try
+    FIPCComm.ReadMessage;
+    If Assigned(FOnMessage) then
+      FOnMessage(Self);
+  Finally
+    FBusy:=False;
+  end;
+end;
+
+procedure TSimpleIPCServer.GetMessageData(Stream: TStream);
+begin
+  Stream.CopyFrom(FMsgData,0);
+end;
+
+procedure TSimpleIPCServer.Activate;
+begin
+  StartServer;
+end;
+
+procedure TSimpleIPCServer.Deactivate;
+begin
+  StopServer;
+end;
+
+{ ---------------------------------------------------------------------
+    TSimpleIPCClient
+  ---------------------------------------------------------------------}
+
+procedure TSimpleIPCClient.SetServerInstance(const AValue: String);
+begin
+  CheckInactive;
+  FServerInstance:=AVAlue;
+end;
+
+procedure TSimpleIPCClient.Activate;
+begin
+  Connect;
+end;
+
+procedure TSimpleIPCClient.Deactivate;
+begin
+  DisConnect;
+end;
+constructor TSimpleIPCClient.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+end;
+
+destructor TSimpleIPCClient.destroy;
+begin
+  Active:=False;
+  Inherited;
+end;
+
+procedure TSimpleIPCClient.Connect;
+begin
+  If Not assigned(FIPCComm) then
+    begin
+    FIPCComm:=CommClass.Create(Self);
+    Try
+      FIPCComm.Connect;
+    Except
+      FreeAndNil(FIPCComm);
+      Raise;
+    end;  
+    FActive:=True;
+    end;
+end;
+
+procedure TSimpleIPCClient.Disconnect;
+begin
+  If Assigned(FIPCComm) then
+    Try
+      FIPCComm.DisConnect;
+    Finally
+      FActive:=False;
+      FreeAndNil(FIPCComm);
+    end;  
+end;
+
+function TSimpleIPCClient.ServerRunning: Boolean;
+
+begin
+  If Assigned(FIPCComm) then
+    Result:=FIPCComm.ServerRunning
+  else
+    With CommClass.Create(Self) do
+      Try
+        Result:=ServerRunning;
+      finally
+        Free;
+      end;
+end;
+
+procedure TSimpleIPCClient.SendMessage(MsgType : TMessageType; Stream: TStream);
+
+begin
+  CheckActive;
+  FBusy:=True;
+  Try
+    FIPCComm.SendMessage(MsgType,Stream);
+  Finally
+    FBusy:=False;
+  end;
+end;
+
+procedure TSimpleIPCClient.SendStringMessage(const Msg: String);
+begin
+  SendStringMessage(mtString,Msg);
+end;
+
+procedure TSimpleIPCClient.SendStringMessage(MsgType: TMessageType; const Msg: String
+  );
+Var
+  S : TStringStream;
+begin
+  S:=TStringStream.Create(Msg);
+  try
+    SendMessage(MsgType,S);
+  finally
+    S.free;
+  end;
+end;
+
+procedure TSimpleIPCClient.SendStringMessageFmt(const Msg: String;
+  Args: array of const);
+begin
+  SendStringMessageFmt(mtString,Msg,Args);
+end;
+
+procedure TSimpleIPCClient.SendStringMessageFmt(MsgType: TMessageType;
+  const Msg: String; Args: array of const);
+begin
+  SendStringMessage(MsgType, Format(Msg,Args));
+end;
+
+{$IFDEF OSNEEDIPCINITDONE}
+initialization
+  IPCInit;
+finalization
+  IPCDone;
+{$ENDIF}  
+end.
+
Index: src/udcutils.pas
===================================================================
--- src/udcutils.pas	(revision 7296)
+++ src/udcutils.pas	(working copy)
@@ -931,6 +931,24 @@
    Result := ord(pstr1[counter]) - ord(pstr2[counter]);
  end;
 
+function LocalCompareTextWideString(const s1, s2 : WideString): PtrInt;
+begin
+{$if fpc_fullversion >= 30001}
+  Result := WideStringManager.CompareWideStringProc(s1, s2, [coIgnoreCase]);
+{$else fpc_fullversion}
+  Result := WideStringManager.CompareTextWideStringProc(s1, s2);
+{$endif}
+end;
+
+function LocalCompareWideString(const s1, s2 : WideString): PtrInt;
+begin
+{$if fpc_fullversion >= 30001}
+  Result := WideStringManager.CompareWideStringProc(s1, s2, []);
+{$else fpc_fullversion}
+  Result := WideStringManager.CompareTextWideStringProc(s1, s2);
+{$endif}
+end;
+
 function StrFloatCmpW(str1, str2: PWideChar; CaseSensitivity: TCaseSensitivity): PtrInt;
 var
   is_digit1, is_digit2: boolean;
@@ -953,8 +971,8 @@
 begin
   // Set up compare function
   case CaseSensitivity of
-    cstNotSensitive: str_cmp:= WideStringManager.CompareTextWideStringProc;
-    cstLocale:       str_cmp:= WideStringManager.CompareWideStringProc;
+    cstNotSensitive: str_cmp:= @LocalCompareTextWideString;
+    cstLocale:       str_cmp:= @LocalCompareWideString;
     cstCharValue:    str_cmp:= @WideStrComp;
     else
       raise Exception.Create('Invalid CaseSensitivity parameter');
upipeserver+udcutils_v2.diff (21,705 bytes)   
Fixed in Revision7308-7311,7360
Operating systemLinux
WidgetsetGTK2, QT4
Architecture32-bit, 64-bit

Activities

fedan

2017-01-02 16:35

reporter   ~0002042

Last edited: 2017-01-02 18:53

simpleipc.{pp,inc} взят из fpc 3.0.1.
upipeserver приведён в соответствие
uniqueinstance не работает с ним (больше одной копии, независимо от настроек, создаётся), хотя канал /tmp/doublecmd--${UID} создаёт.

fedan

2017-01-02 17:18

reporter   ~0002043

Last edited: 2017-01-02 18:53

Вернул upipeserver в исходное состояние, заменил simpleipc.{pp,inc} из fpc 2.6.5, теперь всё нормально.
upipeserver+udcutils_v2.diff

Alexx2000

2017-01-13 22:58

administrator   ~0002045

Last edited: 2017-01-13 22:59

Сделал более красивый вариант, вроде работает (fpc 3.0.2rc1).

fedan

2017-01-13 23:55

reporter   ~0002046

Last edited: 2017-01-14 00:20

собрал:
Double Commander
Version: 0.8.0 alpha
Revision: 7310
Build date: 2017/01/13
Lazarus: 1.7-53936
FPC: 3.0.1
Platform: x86_64-Linux-qt4
OS version: "Gentoo"
Widgetset library: Qt 4.8.6, libQt4Pas 4.5.3
############################################
Double Commander
Version: 0.8.0 alpha
Revision: 7310
Build date: 2017/01/14
Lazarus: 1.7-53936
FPC: 3.0.1
Platform: x86_64-Linux-gtk2
OS version: "Gentoo"
Widgetset library: GTK 2.24.31
############################################

PS:
Нашёл реализацию single instance в fixes_3_0/fpcsrc/packages/fcl-base/src/advancedsingleinstance.pas
И пример fixes_3_0/fpcsrc/packages/fcl-base/examples/sitest.pp

Issue History

Date Modified Username Field Change
2017-01-02 16:22 fedan New Issue
2017-01-02 16:22 fedan File Added: udcutils.diff
2017-01-02 16:23 fedan File Added: upipeserver+udcutils.diff
2017-01-02 16:35 fedan Note Added: 0002042
2017-01-02 16:38 fedan Note Edited: 0002042
2017-01-02 16:51 fedan Note Edited: 0002042
2017-01-02 17:16 fedan File Added: upipeserver+udcutils_v2.diff
2017-01-02 17:18 fedan Note Added: 0002043
2017-01-02 17:18 fedan Note Edited: 0002043
2017-01-02 18:53 fedan Note Edited: 0002043
2017-01-02 18:53 fedan Note Edited: 0002042
2017-01-13 22:58 Alexx2000 Fixed in Revision => 7309
2017-01-13 22:58 Alexx2000 Note Added: 0002045
2017-01-13 22:58 Alexx2000 Assigned To => Alexx2000
2017-01-13 22:58 Alexx2000 Status new => resolved
2017-01-13 22:58 Alexx2000 Resolution open => fixed
2017-01-13 22:58 Alexx2000 Target Version => 0.7.8
2017-01-13 22:59 Alexx2000 Note Edited: 0002045
2017-01-13 23:01 Alexx2000 Fixed in Revision 7309 => 7308,7309
2017-01-13 23:17 Alexx2000 Fixed in Revision 7308,7309 => 7308-7310
2017-01-13 23:55 fedan Note Added: 0002046
2017-01-14 00:20 fedan Note Edited: 0002046
2017-01-14 10:23 Alexx2000 Fixed in Revision 7308-7310 => 7308-7311
2017-01-29 17:18 Alexx2000 Fixed in Revision 7308-7311 => 7308-7311,7360
2017-01-29 17:18 Alexx2000 Fixed in Version => 0.7.8
2020-06-19 21:50 Alexx2000 Status resolved => closed