{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   GM-Software                                               | }
{ |   ===========                                               | }
{ |                                                             | }
{ |   Project: All Projects                                     | }
{ |                                                             | }
{ |   Description: Commonly useful Routines/Objects/Types.      | }
{ |                                                             | }
{ |                                                             | }
{ |   Copyright (C) - 1996 - Gerrit Moeller.                    | }
{ |                                                             | }
{ |   Source code dstributed under MIT license.                 | }
{ |                                                             | }
{ |   See: https://www.gm-software.de                           | }
{ |                                                             | }
{ +-------------------------------------------------------------+ }

{$INCLUDE GMCompilerSettings.inc}

unit GMCommon;

interface

uses {$IFDEF JEDIAPI}jwaWinType, jwaWinError, jwaWinNT, jwaWinBase, jwaWinUser, jwaWinReg, JwaWinNLS,{$ELSE}Windows,{$ENDIF}
     SysUtils, GMStrDef, GMActiveX, GMIntf, GMCollections, GMUnionValue, TypInfo
     {$IFDEF CALLSTACK}, GMCallStack{$ENDIF};

type

  TGMTracePrefix = (tpNone, tpInformation, tpWarning, tpError, tpException, tpCall, tpExecute,
                    tpSQL, tpHttp, tpSOAP, tpTime, tpInterface, tpHTML, tpXML, tpSocket, tpFtp, tpText);

  TGMErrorAction = (eaContinue, eaAskUser, eaAbort);
  //TGMWaitResult = (wrSignaled, wrTimeout, wrAbandoned, wrError);
  TGMVersionResInfo = (viCompanyName, viProductName, viVersionText, viCopyRight, viComments, viFileVersion);
  TGMWinVersion = (wvInvalid, wvWin_3_11, wvWin95, wvWin98, wvWinNT, wvWin2000, wvWinXP, wvServer2003, wvVista, wvWin7, wvUnknown);
  TGM2DDirection = (d2dHorizontal, d2dVertical);
  TGM2DDirections = set of TGM2DDirection;
  TGMCursor = (crArrow, crIBeam, crWait, crCross, crUpArrow, crSize, crDrag, crSizeNESW,
               crSizeNS, crSizeNWSE, crSizeWE, crNo, crHandPoint, crAppStart, crHelp);

  TGMDateTimePart = (dtpSep0, dtpSign, dtpHour, dtpMinute, dtpSecond, dtpDay, dtpMonth, dtpDD, dtpMM, dtpYYYY, dtpYY, dtpHH, dtpNN, dtpSS, dtpUnknown);


const

  cGMTempFilePrefix = '~GM';
  cGMTempFileExtension = 'tmp';
  cPersistentFileExt = 'prs';
  //CHelpFileExt = 'HLP';

  cStrMaskAllFiles = '*.*';

  GM_USER = $0801; // $0400 => WM_USER, small Offset interferes with MS Up/down control ..
  UM_DONEMODAL = GM_USER - 1;

{$IFDEF FPC}
{$IFNDEF JEDIAPI}
  {$EXTERNALSYM QS_KEY}
  QS_KEY                  = $0001;
  {$EXTERNALSYM QS_MOUSEMOVE}
  QS_MOUSEMOVE            = $0002;
  {$EXTERNALSYM QS_MOUSEBUTTON}
  QS_MOUSEBUTTON          = $0004;
  {$EXTERNALSYM QS_POSTMESSAGE}
  QS_POSTMESSAGE          = $0008;
  {$EXTERNALSYM QS_TIMER}
  QS_TIMER                = $0010;
  {$EXTERNALSYM QS_PAINT}
  QS_PAINT                = $0020;
  {$EXTERNALSYM QS_SENDMESSAGE}
  QS_SENDMESSAGE          = $0040;
  {$EXTERNALSYM QS_HOTKEY}
  QS_HOTKEY               = $0080;
  {$EXTERNALSYM QS_ALLPOSTMESSAGE}
  QS_ALLPOSTMESSAGE       = $0100;

  {$EXTERNALSYM DT_WORD_ELLIPSIS}
  DT_WORD_ELLIPSIS = $40000;

  {$EXTERNALSYM CONNECT_E_FIRST}
  CONNECT_E_FIRST = HRESULT($80040200);
  {$EXTERNALSYM CONNECT_E_LAST}
  CONNECT_E_LAST  = HRESULT($8004020F);

  {$EXTERNALSYM CONNECT_E_NOCONNECTION}
  CONNECT_E_NOCONNECTION  = CONNECT_E_FIRST + 0;
  {$EXTERNALSYM CONNECT_E_ADVISELIMIT}
  CONNECT_E_ADVISELIMIT   = CONNECT_E_FIRST + 1;
  {$EXTERNALSYM CONNECT_E_CANNOTCONNECT}
  CONNECT_E_CANNOTCONNECT = CONNECT_E_FIRST + 2;
  {$EXTERNALSYM CONNECT_E_OVERRIDDEN}
  CONNECT_E_OVERRIDDEN    = CONNECT_E_FIRST + 3;
{$ENDIF}
{$ENDIF}


{$IFNDEF JEDIAPI}
  INVALID_FILE_ATTRIBUTES  = DWORD(-1);
  {$EXTERNALSYM INVALID_FILE_ATTRIBUTES}
  SORT_DIGITSASNUMBERS = $00000008; // treat digits like numbers
  {$EXTERNALSYM SORT_DIGITSASNUMBERS}
{$ENDIF}

  cUtf16LEBom: AnsiString = #$FF#$FE;
  cUtf16BEBom: AnsiString = #$FE#$FF;
  cUtf8Bom: AnsiString = #$EF#$BB#$BF;

  cMsgAwakeByAll = QS_ALLEVENTS or QS_ALLINPUT or QS_ALLPOSTMESSAGE;

  cSpaceCh = ' ';
  cWhiteSpace = cSpaceCh + #9#10#13;
  cChDontTerm = '^';

  cDfltExceptionMsg = '';
  cDfltHelpCtx = 0;
  cBeepInvalidChar = 0;
  cDfltPrntWnd = 0;
  cNoUIWnd = $FFFFFFFF;
  cHrPrntWnd = cNoUIWnd;

  cDontChangeTimerInterval = $FFFFFFFF;

  //CInvalidRefCount = -1;
  cDfltDateTime = 0;
  cDfltSizeInBytes = 0;

  cDfltAllocAlignment = SizeOf(Pointer);
  cDfltGlobalAllocFlags = GMEM_MOVEABLE;
  cDfltActiveStored = False;
  cDfltActivePersists = True;
  cDfltIIDRequired = True;
  cDfltCallEventsWhenDisabled = False;
  cDfltTimerInterval = 1000;
  cDfltSaveUSerData = False;
  cDfltAlwaysNotify = False;
  cDfltTextDrawFlags = DT_WORD_ELLIPSIS or DT_NOPREFIX;
  cDfltStorageRootKey = HKEY_CURRENT_USER;
  cDontUseRootKey = 0;

  cCoInitUseDflt = -1;
  cDontCoInit = -2;

  cInvalidUIPos = Low(LongInt);

  KEY_CREATE = KEY_READ or KEY_WRITE;
  KEY_DELETE = KEY_READ or KEY_WRITE; //  or _DELETE; // KEY_READ or KEY_CREATE_SUB_KEY or _DELETE; //

{$IFNDEF JEDIAPI}
  {$EXTERNALSYM MB_CANCELTRYCONTINUE}
  MB_CANCELTRYCONTINUE = $00000006;

  {$EXTERNALSYM FILE_ATTRIBUTE_ENCRYPTED}
  FILE_ATTRIBUTE_ENCRYPTED = $00000040;
  {$EXTERNALSYM FILE_ATTRIBUTE_SPARSE_FILE}
  FILE_ATTRIBUTE_SPARSE_FILE = $00000200;
  {$EXTERNALSYM FILE_ATTRIBUTE_REPARSE_POINT}
  FILE_ATTRIBUTE_REPARSE_POINT = $00000400;

  {$EXTERNALSYM STGM_DIRECT_SWMR}
  STGM_DIRECT_SWMR = $00400000;

  {$EXTERNALSYM WS_EX_LAYERED}
  WS_EX_LAYERED = $00080000;
  {$EXTERNALSYM WS_EX_COMPOSITED}
  WS_EX_COMPOSITED = $02000000;
  {$EXTERNALSYM LWA_COLORKEY}
  LWA_COLORKEY = $00000001;
  {$EXTERNALSYM LWA_ALPHA}
  LWA_ALPHA = $00000002;

  {$EXTERNALSYM KEY_WOW64_64KEY}
  KEY_WOW64_64KEY = $0100;
  {$EXTERNALSYM KEY_WOW64_32KEY}
  KEY_WOW64_32KEY = $0200;
{$ENDIF}

  {$EXTERNALSYM STGC_CONSOLIDATE}
  STGC_CONSOLIDATE = 8;

  cStrGMWebAddress = 'https://www.gm-software.de';
  cStrGMSupportMailAddr = 'support@gm-software.de';
  cStrGMProblemReportMailAddr = 'problem-reports@gm-software.de';
  cStrGMPersistentBasePath = '\Software\GM-Software';

  cStrNULL = 'NULL';
  cStrNone = '<None>';
  cStrMore = '...';
  cStr_More = ' ' + cStrMore;
  cStrSoftware = 'Software';
  cDirSep = '/\';
  cAbsKeyCh = '\';
  cValSepCh = ';';
  cInvalidFileNameChars = '\/:*?"<>|';
  cAllFilesExt = '*';

  cGuidStripChars = cWhiteSpace + '(){}[]"''';

  cInvalidItemIdx = Low(LongInt); // Low(PtrInt); // -1;

  cNullPoint: TPoint = (X: 0; Y: 0);
  cNullRect: TRect = (Left: 0; Top: 0; Right: 0; Bottom: 0);
  cNullSize: TSize = (cx: 0; cy: 0);

  cInvalidUIPoint: TPoint = (X: cInvalidUIPos; Y: cInvalidUIPos);
  cInvalidUIRect: TRect = (Left: cInvalidUIPos; Top: cInvalidUIPos; Right: cInvalidUIPos; Bottom: cInvalidUIPos);

  cAll2DDirections = [Low(TGM2DDirection)..High(TGM2DDirection)];

  cStrClassName = 'ClassName';

  cStrLeft = 'Left';
  cStrTop = 'Top';
  cStrRight = 'Right';
  cStrBottom = 'Bottom';

  cStrFixedDateSep = '.';
  cStrFixedTimeSep = ':';
  cStrFixedMilliSecSep = '-';
//cStrFixedDezSep = '.';
  cStrFixedDateFmt = 'dd"'+cStrFixedDateSep+'"mm"'+cStrFixedDateSep+'"yyyy'; // <- do not localize!
  cStrFixedTimeFmt = 'hh"'+cStrFixedTimeSep+'"nn"'+cStrFixedTimeSep+'"ss"'+cStrFixedMilliSecSep+'"zzz'; // <- do not localize!
//cStrFixedDateTimeFmt = cStrFixedDateFmt + ' ' + cStrFixedTimeFmt;

//cStrFixedDateFmt = 'dd"."mm"."yyyy';     // <- do not localize!
//cStrFixedTimeFmt = 'hh":"nn":"ss"-"zzz'; // <- do not localize!
  cStrFixedDateTimeFmt = cStrFixedDateFmt + ' ' + cStrFixedTimeFmt;
  
//cStrFixedDateTimeFmt = 'dd"."mm"."yyyy hh":"nn":"ss"-"zzz';

  cDecSep = '.';

  cStrDigits = '0123456789';
  cStrSigns = '-+';
  cStrHexChars = cStrDigits + 'abcdefABCDEF';

  cStrHexConvertChars: TGMString = '0123456789ABCDEF';

  cInvalidCPCookie = 0;

  cStrTCompareResult = 'TGMCompareResult';

  cStrVerInfoCompany = 'CompanyName';
  cStrVerInfoProduct = 'ProductName';
  cStrVerInfoCopyright = 'LegalCopyright';
  cStrVerInfoVersion = 'FileVersion';
  cStrVerInfoComments = 'Comments';

  cStrUserName = 'Username';
  cStrPassword = 'Password';
  cStrIsEncryptedPwd = 'PwdIsEncrypted';
  cStrSaveUserData = 'SaveUserData';

  cDfltUserName = '';
  cDfltPassword = '';

  cUnixStartDate: TDateTime = 25569.0;

  cMessageBoxIcon: array [TGMSeverityLevel] of LongWord = (0, mb_IconQuestion, mb_IconInformation, mb_IconExclamation, mb_IconStop);
  cVersionInfoKeys: array [TGMVersionResInfo] of TGMString = (cStrVerInfoCompany, cStrVerInfoProduct, cStrVerInfoVersion, cStrVerInfoCopyright, cStrVerInfoComments, '');
  cVersionInfoKeysA: array [TGMVersionResInfo] of AnsiString = (cStrVerInfoCompany, cStrVerInfoProduct, cStrVerInfoVersion, cStrVerInfoCopyright, cStrVerInfoComments, '');
  cGMTracePrefixes: array [TGMTracePrefix] of TGMString = ('', 'INFORMATION', 'WARNING', 'ERROR', 'EXCEPTION', 'CALL', 'EXECUTE', 'SQL', 'HTTP', 'SOAP', 'TIME', 'INTERFACE', 'HTML', 'XML', 'SOCKET', 'FTP', 'TEXT');
  cWinCursorRes: array [TGMCursor] of Pointer = (IDC_ARROW, IDC_IBEAM, IDC_WAIT, IDC_CROSS, IDC_UPARROW, IDC_SIZE, IDC_ICON,
                          IDC_SIZENESW, IDC_SIZENS, IDC_SIZENWSE, IDC_SIZEWE, IDC_NO, IDC_HAND, IDC_APPSTARTING, IDC_HELP);

  cGMSeveritySound: array [TGMSeverityLevel] of LongWord = (0, MB_ICONQUESTION, MB_ICONASTERISK, MB_ICONEXCLAMATION, MB_ICONHAND);

  cDateTimeFmtPatterns: array [TGMDateTimePart] of TGMString = ('*', 'SIGN', 'HOUR', 'MINUTE', 'SECOND', 'DAY', 'MONTH', 'DD', 'MM', 'YYYY', 'YY', 'HH', 'NN', 'SS', '');

  
type

  PBoolean = ^Boolean;
  
  { ----------------------------- }
  { ---- Function Prototypes ---- }
  { ----------------------------- }

  TProcedure = procedure;

  TGMBooleanFunc = function: Boolean; stdcall;
  TGMMessageBoxFunc = function (const Msg: TGMString; const Severity: TGMSeverityLevel = svInformation; Flags: LongWord = 0; const ParentWnd: HWnd = cDfltPrntWnd): LongInt; stdcall;
  TGMTraceProc = procedure (const AText: TGMString; const APrefix: TGMString = '');
  TGMTraceLineProc = procedure (const ALine: TGMString);
  TProcessLineProc = procedure (const ALine: TGMString; const Data: Pointer);
  TGMInfoProc = TProcedure;

  //TGMExceptionHandlerFunc = function (const AException: TObject; const ParentWnd: HWnd = cDfltPrntWnd; const DefaultCode: LongWord = ERROR_INTERNAL_ERROR): LongWord; stdcall;
  TGMHrExceptionHandlerFunc = function (const AException: TObject; const ParentWnd: HWnd; const DefaultCode: HResult = E_UNEXPECTED): HResult; stdcall; // cHrPrntWnd
  TGMExceptionDlgFunc = function (const AException: TObject; const ParentWnd: HWnd = cDfltPrntWnd): LongInt; stdcall;

  TGMObjectProc = procedure of object;
  TGMObjNotifyProc = procedure(const Sender: TObject) of object;
  TGMObjNotifyBoolFunc = function(const Sender: TObject): Boolean of object;

  TGMGetStringFunc = function: TGMString of object;
  TGMSetStringProc = procedure (const Value: TGMString) of object;

  TGMAddLineFunc = function (const ALine: TGMString; const ALastLine: Boolean; const AData: Pointer): Boolean;


  { ----------------- }
  { ---- Classes ---- }
  { ----------------- }

  TGMHandleObj = class(TGMRefCountedObj, IGMGetHandle, IGMHashCode)
   protected
    FHandle: THandle;

   public
    constructor Create(const AHandle: THandle; const ARefLifeTime: Boolean = True); reintroduce; overload;
    function GetHandle: THandle; stdcall;
    function GetHandleAddr: Pointer;
    function HashCode: TGMHashCode;
    property Handle: THandle read FHandle;
    property HandleAddr: Pointer read GetHandleAddr; // <- useful for calls to WaitForMultipleObjects
  end;


  TGMCloseHandleObj = class(TGMHandleObj)
   public
    destructor Destroy; override;
  end;


  TGMHotKeyTable = class(TGMHandleObj)
  // Virtual key codes:
  // https://docs.microsoft.com/en-us/windows/desktop/inputdev/virtual-key-codes
   public
    constructor Create(const AKeys: array of TAccel; const ARefLifeTime: Boolean = True); reintroduce; overload;
    destructor Destroy; override;
  end;


  TGMNamedOsHandleObj = class(TGMCloseHandleObj, IGMGetName)
   protected
    FName: TGMString;
   public
    function GetName: TGMString; stdcall;
    property Name: TGMString read FName;
  end;


  TGMMutableHandleObj = class(TGMHandleObj, IGMGetSetHandle)
   public
    procedure SetHandle(const Value: THandle); stdcall;
  end;


  TGMRegKey = class;

  IGMRegKey = interface(IGMGetHandle)
    ['{9211EC93-F0A1-4e99-AD71-1BEE41B15EB4}']
    function Obj: TGMRegKey;
  end;

  { TGMRegKey }

  TGMRegKey = class(TGMRefCountedObj, IGMGetHandle, IGMRegKey)
   protected
    FRootKeyRef: IUnknown;
    FRootKey: HKEY;
    FHandle: HKEY;

    function FormatKeyPath(const Value: TGMString): TGMString;

   public // Interfaces
    function Obj: TGMRegKey;
    function GetHandle: THandle; stdcall;

    constructor Create(const ARefLifeTime: Boolean = True); override;
    constructor CreateKey(const ARootKey: HKEY; AKeyPath: TGMString = ''; const AAccessMode: DWORD = KEY_CREATE; const ARefLifeTime: Boolean = True); reintroduce; overload;
    constructor CreateKey(const ARootKey: IUnknown; const AKeyPath: TGMString = ''; const AAccessMode: DWORD = KEY_CREATE; const ARefLifeTime: Boolean = True); reintroduce; overload;
    destructor Destroy; override;
    procedure CloseKey;
    function OpenKey(const ARootKey: HKEY; const AKeyPath: TGMString = ''; const ACheckExists: Boolean = False; const AAccessMode: DWORD = KEY_READ): Boolean; overload;
    function OpenKey(const ARootKey: IUnknown; const AKeyPath: TGMString = ''; const ACheckExists: Boolean = False; const AAccessMode: DWORD = KEY_READ): Boolean; overload;
    procedure ReadValueNames(var Names: TGMStringArray);
    procedure ReadSubKeyNames(var Names: TGMStringArray);
    function DeleteValue(const AValueName: TGMString): Boolean;
    function DeleteKey(const ARootKey: HKEY; const AKeyPath: TGMString; const ARecurse: Boolean): Boolean;
    function ValueExists(const AValueName: TGMString): Boolean;
    function ReadString(const AValueName: TGMString; const ADefaultValue: TGMString = ''): TGMString;
    function ReadInteger(const AValueName: TGMString; const ADefaultValue: LongInt = 0): LongInt;
    function ReadBinary(const AValueName: TGMString; const ADestData: Pointer; const ADestDataSizeInBytes: LongInt): DWORD;
    procedure WriteString(const AValueName, Value: TGMString);
    procedure WriteInteger(const AValueName: TGMString; const Value: LongInt);
    procedure WriteBinary(const AValueName: TGMString; const Data; const DataSize: DWORD);
  end;


  IGMWaitFor = interface(IUnknown)
    ['{340FE1DC-8690-4A51-83F1-19472E1C19A1}']
    function WaitFor(const AProcessMessages: Boolean; const Timeout: DWORD = INFINITE): DWORD;
  end;


  IGMEvent = interface(IGMWaitFor)
    ['{016F7E8A-7219-4CC2-9132-AD61CB0E7A9E}']
    procedure Signal;
    procedure Reset;
  end;


  TGMEvent = class(TGMNamedOsHandleObj, IGMEvent)
   public
    constructor Create(const AManualReset, AInitialSignaled: Boolean;
                       const AName: TGMString = '';
                       const ASecurityAttr: PSecurityAttributes= nil;
                       const ARefLifetime: Boolean = True); reintroduce;
    function WaitFor(const AProcessMessages: Boolean; const Timeout: DWORD = INFINITE): DWORD;
    procedure Signal;
    procedure Reset;
  end;


  TGMMutex = class(TGMNamedOsHandleObj, IGMCriticalSection)
   //
   // Use a mutex like a critical section. This allows so serve the message queue while waiting.
   // A Mutex is re-entrant like a critical section but works across process boundaries too.
   //
   protected
    FProcessMessagesWhileWaiting: Boolean;
    FTimeout: DWORD;

   public
    constructor Create(const AName: TGMString = '';
                       const AProcessMessagesWhileWaiting: Boolean = False;
                       const ATimeout: DWORD = INFINITE;
                       const ASecurityAttr: PSecurityAttributes= nil;
                       const ARefLifetime: Boolean = True); reintroduce;

    procedure EnterCriticalSection;
    procedure LeaveCriticalSection;
  end;


  IGMSemaphore = interface(IUnknown)
    ['{FCFBC53F-BBAB-404B-B414-E338FD5C762C}']
    procedure EnterShared;
    procedure LeaveShared;

    procedure EnterSingleExclusive;
    procedure LeaveSingleExclusive;
  end;

  TGMSemaphore = class(TGMNamedOsHandleObj, IGMSemaphore)
   protected
    FMaxShareCount: LongInt;

   public
    constructor Create(const AMaxShareCount: LongInt;
                       const AName: TGMString = '';
//                     const AProcessMessagesWhileWaiting: Boolean = False;
                       const ASecurityAttr: PSecurityAttributes= nil;
                       const ARefLifetime: Boolean = True); reintroduce;

    procedure EnterShared;
    procedure LeaveShared;

    procedure EnterSingleExclusive;
    procedure LeaveSingleExclusive;
  end;


  IGMTimer = interface(IGMGetHandle)
    ['{5D2C8DAA-3C88-4EE3-9B34-6BD418D3B1BE}']
    procedure Restart(const ANewIntervalMS: UINT = cDontChangeTimerInterval);
    procedure Start;
    procedure Stop;
    function IsRunning: BOOL;
    function GetInterval: UINT;
    procedure SetInterval(const AInterval: UINT);
    property Interval: UINT read GetInterval write SetInterval;
  end;


  {$IFDEF JEDIAPI}
  TGMWaitableTimer = class(TGMNamedOsHandleObj, IGMTimer)
   protected
    FDueTime: LARGE_INTEGER;
    FInterval: LONG;
    FIsRunning: BOOL;
    FExecRoutine: PTIMERAPCROUTINE;
    FExecRoutineArg: Pointer;

   public
    constructor Create(const ADueTime: Int64; // See Microsoft help for CreateWaitableTimer
                       const AAutoStart: Boolean = False;
                       const AName: TGMString = '';
                       const AInterval: LONG = 0;
                       const AExecRoutine: PTIMERAPCROUTINE = nil;
                       const AExecRoutineArg: Pointer = nil;
                       const ASecurityAttr: PSecurityAttributes= nil;
                       const ARefLifetime: Boolean = True); reintroduce;

    destructor Destroy; override;
    procedure Start;
    procedure Restart(const ANewIntervalMS: UINT = cDontChangeTimerInterval);
    procedure Stop;
    function IsRunning: BOOL;
    function GetInterval: UINT;
    procedure SetInterval(const AInterval: UINT);
  end;
  {$ENDIF}


  TGMTimerBase = class(TGMRefCountedObj, IGMGetHandle, IGMTimer)
   protected
    FTimerId: UINT;
    FInterval: UINT;
    function GetInterval: UINT;
    procedure SetInterval(const AInterval: UINT);
    function GetHandle: THandle; virtual; stdcall;

   public
    destructor Destroy; override;
//  function Obj: TGMTimerBase;
    procedure Restart(const ANewIntervalMS: UINT = cDontChangeTimerInterval);
    procedure Start; virtual; abstract;
    procedure Stop; virtual; abstract;
    function IsRunning: BOOL;
    property Interval: UINT read GetInterval write SetInterval;
  end;


  TGMThreadTimer = class(TGMTimerBase)
   protected
    FCaller: TObject;   
    FOnTimerProc: TGMObjNotifyProc;
    procedure DoOnTimer; virtual;

   public
    constructor Create(const AOnTimerProc: TGMObjNotifyProc = nil;
                       const ACaller: TObject = nil;
                       const AWaitTimeoutMilliSec: UINT = cDfltTimerInterval;
                       const AAutoStart: Boolean = False;
                       const ARefLifeTime: Boolean = True); reintroduce; overload; virtual;

    procedure Start; override;
    procedure Stop; override;
    property OnTimer: TGMObjNotifyProc read FOnTimerProc write FOnTimerProc;
  end;


  TGMWndTimer = class(TGMTimerBase)
   protected
    FWnd: HWnd;
    FClientID: LongInt;
    function GetHandle: THandle; override;

   public
    constructor Create(const AWnd: HWnd; const ATimerID: LongInt; const AWaitTimeoutMilliSec: LongInt = cDfltTimerInterval;
        const AAutoStart: Boolean = False; const ARefLifeTime: Boolean = True); reintroduce; overload; virtual;

    procedure Start; override;
    procedure Stop; override;
  end;


  TGMThread = class;

  IGMThread = interface(IUnknown)
    ['{3DC881DD-24DC-41dc-B309-6629CDA7D434}']
    function Obj: TGMThread;
  end;

  TGMThread = class(TGMCloseHandleObj, IGMThread)
   //
   // Get rid of all the stupid things in borlands Classes.TThread.
   // This one is much simpler and has a nice exception wrapper and COM initialization.
   //
   protected
    FThreadId: DWORD;
    FSuspendCount: LongInt;
    FCanceled: BOOL;
    FCoInitFlags: LongInt;
    FTerminated: Boolean;
    FAllowExceptDlg: Boolean;
    FHasBeenRunning: Boolean;

   public
    FreeOnTerminate: Boolean;
    WaitTimeoutOnDestroy: DWORD;

    constructor Create(const ACoInitFlags: LongInt = cCoInitUseDflt; // <- must be first parameter to avoid ambiguity with inherited constructor
                       const ACreateSuspended: Boolean = True;
                       const APriority: LongInt = THREAD_PRIORITY_NORMAL;
                       const AAllowExceptDlg: Boolean = False;
                       AThreadProc: Pointer = nil;
                       const AStackSize: LongWord = 0;
                       const ASecurityAttr: PSecurityAttributes = nil;
                       const ARefLifeTime: Boolean = True); reintroduce; overload;

    destructor Destroy; override;
    function Obj: TGMThread;
    function Execute: HResult; virtual; abstract; // <- return value becomes thread Exit code

    function Suspend: DWORD;
    function Resume: DWORD;
    procedure Run; virtual;
    procedure Cancel; virtual;
    function WaitFor(const AProcessMessages: Boolean; const Timeout: DWORD = INFINITE): HResult;

    function GetPriority: LongInt;
    procedure SetPriority(const AValue: LongInt);

    property ThreadID: LongWord read FThreadId;
    property SuspendCount: LongInt read FSuspendCount;
    property HasBeenRunning: Boolean read FHasBeenRunning;
    property Priority: LongInt read GetPriority write SetPriority;
    property Canceled: BOOL read FCanceled;
    property Terminated: Boolean read FTerminated;
  end;


  TGMThreadTermMsgDataRec = record
    TargetWnd: THandle;
    Msg: Integer;
    WParam: WPARAM;
    LParam: LPARAM;
  end;

  TGMSilentThread = class;

  IGMSilentThread = interface(IUnknown)
    ['{C26731AE-59DF-4689-92F3-A5A487D8D975}']
    function Obj: TGMSilentThread;
  end;

  TGMSilentThread = class(TGMThread, IGMSilentThread)
   protected
    FExceptInfo: IGMExceptionInformation;
    FCSTermMsgData: IGMCriticalSection;
    FTermMsg: TGMThreadTermMsgDataRec;

    function DfltExceptResult: HResult; virtual;
    function Obj: TGMSilentThread;

   public
    {$IFDEF CALLSTACK}
    ExceptCallStack: IGMThreadCallStack;
//  ExceptCallStack: TGMIntegerArray;
    {$ENDIF}

    constructor Create(const ARefLifeTime: Boolean); overload; override;
    procedure SetTermMsgData(const ATermMsgData: TGMThreadTermMsgDataRec); virtual;
    procedure SendTerminationMsg; virtual;
    function InternalExecute: HResult; virtual; abstract;
    function Execute: HResult; override;
    property ExceptInfo: IGMExceptionInformation read FExceptInfo write FExceptInfo;
  end;


  TGMTempCursor = class(TGMRefCountedObj)
   protected
    FOldCursor: HCursor;
    FPMemberVar: PHandle;
    FOldMemeberVarValue: THandle;

   public
    constructor Create(const ANewCursor: TGMCursor; const APMemberVar: PHandle = nil; const ARefLifeTime: Boolean = True); reintroduce;
    destructor Destroy; override;
  end;


  {IGMMemoryBuffer = interface(IUnknown)
    ['9C07F06F-FFC9-4047-8A23-FBEBB88AF307']
    function GetMemory: Pointer;
    function GetSizeInBytes: Cardinal;
    function GetAllocAlignment: LongWord;
    function GetZeroInit: Boolean;
    function GetFreeMemoryOnDestroy: Boolean;
    procedure SetAllocAlignment(const Value: LongWord);
    procedure SetZeroInit(const Value: Boolean);
    procedure SetFreeMemoryOnDestroy(const Value: Boolean);
    procedure Realloc(NewSizeInBytes: Cardinal);
    procedure FreeMemory;
    property Memory: Pointer read GetMemory;
    property SizeInBytes: Cardinal read GetSizeInBytes;
    property AllocAlignment: LongWord read GetAllocAlignment write SetAllocAlignment;
    property ZeroInit: Boolean read GetZeroInit write SetZeroInit;
    property FreeMemoryOnDestroy: Boolean read GetFreeMemoryOnDestroy write SetFreeMemoryOnDestroy;
  end;}

  TGMMemoryBuffer = class;

  IGMMemoryBuffer = interface(IUnknown)
    ['{9C07F06F-FFC9-4047-8A23-FBEBB88AF307}']
    function Obj: TGMMemoryBuffer;
  end;

  TGMMemoryBuffer = class(TGMRefCountedObj, IGMMemoryBuffer)
   //
   // Can be used as a aggregate for interface delegation via "implements" compiler featrue.
   // Will redirect QueryInterface calls to it's owner if the requested interface isn't
   // supported by itself and owner <> nil.
   //
   // If used as interface delegation member the owner must refernece this class by a normal
   // object pointer and not an interface. Because reference counts are routed back to the
   // owner by this class a cyclic reference would keep the owner forever. For the same reason
   // this class must not reference other delegation classes of the owner by interfaces.
   //
   // Note: This is the only solution always working.
   //
   protected
    FOwner: TObject;
    FMemory: Pointer;
    FAllocAlignment: LongWord;
    FZeroInit: Boolean;
    FFreeMemoryOnDestroy: Boolean;
    FSizeInBytes: Int64;
    FOnAfterRealloc: TGMObjNotifyProc;

    function GetMemory: Pointer;
    function GetSizeInBytes: Int64;
    function GetAllocAlignment: LongWord;
    function GetZeroInit: Boolean;
    function GetFreeMemoryOnDestroy: Boolean;
    procedure SetAllocAlignment(const Value: LongWord);
    procedure SetZeroInit(const Value: Boolean);
    procedure SetFreeMemoryOnDestroy(const Value: Boolean);
    procedure InternalRealloc(const ANewSizeInBytes: Int64); virtual;

   public
    constructor Create(const AOwner: TObject = nil;
                       const ASizeInBytes: Int64 = 0;
                       const AAllocAlignment: LongWord = cDfltAllocAlignment;
                       const AZeroInit: Boolean = False;
                       const AFreeMemoryOnDestroy: Boolean = True;
                       const AOnAfterRealloc: TGMObjNotifyProc = nil;
                       const ARefLifeTime: Boolean = True); reintroduce; virtual;

    destructor Destroy; override;
    function QueryInterface({$IFDEF FPC}constref{$ELSE}const{$ENDIF} IID: TGUID; out Intf): HResult; override;
    function _AddRef: LongInt; override;
    function _Release: LongInt; override;
    function Obj: TGMMemoryBuffer;
    procedure FreeMemory; virtual;
    procedure ReallocMemory(ANewSizeInBytes: Int64); virtual;
    property Memory: Pointer read GetMemory;
    property AllocAlignment: LongWord read GetAllocAlignment write SetAllocAlignment;
    property SizeInBytes: Int64 read GetSizeInBytes;
    property ZeroInit: Boolean read GetZeroInit write SetZeroInit;
    property FreeMemoryOnDestroy: Boolean read GetFreeMemoryOnDestroy write SetFreeMemoryOnDestroy;
  end;


  TGMGlobalMemoryBuffer = class(TGMMemoryBuffer, IGMGetHandle, IGMGetSetHandle)
   protected
    FHGlobal: HGLOBAL;
    FAllocFlags: LongWord;
    procedure InternalRealloc(const ANewSizeInBytes: Int64); override;

   public
    function GetHandle: THandle; stdcall;
    procedure SetHandle(const Value: THandle); stdcall;

   public
    constructor Create(const AOwner: TObject = nil;
                       const ASizeInBytes: Int64 = 0;
                       const AAllocAlignment: LongWord = cDfltAllocAlignment;
                       const AZeroInit: Boolean = False;
                       const AFreeMemoryOnDestroy: Boolean = True;
                       const AOnAfterRealloc: TGMObjNotifyProc = nil;
                       const ARefLifeTime: Boolean = True); overload; override;

    constructor Create(const AOwner: TObject = nil;
                       const ASizeInBytes: Int64 = 0;
                       const AAllocAlignment: LongWord = cDfltAllocAlignment;
                       const AAllocFlags: LongWord = cDfltGlobalAllocFlags;
                       const AZeroInit: Boolean = False;
                       const AFreeMemoryOnDestroy: Boolean = True;
                       const AOnAfterRealloc: TGMObjNotifyProc = nil;
                       const ARefLifeTime: Boolean = True); reintroduce; overload; virtual;
   destructor Destroy; override;

   property Handle: THandle read GetHandle;
  end;


  IGMGetAnsiText = interface(IUnknown)
    ['{E6114C8A-BA01-430F-BBCD-B1AB1FEBD27F}']
    function GetAnsiText: AnsiString;
  end;


  TGMAnsiStringMemoryBuffer = class(TGMMemoryBuffer, IGMGetText, IGMGetAnsiText)
   protected
    FAnsiStringBuffer: AnsiString;
    procedure InternalRealloc(const ANewSizeInBytes: Int64); override;
   public
    constructor Create(const AOwner: TObject = nil;
                       const AContentAsString: AnsiString = '';
                       const AOnAfterRealloc: TGMObjNotifyProc = nil;
                       const ARefLifeTime: Boolean = True); reintroduce; // overload; virtual;
    function GetText: TGMString; stdcall;
    function GetAnsiText: AnsiString;
  end;


  TGMStringMemoryBuffer = class(TGMMemoryBuffer, IGMGetText) // IGMGetAnsiText
   protected
    FStringBuffer: TGMString;
    procedure InternalRealloc(const ANewSizeInBytes: Int64); override;
   public
    constructor Create(const AOwner: TObject = nil;
                       const AContentAsString: TGMString = '';
                       const AOnAfterRealloc: TGMObjNotifyProc = nil;
                       const ARefLifeTime: Boolean = True); reintroduce; // overload; virtual;

    function GetText: TGMString; stdcall;
    //function GetAnsiText: AnsiString;
  end;


  TGMResourceMemoryBuffer = class(TGMMemoryBuffer)
   protected
    procedure InternalRealloc(const ANewSizeInBytes: Int64); override;

   public
    constructor Create(const AOwner: TObject = nil;
                       const AResourceName: PGMChar = nil;
                       const AResourceType: PGMChar = nil;
                       AModuleHandle: THandle = INVALID_HANDLE_VALUE;
                       const AOnAfterRealloc: TGMObjNotifyProc = nil;
                       const ARefLifeTime: Boolean = True); reintroduce; // virtual;
  end;


  TGMMemoryLockBytes = class(TGMRefCountedObj, IGMGetOffset,
                                               IGMGetSetOffset,
                                               ILockBytes,
                                               IGMShiftOffset,
                                               IGMAssignFromIntf,
                                               IGMMemoryBuffer)
   //
   // This class is a ILockBytes implementation on Heap memory.
   //
   protected
    FMemoryBuffer: TGMMemoryBuffer;
    FFullDataSize: Int64;
    FOffset: PtrInt;
    FCTime, FATime, FMTime: TFileTime;

    function GetDataSize: Int64; virtual;
    procedure InternalSetSize(ANewSize: Int64); virtual;
    //function CreateMemoryBuffer(const ASizeInBytes, AAllocAlignment: LongInt; const AZeroInit, AFreeMemoryOnDestroy: Boolean): TGMMemoryBuffer; virtual;
    procedure OnAfterRealloc(const ASender: TObject); virtual;

   public
    constructor Create(const AAllocAlignment: LongInt = cDfltAllocAlignment;
                       const AZeroInit: Boolean = False;
                       const AFreeMemoryOnDestroy: Boolean = True;
                       const ASizeInBytes: Int64 = 0;
                       const ARefLifeTime: Boolean = True); reintroduce; virtual;

    destructor Destroy; override;

    function Memory: Pointer;

    procedure AssignFromIntf(const ASource: IUnknown); virtual; stdcall;
    procedure Clear(const AResetOffset: Boolean = True); virtual;

    // IGMGetSetOffset
    function GetOffset: PtrInt; virtual; stdcall;
    procedure SetOffset(AValue: PtrInt); virtual; stdcall;

    // IGMShiftOffset
    procedure SetOffsetAndShiftData(const ANewOffset: LongInt); virtual; stdcall;

    // ILockBytes
    function ReadAt(ulOffset: Int64; pv: Pointer; cb: LongInt; pcbRead: PLongint): HResult; virtual; stdcall;
    function WriteAt(ulOffset: Int64; pv: Pointer; cb: LongInt; pcbWritten: PLongint): HResult; virtual; stdcall;
    function SetSize(cb: Int64): HResult; virtual; stdcall;
    function LockRegion(libOffset: Int64; cb: Int64; dwLockType: LongInt): HResult; virtual; stdcall;
    function UnlockRegion(libOffset: Int64; cb: Int64; dwLockType: LongInt): HResult; virtual; stdcall;
    function Stat(out statstg: TStatStg; grfStatFlag: LongInt): HResult; virtual; stdcall;
    function Flush: HResult; virtual; stdcall;

    property DataSize: Int64 read GetDataSize;
    property Offset: PtrInt read GetOffset write SetOffset;
    property MemoryBuffer: TGMMemoryBuffer read FMemoryBuffer implements IGMMemoryBuffer;
  end;


  TGMIStreamBase = class;
  TGMIStreamRootClass = class of TGMIStreamBase;

  TGMIStreamBase = class(TGMRefCountedObj, ISequentialStream, IStream, IGMGetName)
   protected
    FCaptureExceptions: Boolean;
    FMode: DWORD;
    FName: UnicodeString;

    function InternalGetSize: Int64; virtual;

   public // Interfaces
    constructor Create(const AMode: DWORD; const AName: UnicodeString = ''; const ARefLifeTime: Boolean = True); reintroduce; overload;
    function GetName: TGMString; stdcall;
    // ISequentialStream
    function Read(pv: Pointer; cb: LongInt; pcbRead: PLongint): HResult; virtual; stdcall; abstract;
    function Write(pv: Pointer; cb: LongInt; pcbWritten: PLongint): HResult; virtual; stdcall; abstract;

    // IStream
    function Seek(dlibMove: Int64; dwOrigin: LongInt; libNewPosition: PInt64): HResult; virtual; stdcall; abstract;
    function SetSize(libNewSize: Int64): HResult; virtual; stdcall;
    function CopyTo(stm: IStream; cb: Int64; out cbRead: Int64; out cbWritten: Int64): HResult; virtual; stdcall;
    function Commit(grfCommitFlags: LongInt): HResult; virtual; stdcall;
    function Revert: HResult; virtual; stdcall;
    function LockRegion(libOffset: Int64; cb: Int64; dwLockType: LongInt): HResult; virtual; stdcall;
    function UnlockRegion(libOffset: Int64; cb: Int64; dwLockType: LongInt): HResult; virtual; stdcall;
    function Stat(out statstg: TStatStg; grfStatFlag: LongInt): HResult; virtual; stdcall;
    function Clone(out stm: IStream): HResult; virtual; stdcall;

    function CloneCreateClass: TGMIStreamRootClass; virtual;

    property CaptureExceptions: Boolean read FCaptureExceptions write FCaptureExceptions;
  end;


  TGMSequentialIStream = class(TGMIStreamBase)
   //
   // Internal read/write are called repeatedly if they dont deliver all
   // data with the first call until all requested data is processed.
   // Seek does the best sequential streams can do.
   //
   protected
    FSize: Int64;
    FPosition: Int64;
    // Internal rotuines may raise, and may deliver less data than requested
    function InternalGetSize: Int64; override;
    procedure InternalRead(pv: Pointer; cb: LongWord; var pcbRead: LongWord); virtual; abstract;
    procedure InternalWrite(pv: Pointer; cb: LongWord; var pcbWritten: LongWord); virtual; abstract;

   public
    function Read(pv: Pointer; cb: LongInt; pcbRead: PLongint): HResult; override; stdcall;
    function Write(pv: Pointer; cb: LongInt; pcbWritten: PLongint): HResult; override; stdcall;
    function Seek(dlibMove: Int64; dwOrigin: LongInt; libNewPosition: PInt64): HResult; override; stdcall;
  end;


  TGMMemoryIStreamBase = class;

  IGMMemoryStream = interface(IUnknown)
    ['{732B500B-F422-43cd-A45D-6181D5B02405}']
    function Obj: TGMMemoryIStreamBase;
  end;

  TGMMemoryIStreamBase = class(TGMSequentialIStream, IGMMemoryBuffer, IGMMemoryStream)
   protected
    FMemoryBuffer: TGMMemoryBuffer;

    procedure InternalRead(pv: Pointer; cb: LongWord; var pcbRead: LongWord); override;
    procedure InternalWrite(pv: Pointer; cb: LongWord; var pcbWritten: LongWord); override;
    procedure InternalSetSize(NewSize: Int64); virtual;
    procedure LimitPosition; virtual;

    procedure OnAfterRealloc(const Sender: TObject); virtual;

   public
    destructor Destroy; override;
    function Obj: TGMMemoryIStreamBase;
    function Memory: Pointer;
    function Size: Int64;
    procedure Clear; virtual;

    function SetSize(libNewSize: Int64): HResult; override;
    function Seek(dlibMove: Int64; dwOrigin: LongInt; libNewPosition: PInt64): HResult; override;

    property MemoryBuffer: TGMMemoryBuffer read FMemoryBuffer implements IGMMemoryBuffer;
  end;


  TGMMemoryIStream = class(TGMMemoryIStreamBase)
   protected
    function CreateMemoryBuffer(const ASizeInBytes: Int64; const AAllocAlignment: LongInt; const AZeroInit, AFreeMemoryOnDestroy: Boolean): TGMMemoryBuffer; virtual;

   public
    constructor Create(const AAllocAlignment: LongInt = cDfltAllocAlignment;
                       const AZeroInit: Boolean = False;
                       const AFreeMemoryOnDestroy: Boolean = True;
                       const ASizeInBytes: Int64 = 0;
                       const ARefLifeTime: Boolean = True); overload; virtual;
  end;


  TGMGlobalMemoryIStream = class(TGMMemoryIStream, IGMGetHandle)
   protected
    FAllocFlags: LongWord;
    
    function CreateMemoryBuffer(const ASizeInBytes: Int64; const AAllocAlignment: LongInt; const AZeroInit, AFreeMemoryOnDestroy: Boolean): TGMMemoryBuffer; override;

   public
    constructor Create(const AAllocAlignment: LongInt = cDfltAllocAlignment;
                       const AZeroInit: Boolean = False;
                       const AFreeMemoryOnDestroy: Boolean = True;
                       const ASizeInBytes: Int64 = 0;
                       const ARefLifeTime: Boolean = True); overload; override;

    constructor Create(const AAllocAlignment: LongInt = cDfltAllocAlignment;
                       const AAllocFlags: LongWord = cDfltGlobalAllocFlags;
                       const AHGlobal: HGlobal = 0;
                       const AZeroInit: Boolean = False;
                       const AFreeMemoryOnDestroy: Boolean = True;
                       const ASizeInBytes: Int64 = 0;
                       const ARefLifeTime: Boolean = True); reintroduce; overload; virtual;

    function GetHandle: THandle; stdcall;
    procedure AssignGlobalMemory(const AHGlobal: HGLOBAL; const ADataSize: Int64 = -1; const APosition: LongInt = 0);
    property Handle: THandle read GetHandle;
  end;


  TGMResourceIStream = class(TGMMemoryIStreamBase)
   public
    constructor Create(const AResourceName: PGMChar = nil;
                       const AResourceType: PGMChar = nil;
                       const AModuleHandle: THandle = INVALID_HANDLE_VALUE;
                       const ARefLifeTime: Boolean = True); reintroduce; virtual;
  end;


  TGMAnsiStringIStream  = class(TGMMemoryIStreamBase, IGMGetText, IGMGetAnsiText)
   public
    constructor Create(const AContentAsString: AnsiString = ''; const ARefLifeTime: Boolean = True); reintroduce; virtual;
    function GetText: TGMString; stdcall;
    function GetAnsiText: AnsiString;
  end;


  TGMStringIStream  = class(TGMMemoryIStreamBase, IGMGetText) // IGMGetAnsiText
   public
    constructor Create(const AContentAsString: TGMString = ''; const ARefLifeTime: Boolean = True); reintroduce; virtual;
    function GetText: TGMString; stdcall;
    //function GetAnsiText: AnsiString;
  end;


  TGMLockBytesIStream = class(TGMSequentialIStream {, IGMGetOffset, IGMGetSetOffset})
   protected
    FLockBytes: ILockBytes;
    //FOffset: LongInt;
    procedure InternalRead(pv: Pointer; cb: LongWord; var pcbRead: LongWord); override;
    procedure InternalWrite(pv: Pointer; cb: LongWord; var pcbWritten: LongWord); override;

   //public // Interfaces
    //function GetOffset: LongInt; stdcall;
    //procedure SetOffset(Value: LongInt); stdcall;

   public
    constructor Create(const ALockBytes: ILockBytes; const ARefLifeTime: Boolean = True); reintroduce;
    function SetSize(libNewSize: Int64): HResult; override;
    function Seek(dlibMove: Int64; dwOrigin: LongInt; libNewPosition: PInt64): HResult; override;
  end;


  TGMFileHandleIStream = class(TGMSequentialIStream, IGMGetHandle)
   //
   // IStream implementation based on Windows ReadFile/WriteFile routines
   // ReadFile/WriteFile works on Files, Pipes, Sockets, ..
   //
   protected
    FHandle: THandle;

    procedure InternalRead(pv: Pointer; cb: LongWord; var pcbRead: LongWord); override;
    procedure InternalWrite(pv: Pointer; cb: LongWord; var pcbWritten: LongWord); override;

   public
    constructor Create(const AHandle: LongWord; const AMode: LongInt; const AName: UnicodeString = ''; const ARefLifeTime: Boolean = True); reintroduce; overload;
    function GetHandle: THandle; stdcall;
    function HandleIsValid: Boolean;
    property Handle: THandle read FHandle;
  end;


  TGMFileIStream = class(TGMFileHandleIStream)
   public
    constructor Create(const AFileName: TGMString; const AAccess, AShare, ACreateKind: DWORD; const AFlags: DWORD = FILE_ATTRIBUTE_NORMAL;
      const ARefLifeTime: Boolean = True); reintroduce; overload;
    constructor CreateRead(const AFileName: TGMString; const AShare: DWORD = FILE_SHARE_READ; const AFlags: DWORD = FILE_ATTRIBUTE_NORMAL; const ARefLifeTime: Boolean = True);
    constructor CreateOverwrite(const AFileName: TGMString; const AAccess: DWORD = GENERIC_WRITE; const AFlags: DWORD = FILE_ATTRIBUTE_NORMAL; const ARefLifeTime: Boolean = True);
    destructor Destroy; override;
    function Seek(dlibMove: Int64; dwOrigin: LongInt; libNewPosition: PInt64): HResult; override;
  end;


  TOverlappedWaitHandles = (owhAbort, owhIOComple); // <- Order matters here! Check aborted before checking IOComplete!
  TFileRWFunc = function (hFile: THandle; pBuffer: Pointer; nNumberOfBytes: DWORD; var lpBytesTransferred: DWORD; lpOverlapped: POverlapped): BOOL;

  TGMOverlappedIStream = class(TGMFileHandleIStream)
   protected
    FEvIOCompleted: IGMGetHandle;
    FOverlappedIOData: TOverlapped;
    FWaitHandles: array [TOverlappedWaitHandles] of THandle;

    procedure FileRWWrapper(pv: Pointer; cb: LongWord; var pcbRead: LongWord; const FileRWFunc: TFileRWFunc);
    procedure InternalRead(pv: Pointer; cb: LongWord; var pcbRead: LongWord); override;
    procedure InternalWrite(pv: Pointer; cb: LongWord; var pcbWritten: LongWord); override;

   public
    constructor Create(const AHandle: LongWord; const AMode: LongInt; const AEvAbort: IGMGetHandle; const AName: UnicodeString = '';
                const ARefLifeTime: Boolean = True); reintroduce; overload;
  end;


  TGMChainedIStream = class(TGMIStreamBase)
   protected
    FChainedStream: IStream;

   public
    // ISequentialStream
    function Read(pv: Pointer; cb: LongInt; pcbRead: PLongint): HResult; override; stdcall;
    function Write(pv: Pointer; cb: LongInt; pcbWritten: PLongint): HResult; override; stdcall;

    // IStream
    function Seek(dlibMove: Int64; dwOrigin: LongInt; libNewPosition: PInt64): HResult; override; stdcall;
    function SetSize(libNewSize: Int64): HResult; override; stdcall;
    function Commit(grfCommitFlags: LongInt): HResult; override; stdcall;
    function Revert: HResult; override; stdcall;
    function LockRegion(libOffset: Int64; cb: Int64; dwLockType: LongInt): HResult; override; stdcall;
    function UnlockRegion(libOffset: Int64; cb: Int64; dwLockType: LongInt): HResult; override; stdcall;
    function Stat(out statstg: TStatStg; grfStatFlag: LongInt): HResult; override; stdcall;

    constructor Create(const AChainedStream: IStream; const ARefLifeTime: Boolean = True); reintroduce;
  end;


  TGMNotifyingIStream = class(TGMChainedIStream, IConnectionPointContainer, IGMCreateConnectionPoint)
   //
   // This stream may be chained between other streams.
   // All operations are passed to the stream given in constructor.
   // When reading or writing connected objects will be notified about the progress.
   // This allows to get progress information when sombody else is reading or writing.
   //
   protected
    FPosition: Int64;
    FConnectionPointContainer: IConnectionPointContainer;
    FCancel: BOOL;
    //FMTime: TFileTime;

    procedure CallSinkOnProgress(const NotifySink: IUnknown; const Params: array of OleVariant);
    function OnProgress(const AProgress: Int64): Boolean;

   public
    constructor Create(const AChainedStream: IStream; const ARefLifeTime: Boolean = True);
    //constructor CreateLastMod(const AChainedStream: IStream; const ALastMod: TDateTime; const ARefLifeTime: Boolean = True);
    //function Stat(out statstg: TStatStg; grfStatFlag: LongInt): HResult; override;
    destructor Destroy; override;

    // ISequentialStream
    function Read(pv: Pointer; cb: LongInt; pcbRead: PLongint): HResult; override; stdcall;
    function Write(pv: Pointer; cb: LongInt; pcbWritten: PLongint): HResult; override; stdcall;

    // IGMCreateConnectionPoint
    procedure CreateConnectionPoint(const IID: TGUID); stdcall;

    // IConnectionPointContainer
    function EnumConnectionPoints(out Enum: IEnumConnectionPoints): HResult; stdcall;
    function FindConnectionPoint(const iid: TGUID; out cp: IConnectionPoint): HResult; stdcall;
  end;


  TGMBufferedIStream = class(TGMSequentialIStream)
   protected
    FChainedStream: IStream;
    FAnsiStrBuffer: AnsiString;
    FBufWriteCount: LongInt;
    FBufDataSize: LongInt;
    FBufPos: LongInt;

    function FillBuffer: HResult;
    function FlushBuffer: HResult;

    procedure InternalRead(pv: Pointer; cb: LongWord; var pcbRead: LongWord); override;
    procedure InternalWrite(pv: Pointer; cb: LongWord; var pcbWritten: LongWord); override;

   public
    constructor Create(const AChainedStream: IStream; const ABufSizeInBytes: Integer = cDfltCopyBufferSize; const AName: TGMString = ''; const ARefLifeTime: Boolean = True); reintroduce;
    destructor Destroy; override;

    // ISequentialStream
    function Read(pv: Pointer; cb: LongInt; pcbRead: PLongint): HResult; override; stdcall;
    function Write(pv: Pointer; cb: LongInt; pcbWritten: PLongint): HResult; override; stdcall;
//  function Seek(dlibMove: Int64; dwOrigin: LongInt; libNewPosition: PInt64): HResult; override; stdcall;
  end;


  TGMInterfaceIDArray = array of TGUID;

  TGMIntfConnectDataRec = record
   IID: TGUID;
   Cookie: LongInt;
   Required: Boolean;
  end;

  TGMIntfSourceChangeEvent = procedure (const OldSource, NewSource: IUnknown) of object;
//TGMIntfSourceObjChangeEvent = procedure (const OldSource, NewSource: TObject) of object;
  TGMIntfProc = procedure (const Intf: IUnknown) of object;

  TIntfIDsToConnectArray = array of TGMIntfConnectDataRec;

  TGMObjInterfaceConnector = class(TGMRefCountedObj, IGMGetActive, IGMGetSetActive, IGMDisconnectFromConnectionPoint, IGMAskBoolean,
                                                     IGMGetInterfaceSource, IGMGetSetInterfaceSource)
   protected
    FOwner: TObject;
    FObjectToBeConnected: TObject;
    FInterfaceSource: IUnknown;
//  FInterfaceSourceObject: TObject;
    FNeededInterfaceIDs: TGMInterfaceIDArray;
    FIntfIDsToConnect: TIntfIDsToConnectArray;
    FAlwaysNotify: Boolean;

    FOnBeforeIntfSourceChange: TGMIntfSourceChangeEvent;
    FOnAfterIntfSourceChange: TGMIntfSourceChangeEvent;
//  FOnBeforeIntfSourceObjChange: TGMIntfSourceObjChangeEvent;
//  FOnAfterIntfSourceObjChange: TGMIntfSourceObjChangeEvent;
    FOnCheckIntfCanBeConnected: TGMIntfProc;

    function GetInterfaceSource: IUnknown; virtual; stdcall;
    procedure SetInterfaceSource(const AValue: IUnknown); virtual; stdcall;
//  procedure SetInterfaceSourceObject(const Value: TObject);

    procedure CheckNotConnected(MethodName: TGMString);

    // IGMGetSetActive
    function GetActive: Boolean; virtual; stdcall;
    procedure SetActive(const Value: Boolean); virtual; stdcall;

    // IGMDisconnectFromConnectionPoint
    procedure DisconnectFromConnectionPoint(const ConnectionPointContainer: IUnknown; const IID: TGUID; const Cookie: LongInt); virtual; stdcall;

    // IGMAskBoolean
    function AskBoolean(const ValueId: LongInt): LongInt; virtual; stdcall;

   public
    constructor Create(const AOwner: TObject; const ANeededInterfaceIDs: array of TGUID; const AIntfIDsToConnect: array of TGMIntfConnectDataRec); reintroduce;
    destructor Destroy; override;

    procedure AssignFromObj(const Source: TObject); virtual; stdcall;
    procedure CheckInterfaceCanBeConnected(const Intf: IUnknown); virtual;
    function InterfaceCanBeConnected(const Intf: IUnknown): Boolean; virtual;

    function IsConnected: Boolean; virtual;
    function GetSourceIntf(const IID: TGUID; out Intf): Boolean; virtual;
    function GetPropertyIntf(const PropertyName: TGMString; const IID: TGUID; out Intf): HResult; virtual;

    function SourceIsActive: Boolean; virtual;
    function SourceState: LongInt; virtual;

    procedure AddNeededIntfID(const IID: TGUID); virtual;
    procedure AddNeededIntfIDs(const IIDs: array of TGUID);
    procedure AddIntfIDToConnect(const IID: TGUID; const Required: Boolean = cDfltIIDRequired); virtual;
    procedure AddIntfIDsToConnect(const AIntfIDsToConnect: array of TGMIntfConnectDataRec);

    procedure ConnectInterface(const Container: IUnknown; var GMIntfConnectData: TGMIntfConnectDataRec; const ARoutineName: TGMString = cDfltRoutineName); virtual;
    procedure DisconnectInterface(const Container: IUnknown; const IID: TGUID; var Cookie: LongInt); virtual;

    procedure ConnectAllInterfaces(const Container: IUnknown); //overload;
    procedure DisconnectAllInterfaces(const Container: IUnknown); //overload;

    property NeededInterfaceIDs: TGMInterfaceIDArray read FNeededInterfaceIDs;
    property IntfIDsToConnect: TIntfIDsToConnectArray read FIntfIDsToConnect;
    property Owner: TObject read FOwner;
    property ObjectToBeConnected: TObject read FObjectToBeConnected write FObjectToBeConnected;

//  property InterfaceSourceObject: TObject read FInterfaceSourceObject write SetInterfaceSourceObject;
    property InterfaceSource: IUnknown read GetInterfaceSource write SetInterfaceSource;

    property AlwaysNotify: Boolean read FAlwaysNotify write FAlwaysNotify default cDfltAlwaysNotify;
    property OnBeforeIntfSourceChange: TGMIntfSourceChangeEvent read FOnBeforeIntfSourceChange write FOnBeforeIntfSourceChange;
    property OnAfterIntfSourceChange: TGMIntfSourceChangeEvent read FOnAfterIntfSourceChange write FOnAfterIntfSourceChange;
//  property OnBeforeIntfSourceObjChange: TGMIntfSourceObjChangeEvent read FOnBeforeIntfSourceObjChange write FOnBeforeIntfSourceObjChange;
//  property OnAfterIntfSourceObjChange: TGMIntfSourceObjChangeEvent read FOnAfterIntfSourceObjChange write FOnAfterIntfSourceObjChange;
    property OnCheckIntfCanBeConnected: TGMIntfProc read FOnCheckIntfCanBeConnected write FOnCheckIntfCanBeConnected;
  end;


  TGMActiveChangeNotifyEvent = procedure (const NewActive: Boolean) of Object;

  TGMActivatableIntfSource = class(TGMObjInterfaceConnector, IGMActiveChangeNotifications)
   protected
    FOnBeforeActiveChange: TGMActiveChangeNotifyEvent;
    FOnAfterActiveChange: TGMActiveChangeNotifyEvent;

   public
    // IGMActiveChangeNotifications
    procedure BeforeActiveChange(const NewActive: Boolean); virtual; stdcall;
    procedure AfterActiveChange(const NewActive: Boolean); virtual; stdcall;

    constructor Create(const AOwner: TObject; const ANeededInterfaceIDs: array of TGUID; const AIntfIDsToConnect: array of TGMIntfConnectDataRec);

   published
    property OnBeforeActiveChange: TGMActiveChangeNotifyEvent read FOnBeforeActiveChange write FOnBeforeActiveChange;
    property OnAfterActiveChange: TGMActiveChangeNotifyEvent read FOnAfterActiveChange write FOnAfterActiveChange;
  end;
                                                                          

  { -------------------- }
  { ---- Components ---- }
  { -------------------- }

  TGMConnectableObject = class(TGMRefCountedObj, IConnectionPointContainer, IGMCreateConnectionPoint,
                                                 IGMEnableNotifications, IGMGetPropertyIntf,
                                                 IGMGetInterfaceSource, IGMGetSetInterfaceSource)
   protected
    FObjectConnectedTo: TGMObjInterfaceConnector;
    FConnectionPointContainer: IConnectionPointContainer;
    FNotifyDisableCount: LongInt;
    FCallEventsWhenDisabled: Boolean;

    procedure InternalClose; virtual;
    //procedure CallSinkClose(const NotifySink: IUnknown; const Params: array of OleVariant);
    procedure ConnectInterface(const Container: TObject; const IID: TGUID; var Cookie: LongInt; const CallingRoutineName: TGMString = cDfltRoutineName); overload; virtual;
    procedure ConnectInterface(const Container: IUnknown; const IID: TGUID; var Cookie: LongInt; const CallingRoutineName: TGMString = cDfltRoutineName); overload; virtual;

    procedure DisconnectInterface(const Container: TObject; const IID: TGUID; var Cookie: LongInt); overload; virtual;
    procedure DisconnectInterface(const Container: IUnknown; const IID: TGUID; var Cookie: LongInt); overload; virtual;

    procedure NotifyConnectedObjectsOnFirstDisable(const NotificationOnFirstDisable: LongInt = Ord(rgNone)); virtual;
    procedure NotifyConnectedObjectsOnReEnable(const NotificationOnReEnable: LongInt = Ord(rgNone)); virtual;

   public
    constructor Create(const ARefLifeTime: Boolean); override;
    destructor Destroy; override;

    // IGMGetPropertyIntf
    function GetPropertyIntf(const PropertyName: TGMString; const IID: TGUID; out Intf): HResult; virtual; stdcall;

    // IGMCreateConnectionPoint
    procedure CreateConnectionPoint(const IID: TGUID); virtual; stdcall;

    // IConnectionPointContainer
    function EnumConnectionPoints(out Enum: IEnumConnectionPoints): HResult; stdcall;
    function FindConnectionPoint(const iid: TGUID; out cp: IConnectionPoint): HResult; stdcall;

    // IGMEnableNotifications
    function GetNotifyDisableCount: LongInt; virtual; stdcall;
    function EnableNotifications(const NotificationOnReEnable: LongInt = Ord(rgNone)): LongInt; virtual; stdcall;
    function DisableNotifications(const NotificationOnFirstDisable: LongInt = Ord(rgNone)): LongInt; virtual; stdcall;

    function DoCallEvents: Boolean; virtual;
    function DoNotifySink(const NotifySink: IUnknown; const IID: TGUID; out Intf): Boolean; virtual;

    property ConnectionPointContainer: IConnectionPointContainer read FConnectionPointContainer;
    property NotifyDisableCount: LongInt read GetNotifyDisableCount;
    property ObjectConnectedTo: TGMObjInterfaceConnector read FObjectConnectedTo implements IGMGetSetInterfaceSource, IGMGetInterfaceSource;
    property CallEventsWhenDisabled: Boolean read FCallEventsWhenDisabled write FCallEventsWhenDisabled default cDfltCallEventsWhenDisabled;
  end;


  TGMActivationProperties = class(TGMRefCountedObj)
   protected
    FOwner: TObject;
    FActiveStored: Boolean;

    function GetActive: Boolean; virtual;
    procedure SetActive(Value: Boolean); virtual;
    function IsActiveStored: Boolean; virtual;

   public
    constructor Create(const AOwner: TObject); reintroduce; virtual;
    property Owner: TObject read FOwner;

   published
    property Active: Boolean read GetActive write SetActive stored IsActiveStored;
    property StoreActive: Boolean read FActiveStored write FActiveStored default cDfltActiveStored;
  end;

  TGMActivationPropertyClass = class of TGMActivationProperties;


  TGMActivationStoredProperties = class(TGMActivationProperties)
   public
    constructor Create(const AOwner: TObject); override;

   published
    property StoreActive default cDfltActivePersists;
  end;


  TGMActivatableObject = class;

  TGMActiveChangeEvent = procedure (Sender: TGMActivatableObject; const NewActive: Boolean) of object;

  TGMActivatableObject = class(TGMConnectableObject, IGMGetActive, IGMGetSetActive, IGMVerifyActivation)
   protected
    FWasActive: Boolean;
    FActivationProperties: TGMActivationProperties;

    FOnBeforeActiveChange: TGMActiveChangeEvent;
    FOnAfterActiveChange: TGMActiveChangeEvent;

    function ActivationPropertyCreateClass: TGMActivationPropertyClass; virtual;

    function GetActive: Boolean; virtual; stdcall; abstract;
    procedure SetActive(const Value: Boolean); virtual; stdcall;
    procedure SetActivationProperties(const Value: TGMActivationProperties);

    procedure CheckIsActive(const MemberName: TGMString = cDfltRoutineName); virtual; stdcall;
    procedure CheckIsInactive(const MemberName: TGMString = cDfltRoutineName); virtual; stdcall;

    procedure DoBeforeOpen; virtual;
    procedure DoAfterOpen; virtual;
    procedure DoBeforeClose; virtual;  
    procedure DoAfterClose; virtual;

    //procedure CallSinkBeforeActiveChange(const NotifySink: IUnknown; const Params: array of OleVariant);
    //procedure CallSinkAfterActiveChange(const NotifySink: IUnknown; const Params: array of OleVariant);

    procedure NotifyBeforeActiveChange(const NewActive: Boolean); virtual;
    procedure NotifyAfterActiveChange(const NewActive: Boolean); virtual;

    procedure InternalOpen; virtual; abstract;

    function CloseOnDestroy: Boolean; virtual;

   public
    constructor Create(const ARefLifeTime: Boolean); override;
    destructor Destroy; override;

    procedure Open;
    procedure Close;

    property Active: Boolean read GetActive write SetActive;
    property ActivationProperties: TGMActivationProperties read FActivationProperties write SetActivationProperties;

    property OnBeforeActiveChange: TGMActiveChangeEvent read FOnBeforeActiveChange write FOnBeforeActiveChange;
    property OnAfterActiveChange: TGMActiveChangeEvent read FOnAfterActiveChange write FOnAfterActiveChange;
  end;


  TGMHandleActivateObj = class(TGMActivatableObject, IGMGetHandle)
   protected
    FHandle: THandle;

    function GetActive: Boolean; override;

    procedure InternalOpen; override;
    procedure InternalClose; override;

    procedure AllocHandle; virtual; abstract;
    procedure ReleaseHandle; virtual; abstract;

   public
    function GetHandle: THandle; virtual; stdcall;
    function GetHandleAllocated: Boolean; virtual; stdcall;

    property Handle: THandle read GetHandle;
  end;


  TGMClipboard = class;

  IGMClipboard = interface(IUnknown)
    ['{153C4E19-E12B-452d-A05F-FC53D9D10461}']
    function Obj: TGMClipboard;
  end;


  TGMClipboard = class(TGMRefCountedObj, IGMClipboard)
   public
    procedure SetEmpty; 

    procedure SetAsHandle(const AFormat: UINT; const AValue: THandle; const ASetEmptyBefore: Boolean = False);
    procedure SetAsLockBytes(const AFormat: UINT; const AValue: ILockBytes; const ASetEmptyBefore: Boolean = False);
    procedure SetAsText(const AValue: TGMString; const ASetEmptyBefore: Boolean = False);

    function GetAsHandle(const AFormat: UINT): THandle;
    procedure ReplaceByHandle(const AFormat: UINT; const AValue: THandle);
    function GetAsText: TGMString;
    procedure ReplaceByText(const AValue: TGMString);
    function GetAsLockBytes(const AFormat: UINT): ILockBytes;
    procedure ReplaceByLockBytes(const AFormat: UINT; const AValue: ILockBytes);
    procedure PasteToLockBytes(const AFormat: UINT; const LockBytes: ILockBytes);
    function Obj: TGMClipboard;
    //function GetAsIStream: IStream;
    //procedure SetAsIStream(const Value: IStream);

    constructor Create(const AWnd: HWnd = 0; const ARefLifeTime: Boolean = True); reintroduce;
    destructor Destroy; override;

    property AsText: TGMString read GetAsText write ReplaceByText;
    property AsHandle[const AFormat: UINT]: THandle read GetAsHandle write ReplaceByHandle;
    property AsLockBytes[const AFormat: UINT]: ILockBytes read GetAsLockBytes write ReplaceByLockBytes;
    //property AsIStream: IStream read GetAsIStream write SetAsIStream;
  end;


  { ------------------------------- }
  { ---- GM Exception Handling ---- }
  { ------------------------------- }

  TGMExceptionAskBoolValId = (bevPresentToUI, bevCaptureCallStack);

  TGMExceptionInformation = class(TGMRefCountedObj, IGMExceptionInformation, IGMGetHRCode,
                                                    IGMAssignFromObj, IGMAssignFromIntf, IGMAskBoolean)
   //
   // A container to carry exception information
   //
   public
    FMessage: TGMString;
    FExceptionClassName: TGMString;
    FExceptAddress: Pointer;
    FRaisorName: TGMString;
    FRaisorClassName: TGMString;
    FRoutineName: TGMString;
    FSeverityLevel: TGMSeverityLevel;
    FHelpContext: LongInt;
    FHrCode: HResult;
    FCaptureCallStack: BOOL;
    FPresentToUI: LongInt; // <- TGMBoolAskResult;

   public
    constructor CreateFromObj(const ASource: TObject;
                              const ARefLifeTime: Boolean = False;
                              const ACaptureCallStack: Boolean = False); reintroduce;

    constructor CreateFromIntf(const ASource: IUnknown;
                               const ARefLifeTime: Boolean = False;
                               const ACaptureCallStack: Boolean = False); reintroduce;

    constructor Create(const ARefLifeTime: Boolean = False;
                       const ACaptureCallStack: Boolean = False;
                       const AMessage: TGMString = '';
                       const AExceptionClassName: TGMString = '';
                       const AExceptAddress: Pointer = nil;
                       const ARaisorName: TGMString = '';
                       const ARaisorClassName: TGMString = '';
                       const ARoutineName: TGMString = '';
                       const ASeverityLevel: TGMSeverityLevel = svError;
                       const AHelpContext: LongInt = 0;
                       const AHRCode: HResult = ERROR_SUCCESS); reintroduce;

    procedure AssignFromObj(const ASource: TObject); stdcall;
    procedure AssignFromIntf(const ASource: IUnknown); stdcall;
    function GetHRCode: HResult; stdcall;
    function AskBoolean(const ValueId: LongInt): LongInt; stdcall;

    { ---- IGMExceptionInformation ---- }
    function GetGMMessage: PGMChar; stdcall;
    function GetExceptionClassName: PGMChar; stdcall;
    function GetExceptAddress: Pointer; stdcall;
    function GetRaisorName: PGMChar; stdcall;
    function GetRoutineName: PGMChar; stdcall;
    function GetHelpCtx: LongInt; stdcall;
    function GetSeverityLevel: TGMSeverityLevel; stdcall;
    function GetRaisorClassName: PGMChar; stdcall;
    //function GetPresentToUI: BOOL; stdcall;
  end;

  
  EGMException = class(Exception, IUnknown, IGMExceptionInformation, IGMGetText, IGMGetSetText, IGMSetExceptionInformation)
   protected
    FGMMessage: TGMString;
    FRefCount: LongInt;
    FExceptAddress: Pointer;
    FRaisorName: TGMString;
    FRaisorClassName: TGMString;
    FRoutineName: TGMString;
    FSeverityLevel: TGMSeverityLevel;
    FHelpContext: LongInt;
    FClassName: TGMString;

    procedure SetupInformation(const AMsg: TGMString = cDfltExceptionMsg;
                               const ARaisorName: TGMString = '';
                               const ARaisorClassName: TGMString = '';
                               const ARoutineName: TGMString = cDfltRoutineName;
                               const ASeverityLevel: TGMSeverityLevel = svError;
                               const AHelpCtx: LongInt = cDfltHelpCtx); virtual;

   public
    constructor ObjError(const AMsg: TGMString = cDfltExceptionMsg;
                         const AObj: TObject = nil;
                         const ARoutineName: TGMString = cDfltRoutineName;
                         const ASeverityLevel: TGMSeverityLevel = svError;
                         const AHelpCtx: LongInt = cDfltHelpCtx); virtual;

    constructor IntfError(const AMsg: TGMString = cDfltExceptionMsg;
                          const AIntf: IUnknown = nil;
                          const ARoutineName: TGMString = cDfltRoutineName;
                          const ASeverityLevel: TGMSeverityLevel = svError;
                          const AHelpCtx: LongInt = cDfltHelpCtx); virtual;

    destructor Destroy; override;

//  procedure SetRoutineName(const ARoutineName: PGMChar); stdcall;
//  procedure SetMessage(const AMessage: PGMChar); stdcall;
//  procedure SetSeverityLevel(const ASeverityLevel: TGMSeverityLevel); stdcall;

    // IUnknown
    function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} AIID: TGUID; out AIntf): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function _AddRef: LongInt; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function _Release: LongInt; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};

    // IGMGetSetText
    function GetText: TGMString; stdcall;
    procedure SetText(const Value: TGMString); stdcall;

    // IGMSetExceptionInformation
    procedure SetMessage(AMessage: PGMChar); stdcall;
    procedure SetSeverityLevel(ASeverityLevel: TGMSeverityLevel); stdcall;

    // IGMExceptionInformation
    function GetGMMessage: PGMChar; stdcall;
    function GetExceptionClassName: PGMChar; stdcall;
    function GetExceptAddress: Pointer; stdcall;
    function GetRaisorName: PGMChar; stdcall;
    function GetRaisorClassName: PGMChar; stdcall;
    function GetRoutineName: PGMChar; stdcall;
    function GetSeverityLevel: TGMSeverityLevel; stdcall;
    function GetHelpCtx: LongInt; stdcall;

    property RefCount: LongInt read FRefCount;
//  property ARoutineName: TGMString read FRoutineName write FRoutineName;
//  property SeverityLevel: TGMSeverityLevel read GetSeverityLevel write FSeverityLevel;
  end;

  EGMExceptionClass = class of EGMException;


  EGMConvertException = class(EGMException);
  EGMFmtException = class(EGMException);


  EGMHrException = class(EGMException, IGMGetHRCode)
   protected
    FHrCode: HResult;

   public
    constructor ObjError(const AHRCode: HResult;
                         const AParams: array of PGMChar;
                         const AObj: TObject = nil;
                         const ARoutineName: TGMString = cDfltRoutineName;
                         const AMsgPostfix: TGMString = '';
                         const AHelpCtx: LongInt = cDfltHelpCtx); reintroduce; overload; virtual;

    constructor IntfError(const AHRCode: HResult;
                          const AParams: array of PGMChar;
                          const AIntf: IUnknown = nil;
                          const ARoutineName: TGMString = cDfltRoutineName;
                          const AMsgPostfix: TGMString = '';
                          const AHelpCtx: LongInt = cDfltHelpCtx); reintroduce; overload; virtual;

    function GetHRCode: HResult; stdcall;
    property HRCode: HResult read GetHRCode;
  end;


  EAPIException = class(EGMException, IGMGetHRCode)
   protected
    FErrorCode: LongWord;

   public
    constructor ObjError(const AWinApiErrorCode: LongWord;
                         const AParams: array of PGMChar;
                         const AObj: TObject = nil;
                         const ARoutineName: TGMString = cDfltRoutineName;
                         const AMsgPostfix: TGMString = '';
                         const AHelpCtx: LongInt = cDfltHelpCtx); reintroduce; overload; virtual;

    function GetHRCode: HResult; stdcall;
    property HRCode: HResult read GetHRCode;
    property ErrorCode: LongWord read FErrorCode;
  end;


  EGMAbort = class(EAbort, IUnknown, IGMGetHRCode)
   protected
    FRefCount: LongInt;
   public
    function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} AIID: TGUID; out AIntf): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function _AddRef: LongInt; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function _Release: LongInt; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function GetHRCode: HResult; stdcall;
  end;


  { ------------------------------------------ }
  { ---- Connection Point Implementations ---- }
  { ------------------------------------------ }

  IGMConnectedObjListEntry = interface(IUnknown)
    ['{19601AE2-1EAA-11d5-AB38-000021DCAD19}']
    procedure AssignTo(var CnData: tagConnectData); stdcall;
    function GetUnkIntf: IUnknown; stdcall;
    function GetCookie: LongInt; stdcall;
    procedure SetUnkIntf(const Value: IUnknown); stdcall;
    procedure SetCookie(const Value: LongInt); stdcall;
    property UnkIntf: IUnknown read GetUnkIntf write SetUnkIntf;
    property Cookie: LongInt read GetCookie write SetCookie;
  end;


  TGMConnectedObjListEntry = class(TGMRefCountedObj, IGMConnectedObjListEntry)
   protected
    FUnkIntf: IUnknown;
    FCookie: LongInt;

    function GetUnkIntf: IUnknown; stdcall;
    function GetCookie: LongInt; stdcall;
    procedure SetUnkIntf(const Value: IUnknown); stdcall;
    procedure SetCookie(const Value: LongInt); stdcall;

   public
    constructor Create(const AUnkIntf: IUnknown; const ACookie: LongInt); reintroduce;
    destructor Destroy; override;
    procedure AssignTo(var CnData: tagConnectData); stdcall;
    property UnkIntf: IUnknown read GetUnkIntf write SetUnkIntf;
    property Cookie: LongInt read GetCookie write SetCookie;
  end;


  TGMEnumXxxxImpl = class;
  TGMEnumXxxxImplClass = class of TGMEnumXxxxImpl;
  TGMEnumXxxxImpl = class(TGMRefCountedObj)
   protected
    FList: IGMIntfArrayCollection;
    FListPos: LongInt;
    FElemIID: TGUID;

   public
    constructor Create(const AList: IGMIntfArrayCollection; const AElemIID: TGUID; const AListPos: LongInt = cGMUnknownPosition); reintroduce;
    function CreateCloneClass: TGMEnumXxxxImplClass; virtual; abstract;

    property ElemIID: TGUID read FElemIID;

    function CreateClone(const IID: TGUID; out Enum): HResult; stdcall;

    { ---- IEnumXxxx ---- }
    function Skip(celt: LongInt): HResult; stdcall;
    function Reset: HResult; stdcall;
  end;


  TGMEnumConnectionPointsImpl = class(TGMEnumXxxxImpl, IEnumConnectionPoints)
   public
    constructor Create(const AList: IGMIntfArrayCollection);
    function CreateCloneClass: TGMEnumXxxxImplClass; override;
    function Clone(out Enum: IEnumConnectionPoints): HResult; stdcall;
    function Next(celt: LongInt; out elt; pceltFetched: PLongint): HResult; stdcall;
  end;


  TGMEnumConnectionsImpl = class(TGMEnumXxxxImpl, IEnumConnections)
   public
    constructor Create(const AList: IGMIntfArrayCollection);
    function CreateCloneClass: TGMEnumXxxxImplClass; override;
    function Clone(out Enum: IEnumConnections): HResult; stdcall;
    function Next(celt: LongInt; out elt; pceltFetched: PLongint): HResult; stdcall;
  end;


  TGMConnectionPointContainerImpl = class(TGMRefCountedObj, IConnectionPointContainer,
                                                            IGMReleaseReferences,
                                                            IGMCreateConnectionPoint)
   protected
    FConnectionPoints: IGMIntfArrayCollection;

   public
    constructor Create(const AConnectionPoints: array of TGUID; const ARefLifeTime: Boolean = True); reintroduce;

    // IGMReleaseReferences
    procedure ReleaseReferences; virtual; stdcall;

    // IGMMaintainConnectionPoints
    procedure CreateConnectionPoint(const IID: TGUID); virtual; stdcall;

    // IConnectionPointContainer
    function EnumConnectionPoints(out Enum: IEnumConnectionPoints): HResult; stdcall;
    function FindConnectionPoint(const iid: TGUID; out cp: IConnectionPoint): HResult; stdcall;
  end;


  TGMConnectionPointImpl = class(TGMRefCountedObj, IConnectionPoint)
   protected
    FIntfID: TGUID;
    FOwner: IUnknown;
    FConnectedObjects: IGMIntfArrayCollection;
    FCurrentCookie: LongWord;

   public
    constructor Create(const AOwner: IUnknown; const IID: TGUID; const ARefLifeTime: Boolean = True); reintroduce;
    destructor Destroy; override;

    property IntfID: TGUID read FIntfID;

    // IConnectionPoint 
    function GetConnectionInterface(out iid: TGUID): HResult; stdcall;
    function GetConnectionPointContainer(out Cpc: IConnectionPointContainer): HResult; stdcall;
    function EnumConnections(out Enum: IEnumConnections): HResult; stdcall;
    function Advise(const unkSink: IUnknown; out dwCookie: LongInt): HResult; stdcall;
    function Unadvise(dwCookie: LongInt): HResult; stdcall;
  end;


  { --------------------- }
  { ---- File System ---- }
  { --------------------- }

  TGMFileProperties = class(TGMRefCountedObj, IGMFileProperties, IGMGetFileName, IGMGetSetFileName, IGMAssignFromIntf, IGMCriticalSection)
   protected
    FCriticalSection: IGMCriticalSection;
    FFileName: TGMString;
    FDisplayName: TGMString;
    FAttributes: TFileAttributes;
    FCreationTime: TDateTime;
    FLastAccessTime: TDateTime;
    FLastWriteTime: TDateTime;
    FSizeInBytes: Int64;

    function GetFileName: TGMString; stdcall;
    function GetDisplayName: TGMString; stdcall;
    function GetAttributes: TFileAttributes; stdcall;
    function GetCreationTime: TDateTime; stdcall;
    function GetLastAccessTime: TDateTime; stdcall;
    function GetLastWriteTime: TDateTime; stdcall;
    function GetSizeInBytes: Int64; stdcall;

   public
    constructor Create(const ARefLifeTime: Boolean = True); overload; override;
    constructor CreateFromExisting(const AExistingFileName: TGMString; const ARefLifeTime: Boolean = True); reintroduce; overload;
    constructor Create(const FindData: TWin32FindData; const AFilePath: TGMString = ''; const ARefLifeTime: Boolean = True); reintroduce; overload;
    constructor Create(const AFileName: TGMString;
                       const AAttributes: TFileAttributes = [];
                       const ASizeInBytes: Int64 = cDfltSizeInBytes;
                       const ACreationTime: TDateTime = cDfltDateTime;
                       const ALastWriteTime: TDateTime = cDfltDateTime;
                       const ALastAccessTime: TDateTime = cDfltDateTime;
                       const ARefLifeTime: Boolean = True); reintroduce; overload;

    //constructor Create(const AFileName: TGMString; const AAttributes: TFileAttributes = []; const ASize: Int64 = -1; const ARefLifeTime: Boolean = True); overload;
    //function CriticalSection: IGMCriticalSection;
    procedure SetFileName(const Value: TGMString); stdcall;
    procedure AssignFromIntf(const Source: IUnknown); stdcall;

    property AFileName: TGMString read FFileName;
    property Attributes: TFileAttributes read FAttributes;
    property CreationTime: TDateTime read FCreationTime;
    property LastAccessTime: TDateTime read FLastAccessTime;
    property LastWriteTime: TDateTime read FLastWriteTime;
    property SizeInBytes: Int64 read FSizeInBytes;

    property CriticalSection: IGMCriticalSection read FCriticalSection implements IGMCriticalSection;
  end;


  { ----------------------- }
  { ---- Miscellaneous ---- }
  { ----------------------- }

  type


//PMetafileHeader = ^TMetafileHeader;
//TMetafileHeader = packed record
//  Key: LongInt;
//  Handle: SmallInt;
//  Box: TSmallRect;
//  Inch: Word;
//  Reserved: LongInt;
//  CheckSum: Word;
//end;

//PCursorOrIconRec = ^TCursorOrIconRec;
//TCursorOrIconRec = packed record
//  Reserved: Word;
//  wType: Word;
//  Count: Word;
//end;


  //
  // A set of char that works with ansi chars and unicode chars.
  // Performance is almost the same as "set of char" compiler generated code.
  //
  TGMSetOfChar = class
   protected
    //FElementsAsBits: array [0..Ord(High(TGMChar)) div (SizeOf(PtrInt)) * 8] of PtrInt;
    FElementsAsBits: array [0..Ord(High(TGMChar)) div 8] of Byte;
   public
    procedure AddChar(AChar: TGMChar);
    procedure RemoveChar(AChar: TGMChar); // : Boolean;
    procedure RemoveAllChars;
    procedure AddAllChars;
    function Contains(AChar: TGMChar): Boolean;
    procedure Union(AOther: TGMSetOfChar);
  end;


  //
  // Objects To be used as temprary Reference Items for the TGMObjArrayCollection Find/FindNearest Methods
  //

  TGMNameObj = class(TGMRefCountedObj, IGMGetName, IGMHashCode, IGMGetSetName)
   protected
    FName: TGMString;
   public
    constructor Create(const AName: TGMString; const ARefLifeTime: Boolean = True); reintroduce; overload;
    function GetName: TGMString; virtual; stdcall;
    procedure SetName(const ANewName: TGMString); virtual; stdcall;
    function HashCode: TGMHashCode;

    property Name: TGMString read GetName write SetName;
  end;


  TGMIntegerObj = class(TGMRefCountedObj, IGMHashCode)
   protected
    FValue: PtrInt;
   public
    constructor Create(const AValue: PtrInt; const ARefLifeTime: Boolean = True); reintroduce;
    function HashCode: TGMHashCode;
    property Value: PtrInt read FValue;
  end;


  TGMPositionObj = class(TGMIntegerObj, IGMGetPosition)
   public
    destructor Destroy; override;
    function GetPosition: PtrInt; virtual; stdcall;
  end;


  TGMLeftObj = class(TGMIntegerObj, IGMGetLeft)
   public
    function GetLeft: LongInt; virtual; stdcall;
  end;


  TGMGuidObj = class(TGMRefCountedObj, IGMGetGUID)
   protected
    FGuid: TGUID;
   public
    constructor Create(const AGuid: TGUID; const ARefLifeTime: Boolean = True); reintroduce;
    function GetGUID: TGUID; stdcall;
    property Guid: TGUID read FGuid;
  end;


  TGMNameAndPosObj = class(TGMNameObj, IGMGetPosition)
   protected
    FPosition: PtrInt;
   public
    constructor Create(const AName: TGMString; const APosition: LongInt; const ARefLifeTime: Boolean = True); reintroduce; virtual;
    function GetPosition: PtrInt; virtual; stdcall;
  end;


  TGMNameAndStrValueObj = class(TGMNameObj, IGMGetStringValue, IGMGetUnionValue, IGMGetText, IGMGetSetStringValue, IGMGetSetUnionValue, IGMGetSetText)
   protected
    FStrValue: TGMString;

   public
    constructor Create(const AName, AStrValue: TGMString; const ARefLifeTime: Boolean = True); reintroduce; overload;
    function GetStringValue: TGMString; virtual;
    procedure SetStringValue(const AStrValue: TGMString); virtual;
    function GetUnionValue: RGMUnionValue; virtual;
    procedure SetUnionValue(const AUnionValue: RGMUnionValue); virtual;
    function GetText: TGMString; virtual; stdcall;
    procedure SetText(const AStrValue: TGMString); virtual; stdcall;

    property StrValue: TGMString read GetStringValue write SetStringValue;
  end;


  TGMNameAndValueObj = class(TGMNameObj, IGMGetUnionValue, IGMGetStringValue, IGMGetText,
                                         IGMLoadStoreData, IGMGetSetUnionValue, IGMGetSetText) // IGMGetKeyValue
   protected
    FValue: RGMUnionValue;

   public
    constructor Create(const AName: TGMString; const AValue: RGMUnionValue; const ARefLifeTime: Boolean = True); reintroduce; overload;

    function GetKeyValue: RGMUnionValue; virtual;
//  function GetName: TGMString; virtual; stdcall;
//  procedure SetName(const AValue: TGMString); virtual; stdcall;
    function GetUnionValue: RGMUnionValue; virtual;
    function GetStringValue: TGMString;
    procedure SetUnionValue(const AUnionValue: RGMUnionValue); virtual;
    function GetText: TGMString; virtual; stdcall;
    procedure SetText(const AValue: TGMString); virtual; stdcall;
    procedure LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); virtual; stdcall;
    procedure StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); virtual; stdcall;
//  function HashCode: TGMHashCode;

    property Value: RGMUnionValue read GetUnionValue write SetUnionValue;
  end;


  TGMUserAccountObj = class(TGMRefCountedObj, IGMUserAccount)
   protected
    FUsername: TGMString;
    FPassword: TGMString;
//  FDomain: TGMString;
    FSaveUserData: Boolean;

    function GetUsername: PGMChar; stdcall;
    function GetPassword: PGMChar; stdcall;
//  function GetDomain: PGMChar; stdcall;
    function GetSaveUserData: Boolean; stdcall;
    procedure SetUsername(AUSername: PGMChar); stdcall;
    procedure SetPassword(APassword: PGMChar); stdcall;
//  procedure SetDomain(ADomain: PGMChar); stdcall;
    procedure SetSaveUserData(Value: Boolean); stdcall;

   public
    constructor Create(const AUsername, APassword: TGMString; const ASAveUserData: Boolean = cDfltSaveUSerData; const ARefLifeTime: Boolean = True); reintroduce;
  end;



  { ----------------------- }
  { ---- Smart classes ---- }
  { ----------------------- }

  TGMDLLHandleObj = class(TGMHandleObj)
   public
    constructor Create(const ADLLFilePath: TGMString; const ACheckSuccess: Boolean = False; const ARefLifeTime: Boolean = True); reintroduce; overload;
    destructor Destroy; override;
  end;


  TGMIconHolder = class(TGMHandleObj)
   public
    destructor Destroy; override;
  end;


  TStringReplaceRec = record
   SearchStr: TGMString;
   Replacement: TGMString;
  end;


  RPathWalkData = record
   ValuePart, MaskPart: TGMString;
   ValueChPos, MaskchPos: PtrInt;
  end;


{ ------------------------- }
{ ---- Global Routines ---- }
{ ------------------------- }

{ ---- Data Load Store ---- }

//function GMReadValidRect(const Source: IGMValueStorage; const RectName: TGMString; var Value: TRect; const DefaultValue: LongInt = cInvalidUIPos): Boolean;
function GMReadRect(const ASource: IGMValueStorage; const ARectName: TGMString; const ADefaultRect: TRect): TRect;
procedure GMWriteRect(const ADest: IGMValueStorage; const ARectName: TGMString; const AValue: TRect; const ADefaultValue: LongInt = cInvalidUIPos);

//function GMFontStyleToInt(const Value: TFontStyles): LongInt;
//function GMFontStyleFromInt(const Value: LongInt): TFontStyles;

//procedure GMReadFont(const Source: IGMValueStorage; const FontName: TGMString; const Font: TFont);
//procedure GMWriteFont(const Dest: IGMValueStorage; const FontName: TGMString; const Font: TFont);


{ ---- AStream routines ---- }

function GMIStreamHasSignature(const AStream: IStream; const AFormatSig: AnsiString): Boolean;
function GMIStreamContainsJpeg(const AStream: IStream): boolean;
function GMIStreamContainsGIF(const AStream: IStream): boolean;
function GMIStreamContainsBmp(const AStream: IStream): boolean;

function GMIStreamReadStrA(const AStream: ISequentialStream): AnsiString;
function GMIStreamReadStrW(const AStream: ISequentialStream): UnicodeString;
procedure GMIStreamWriteStrA(const AStream: ISequentialStream; const AValue: AnsiString);
procedure GMIStreamWriteStrW(const AStream: ISequentialStream; const AValue: UnicodeString);

function GMReadBOMCharKind(const AStream: IStream; const ADefaultChKind: TGMCharKind = ckAnsi): TGMCharKind;
procedure GMWriteBOM(const ADestStream: ISequentialStream; const ACharKind: TGMCharKind);

function GMIStreamContainsASCIIText(const AStream: IStream): Boolean;
function GMIStreamContainsXml(const AStream: IStream): Boolean;
procedure GMConsumeStreamContent(const AStream: ISequentialStream; const ABufferSize: LongInt = $8000);


// ---- String type conversion ---- //

//function GMStrToHexStr(const AValue: AnsiString): AnsiString; <- Use GMCharCoding.GMEncodeBase16Str instead
//function GMHexStrToStr(const AValue: AnsiString): AnsiString; <- Use GMCharCoding.GMDecodeBase16Str instead

{$IFDEF DELPHI9}
function GMIntToStr(const AValue: QWord): TGMString; overload;
{$ENDIF}
function GMIntToStr(const AValue: Int64): TGMString; overload;
function GMIntToStr(const AValue: LongInt): TGMString; overload;

function GMIntToHexStr(AValue: LongInt): TGMString; overload;
function GMIntToHexStr(AValue: Int64): TGMString; overload;
{$IFDEF DELPHI9}
function GMIntToHexStr(AValue: QWord): TGMString; overload;
{$ENDIF}

function GMStrToInt(const AValue: TGMString): LongInt; {$IFDEF DELPHI9}overload;{$ENDIF}
{$IFDEF DELPHI9}
function GMStrToInt(const AValue: TGMString): Int64; overload;
{$ENDIF}

function GMStrToInt32(const AValue: TGMString): LongInt;
function GMStrToUInt32(const AValue: TGMString): LongWord;
function GMStrToInt64(const AValue: TGMString): Int64;
{$IFDEF DELPHI9}
function GMStrToUInt64(const AValue: TGMString): QWord;
{$ENDIF}
function GMStrToSingle(AValue: TGMString): Single;
function GMStrToDouble(AValue: TGMString): Double;
function GMStrToCurrency(AValue: TGMString): Currency;

function GMSingleToStr(const AValue: Single; const AWidth: Integer = -1; const APrecision: Integer = -1): TGMString;
function GMDoubleToStr(const AValue: Double; const AWidth: Integer = -1; const APrecision: Integer = -1): TGMString;
function GMExtendedToStr(const AValue: Extended; const AWidth: Integer = -1; const APrecision: Integer = -1): TGMString;
function GMCurrencyToStr(const AValue: Currency; const AWidth: Integer = -1; const APrecision: Integer = -1): TGMString;

// ---- String routines ---- //

function GMIsPrefixStr(const APrefix, AValue: TGMString; const AIngoreCase: Boolean = True): Boolean;

function GMIsDigitA(ACh: AnsiChar): Boolean;
function GMIsDigit(ACh: TGMChar): Boolean;
function GMIsLetter(ACh: TGMChar): Boolean;

// Froward string scan until = ACh
function GMStrLScanA(AStr: PAnsiChar; ACh: AnsiChar; AMaxLen: PtrUInt): PAnsiChar; assembler; register;
function GMStrLScanW(AStr: PWideChar; ACh: WideChar; AMaxLen: PtrUInt): PWideChar; assembler; register;
function GMStrLScan(AStr: PGMChar; ACh: TGMChar; AMaxLen: PtrUInt): PGMChar;

// Reverse string scan until = ACh
function GMStrRLScanA(AStr: PAnsiChar; ACh: AnsiChar; AMaxLen: PtrUInt): PAnsiChar; assembler; register;
function GMStrRLScanW(AStr: PWideChar; ACh: WideChar; AMaxLen: PtrUInt): PWideChar; assembler; register;
function GMStrRLScan(AStr: PGMChar; ACh: TGMChar; AMaxLen: PtrUInt): PGMChar;

// Froward string scan until <> ACh
function GMStrCLScanA(AStr: PAnsiChar; ACh: AnsiChar; AMaxLen: PtrUInt): PAnsiChar; assembler; register;
function GMStrCLScanW(AStr: PWideChar; ACh: WideChar; AMaxLen: PtrUInt): PWideChar; assembler; register;
function GMStrCLScan(AStr: PGMChar; ACh: TGMChar; AMaxLen: PtrUInt): PGMChar;

// Reverse string scan until <> ACh
function GMStrCRLScanA(AStr: PAnsiChar; ACh: AnsiChar; AMaxLen: PtrUInt): PAnsiChar; assembler; register;
function GMStrCRLScanW(AStr: PWideChar; ACh: WideChar; AMaxLen: PtrUInt): PWideChar; assembler; register;
function GMStrCRLScan(AStr: PGMChar; ACh: TGMChar; AMaxLen: PtrUInt): PGMChar;

function GMStrLScanPos(const AValue: TGMString; AChToFind: TGMChar; AStartChPos: PtrInt = 1): PtrInt;


function GMStrScanA(AStr: PAnsiChar; ACh: AnsiChar): PAnsiChar; assembler; register;
function GMStrScanW(AStr: PWideChar; ACh: WideChar): PWideChar; assembler; register;
function GMStrScan(AStr: PGMChar; ACh: TGMChar): PGMChar;

function GMStrLCompA(const AStr1, AStr2: PAnsiChar; AMaxLen: PtrUInt): PtrInt; assembler; register;
function GMStrLCompW(const AStr1, AStr2: PWideChar; AMaxLen: PtrUInt): PtrInt; assembler; register;
function GMStrLComp(const AStr1, AStr2: PGMChar; AMaxLen: PtrUInt): PtrInt;
//function GMStrComp(const Str1, Str2: TGMString): LongInt;
function GMCompareMemory(const AContents1, AContents2: Pointer; const AMaxLenInBytes: PtrUInt): TGMCompareResult;

function GMStrLICompA(const AStr1, AStr2: PAnsiChar; AMaxLen: PtrUInt): LongInt; assembler; register;
function GMStrLICompW(const AStr1, AStr2: PWideChar; AMaxLen: PtrUInt): LongInt; assembler; register;
function GMStrLIComp(const AStr1, AStr2: PGMChar; AMaxLen: PtrUInt): LongInt;

function GMSameText(const AValue1, AValue2: TGMString): Boolean;

//function GMStrScanPas(const AValue: PGMChar; Ch: TGMChar): PGMChar;

function GMIsDelimiterA(const ADelimiters, AValue: AnsiString; AIndex: PtrInt): Boolean; {$IFDEF DELPHI9}inline;{$ENDIF}
function GMIsDelimiterW(const ADelimiters, AValue: UnicodeString; AIndex: PtrInt): Boolean; {$IFDEF DELPHI9}inline;{$ENDIF}
function GMIsDelimiter(const ADelimiters, Value: TGMString; Index: PtrInt): Boolean; {$IFDEF DELPHI9}inline;{$ENDIF}

function GMLastDelimiter(const ADelimiters, AValue: TGMString): PtrInt;

function GMIsNumber(const AValue: TGMString): Boolean;

function GMDeleteLastWord(const Value: TGMString; const Separators: TGMString): TGMString;
function GMDeleteFirstWord(const Value: TGMString; const Separators: TGMString; const StripSeparators: Boolean = True): TGMString;
function GMDeleteFirstWords(const Value: TGMString; const WordCount: LongInt; const Separators: TGMString): TGMString;
function GMDeleteNextWord(const AchPos: PtrInt; const Value, Separators: TGMString): TGMString;
function GMDeleteChars(const Value: TGMString; const ADelChars: TGMString; const ANotDelChars: Boolean = False): TGMString;
function GMDeleteCharsA(const AValue: AnsiString; const ADelChars: AnsiString; const ANotDelChars: Boolean = False): AnsiString;
function GMDeleteWords(const AValue: TGMString; const AWords: array of TGMString; const ASeparators: TGMString; const AWholeWords: Boolean = True; const AIgnoreCase: Boolean = True): TGMString;
function GMKeepWords(const AValue: TGMString; const AWords: array of TGMString; const ASeparators: TGMString; const AWholeWords: Boolean = True; const AIgnoreCase: Boolean = True): TGMString;

function GMNextWord(var AChPos: PtrInt; const AValue: TGMString; ASeparatorChar: TGMChar; const ASkipLeadingSeparators: Boolean = True): TGMString; overload;
function GMNextWord(var AChPos: PtrInt; const AValue, ASeparators: TGMString; const ASkipLeadingSeparators: Boolean = True): TGMString; overload;

function GMFirstWord(const Value: TGMString; const Separators: TGMString; const SkipLeadingSeparators: Boolean = True): TGMString;
function GMLastWord(const Value: TGMString; const Separators: TGMString; const ASkipTrailingSeparators: Boolean = True): TGMString;
function GMNThWord(const Value: TGMString; const WordNummber: Word; const Separators: TGMString): TGMString;
function GMWordCount(const AText, ASeparators: TGMString): LongInt;
function GMNextLine(var AChPos: PtrInt; const AText: TGMString): TGMString;
function GMPreviousWord(var AChPos: PtrInt; const AValue, ASeparators: TGMString; const ASkipTrailingSeparators: Boolean = True): TGMString;
//function GMFirstLine(const AValue: TGMString): TGMString;

function GMStrip(const AValue: TGMString; const AChars: TGMString = cWhiteSpace; const ANotStripChars: Boolean = False): TGMString;
function GMStripRight(const AValue: TGMString; const AChars: TGMString = cWhiteSpace): TGMString;
function GMStripLeft(const AValue: TGMString; const AChars: TGMString = cWhiteSpace): TGMString;

function GMTrimLeftA(const AValue: AnsiString; AChar: AnsiChar = ' '): AnsiString;
function GMTrimLeftW(const AValue: UnicodeString; AChar: WideChar = ' '): UnicodeString;
function GMTrimLeft(const AValue: TGMString; AChar: TGMChar = ' '): TGMString;

function GMTrimRightA(const AValue: AnsiString; AChar: AnsiChar = ' '): AnsiString;
function GMTrimRightW(const AValue: UnicodeString; AChar: WideChar = ' '): UnicodeString;
function GMTrimRight(const AValue: TGMString; AChar: TGMChar = ' '): TGMString;

function GMTrim(const AStr: TGMString; AChar: TGMChar = ' '): TGMString;

//function GMTermSentence(const AStr: TGMString): TGMString;
function GMTerminateStr(const AStr: TGMString; const ATermination: TGMString = '.'): TGMString;

function GMFindToken(const AText, AToken: TGMString; var AchPos: PtrInt; const ASeparators: TGMString; AWholeWords: Boolean = True; const AIgnoreCase: Boolean = True): Boolean;
function GMHasToken(const AValue, AToken, ASeparators: TGMString; AWholeWords: Boolean = True; AIgnoreCase: Boolean = True): Boolean;
function GMTokenCount(const AValue, AToken, ASeparators: TGMString; AWholeWords: Boolean = True; AIgnoreCase: Boolean = True): LongInt;

function GMReplaceChars(const AValue: TGMString; const AFindChars, AReplacements: TGMString): TGMString;
function GMReplaceWords(const Value: TGMString; const OldWord, NewWord, Separators: TGMString; const AIgnoreCase: Boolean = True): TGMString;

function GMFindOneOfWords(const Text, Separators: TGMString; const Words: array of TGMString; var chPos: PtrInt; const AIgnoreCase: Boolean = True): Boolean;
function GMFindTextPart(const Text, Separators: TGMString; const StartWords, EndWords: array of TGMString; const AIgnoreCase: Boolean = True): TGMString;
function GMReplaceTextPart(const Text: TGMString; const Separators, NewPart: TGMString; const StartWords, EndWords: array of TGMString; const AIgnoreCase: Boolean = True): TGMString;

function GMCommonPrefixLen(const Str1, Str2: TGMString; const IngoreCase: Boolean = True): LongInt;
function GMQuote(const AValue: TGMString; const ALeftQuote: TGMChar = '"'; const ARightQuote: TGMChar = '"'): TGMString;
//function GMRemoveQuotes(const AValue: TGMString; const ALeftQuotes: TGMString = '"'; const ARightQuotes: TGMString = '"'): TGMString;
function GMRemoveQuotes(const AValue: TGMString; const ALeftQuote: TGMchar = '"'; const ARightQuote: TGMChar = '"'): TGMString;
//function SysStringLen(const S: UnicodeString): LongInt; stdcall; external 'oleaut32.dll' name 'SysStringLen';

function GMIsOneOfStrings(const Value: TGMString; const Strings: array of TGMString; const AIgnoreCase: Boolean = True): Boolean;

function GMFixedEncodeDateTime(const AValue: TDateTime): TGMString;
function GMFixedDecodeDateTime(const AValue: TGMString): TDateTime;
function GMStrToDateTime(const AValue, AFormat: TGMString): TDateTime;
function GMHasDateTimeFormat(const AValue, AFormat: TGMString): Boolean;

function GMCompareVersions(const AVersionA, AVersionB: TGMString): TGMCompareResult;

function GMUpCaseW(ACh: WideChar): WideChar;
function GMUpCaseA(ACh: AnsiChar): AnsiChar;
function GMUpCase(ACh: TGMChar): TGMChar;

function GMLoCaseW(ACh: WideChar): WideChar;
function GMLoCaseA(ACh: AnsiChar): AnsiChar;
function GMLoCase(ACh: TGMChar): TGMChar;

function GMUpperCaseA(const AValue: AnsiString): AnsiString;
function GMUpperCaseW(const AValue: UnicodeString): UnicodeString;
function GMUpperCase(const AValue: TGMString): TGMString;

function GMLowerCase(const AValue: TGMString): TGMString;

function GMHashCodeFromString(const AValue: TGMString): TGMHashCode;

function GMInsertEscapeChars(const AValue: TGMString): TGMString;
function GMResolveEscapeChars(const AValue: TGMString; const ACaller: TObject = nil): TGMString;

function GMInsertQuotedStrEscChars(const AValue: TGMString): TGMString;
function GMResolveQuotedStrEscChars(const AValue: TGMString; const ACaller: TObject = nil): TGMString;


{ ---- complex string manipulations ---- }

//function GMResolveEscapeChars(const Value: TGMString; const EscCh: TGMChar): TGMString;
function GMMakeSingleLine(const AValue: TGMString; const ANewLineStr: TGMString = ', '; const AEmitEmptyLines: Boolean = False): TGMString;
function GMReduceWhiteSpace(const AValue: TGMString): TGMString;
//function GMFullLineBreaks(const Value: TGMString): TGMString;
function GMInsertXMLLineBreaks(const AValue: TGMString): TGMString;
function GMBlockIndent(const AValue, AIndent: TGMString; const AStrip: Boolean = True): TGMString;
function GMReplaceStrings(const AValue: TGMString; const AReplacements: array of TStringReplaceRec; const AMatchCase: Boolean = False): TGMString;
function GMExpandEnvironmentStrings(const APath: TGMString): TGMString;
function GMExpandPath(const APath: TGMString; ARootPath: TGMString = ''; const ADirSep: TGMString = '\'): TGMString;
function GMLimitedTextExtract(const AValue: TGMString; const AMaxLineCount, AMaxLineLength: Integer; const ARemoveEmptyLines: Boolean = True): TGMString;


{ ---- TGMString Buffer Routines ---- }

//function GMStrLen(AValue: PGMChar): LongWord;
function GMStrLen(const AStr: PGMChar; AMaxLen: PtrInt = -1): PtrInt;

//function GMStrNLen(const Value: PAnsiChar; const AMaxLen: Integer): LongWord;
//function GMWStrNLen(const Value: PWideChar; const MaxLen: Integer): LongWord;

//function GMStrLenA(const Value: PAnsiChar; const MaxLen: LongInt = -1): LongInt;
//function GMBufferAsString(const Buffer: Pointer; MaxLen: LongInt = -1): AnsiString;
//function GMStrLenW(const Value: PWideChar; const MaxLen: LongInt = -1): LongInt;
//function GMBufferAsWideString(const Buffer: Pointer; MaxLen: LongInt = -1): UnicodeString;


{ ---- filepath / doc routines ---- }

function GMFileSystemEntry(const FilePath: TGMString): IGMFileProperties;
function GMFindDataFileSize(const FindData: TWin32FindData): Int64;
function GMFileExists(const AFileName: TGMString): Boolean;
procedure GMCheckFileExists(const AFileName: TGMString; const Caller: TObject = nil; const CallingName: TGMString = cDfltRoutineName);
procedure GMCheckFileOpenReadOnly(const AFileName: TGMString; const OpenReadOnly: Boolean; const Caller: TObject = nil; const CallingName: TGMString = cDfltRoutineName);
function GMFolderExists(const AFolderName: TGMString): Boolean;
function GMFileOrFolderExists(const AFileName: TGMString): Boolean;
procedure GMCreatePath(DirPath: TGMString; const Caller: TObject = nil);

function GMApplicationExeName: TGMString;
function GMTempFileName(Directory: TGMString  = ''; Prefix: TGMString  = CGMTempFilePrefix; Extension: TGMString  = CGMTempFileExtension): TGMString;
function GMModuleFileName(const ModuleHandle: HMODULE): TGMString;
function GMThisModuleFileName: TGMString;
function GMExecutableForDocExt(DocExt: TGMString): TGMString;

function GMAppFileWithExtension(const AExtension: TGMString): TGMString;
function GMChangeFileExt(const AFileName, ANewExtension: TGMString): TGMString;

function GMIsRelativePath(const APath: TGMString): Boolean;
function GMTermPath(const Path: TGMString; const Separator: TGMString = '\'): TGMString;
function GMAbsPath(const APath: TGMString; const AAbsStart: TGMString = '\'): TGMString;
function GMApplyRelativePath(const Path, RelativePath: TGMString): TGMString;
function GMAppendPath(const APath1, APath2: TGMString; const APathSep: TGMString = '\'): TGMString;
function GMBuildPath(const APathParts: array of TGMString; const APathSep: TGMString = '\'): TGMString;
function GMAppendStrippedPath(const Path1, Path2: TGMString; const Separator: TGMString = '\'): TGMString;
function GMParentDir(const APath: TGMString): TGMString;
function GMFullPathName(const AFileName: TGMString): TGMString;
function GMLongPathName(const AShortPathName: TGMString): TGMString;
function GMFileHasExtension(const AFileName, FileExtension: TGMString): Boolean;

function GMFileVersionInfo(const AFileName: TGMString; const VersionInfoKey: TGMVersionResInfo; const AAnsiData: Boolean = True): TGMString;
function GMExeVersionInformation(const AVersionInfoKey: TGMVersionResInfo): TGMString;

function GMIsValidFileName(const AFileName: TGMString; const AInvalidChars: TGMString = cInvalidFileNameChars): Boolean;
procedure GMCheckIsValidFileName(const AFileName: TGMString;
                                 const AInvalidChars: TGMString = cInvalidFileNameChars;
                                 const Caller: TObject = nil;
                                 const CallingName: TGMString = '');

function GMExtractFileName(const AFilePath: TGMString): TGMString;
function GMExtractPath(const AFilePath: TGMString): TGMString;
function GMExtractPathOnly(const AFilePath: TGMString): TGMString;
function GMExtractFileExt(const AFilePath: TGMString): TGMString;
function GMExtractFileBaseName(const AFilePath: TGMString): TGMString;
function GMExtractDrive(const AFilePath: TGMString): TGMString;

function GMIsStringMatch(const AValue, AMask: TGMString; const AMatchEmptyMask: Boolean = True; const ACharIndex: LongInt = 1): Boolean;
function GMWalkPathMask(const AValue, AMask, ADirSeparators: TGMString; var AWalkData: RPathWalkData): Boolean;
function GMIsAbsPathMatch(const AValue, AMask, ADirSeparators: TGMString): Boolean;
function GMIsSingleMaskMatch(const AFileName, ASingleMask, ADirSeparators: TGMString; const AMatchCase: Boolean): Boolean;
function GMIsAnyMaskMatch(const AFileName, AMultiMask, ADirSeparators: TGMString; const AMatchEmptyMask: Boolean = True; const AMatchCase: Boolean = False; const AMaskSeparators: TGMString = ';'): Boolean;
   

{ ---- Type Check/Convert ---- }

function GMDateIsNull(const AValue: TDateTime): Boolean;
function GMTimeIsNull(const AValue: TDateTime): Boolean;
function GMVarToNum(const AValue: OleVariant; const ADefaultValue: LongInt = 0): OleVariant;
function GMVarToInt(const AValue: OleVariant; const ADefaultValue: LongInt = 0): LongInt;
function GMVarToFloat(const AValue: OleVariant; const ADefaultValue: double = 0.0): OleVariant;
function GMVarToNULLStr(const AValue: OleVariant): TGMString;
function GMStrToNULLVar(const AValue: TGMString): Variant;
function GMMakeDezInt(const AValue: TGMString; const ADefaultValue: Int64 = 0): TGMString;
function GMMakeFloat(const AValue: TGMString; const ADefaultValue: Double = 0): TGMString;
function GMVarIsNullOrEmpty(const AValue: Variant): Boolean;

function GMVarToStr(const AValue: OleVariant): TGMString;
function GMVarToQuotedStr(const AValue: OleVariant): TGMString;

function GMStrToBool(const AValue: TGMString): Boolean;
function GMBoolToStr(AValue: Boolean; const AStrFalse: TGMString = ''; const AStrTrue: TGMString = ''): TGMString;

function GMGetTimeZoneInfoByRegistryKeyName(const ATimeZoneRegKeyName: TGMString; var ATimeZoneData: TIME_ZONE_INFORMATION): Boolean;
function GMUTCToLocalTime(const AUtcTime: TDateTime; const ALocalTimeZone: PTIME_ZONE_INFORMATION = nil; const ACaller: TObject = nil): TDateTime;
function GMLocalTimeToUTC(const ALocalTime: TDateTime; const ALocalTimeZone: PTIME_ZONE_INFORMATION = nil; const ACaller: TObject = nil): TDateTime;

function GMDateTimeToFileTime(const AValue: TDateTime; const ACaller: TObject = nil): TFileTime;
function GMFileTimeToDateTime(const AValue: TFileTime; const ACaller: TObject = nil): TDateTime;

function GMUnixTimeToDateTime(const AUnixTime: Int64): TDateTime;
function GMUnixTimeFromDateTime(const ADateTime: TDateTime): Int64;


{ ---- formating ---- }

function GMDateTimeToStr(const ADateTime: TDateTime): TGMString;
function GMIntWithThousandSep(const Value: Int64): TGMString;
function GMFileSizeAsString(const FileSize: Int64): TGMString;
function GMFileAttrAsString(const FileEntry: IGMFileProperties; const Separator: TGMString = ', '): TGMString;
function GMFileEntryAsString(const FileEntry: IGMFileProperties; const Separator: TGMString = ', '): TGMString;

function GMFormat(const AFormatStr: TGMString; const Args: array of const): TGMString;

function GMStringToUtf8(const AValue: UnicodeString): AnsiString;
function GMUtf8ToString(const AValue: AnsiString): UnicodeString;


{ ---- Rectangle Routines ---- }

function GMRect(const ALeft, ATop, ARight, ABottom: LongInt): TRect; overload; inline;
function GMRect(const ATopLeft, ABottomRight: TPoint): TRect; overload; inline;
function GMPoint(const AX, AY: LongInt): TPoint; inline;
function GMSize(const cx, cy: LongInt): TSize; inline;
function GMInflateRect(const R: TRect; const dx: LongInt = 0; const dy: LongInt = 0): TRect; inline;
function GMMoveRect(const R: TRect; const dx: LongInt = 0; const dy: LongInt = 0): TRect; overload; inline;
function GMMoveRect(const R: TRect; const Delta: TPoint): TRect; overload; inline;
function GMRectModifiedBy(const R: TRect; const dLeft: LongInt = 0; const dTop: LongInt = 0; const dRight: LongInt = 0; const dBottom: LongInt = 0): TRect;
function GMRectIntersection(const R1, R2: TRect): TRect;
function GMRectUnion(const R1, R2: TRect): TRect;
function GMCenterRectInRect(const Inner, Outer: Trect): TRect;
function GMCenterExtent(const AValue: LongInt; const ASize: TPoint): TPoint;
function GMCenterExtentInRect(const ASize: TPoint; const ARect: TRect): TRect;
function GMRectSize(const ARect: TRect): TPoint;
function GMLayoutRect(const RDraw: TRect; const LayoutSize: TPoint; const HAlignment: TGMHorizontalAlignment; const VAlignment: TGMVerticalAlignment): TRect;
function GMPointOffsBy(const APoint: TPoint; const ADelta: LongInt): TPoint;
function GMAddPoints(const APointA, APointB: TPoint; const AScale: SmallInt = 1): TPoint;
function GMEqualPoints(const PointA, PointB: TPoint): Boolean;
procedure GMExchangeLongInt(var AValue1, AValue2: LongInt);
procedure GMExchangePtrInt(var AValue1, AValue2: PtrInt);


{ ---- Registered Classes ---- }
                    
function GMIsClass(AClassInstance, AClass: TClass): Boolean;
function GMIsClassByName(const AObj: TObject; const AClass: TClass): Boolean;


{ ---- Compiler Design Interface ---- }

function GMGetOrdinalProperty(const AObject: TObject; const PropertyName: TGMString; var PropertyValue: LongInt): Boolean;
function GMGetStringProperty(const AObject: TObject; const PropertyName: TGMString; var PropertyValue: TGMString): Boolean;
function GMSetStringProperty(const AObject: TObject; const PropertyName: TGMString; const PropertyValue: TGMString): Boolean;
// GMAssignObjProperties works only for classes declared with the $M+ compiler directive
function GMCheckGetEnumValFromName(const ATypInfo: PTypeInfo; const AEnumValueName: TGMString): Integer;
procedure GMAssignObjProperties(const Source, Dest: TObject; const TypeKinds: TTypeKinds);


{ ---- Arithmetic Functions ---- }

function Min(A, B: LongInt): LongInt; overload; inline;
function Min(A, B: Int64): Int64; overload; inline;
function Max(A, B: LongInt): LongInt; overload; inline;
function Max(A, B: Int64): Int64; overload; inline;
function MakeLongInt(Lo, Hi: SmallInt): LongInt; inline;

function GMBoundedInt(Value, Min, Max: LongInt; const MinBased: Boolean = True): LongInt; overload; inline;
function GMBoundedInt(Value, Min, Max: Int64; const MinBased: Boolean = True): Int64; overload; inline;

function GMBoundedDouble(Value, Min, Max: Double; const MinBased: Boolean = True): Double;

function GMIsInRange(const Value, Min, Max: LongInt): Boolean; overload; inline;
function GMIsInRange(const Value, Min, Max: Int64): Boolean; overload; inline;

//function GMAbsInt(const Value: LongInt): LongInt;
//function GMAbsPtrInt(AValue: PtrInt): PtrInt; inline;
function GMAddPtr(const APointer: Pointer; const AOffset: LongInt): Pointer; overload; inline;
function GMAddPtr(const APointer: Pointer; const AOffset: Int64): Pointer; overload; inline;

function GMAlignedValue(const AValue, AlignDelta: PtrInt): PtrInt; inline;


{ ---- Dlg window related ---- }

function GMAddMsgBoxIcon(const Flags: LongWord; const Severity: TGMSeverityLevel): LongWord;
function GMWindowsMsgBox(const Msg: TGMString; const Severity: TGMSeverityLevel = svInformation; Flags: LongWord = 0; const ParentWnd: HWnd = cDfltPrntWnd): LongInt; stdcall;
function GMActiveProcessWindow: HWnd;
function GMDlgRootWindow(const AWnd: HWnd): HWnd;
function GMAppRootWindow(const AWnd: HWnd = cDfltPrntWnd; const SearchProcess: Boolean = True): HWnd;
function GMModalDlgParentWnd(const AParentWnd: HWnd = cDfltPrntWnd; const ASearchProcess: Boolean = True): HWnd;
procedure GMRemoveAllMenuItems(const Menu: HMenu);


{ ---- Exceptions ---- }

function GMHrCheckObj(const HRCode: HResult;
                      const Obj: TObject = nil;
                      const ARoutineName: TGMString = cDfltRoutineName;
                      const AMsgPostfix: TGMString = '';
                      const Strict: Boolean = False;
                      const AHelpCtx: LongInt = cDfltHelpCtx): HResult;

function GMHrCheckObjParams(const HRCode: HResult;
                            const Params: array of PGMChar;
                            const Obj: TObject = nil;
                            const ARoutineName: TGMString = cDfltRoutineName;
                            const AMsgPostfix: TGMString = '';
                            const Strict: Boolean = False;
                            const AHelpCtx: LongInt = cDfltHelpCtx): HResult;

procedure GMHrTraceObjParams(const HRCode: HResult;
                             const Params: array of PGMChar;
                             const Obj: TObject = nil;
                             const ARoutineName: TGMString = cDfltRoutineName;
                             const AMsgPostfix: TGMString = '';
                             const Strict: Boolean = False;
                             const AHelpCtx: LongInt = cDfltHelpCtx);

procedure GMHrCheckIntf(const HRCode: HResult;
                        const Intf: IUnknown = nil;
                        const ARoutineName: TGMString = cDfltRoutineName;
                        const AMsgPostfix: TGMString = '';
                        const Strict: Boolean = False;
                        const AHelpCtx: LongInt = cDfltHelpCtx);

procedure GMAPICheckObj(const ARoutineName: TGMString;
                        const AMsgPostfix: TGMString;
                        const AWinApiErrorCode: DWORD; const AWinApiRetVal: BOOL;
                        const AObj: TObject = nil;
                        const AHelpCtx: LongInt = cDfltHelpCtx);

procedure GMAPICheckObjParams(const ARoutineName: TGMString;
                              const AMsgPostfix: TGMString;
                              const AWinApiErrorCode: DWORD; const AWinApiRetVal: BOOL;
                              const Params: array of PGMChar;
                              const Obj: TObject = nil;
                              const AHelpCtx: LongInt = cDfltHelpCtx);

procedure GMAPICheckObjEx(const ARoutineName: TGMString;
                          const AMsgPostfix: TGMString;
                          const AWinApiErrorCode: DWORD; const AWinApiRetVal: BOOL;
                          const SuccessCodes: array of PtrInt;
                          const Obj: TObject = nil;
                          const AHelpCtx: LongInt = cDfltHelpCtx);



function GMExceptObject: TObject;
function GMExceptAddr: Pointer;


{ ---- OLE ---- }

function OLEFormatEtc(const cfFormat: TClipFormat = 0; const ptd: PDVTargetDevice = nil; const dwAspect: LongInt = DVASPECT_CONTENT; const lindex: LongInt = -1; const tymed: LongInt = TYMED_HGLOBAL): TFormatEtc;

function OLEStgMedium(const tymed: LongInt; const handle: THandle; const unkForRelease: Pointer = nil): TStgMedium; overload;
function OLEStgMedium(const tymed: LongInt; const pUnknown: Pointer; const unkForRelease: Pointer = nil): TStgMedium; overload;
function OLEStgMedium(const tymed: LongInt; const lpszFileName: POleStr; const unkForRelease: Pointer = nil): TStgMedium; overload;

//function GMFindOleServerForClassId(const ClassId: TGUID; var OleServer: TGMString; var IconIndex: LongInt): Boolean;


{ ---- system ---- }

function GMWindowsDir: TGMString;
function GMWinSystemDir: TGMString;
function GMWinTempDir: TGMString;
function GMCurrentDir: TGMString;
{$IFDEF JEDIAPI}
procedure GMGetUserAndDomainNames(var AUserName, ADomainName: TGMString);
{$ENDIF}
function GMThisComputerName: TGMString;
function GMThisUserName: TGMString;
function GMThisUserSID: TGMString;
procedure GMGetAllUserNames(var AUserNames: TGMStringArray);
procedure GMGetAllUserSettingsDirectories(var ADirectories: TGMStringArray; const ASubDirName: TGMString);

function GMWinVersion: TGMWinVersion;
function GMIs64BitOS: BOOL;
function GMPointerSizeInBits: Integer;
function GMPointerSizeAsString(const AAddLeft: TGMString = ''; const AAddRight: TGMString = ''): TGMString;
function GMMousePosition: TPoint;
procedure GMRefreshMouseCursor;
procedure GMSetCaretPos(const ACaretPos: TPoint);
function GMSetLayeredWindowAttributes(Wnd: HWnd; crKey: COLORREF; bAlpha: Byte; dwFlags: DWORD): BOOL;
function GMCanUseLayeredWindows: Boolean;
procedure GMLoadProcAddress(const AModuleName: TGMString; const AProcName: AnsiString; var AProc);
function GMGetProcAddress(const AModuleName: TGMString; const AProcName: AnsiString; const ACheck: Boolean = True): Pointer;
procedure GMParseCommandLine(var AArguments: TGMStringArray);


{ ---- Tracing ---- }

//procedure GMIterateLines(const AText: TGMString; const ALineProc: TProcessLineProc; const AData: Pointer);
function GMDfltDoTracing: Boolean; stdcall;
procedure GMDfltTraceLine(const ALine: TGMString);
procedure GMDfltTrace(const AText: TGMString; const APrefix: TGMString = '');
procedure GMTraceMethod(const AObj: TObject; const AMethodName: TGMString; const AText: TGMString = '');
procedure GMTraceException(const AException: TObject; const ASingleLine: Boolean = True);
procedure GMTraceAllInterfaces(const AIntf: IUnknown; const AName: TGMString);


{ ---- Exception handling ---- }

function GMPresentExceptionUI(const AException: TObject): Boolean;

function GMHResultFromWin32(const AWinErrorCode: LongWord; const AFacilitycode: LongWord = FACILITY_WIN32): HRESULT;
//function GMWin32FromHResult(const HRCode: HResult): LongWord;

function GMDfltExecExceptionDlg(const AException: TObject; const ParentWnd: HWnd= cDfltPrntWnd): LongInt; stdcall;
//function GMDfltVerboseExceptionMessages: Boolean; stdcall;
function GMDfltHrExceptionHandler(const AException: TObject; const AParentWnd: HWnd; const ADefaultCode: HResult = E_UNEXPECTED): HResult; stdcall; // cHrPrntWnd
function GMBuildExceptionMsg(const AExceptInfo: IGMExceptionInformation; const AVerbose: Boolean = {$IFDEF DEBUG}True{$ELSE}False{$ENDIF}): TGMString;
function GMMsgFromExceptObj(const AException: TObject; const AVerbose: Boolean = {$IFDEF DEBUG}True{$ELSE}False{$ENDIF}): TGMString;
function GMExceptionSeverity(const AException: TObject; const ADefaultValue: TGMSeverityLevel = svError): TGMSeverityLevel;
function GMIsFatalException(const AExceptObject: TObject): Boolean;
function GMAskExceptionContinue(const AException: TObject; const ErrorAction: TGMErrorAction; AskContinue: TGMString = ''; const ParentWnd: HWnd = cDfltPrntWnd): Boolean;
function GMModuleErrorMessage(const ModuleFileName: TGMString; const ErrorCode: DWORD): TGMString;


{ ---- Compare Routines ---- }
                                                                                  // LINGUISTIC_IGNORECASE ??
function GMCompareNames(const AName1, AName2: TGMString; const ACmpareFlags: DWORD = NORM_IGNORECASE; ALocale: LCID = 0): TGMCompareResult;

function GMCompareByLeft(const ItemA, ItemB: IUnknown): TGMCompareResult;
function GMCompareByName(const ItemA, ItemB: IUnknown): TGMCompareResult;
function GMCompareByString(const ItemA, ItemB: IUnknown): TGMCompareResult;
function GMCompareByNameDigitsAsNumbers(const ItemA, ItemB: IUnknown): TGMCompareResult;
function GMCompareByFileName(const ItemA, ItemB: IUnknown): TGMCompareResult;
function GMCompareByPosition(const ItemA, ItemB: IUnknown): TGMCompareResult;
//function GMCompareByKeyValue(const ItemA, ItemB: IUnknown): TGMCompareResult;
function GMCompareByInstance(const ItemA, ItemB: IUnknown): TGMCompareResult;
function GMCompareByGuid(const ItemA, ItemB: IUnknown): TGMCompareResult;
function GMCompareByHandle(const ItemA, ItemB: IUnknown): TGMCompareResult;

function GMCompareFileEntryByName(const ItemA, ItemB: IUnknown): TGMCompareResult;
function GMCompareFileEntryBySize(const ItemA, ItemB: IUnknown): TGMCompareResult;
function GMCompareFileEntryByLastMod(const ItemA, ItemB: IUnknown): TGMCompareResult;

function GMCompareVariants(const ValueA, ValueB: Variant; const MatchCase: Boolean = True): TGMCompareResult;
function GMCompareUnionValues(const ValueA, ValueB: RGMUnionValue; const MatchCase: Boolean = True): TGMCompareResult;


{ ---- Message processing ---- }

function GMHotKeyRec(const AFlags: Byte; const AKey, ACommand: Word): TAccel;
function GMTranslateAndDispatchMsg(var AMsg: TMsg): LongInt;
procedure GMProcessAllMessages;
procedure GMProcessMessages(const AMessages: array of LongInt);
function GMMsgLoopWaitForMultipleObjects(const AHandleCount: DWORD; const AHandles: Pointer; const AProcessMessages: Boolean;
    const AWaitTimeoutMilliSec: DWORD = INFINITE; const AWaitForAll: BOOL = False): DWORD;
function GMExecProcess(const ACmdLine: TGMString; const AProcessFlags: DWORD = 0; const AWaitForTermination: Boolean = False;
    const AUserToken: THandle = 0; const AWaitForInputReady: Boolean = True): DWORD;


{ ---- creators ---- }

function GMIntfConnectData(const IID: TGUID; const Required: Boolean = cDfltIIDRequired): TGMIntfConnectDataRec;
function GMStringReplaceRec(const ASearchStr, AReplacement: TGMString): TStringReplaceRec;


{ ---- global memory ---- }

//procedure GMFreeMetafileHandle(const HMetaFile: HGlobal);
function GMCopyToGlobalMem(const PData: Pointer; const DataSize: LongWord; const AllocFlags: LongWord = GMEM_MOVEABLE): HGlobal;
function GMCopyHGlobal(const Handle: HGLOBAL; const AllocFlags: LongWord = GMEM_MOVEABLE): HGLOBAL;


{ ---- TGMString Arrays ---- }

procedure GMBreakLinesToStrArray(const ASrcText: TGMString; var ADstLines: TGMStringArray; const AddEmptyLines: Boolean = False);
procedure GMSplitWordsToStrArray(const AValue, ASeparators: TGMString; const AAllowDuplicates: Boolean; var ADestStrings: TGMStringArray);


{ ---- Other ---- }

function GMErrorActionName(const ErrorAction: TGMErrorAction): TGMString;
//procedure GMAssignImgFromRes(const Picture: TPicture; const ResourceName: TGMString; const GraphicClass: TGraphicClass; const ResTypeName: TGMString = cDfltGMResTypeName; ResModuleHandle: THandle = 0);

// GMBreakLines smartly recognizes all kinds of line breaks CRLF | LFCR | CR | LF
procedure GMBreakLines(const ASrcText: TGMString; const AAddLineFunc: TGMAddLineFunc; const AData: Pointer; const AddEmptyLines: Boolean = False);

function GMRegKeyAsString(const ARootKey: HKEY): TGMString;

function GMScrollData(const fMask: UINT = 0; const nMin: LongInt = 0; const nMax: LongInt = 0;
                      const nPage: UINT = 0; const nPos: LongInt = 0; const nTrackPos: LongInt = 0): TScrollInfo;
function GMScrollDataFromWnd(const Handle: HWnd; const CtlKind, Mask: LongWord): TScrollInfo;
function GMWheelScrollDelta(const PageSize: LongInt; const Direction: LongInt): LongInt;
function GMCalcScrollPos(const AScrollCode: LongInt; const AScrollData: TScrollInfo): LongInt;

function GMIsUrl(const AUrl: TGMString): Boolean;
procedure GMCheckIsValidUrl(const AUrl: TGMString; const Caller: TObject = nil; const CallingName: TGMString = '');
procedure GMShowURL(const AURL: TGMString; const ACaller: TObject = nil);

function GMTimerList: TGMObjArrayCollection;

procedure GMTrace(const AText: TGMString; const APrefix: TGMTracePrefix = tpNone);

procedure GMFreeAndNil(var Obj);

procedure GMAddCharsToSetOfChar(const ACharSet: TGMSetOfChar; const ACharsToAdd: TGMString; const ARemoveOtherChars: Boolean);

{$IFNDEF JEDIAPI}
function TzSpecificLocalTimeToSystemTime(lpTimeZoneInformation: PTimeZoneInformation;
        const lpLocalTime: TSystemTime; var lpUniversalTime: TSystemTime): BOOL; stdcall; external 'kernel32.dll';
{$ENDIF}

{$EXTERNALSYM ShellExecute}
function ShellExecute(Wnd: HWND; Operation, FileName, Parameters,
  Directory: PGMChar; ShowCmd: Integer): THandle; stdcall; external 'shell32.dll' name {$IFDEF UNICODE}'ShellExecuteW'{$ELSE}'ShellExecuteA'{$ENDIF};



resourcestring

  //RStrUnknown = '<Unknown>';
  RStrUnknown = '?';
  RStrMessage = 'Message';

  RStrPassword = 'Password';
  RStrUsername = 'Username';

  RStrYes = 'Yes';
  RStrNo = 'No';

  RStrTrue = 'True';
  RStrFalse = 'False';

  RStrOperationCanceled = 'Operation canceled';
  RStrOperationError = 'Operation Error';

  RStrWriteErrorFmt = 'Write Error, bytes to write %d, bytes that have been written %d';
  RStrReadErrorFmt = 'Read Error, bytes to read %d, bytes that have been read %d';

  RStrNoExceptInfo = 'No exception information available';

  RStrContinueOperation = 'Continue Operation';
  RStrAskUser = 'Ask User';
  RStrAbort = 'Abort Operation';

  RStrExceptionClass = 'Exception Class';
  RStrSeverityLevel = 'Severity Level';
  RStrObjectName = 'Object Name';
  RStrObjectClass = 'Object Class';
  RStrRoutineName = 'Routine Name';
  RStrExceptAddr = 'Exception Address';

  RStrUnknownError = 'Unknown Error';

  RStrFileNotExists = 'File not found: "%s"';
  RStrFileReadonlyFmt = 'The file "%s" is readonly and can only be opened in read only mode';
  RStrValueBoundsHint = 'The value must be between %d and %d';

  RStrResWriteNotSupported = 'Writing to resources not supported';

  RStrAllFiles = 'All Files';

  RStrInvalidESCSequenceFmt = 'Invalid escape char sequence "%s" in string "%s" at position %d';

  RStrInvalidIntStrFmt = 'Invalid character in integer value "%s" at position %d';
  RStrInvalidFloatStrFmt = 'Invalid character in floating point value "%s" at position %d';
  RStrInvalidCurrencyStrFmt = 'Invalid character in currency value "%s" at position %d';
  RStrInvalidFmtChar = 'Invalid format type char';
  RStrInvalidArgTypeFmtChar = 'Invalid argument type for format type char';
  RStrFmtDigitExpected = 'Digit expected in format string but found';
  RStrInvalidDateTimeFmtStr = 'Invalid date time format string "%s" at character position %d';

  RStrInvalidFileName = 'Invalid file or folder name "%s". The name must not be empty and must not contain one of the following charachters: %s';
  //RStrInvalidFileName = '"%s" ist kein g├╝ltiger Datei- oder Ordnername. Der Name darf nicht leer sein und folgende Zeichen nicht enthalten: %s';

const

  cGMNoHandler: TGMObjNotifyProc = nil; // <- useful for overloaded inherited constructor call
  //cIntfNil: IUnknown = nil; // <- useful for overloaded inherited constructor call

var

  gGMMainThreadID: LongWord = 0;
//vfGMVerboseExceptionMessages: TGMBooleanFunc = GMDfltVerboseExceptionMessages;
  vfGMDoTracing: TGMBooleanFunc = GMDfltDoTracing;
  vfGMTraceLine: TGMTraceLineProc = GMDfltTraceLine;
  vfGMTrace: TGMTraceProc = GMDfltTrace;
  vfGMMessageBox: TGMMessageBoxFunc = GMWindowsMsgBox;
  vGMWaitCursor: TGMCursor = crWait;
  vfGMHrExceptionHandler: TGMHrExceptionHandlerFunc = GMDfltHrExceptionHandler;
  vfGMExecExceptionDlg: TGMExceptionDlgFunc = GMDfltExecExceptionDlg;
  vGMTopWindow: HWnd = 0;
  gDigitAsNumberSortSupported: Boolean = False;

  vGMKeyAcceleratorTargetWnd: HWnd = 0;
  vGMKeyAcceleratorTable: IGMGetHandle = nil;

  //vGMErrorActionNames: array [TGMErrorAction] of TGMString = (RStrContinueOperation, RStrAskUser, RStrAbort);

  //vAliveMessages: array [0..18] of LongInt = (6, 7, 8, 10, 11, 12, 13, 14, 15, $0014, $0200, $0113, $0020, $002C, $002B, $0083, $0084, $0085, $0086);
  //vAliveMessages: set of Byte = [6, 7, 8, 10, 11, 12, 13, 14, 15, $0014, $0020, $002C, $002B, $0083, $0084, $0085, $0086]; // $0200, $0113,


implementation

{$IFDEF JEDIAPI}uses{$ELSE}
  {$IFDEF DELPHI6}uses{$ENDIF}
{$ENDIF}

{$IFDEF DELPHI6}Variants{$ENDIF}
{$IFDEF JEDIAPI}{$IFDEF DELPHI6},{$ENDIF}jwaWinVer, JwaSddl{$ENDIF}

{$IFDEF JEDIAPI};{$ELSE}
  {$IFDEF DELPHI6};{$ENDIF}
{$ENDIF}


resourcestring

  RStrIntfListCantChange = 'The Interface Lists cannot be changed while the Object is connected';
  RStrExceptionModule = 'Exception in Module';
  RStrNoModuleName = 'No module name specified';
  RStrRoutineNotFound = 'Routine "%s" not found in Module "%s"';
  //RStrInvalidListSize = 'Ivalid List Size: %d';
  RStrCharPos = 'Character position';


  RStrFileCreatedFmt = 'Created %s';
  RStrFileModifiedFmt = 'Modified %s';
  RStrFileSizeFmt = 'Size %s';
  RStrFileAttrFmt = 'Attributes [%s]';
  RStrInFolderFmt = 'in Folder "%s"';

  RStrNoTypeInfo = 'Type information is nil';
  RStrNotEnumTypeFmt = 'Type "%s" is of kind "%s" instead of "%s"';
  RStrInvalidEnumValFmt = 'Invalid value "%s" for enumeration type "%s". Valid values are (%s)';
  RStrInvalidUrlFmt = 'Invalid URL: %s';



var

  gGMTimerList: TGMObjArrayCollection = nil;
  gCStraceText: IGMCriticalsection = nil;
  gCSExceptHandler: IGMCriticalsection = nil;


{ ------------------------------------ }
{ ---- Names from resourcestrings ---- }
{ ------------------------------------ }

function GMErrorActionName(const ErrorAction: TGMErrorAction): TGMString;
begin
  case ErrorAction of
   eaContinue: Result := RStrContinueOperation;
   eaAskUser: Result := RStrAskUser;
   eaAbort: Result := RStrAbort;
   else Result := '';
  end;
end;


{ ---------------------- }
{ ---- TGMSetOfChar ---- }
{ ---------------------- }

const

  cCharSetElementBitSize = 8;
  cByteBitMask: array [0..7] of Byte = (1, 2, 4, 8, 16, 32, 64, 128);


procedure GMAddCharsToSetOfChar(const ACharSet: TGMSetOfChar; const ACharsToAdd: TGMString; const ARemoveOtherChars: Boolean);
var i: PtrInt;
begin
  if ACharSet <> nil then
   begin
    if ARemoveOtherChars then ACharSet.RemoveAllChars;
    for i:=1 to Length(ACharsToAdd) do ACharSet.AddChar(ACharsToAdd[i]);
   end;
end;

procedure TGMSetOfChar.RemoveAllChars;
begin
  FillChar(FElementsAsBits, SizeOf(FElementsAsBits), 0);
end;

procedure TGMSetOfChar.AddAllChars;
begin
  FillChar(FElementsAsBits, SizeOf(FElementsAsBits), $FF);
end;

procedure TGMSetOfChar.AddChar(AChar: TGMChar);
var divIdx: PtrInt;
begin
  divIdx := Ord(AChar) div cCharSetElementBitSize;
  FElementsAsBits[divIdx] := FElementsAsBits[divIdx] or cByteBitMask[Ord(AChar) mod cCharSetElementBitSize];
end;

procedure TGMSetOfChar.RemoveChar(AChar: TGMChar); //: Boolean;
var divIdx: PtrInt;
begin
  //Result := Contains(AChar);
  divIdx := Ord(AChar) div cCharSetElementBitSize;
  FElementsAsBits[divIdx] := FElementsAsBits[divIdx] and not cByteBitMask[Ord(AChar) mod cCharSetElementBitSize];
end;

function TGMSetOfChar.Contains(AChar: TGMChar): Boolean;
begin
  Result := FElementsAsBits[Ord(AChar) div cCharSetElementBitSize] and cByteBitMask[Ord(AChar) mod cCharSetElementBitSize] <> 0;
end;

procedure TGMSetOfChar.Union(AOther: TGMSetOfChar);
var i: PtrInt; pSrc, pDst: PPtrUInt;
begin
  //if AOther <> nil then
  //  for i:=Low(FElementsAsBits) to High(FElementsAsBits) do
  //      FElementsAsBits[i] := FElementsAsBits[i] or AOther.FElementsAsBits[i];

  //
  // Do Assignment in granularity of a native int, using full processor register size should be faster ...
  //
  pDst := PPtrUInt(@FElementsAsBits[Low(FElementsAsBits)]);
  pSrc := PPtrUInt(@AOther.FElementsAsBits[Low(AOther.FElementsAsBits)]);
  for i:=0 to Length(FElementsAsBits) div SizeOf(PtrUInt)-1 do
   begin
     pDst^ := pDst^ or pSrc^;
     Inc(pSrc); Inc(pDst);
   end;
end;


{ -------------------- }
{ ---- TGMNameObj ---- }
{ -------------------- }

constructor TGMNameObj.Create(const AName: TGMString; const ARefLifeTime: Boolean);
begin
//inherited
  Create(ARefLifeTime);
  FName := AName;
end;

function TGMNameObj.GetName: TGMString;
begin
  Result := FName;
end;

procedure TGMNameObj.SetName(const ANewName: TGMString);
begin
  FName := ANewName;
end;

function TGMNameObj.HashCode: TGMHashCode;
begin
  Result := GMHashCodeFromString(FName);
end;


{ ---------------------- }
{ ---- TGMHandleObj ---- }
{ ---------------------- }

constructor TGMHandleObj.Create(const AHandle: THandle; const ARefLifeTime: Boolean);
begin
//inherited
  Create(ARefLifeTime);
  FHandle := AHandle;
end;

function TGMHandleObj.GetHandle: THandle;
begin
  Result := Handle;
end;

function TGMHandleObj.HashCode: TGMHashCode;
begin
  Result := TGMHashCode(FHandle);
end;

function TGMHandleObj.GetHandleAddr: Pointer;
begin
  Result := @FHandle;
end;


{ --------------------------- }
{ ---- TGMCloseHandleObj ---- }
{ --------------------------- }

destructor TGMCloseHandleObj.Destroy;
begin
  if FHandle <> 0 then begin CloseHandle(FHandle); FHandle := 0; end;
  inherited Destroy;
end;


{ --------------------------- }
{ ---- TGMCloseHandleObj ---- }
{ --------------------------- }

constructor TGMHotKeyTable.Create(const AKeys: array of TAccel; const ARefLifeTime: Boolean);
{$IFNDEF JEDIAPI}var pa: PAccel;{$ENDIF}
begin
  {$IFDEF JEDIAPI}
  FHandle := CreateAcceleratorTable(@AKeys[Low(AKeys)], Length(AKeys));
  {$ELSE}
  pa := @AKeys[Low(AKeys)];
  FHandle := CreateAcceleratorTable(pa^, Length(AKeys));
  {$ENDIF}

  inherited Create(FHandle, ARefLifeTime);
  GMApiCheckObj('CreateAcceleratorTable', '', GetLastError, FHandle <> 0, Self);
end;

destructor TGMHotKeyTable.Destroy;
begin
  if FHandle <> 0 then begin DestroyAcceleratorTable(FHandle); FHandle := 0; end;
  inherited Destroy;
end;


{ ----------------------------- }
{ ---- TGMNamedOsHandleObj ---- }
{ ----------------------------- }

function TGMNamedOsHandleObj.GetName: TGMString;
begin
  Result := FName;
end;


{ ----------------------------- }
{ ---- TGMMutableHandleObj ---- }
{ ----------------------------- }

procedure TGMMutableHandleObj.SetHandle(const Value: THandle);
begin
  FHandle := Value;
end;


{ ----------------------- }
{ ---- TGMIntegerObj ---- }
{ ----------------------- }

constructor TGMIntegerObj.Create(const AValue: PtrInt; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FValue := AValue;
end;

function TGMIntegerObj.HashCode: TGMHashCode;
begin
  Result := FValue;
end;


{ ------------------------ }
{ ---- TGMPositionObj ---- }
{ ------------------------ }

destructor TGMPositionObj.Destroy;
begin
  inherited;
end;

function TGMPositionObj.GetPosition: PtrInt;
begin
  Result := FValue;
end;


{ -------------------- }
{ ---- TGMLeftObj ---- }
{ -------------------- }

function TGMLeftObj.GetLeft: LongInt;
begin
  Result := FValue;
end;


{ -------------------- }
{ ---- TGMGuidObj ---- }
{ -------------------- }

constructor TGMGuidObj.Create(const AGuid: TGUID; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FGuid := AGuid;
end;

function TGMGuidObj.GetGUID: TGUID;
begin
  Result := FGuid;
end;


{ -------------------------- }
{ ---- TGMNameAndPosObj ---- }
{ -------------------------- }

constructor TGMNameAndPosObj.Create(const AName: TGMString; const APosition: LongInt; const ARefLifeTime: Boolean);
begin
  inherited Create(AName, ARefLifeTime);
  FPosition := APosition;
end;

function TGMNameAndPosObj.GetPosition: PtrInt;
begin
  Result := FPosition;
end;


{ ------------------------------- }
{ ---- TGMNameAndStrValueObj ---- }
{ ------------------------------- }

constructor TGMNameAndStrValueObj.Create(const AName, AStrValue: TGMString; const ARefLifeTime: Boolean);
begin
  Create(AName, ARefLifeTime);
  FStrValue := AStrValue;
end;

function TGMNameAndStrValueObj.GetStringValue: TGMString;
begin
  Result := FStrValue;
end;

function TGMNameAndStrValueObj.GetText: TGMString;
begin
  Result := FStrValue;
end;

function TGMNameAndStrValueObj.GetUnionValue: RGMUnionValue;
begin
  Result := FStrValue;
end;

procedure TGMNameAndStrValueObj.SetStringValue(const AStrValue: TGMString);
begin
  FStrValue := AStrValue;
end;

procedure TGMNameAndStrValueObj.SetText(const AStrValue: TGMString);
begin
  FStrValue := AStrValue;
end;

procedure TGMNameAndStrValueObj.SetUnionValue(const AUnionValue: RGMUnionValue);
begin
  FStrValue := AUnionValue;
end;


{ ---------------------------- }
{ ---- TGMNameAndValueObj ---- }
{ ---------------------------- }

constructor TGMNameAndValueObj.Create(const AName: TGMString; const AValue: RGMUnionValue; const ARefLifeTime: Boolean);
begin
  Create(ARefLifeTime);
  FName := AName;
  FValue := AValue;
end;

//function TGMNameAndValueObj.GetName: TGMString;
//begin
//Result := FName;
//end;
//
//procedure TGMNameAndValueObj.SetName(const AValue: TGMString);
//begin
//FName := AValue;
//end;

function TGMNameAndValueObj.GetUnionValue: RGMUnionValue;
begin
  Result := FValue;
end;

function TGMNameAndValueObj.GetStringValue: TGMString;
begin
  Result := FValue;
end;

function TGMNameAndValueObj.GetKeyValue: RGMUnionValue;
begin
  Result := FValue;
end;

procedure TGMNameAndValueObj.SetUnionValue(const AUnionValue: RGMUnionValue);
begin
  FValue := AUnionValue;
end;

function TGMNameAndValueObj.GetText: TGMString;
begin
  Result := FValue.AsStringDflt;
end;

procedure TGMNameAndValueObj.SetText(const AValue: TGMString);
//var ValStr: TGMString;
begin
  case FValue.ValueType of
   uvtDouble: FValue := GMStrToDouble(GMReplaceChars(AValue, '.', ','));
   uvtInt64: FValue := GMStrToInt64(AValue);
   uvtInt32: FValue := GMStrToInt(AValue);
   else FValue := AValue;
  end;
  //if FValue.ValueType in [uvtDouble] then ValStr := GMReplaceChars(AValue, '.', ',') else ValStr := AValue;
  //{$IFDEF FPC}
  //FValue := VarAsType(ValStr, VarType(FValue));
  //{$ELSE}
  //VarCast(FValue, ValStr, VarType(FValue));
  //{$ENDIF}
end;

procedure TGMNameAndValueObj.LoadData(const ASource: IGMValueStorage;
 const ACryptCtrlData: PGMCryptCtrlData); stdcall;
begin
  if ASource <> nil then FValue := ASource.ReadUnionValue(Name, FValue); // <- Dont't trigger AfterValueChange Event here
end;

procedure TGMNameAndValueObj.StoreData(const ADest: IGMValueStorage;
 const ACryptCtrlData: PGMCryptCtrlData); stdcall;
begin
  if ADest <> nil then ADest.WriteUnionValue(Name, FValue);
end;

//function TGMNameAndValueObj.HashCode: TGMHashCode;
//begin
//Result := GMHashCodeFromString(FName);
//end;


{ --------------------------- }
{ ---- TGMUserAccountObj ---- }
{ --------------------------- }

constructor TGMUserAccountObj.Create(const AUsername, APassword: TGMString; const ASaveUserData: Boolean = cDfltSaveUSerData; const ARefLifeTime: Boolean = True);
begin
  inherited Create(ARefLifeTime);
  FUsername := AUsername;
  FPassword := APassword;
//FDomain := ADomain;
  FSaveUserData := ASaveUserData;
end;

function TGMUserAccountObj.GetUsername: PGMChar;
begin
  Result := PGMChar(FUsername);
end;

function TGMUserAccountObj.GetPassword: PGMChar;
begin
  Result := PGMChar(FPassword);
end;

//function TGMUserAccountObj.GetDomain: PGMChar;
//begin
//Result := PGMChar(FDomain);
//end;

function TGMUserAccountObj.GetSaveUserData: Boolean;
begin
  Result := FSaveUserData;
end;

procedure TGMUserAccountObj.SetUsername(AUsername: PGMChar);
begin
  FUsername := AUsername;
end;

procedure TGMUserAccountObj.SetPassword(APassword: PGMChar);
begin
  FPassword := APassword;
end;

//procedure TGMUserAccountObj.SetDomain(ADomain: PGMChar);
//begin
//FDomain := ADomain;
//end;

procedure TGMUserAccountObj.SetSaveUserData(Value: Boolean);
begin
  FSaveUserData := Value;
end;


{ ------------------------- }
{ ---- TGMDLLHandleObj ---- }
{ ------------------------- }

constructor TGMDLLHandleObj.Create(const ADLLFilePath: TGMString; const ACheckSuccess: Boolean = False; const ARefLifeTime: Boolean = True);
var lastErr: DWORD;
begin
  inherited Create(LoadLibrary(PGMChar(ADLLFilePath)), ARefLifeTime);
  if ACheckSuccess and (Handle = 0) then
   begin
    lastErr := GetLastError;
    GMAPICheckObjParams('LoadLibrary("'+ADLLFilePath+'")', '', lastErr, Handle <> 0, [PGMChar(ADLLFilePath)], Self);
   end;
end;

destructor TGMDLLHandleObj.Destroy;
begin
  if Handle <> 0 then begin FreeLibrary(Handle); FHandle := 0; end;
  inherited Destroy;
end;


{ ----------------------- }
{ ---- TGMIconHolder ---- }
{ ----------------------- }

destructor TGMIconHolder.Destroy;
begin
  if FHandle <> 0 then DestroyIcon(FHandle);
  inherited;
end;


{ ------------------- }
{ ---- TGMRegKey ---- }
{ ------------------- }

constructor TGMRegKey.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
end;

constructor TGMRegKey.CreateKey(const ARootKey: HKEY; AKeyPath: TGMString; const AAccessMode: DWORD; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FRootKey := ARootKey;
  AKeyPath := FormatKeyPath(AKeyPath);
  GMApiCheckObj('RegCreateKeyEx("'+AKeyPath+'")', '', RegCreateKeyEx(ARootKey, PGMChar(AKeyPath), 0, nil, REG_OPTION_NON_VOLATILE, AAccessMode, nil, FHandle, nil), False, Self);
end;

constructor TGMRegKey.CreateKey(const ARootKey: IUnknown; const AKeyPath: TGMString; const AAccessMode: DWORD; const ARefLifeTime: Boolean);
var PIKey: IGMGetHandle;
begin
  GMCheckQueryInterface(ARootKey, IGMGetHandle, PIKey, 'TGMRegKey.CreateKey');
  FRootKeyRef := ARootKey;
  CreateKey(PIKey.Handle, AKeyPath, AAccessMode, ARefLifeTime);
end;

destructor TGMRegKey.Destroy;
begin
  CloseKey;
  inherited Destroy;
end;

function TGMRegKey.Obj: TGMRegKey;
begin
  Result := Self;
end;

function TGMRegKey.GetHandle: THandle; stdcall;
begin
  Result := FHandle;
end;

procedure TGMRegKey.CloseKey;
begin
  if FHandle <> 0 then begin RegCloseKey(FHandle); FHandle := 0; end;
end;

function TGMRegKey.FormatKeyPath(const Value: TGMString): TGMString;
begin
  Result := GMStrip(Value, cWhiteSpace + '/\');
end;

function TGMRegKey.OpenKey(const ARootKey: HKEY; const AKeyPath: TGMString; const ACheckExists: Boolean; const AAccessMode: DWORD): Boolean;
var AWinApiErrorCode: LongInt;
begin
  CloseKey;
  FRootKey := ARootKey;
  //AKeyPath := FormatKeyPath(AKeyPath);
  if not ACheckExists then
   Result := RegOpenKeyEx(ARootKey, PGMChar(FormatKeyPath(AKeyPath)), 0, AAccessMode, FHandle) = ERROR_SUCCESS
  else
   begin
    AWinApiErrorCode := RegOpenKeyEx(ARootKey, PGMChar(FormatKeyPath(AKeyPath)), 0, AAccessMode, FHandle);
    if (AWinApiErrorCode <> ERROR_SUCCESS) and (AWinApiErrorCode <> ERROR_FILE_NOT_FOUND) and (AWinApiErrorCode <> ERROR_PATH_NOT_FOUND) then
       GMApiCheckObj(GMFormat('RegOpenKeyEx(%s, "%s", Accessmode: %u, 0x%x)', [GMRegKeyAsString(ARootKey), AKeyPath, AAccessMode, AAccessMode]), '', AWinApiErrorCode, False, Self);
    Result := AWinApiErrorCode = ERROR_SUCCESS;
   end;
end;

function TGMRegKey.OpenKey(const ARootKey: IUnknown; const AKeyPath: TGMString; const ACheckExists: Boolean; const AAccessMode: DWORD): Boolean;
var PIKey: IGMGetHandle;
begin
  GMCheckQueryInterface(ARootKey, IGMGetHandle, PIKey, 'TGMRegKey.OpenKey');
  FRootKeyRef := ARootKey;
  Result := OpenKey(PIKey.Handle, AKeyPath, ACheckExists, AAccessMode);
end;

procedure TGMRegKey.ReadValueNames(var Names: TGMStringArray);
var RetCode: LongInt; MaxLen: DWORD; Name: TGMString; i: LongInt;
begin
  SetLength(Names, 0);
  GMApiCheckObj('RegQueryInfoKey', '', RegQueryInfoKey(FHandle, nil, nil, nil, nil, nil, nil, nil, @MaxLen, nil, nil, nil), False, Self);
  if MaxLen = 0 then Exit;
  SetLength(Name, MaxLen);
  i := 0;
  repeat
   MaxLen := Length(Name) + 1;
   RetCode := RegEnumValue(FHandle, i, PGMChar(Name), MaxLen, nil, nil, nil, nil);
   if RetCode = ERROR_SUCCESS then GMAddStrToArray(PGMChar(Name), Names);
   Inc(i);
  until RetCode <> ERROR_SUCCESS;
  GMAPICheckObjEx('RegEnumKeyEx', '', RetCode, False, [ERROR_SUCCESS, ERROR_NO_MORE_ITEMS], Self);
end;

procedure TGMRegKey.ReadSubKeyNames(var Names: TGMStringArray);
var RetCode: LongInt; MaxLen: DWORD; Name: TGMString; i: LongInt;
begin
  SetLength(Names, 0);
  GMApiCheckObj('RegQueryInfoKey', '', RegQueryInfoKey(FHandle, nil, nil, nil, nil, @MaxLen, nil, nil, nil, nil, nil, nil), False, Self);
  if (MaxLen > 0) and (GMWinVersion < wvWinNT) then Dec(MaxLen);
  if MaxLen = 0 then Exit;
  SetLength(Name, MaxLen);
  i := 0;
  repeat
   MaxLen := Length(Name) + 1;
   RetCode := RegEnumKeyEx(FHandle, i, PGMChar(Name), MaxLen, nil, nil, nil, nil);
   if RetCode = ERROR_SUCCESS then GMAddStrToArray(PGMChar(Name), Names);
   Inc(i);
  until RetCode <> ERROR_SUCCESS;
  GMAPICheckObjEx('RegEnumKeyEx', '', RetCode, False, [ERROR_SUCCESS, ERROR_NO_MORE_ITEMS], Self);
  //if RetCode <> ERROR_NO_MORE_ITEMS then raise EAPIException.ObjError(RetCode, Self, 'ReadSubKeyNames');
end;

function TGMRegKey.DeleteKey(const ARootKey: HKEY; const AKeyPath: TGMString; const ARecurse: Boolean): Boolean;
var SubKey: IGMRegKey; SubKeyNames: TGMStringArray; i: LongInt; AWinApiErrorCode: LongInt;
begin
  if ARecurse then
   begin
    Result := OpenKey(ARootKey, AKeyPath);
    try
     if not Result then Exit;
     ReadSubKeyNames(SubKeyNames);
     SubKey := TGMRegKey.Create;
     for i:=Low(SubKeyNames) to High(SubKeyNames) do SubKey.Obj.DeleteKey(ARootKey, GMAppendPath(AKeyPath, SubKeyNames[i]), ARecurse);
    finally CloseKey; end;
   end;

  AWinApiErrorCode := RegDeleteKey(ARootKey, PGMChar(FormatKeyPath(AKeyPath)));
  if (AWinApiErrorCode <> ERROR_SUCCESS) and (AWinApiErrorCode <> ERROR_FILE_NOT_FOUND) and (AWinApiErrorCode <> ERROR_PATH_NOT_FOUND) then
     GMApiCheckObj(GMFormat('RegDeleteKey(%s, Valuename: "%s", Recurse: %s)', [GMRegKeyAsString(ARootKey), AKeyPath, GMBoolToStr(ARecurse)]), '', AWinApiErrorCode, False, Self);
  Result := AWinApiErrorCode = ERROR_SUCCESS;
end;

function TGMRegKey.ValueExists(const AValueName: TGMString): Boolean;
var RegType, len: DWORD;
begin
  Result := RegQueryValueEx(FHandle, PGMChar(AValueName), nil, @RegType, nil, @len) = ERROR_SUCCESS;
end;

function TGMRegKey.DeleteValue(const AValueName: TGMString): Boolean;
var AWinApiErrorCode: DWORD;
begin
  AWinApiErrorCode := RegDeleteValue(FHandle, PGMChar(AValueName));
  if (AWinApiErrorCode <> ERROR_SUCCESS) and (AWinApiErrorCode <> ERROR_FILE_NOT_FOUND) and (AWinApiErrorCode <> ERROR_PATH_NOT_FOUND) then
     GMApiCheckObj(GMFormat('RegDeleteValue(%s, Valuename: "%s")', [GMRegKeyAsString(FHandle), AValueName]), '', AWinApiErrorCode, False, Self);
  Result := AWinApiErrorCode = ERROR_SUCCESS;
end;

procedure TGMRegKey.WriteBinary(const AValueName: TGMString; const Data; const DataSize: DWORD);
begin
  GMApiCheckObj('RegSetValueEx("'+AValueName+'")', '', RegSetValueEx(FHandle, PGMChar(AValueName), 0, REG_BINARY, Pointer(@Data), DataSize), False, Self);
end;

procedure TGMRegKey.WriteString(const AValueName, Value: TGMString);
begin
  GMApiCheckObj(GMFormat('RegSetValueEx(Valuename: "%s", Value: "%s")', [AValueName, Value]), '', RegSetValueEx(FHandle, PGMChar(AValueName), 0, REG_SZ, Pointer(PGMChar(Value)), (Length(Value)+1) * SizeOf(TGMChar)), False, Self);
end;

procedure TGMRegKey.WriteInteger(const AValueName: TGMString; const Value: LongInt);
begin
  GMApiCheckObj(GMFormat('RegSetValueEx(Valuename: "%s", Value: "%d")', [AValueName, Value]), '', RegSetValueEx(FHandle, PGMChar(AValueName), 0, REG_DWORD, Pointer(@Value), SizeOf(Value)), False, Self);
end;

function TGMRegKey.ReadString(const AValueName: TGMString;
 const ADefaultValue: TGMString): TGMString;
var regType, len, dwValue: DWORD; // retCode: LongInt;
begin
  Result := ADefaultValue;
//retCode := RegQueryValueEx(FHandle, PGMChar(AValueName), nil, @regType, nil, @len);
//if retCode <> ERROR_SUCCESS then raise EApiException.ObjError(retCode, [], Self);
  if RegQueryValueEx(FHandle, PGMChar(AValueName), nil, @regType, nil, @len) <> ERROR_SUCCESS then Exit;

  case regType of
   REG_DWORD:
    begin
     len := SizeOf(dwValue);
     if RegQueryValueEx(FHandle, PGMChar(AValueName), nil, @regType, Pointer(@dwValue), @len) = ERROR_SUCCESS then Result := GMIntToStr(dwValue);
    end;

   REG_SZ, REG_EXPAND_SZ:
    if len div SizeOf(TGMChar) <= 1 then Result := '' else
     begin
      SetLength(Result, LongInt(len) div SizeOf(TGMChar)-1);
      if RegQueryValueEx(FHandle, PGMChar(AValueName), nil, @regType, Pointer(PGMChar(Result)), @len) <> ERROR_SUCCESS then Exit;
      if regType = REG_EXPAND_SZ then Result := GMExpandEnvironmentStrings(Result);
     end;

   //else Result := ADefaultValue;
  end;
end;

function TGMRegKey.ReadInteger(const AValueName: TGMString; const ADefaultValue: LongInt): LongInt;
var regType, len: DWORD; StrVal: TGMString;
begin
  Result := ADefaultValue;
  if RegQueryValueEx(FHandle, PGMChar(AValueName), nil, @regType, nil, @len) <> ERROR_SUCCESS then Exit;
  case regType of
   REG_DWORD:
    begin
     len := SizeOf(Result);
     {if not} RegQueryValueEx(FHandle, PGMChar(AValueName), nil, @regType, Pointer(@Result), @len); // = ERROR_SUCCESS then Result := ADefaultValue;
    end;

   REG_SZ, REG_EXPAND_SZ:
    if len <= 1 then Result := ADefaultValue else
     begin
      SetLength(StrVal, LongInt((len div SizeOf(TGMChar))-1));
      if RegQueryValueEx(FHandle, PGMChar(AValueName), nil, @regType, Pointer(PGMChar(StrVal)), @len) <> ERROR_SUCCESS then Exit;
      if regType = REG_EXPAND_SZ then StrVal := GMExpandEnvironmentStrings(StrVal);
      Result := GMStrToInt32(GMMakeDezInt(StrVal, ADefaultValue));
     end;

   //else Result := ADefaultValue;
  end;
end;

function TGMRegKey.ReadBinary(const AValueName: TGMString; const ADestData: Pointer; const ADestDataSizeInBytes: LongInt): DWORD;
var regType: DWORD; retVal: LongInt;
begin
  if RegQueryValueEx(FHandle, PGMChar(AValueName), nil, @regType, nil, @Result) <> ERROR_SUCCESS then begin Result := 0; Exit; end;
  Result := Max(0, Min(ADestDataSizeInBytes, Result));
  if Result > 0 then
   begin
    retVal := RegQueryValueEx(FHandle, PGMChar(AValueName), nil, @regType, ADestData, @Result);
    Assert(retVal = ERROR_SUCCESS);
    //if retVal <> ERROR_SUCCESS then ...
   end;
end;


{ ------------------ }
{ ---- TGMEvent ---- }
{ ------------------ }

constructor TGMEvent.Create(const AManualReset, AInitialSignaled: Boolean; const AName: TGMString; const ASecurityAttr: PSecurityAttributes; const ARefLifetime: Boolean);
var pName: PGMChar;
begin
  FName := AName;
  if Length(AName) > 0 then pName := PGMChar(AName) else pName := nil;
  inherited Create(CreateEvent(ASecurityAttr, AManualReset, AInitialSignaled, pName), ARefLifetime);
  if FHandle = 0 then GMApiCheckObj('CreateEvent', '', GetLastError, FHandle <> 0, Self);
end;

function TGMEvent.WaitFor(const AProcessMessages: Boolean; const Timeout: DWORD): DWORD;
begin
  Result := GMMsgLoopWaitForMultipleObjects(1, @FHandle, AProcessMessages, Timeout);
end;

procedure TGMEvent.Signal;
begin
  GMApiCheckObj('SetEvent', '', GetLastError, SetEvent(Handle), Self);     
end;

procedure TGMEvent.Reset;
begin
  GMApiCheckObj('ResetEvent', '', GetLastError, ResetEvent(Handle), Self);
end;


{ ------------------ }
{ ---- TGMMutex ---- }
{ ------------------ }

constructor TGMMutex.Create(const AName: TGMString;
  const AProcessMessagesWhileWaiting: Boolean; const ATimeout: DWORD;
  const ASecurityAttr: PSecurityAttributes;
  const ARefLifetime: Boolean);
var lastErr: DWORD; pName: PGMChar;
begin
  FName := AName;
  FProcessMessagesWhileWaiting := AProcessMessagesWhileWaiting;
  FTimeout := ATimeout;
  inherited Create(0, ARefLifeTime);

  if Length(AName) > 0 then pName := PGMChar(AName) else pName := nil;
  FHandle := CreateMutex(ASecurityAttr, False, pName);
  if FHandle = 0 then // <- The case ERROR_ALREADY_EXISTS will set the handle!
   begin
    lastErr := GetLastError;
    if lastErr <> ERROR_ACCESS_DENIED then GMApiCheckObj('CreateMutex', '', lastErr, FHandle <> 0, Self) else
     begin
      FHandle := OpenMutex(SYNCHRONIZE, False, PGMChar(AName));
      GMApiCheckObj('OpenMutex', '', GetLastError, FHandle <> 0, Self)
     end;
   end;
end;

procedure TGMMutex.EnterCriticalSection;
begin
  GMMsgLoopWaitForMultipleObjects(1, @FHandle, FProcessMessagesWhileWaiting, FTimeout);
end;

procedure TGMMutex.LeaveCriticalSection;
begin
  GMApiCheckObj('ReleaseMutex', '', GetLastError, ReleaseMutex(Handle), Self);
end;


{ ---------------------- }
{ ---- TGMSemaphore ---- }
{ ---------------------- }

constructor TGMSemaphore.Create(const AMaxShareCount: LongInt;
                                const AName: TGMString;
//                              const AProcessMessagesWhileWaiting: Boolean = False;
                                const ASecurityAttr: PSecurityAttributes;
                                const ARefLifetime: Boolean);
var pName: PGMChar;
begin
  FMaxShareCount := AMaxShareCount;
  FName := AName;

  if Length(AName) > 0 then pName := PGMChar(AName) else pName := nil;
 inherited Create(CreateSemaphore(ASecurityAttr, AMaxShareCount, AMaxShareCount, pName), ARefLifetime);
 if FHandle = 0 then GMApiCheckObj('CreateSemaphore', '', GetLastError, FHandle <> 0, Self);
end;

procedure TGMSemaphore.EnterShared;
begin
  case WaitForSingleObject(FHandle, INFINITE) of
   WAIT_OBJECT_0: ;
   WAIT_TIMEOUT: ;
  end;
end;

procedure TGMSemaphore.LeaveShared;
var lastErr: DWORD;
begin
  if not ReleaseSemaphore(FHandle, 1, nil) then
   begin
    lastErr := GetLastError;
    GMApiCheckObj('ReleaseSemaphore(1)', '', lastErr, False, Self);
   end;
end;

procedure TGMSemaphore.EnterSingleExclusive;
var i: Integer;
begin
  for i:=1 to FMaxShareCount do
   case WaitForSingleObject(FHandle, INFINITE) of
    WAIT_OBJECT_0: ;
    WAIT_TIMEOUT: ;
   end;
end;

procedure TGMSemaphore.LeaveSingleExclusive;
var lastErr: DWORD;
begin
  if not ReleaseSemaphore(FHandle, FMaxShareCount, nil) then
   begin
    lastErr := GetLastError;
    GMApiCheckObj('ReleaseSemaphore(FMaxShareCount)', '', lastErr, False, Self);
   end;
end;


{ -------------------------- }
{ ---- TGMWaitableTimer ---- }
{ -------------------------- }

{$IFDEF JEDIAPI}
constructor TGMWaitableTimer.Create(const ADueTime: Int64;
                                    const AAutoStart: Boolean;
                                    const AName: TGMString;
                                    const AInterval: LONG;
                                    const AExecRoutine: PTIMERAPCROUTINE;
                                    const AExecRoutineArg: Pointer;
                                    const ASecurityAttr: PSecurityAttributes;
                                    const ARefLifetime: Boolean);
var pName: PGMChar;
begin
  FName := AName;
  FDueTime.QuadPart := ADueTime;
  FInterval := AInterval;
  FExecRoutine := AExecRoutine;
  FExecRoutineArg := AExecRoutineArg;
  FIsRunning := False;
  if Length(AName) > 0 then pName := PGMChar(AName) else pName := nil;
  inherited Create(CreateWaitableTimer(ASecurityAttr, False, pName), ARefLifeTime);
  if FHandle = 0 then GMApiCheckObj('CreateWaitableTimer', '', GetLastError, FHandle <> 0, Self);
  if AAutoStart then Start;
end;

destructor TGMWaitableTimer.Destroy;
begin
  try Stop; except end; // <- no exceptions in destructors!
  inherited Destroy;
end;

function TGMWaitableTimer.IsRunning: BOOL;
begin
  Result := FIsRunning;
end;

procedure TGMWaitableTimer.Start;
begin
  FIsRunning := SetWaitableTimer(FHandle, FDueTime, FInterval, FExecRoutine, FExecRoutineArg, False);
  GMApiCheckObj('SetWaitableTimer', '', GetLastError, FIsRunning, Self);
end;

procedure TGMWaitableTimer.Stop;
begin
  if FIsRunning then GMApiCheckObj('CancelWaitableTimer', '', GetLastError, CancelWaitableTimer(FHandle), Self);
end;

function TGMWaitableTimer.GetInterval: UINT;
begin
  Result := UINT(FInterval);
end;

procedure TGMWaitableTimer.SetInterval(const AInterval: UINT);
begin
  FInterval := Max(0, Min(AInterval, High(FInterval)));
end;

procedure TGMWaitableTimer.Restart(const ANewIntervalMS: UINT);
begin
  if (ANewIntervalMS <> cDontChangeTimerInterval) then
   begin
    FDueTime.QuadPart := ANewIntervalMS * -10000;
    FInterval := ANewIntervalMS;
   end;

  Start;
end;
{$ENDIF}


{ ---------------------- }
{ ---- TGMTimerBase ---- }
{ ---------------------- }

destructor TGMTimerBase.Destroy;
begin
  try Stop; except GMTraceException(GMExceptObject); end; // <- no exceptions in destructors!
  inherited Destroy;
end;

function TGMTimerBase.GetHandle: THandle;
begin
  Result := FTimerId;
end;

//function TGMTimerBase.Obj: TGMTimerBase;
//begin
//Result := Self;
//end;

function TGMTimerBase.IsRunning: BOOL;
begin
  Result := FTimerId <> 0;
end;

function TGMTimerBase.GetInterval: UINT;
begin
  Result := FInterval;
end;

procedure TGMTimerBase.SetInterval(const AInterval: UINT);
var wasRunning: Boolean;
begin
  if AInterval <> FInterval then
   begin
    wasRunning := IsRunning;
    Stop;
    FInterval := AInterval;
    if wasRunning then Start;
   end;
end;

procedure TGMTimerBase.Restart(const ANewIntervalMS: UINT);
begin
  Stop;
  if ANewIntervalMS <> cDontChangeTimerInterval then FInterval := ANewIntervalMS;
  Start;
end;


{ ------------------------ }
{ ---- TGMThreadTimer ---- }
{ ------------------------ }

function GMTimerList: TGMObjArrayCollection;
begin
  if gGMTimerList = nil then gGMTimerList := TGMObjArrayCollection.Create(False, True, True, GMCompareByHandle);
  Result := gGMTimerList;
end;

procedure TimerProc(Wnd: HWnd; Msg: UINT; EventId: UINT; TickCount: DWORD); stdcall;
//
// This will be called by another thread from inside windows OS
//
var PIHandle: IGMGetHandle; Timer: TObject;
begin
  try
   PIHandle := TGMHandleObj.Create(EventId, True);
   if GMTimerList.Find(PIHandle, Timer) and (Timer is TGMThreadTimer) then TGMThreadTimer(Timer).DoOnTimer;
  except
   // vfGMExceptionHandler is secured by a critical section
   vfGMHrExceptionHandler(GMExceptObject, cDfltPrntWnd); // GMModalDlgParentWnd
  end;
end;

constructor TGMThreadTimer.Create(const AOnTimerProc: TGMObjNotifyProc; const ACaller: TObject; const AWaitTimeoutMilliSec: UINT; const AAutoStart, ARefLifeTime: Boolean);
begin
  //inherited
  Create(ARefLifeTime);
  FInterval := AWaitTimeoutMilliSec;
  FOnTimerProc := AOnTimerProc;
  FCaller := ACaller;
  if AAutoStart then Start;
end;

procedure TGMThreadTimer.DoOnTimer;
var Caller: TObject;
begin
  if Assigned(OnTimer) then
   try
    if FCaller <> nil then Caller := FCaller else Caller := Self;
    OnTimer(Caller);
   except Stop; raise; end;
end;

procedure TGMThreadTimer.Start;
begin
  if IsRunning then Exit;
  FTimerId := SetTimer(0, 0, FInterval, Addr(TimerProc)); // Using 0 as timer-id will assign a unique id by the system - PtrUint(Self)
  GMAPICheckObj('SetTimer', '', GetLastError, FTimerId <> 0, Self);
  GMTimerList.Add(Self);
end;

procedure TGMThreadTimer.Stop;
begin
  if not IsRunning then Exit;
  GMTimerList.RemoveByKey(Self);
  GMAPICheckObj('KillTimer', '', GetLastError, KillTimer(0, FTimerId), Self);
  FTimerId := 0;
end;


{ --------------------- }
{ ---- TGMWndTimer ---- }
{ --------------------- }

constructor TGMWndTimer.Create(const AWnd: HWnd; const ATimerID: LongInt; const AWaitTimeoutMilliSec: LongInt; const
    AAutoStart, ARefLifeTime: Boolean);
begin
  //inherited
  Create(ARefLifeTime);
  FInterval := AWaitTimeoutMilliSec;
  FWnd := AWnd;
  FClientID := ATimerID;
  if AAutoStart then Start;
end;

function TGMWndTimer.GetHandle: THandle;
begin
  Result := FWnd;
end;

procedure TGMWndTimer.Start;
begin
  if IsRunning then Exit;
  FTimerID := SetTimer(GetHandle, FClientID, FInterval, nil); // <- FTimerID is checked in IsRunning function!
  GMAPICheckObj('SetTimer', '', GetLastError, FTimerID <> 0, Self);
end;

procedure TGMWndTimer.Stop;
begin
  if not IsRunning then Exit;
  GMAPICheckObj('KillTimer', '', GetLastError, KillTimer(GetHandle, FClientID), Self);
  FTimerId := 0;
end;


{ ---------------------- }
{ ---- GMThreadProc ---- }
{ ---------------------- }

//
// The default thread code wrapper that will be executed by a new thread
//

function GMThreadProc(AParam: Pointer): HResult; stdcall;
var thread: TGMThread; allowUI: Boolean; dlgParentWnd: HWND; comInit: IUnknown;
begin
  thread := nil;
  try
   allowUI := False;
   try
    thread := TObject(AParam) as TGMThread;
    allowUI := thread.FAllowExceptDlg;
    if thread.FCoInitFlags <> cDontCoInit then comInit := TGMCOMInitializer.Create(thread.FCoInitFlags);
    try
     Result := thread.Execute;
    finally
     thread.FTerminated := True;
    end;
   except
    // vfGMExceptionHandler is secured by a critical section
    if allowUI then dlgParentWnd := GMModalDlgParentWnd else dlgParentWnd := cNoUIWnd;
    Result := vfGMHrExceptionHandler(GMExceptObject, dlgParentWnd);
   end;
  finally
   if (thread <> nil) and thread.FreeOnTerminate then thread.Free; // <- free may release interface members, do this before CoUninitialize
  end;
end;


{ ------------------- }
{ ---- TGMThread ---- }
{ ------------------- }

constructor TGMThread.Create(const ACoInitFlags: LongInt; // <- must be first parameter to avoid ambiguity with inherited constructor
                             const ACreateSuspended: Boolean;
                             const APriority: LongInt;
                             const AAllowExceptDlg: Boolean;
                             AThreadProc: Pointer;
                             const AStackSize: LongWord;
                             const ASecurityAttr: PSecurityAttributes;
                             const ARefLifeTime: Boolean);
//const cFlags: array [Boolean] of DWORD = (0, CREATE_SUSPENDED);
//const cSuspendCount: array [Boolean] of DWORD = (0, 1);
begin
  IsMultiThread := True;
  FHasBeenRunning := False;
  WaitTimeoutOnDestroy := INFINITE;

  if ACoInitFlags = cCoInitUseDflt then FCoInitFlags := vGMComInitFlags else FCoInitFlags := ACoInitFlags;
  //FSuspendCount := cSuspendCount[ACreateSuspended];
  FSuspendCount := 1;
  FAllowExceptDlg := AAllowExceptDlg;
  if AThreadProc = nil then AThreadProc := @GMThreadProc;

  inherited Create(CreateThread(ASecurityAttr, AStackSize, AThreadProc, Self, CREATE_SUSPENDED, {$IFDEF JEDIAPI}@{$ENDIF}FThreadId), ARefLifeTime); // <- void ambiguity with this constructor!
  GMApiCheckObj('CreateThread', '', GetLastError, FHandle <> 0, Self);

  GMApiCheckObj('SetThreadPriority', '', GetLastError, SetThreadPriority(FHandle, APriority), Self);
  if not ACreateSuspended then Resume;
end;

destructor TGMThread.Destroy;
begin
  FreeOnTerminate := False; // <- avoid re-enter when called from GMThreadProc, if it had been called from there this has no effect.
  if FHandle <> 0 then
   begin
    if not FTerminated and FHasBeenRunning then begin Cancel; Run; WaitFor(False, WaitTimeoutOnDestroy); end;
    // else if FHasBeenRunning then TerminateThread(FHandle, DWORD(E_ABORT));
   end;
  inherited Destroy;
end;

function TGMThread.Obj: TGMThread;
begin
  Result := Self;
end;

procedure TGMThread.Cancel;
begin
  FCanceled := True;
end;

function TGMThread.WaitFor(const AProcessMessages: Boolean; const Timeout: DWORD): HResult;
begin
  if FHandle = 0 then Result := 0 else // <- in case our constructor has been skipped by inherited class
   begin
    GMMsgLoopWaitForMultipleObjects(1, @FHandle, AProcessMessages, Timeout);
    if not GetExitCodeThread(FHandle, LongWord(Result)) then Result := 0;
    //GMApiCheckObj(GetExitCodeThread(H, Result), Self, 'GetExitCodeThread');
   end;
end;

function TGMThread.Suspend: DWORD;
begin
  Result := SuspendThread(FHandle); // <- Returns previous suspend count
  GMApiCheckObj('SuspendThread', '', GetLastError, Result <> $FFFFFFFF, Self);
  Inc(FSuspendCount); // := Result;
end;

function TGMThread.Resume: DWORD;
begin
  if FSuspendCount <= 0 then begin Result := 0; Exit; end;
  Result := ResumeThread(FHandle); // <- Returns previous suspend count
  GMApiCheckObj('ResumeThread', '', GetLastError, Result <> $FFFFFFFF, Self);
  Dec(FSuspendCount); //  := Result;
  FHasBeenRunning := FHasBeenRunning or (FSuspendCount <= 0);
end;

procedure TGMThread.Run;
begin
  while FSuspendCount > 0 do Resume;
end;

function TGMThread.GetPriority: LongInt;
begin
  Result := GetThreadPriority(FHandle);
  GMApiCheckObj('GetThreadPriority', '', GetLastError, Priority <> THREAD_PRIORITY_ERROR_RETURN, Self);
end;

procedure TGMThread.SetPriority(const AValue: LongInt);
begin
  GMApiCheckObj('SetThreadPriority', '', GetLastError, SetThreadPriority(FHandle, AValue), Self);
end;


{ ------------------------- }
{ ---- TGMSilentThread ---- }
{ ------------------------- }

constructor TGMSilentThread.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FCSTermMsgData := TGMCriticalSection.Create;
end;

function TGMSilentThread.Obj: TGMSilentThread;
begin
  Result := Self;
end;

function TGMSilentThread.DfltExceptResult: HResult;
begin
  Result := E_FAIL; // E_UNEXPECTED;
end;

procedure TGMSilentThread.SetTermMsgData(const ATermMsgData: TGMThreadTermMsgDataRec);
begin
  FCSTermMsgData.EnterCriticalSection;
  try
   FTermMsg := ATermMsgData;
  finally
   FCSTermMsgData.LeaveCriticalSection;
  end;
end;

{function TGMSilentThread.GetExceptInfo: IGMExceptionInformation;
begin
  Result := FExceptInfo;
end;}

procedure TGMSilentThread.SendTerminationMsg;
begin
  FCSTermMsgData.EnterCriticalSection;
  try
   if IsWindow(FTermMsg.TargetWnd) and (FTermMsg.Msg <> 0) then with FTermMsg do PostMessage(TargetWnd, Msg, WParam, LParam);
  finally
   FCSTermMsgData.LeaveCriticalSection;
  end;
end;

function TGMSilentThread.Execute: HResult;
begin
  try
   try
    Result := InternalExecute;
   except
    {$IFDEF CALLSTACK}
 // if Length(ExceptCallStack) = 0 then GMCaptureCurrentThreadCallStack(ExceptCallStack);
    if ExceptCallStack = nil then ExceptCallStack := GMGetThreadCallStackData(ThreadID, True);
    {$ENDIF}
    GMTraceException(GMExceptObject);
    Result := GMGetObjHRCode(GMExceptObject, DfltExceptResult);
    //if not GMIsclassByName(GMExceptObject, EAbort) and GMAskBoolean(GMExceptObject, Ord(bevPresentToUI), True) then
    FExceptInfo := TGMExceptionInformation.CreateFromObj(GMExceptObject, True); // else GMTraceException(GMExceptObject);
   end;
  finally
    //
    // Message must be send after FExceptInfo has been assigned!
    //
   SendTerminationMsg;
  end;
end;


{ ----------------------- }
{ ---- TGMTempCursor ---- }
{ ----------------------- }

constructor TGMTempCursor.Create(const ANewCursor: TGMCursor; const APMemberVar: PHandle; const ARefLifeTime: Boolean);
var cursor: THandle;
begin
  inherited Create(ARefLifeTime);
  cursor := LoadCursor(0, cWinCursorRes[ANewCursor]);
  FOldCursor := SetCursor(cursor);
  FPMemberVar := APMemberVar;
  if FPMemberVar <> nil then
   begin
    FOldMemeberVarValue := FPMemberVar^;
    FPMemberVar^ := cursor;
   end;
end;

destructor TGMTempCursor.Destroy;
begin
  if FOldCursor <> 0 then SetCursor(FOldCursor);
  if FPMemberVar <> nil then FPMemberVar^ := FOldMemeberVarValue;
  inherited Destroy;
end;


{ ---------------------- }
{ ---- API Checking ---- }
{ ---------------------- }

function GMHrCheckObjParams(const HRCode: HResult;
                            const Params: array of PGMChar;
                            const Obj: TObject;
                            const ARoutineName: TGMString;
                            const AMsgPostfix: TGMString;
                            const Strict: Boolean;
                            const AHelpCtx: LongInt): HResult;
begin
  Result := HRCode;
  if not GMHrSucceeded(HRCode) or (Strict and (HRCode <> S_OK)) then
   if (HRCode = E_ABORT) or (HRCode = GMHResultFromWin32(ERROR_CANCELLED)) then
    raise EGMAbort.Create(RStrOperationCanceled)
   else
    raise EGMHrException.ObjError(HRCode, Params, Obj, ARoutineName, AMsgPostfix, AHelpCtx);

// case HRCode of
//  E_ABORT: raise EGMAbort.Create(RStrOperationCanceled);
//  else raise EGMHrException.ObjError(HRCode, Params, Obj, ARoutineName, AMsgPostfix, AHelpCtx);
// end;
end;

function GMHrCheckObj(const HRCode: HResult;
                      const Obj: TObject;
                      const ARoutineName: TGMString;
                      const AMsgPostfix: TGMString;
                      const Strict: Boolean;
                      const AHelpCtx: LongInt): HResult;
begin
  Result := GMHrCheckObjParams(HRCode, [], Obj, ARoutineName, AMsgPostfix, Strict, AHelpCtx);
end;

procedure GMHrTraceObjParams(const HRCode: HResult;
                             const Params: array of PGMChar;
                             const Obj: TObject;
                             const ARoutineName: TGMString;
                             const AMsgPostfix: TGMString;
                             const Strict: Boolean;
                             const AHelpCtx: LongInt);
var PIExceptInfo: IGMExceptionInformation;
begin
  if not GMHrSucceeded(HRCode) or (Strict and (HRCode <> S_OK)) then
   begin
    PIExceptInfo := TGMExceptionInformation.Create(True, False, AMsgPostfix + GMSysErrorMsg(HRCode, Params),
                                                   EGMHrException.ClassName, ExceptAddr, GMGetObjDisplayName(Obj),
                                                   GMObjClassName(Obj), ARoutineName, svWarning, AHelpCtx, HRCode);
    GMTrace(GMBuildExceptionMsg(PIExceptInfo, True), tpWarning);
   end;
end;

procedure GMHrCheckIntfParams(const HRCode: HResult; const AMsgFmtParams: array of PGMChar; const Intf: IUnknown; const
    ARoutineName, AMsgPostfix: TGMString; const Strict: Boolean; const AHelpCtx: LongInt);
begin
  if not GMHrSucceeded(HRCode) or (Strict and (HRCode <> S_OK)) then
   if (HRCode = E_ABORT) or (HRCode = GMHResultFromWin32(ERROR_CANCELLED)) then
    raise EGMAbort.Create(RStrOperationCanceled)
   else
    raise EGMHrException.IntfError(HRCode, AMsgFmtParams, Intf, ARoutineName, AMsgPostfix, AHelpCtx);
end;

procedure GMHrCheckIntf(const HRCode: HResult;
                        const Intf: IUnknown;
                        const ARoutineName: TGMString;
                        const AMsgPostfix: TGMString;
                        const Strict: Boolean;
                        const AHelpCtx: LongInt);
begin
  GMHrCheckIntfParams(HRCode, [], Intf, ARoutineName, AMsgPostfix, Strict, AHelpCtx);
end;

procedure GMAPICheckObjParams(const ARoutineName, AMsgPostfix: TGMString; const AWinApiErrorCode: DWORD; const AWinApiRetVal: BOOL;
    const Params: array of PGMChar; const Obj: TObject; const AHelpCtx: LongInt);
begin
  if not AWinApiRetVal and (AWinApiErrorCode <> NO_ERROR) then
     raise EAPIException.ObjError(AWinApiErrorCode, Params, Obj, ARoutineName, AMsgPostfix, AHelpCtx);
end;

procedure GMAPICheckObj(const ARoutineName, AMsgPostfix: TGMString; const AWinApiErrorCode: DWORD; const AWinApiRetVal: BOOL;
    const AObj: TObject; const AHelpCtx: LongInt);
begin
  if not AWinApiRetVal and (AWinApiErrorCode <> NO_ERROR) then
     raise EAPIException.ObjError(AWinApiErrorCode, [], AObj, ARoutineName, AMsgPostfix, AHelpCtx);
end;

procedure GMAPICheckObjEx(const ARoutineName, AMsgPostfix: TGMString; const AWinApiErrorCode: DWORD; const AWinApiRetVal: BOOL;
    const SuccessCodes: array of PtrInt; const Obj: TObject; const AHelpCtx: LongInt);
begin
  if AWinApiRetVal then Exit;
  if GMIsOneOfCodes(PtrInt(AWinApiErrorCode), SuccessCodes) then Exit;
  raise EAPIException.ObjError(AWinApiErrorCode, [], Obj, ARoutineName, AMsgPostfix, AHelpCtx);
end;


type
  PRaiseFrameRec = ^TRaiseFrameRec;
  TRaiseFrameRec = packed record
    NextRaise: PRaiseFrameRec;
    ExceptAddr: Pointer;
    ExceptObject: TObject;
    ExceptionRecord: PExceptionRecord;
  end;

function GMExceptObject: TObject;
begin
  if RaiseList = nil then Result := nil else
    {$IFDEF FPC}
    Result := RaiseList^.FObject;
    {$ELSE}
    Result := PRaiseFrameRec(RaiseList)^.ExceptObject;
    {$ENDIF}
end;

function GMExceptAddr: Pointer;
begin
  if RaiseList <> nil then
    Result := PRaiseFrameRec(RaiseList)^.ExceptAddr else
    Result := nil;
end;


function OLEFormatEtc(const cfFormat: TClipFormat; const ptd: PDVTargetDevice; const dwAspect: LongInt; const lindex: LongInt; const tymed: LongInt): TFormatEtc;
begin
  Result.cfFormat := cfFormat;
  Result.ptd := ptd;
  Result.dwAspect := dwAspect;
  Result.lindex := lindex;
  Result.tymed := tymed;
end;

function OLEStgMedium(const tymed: LongInt; const handle: THandle; const unkForRelease: Pointer): TStgMedium; overload;
begin
  Result.tymed := tymed;
  Result.hGlobal := handle;
  Result.unkForRelease := unkForRelease;
end;

function OLEStgMedium(const tymed: LongInt; const pUnknown: Pointer; const unkForRelease: Pointer): TStgMedium; overload;
begin
  Result.tymed := tymed;
  Result.stm := pUnknown;
  Result.unkForRelease := unkForRelease;
end;

function OLEStgMedium(const tymed: LongInt; const lpszFileName: POleStr; const unkForRelease: Pointer): TStgMedium; overload;
begin
  Result.tymed := tymed;
  Result.lpszFileName := lpszFileName;
  Result.unkForRelease := unkForRelease;
end;

//procedure GMFreeMetafileHandle(const HMetaFile: HGlobal);
//var P: Pointer;
//begin
//if HMetaFile <> 0 then
// begin
//  P := GlobalLock(HMetaFile);
//  try
//   if P <> nil then DeleteMetaFile(PMetaFilePict(P)^.hMF);
//  finally
//   GlobalUnlock(HMetaFile);
//  end;
//  GlobalFree(HMetaFile);
// end;
//end;

function GMRegKeyAsString(const ARootKey: HKEY): TGMString;
begin
  case ARootKey of
   HKEY_CLASSES_ROOT:      Result := 'HKEY_CLASSES_ROOT';
   HKEY_CURRENT_USER:      Result := 'HKEY_CURRENT_USER (' + GMThisUserName + ')';
   HKEY_LOCAL_MACHINE:     Result := 'HKEY_LOCAL_MACHINE';
   HKEY_USERS:             Result := 'HKEY_USERS';
   HKEY_PERFORMANCE_DATA:  Result := 'HKEY_PERFORMANCE_DATA';
   HKEY_CURRENT_CONFIG:    Result := 'HKEY_CURRENT_CONFIG';
   HKEY_DYN_DATA:          Result := 'HKEY_DYN_DATA';
   else Result := GMFormat('HKEY(Dez: %u, Hex: 0x%x)', [ARootKey, ARootKey]);
  end;
end;


{ -------------------------- }
{ ---- Compare Routines ---- }
{ -------------------------- }

function GMCompareNames(const AName1, AName2: TGMString; const ACmpareFlags: DWORD; ALocale: LCID): TGMCompareResult;
begin
  if ALocale = 0 then ALocale := LOCALE_USER_DEFAULT;
  Result := TGMCompareResult(CompareString(ALocale, ACmpareFlags, PGMChar(AName1), Length(AName1), PGMChar(AName2), Length(AName2)) - 1);
end;

function GMCompareByInstance(const ItemA, ItemB: IUnknown): TGMCompareResult;
begin
  if PtrUInt(ItemA) > PtrUInt(ItemB) then Result := crAGreaterThanB else
  if PtrUInt(ItemA) = PtrUInt(ItemB) then Result := crAEqualToB else
  Result := crALessThanB;
end;

function GMCompareByLeft(const ItemA, ItemB: IUnknown): TGMCompareResult;
const cStrRoutineName = 'GMCompareByLeft';
var leftA, leftB: IGMGetLeft;
begin
  GMCheckQueryInterface(ItemA, IGMGetLeft, leftA, cStrRoutineName);
  GMCheckQueryInterface(ItemB, IGMGetLeft, leftB, cStrRoutineName);

  if leftA.Left > leftB.Left then Result := crAGreaterThanB else
  if leftA.Left = leftB.Left then Result := crAEqualToB else
  Result := crALessThanB;
end;

function GMCompareByName(const ItemA, ItemB: IUnknown): TGMCompareResult;
const cStrRoutineName = 'GMCompareByName';
var nameA, nameB: IGMGetName;
begin
  GMCheckQueryInterface(ItemA, IGMGetName, nameA, cStrRoutineName);
  GMCheckQueryInterface(ItemB, IGMGetName, nameB, cStrRoutineName);
  Result := GMCompareNames(nameA.Name, nameB.Name);
end;

function GMCompareByString(const ItemA, ItemB: IUnknown): TGMCompareResult;
const cStrRoutineName = 'GMCompareByName';
var nameA, nameB: IGMGetName; // cmp: LongInt;
begin
  GMCheckQueryInterface(ItemA, IGMGetName, nameA, cStrRoutineName);
  GMCheckQueryInterface(ItemB, IGMGetName, nameB, cStrRoutineName);
  Result := GMCompareNames(nameA.Name, nameB.Name, 0);
end;

function GMCompareByNameDigitsAsNumbers(const ItemA, ItemB: IUnknown): TGMCompareResult;
const cStrRoutineName = 'GMCompareByNameDigitsAsNumbers';
var nameA, nameB: IGMGetName; caseFlags: DWORD;
begin
  caseFlags := NORM_IGNORECASE;
  if gDigitAsNumberSortSupported then caseFlags := caseFlags or SORT_DIGITSASNUMBERS;

  GMCheckQueryInterface(ItemA, IGMGetName, nameA, cStrRoutineName);
  GMCheckQueryInterface(ItemB, IGMGetName, nameB, cStrRoutineName);
  Result := GMCompareNames(nameA.Name, nameB.Name, caseFlags);
end;

function GMCompareByFileName(const ItemA, ItemB: IUnknown): TGMCompareResult;
const cStrRoutineName = 'GMCompareByFileName';
var nameA, nameB: IGMGetFileName;
begin
  GMCheckQueryInterface(ItemA, IGMGetFileName, nameA, cStrRoutineName);
  GMCheckQueryInterface(ItemB, IGMGetFileName, nameB, cStrRoutineName);
  Result := GMCompareNames(nameA.FileName, nameB.FileName);
end;

function GMCompareByPosition(const ItemA, ItemB: IUnknown): TGMCompareResult;
const cStrRoutineName = 'GMCompareByPosition';
var positionA, positionB: IGMGetPosition;
begin
  GMCheckQueryInterface(ItemA, IGMGetPosition, positionA, cStrRoutineName);
  GMCheckQueryInterface(ItemB, IGMGetPosition, positionB, cStrRoutineName);
  if positionA.Position > positionB.Position then Result := crAGreaterThanB else
  if positionA.Position = positionB.Position then Result := crAEqualToB else
  Result := crALessThanB;
end;

//function GMCompareByKeyValue(const ItemA, ItemB: IUnknown): TGMCompareResult;
//const cStrRoutineName = 'GMCompareByKeyValue';
//var keyValueA, keyValueB: IGMGetKeyValue;
//begin
//  GMCheckQueryInterface(ItemA, IGMGetKeyValue, keyValueA, cStrRoutineName);
//  GMCheckQueryInterface(ItemB, IGMGetKeyValue, keyValueB, cStrRoutineName);
//  if keyValueA.KeyValue > keyValueB.KeyValue then Result := crAGreaterThanB else
//  if keyValueA.KeyValue = keyValueB.KeyValue then Result := crAEqualToB else
//  Result := crALessThanB;
//end;

function GMCompareByGuid(const ItemA, ItemB: IUnknown): TGMCompareResult;
const cStrRoutineName = 'GMCompareByGuid';
var guidA, guidB: IGMGetGUID;
begin
  GMCheckQueryInterface(ItemA, IGMGetGUID, guidA, cStrRoutineName);
  GMCheckQueryInterface(ItemB, IGMGetGUID, guidB, cStrRoutineName);
  Result := GMCompareGuids(guidA.Guid, guidB.Guid);
end;

function GMCompareByHandle(const ItemA, ItemB: IUnknown): TGMCompareResult;
const cStrRoutineName = 'GMCompareByHandle';
var handleA, handleB: IGMGetHandle;
begin
  GMCheckQueryInterface(ItemA, IGMGetHandle, handleA, cStrRoutineName);
  GMCheckQueryInterface(ItemB, IGMGetHandle, handleB, cStrRoutineName);
  if handleA.Handle > handleB.Handle then Result := crAGreaterThanB else
  if handleA.Handle = handleB.Handle then Result := crAEqualToB else
  Result := crALessThanB;
end;

function GMCompareFileEntryByName(const ItemA, ItemB: IUnknown): TGMCompareResult;
const cStrRoutineName = 'GMCompareFileEntryByName';
var entryA, entryB: IGMFileProperties;
begin
  GMCheckQueryInterface(ItemA, IGMFileProperties, entryA, cStrRoutineName);
  GMCheckQueryInterface(ItemB, IGMFileProperties, entryB, cStrRoutineName);
  Result := GMCompareNames(entryA.FileName, entryB.FileName);
end;

function GMCompareFileEntryBySize(const ItemA, ItemB: IUnknown): TGMCompareResult;
const cStrRoutineName = 'GMCompareFileEntryBySize';
var entryA, entryB: IGMFileProperties;
begin
  GMCheckQueryInterface(ItemA, IGMFileProperties, entryA, cStrRoutineName);
  GMCheckQueryInterface(ItemB, IGMFileProperties, entryB, cStrRoutineName);
  if entryA.SizeInBytes > entryB.SizeInBytes then Result := crAGreaterThanB else
  if entryA.SizeInBytes = entryB.SizeInBytes then Result := crAEqualToB else
  Result := crALessThanB;
end;

function GMCompareFileEntryByLastMod(const ItemA, ItemB: IUnknown): TGMCompareResult;
const cStrRoutineName = 'GMCompareFileEntryByLastMod';
var entryA, entryB: IGMFileProperties;
begin
  GMCheckQueryInterface(ItemA, IGMFileProperties, entryA, cStrRoutineName);
  GMCheckQueryInterface(ItemB, IGMFileProperties, entryB, cStrRoutineName);
  if entryA.LastWriteTime > entryB.LastWriteTime then Result := crAGreaterThanB else
  if entryA.LastWriteTime = entryB.LastWriteTime then Result := crAEqualToB else
  Result := crALessThanB;
end;
                                                                                                       
procedure GMBreakLines(const ASrcText: TGMString; const AAddLineFunc: TGMAddLineFunc; const AData: Pointer; const AddEmptyLines: Boolean = False);
var pCh, pChStart: PGMChar; line: TGMString; endsWithLineBreak: Boolean;
begin
  if not Assigned(AAddLineFunc) then Exit;
  pCh := PGMChar(ASrcText);
  if pCh <> nil then
   while pCh^ <> #0 do
    begin
     pChStart := pCh;
     while True do
      case pCh^ of
       #0, #10, #13: Break;
       else Inc(pCh);
      end;

     SetString(line, pChStart, pCh - pChStart);
     endsWithLineBreak := False;
     if pCh^ = #13 then begin Inc(pCh); endsWithLineBreak := True; end;
     if pCh^ = #10 then begin Inc(pCh); endsWithLineBreak := True; end;
     if (Length(line) > 0) or AddEmptyLines then if not AAddLineFunc(line, not endsWithLineBreak, AData) then Break;
    end;
end;

function GMAddLineToStrArray(const ALine: TGMString; const AEndsWithLineBreak: Boolean; const AData: Pointer): Boolean;
begin
  if AData = nil then Result := False else begin GMAddStrToArray(ALine, PGMStringArray(AData)^, True); Result := True; end;
end;

procedure GMBreakLinesToStrArray(const ASrcText: TGMString; var ADstLines: TGMStringArray; const AddEmptyLines: Boolean = False);
begin
  SetLength(ADstLines, 0);
  GMBreakLines(ASrcText, GMAddLineToStrArray, @ADstLines, AddEmptyLines);
end;

procedure GMSplitWordsToStrArray(const AValue, ASeparators: TGMString; const AAllowDuplicates: Boolean; var ADestStrings: TGMStringArray);
var chPos: PtrInt; token: TGMString;
begin
  SetLength(ADestStrings, 0); chPos := 1;
  repeat
   token := GMNextWord(chPos, AValue, ASeparators);
   if (Length(token) > 0) and (AAllowDuplicates or not GMIsOneOfStrings(token, ADestStrings)) then GMAddStrToArray(token, ADestStrings);
  until Length(token) <= 0;
end;


{ --------------------- }
{ ---- Scroll Data ---- }
{ --------------------- }

function GMScrollData(const fMask: UINT; const nMin: LongInt; const nMax: LongInt; const nPage: UINT; const nPos: LongInt; const nTrackPos: LongInt): TScrollInfo;
begin
  Result.cbSize := SizeOf(Result);
  Result.fMask := fMask;
  Result.nMin := nMin;
  Result.nMax := nMax;
  Result.nPage := nPage;
  Result.nPos := nPos;
  Result.nTrackPos := nTrackPos;
end;

function GMScrollDataFromWnd(const Handle: HWnd; const CtlKind, Mask: LongWord): TScrollInfo;
begin
  //FillChar(Result, SizeOf(Result), 0);
  Result := Default(TScrollInfo);
  Result.cbSize := SizeOf(Result);
  Result.fMask := Mask;
  GetScrollInfo(Handle, CtlKind, Result); // <- leaves Result untouched when it fails
end;

function GMWheelScrollDelta(const PageSize: LongInt; const Direction: LongInt): LongInt;
const cSign: array [Boolean] of LongInt = (1, -1); cPercent: array [Boolean] of Double = (0.13, 0.67);
begin
  Result := Round(PageSize * cSign[Direction < 0] * cPercent[GetKeyState(VK_CONTROL) < 0]);
end;

function GMCalcScrollPos(const AScrollCode: LongInt; const AScrollData: TScrollInfo): LongInt;
//var AScrollData: TScrollInfo;
  function LineScrollAmmount: LongInt;
  begin
    Result := Max(1, Round(AScrollData.nPage * 0.06));
  end;

  function PageScrollAmmount: LongInt;
  begin
    Result := Max(1, Round(AScrollData.nPage * 0.95));
  end;
begin
  //if AWnd = 0 then begin Result := 0; Exit; end;
  Result := AScrollData.nPos;
  case AScrollCode of
   SB_TOP:         Result := AScrollData.nMin;
   SB_BOTTOM:      Result := AScrollData.nMax;
   SB_LINEDOWN:    Inc(Result, LineScrollAmmount);
   SB_LINEUP:      Dec(Result, LineScrollAmmount);
   SB_PAGEDOWN:    Inc(Result, PageScrollAmmount);
   SB_PAGEUP:      Dec(Result, PageScrollAmmount);
   SB_THUMBPOSITION, SB_THUMBTRACK: Result := AScrollData.nTrackPos; // Result := GMScrollDataFromWnd(Handle, SB_CTL, SIF_TRACKPOS).nTrackPos;
   //SB_ENDSCROLL:
  end;
  Result := GMBoundedInt(Result, AScrollData.nMin, AScrollData.nMax - Max(LongInt(AScrollData.nPage)-1, 0));
end;


{ ----------------- }
{ ---- Tracing ---- }
{ ----------------- }

function GMDfltDoTracing: Boolean;
begin
  {$IFDEF DEBUG}Result := True;{$ELSE}Result := False;{$ENDIF}
end;

procedure GMTrace(const AText: TGMString; const APrefix: TGMTracePrefix);
begin
  vfGMTrace(AText, cGMTracePrefixes[APrefix]);
end;

procedure GMDfltTraceLine(const ALine: TGMString);
begin
  OutputDebugString(PGMChar(ALine));
end;

function GMPrefixedTrace(const ALine: TGMString; const ALastLine: Boolean; const AData: Pointer): Boolean;
var prefix: TGMString;
begin
  Result := True;
  if (AData <> nil) and (PGMChar(AData)^ <> #0) then
   begin
    prefix := PGMChar(AData);
    vfGMTraceLine('[' + prefix + '] ' + ALine);
   end
  else
   vfGMTraceLine(ALine);
end;

//procedure GMIterateLines(const AText: TGMString; const ALineProc: TProcessLineProc; const AData: Pointer);
//var a,b : LongInt;
//procedure TellLine;
//var s: TGMString;
//begin
//  s := GMStripRight(Copy(AText, a, b-a), cNewLine);
//  if Length(s) > 0 then ALineProc(s, AData);
//end;
//begin
//if not Assigned(ALineProc) then Exit;
//a:=1; b:=1;
//while b <= Length(AText) do
// if not GMIsDelimiter(cNewLine, AText, b) then Inc(b) else
//  begin
//   TellLine;
//   while GMIsDelimiter(cNewLine, AText, b) do Inc(b);
//   a:=b;
//  end;
//TellLine;
//end;

procedure GMDfltTrace(const AText: TGMString; const APrefix: TGMString);
//var syncLock: IUnknown; // a,b : LongInt;
begin
  //syncLock := TGMCriticalSectionLock.Create(gCStraceText); // <- just to keep output separated, not technically neccessary (working only on the stack)
//if gCStraceText <> nil then gCStraceText.EnterCriticalSection;
//try
   if not vfGMDoTracing then Exit; // <- better do it inside critical section, maybe it needs some initialization
   GMBreakLines(AText, GMPrefixedTrace, PGMChar(APrefix));
// GMIterateLines(AText, GMPrefixedTrace, PGMChar(APrefix));
//finally
// if gCStraceText <> nil then gCStraceText.LeaveCriticalSection;
//end;
end;

procedure GMTraceMethod(const AObj: TObject; const AMethodName: TGMString; const AText: TGMString = '');
begin
  if not vfGMDoTracing then Exit;
  if AText <> '' then
   GMTrace(GMFormat('%s[%p].%s: %s', [GMObjClassName(AObj), Pointer(AObj), AMethodName, AText]), tpCall)
  else
   GMTrace(GMFormat('%s[%p].%s', [GMObjClassName(AObj), Pointer(AObj), AMethodName]), tpCall);
end;

procedure GMTraceException(const AException: TObject; const ASingleLine: Boolean);
var ExceptInfo: IGMExceptionInformation; Msg: TGMString;
begin
  try
   //if (AException = nil) or not (AException is Exception) or not vfGMDoTracing then Exit;
   //with AException as Exception do if AsSingleLine then Msg := GMMakeSingleLine(Message) else Msg := Message;
   //vfGMTrace(GMFormat('%s: %s', [AException.ClassName, Msg]), tpException);
   if not vfGMDoTracing then Exit;
   ExceptInfo := TGMExceptionInformation.CreateFromObj(AException, True);
   Msg := GMBuildExceptionMsg(ExceptInfo, True);
   if ASingleLine then Msg := GMMakeSingleLine(Msg);
   GMTrace(Msg, tpException);
  except end;
end;

procedure GMTraceAllInterfaces(const AIntf: IUnknown; const AName: TGMString);
var RegKey: IGMRegKey; SubDirNames: TGMStringArray; i: LongInt; PIUnk: IUnknown;
begin
  if AIntf = nil then Exit;
  RegKey := TGMRegKey.Create;
  if not RegKey.Obj.OpenKey(HKEY_CLASSES_ROOT, '\Interface') then Exit;
  RegKey.Obj.ReadSubKeyNames(SubDirNames);
  for i:=Low(SubDirNames) to High(SubDirNames) do
   try
    //if Registry.OpenKey('\Interface\' + SubDirNames[i], False) then IntfName := Registry.ReadString('') else IntfName := '';
    if GMQueryInterface(AIntf, GMStringToGuid(SubDirNames[i]), PIUnk) then
     GMTrace(GMFormat('"%s" Supports Interface: %s %s', [AName, GMIntfIIDName(SubDirNames[i]), SubDirNames[i]]), tpInterface);
   except end;
end;


{ --------------------------------- }
{ ---- Complex Data Load Store ---- }
{ --------------------------------- }

function GMRectValName(const ARectName, AValueName: TGMString): TGMString;
begin
  Result := GMStringJoin(ARectName, ' ', AValueName); //GMStrip(GMFormat('%s %s', [ARectName, AValueName]), cWhiteSpace);
end;

{function GMReadValidRect(const Source: IGMValueStorage; const RectName: TGMString; var Value: TRect; const DefaultValue: LongInt): Boolean;
begin
  if Source <> nil then
   begin
    Value.Left := Source.ReadInteger(GMRectValName(RectName, cStrLeft), DefaultValue);
    Value.Top := Source.ReadInteger(GMRectValName(RectName, cStrTop), DefaultValue);
    Value.Right := Source.ReadInteger(GMRectValName(RectName, cStrRight), DefaultValue);
    Value.Bottom := Source.ReadInteger(GMRectValName(RectName, cStrBottom), DefaultValue);
   end;
  Result := (Value.Left <> DefaultValue) and (Value.Top <> DefaultValue);
end;}

function GMReadRect(const ASource: IGMValueStorage; const ARectName: TGMString; const ADefaultRect: TRect): TRect;
begin
  Result := ADefaultRect;
  if ASource = nil then Exit;
  Result.Left := ASource.ReadInteger(GMRectValName(ARectName, cStrLeft), ADefaultRect.Left);
  Result.Top := ASource.ReadInteger(GMRectValName(ARectName, cStrTop), ADefaultRect.Top);
  Result.Right := ASource.ReadInteger(GMRectValName(ARectName, cStrRight), ADefaultRect.Right);
  Result.Bottom := ASource.ReadInteger(GMRectValName(ARectName, cStrBottom), ADefaultRect.Bottom);
end;

procedure GMWriteRect(const ADest: IGMValueStorage; const ARectName: TGMString; const AValue: TRect; const ADefaultValue: LongInt);
begin
  if ADest = nil then Exit;
  GMStoreInteger(ADest, GMRectValName(ARectName, cStrLeft), AValue.Left, ADefaultValue);
  GMStoreInteger(ADest, GMRectValName(ARectName, cStrTop), AValue.Top, ADefaultValue);
  GMStoreInteger(ADest, GMRectValName(ARectName, cStrRight), AValue.Right, ADefaultValue);
  GMStoreInteger(ADest, GMRectValName(ARectName, cStrBottom), AValue.Bottom, ADefaultValue);
end;

{
  cStrFontCharset = 'charset';
  cStrFontColor = 'Color';
  cStrFontHeight = 'Height';
  cStrFontName = 'Name';
  cStrFontPitch = 'Pitch';
  cStrFontSize = 'Size';
  cStrFontStyle = 'Style';

function GMFontStyleToInt(const Value: TFontStyles): LongInt;
var i: TFontStyle;
begin
  Result := 0;
  for i:=Low(i) to High(i) do if i in Value then Result := Result or (1 shl Ord(i));
end;

function GMFontStyleFromInt(const Value: LongInt): TFontStyles;
var i: TFontStyle;
begin
  Result := [];
  for i:=Low(i) to High(i) do if Value and (1 shl Ord(i)) <> 0 then Include(Result, i);
end;

procedure GMReadFont(const Source: IGMValueStorage; const FontName: TGMString; const Font: TFont);
begin
  if Source = nil then Exit;
  Font.Charset := TFontCharset(Source.ReadInteger(GMFormat('%s %s', [FontName, cStrFontCharset]), cDfltFontCharset));
  Font.Color := TColor(Source.ReadInteger(GMFormat('%s %s', [FontName, cStrFontColor]), cDfltFontColor));
  Font.Height := Source.ReadInteger(GMFormat('%s %s', [FontName, cStrFontHeight]), cDfltFontHeight);
  Font.Name := Source.ReadString(GMFormat('%s %s', [FontName, cStrFontName]), cDfltFontName);
  Font.Pitch := TFontPitch(Source.ReadInteger(GMFormat('%s %s', [FontName, cStrFontPitch]), cDfltFontPitch));
  Font.Size := Source.ReadInteger(GMFormat('%s %s', [FontName, cStrFontSize]), cDfltFontSize);
  Font.Style := GMFontStyleFromInt(Source.ReadInteger(GMFormat('%s %s', [FontName, cStrFontStyle]), GMFontStyleToInt(cDfltFontStyle)));
end;

procedure GMWriteFont(const Dest: IGMValueStorage; const FontName: TGMString; const Font: TFont);
begin
  if Dest = nil then Exit;
  GMStoreInteger(Dest, GMFormat('%s %s', [FontName, cStrFontCharset]), LongInt(Font.Charset), cDfltFontCharset);
  GMStoreInteger(Dest, GMFormat('%s %s', [FontName, cStrFontColor]), Font.Color, cDfltFontColor);
  GMStoreInteger(Dest, GMFormat('%s %s', [FontName, cStrFontHeight]), Font.Height, cDfltFontHeight);
  GMStoreString(Dest, GMFormat('%s %s', [FontName, cStrFontName]), Font.Name, cDfltFontName);
  GMStoreInteger(Dest, GMFormat('%s %s', [FontName, cStrFontPitch]), LongInt(Font.Pitch), cDfltFontPitch);
  GMStoreInteger(Dest, GMFormat('%s %s', [FontName, cStrFontSize]), Font.Size, cDfltFontSize);
  GMStoreInteger(Dest, GMFormat('%s %s', [FontName, cStrFontStyle]), GMFontStyleToInt(Font.Style), GMFontStyleToInt(cDfltFontStyle));
end;}


{ ---------------------------------- }
{ ---- Core TGMString functions ---- }
{ ---------------------------------- }

function GMStrLScanA(AStr: PAnsiChar; ACh: AnsiChar; AMaxLen: PtrUInt): PAnsiChar;
// 64-Bit: RCX = AStr, RDX = ACh, R8 = AMaxLen
// 32-Bit: On enter EAX contains AStr, EDX contains ACh and ECX AMaxLen.
// On Exit EAX contains Result pointer (may be nil).
asm
{$IFDEF CPU64}
        PUSH    RDI
        CMP     AMaxLen, 0
        JG      @@1
        MOV     RAX, 0
        JMP     @@3    // <- exit returning nil if AMaxLen <= 0

@@1:    CMP     AStr, 0
        JNE     @@2
        MOV     RAX, 0
        JMP     @@3    // <- exit returning nil if AStr = nil

@@2:    MOV     RDI, AStr     // RCX
        MOV     RCX, AMaxLen
        MOV     AL, ACh
        REPNE   SCASB
        MOV     RAX, 0
        JNE     @@3
        MOV     RAX, RDI
        DEC     RAX
@@3:    POP     RDI
{$ELSE}
        PUSH    EDI
        CMP     ECX, 0 // AMaxLen
        JG      @@1
        MOV     EAX, 0
        JMP     @@3    // <- exit returning nil if AMaxLen <= 0

@@1:    CMP     AStr, 0
        JNE     @@2
        MOV     EAX, 0
        JMP     @@3    // <- exit returning nil if AStr = nil

@@2:    MOV     EDI, AStr // prepare SCASx operation
        MOV     AL, ACh
        REPNE   SCASB  // <- Scan while unequal
        MOV     EAX, 0
        JNE     @@3
        MOV     EAX, EDI
        DEC     EAX
@@3:    POP     EDI
{$ENDIF}
end;

function GMStrLScanW(AStr: PWideChar; ACh: WideChar; AMaxLen: PtrUInt): PWideChar;
// 64-Bit: RCX = AStr, RDX = ACh, R8 = AMaxLen
// 32-Bit: On enter EAX contains AStr, EDX contains ACh and ECX AMaxLen.
// On Exit EAX contains Result pointer (may be nil).
asm
{$IFDEF CPU64}
        PUSH    RDI
        CMP     AMaxLen, 0
        JG      @@1
        MOV     RAX, 0
        JMP     @@3    // <- exit returning nil if AMaxLen <= 0

@@1:    CMP     AStr, 0
        JNE     @@2
        MOV     RAX, 0
        JMP     @@3    // <- exit returning nil if AStr = nil

@@2:    MOV     RDI, AStr
        MOV     RCX, AMaxLen
        MOV     AX, ACh
        REPNE   SCASW
        MOV     RAX, 0
        JNE     @@3
        MOV     RAX, RDI
        SUB     RAX, 2
@@3:    POP     RDI
{$ELSE}
        PUSH    EDI
        CMP     ECX, 0 // AMaxLen
        JG      @@1
        MOV     EAX, 0
        JMP     @@3    // <- exit returning nil if AMaxLen <= 0

@@1:    CMP     AStr, 0
        JNE     @@2
        MOV     EAX, 0
        JMP     @@3    // <- exit returning nil if AStr = nil

@@2:    MOV     EDI, AStr
        MOV     AX, ACh
        REPNE   SCASW  // <- Scan while unequal
        MOV     EAX, 0
        JNE     @@3
        MOV     EAX, EDI
        SUB     EAX, 2
@@3:    POP     EDI
{$ENDIF}
end;

function GMStrLScan(AStr: PGMChar; ACh: TGMChar; AMaxLen: PtrUInt): PGMChar;
begin
  {$IFDEF UNICODE}
  Result := GMStrLScanW(AStr, ACh, AMaxLen);
  {$ELSE}
  Result := GMStrLScanA(AStr, ACh, AMaxLen);
  {$ENDIF}
end;

function GMStrLScanPos(const AValue: TGMString; AChToFind: TGMChar; AStartChPos: PtrInt): PtrInt;
var pEndCh: PGMChar;
begin
  if (AStartChPos < 1) or (AStartChPos > Length(AValue)) then
   pEndCh := nil
  else
   pEndCh := GMStrLScan(PGMChar(@AValue[AStartChPos]), AChToFind, Length(AValue)-AStartChPos+1);

  if pEndCh <> nil then
   Result := pEndCh + AStartChPos - PGMChar(@AValue[AStartChPos])
  else
   Result := Length(AValue) + 1;
end;


function GMStrRLScanA(AStr: PAnsiChar; ACh: AnsiChar; AMaxLen: PtrUInt): PAnsiChar;
// 64-Bit: RCX = AStr, RDX = ACh, R8 = AMaxLen
// 32-Bit: On enter EAX contains AStr, EDX contains ACh and ECX AMaxLen.
// On Exit EAX contains Result pointer (may be nil).
asm
{$IFDEF CPU64}
        PUSH    RDI
        CMP     AMaxLen, 0
        JG      @@1
        MOV     RAX, 0
        JMP     @@3    // <- exit returning nil if AMaxLen <= 0

@@1:    CMP     AStr, 0
        JNE     @@2
        MOV     RAX, 0
        JMP     @@3    // <- exit returning nil if AStr = nil

@@2:    STD            // <- set direction flag => reverse scan
        MOV     RDI, AStr     // RCX
        MOV     RCX, AMaxLen  // R8
        MOV     AL, ACh       // RDX
        REPNE   SCASB
        MOV     RAX, 0
        CLD            // <- direction flag MUST be cleared!
        JNE     @@3
        MOV     RAX, RDI
        INC     RAX
@@3:    POP     RDI
{$ELSE}
        PUSH    EDI
        CMP     ECX, 0 // AMaxLen
        JG      @@1
        MOV     EAX, 0
        JMP     @@3    // <- exit returning nil if AMaxLen <= 0

@@1:    CMP     AStr, 0
        JNE     @@2
        MOV     EAX, 0
        JMP     @@3    // <- exit returning nil if AStr = nil

@@2:    STD            // <- set direction flag => reverse scan
        MOV     EDI, AStr
        MOV     AL, ACh
        REPNE   SCASB
        MOV     EAX, 0
        CLD            // <- direction flag MUST be cleared!
        JNE     @@3
        MOV     EAX, EDI
        INC     EAX
@@3:    POP     EDI
{$ENDIF}
end;

function GMStrRLScanW(AStr: PWideChar; ACh: WideChar; AMaxLen: PtrUInt): PWideChar;
// 64-Bit: RCX = AStr, RDX = ACh, R8 = AMaxLen
// 32-Bit: On enter EAX contains AStr, EDX contains ACh and ECX AMaxLen.
// On Exit EAX contains Result pointer (may be nil).
asm
{$IFDEF CPU64}
        PUSH    RDI
        CMP     AMaxLen, 0
        JG      @@1
        MOV     RAX, 0
        JMP     @@3    // <- exit returning nil if AMaxLen <= 0

@@1:    CMP     AStr, 0
        JNE     @@2
        MOV     RAX, 0
        JMP     @@3    // <- exit returning nil if AStr = nil

@@2:    STD            // <- set direction flag => reverse scan
        MOV     RDI, AStr     // RCX
        MOV     RCX, AMaxLen  // R8
        MOV     AX, ACh       // RDX
        REPNE   SCASW
        MOV     RAX, 0
        CLD           // <- direction flag MUST be cleared!
        JNE     @@3
        MOV     RAX, RDI
        ADD     RAX, 2
@@3:    POP     RDI
{$ELSE}
        PUSH    EDI
        CMP     ECX, 0 // AMaxLen
        JG      @@1
        MOV     EAX, 0
        JMP     @@3    // <- exit returning nil if AMaxLen <= 0

@@1:    CMP     AStr, 0
        JNE     @@2
        MOV     EAX, 0
        JMP     @@3    // <- exit returning nil if AStr = nil

@@2:    STD            // <- set direction flag => reverse scan
        MOV     EDI, AStr
        MOV     AX, ACh
        REPNE   SCASW
        MOV     EAX, 0
        CLD            // <- direction flag MUST be cleared!
        JNE     @@3
        MOV     EAX, EDI
        ADD     EAX, 2
@@3:    POP     EDI
{$ENDIF}
end;

function GMStrRLScan(AStr: PGMChar; ACh: TGMChar; AMaxLen: PtrUInt): PGMChar;
begin
  {$IFDEF UNICODE}
  Result := GMStrRLScanW(AStr, ACh, AMaxLen);
  {$ELSE}
  Result := GMStrRLScanA(AStr, ACh, AMaxLen);
  {$ENDIF}
end;


function GMStrCLScanA(AStr: PAnsiChar; ACh: AnsiChar; AMaxLen: PtrUInt): PAnsiChar;
// 64-Bit: RCX = AStr, RDX = ACh, R8 = AMaxLen
// 32-Bit: On enter EAX contains AStr, EDX contains ACh and ECX AMaxLen.
// On Exit EAX contains Result pointer (may be nil).
asm
{$IFDEF CPU64}
        PUSH    RDI
        CMP     AMaxLen, 0
        JG      @@1
        MOV     RAX, 0
        JMP     @@3    // <- exit returning nil if AMaxLen <= 0

@@1:    CMP     AStr, 0
        JNE     @@2
        MOV     RAX, 0
        JMP     @@3    // <- exit returning nil if AStr = nil

@@2:    MOV     RDI, AStr
        MOV     RCX, AMaxLen
        MOV     AL, ACh
        REPE    SCASB
        MOV     RAX, 0
        JE      @@3
        MOV     RAX, RDI
        DEC     RAX
@@3:    POP     RDI
{$ELSE}
        PUSH    EDI
        CMP     ECX, 0 // AMaxLen
        JG      @@1
        MOV     EAX, 0
        JMP     @@3    // <- exit returning nil if AMaxLen <= 0

@@1:    CMP     AStr, 0
        JNE     @@2
        MOV     EAX, 0
        JMP     @@3    // <- exit returning nil if AStr = nil

@@2:    MOV     EDI, AStr
        MOV     AL, ACh
        REPE    SCASB
        MOV     EAX, 0
        JE      @@3
        MOV     EAX, EDI
        DEC     EAX
@@3:    POP     EDI
{$ENDIF}
end;

function GMStrCLScanW(AStr: PWideChar; ACh: WideChar; AMaxLen: PtrUInt): PWideChar;
// 64-Bit: RCX = AStr, RDX = ACh, R8 = AMaxLen
// 32-Bit: On enter EAX contains AStr, EDX contains ACh and ECX AMaxLen.
// On Exit EAX contains Result pointer (may be nil).
asm
{$IFDEF CPU64}
        PUSH    RDI
        CMP     AMaxLen, 0
        JG      @@1
        MOV     RAX, 0
        JMP     @@3    // <- exit returning nil if AMaxLen <= 0

@@1:    CMP     AStr, 0
        JNE     @@2
        MOV     RAX, 0
        JMP     @@3    // <- exit returning nil if AStr = nil

@@2:    MOV     RDI, AStr
        MOV     RCX, AMaxLen
        MOV     AX, ACh
        REPE    SCASW
        MOV     RAX, 0
        JE      @@3
        MOV     RAX, RDI
        SUB     RAX, 2
@@3:    POP     RDI
{$ELSE}
        PUSH    EDI
        CMP     ECX, 0 // AMaxLen
        JG      @@1
        MOV     EAX, 0
        JMP     @@3    // <- exit returning nil if AMaxLen <= 0

@@1:    CMP     AStr, 0
        JNE     @@2
        MOV     EAX, 0
        JMP     @@3    // <- exit returning nil if AStr = nil

@@2:    MOV     EDI, AStr
        MOV     AX, ACh
        REPE    SCASW
        MOV     EAX, 0
        JE      @@3
        MOV     EAX, EDI
        SUB     EAX, 2
@@3:    POP     EDI
{$ENDIF}
end;

function GMStrCLScan(AStr: PGMChar; ACh: TGMChar; AMaxLen: PtrUInt): PGMChar;
begin
  {$IFDEF UNICODE}
  Result := GMStrCLScanW(AStr, ACh, AMaxLen);
  {$ELSE}
  Result := GMStrCLScanA(AStr, ACh, AMaxLen);
  {$ENDIF}
end;


function GMStrCRLScanA(AStr: PAnsiChar; ACh: AnsiChar; AMaxLen: PtrUInt): PAnsiChar;
// 64-Bit: RCX = AStr, RDX = ACh, R8 = AMaxLen
// 32-Bit: On enter EAX contains AStr, EDX contains ACh and ECX AMaxLen.
// On Exit EAX contains Result pointer (may be nil).
asm
{$IFDEF CPU64}
        PUSH    RDI
        CMP     AMaxLen, 0
        JG      @@1
        MOV     RAX, 0
        JMP     @@3    // <- exit returning nil if AMaxLen <= 0

@@1:    CMP     AStr, 0
        JNE     @@2
        MOV     RAX, 0
        JMP     @@3    // <- exit returning nil if AStr = nil

@@2:    STD            // <- set direction flag => reverse scan
        MOV     RDI, AStr     // RCX
        MOV     RCX, AMaxLen  // R8
        MOV     AL, ACh       // RDX
        REPE    SCASB
        MOV     RAX, 0
        CLD            // <- direction flag MUST be cleared!
        JE      @@3
        MOV     RAX, RDI
        INC     RAX
@@3:    POP     RDI
{$ELSE}
        PUSH    EDI
        CMP     ECX, 0 // AMaxLen
        JG      @@1
        MOV     EAX, 0
        JMP     @@3    // <- exit returning nil if AMaxLen <= 0

@@1:    CMP     AStr, 0
        JNE     @@2
        MOV     EAX, 0
        JMP     @@3    // <- exit returning nil if AStr = nil

@@2:    STD            // <- set direction flag => reverse scan
        MOV     EDI, AStr
        MOV     AL, ACh
        REPE    SCASB
        MOV     EAX, 0
        CLD            // <- direction flag MUST be cleared!
        JE      @@3
        MOV     EAX, EDI
        INC     EAX
@@3:    POP     EDI
{$ENDIF}
end;

function GMStrCRLScanW(AStr: PWideChar; ACh: WideChar; AMaxLen: PtrUInt): PWideChar;
// 64-Bit: RCX = AStr, RDX = ACh, R8 = AMaxLen
// 32-Bit: On enter EAX contains AStr, EDX contains ACh and ECX AMaxLen.
// On Exit EAX contains Result pointer (may be nil).
asm
{$IFDEF CPU64}
        PUSH    RDI
        CMP     AMaxLen, 0
        JG      @@1
        MOV     RAX, 0
        JMP     @@3    // <- exit returning nil if AMaxLen <= 0

@@1:    CMP     AStr, 0
        JNE     @@2
        MOV     RAX, 0
        JMP     @@3    // <- exit returning nil if AStr = nil

@@2:    STD            // <- set direction flag => reverse scan
        MOV     RDI, AStr     // RCX
        MOV     RCX, AMaxLen  // R8
        MOV     AX, ACh       // RDX
        REPE    SCASW
        MOV     RAX, 0
        CLD           // <- direction flag MUST be cleared!
        JE      @@3
        MOV     RAX, RDI
        ADD     RAX, 2
@@3:    POP     RDI
{$ELSE}
        PUSH    EDI
        CMP     ECX, 0 // AMaxLen
        JG      @@1
        MOV     EAX, 0
        JMP     @@3    // <- exit returning nil if AMaxLen <= 0

@@1:    CMP     AStr, 0
        JNE     @@2
        MOV     EAX, 0
        JMP     @@3    // <- exit returning nil if AStr = nil

@@2:    STD            // <- set direction flag => reverse scan
        MOV     EDI, AStr
        MOV     AX, ACh
        REPE    SCASW
        MOV     EAX, 0
        CLD            // <- direction flag MUST be cleared!
        JE      @@3
        MOV     EAX, EDI
        ADD     EAX, 2
@@3:    POP     EDI
{$ENDIF}
end;

function GMStrCRLScan(AStr: PGMChar; ACh: TGMChar; AMaxLen: PtrUInt): PGMChar;
begin
  {$IFDEF UNICODE}
  Result := GMStrCRLScanW(AStr, ACh, AMaxLen);
  {$ELSE}
  Result := GMStrCRLScanA(AStr, ACh, AMaxLen);
  {$ENDIF}
end;



function GMStrScanA(AStr: PAnsiChar; ACh: AnsiChar): PAnsiChar;
// Searches until it hits either 0 or ACh
asm
{$IFDEF CPU64}
        MOV     RAX, AStr
        TEST    RAX, RAX
        JZ      @@Exit  // <- AStr is nil and Result is nil, Exit!
  @@Loop:
        CMP     [RAX], DL
        JE      @@Exit
        CMP     BYTE PTR [RAX], 0
        JE      @@Clear
        INC     RAX
        JMP     @@Loop
  @@Clear:
        XOR     RAX, RAX
  @@Exit:
{$ELSE}
        TEST    EAX, EAX
        JZ      @@Exit  // <- AStr is nil and Result is nil, Exit!
  @@Loop:
        CMP     [EAX], DL
        JE      @@Exit
        CMP     BYTE PTR [EAX], 0
        JE      @@Clear
        INC     EAX
        JMP     @@Loop
  @@Clear:
        XOR     EAX, EAX
  @@Exit:
{$ENDIF}
end;

function GMStrScanW(AStr: PWideChar; ACh: WideChar): PWideChar;
// Searches until it hits either 0 or ACh
asm
{$IFDEF CPU64}
        MOV     RAX, AStr
        TEST    RAX, RAX
        JZ      @@Exit  // <- AStr is nil and Result is nil, Exit!
  @@Loop:
        CMP     [RAX], DX
        JE      @@Exit
        CMP     WORD PTR [RAX], 0
        JE      @@Clear
        ADD     RAX, 2
        JMP     @@Loop
  @@Clear:
        XOR     RAX, RAX
  @@Exit:
{$ELSE}
        TEST    EAX, EAX
        JZ      @@Exit  // <- AStr is nil and Result is nil, Exit!
  @@Loop:
        CMP     [EAX], DX
        JE      @@Exit
        CMP     WORD PTR [EAX], 0
        JE      @@Clear
        ADD     EAX, 2
        JMP     @@Loop
  @@Clear:
        XOR     EAX, EAX
  @@Exit:
{$ENDIF}
end;

//function GMStrScanA(AStr: PAnsiChar; ACh: AnsiChar): PAnsiChar;
//begin
//Result := AStr;
//if Result = nil then Exit;
//while (Result^ <> ACh) and (Result^ <> #0) do Inc(Result);
//if Result^ <> ACh then Result := nil;
//end;

//function GMStrScanW(AStr: PWideChar; ACh: WideChar): PWideChar;
//begin
//Result := AStr;
//if Result = nil then Exit;
//while (Result^ <> ACh) and (Result^ <> #0) do Inc(Result);
//if Result^ <> ACh then Result := nil;
//end;

function GMStrScan(AStr: PGMChar; ACh: TGMChar): PGMChar;
begin
  {$IFDEF UNICODE}
  Result := GMStrScanW(AStr, ACh);
  {$ELSE}
  Result := GMStrScanA(AStr, ACh);
  {$ENDIF}
end;

function GMStrLCompA(const AStr1, AStr2: PAnsiChar; AMaxLen: PtrUInt): PtrInt;
asm
{$IFDEF CPU64}
        PUSH    RDI
        PUSH    RSI
        MOV     RDI, AStr1
        MOV     RSI, AStr2
        MOV     RCX, AMaxLen
        XOR     RAX, RAX
        XOR     RDX, RDX
        OR      RCX, RCX
        JE      @@1      // <- check zero length
        REPE    CMPSB
        MOV     AL, [RSI-1]
        MOV     DL, [RDI-1]
        SUB     RAX, RDX
@@1:    POP     RSI
        POP     RDI
{$ELSE}
        PUSH    EDI
        PUSH    ESI
        MOV     EDI,EDX
        MOV     ESI,EAX
        XOR     EAX,EAX
        XOR     EDX,EDX
        OR      ECX,ECX
        JE      @@1      // <- check zero length
        REPE    CMPSB
        MOV     AL,[ESI-1]
        MOV     DL,[EDI-1]
        SUB     EAX,EDX
@@1:    POP     ESI
        POP     EDI
{$ENDIF}
end;

function GMStrLCompW(const AStr1, AStr2: PWideChar; AMaxLen: PtrUInt): PtrInt;
asm
{$IFDEF CPU64}
        PUSH    RDI
        PUSH    RSI
        MOV     RDI, AStr1
        MOV     RSI, AStr2
        MOV     RCX, AMaxLen
        XOR     RAX, RAX
        XOR     RDX, RDX
        OR      RCX, RCX
        JE      @@1      // <- check zero length
        REPE    CMPSW
        MOV     AX, [RSI-2]
        MOV     DX, [RDI-2]
        SUB     RAX, RDX
@@1:    POP     RSI
        POP     RDI
{$ELSE}
        PUSH    EDI
        PUSH    ESI
        MOV     EDI,EDX
        MOV     ESI,EAX
        XOR     EAX,EAX
        XOR     EDX,EDX
        OR      ECX,ECX
        JE      @@1      // <- check zero length
        REPE    CMPSW
        MOV     AX,[ESI-2]
        MOV     DX,[EDI-2]
        SUB     EAX,EDX
@@1:    POP     ESI
        POP     EDI
{$ENDIF}
end;

function GMStrLComp(const AStr1, AStr2: PGMChar; AMaxLen: PtrUInt): PtrInt;
begin
  {$IFDEF UNICODE}
  Result := GMStrLCompW(AStr1, AStr2, AMaxLen);
  {$ELSE}
  Result := GMStrLCompA(AStr1, AStr2, AMaxLen);
  {$ENDIF}
end;

function GMCompareMemory(const AContents1, AContents2: Pointer; const AMaxLenInBytes: PtrUInt): TGMCompareResult;
var cmp: PtrInt;
begin
  cmp := GMStrLCompA(AContents1, AContents2, AMaxLenInBytes);
  if cmp < 0 then Result := crALessThanB else if cmp = 0 then Result := crAEqualToB else Result := crAGreaterThanB;
end;


//function GMStrComp(const Str1, Str2: TGMString): LongInt;
//begin
//Result := GMStrLComp(PGMChar(Str1), PGMChar(Str2), Min(Length(Str1), Length(Str2)));
//if Result = 0 then
// begin
//  if Length(Str1) < Length(Str2) then Result := -1
//  else
//  if Length(Str1) > Length(Str2) then Result := 1;
// end;
//end;

function GMStrLICompA(const AStr1, AStr2: PAnsiChar; AMaxLen: PtrUInt): LongInt;
asm
{$IFDEF CPU64}
        PUSH    RDI
        PUSH    RSI
        MOV     RDI, AStr1
        MOV     RSI, AStr2
        MOV     RCX, AMaxLen
        XOR     RAX, RAX
        XOR     RDX, RDX
        OR      RCX, RCX
        JE      @@4      // <- check zero length
@@1:    REPE    CMPSB
        JE      @@4
        MOV     AL, [RSI-1]
        CMP     AL, 'a'
        JB      @@2
        CMP     AL, 'z'
        JA      @@2
        SUB     AL, 20H
@@2:    MOV     DL, [RDI-1]
        CMP     DL, 'a'
        JB      @@3 
        CMP     DL, 'z'
        JA      @@3
        SUB     DL, 20H
@@3:    SUB     RAX, RDX
        JE      @@1
@@4:    POP     RSI
        POP     RDI
{$ELSE}
        PUSH    EDI
        PUSH    ESI
        MOV     EDI,EDX
        MOV     ESI,EAX
        XOR     EAX,EAX
        XOR     EDX,EDX
        OR      ECX,ECX
        JE      @@4      // <- check zero length
@@1:    REPE    CMPSB
        JE      @@4
        MOV     AL,[ESI-1]
        CMP     AL,'a'
        JB      @@2
        CMP     AL,'z'
        JA      @@2
        SUB     AL,20H
@@2:    MOV     DL,[EDI-1]
        CMP     DL,'a'
        JB      @@3
        CMP     DL,'z'
        JA      @@3
        SUB     DL,20H
@@3:    SUB     EAX,EDX
        JE      @@1
@@4:    POP     ESI
        POP     EDI
{$ENDIF}
end;

function GMStrLICompW(const AStr1, AStr2: PWideChar; AMaxLen: PtrUInt): LongInt;
asm
{$IFDEF CPU64}
        PUSH    RDI
        PUSH    RSI
        MOV     RDI, AStr1
        MOV     RSI, AStr2
        MOV     RCX, AMaxLen
        XOR     RAX, RAX
        XOR     RDX, RDX
        OR      RCX, RCX
        JE      @@4      // <- check zero length
@@1:    REPE    CMPSW
        JE      @@4
        MOV     AX, [RSI-2]
        CMP     AX, 'a'
        JB      @@2
        CMP     AX, 'z'
        JA      @@2
        SUB     AX, 20H
@@2:    MOV     DX, [RDI-2]
        CMP     DX, 'a'
        JB      @@3
        CMP     DX, 'z'
        JA      @@3
        SUB     DX,20H
@@3:    SUB     RAX,RDX
        JE      @@1
@@4:    POP     RSI
        POP     RDI
{$ELSE}
        PUSH    EDI
        PUSH    ESI
        MOV     EDI,EDX
        MOV     ESI,EAX
        XOR     EAX,EAX
        XOR     EDX,EDX
        OR      ECX,ECX
        JE      @@4      // <- check zero length
@@1:    REPE    CMPSW
        JE      @@4
        MOV     AX,[ESI-2]
        CMP     AX,'a'
        JB      @@2
        CMP     AX,'z'
        JA      @@2
        SUB     AX,20H
@@2:    MOV     DX,[EDI-2]
        CMP     DX,'a'
        JB      @@3
        CMP     DX,'z'
        JA      @@3
        SUB     DX,20H
@@3:    SUB     EAX,EDX
        JE      @@1
@@4:    POP     ESI
        POP     EDI
{$ENDIF}
end;

//function GMStrLICompA(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer;
//var P1, P2: PAnsiChar; I: Cardinal; C1, C2: AnsiChar;
//begin
//P1 := Str1; P2 := Str2; I := 0;
//while I < MaxLen do
// begin
//  if P1^ in ['a'..'z'] then
//    C1 := AnsiChar(Byte(P1^) xor $20)
//  else
//    C1 := P1^;
//
//  if P2^ in ['a'..'z'] then
//    C2 := AnsiChar(Byte(P2^) xor $20)
//  else
//    C2 := P2^;
//
//  if (C1 <> C2) or (C1 = #0) then
//    begin Result := Ord(C1) - Ord(C2); Exit; end;
//
//  Inc(P1); Inc(P2); Inc(I);
// end;
//Result := 0;
//end;

//function GMStrLICompW(const Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
//var P1, P2: PWideChar; I: Cardinal; C1, C2: WideChar;
//begin
//P1 := Str1; P2 := Str2; I := 0;
//while I < MaxLen do
// begin
//  if (P1^ >= 'a') and (P1^ <= 'z') then
//    C1 := WideChar(Word(P1^) xor $20)
//  else
//    C1 := P1^;
//
//  if (P2^ >= 'a') and (P2^ <= 'z') then
//    C2 := WideChar(Word(P2^) xor $20)
//  else
//    C2 := P2^;
//
//  if (C1 <> C2) or (C1 = #0) then
//    begin Result := Ord(C1) - Ord(C2); Exit; end;
//
//  Inc(P1); Inc(P2); Inc(I);
// end;
//Result := 0;
//end;

function GMStrLIComp(const AStr1, AStr2: PGMChar; AMaxLen: PtrUInt): LongInt;
begin
//Result := lstrcmpi(Str1, Str2);  CompareStringEx(...);
  {$IFDEF UNICODE}
  Result := GMStrLICompW(AStr1, AStr2, AMaxLen);
  {$ELSE}
  Result := GMStrLICompA(AStr1, AStr2, AMaxLen);
  {$ENDIF}
end;

function GMSameText(const AValue1, AValue2: TGMString): Boolean;
begin
  Result := Length(AValue1) = Length(AValue2);
  if Result then Result := GMStrLIComp(PGMChar(AVAlue1), PGMChar(AValue2), Length(AValue1)) = 0;
end;


function GMLoCaseW(ACh: WideChar): WideChar;
begin
  Result := ACh;
  case ACh of
    'A'..'Z': Result := WideChar(Word(ACh) or not $FFDF);
  end;
end;

function GMLoCaseA(ACh: AnsiChar): AnsiChar;
begin
  Result := ACh;
  if Result in ['A'..'Z'] then Inc(Result, Ord('a')-Ord('A'));
end;

function GMLoCase(ACh: TGMChar): TGMChar;
begin
  {$IFDEF UNICODE}
  Result := GMLoCaseW(ACh);
  {$ELSE}
  Result := GMLoCaseA(ACh);
  {$ENDIF}
end;

function GMUpCaseA(ACh: AnsiChar): AnsiChar;
begin
  Result := ACh;
  if Result in ['a'..'z'] then Dec(Result, Ord('a')-Ord('A'));
end;

function GMUpCaseW(ACh: WideChar): WideChar;
begin
  Result := ACh;
  case ACh of
    'a'..'z': Result := WideChar(Word(ACh) and $FFDF);
  end;
end;

function GMUpCase(ACh: TGMChar): TGMChar;
begin
  {$IFDEF UNICODE}
  Result := GMUpCaseW(ACh);
  {$ELSE}
  Result := GMUpCaseA(ACh);
  {$ENDIF}
end;

function GMUpperCaseA(const AValue: AnsiString): AnsiString;
var i: Integer;
begin
  Result := AValue;
  for i:= 1 to Length(Result) do Result[i] := GMUpCaseA(Result[i]);
end;

function GMUpperCaseW(const AValue: UnicodeString): UnicodeString;
var i: Integer;
begin
  Result := AValue;
  for i:= 1 to Length(Result) do Result[i] := GMUpCaseW(Result[i]);
end;

function GMUpperCase(const AValue: TGMString): TGMString;
begin
  {$IFDEF UNICODE}
  Result := GMUpperCaseW(AValue);
  {$ELSE}
  Result := GMUpperCaseA(AValue);
  {$ENDIF}
end;

function GMLowerCase(const AValue: TGMString): TGMString;
var i: Integer;
begin
  Result := AValue;
  for i:= 1 to Length(Result) do Result[i] := GMLoCase(Result[i]);
end;

//function GMStrScanPas(const AValue: PGMChar; Ch: TGMChar): PGMChar;
//begin
//Result := AValue;
//if Result = nil then Exit;
//while (Result^ <> Ch) and (Result^ <> #0) do Inc(Result);
//if Result^ = #0 then Result := nil;
//end;


{ ----------------------------- }
{ ---- TGMString functions ---- }
{ ----------------------------- }

function GMDateTimeToStr(const ADateTime: TDateTime): TGMString;
var FormatStr: TGMString; {$IFDEF UNICODE}timeStr: AnsiString;{$ENDIF}
begin
  if GMDateIsNull(ADateTime) then
   begin
    if GMTimeIsNull(ADateTime) then begin Result := ''; Exit; end
    else FormatStr := DefaultFormatSettings.LongTimeFormat; // LongTimeFormat;
   end
  else
   begin                                         // ShortDateFormat
    if GMTimeIsNull(ADateTime) then FormatStr := DefaultFormatSettings.ShortDateFormat else FormatStr := '';
   end;

  {$IFDEF UNICODE}
  DateTimeToString(timeStr, FormatStr, ADateTime);
  Result := timeStr;
  {$ELSE}
  DateTimeToString(Result, FormatStr, ADateTime);
  {$ENDIF}
end;

function GMCommonPrefixLen(const Str1, Str2: TGMString; const IngoreCase: Boolean = True): LongInt;
begin
  Result := 0;
  while (Result < Length(Str1)) and (Result < Length(Str2)) do
   begin
    if IngoreCase then
     begin if GMUpCase(Str1[Result+1]) <> GMUpCase(Str2[Result+1]) then Break; end
    else
     begin if Str1[Result+1] <> Str2[Result+1] then Break; end;

    Inc(Result);
   end;
end;

function GMQuote(const AValue: TGMString; const ALeftQuote, ARightQuote: TGMChar): TGMString;
begin
  Result := GMStripRight(GMStripLeft(AValue, ALeftQuote), ARightQuote);
//if Result <> '' then
  Result := ALeftQuote + Result + ARightQuote;
end;

//function GMRemoveQuotes(const AValue: TGMString; const ALeftQuotes, ARightQuotes: TGMString): TGMString;
//begin
//Result := AValue;
//if (Length(Result) > 0) and (Length(ALeftQuotes) > 0) and GMIsdelimiter(ALeftQuotes, Result, 1) then System.Delete(Result, 1, 1);
//if (Length(Result) > 0) and (Length(ARightQuotes) > 0) and GMIsdelimiter(ARightQuotes, Result, Length(Result)) then System.Delete(Result, Length(Result), 1);
//end;

function GMRemoveQuotes(const AValue: TGMString; const ALeftQuote, ARightQuote: TGMChar): TGMString;
var startCh, endCh: PtrInt;
begin
  if Length(AValue) <= 0 then Result := AValue else
   begin
    if AValue[1] = ALeftQuote then startCh := 2 else startCh := 1;
    if (Length(AValue) >= startCh) and (AValue[Length(AValue)] = ARightQuote) then endCh := Length(AValue) else endCh := Length(AValue) + 1;
    Result := System.Copy(AValue, startCh, endCh - startCh);
   end;
end;

//function GMResolveEscapeChars2(const Value: TGMString; const EscCh: TGMChar): TGMString;
//var chPos, startPos, ASCII: LongInt;
//begin
//Result := Value;
//chPos := 1;
//while chPos <= Length(Result) do
// if not (Result[chPos] = EscCh) then Inc(chPos) else
//  begin
//   startPos := chPos;
//   Inc(chPos);
//   if (chPos <= Length(Result)) and (Result[chPos] = EscCh) then System.Delete(Result, chPos, 1)
//   else
//    begin
//     while (chPos <= Length(Result)) and GMIsDigit(Result[chPos]) do Inc(chPos);
//     ASCII := GMStrToInt(GMMakeDezInt(Copy(Result, startPos, chPos - startPos), -1));
//     System.Delete(Result, startPos, chPos - startPos);
//     if GMIsInRange(ASCII, 0, 255) then System.Insert(Chr(ASCII), Result, startPos);
//     chPos := startPos + 1;
//    end;
//  end;
//end;

function GMIsPrefixStr(const APrefix, AValue: TGMString; const AIngoreCase: Boolean): Boolean;
var len: PtrInt;
begin
  if APrefix = '' then Result := False else
   begin
    len := Min(Length(APrefix), Length(AValue));
    if len < Length(APrefix) then Result := False else
     if AIngoreCase then
      Result := GMStrLIComp(PGMChar(APrefix), PGMChar(AValue), len) = 0
     else
      Result := GMStrLComp(PGMChar(APrefix), PGMChar(AValue), len) = 0;
   end;
end;

function GMDeleteLastWord(const Value: TGMString; const Separators: TGMString): TGMString;
var chPos: PtrInt;
begin
  Result := Value;

  chPos := Length(Result);
  while (chPos >= 1) and GMIsDelimiter(Separators, Result, chPos) do Dec(chPos);
//if chPos < Length(Result) then System.Delete(Result, chPos+1, Length(Result)-chPos);

//chPos := Length(Result);
  while (chPos >= 1) and not GMIsDelimiter(Separators, Result, chPos) do Dec(chPos);
//if chPos < Length(Result) then System.Delete(Result, chPos+1, Length(Result)-chPos);

//chPos := Length(Result);
  while (chPos >= 1) and GMIsDelimiter(Separators, Result, chPos) do Dec(chPos);
  if chPos < Length(Result) then System.Delete(Result, chPos+1, Length(Result)-chPos);
end;

function GMDeleteFirstWord(const Value: TGMString; const Separators: TGMString; const StripSeparators: Boolean = True): TGMString;
var chPos: PtrInt;
begin
  Result := Value;

  chPos := 1;
  While (chPos <= Length(Result)) and GMIsDelimiter(Separators, Result, chPos) do Inc(chPos);
  if chPos > 1 then System.Delete(Result, 1, chPos-1);

  chPos := 1;
  While (chPos <= Length(Result)) and not GMIsDelimiter(Separators, Result, chPos) do Inc(chPos);
  if chPos > 1 then System.Delete(Result, 1, chPos-1);

  if not StripSeparators then Exit;

  chPos := 1;
  While (chPos <= Length(Result)) and GMIsDelimiter(Separators, Result, chPos) do Inc(chPos);
  if chPos > 1 then System.Delete(Result, 1, chPos-1);
end;

function GMDeleteFirstWords(const Value: TGMString; const WordCount: LongInt; const Separators: TGMString): TGMString;
var i: LongInt;
begin
  Result := Value;
  for i:=1 to WordCount do Result := GMDeleteFirstWord(Result, Separators);
end;

function GMDeleteNextWord(const AchPos: PtrInt; const Value, Separators: TGMString): TGMString;
var chps: LongInt;
begin
  Result := Value;
  if Length(Result) >= AChPos then
   begin
    chps := AChPos;
    While (chps <= Length(Result)) and GMIsDelimiter(Separators, Result, chps) do Inc(chps);
    if chps > AChPos then System.Delete(Result, AChPos, chps-AChPos);

    chps := AChPos;
    While (chps <= Length(Result)) and not GMIsDelimiter(Separators, Result, chps) do Inc(chps);
    if chps > AChPos then System.Delete(Result, AChPos, chps-AChPos);

    chps := AChPos;
    While (chps <= Length(Result)) and GMIsDelimiter(Separators, Result, chps) do Inc(chps);
    if chps > AChPos then System.Delete(Result, AChPos, chps-AChPos);
   end;
end;

function GMFindToken(const AText, AToken: TGMString; var AchPos: PtrInt; const ASeparators: TGMString; AWholeWords: Boolean; const AIgnoreCase: Boolean): Boolean;
var len, TokenLen: LongInt;
  function IsSubStrAtPos(const AText, AToken: TGMString; const AChPos: LongInt): Boolean;
  begin
    if AIgnoreCase then
     Result := GMStrLIComp(@AText[AChPos], PGMChar(AToken), TokenLen) = 0
    else
     Result := GMStrLComp(@AText[AChPos], PGMChar(AToken), TokenLen) = 0;
  end;
begin
  Result := False; len := Length(AText); TokenLen := Length(AToken);
  if AChPos < 1 then AChPos := 1;
  if AChPos > len - TokenLen + 1 then Exit;
  //if not GMIsInRange(AChPos, 1, len - TokenLen + 1) then Exit;
  if TokenLen = 0 then Exit;
  if ASeparators = '' then AWholeWords := False;
  if AWholeWords then while (AChPos <= len - TokenLen + 1) and GMIsDelimiter(ASeparators, AText, AChPos) do Inc(AChPos);

  while (AChPos <= len - TokenLen + 1) and not Result do
   begin
    if IsSubStrAtPos(AText, AToken, AChPos) then
     begin
      if not AWholeWords then Result := True else
       begin
        if len < AChPos + TokenLen then Result := True else
         if GMIsDelimiter(ASeparators, AText, AChPos + TokenLen) then Result := True;
       end;
     end;

    if not Result then
     if not AWholeWords then Inc(AChPos) else
      begin
       while (AChPos <= len - TokenLen + 1) and not GMIsDelimiter(ASeparators, AText, AChPos) do Inc(AChPos);
       while (AChPos <= len - TokenLen + 1) and GMIsDelimiter(ASeparators, AText, AChPos) do Inc(AChPos);
      end;
   end;
end;

function GMHasToken(const AValue, AToken, ASeparators: TGMString; AWholeWords, AIgnoreCase: Boolean ): Boolean;
var chPos: PtrInt;
begin
  chPos := 1;
  Result := GMFindToken(AValue, AToken, chPos, ASeparators, AWholeWords, AIgnoreCase);
end;

function GMTokenCount(const AValue, AToken, ASeparators: TGMString; AWholeWords, AIgnoreCase: Boolean): LongInt;
var chPos: PtrInt;
begin
  chPos := 1; Result := 0;
  while GMFindToken(AValue, AToken, chPos, ASeparators, AWholeWords, AIgnoreCase) do begin Inc(Result); Inc(chPos, Length(AToken)); end;
end;

function GMDeleteWords(const AValue: TGMString; const AWords: array of TGMString; const ASeparators: TGMString; const AWholeWords, AIgnoreCase: Boolean): TGMString;
var i, chPos: PtrInt;
begin
  Result := AValue;
  for i:=Low(AWords) to High(AWords) do
   if AWords[i] <> '' then
    begin
     chPos := 1;
     while GMFindToken(Result, AWords[i], chPos, ASeparators, AWholeWords, AIgnoreCase) do System.Delete(Result, chPos, Length(AWords[i]));
    end;
end;

function GMKeepWords(const AValue: TGMString; const AWords: array of TGMString; const ASeparators: TGMString; const AWholeWords, AIgnoreCase: Boolean): TGMString;
var i, chPos: PtrInt;
begin
  Result := '';
  for i:=Low(AWords) to High(AWords) do
   if AWords[i] <> '' then
    begin
     chPos := 1;
     if GMFindToken(AValue, AWords[i], chPos, ASeparators, AWholeWords, AIgnoreCase) then
      Result := GMStringJoin(Result, ' ', AWords[i]);
    end;
end;

function GMReplaceWords(const Value: TGMString; const OldWord, NewWord, Separators: TGMString; const AIgnoreCase: Boolean): TGMString;
var chPos: PtrInt;
begin
  Result := Value;
  chPos := 1;
  while GMFindToken(Result, OldWord, chPos, Separators, True, AIgnoreCase) do
   begin
    System.Delete(Result, chPos, Length(OldWord));
    Insert(NewWord, Result, chPos);
    chPos := chPos + Length(NewWord);
   end;
end;

function GMFindOneOfWords(const Text, Separators: TGMString; const Words: array of TGMString; var chPos: PtrInt; const AIgnoreCase: Boolean): Boolean;
var i, startPos: LongInt;
begin
  Result := False;
  if (Length(Words) > 0) and (Text <> '') then
   begin
    startPos := chPos;
    for i:=Low(Words) to High(Words) do
     if (Words[i] <> '') and GMFindToken(Text, Words[i], chPos, Separators, True, AIgnoreCase) then
      begin Result := True; Break; end else chPos := startPos;
    if not Result then chPos := startPos;
   end;         
end;

function GMIsOneOfStrings(const Value: TGMString; const Strings: array of TGMString; const AIgnoreCase: Boolean): Boolean;
var i: LongInt;
  function CompareStrings(const Str1, Str2: TGMString): Boolean;
  begin
    if AIgnoreCase then Result := GMSameText(Str1, Str2) else Result := Str1 = Str2;
  end;
begin
  Result := False;
  for i:=Low(Strings) to High(Strings) do
   if CompareStrings(Value, Strings[i]) then begin Result := True; Break; end;
end;

function GMFindTextPart(const Text, Separators: TGMString; const StartWords, EndWords: array of TGMString; const AIgnoreCase: Boolean): TGMString;
var startPos, endPos: PtrInt;
begin
  Result := ''; startPos := 1;
  if GMFindOneOfWords(Text, Separators, StartWords, startPos, AIgnoreCase) then
   begin
    endPos := startPos;
    if not GMFindOneOfWords(Text, Separators, EndWords, endPos, AIgnoreCase) then endPos := Length(Text) + 1;
    Result := GMStrip(GMDeleteFirstWord(Copy(Text, startPos, endPos - startPos), cWhiteSpace), cWhiteSpace + ';');
   end;
end;

function GMReplaceTextPart(const Text: TGMString; const Separators, NewPart: TGMString; const StartWords, EndWords: array of TGMString; const AIgnoreCase: Boolean): TGMString;
var startPos, endPos: PtrInt;
begin
  Result := Text;
  startPos := 1;
  if not GMFindOneOfWords(Result, Separators, StartWords, startPos, AIgnoreCase) then
   startPos := Length(Result) else Dec(startPos);
  while (startPos >= 1) and GMIsDelimiter(cWhiteSpace, Result, startPos) do Dec(startPos);
  Inc(startPos);

  endPos := 1;
  if not GMFindOneOfWords(Result, Separators, EndWords, endPos, AIgnoreCase) then
   endPos := Length(Result)+1;
  //While (endPos <= Length(Result)) and GMIsDelimiter(cWhiteSpace, Result, endPos) do Inc(endPos);
  //if endPos = Length(Result) then Inc(endPos);

  if startPos < endPos then
   System.Delete(Result, startPos, endPos - startPos)
  else
   startPos := endPos;

  if NewPart <> '' then Insert(NewPart, Result, startPos);
end;

function GMNextLine(var AChPos: PtrInt; const AText: TGMString): TGMString;
const cIncCount: array [Boolean] of PtrInt = (1, 2);
var ch1, ch2: TGMChar; startPos: PtrInt;
begin
  startPos := AChPos;
  while (AChPos <= Length(AText)) do
   case AText[AChPos] of
     #13, #10: Break;
     else Inc(AChPos);
   end;

  if AChPos > startPos then Result := Copy(AText, startPos, AChPos-startPos) else Result := '';

  if AChPos <= Length(AText) then ch1 := AText[AChPos] else ch1 := #0;
  if AChPos+1 <= Length(AText) then ch2 := AText[AChPos+1] else ch2 := #0;

  //if ch1 = #13 then Inc(AChPos, cIncCount[ch2 = #10]) else if ch1 = #10 then Inc(AChPos, cIncCount[ch2 = #13]);

  case ch1 of
    #13: Inc(AChPos, cIncCount[ch2 = #10]);
    #10: Inc(AChPos, cIncCount[ch2 = #13]);
  end;
end;

function GMLimitedTextExtract(const AValue: TGMString; const AMaxLineCount, AMaxLineLength: Integer; const ARemoveEmptyLines: Boolean): TGMString;
var lineNo, chPos: PtrInt; line: TGMString;
//function NextLine(var AChPos: Integer): TGMString;
//var startPos, len: Integer;
//begin
//  while (AChPos <= Length(AValue)) and GMIsDelimiter(#10#13, AValue, chPos) do Inc(AChPos);
//  startPos := AChPos;
//  while (AChPos <= Length(AValue)) and not GMIsDelimiter(#10#13, AValue, chPos) do Inc(AChPos);
//
//  len := AChPos - startPos;
//  if AMaxLineLength > 0 then len := Min(AMaxLineLength, len);
//
//  Result := Copy(AValue, startPos, len);
//
//  if AChPos - startPos > len then Result := Result + cStr_More;
//end;
begin
  Result := '';
  lineNo := 1; chPos := 1;
  while ((AMaxLineCount <= 0) or (lineNo <= AMaxLineCount)) and (chPos <= Length(AValue)) do
   begin
    line := GMStrip(GMNextLine(chPos, AValue));
    if (AMaxLineLength > 0) and (Length(line) > AMaxLineLength) then line := Copy(line, 1, AMaxLineLength) + cStr_More;
    if not ARemoveEmptyLines or (Length(line) > 0) then
       begin Result := GMStringJoin(Result, cNewLine, line); Inc(lineNo); end;
   end;
end;

function GMNextWord(var AChPos: PtrInt; const AValue, ASeparators: TGMString; const ASkipLeadingSeparators: Boolean): TGMString;
var startPos: PtrInt;
begin
  if ASkipLeadingSeparators then while (AChPos <= Length(AValue)) and GMIsDelimiter(ASeparators, AValue, AChPos) do Inc(AChPos);
  startPos := AChPos;
  while (AChPos <= Length(AValue)) and not GMIsDelimiter(ASeparators, AValue, AChPos) do Inc(AChPos);
  if AChPos > startPos then Result := Copy(AValue, startPos, AChPos-startPos) else Result := '';
  if (AChPos <= Length(AValue)) and GMIsDelimiter(ASeparators, AValue, AChPos) then Inc(AChPos);
//  {if SkipSeparators then} while (AChPos <= Length(AValue)) and GMIsDelimiter(ASeparators, AValue, AChPos) do Inc(AChPos);
end;

function GMNextWord(var AChPos: PtrInt; const AValue: TGMString; ASeparatorChar: TGMChar; const ASkipLeadingSeparators: Boolean): TGMString;
const cFoundInc: array [Boolean] of PtrInt = (1, 0);
var pChEnd: PGMChar; len: PtrInt;
begin
  if (Length(AValue) <= 0) or (AChPos < 1) or (AChPos > Length(AValue)) then begin Result := ''; Exit; end;

  if ASkipLeadingSeparators then
   begin
    pChEnd := GMStrCLScan(@AValue[AChPos], ASeparatorChar, Length(AValue) - AChPos + 1);
    if pChEnd <> nil then Inc(AChPos, pChEnd - PGMChar(@AValue[AChPos])) else
       begin AChPos := Length(AValue) + 1; Result := ''; Exit; end; // <- Note:  EXIT Here!
   end;

  pChEnd := GMStrLScan(@AValue[AChPos], ASeparatorChar, Length(AValue) - AChPos + 1);
  if pChEnd = nil then len := Length(AValue) - AChPos + 1 else len := pChEnd - PGMChar(@AValue[AChPos]);
  Result := System.Copy(AValue, AChPos, len);
  Inc(AChPos, len + cFoundInc[pChEnd = nil]);
end;

function GMPreviousWord(var AChPos: PtrInt; const AValue, ASeparators: TGMString; const ASkipTrailingSeparators: Boolean): TGMString;
var startPos: LongInt;
begin
//Result := '';
  if ASkipTrailingSeparators then while (AChPos > 0) and GMIsDelimiter(ASeparators, AValue, AChPos) do Dec(AChPos);
  startPos := AChPos;
  while (AChPos > 0) and not GMIsDelimiter(ASeparators, AValue, AChPos) do Dec(AChPos);
  if AChPos < startPos then Result := Copy(AValue, AChPos+1, startPos - AChPos) else Result := '';
//while (AChPos > 0) and GMIsDelimiter(ASeparators, AValue, AChPos) do Dec(AChPos);
end;

//function GMFirstLine(const Value: TGMString): TGMString;
//const cLineBreaks = #10#13;
//var i: LongInt;
//begin
//i:=1;
//while (i <= Length(Value)) and not GMIsDelimiter(cLineBreaks, Value, i) do Inc(i);
//Result := Copy(Value, 1, i-1);
//end;

function GMFirstWord(const Value: TGMString; const Separators: TGMString; const SkipLeadingSeparators: Boolean): TGMString;
var chPos: PtrInt;
begin
  chPos := 1;
  Result := GMNextWord(chPos, Value, Separators, SkipLeadingSeparators);
end;

function GMLastWord(const Value: TGMString; const Separators: TGMString; const ASkipTrailingSeparators: Boolean): TGMString;
var chPos: PtrInt;
begin
  chPos := Length(Value);
  Result := GMPreviousWord(chPos, Value, Separators, ASkipTrailingSeparators);
end;

function GMNThWord(const Value: TGMString; const WordNummber: Word; const Separators: TGMString): TGMString;
var i, chPos: PtrInt;
begin
  chPos := 1; Result := '';
  for i:=1 to WordNummber do Result := GMNextWord(chPos, Value, Separators, True);
end;

function GMWordCount(const AText, ASeparators: TGMString): LongInt;
var token: TGMString; chPos: PtrInt;
begin
  Result := 0; chPos := 1;
  token := GMNextWord(chPos, AText, ASeparators);
  while Length(token) > 0 do
   begin
    Inc(Result);
    token := GMNextWord(chPos, AText, ASeparators);
   end;
end;

function GMIsDigitA(ACh: AnsiChar): Boolean;
begin
  Result := (ACh >= '0') and (ACh <= '9');
end;

function GMIsDigit(ACh: TGMChar): Boolean;
begin
  Result := (ACh >= '0') and (ACh <= '9');
end;

function GMIsLetter(ACh: TGMChar): Boolean;
begin
  Result := ((ACh >= 'A') and (ACh <= 'Z')) or ((ACh >= 'a') and (ACh <= 'z'));
end;

function GMMakeDezInt(const AValue: TGMString; const ADefaultValue: Int64): TGMString;
var isSigned: Boolean; chPos: PtrInt;
begin
  chPos := 1;
  while (chPos <= Length(AValue)) and GMIsDelimiter(cWhiteSpace, AValue, chPos) do Inc(chPos);
  isSigned := (chPos <= Length(AValue)) and (AValue[chPos] = '-');
  Result := GMDeleteChars(AValue, cStrDigits, True);
  if Result = '' then Result := GMIntToStr(ADefaultValue)
   else if isSigned then Result := '-' + Result;
end;

function GMMakeFloat(const AValue: TGMString; const ADefaultValue: Double = 0): TGMString;
var isSigned: Boolean; chPos: PtrInt;
begin
  chPos := 1;
  while (chPos <= Length(AValue)) and GMIsDelimiter(cWhiteSpace, AValue, chPos) do Inc(chPos);
  isSigned := (chPos <= Length(AValue)) and (AValue[chPos] = '-');
  Result := GMDeleteChars(AValue, cStrDigits + '.,', True);
  if Result = '' then Result := GMDoubleToStr(ADefaultValue)
   else if isSigned then Result := '-' + Result;
end;

{function GMStrip(const AValue: TGMString; const AChars: TGMString; const ANotStripChars: Boolean): TGMString;
begin
  Result := AValue;

  if ANotStripChars then
   begin
    while (Length(Result) > 0) and not GMIsDelimiter(AChars, Result, 1) do System.Delete(Result, 1, 1);
    while (Length(Result) > 0) and not GMIsDelimiter(AChars, Result, Length(Result)) do System.Delete(Result, Length(Result), 1);
   end
  else
   begin
    while (Length(Result) > 0) and GMIsDelimiter(AChars, Result, 1) do System.Delete(Result, 1, 1);
    while (Length(Result) > 0) and GMIsDelimiter(AChars, Result, Length(Result)) do System.Delete(Result, Length(Result), 1);
   end;
end;}

function GMTrimLeftA(const AValue: AnsiString; AChar: AnsiChar): AnsiString;
var pStart: PAnsiChar; startIdx: Integer;
begin
  pStart := GMStrCLScanA(PAnsiChar(AValue), AChar, Length(AValue));
  if pStart = nil then Result := '' else
   begin
    startIdx := pStart - PAnsiChar(AValue);
    if startIdx = 0 then Result := AValue else
       Result := Copy(AValue, startIdx + 1, Length(AValue) - startIdx);
   end;
end;

function GMTrimLeftW(const AValue: UnicodeString; AChar: WideChar): UnicodeString;
var pStart: PWideChar; startIdx: Integer;
begin
  pStart := GMStrCLScanW(PWideChar(AValue), AChar, Length(AValue));
  if pStart = nil then Result := '' else
   begin
    startIdx := pStart - PWideChar(AValue);
    if startIdx = 0 then Result := AValue else
       Result := Copy(AValue, startIdx + 1, Length(AValue) - startIdx);
   end;
end;

function GMTrimLeft(const AValue: TGMString; AChar: TGMChar): TGMString;
begin
  {$IFDEF UNICODE}
  Result := GMTrimLeftW(AValue, AChar);
  {$ELSE}
  Result := GMTrimLeftA(AValue, AChar);
  {$ENDIF}
end;

function GMTrimRightA(const AValue: AnsiString; AChar: AnsiChar): AnsiString;
var pEnd: PAnsiChar;
begin
  if Length(AValue) <= 0 then Result := AValue else
   begin
    pEnd := GMStrCRLScanA(PAnsiChar(AValue) + Length(AValue)-1, AChar, Length(AValue));
    if pEnd = nil then Result := ''
    else
    if pEnd = @AValue[Length(AValue)] then Result := AValue else
       Result := Copy(AValue, 1, pEnd - PAnsiChar(AValue) + 1);
   end;
end;

function GMTrimRightW(const AValue: UnicodeString; AChar: WideChar): UnicodeString;
var pEnd: PWideChar;
begin
  if Length(AValue) <= 0 then Result := AValue else
   begin
    pEnd := GMStrCRLScanW(PWideChar(AValue) + Length(AValue)-1, AChar, Length(AValue));
    if pEnd = nil then Result := ''
    else
    if pEnd = @AValue[Length(AValue)] then Result := AValue else
       Result := Copy(AValue, 1, pEnd - PWideChar(AValue) + 1);
   end;
end;

function GMTrimRight(const AValue: TGMString; AChar: TGMChar): TGMString;
begin
  {$IFDEF UNICODE}
  Result := GMTrimRightW(AValue, AChar);
  {$ELSE}
  Result := GMTrimRightA(AValue, AChar);
  {$ENDIF}
end;

function GMTrim(const AStr: TGMString; AChar: TGMChar = ' '): TGMString;
begin
  Result := GMTrimLeft(GMTrimRight(AStr, AChar), AChar);
end;

function GMStrip(const AValue: TGMString; const AChars: TGMString; const ANotStripChars: Boolean): TGMString;
var l, r, len: Integer;
begin
  len := Length(AValue); l := 1; r := len;
  if ANotStripChars then
   begin
    while (l <= len) and not GMIsDelimiter(AChars, AValue, l) do Inc(l);
    while (r >= l) and not GMIsDelimiter(AChars, AValue, r) do Dec(r);
   end
  else
   begin
    while (l <= len) and GMIsDelimiter(AChars, AValue, l) do Inc(l);
    while (r >= l) and GMIsDelimiter(AChars, AValue, r) do Dec(r);
   end;

  // if nothing has to be rmoved from the string, then return AValue directly to avoid copying of content
  if (l = 1) and (r = len) then Result := AValue else Result := Copy(AValue, l, r-l+1);
end;

function GMStripRight(const AValue: TGMString; const AChars: TGMString): TGMString;
var r: Integer;
begin
  r := Length(AValue);
  while (r >= 1) and GMIsDelimiter(AChars, AValue, r) do Dec(r);
  // if nothing has to be rmoved from the string, then return AValue directly to avoid copying of content
  if r = Length(AValue) then Result := AValue else Result := Copy(AValue, 1, r);
end;

function GMStripLeft(const AValue: TGMString; const AChars: TGMString): TGMString;
var l, len: Integer;
begin
  len := Length(AValue); l := 1;
  while (l <= len) and GMIsDelimiter(AChars, AValue, l) do Inc(l);
  // if nothing has to be rmoved from the string, then return AValue directly to avoid copying of content
  if l = 1 then Result := AValue else Result := Copy(AValue, l, len-l+1);
end;

function GMReplaceChars(const AValue: TGMString; const AFindChars, AReplacements: TGMString): TGMString;
var i, chPos: Integer; pCh: PGMChar;
begin
  Result := AValue;
  for i:=1 to Length(Result) do
   begin
    //chPos := Pos();
    pCh := GMStrLScan(PGMCHar(AFindChars), Result[i], Length(AFindChars));
    if pCh = nil then Continue;
    chPos := pCh - PGMChar(AFindChars) + 1;
    if chPos <= Length(AReplacements) then Result[i] := AReplacements[chPos];
   end;
end;

function GMTerminateStr(const AStr: TGMString; const ATermination: TGMString): TGMString;
var lastCh: TGMChar;
begin
  Result := AStr;
  if Length(Result) = 0 then Exit;
  lastCh := Result[Length(Result)];

  if lastCh = cChDontTerm then
   begin
    System.Delete(Result, Length(Result), 1);
    Exit;
   end;

  if (Length(Result) >= Length(ATermination))
     and not GMSameText(Copy(AStr, Length(AStr) - Length(ATermination) + 1, Length(ATermination)), ATermination)
     and (lastCh <> '.') and (lastCh <> '?') and (lastCh <> '!') and (lastCh <> cChDontTerm)
   then Result := Result + ATermination;
end;

function GMDeleteChars(const Value: TGMString; const ADelChars: TGMString; const ANotDelChars: Boolean = False): TGMString;
var i: PtrInt;
begin
  Result := Value;
  i:=1;
  if ANotDelChars then
   while i<= Length(Result) do if not GMIsDelimiter(ADelChars, Result, i) then System.Delete(Result, i, 1) else Inc(i)
  else
   while i<= Length(Result) do if GMIsDelimiter(ADelChars, Result, i) then System.Delete(Result, i, 1) else Inc(i);
end;

function GMDeleteCharsA(const AValue: AnsiString; const ADelChars: AnsiString; const ANotDelChars: Boolean = False): AnsiString;
var i: PtrInt;
begin
  Result := AValue;
  i:=1;
  if ANotDelChars then
   while i<= Length(Result) do if not GMIsDelimiterA(ADelChars, Result, i) then System.Delete(Result, i, 1) else Inc(i)
  else
   while i<= Length(Result) do if GMIsDelimiterA(ADelChars, Result, i) then System.Delete(Result, i, 1) else Inc(i);
end;

function GMIsDelimiterA(const ADelimiters, AValue: AnsiString; AIndex: PtrInt): Boolean;
begin
  if (AIndex <= 0) or (AIndex > Length(AValue)) then begin Result := False; Exit; end;
  Result := GMStrLScanA(PAnsiChar(ADelimiters), AValue[AIndex], Length(ADelimiters)) <> nil;
end;

function GMIsDelimiterW(const ADelimiters, AValue: UnicodeString; AIndex: PtrInt): Boolean;
begin
  if (AIndex < 1) or (AIndex > Length(AValue)) then begin Result := False; Exit; end;
  Result := GMStrLScanW(PWideChar(ADelimiters), AValue[AIndex], Length(ADelimiters)) <> nil;
end;

function GMIsDelimiter(const ADelimiters, Value: TGMString; Index: PtrInt): Boolean;
begin
  {$IFDEF UNICODE}
  Result := GMIsDelimiterW(ADelimiters, Value, Index);
  {$ELSE}
  Result := GMIsDelimiterA(ADelimiters, Value, Index);
  {$ENDIF}
end;

function GMLastDelimiter(const ADelimiters, AValue: TGMString): PtrInt;
begin
  for Result := Length(AValue) downto 1 do if GMStrLScan(PGMChar(ADelimiters), AValue[Result], Length(ADelimiters)) <> nil then Exit;
  Result := 0;
end;

function GMIsNumber(const AValue: TGMString): Boolean;
var i: PtrInt;
begin
  for i:=1 to Length(AValue) do if not GMIsDigit(AValue[i]) then begin Result := False; Exit; end;
  Result := Length(AValue) > 0;
end;

//function IsNumber(const ANumVal: TGMString): Boolean;
//var chPos: Integer;
//begin
//for chPos:=1 to Length(ANumVal) do
// if not GMIsdelimiter(cStrDigits, ANumVal, chPos) then begin Result := False; Exit; end;
//
//Result := Length(ANumVal) > 0;
//end;

function GMHashCodeFromString(const AValue: TGMString): TGMHashCode;
var i: LongInt; pb: PByte;
begin
  Result := 0;
  pb := Pointer(PGMChar(AValue));
  for i:=1 to Length(AValue) * SizeOf(TGMChar) do
   begin
    Result := Result + (pb^ * (i - 1) * 256);
//  Result := Result + (Ord(AValue[i]) * (i - 1) * 256);
//  Result := Result shl 5 + Ord(HashString[i]) + Result;
    Inc(pb);
   end;
end;

//function HashOf(const key: string): cardinal;
//asm
//xor edx,edx     { Result := 0 }
//and eax,eax     { test if 0 }
//jz @End         { skip if nil }
//mov ecx,[eax-4] { ecx := string length }
//jecxz @End      { skip if length = 0 }
//@loop:            { repeat }
//rol edx,2       { edx := (edx shl 2) or (edx shr 30)... }
//xor dl,[eax]    { ... xor Ord(key[eax]) }
//inc eax         { inc(eax) }
//loop @loop      { until ecx = 0 }
//@End:
//mov eax,edx     { Result := eax }
//end;

{function HashOf(const key: string): cardinal;
var
  I: integer;
begin
  Result := 0;
  for I := 1 to length(key) do
  begin
    Result := (Result shl 5) or (Result shr 27);
    Result := Result xor Cardinal(key[I]);
  end;
end;}


function GMInsertEscapeChars(const AValue: TGMString): TGMString;
var srcChIdx, dstChIdx, k, n: PtrInt; leadingBlank: Boolean; // startTicks: QWord;
  procedure AppendDestCh(ACh: TGMChar);
  //var newLen: PtrInt;
  begin
    if (Length(Result)) < dstChIdx then SetLength(Result, Length(Result) + Max(Round(Length(Result) * 0.2), 64));
     //begin
     // newLen := Length(Result) + Max(Round(Length(Result) * 0.2), 64);
     // SetLength(Result, newLen);
     //end;

    Result[dstChIdx] := ACh;
    Inc(dstChIdx);
  end;
begin
  //
  // Don't escape all blanks, only leading and trailing blanks.
  //
  //startTicks := GetTickCount64();
  SetLength(Result, Round(Length(AValue) * 1.3));
  dstChIdx := 1; leadingBlank := True;
  for srcChIdx:=1 to Length(AValue) do
   begin
    case AValue[srcChIdx] of
     ' ': if leadingBlank then
           begin AppendDestCh('\'); AppendDestCh('s'); end
          else
           AppendDestCh(AValue[srcChIdx]);

     #9:  begin AppendDestCh('\'); AppendDestCh('t'); leadingBlank := False; end;
     #10: begin AppendDestCh('\'); AppendDestCh('n'); leadingBlank := False; end;
     #13: begin AppendDestCh('\'); AppendDestCh('r'); leadingBlank := False; end;
     '\': begin AppendDestCh('\'); AppendDestCh('\'); leadingBlank := False; end;
     else begin AppendDestCh(AValue[srcChIdx]); leadingBlank := False; end;
    end;
   end;

  //
  // Escape trailing blanks, they may be stripped or ignored otherwise
  //
  srcChIdx := dstChIdx-1;
  while (srcChIdx >= 1) and (Result[srcChIdx] = ' ') do Dec(srcChIdx);
  if srcChIdx < dstChIdx-1 then
   begin
    n := dstChIdx-1;
    Dec(dstChIdx, dstChIdx-srcChIdx-1);
    for k:=srcChIdx+1 to n do begin AppendDestCh('\'); AppendDestCh('s'); end;
   end;

  SetLength(Result, dstChIdx-1);
  //vfGMTrace(GMFormat('GMInsertEscapeChars: %d [ms]', [GetTickCount64() - startTicks]), 'SAVE');
end;

//function GMInsertEscapeChars(const AValue: TGMString): TGMString;
//var i: PtrInt; startTicks: QWord;
//begin
//  startTicks := GetTickCount64();
//  Result := '';
//  for i:=1 to Length(AValue) do
//   begin
//    case AValue[i] of
//     //' ': begin Result[i] := '\'; System.Insert('s', Result, i+1); Inc(i); end; // <- i will be incremented another time below!
//     #9:  Result += '\t'; // begin Result[i] := '\'; System.Insert('t', Result, i+1); Inc(i); end; // <- i will be incremented another time below!
//     #10: Result += '\n'; // begin Result[i] := '\'; System.Insert('n', Result, i+1); Inc(i); end; // <- i will be incremented another time below!
//     #13: Result += '\r'; // begin Result[i] := '\'; System.Insert('r', Result, i+1); Inc(i); end; // <- i will be incremented another time below!
//     '\': Result += '\\'; // begin System.Insert('\', Result, i); Inc(i); end; // <- i will be incremented another time below!
//     else Result += AValue[i];
//    end;
//   end;
//  vfGMTrace(GMFormat('GMInsertEscapeChars: %d [ms]', [GetTickCount64() - startTicks]), 'SAVE');
//end;

//function GMInsertEscapeChars(const AValue: TGMString): TGMString;
//var i: PtrInt; startTicks: QWord;
//begin
//  startTicks := GetTickCount64();
//  Result := AValue;
//  //
//  // Don't escape all blanks, only leading and trailing blanks (-> done below)
//  //
//  i:=1;
//  while i <= Length(Result) do
//   begin
//    case Result[i] of
//     //' ': begin Result[i] := '\'; System.Insert('s', Result, i+1); Inc(i); end; // <- i will be incremented another time below!
//     #9:  begin Result[i] := '\'; System.Insert('t', Result, i+1); Inc(i); end; // <- i will be incremented another time below!
//     #10: begin Result[i] := '\'; System.Insert('n', Result, i+1); Inc(i); end; // <- i will be incremented another time below!
//     #13: begin Result[i] := '\'; System.Insert('r', Result, i+1); Inc(i); end; // <- i will be incremented another time below!
//     '\': begin System.Insert('\', Result, i); Inc(i); end; // <- i will be incremented another time below!
//    end;
//    Inc(i);
//   end;
//
//  //
//  // Escape trailing blanks, they may be stripped or ignored otherwise
//  //
//  i := Length(Result);
//  while (i >= 1) and (Result[i] = ' ') do
//   begin
//    Result[i] := '\'; System.Insert('s', Result, i+1);
//    Dec(i);
//   end;
//
//  //
//  // Escape leading blanks, they may be stripped or ignored otherwise
//  //
//  i:=1;
//  while (i <= Length(Result)) and (Result[i] = ' ') do
//   begin
//    Result[i] := '\';
//    System.Insert('s', Result, i+1);
//    Inc(i, 2);
//   end;
//  vfGMTrace(GMFormat('GMInsertEscapeChars: %d [ms]', [GetTickCount64() - startTicks]), 'SAVE');
//end;

function StrExerpt(const AValue: TGMString; const AMaxLen: PtrInt): TGMString;
begin
  if (AMaxLen > 0) and (Length(AValue) > AMaxLen) then Result := Copy(AValue, 1, AMaxLen) + cStr_More
  else Result := AValue;
end;

function GMResolveEscapeChars(const AValue: TGMString; const ACaller: TObject): TGMString;
var srcChIdx, dstChIdx: PtrInt; ch, prevCh: TGMChar; // startTicks: QWord;
begin
  //startTicks := GetTickCount64();
  dstChIdx := 1;
  SetLength(Result, Length(AValue));
  prevCh := #0;
  for srcChIdx:=1 to Length(AValue) do
   begin
    ch := AValue[srcChIdx];
    if prevCh <> '\' then
     begin
      if ch <> '\' then begin Result[dstChIdx] := ch; Inc(dstChIdx); end;
     end
    else
     case ch of
      's': begin Result[dstChIdx] := ' '; Inc(dstChIdx); end;
      't': begin Result[dstChIdx] := #9; Inc(dstChIdx); end;
      'n': begin Result[dstChIdx] := #10; Inc(dstChIdx); end;
      'r': begin Result[dstChIdx] := #13; Inc(dstChIdx); end;
      '"': begin Result[dstChIdx] := '"'; Inc(dstChIdx); end;
      '\': begin Result[dstChIdx] := '\'; ch := #0; Inc(dstChIdx); end;
      else raise EGMException.ObjError(GMFormat(RStrInvalidESCSequenceFmt, ['' + prevCh + ch, StrExerpt(AValue, 4096), srcChIdx-1]), ACaller, 'GMResolveEscapeChars'); // Inc(i);
     end;
    prevCh := ch;
   end;
  SetLength(Result, dstChIdx-1);
  //vfGMTrace(GMFormat('GMResolveEscapeChars: %d [ms]', [GetTickCount64() - startTicks]), 'LOAD');
end;

//function GMResolveEscapeChars(const AValue: TGMString; const ACaller: TObject): TGMString;
//var i: PtrInt; ch, prevCh: TGMChar; // startTicks: QWord;
//begin
//  //startTicks := GetTickCount64();
//  i:=1; Result := AValue; prevCh := #0;
//  while i <= Length(Result) do
//   begin
//    ch := Result[i];
//    if prevCh <> '\' then Inc(i) else
//     case ch of
//      's': begin Result[i-1] := ' '; System.Delete(Result, i, 1); end; // <- No increment here!
//      't': begin Result[i-1] := #9; System.Delete(Result, i, 1); end; // <- No increment here!
//      'n': begin Result[i-1] := #10; System.Delete(Result, i, 1); end; // <- No increment here!
//      'r': begin Result[i-1] := #13; System.Delete(Result, i, 1); end; // <- No increment here!
//      '\': begin System.Delete(Result, i, 1); ch := #0; end; // <- No increment here!
//      else raise EGMException.ObjError(GMFormat(RStrInvalidESCSequenceFmt, ['' + prevCh + ch, AValue, i-1]), ACaller, 'GMResolveEscapeChars'); // Inc(i);
//     end;
//    prevCh := ch;
//   end;
//  //vfGMTrace(GMFormat('GMResolveEscapeChars: %d [ms]', [GetTickCount64() - startTicks]), 'LOAD');
//end;

//function GMInsertQuotedStrEscChars(const AValue: TGMString): TGMString;
//var i: PtrInt;
//begin
//  i:=1; Result := AValue;
//  while i <= Length(Result) do
//   begin
//    case Result[i] of
//     //' ': begin Result[i] := '\'; System.Insert('s', Result, i+1); Inc(i); end; // <- i will be incremented another time below!
//     #9:  begin Result[i] := '\'; System.Insert('t', Result, i+1); Inc(i); end; // <- i will be incremented another time below!
//     #10: begin Result[i] := '\'; System.Insert('n', Result, i+1); Inc(i); end; // <- i will be incremented another time below!
//     #13: begin Result[i] := '\'; System.Insert('r', Result, i+1); Inc(i); end; // <- i will be incremented another time below!
//     '\', '"': begin System.Insert('\', Result, i); Inc(i); end; // <- i will be incremented another time below!
//    end;
//    Inc(i);
//   end;
//end;


function GMInsertQuotedStrEscChars(const AValue: TGMString): TGMString;
var srcChIdx, dstChIdx: PtrInt; // leadingBlank: Boolean; // startTicks: QWord;
  procedure AppendDestCh(ACh: TGMChar);
  //var newLen: PtrInt;
  begin
    if (Length(Result)) < dstChIdx then SetLength(Result, Length(Result) + Max(Round(Length(Result) * 0.2), 64));
     //begin
     // newLen := Length(Result) + Max(Round(Length(Result) * 0.2), 64);
     // SetLength(Result, newLen);
     //end;

    Result[dstChIdx] := ACh;
    Inc(dstChIdx);
  end;
begin
  //startTicks := GetTickCount64();
  SetLength(Result, Round(Length(AValue) * 1.3));
  dstChIdx := 1;
  for srcChIdx:=1 to Length(AValue) do
   begin
    case AValue[srcChIdx] of
     //' ': if leadingBlank then
     //      begin AppendDestCh('\'); AppendDestCh('s'); end
     //     else
     //      AppendDestCh(AValue[srcChIdx]);

     #9:  begin AppendDestCh('\'); AppendDestCh('t'); end;
     #10: begin AppendDestCh('\'); AppendDestCh('n'); end;
     #13: begin AppendDestCh('\'); AppendDestCh('r'); end;
     '"': begin AppendDestCh('\'); AppendDestCh('"'); end;
     '\': begin AppendDestCh('\'); AppendDestCh('\'); end;
     else begin AppendDestCh(AValue[srcChIdx]); end;
    end;
   end;

  SetLength(Result, dstChIdx-1);
  //vfGMTrace(GMFormat('GMInsertEscapeChars: %d [ms]', [GetTickCount64() - startTicks]), 'SAVE');
end;


function GMResolveQuotedStrEscChars(const AValue: TGMString; const ACaller: TObject): TGMString;
begin
  Result := GMResolveEscapeChars(AValue, ACaller);
end;

//function GMResolveQuotedStrEscChars(const AValue: TGMString; const ACaller: TObject): TGMString;
//var i: PtrInt; ch, prevCh: TGMChar;
//begin
//  i:=1; Result := AValue; prevCh := #0;
//  while i <= Length(Result) do
//   begin
//    ch := Result[i];
//    if prevCh <> '\' then Inc(i) else
//     case ch of
//      //'s': begin Result[i-1] := ' '; System.Delete(Result, i, 1); end; // <- No increment here!
//      't': begin Result[i-1] := #9; System.Delete(Result, i, 1); end; // <- No increment here!
//      'n': begin Result[i-1] := #10; System.Delete(Result, i, 1); end; // <- No increment here!
//      'r': begin Result[i-1] := #13; System.Delete(Result, i, 1); end; // <- No increment here!
//      '\': begin System.Delete(Result, i, 1); ch := #0; end; // <- No increment here!
//      '"': begin System.Delete(Result, i-1, 1); ch := #0; end; // <- No increment here!
//      else raise EGMException.ObjError(GMFormat(RStrInvalidESCSequenceFmt, ['' + prevCh + ch, AValue, i-1]), ACaller, 'GMResolveQuotedStrEscChars'); // Inc(i);
//     end;
//    prevCh := ch;
//   end;
//end;


type
  PNewLineDataRec = ^TNewLineDataRec;
  TNewLineDataRec = record
    Value, NewLineStr: TGMString;
  end;

function AppendSingleLine(const ALine: TGMString; const ALastLine: Boolean; const AData: Pointer): Boolean;
begin
  if AData = nil then begin Result := False; Exit; end;
//PNewLineDataRec(AData).Value := GMStringJoin(PNewLineDataRec(AData).Value, PNewLineDataRec(AData).NewLineStr, ALine);
  if Length(PNewLineDataRec(AData).Value) <= 0 then PNewLineDataRec(AData).Value := ALine else
     PNewLineDataRec(AData).Value := PNewLineDataRec(AData).Value + PNewLineDataRec(AData).NewLineStr + ALine;

  Result := True;
end;

function GMMakeSingleLine(const AValue: TGMString; const ANewLineStr: TGMString; const AEmitEmptyLines: Boolean): TGMString;
var newLineData: TNewLineDataRec;
begin
  newLineData.NewLineStr := ANewLineStr;
  newLineData.Value := '';
  GMBreakLines(AValue, AppendSingleLine, @newLineData, AEmitEmptyLines);
  Result := newLineData.Value;
end;

function GMReduceWhiteSpace(const AValue: TGMString): TGMString;
var chPos: PtrInt;
begin
  Result := GMStrip(AValue);
  chPos := 1;
  while (chPos <= Length(Result)) do
   if GMIsDelimiter(cWhiteSpace, Result, chPos) and (chPos < Length(Result)) and
      GMIsDelimiter(cWhiteSpace, Result, chPos + 1) then System.Delete(Result, chPos + 1, 1) else Inc(chPos);
end;

//function GMMakeSingleLine(const Value: TGMString; const NewLineStr: TGMString): TGMString;
//var chPos: PtrInt; NewLine: Boolean;
//begin
//chPos := 1;
//Result := Value;
//while chPos <= Length(Result) do
// if GMIsDelimiter(cWhiteSpace, Result, chPos) then
//  begin
//   NewLine := False;
//   while GMIsDelimiter(cWhiteSpace, Result, chPos) and (chPos <= Length(Result)) do
//    begin
//     NewLine := NewLine or (Result[chPos] in [#10, #13]);
//     System.Delete(Result, chPos, 1);
//    end;
//
//   if chPos <= Length(Result) then
//    begin
//     if NewLine then begin Insert(NewLineStr, Result, chPos); Inc(chPos, Length(NewLineStr)); end;
//     Insert(' ', Result, chPos);
//     Inc(chPos);
//    end;
//  end
// else Inc(chPos);
//end;

//function GMFullLineBreaks(const Value: TGMString): TGMString;
//var i: LongInt;
//begin
//  Result := Value; i:=1;
//  while i <= Length(Result) do
//   begin
//    if Result[i] = #10 then if (i <= 1) or (Result[i-1] <> #13) then begin Insert(#13, Result, i); Inc(i); end;
//    Inc(i);
//   end;
//end;

//function GMInsertXMLLineBreaks(const Value: TGMString): TGMString;
//const cNewLine = #13#10; CXMLTrail = '</'; CXMLSingle = '/>';
//var chPos: PtrInt; // Start: DWORD; InsCount: LongInt;
//begin
//  //Start := GetTickCount; InsCount := 0;
//  Result := Value;
//  chPos:=1;
//  while GMFindToken(Result, CXMLTrail, chPos, '', False) do
//   begin
//    Inc(chPos, Length(CXMLTrail));
//    while (chPos <= Length(Result)) and (Result[chPos] <> '>') do Inc(chPos);
//    if chPos <= Length(Result) then begin Insert(cNewLine, Result, chPos+1); Inc(chPos, Length(cNewLine) + 1); end; // Inc(InsCount);
//   end;
//  chPos:=1;
//  while GMFindToken(Result, CXMLSingle, chPos, '', False) do
//   begin
//    Inc(chPos, Length(CXMLSingle));
//    if chPos <= Length(Result) then begin Insert(cNewLine, Result, chPos); Inc(chPos, Length(cNewLine)); end; // Inc(InsCount);
//   end;
//  //vfGMMEssageBox(GMFormat('ms: %d, Insertions: %d', [GetTickCount - Start, InsCount]));
//end;

function GMInsertXMLLineBreaks(const AValue: TGMString): TGMString;
const chStart: TGMChar = '<'; chEnd: TGMChar = '>';
type TXmlTokenKind = (tkStart, tkSingle, tkEnd);
var tokenKind, lastTokenKind: TXmlTokenKind; chPos, lastchPos: PtrInt; pCh: PGMChar; //Start: DWORD;

  procedure _InsertNewLine(AChPos: LongInt);
  begin
    Inc(AChPos); // <- switch from zero base to one base!
    //if (Ord(Result[AChPos]) > 255) or not (AnsiChar(Result[AChPos]) in [#10, #13]) then
    //if AChPos <= Length(Result) then
    case Result[AChPos] of
      #10, #13: ; // <- Nothing!
      else begin Insert(cNewLine, Result, AChPos); Inc(chPos, Length(cNewLine)); Inc(lastChPos, Length(cNewLine)); end;
    end;
  end;

begin
  //Start := GetTickCount;
  Result := AValue;
  if Length(Result) <= 0 then Exit;

  lastTokenKind := tkSingle;
  chPos := 0; lastChPos := 0;
  repeat
   tokenKind := tkStart;
   pCh := GMStrLScan(PGMChar(Result) + chPos, chStart, Length(Result) - chPos);
   if pCh = nil then Break;

   if (pCh - PGMChar(Result) + 1 < Length(Result)) then
    begin
     if ((pCh + 1)^ = '/') then tokenKind := tkEnd;
     pCh := GMStrLScan(pCh + 1, chEnd, PGMChar(Result) + Length(Result) - pCh - 1);
     if pCh = nil then Break;

     if (pCh - 1)^ = '/' then tokenKind := tkSingle;
    end;

   chPos := pCh - PGMChar(Result) + 1;

   if chPos >= Length(Result) then Break;

   case tokenKind of
    tkStart:  if lastTokenKind = tkStart then _InsertNewLine(lastChPos);
    tkSingle: if lastTokenKind in [tkEnd, tkSingle] then _InsertNewLine(chPos);
    tkEnd:    _InsertNewLine(chPos);
   end;
   lastChPos := chPos;
   lastTokenKind := tokenKind;
  until False; // chPos >= Length(Result);
  //vfGMMEssageBox(IntToStr(GetTickCount - Start));
end;

function GMCompareVersions(const AVersionA, AVersionB: TGMString): TGMCompareResult;
const //cResult: array [Boolean] of TGMCompareResult = (crALessThanB, crAEqualToB);
      cVerSep = '.'; LowVer = Low(LongInt);
var ChPA, ChPB, SegNoA, SegNoB: PtrInt;
begin
  ChPA := 1; ChPB := 1;
  repeat
   SegNoA := GMStrToInt(GMMakeDezInt(GMNextWord(ChPA, AVersionA, cVerSep, False), LowVer));
   SegNoB := GMStrToInt(GMMakeDezInt(GMNextWord(ChPB, AVersionB, cVerSep, False), LowVer));
  until (SegNoA <> SegNoB) or (SegNoA = LowVer) or (SegNoB = LowVer);
  if SegNoA < SegNoB then Result := crALessThanB else
  if SegNoA > SegNoB then Result := crAGreaterThanB else Result := crAEqualToB;
end;

function GMFixedEncodeDateTime(const AValue: TDateTime): TGMString;
var hasDate, hasTime: Boolean;
begin
  hasDate := Trunc(AValue) <> 0.0;
  hasTime := Frac(AValue) <> 0.0;
  if hasDate and hasTime then Result := FormatDateTime(cStrFixedDateTimeFmt, AValue)
  else
  if hasDate then Result := FormatDateTime(cStrFixedDateFmt, AValue)
  else
  Result := FormatDateTime(cStrFixedTimeFmt, AValue)
end;

function GMFixedDecodeDateTime(const AValue: TGMString): TDateTime;
var chPos: PtrInt; tmp, day, month, year, hour, minute, second, milliSec: LongInt;
  function NextNumber(var AchPos: PtrInt; const AValue: TGMString): LongInt;
//const cDigits = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'];
  var startPos: LongInt;
  begin
    while (AChPos <= Length(AValue)) and ((AValue[AChPos] < '0') or (AValue[AChPos] > '9')) do Inc(AChPos);
    startPos := AChPos;
    while (AChPos <= Length(AValue)) and (AValue[AChPos] >= '0') and (AValue[AChPos] <= '9') do Inc(AChPos);
    Result := GMStrToInt(GMMakeDezInt(Copy(AValue, startPos, AChPos - startPos)));
  end;

  procedure SetAllZero(AFirstValue: Integer);
  begin
    day := 0; month := 0; year := AFirstValue; hour := 0; minute := 0; second := 0; milliSec := 0;
  end;  

  procedure ReadDate(AFirstValue: Integer);
  begin
    if AFirstValue >= 0 then day := AFirstValue else day := NextNumber(chPos, AValue);
    month := NextNumber(chPos, AValue);
    year := NextNumber(chPos, AValue);
  end;

  procedure ReadTime(AFirstValue: Integer);
  begin
    if AFirstValue >= 0 then hour := AFirstValue else hour := NextNumber(chPos, AValue);
    minute := NextNumber(chPos, AValue);
    second := NextNumber(chPos, AValue);
    milliSec := NextNumber(chPos, AValue);
  end;
begin
  chPos := 1;
  tmp := NextNumber(chPos, AValue);
  while (chPos <= Length(AValue)) and GMIsDelimiter(cWhiteSpace, AValue, chPos) do Inc(chPos); // ((AValue[chPos] = ' ') or (AValue[chPos] = #9) or (AValue[chPos] = #10) or (AValue[chPos] = #13))

  if chPos > Length(AValue) then begin SetAllZero(tmp); end
  else
  if AValue[chPos] = cStrFixedDateSep then begin ReadDate(tmp); ReadTime(-1); end
  else
  if AValue[chPos] = cStrFixedTimeSep then begin ReadTime(tmp); day := 0; month := 0; year := 0; end
  else
  SetAllZero(tmp);

  if (year = 0) and (month = 0) and (day = 0) then Result := 0 else Result := EncodeDate(year, month, day);

  if Result >= 0 then
    Result := Result + EncodeTime(hour, minute, second, milliSec)
  else
    Result := Result - EncodeTime(hour, minute, second, milliSec);
end;

{function GMFixedDecodeDateTime(const AValue: TGMString): TDateTime;
var chPos, day, month, year, hour, minute, second, milliSec: LongInt;
  function NextNumber(var AchPos: PtrInt; const AValue: TGMString): LongInt;
//const cDigits = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'];
  var startPos: LongInt;
  begin
    while (AChPos <= Length(AValue)) and ((AValue[AChPos] < '0') or (AValue[AChPos] > '9')) do Inc(AChPos);
    startPos := AChPos;
    while (AChPos <= Length(AValue)) and (AValue[AChPos] >= '0') and (AValue[AChPos] <= '9') do Inc(AChPos);
    Result := GMStrToInt(GMMakeDezInt(Copy(AValue, startPos, AChPos - startPos)));
  end;
begin
  chPos := 1;
  day := NextNumber(chPos, AValue);
  month := NextNumber(chPos, AValue);
  year := NextNumber(chPos, AValue);
  hour := NextNumber(chPos, AValue);
  minute := NextNumber(chPos, AValue);
  second := NextNumber(chPos, AValue);
  milliSec := NextNumber(chPos, AValue);
  Result := EncodeDate(year, month, day);
  if Result >= 0 then
    Result := Result + EncodeTime(hour, minute, second, milliSec)
  else
    Result := Result - EncodeTime(hour, minute, second, milliSec);
end;}

function GMHasDateTimeFormat(const AValue, AFormat: TGMString): Boolean;
const cStrRoutineName = 'GMHasDateTimeFormat';
var fmtChPos, valChPos, startPos: PtrInt; dtp: TGMDateTimePart; valPart: TGMString; // , day, month, year, hour, minute, second, milliSec

//function NextNumber: TGMString;
//var startPos: Integer;
//begin
//  while (valChPos <= Length(AValue)) and not GMIsDelimiter(cStrDigits, AValue, valChPos) do Inc(valChPos);
//  startPos := valChPos;
//  while (valChPos <= Length(AValue)) and GMIsDelimiter(cStrDigits, AValue, valChPos) do Inc(valChPos);
//  Result := Copy(AValue, startPos, valChPos - startPos);
////  while (valChPos <= Length(AValue)) and not GMIsDelimiter(cStrDigits, AValue, valChPos) do Inc(valChPos);
//end;
begin
  Result := (Length(AValue) > 0) and (Length(AFormat) > 0);

  fmtChPos := 1; valChPos := 1; // day := 0; month := 0; year := 0; hour := 0; minute := 0; second := 0; milliSec := 0;
  while Result and (valChPos <= Length(AValue)) and (fmtChPos <= Length(AFormat)) do
   begin
    for dtp := Low(dtp) to High(dtp) do if GMSameText(Copy(AFormat, fmtChPos, Length(cDateTimeFmtPatterns[dtp])), cDateTimeFmtPatterns[dtp]) then Break;
    Inc(fmtChPos, Length(cDateTimeFmtPatterns[dtp]));


    case dtp of
     dtpDD, dtpMM, dtpYYYY, dtpYY, dtpHH, dtpNN, dtpSS:
      begin
       valPart := Copy(AValue, valChPos, Length(cDateTimeFmtPatterns[dtp]));
       Inc(valChPos, Length(cDateTimeFmtPatterns[dtp]));
       if not GMIsNumber(valPart) then begin Result := False; Exit; end; // <- NOTE: May Exit here!
      end;

     dtpHour, dtpMinute, dtpSecond, dtpDay, dtpMonth:
      begin
       startPos := valChPos;
       while (valChPos <= Length(AValue)) and GM