{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is JclSysUtils.pas.                                                            }
{                                                                                                  }
{ The Initial Developer of the Original Code is Marcel van Brakel.                                 }
{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All rights reserved.  }
{                                                                                                  }
{ Contributors:                                                                                    }
{   Alexander Radchenko,                                                                           }
{   Andreas Hausladen (ahuser)                                                                     }
{   Anthony Steele                                                                                 }
{   Bernhard Berger                                                                                }
{   Heri Bender                                                                                    }
{   Jean-Fabien Connault (cycocrew)                                                                }
{   Jens Fudickar                                                                                  }
{   Jeroen Speldekamp                                                                              }
{   Marcel van Brakel                                                                              }
{   Peter Friese                                                                                   }
{   Petr Vones (pvones)                                                                            }
{   Python                                                                                         }
{   Robert Marquardt (marquardt)                                                                   }
{   Robert R. Marsh                                                                                }
{   Robert Rossmair (rrossmair)                                                                    }
{   Rudy Velthuis                                                                                  }
{   Uwe Schuster (uschuster)                                                                       }
{   Wayne Sherman                                                                                  }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ Description: Various pointer and class related routines.                                         }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ Last modified: $Date::                                                                         $ }
{ Revision:      $Rev::                                                                          $ }
{ Author:        $Author::                                                                       $ }
{                                                                                                  }
{**************************************************************************************************}

unit JclSysUtils;

{$I jcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$IFDEF HAS_UNITSCOPE}
  {$IFDEF MSWINDOWS}
  Winapi.Windows,
  {$ENDIF MSWINDOWS}
  System.SysUtils, System.Classes, System.TypInfo, System.SyncObjs,
  {$ELSE ~HAS_UNITSCOPE}
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF MSWINDOWS}
  SysUtils, Classes, TypInfo, SyncObjs,
  {$ENDIF ~HAS_UNITSCOPE}
  JclBase, JclSynch;

// memory initialization
// first parameter is "out" to make FPC happy with uninitialized values
procedure ResetMemory(out P; Size: Longint);

// Pointer manipulation
procedure GetAndFillMem(var P: Pointer; const Size: Integer; const Value: Byte);
procedure FreeMemAndNil(var P: Pointer);
function PCharOrNil(const S: string): PChar;
function PAnsiCharOrNil(const S: AnsiString): PAnsiChar;
{$IFDEF SUPPORTS_WIDESTRING}
function PWideCharOrNil(const W: WideString): PWideChar;
{$ENDIF SUPPORTS_WIDESTRING}

function SizeOfMem(const APointer: Pointer): Integer;

function WriteProtectedMemory(BaseAddress, Buffer: Pointer; Size: Cardinal;
  out WrittenBytes: Cardinal): Boolean;

// Guards
type
  ISafeGuard = interface
    function ReleaseItem: Pointer;
    function GetItem: Pointer;
    procedure FreeItem;
    property Item: Pointer read GetItem;
  end;

  IMultiSafeGuard = interface (IInterface)
    function AddItem(Item: Pointer): Pointer;
    procedure FreeItem(Index: Integer);
    function GetCount: Integer;
    function GetItem(Index: Integer): Pointer;
    function ReleaseItem(Index: Integer): Pointer;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: Pointer read GetItem;
  end;

  TJclSafeGuard = class(TInterfacedObject, ISafeGuard)
  private
    FItem: Pointer;
  public
    constructor Create(Mem: Pointer);
    destructor Destroy; override;
    { ISafeGuard }
    function ReleaseItem: Pointer;
    function GetItem: Pointer;
    procedure FreeItem; virtual;
    property Item: Pointer read GetItem;
  end;

  TJclObjSafeGuard = class(TJclSafeGuard, ISafeGuard)
  public
    constructor Create(Obj: TObject);
    { ISafeGuard }
    procedure FreeItem; override;
  end;

  TJclMultiSafeGuard = class(TInterfacedObject, IMultiSafeGuard)
  private
    FItems: TList;
  public
    constructor Create;
    destructor Destroy; override;
    { IMultiSafeGuard }
    function AddItem(Item: Pointer): Pointer;
    procedure FreeItem(Index: Integer); virtual;
    function GetCount: Integer;
    function GetItem(Index: Integer): Pointer;
    function ReleaseItem(Index: Integer): Pointer;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: Pointer read GetItem;
  end;

  TJclObjMultiSafeGuard = class(TJclMultiSafeGuard, IMultiSafeGuard)
  public
    { IMultiSafeGuard }
    procedure FreeItem(Index: Integer); override;
  end;

function Guard(Mem: Pointer; out SafeGuard: ISafeGuard): Pointer; overload;
function Guard(Obj: TObject; out SafeGuard: ISafeGuard): TObject; overload;

function Guard(Mem: Pointer; var SafeGuard: IMultiSafeGuard): Pointer; overload;
function Guard(Obj: TObject; var SafeGuard: IMultiSafeGuard): TObject; overload;

function GuardGetMem(Size: Cardinal; out SafeGuard: ISafeGuard): Pointer;
function GuardAllocMem(Size: Cardinal; out SafeGuard: ISafeGuard): Pointer;

(*
{$IFDEF SUPPORTS_GENERICS}
type
  ISafeGuard<T: class> = interface
    function ReleaseItem: T;
    function GetItem: T;
    procedure FreeItem;
    property Item: T read GetItem;
  end;

  TSafeGuard<T: class> = class(TObject, ISafeGuard<T>)
  private
    FItem: T;
    function ReleaseItem: T;
    function GetItem: T;
    procedure FreeItem;

  constructor Create(Instance: T);
  destructor Destroy; override;
  public
    class function New(Instance: T): ISafeGuard<T>; static;
  end;
{$ENDIF SUPPORTS_GENERICS}
*)

{ Shared memory between processes functions }

// Functions for the shared memory owner
type
  ESharedMemError = class(EJclError);

{$IFDEF MSWINDOWS}

{ SharedGetMem return ERROR_ALREADY_EXISTS if the shared memory is already
  allocated, otherwise it returns 0.
  Throws ESharedMemError if the Name is invalid. }
function SharedGetMem(var P{: Pointer}; const Name: string; Size: Cardinal;
  DesiredAccess: Cardinal = FILE_MAP_ALL_ACCESS): Integer;

{ SharedAllocMem calls SharedGetMem and then fills the memory with zero if
  it was not already allocated.
  Throws ESharedMemError if the Name is invalid. }
function SharedAllocMem(const Name: string; Size: Cardinal;
  DesiredAccess: Cardinal = FILE_MAP_ALL_ACCESS): Pointer;

{ SharedFreeMem releases the shared memory if it was the last reference. }
function SharedFreeMem(var P{: Pointer}): Boolean;

// Functions for the shared memory user

{ SharedOpenMem returns True if the shared memory was already allocated by
  SharedGetMem or SharedAllocMem. Otherwise it returns False.
  Throws ESharedMemError if the Name is invalid. }

function SharedOpenMem(var P{: Pointer}; const Name: string;
  DesiredAccess: Cardinal = FILE_MAP_ALL_ACCESS): Boolean; overload;

{ SharedOpenMem return nil if the shared memory was not already allocated
  by SharedGetMem or SharedAllocMem.
  Throws ESharedMemError if the Name is invalid. }
function SharedOpenMem(const Name: string;
  DesiredAccess: Cardinal = FILE_MAP_ALL_ACCESS): Pointer; overload;

{ SharedCloseMem releases the shared memory if it was the last reference. }
function SharedCloseMem(var P{: Pointer}): Boolean;

{$ENDIF MSWINDOWS}

// Binary search
function SearchSortedList(List: TList; SortFunc: TListSortCompare; Item: Pointer;
  Nearest: Boolean = False): Integer;

type
  TUntypedSearchCompare = function(Param: Pointer; ItemIndex: Integer; const Value): Integer;

function SearchSortedUntyped(Param: Pointer; ItemCount: Integer; SearchFunc: TUntypedSearchCompare;
  const Value; Nearest: Boolean = False): Integer;

// Dynamic array sort and search routines
type
  TDynArraySortCompare = function (Item1, Item2: Pointer): Integer;

procedure SortDynArray(const ArrayPtr: Pointer; ElementSize: Cardinal; SortFunc: TDynArraySortCompare);
// Usage: SortDynArray(Array, SizeOf(Array[0]), SortFunction);
function SearchDynArray(const ArrayPtr: Pointer; ElementSize: Cardinal; SortFunc: TDynArraySortCompare;
  ValuePtr: Pointer; Nearest: Boolean = False): SizeInt;
// Usage: SearchDynArray(Array, SizeOf(Array[0]), SortFunction, @SearchedValue);

{ Various compare functions for basic types }

function DynArrayCompareByte(Item1, Item2: Pointer): Integer;
function DynArrayCompareShortInt(Item1, Item2: Pointer): Integer;
function DynArrayCompareWord(Item1, Item2: Pointer): Integer;
function DynArrayCompareSmallInt(Item1, Item2: Pointer): Integer;
function DynArrayCompareInteger(Item1, Item2: Pointer): Integer;
function DynArrayCompareCardinal(Item1, Item2: Pointer): Integer;
function DynArrayCompareInt64(Item1, Item2: Pointer): Integer;

function DynArrayCompareSingle(Item1, Item2: Pointer): Integer;
function DynArrayCompareDouble(Item1, Item2: Pointer): Integer;
function DynArrayCompareExtended(Item1, Item2: Pointer): Integer;
function DynArrayCompareFloat(Item1, Item2: Pointer): Integer;

function DynArrayCompareAnsiString(Item1, Item2: Pointer): Integer;
function DynArrayCompareAnsiText(Item1, Item2: Pointer): Integer;
function DynArrayCompareWideString(Item1, Item2: Pointer): Integer;
function DynArrayCompareWideText(Item1, Item2: Pointer): Integer;
function DynArrayCompareString(Item1, Item2: Pointer): Integer;
function DynArrayCompareText(Item1, Item2: Pointer): Integer;

// Object lists
procedure ClearObjectList(List: TList);
procedure FreeObjectList(var List: TList);

// Reference memory stream
type
  TJclReferenceMemoryStream = class(TCustomMemoryStream)
  public
    constructor Create(const Ptr: Pointer; Size: Longint);
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

// AutoPtr
type
  IAutoPtr = interface
    { Returns the object as pointer, so it is easier to assign it to a variable }
    function AsPointer: Pointer;
    { Returns the AutoPtr handled object }
    function AsObject: TObject;
    { Releases the object from the AutoPtr. The AutoPtr looses the control over
      the object. }
    function ReleaseObject: TObject;
  end;

  TJclAutoPtr = class(TInterfacedObject, IAutoPtr)
  private
    FValue: TObject;
  public
    constructor Create(AValue: TObject);
    destructor Destroy; override;
    { IAutoPtr }
    function AsPointer: Pointer;
    function AsObject: TObject;
    function ReleaseObject: TObject;
  end;

function CreateAutoPtr(Value: TObject): IAutoPtr;

// Replacement for the C ternary conditional operator ? :
function Iff(const Condition: Boolean; const TruePart, FalsePart: string): string; overload;
function Iff(const Condition: Boolean; const TruePart, FalsePart: Char): Char; overload;
function Iff(const Condition: Boolean; const TruePart, FalsePart: Byte): Byte; overload;
function Iff(const Condition: Boolean; const TruePart, FalsePart: Integer): Integer; overload;
function Iff(const Condition: Boolean; const TruePart, FalsePart: Cardinal): Cardinal; overload;
function Iff(const Condition: Boolean; const TruePart, FalsePart: Float): Float; overload;
function Iff(const Condition: Boolean; const TruePart, FalsePart: Boolean): Boolean; overload;
function Iff(const Condition: Boolean; const TruePart, FalsePart: Pointer): Pointer; overload;
function Iff(const Condition: Boolean; const TruePart, FalsePart: Int64): Int64; overload;
{$IFDEF SUPPORTS_VARIANT}
function Iff(const Condition: Boolean; const TruePart, FalsePart: Variant): Variant; overload;
{$ENDIF SUPPORTS_VARIANT}

// Classes information and manipulation
type
  EJclVMTError = class(EJclError);

// Virtual Methods
{$IFNDEF FPC}
function GetVirtualMethodCount(AClass: TClass): Integer;
{$ENDIF ~FPC}
function GetVirtualMethod(AClass: TClass; const Index: Integer): Pointer;
procedure SetVirtualMethod(AClass: TClass; const Index: Integer; const Method: Pointer);

// Dynamic Methods
type
  TDynamicIndexList = array [0..MaxInt div 16] of Word;
  PDynamicIndexList = ^TDynamicIndexList;
  TDynamicAddressList = array [0..MaxInt div 16] of Pointer;
  PDynamicAddressList = ^TDynamicAddressList;

function GetDynamicMethodCount(AClass: TClass): Integer;
function GetDynamicIndexList(AClass: TClass): PDynamicIndexList;
function GetDynamicAddressList(AClass: TClass): PDynamicAddressList;
function HasDynamicMethod(AClass: TClass; Index: Integer): Boolean;
{$IFNDEF FPC}
function GetDynamicMethod(AClass: TClass; Index: Integer): Pointer;
{$ENDIF ~FPC}

{ init table methods }

function GetInitTable(AClass: TClass): PTypeInfo;

{ field table methods }

type
  PFieldEntry = ^TFieldEntry;
  TFieldEntry = packed record
    OffSet: Integer;
    IDX: Word;
    Name: ShortString;
  end;

  PFieldClassTable = ^TFieldClassTable;
  TFieldClassTable = packed record
    Count: Smallint;
    Classes: array [0..8191] of ^TPersistentClass;
  end;

  PFieldTable = ^TFieldTable;
  TFieldTable = packed record
    EntryCount: Word;
    FieldClassTable: PFieldClassTable;
    FirstEntry: TFieldEntry;
   {Entries: array [1..65534] of TFieldEntry;}
  end;

function GetFieldTable(AClass: TClass): PFieldTable;

{ method table }

type
  PMethodEntry = ^TMethodEntry;
  TMethodEntry = packed record
    EntrySize: Word;
    Address: Pointer;
    Name: ShortString;
  end;

  PMethodTable = ^TMethodTable;
  TMethodTable = packed record
    Count: Word;
    FirstEntry: TMethodEntry;
   {Entries: array [1..65534] of TMethodEntry;}
  end;

function GetMethodTable(AClass: TClass): PMethodTable;
function GetMethodEntry(MethodTable: PMethodTable; Index: Integer): PMethodEntry;

// Function to compare if two methods/event handlers are equal
function MethodEquals(aMethod1, aMethod2: TMethod): boolean;
function NotifyEventEquals(aMethod1, aMethod2: TNotifyEvent): boolean;

// Class Parent
procedure SetClassParent(AClass: TClass; NewClassParent: TClass);
function GetClassParent(AClass: TClass): TClass;

{$IFNDEF FPC}
function IsClass(Address: Pointer): Boolean;
function IsObject(Address: Pointer): Boolean;
{$ENDIF ~FPC}

function InheritsFromByName(AClass: TClass; const AClassName: string): Boolean;

// Interface information
function GetImplementorOfInterface(const I: IInterface): TObject;

// interfaced persistent
type
  TJclInterfacedPersistent = class(TInterfacedPersistent, IInterface)
  protected
    FOwnerInterface: IInterface;
    FRefCount: Integer;
  public
    procedure AfterConstruction; override;
    { IInterface }
    // function QueryInterface(const IID: TGUID; out Obj): HRESULT; virtual; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

// Numeric formatting routines
type
  TDigitCount = 0..255;
  TDigitValue = -1..35;  // invalid, '0'..'9', 'A'..'Z'
  TNumericSystemBase = 2..Succ(High(TDigitValue));

  TJclNumericFormat = class(TObject)
  private
    FWantedPrecision: TDigitCount;
    FPrecision: TDigitCount;
    FNumberOfFractionalDigits: TDigitCount;
    FExpDivision: Integer;
    FDigitBlockSize: TDigitCount;
    FWidth: TDigitCount;
    FSignChars: array [Boolean] of Char;
    FBase: TNumericSystemBase;
    FFractionalPartSeparator: Char;
    FDigitBlockSeparator: Char;
    FShowPositiveSign: Boolean;
    FPaddingChar: Char;
    FMultiplier: string;
    function GetDigitValue(Digit: Char): Integer;
    function GetNegativeSign: Char;
    function GetPositiveSign: Char;
    procedure InvalidDigit(Digit: Char);
    procedure SetPrecision(const Value: TDigitCount);
    procedure SetBase(const Value: TNumericSystemBase);
    procedure SetNegativeSign(const Value: Char);
    procedure SetPositiveSign(const Value: Char);
    procedure SetExpDivision(const Value: Integer);
  protected
    function IntToStr(const Value: Int64; out FirstDigitPos: Integer): string; overload;
    function ShowSign(const Value: Float): Boolean; overload;
    function ShowSign(const Value: Int64): Boolean; overload;
    function SignChar(const Value: Float): Char; overload;
    function SignChar(const Value: Int64): Char; overload;
    property WantedPrecision: TDigitCount read FWantedPrecision;
  public
    constructor Create;
    function Digit(DigitValue: TDigitValue): Char;
    function DigitValue(Digit: Char): TDigitValue;
    function IsDigit(Value: Char): Boolean;
    function Sign(Value: Char): Integer;
    procedure GetMantissaExp(const Value: Float; out Mantissa: string; out Exponent: Integer);
    function FloatToHTML(const Value: Float): string;
    function IntToStr(const Value: Int64): string; overload;
    function FloatToStr(const Value: Float): string; overload;
    function StrToInt(const Value: string): Int64;
    property Base: TNumericSystemBase read FBase write SetBase;
    property Precision: TDigitCount read FPrecision write SetPrecision;
    property NumberOfFractionalDigits: TDigitCount read FNumberOfFractionalDigits write FNumberOfFractionalDigits;
    property ExponentDivision: Integer read FExpDivision write SetExpDivision;
    property DigitBlockSize: TDigitCount read FDigitBlockSize write FDigitBlockSize;
    property DigitBlockSeparator: Char read FDigitBlockSeparator write FDigitBlockSeparator;
    property FractionalPartSeparator: Char read FFractionalPartSeparator write FFractionalPartSeparator;
    property Multiplier: string read FMultiplier write FMultiplier;
    property PaddingChar: Char read FPaddingChar write FPaddingChar;
    property ShowPositiveSign: Boolean read FShowPositiveSign write FShowPositiveSign;
    property Width: TDigitCount read FWidth write FWidth;
    property NegativeSign: Char read GetNegativeSign write SetNegativeSign;
    property PositiveSign: Char read GetPositiveSign write SetPositiveSign;
  end;

function IntToStrZeroPad(Value, Count: Integer): string;

// Child processes
type
  // e.g. TStrings.Append
  TTextHandler = procedure(const Text: string) of object;
  TJclProcessPriority = (ppIdle, ppNormal, ppHigh, ppRealTime, ppBelowNormal, ppAboveNormal);

const
  ABORT_EXIT_CODE = {$IFDEF MSWINDOWS} ERROR_CANCELLED {$ELSE} 1223 {$ENDIF};

function Execute(const CommandLine: string; OutputLineCallback: TTextHandler; RawOutput: Boolean = False;
  AbortPtr: PBoolean = nil; ProcessPriority: TJclProcessPriority = ppNormal;
  AutoConvertOem: Boolean = False): Cardinal; overload;
function Execute(const CommandLine: string; AbortEvent: TJclEvent;
  OutputLineCallback: TTextHandler; RawOutput: Boolean = False; ProcessPriority: TJclProcessPriority = ppNormal;
  AutoConvertOem: Boolean = False): Cardinal; overload;
function Execute(const CommandLine: string; var Output: string; RawOutput: Boolean = False;
  AbortPtr: PBoolean = nil; ProcessPriority: TJclProcessPriority = ppNormal;
  AutoConvertOem: Boolean = False): Cardinal; overload;
function Execute(const CommandLine: string; AbortEvent: TJclEvent;
  var Output: string; RawOutput: Boolean = False; ProcessPriority: TJclProcessPriority = ppNormal;
  AutoConvertOem: Boolean = False): Cardinal; overload;

function Execute(const CommandLine: string; OutputLineCallback, ErrorLineCallback: TTextHandler;
  RawOutput: Boolean = False; RawError: Boolean = False; AbortPtr: PBoolean = nil;
  ProcessPriority: TJclProcessPriority = ppNormal; AutoConvertOem: Boolean = False): Cardinal; overload;
function Execute(const CommandLine: string; AbortEvent: TJclEvent;
  OutputLineCallback, ErrorLineCallback: TTextHandler; RawOutput: Boolean = False; RawError: Boolean = False;
  ProcessPriority: TJclProcessPriority = ppNormal; AutoConvertOem: Boolean = False): Cardinal; overload;
function Execute(const CommandLine: string; var Output, Error: string;
  RawOutput: Boolean = False; RawError: Boolean = False; AbortPtr: PBoolean = nil;
  ProcessPriority: TJclProcessPriority = ppNormal; AutoConvertOem: Boolean = False): Cardinal; overload;
function Execute(const CommandLine: string; AbortEvent: TJclEvent;
  var Output, Error: string; RawOutput: Boolean = False; RawError: Boolean = False;
  ProcessPriority: TJclProcessPriority = ppNormal; AutoConvertOem: Boolean = False): Cardinal; overload;

type
  {$IFDEF MSWINDOWS}
  TJclExecuteCmdProcessOptionBeforeResumeEvent = procedure(const ProcessInfo: TProcessInformation) of object;
  TStartupVisibility = (svHide, svShow, svNotSet);
  {$ENDIF MSWINDOWS}

  TJclExecuteCmdProcessOptions = {record} class(TObject)
  private
    FCommandLine: string;
    FAbortPtr: PBoolean;
    FAbortEvent: TJclEvent;

    FOutputLineCallback: TTextHandler;
    FRawOutput: Boolean;
    FMergeError: Boolean;
    FErrorLineCallback: TTextHandler;
    FRawError: Boolean;
    FProcessPriority: TJclProcessPriority;

    FAutoConvertOem: Boolean;
    {$IFDEF MSWINDOWS}
    FCreateProcessFlags: DWORD;
    FStartupVisibility: TStartupVisibility;
    FBeforeResume: TJclExecuteCmdProcessOptionBeforeResumeEvent;
    {$ENDIF MSWINDOWS}

    FExitCode: Cardinal;
    FOutput: string;
    FError: string;
  public
    // in:
    property CommandLine: string read FCommandLine write FCommandLine;
    property AbortPtr: PBoolean read FAbortPtr write FAbortPtr;
    property AbortEvent: TJclEvent read FAbortEvent write FAbortEvent;

    property OutputLineCallback: TTextHandler read FOutputLineCallback write FOutputLineCallback;
    property RawOutput: Boolean read FRawOutput write FRawOutput default False;
    property MergeError: Boolean read FMergeError write FMergeError default False;
    property ErrorLineCallback: TTextHandler read FErrorLineCallback write FErrorLineCallback;
    property RawError: Boolean read FRawError write FRawError default False;
    property ProcessPriority: TJclProcessPriority read FProcessPriority write FProcessPriority default ppNormal;

    // AutoConvertOem assumes the process outputs OEM encoded strings and converts them to the
    // default string encoding.
    property AutoConvertOem: Boolean read FAutoConvertOem write FAutoConvertOem default True;
    {$IFDEF MSWINDOWS}
    property CreateProcessFlags: DWORD read FCreateProcessFlags write FCreateProcessFlags;
    property StartupVisibility: TStartupVisibility read FStartupVisibility write FStartupVisibility;
    property BeforeResume: TJclExecuteCmdProcessOptionBeforeResumeEvent read FBeforeResume write FBeforeResume;
    {$ENDIF MSWINDOWS}

    // out:
    property ExitCode: Cardinal read FExitCode;
    property Output: string read FOutput;
    property Error: string read FError;
  public
    constructor Create(const ACommandLine: string);
  end;

function ExecuteCmdProcess(Options: TJclExecuteCmdProcessOptions): Boolean;

type
{$HPPEMIT 'namespace Jclsysutils'}
{$HPPEMIT '{'}
{$HPPEMIT '  // For some reason, the generator puts this interface after its first'}
{$HPPEMIT '  // usage, resulting in an unusable header file. We fix this by forward'}
{$HPPEMIT '  // declaring the interface.'}
{$HPPEMIT '  __interface IJclCommandLineTool;'}
(*$HPPEMIT '}'*)

  IJclCommandLineTool = interface
    ['{A0034B09-A074-D811-847D-0030849E4592}']
    function GetExeName: string;
    function GetOptions: TStrings;
    function GetOutput: string;
    function GetOutputCallback: TTextHandler;
    procedure AddPathOption(const Option, Path: string);
    function Execute(const CommandLine: string): Boolean;
    procedure SetOutputCallback(const CallbackMethod: TTextHandler);
    property ExeName: string read GetExeName;
    property Options: TStrings read GetOptions;
    property OutputCallback: TTextHandler read GetOutputCallback write SetOutputCallback;
    property Output: string read GetOutput;
  end;

  EJclCommandLineToolError = class(EJclError);

  TJclCommandLineTool = class(TInterfacedObject, IJclCommandLineTool)
  private
    FExeName: string;
    FOptions: TStringList;
    FOutput: string;
    FOutputCallback: TTextHandler;
  public
    constructor Create(const AExeName: string);
    destructor Destroy; override;
    { IJclCommandLineTool }
    function GetExeName: string;
    function GetOptions: TStrings;
    function GetOutput: string;
    function GetOutputCallback: TTextHandler;
    procedure AddPathOption(const Option, Path: string);
    function Execute(const CommandLine: string): Boolean;
    procedure SetOutputCallback(const CallbackMethod: TTextHandler);
    property ExeName: string read GetExeName;
    property Options: TStrings read GetOptions;
    property OutputCallback: TTextHandler read GetOutputCallback write SetOutputCallback;
    property Output: string read GetOutput;
  end;

// Console Utilities
function ReadKey: Char;

// Loading of modules (DLLs)
type
{$IFDEF MSWINDOWS}
  TModuleHandle = HINST;
{$ENDIF MSWINDOWS}
{$IFDEF LINUX}
  TModuleHandle = Pointer;
{$ENDIF LINUX}

const
  INVALID_MODULEHANDLE_VALUE = TModuleHandle(0);

function LoadModule(var Module: TModuleHandle; FileName: string): Boolean;
function LoadModuleEx(var Module: TModuleHandle; FileName: string; Flags: Cardinal): Boolean;
procedure UnloadModule(var Module: TModuleHandle);
function GetModuleSymbol(Module: TModuleHandle; SymbolName: string): Pointer;
function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: string; var Accu: Boolean): Pointer;
function ReadModuleData(Module: TModuleHandle; SymbolName: string; var Buffer; Size: Cardinal): Boolean;
function WriteModuleData(Module: TModuleHandle; SymbolName: string; var Buffer; Size: Cardinal): Boolean;

// Conversion Utilities
type
  EJclConversionError = class(EJclError);

function StrToBoolean(const S: string): Boolean;
function BooleanToStr(B: Boolean): string;
function IntToBool(I: Integer): Boolean;
function BoolToInt(B: Boolean): Integer;

function TryStrToUInt(const Value: string; out Res: Cardinal): Boolean;
function StrToUIntDef(const Value: string; const Default: Cardinal): Cardinal;
function StrToUInt(const Value: string): Cardinal;

const
  {$IFDEF MSWINDOWS}
  ListSeparator = ';';
  {$ENDIF MSWINDOWS}
  {$IFDEF LINUX}
  ListSeparator = ':';
  {$ENDIF LINUX}

// functions to handle items in a separated list of items
// add items at the end
procedure ListAddItems(var List: string; const Separator, Items: string);
// add items at the end if they are not present
procedure ListIncludeItems(var List: string; const Separator, Items: string);
// delete multiple items
procedure ListRemoveItems(var List: string; const Separator, Items: string);
// delete one item
procedure ListDelItem(var List: string; const Separator: string;
  const Index: Integer);
// return the number of item
function ListItemCount(const List, Separator: string): Integer;
// return the Nth item
function ListGetItem(const List, Separator: string;
  const Index: Integer): string;
// set the Nth item
procedure ListSetItem(var List: string; const Separator: string;
  const Index: Integer; const Value: string);
// return the index of an item
function ListItemIndex(const List, Separator, Item: string): Integer;

// RTL package information
function SystemTObjectInstance: TJclAddr;
function IsCompiledWithPackages: Boolean;

// GUID
function JclGUIDToString(const GUID: TGUID): string;
function JclStringToGUID(const S: string): TGUID;
function GUIDEquals(const GUID1, GUID2: TGUID): Boolean;

// thread safe support

type
  TJclIntfCriticalSection = class(TInterfacedObject, IInterface)
  private
    FCriticalSection: TCriticalSection;
  public
    constructor Create;
    destructor Destroy; override;
    { IInterface }
    // function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

type
  {$IFDEF BORLAND}
  {$IFDEF COMPILER16_UP}
  TFileHandle = THandle;
  {$ELSE ~COMPILER16_UP}
  TFileHandle = Integer;
  {$ENDIF ~COMPILER16_UP}
  {$ELSE ~BORLAND}
  TFileHandle = THandle;
  {$ENDIF ~BORLAND}

  TJclSimpleLog = class (TObject)
  private
    FDateTimeFormatStr: String;
    FLogFileHandle: TFileHandle;
    FLogFileName: string;
    FLoggingActive: Boolean;
    FLogWasEmpty: Boolean;
    function GetLogOpen: Boolean;
  protected
    function CreateDefaultFileName: string;
  public
    constructor Create(const ALogFileName: string = '');
    destructor Destroy; override;
    procedure ClearLog;
    procedure CloseLog;
    procedure OpenLog;
    procedure Write(const Text: string; Indent: Integer = 0; KeepOpen: Boolean = true); overload;
    procedure Write(Strings: TStrings; Indent: Integer = 0; KeepOpen: Boolean = true); overload;
    //Writes a line to the log file. The current timestamp is written before the line.
    procedure TimeWrite(const Text: string; Indent: Integer = 0; KeepOpen: Boolean = true); overload;
    procedure TimeWrite(Strings: TStrings; Indent: Integer = 0; KeepOpen: Boolean = true); overload;
    procedure WriteStamp(SeparatorLen: Integer = 0; KeepOpen: Boolean = true);
    // DateTimeFormatStr property assumes the values described in "FormatDateTime Function" in Delphi Help
    property DateTimeFormatStr: String read FDateTimeFormatStr write FDateTimeFormatStr;
    property LogFileName: string read FLogFileName;
    //1 Property to activate / deactivate the logging
    property LoggingActive: Boolean read FLoggingActive write FLoggingActive default True;
    property LogOpen: Boolean read GetLogOpen;
  end;

type
  TJclFormatSettings = class
  private
    function GetCurrencyDecimals: Byte; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetCurrencyFormat: Byte; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetCurrencyString: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetDateSeparator: Char; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetDayNamesHighIndex: Integer; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetDayNamesLowIndex: Integer; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetDecimalSeparator: Char; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetListSeparator: Char; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetLongDateFormat: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetLongDayNames(AIndex: Integer): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetLongMonthNames(AIndex: Integer): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetLongTimeFormat: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetMonthNamesHighIndex: Integer; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetMonthNamesLowIndex: Integer; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetNegCurrFormat: Byte; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetShortDateFormat: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetShortDayNames(AIndex: Integer): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetShortMonthNames(AIndex: Integer): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetShortTimeFormat: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetThousandSeparator: Char; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetTimeAMString: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetTimePMString: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetTimeSeparator: Char; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    function GetTwoDigitYearCenturyWindow: Word; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    procedure SetCurrencyDecimals(AValue: Byte); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    procedure SetCurrencyFormat(const AValue: Byte); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    procedure SetCurrencyString(AValue: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    procedure SetDateSeparator(const AValue: Char); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    procedure SetDecimalSeparator(AValue: Char); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    procedure SetListSeparator(const AValue: Char); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    procedure SetLongDateFormat(const AValue: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    procedure SetLongTimeFormat(const AValue: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    procedure SetNegCurrFormat(const AValue: Byte); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    procedure SetShortDateFormat(AValue: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    procedure SetShortTimeFormat(const AValue: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    procedure SetThousandSeparator(AValue: Char); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    procedure SetTimeAMString(const AValue: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    procedure SetTimePMString(const AValue: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    procedure SetTimeSeparator(const AValue: Char); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
    procedure SetTwoDigitYearCenturyWindow(const AValue: Word); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  public
    property CurrencyDecimals: Byte read GetCurrencyDecimals write SetCurrencyDecimals;
    property CurrencyFormat: Byte read GetCurrencyFormat write SetCurrencyFormat;
    property CurrencyString: string read GetCurrencyString write SetCurrencyString;
    property DateSeparator: Char read GetDateSeparator write SetDateSeparator;
    property DayNamesHighIndex: Integer read GetDayNamesHighIndex;
    property DayNamesLowIndex: Integer read GetDayNamesLowIndex;
    property DecimalSeparator: Char read GetDecimalSeparator write SetDecimalSeparator;
    property ListSeparator: Char read GetListSeparator write SetListSeparator;
    property LongDateFormat: string read GetLongDateFormat write SetLongDateFormat;
    property LongDayNames[AIndex: Integer]: string read GetLongDayNames;
    property LongMonthNames[AIndex: Integer]: string read GetLongMonthNames;
    property LongTimeFormat: string read GetLongTimeFormat write SetLongTimeFormat;
    property MonthNamesHighIndex: Integer read GetMonthNamesHighIndex;
    property MonthNamesLowIndex: Integer read GetMonthNamesLowIndex;
    property NegCurrFormat: Byte read GetNegCurrFormat write SetNegCurrFormat;
    property ShortDateFormat: string read GetShortDateFormat write SetShortDateFormat;
    property ShortDayNames[AIndex: Integer]: string read GetShortDayNames;
    property ShortMonthNames[AIndex: Integer]: string read GetShortMonthNames;
    property ShortTimeFormat: string read GetShortTimeFormat write SetShortTimeFormat;
    property ThousandSeparator: Char read GetThousandSeparator write SetThousandSeparator;
    property TimeAMString: string read GetTimeAMString write SetTimeAMString;
    property TimePMString: string read GetTimePMString write SetTimePMString;
    property TimeSeparator: Char read GetTimeSeparator write SetTimeSeparator;
    property TwoDigitYearCenturyWindow: Word read GetTwoDigitYearCenturyWindow write SetTwoDigitYearCenturyWindow;
  end;

var
  JclFormatSettings: TJclFormatSettings;

// Procedure to initialize the SimpleLog Variable
procedure InitSimpleLog(const ALogFileName: string = ''; AOpenLog: Boolean = true);

// Global Variable to make it easier for an application wide log handling.
// Must be initialized with InitSimpleLog before using
var
  SimpleLog : TJclSimpleLog;


// Validates if then variant value is null or is empty
function VarIsNullEmpty(const V: Variant): Boolean;
// Validates if then variant value is null or is empty or VarToStr is a blank string
function VarIsNullEmptyBlank(const V: Variant): Boolean;


{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL$';
    Revision: '$Revision$';
    Date: '$Date$';
    LogPath: 'JCL\source\common';
    Extra: '';
    Data: nil
    );
{$ENDIF UNITVERSIONING}

implementation

uses
  {$IFDEF HAS_UNIT_LIBC}
  Libc,
  {$ENDIF HAS_UNIT_LIBC}
  {$IFDEF MSWINDOWS}
  JclConsole,
  {$ENDIF MSWINDOWS}
  {$IFDEF HAS_UNITSCOPE}
  System.Variants, System.Types, System.Contnrs,
  {$IFDEF HAS_UNIT_ANSISTRINGS}
  System.AnsiStrings,
  {$ENDIF HAS_UNIT_ANSISTRINGS}
  {$ELSE ~HAS_UNITSCOPE}
  Variants, Types, Contnrs,
  {$IFDEF HAS_UNIT_ANSISTRINGS}
  AnsiStrings,
  {$ENDIF HAS_UNIT_ANSISTRINGS}
  {$ENDIF ~HAS_UNITSCOPE}
  JclFileUtils, JclMath, JclResources, JclStrings,
  JclStringConversions, JclSysInfo, JclWin32;

// memory initialization
procedure ResetMemory(out P; Size: Longint);
begin
  if Size > 0 then
  begin
    Byte(P) := 0;
    FillChar(P, Size, 0);
  end;
end;

// Pointer manipulation
procedure GetAndFillMem(var P: Pointer; const Size: Integer; const Value: Byte);
begin
  GetMem(P, Size);
  FillChar(P^, Size, Value);
end;

procedure FreeMemAndNil(var P: Pointer);
var
  Q: Pointer;
begin
  Q := P;
  P := nil;
  FreeMem(Q);
end;

function PCharOrNil(const S: string): PChar;
begin
  Result := Pointer(S);
end;

function PAnsiCharOrNil(const S: AnsiString): PAnsiChar;
begin
  Result := Pointer(S);
end;

{$IFDEF SUPPORTS_WIDESTRING}

function PWideCharOrNil(const W: WideString): PWideChar;
begin
  Result := Pointer(W);
end;

{$ENDIF SUPPORTS_WIDESTRING}

{$IFDEF MSWINDOWS}
type
  PUsed = ^TUsed;
  TUsed = record
    SizeFlags: Integer;
  end;

const
  cThisUsedFlag = 2;
  cPrevFreeFlag = 1;
  cFillerFlag   = Integer($80000000);
  cFlags        = cThisUsedFlag or cPrevFreeFlag or cFillerFlag;

function SizeOfMem(const APointer: Pointer): Integer;
var
  U: PUsed;
begin
  if IsMemoryManagerSet then
    Result:= -1
  else
  begin
    Result := 0;
    if APointer <> nil then
    begin
      U := APointer;
      U := PUsed(TJclAddr(U) - SizeOf(TUsed));
      if (U.SizeFlags and cThisUsedFlag) <> 0 then
        Result := (U.SizeFlags) and (not cFlags - SizeOf(TUsed));
    end;
  end;
end;
{$ENDIF MSWINDOWS}

{$IFDEF LINUX}
function SizeOfMem(const APointer: Pointer): Integer;
begin
  if IsMemoryManagerSet then
    Result:= -1
  else
  begin
    if APointer <> nil then
      Result := malloc_usable_size(APointer)
    else
      Result := 0;
  end;
end;
{$ENDIF LINUX}

function WriteProtectedMemory(BaseAddress, Buffer: Pointer;
  Size: Cardinal; out WrittenBytes: Cardinal): Boolean;
{$IFDEF MSWINDOWS}
var
  OldProtect, Dummy: Cardinal;
begin
  WrittenBytes := 0;
  if Size > 0 then
  begin
    // (outchy) VirtualProtect for DEP issues
    OldProtect := 0;
    Result := VirtualProtect(BaseAddress, Size, PAGE_EXECUTE_READWRITE, OldProtect);
    if Result then
    try
      Move(Buffer^, BaseAddress^, Size);
      WrittenBytes := Size;
      if OldProtect in [PAGE_EXECUTE, PAGE_EXECUTE_READ, PAGE_EXECUTE_READWRITE, PAGE_EXECUTE_WRITECOPY] then
        FlushInstructionCache(GetCurrentProcess, BaseAddress, Size);
    finally
      Dummy := 0;
      VirtualProtect(BaseAddress, Size, OldProtect, Dummy);
    end;
  end;
  Result := WrittenBytes = Size;
end;
{$ENDIF MSWINDOWS}
{$IFDEF LINUX}
{ TODO -cHelp : Author: Andreas Hausladen }
{ TODO : Works so far, but causes app to hang on termination }
var
  AlignedAddress: Cardinal;
  PageSize, ProtectSize: Cardinal;
begin
  Result := False;
  WrittenBytes := 0;

  PageSize := Cardinal(getpagesize);
  AlignedAddress := Cardinal(BaseAddress) and not (PageSize - 1); // start memory page
  // get the number of needed memory pages
  ProtectSize := PageSize;
  while Cardinal(BaseAddress) + Size > AlignedAddress + ProtectSize do
    Inc(ProtectSize, PageSize);

  if mprotect(Pointer(AlignedAddress), ProtectSize,
    PROT_READ or PROT_WRITE or PROT_EXEC) = 0 then // obtain write access
  begin
    try
      Move(Buffer^, BaseAddress^, Size); // replace code
      Result := True;
      WrittenBytes := Size;
    finally
      // Is there any function that returns the current page protection?
//    mprotect(p, ProtectSize, PROT_READ or PROT_EXEC); // lock memory page
    end;
  end;
end;

procedure FlushInstructionCache;
{ TODO -cHelp : Author: Andreas Hausladen }
begin
  // do nothing
end;

{$ENDIF LINUX}

// Guards

//=== { TJclSafeGuard } ======================================================

constructor TJclSafeGuard.Create(Mem: Pointer);
begin
  inherited Create;
  FItem := Mem;
end;

destructor TJclSafeGuard.Destroy;
begin
  FreeItem;
  inherited Destroy;
end;

function TJclSafeGuard.ReleaseItem: Pointer;
begin
  Result := FItem;
  FItem := nil;
end;

function TJclSafeGuard.GetItem: Pointer;
begin
  Result := FItem;
end;

procedure TJclSafeGuard.FreeItem;
begin
  if FItem <> nil then
    FreeMem(FItem);
  FItem := nil;
end;

//=== { TJclObjSafeGuard } ===================================================

constructor TJclObjSafeGuard.Create(Obj: TObject);
begin
  inherited Create(Pointer(Obj));
end;

procedure TJclObjSafeGuard.FreeItem;
begin
  if FItem <> nil then
  begin
    TObject(FItem).Free;
    FItem := nil;
  end;
end;

//=== { TJclMultiSafeGuard } =================================================

constructor TJclMultiSafeGuard.Create;
begin
  inherited Create;
  FItems := TList.Create;
end;

destructor TJclMultiSafeGuard.Destroy;
var
  I: Integer;
begin
  for I := FItems.Count - 1 downto 0 do
    FreeItem(I);
  FItems.Free;
  inherited Destroy;
end;

function TJclMultiSafeGuard.AddItem(Item: Pointer): Pointer;
begin
  Result := Item;
  FItems.Add(Item);
end;

procedure TJclMultiSafeGuard.FreeItem(Index: Integer);
begin
  FreeMem(FItems[Index]);
  FItems.Delete(Index);
end;

function TJclMultiSafeGuard.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TJclMultiSafeGuard.GetItem(Index: Integer): Pointer;
begin
  Result := FItems[Index];
end;

function TJclMultiSafeGuard.ReleaseItem(Index: Integer): Pointer;
begin
  Result := FItems[Index];
  FItems.Delete(Index);
end;

function Guard(Mem: Pointer; var SafeGuard: IMultiSafeGuard): Pointer; overload;
begin
  if SafeGuard = nil then
    SafeGuard := TJclMultiSafeGuard.Create;
  Result := SafeGuard.AddItem(Mem);
end;

//=== { TJclObjMultiSafeGuard } ==============================================

procedure TJclObjMultiSafeGuard.FreeItem(Index: Integer);
begin
  TObject(FItems[Index]).Free;
  FItems.Delete(Index);
end;

function Guard(Obj: TObject; var SafeGuard: IMultiSafeGuard): TObject; overload;
begin
  if SafeGuard = nil then
    SafeGuard := TJclObjMultiSafeGuard.Create;
  Result := SafeGuard.AddItem(Obj);
end;

function Guard(Mem: Pointer; out SafeGuard: ISafeGuard): Pointer; overload;
begin
  Result := Mem;
  SafeGuard := TJclSafeGuard.Create(Mem);
end;

function Guard(Obj: TObject; out SafeGuard: ISafeGuard): TObject; overload;
begin
  Result := Obj;
  SafeGuard := TJclObjSafeGuard.Create(Obj);
end;

function GuardGetMem(Size: Cardinal; out SafeGuard: ISafeGuard): Pointer;
begin
  GetMem(Result, Size);
  Guard(Result, SafeGuard);
end;

function GuardAllocMem(Size: Cardinal; out SafeGuard: ISafeGuard): Pointer;
begin
  Result := AllocMem(Size);
  Guard(Result, SafeGuard);
end;

{$IFDEF SUPPORTS_GENERICS_}
//=== { TSafeGuard<T> } ======================================================

constructor TSafeGuard<T>.Create(Instance: T);
begin
  inherited Create;
  FItem := Instance;
end;

destructor TSafeGuard<T>.Destroy;
begin
  FreeItem;
  inherited Destroy;
end;

function TSafeGuard<T>.ReleaseItem: T;
begin
  Result := FItem;
  FItem := nil;
end;

function TSafeGuard<T>.GetItem: T;
begin
  Result := FItem;
end;

procedure TSafeGuard<T>.FreeItem;
begin
  if FItem <> nil then
    FItem.Free;
  FItem := nil;
end;
{$ENDIF SUPPORTS_GENERICS_}

//=== Shared memory functions ================================================

type
  PMMFHandleListItem = ^TMMFHandleListItem;
  TMMFHandleListItem = record
    Next: PMMFHandleListItem;
    Memory: Pointer;
    Handle: THandle;
    Name: string;
    References: Integer;
  end;

  PMMFHandleList = PMMFHandleListItem;

var
  MMFHandleList: PMMFHandleList = nil;
  {$IFDEF THREADSAFE}
  MMFFinalized: Boolean = False;
  GlobalMMFHandleListCS: TJclIntfCriticalSection = nil;
  {$ENDIF THREADSAFE}

{$IFDEF THREADSAFE}
function GetAccessToHandleList: IInterface;
var
  OldValue: Pointer;
  CS: TJclIntfCriticalSection;
begin
  if not Assigned(GlobalMMFHandleListCS) and not MMFFinalized then
  begin
    CS := TJclIntfCriticalSection.Create;
    {$IFDEF RTL200_UP} // Delphi 2009+
    OldValue := InterlockedCompareExchangePointer(Pointer(GlobalMMFHandleListCS), Pointer(CS), nil);
    {$ELSE}
      {$IFDEF RTL160_UP} // Delphi 7-2007
    OldValue := Pointer(InterlockedCompareExchange(Longint(GlobalMMFHandleListCS), Longint(CS), 0));
      {$ELSE} // Delphi 5, 6
    OldValue := InterlockedCompareExchange(Pointer(GlobalMMFHandleListCS), Pointer(CS), nil);
      {$ENDIF RTL180_UP}
    {$ENDIF RTL185_UP}
    if OldValue <> nil then
      CS.Free;
  end;
  Result := GlobalMMFHandleListCS;
end;
{$ENDIF THREADSAFE}

{$IFDEF MSWINDOWS}

function SharedGetMem(var P{: Pointer}; const Name: string; Size: Cardinal;
  DesiredAccess: Cardinal = FILE_MAP_ALL_ACCESS): Integer;
var
  FileMappingHandle: THandle;
  Iterate, NewListItem: PMMFHandleListItem;
  Protect: Cardinal;
  {$IFDEF THREADSAFE}
  HandleListAccess: IInterface;
  {$ENDIF THREADSAFE}
begin
  Result := 0;
  Pointer(P) := nil;

  if not JclCheckWinVersion(5, 0) and ((Name = '') or (Pos('\', Name) > 0)) then
    raise ESharedMemError.CreateResFmt(@RsInvalidMMFName, [Name]);

  {$IFDEF THREADSAFE}
  HandleListAccess := GetAccessToHandleList;
  {$ENDIF THREADSAFE}

  // search for same name
  Iterate := MMFHandleList;
  while Iterate <> nil do
  begin
    if CompareText(Iterate^.Name, Name) = 0 then
    begin
      Inc(Iterate^.References);
      Pointer(P) := Iterate^.Memory;
      Result := ERROR_ALREADY_EXISTS;
      Exit;
    end;
    Iterate := Iterate^.Next;
  end;

  // open file mapping
  FileMappingHandle := OpenFileMapping(DesiredAccess, False, PChar(Name));
  if FileMappingHandle = 0 then
  begin
    if Size = 0 then
      raise ESharedMemError.CreateResFmt(@RsInvalidMMFEmpty, [Name]);

    Protect := PAGE_READWRITE;
    if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and (DesiredAccess = FILE_MAP_COPY) then
      Protect := PAGE_WRITECOPY;

    FileMappingHandle := CreateFileMapping(INVALID_HANDLE_VALUE, nil, Protect,
      0, Size, PChar(Name));
  end
  else
    Result := ERROR_ALREADY_EXISTS;

  if GetLastError = ERROR_ALREADY_EXISTS then
    Result := ERROR_ALREADY_EXISTS
  else
  begin
    if FileMappingHandle = 0 then
      RaiseLastOSError;
  end;

  // map view
  Pointer(P) := MapViewOfFile(FileMappingHandle, DesiredAccess, 0, 0, Size);
  if Pointer(P) = nil then
  begin
    try
      RaiseLastOSError;
    except
      CloseHandle(FileMappingHandle);
      raise;
    end;
  end;

  // add list item to MMFHandleList
  New(NewListItem);
  NewListItem^.Name := Name;
  NewListItem^.Handle := FileMappingHandle;
  NewListItem^.Memory := Pointer(P);
  NewListItem^.References := 1;

  NewListItem^.Next := MMFHandleList;
  MMFHandleList := NewListItem;
end;

function SharedAllocMem(const Name: string; Size: Cardinal;
  DesiredAccess: Cardinal = FILE_MAP_ALL_ACCESS): Pointer;
begin
  Result := nil;
  if (SharedGetMem(Result, Name, Size, DesiredAccess) <> ERROR_ALREADY_EXISTS) and
    ((DesiredAccess and (FILE_MAP_WRITE or FILE_MAP_COPY)) <> 0) and
    (Size > 0) and (Result <> nil) then
      ResetMemory(Pointer(Result)^, Size);
end;

function SharedFreeMem(var P{: Pointer}): Boolean;
var
  N, Iterate: PMMFHa…