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

{$INCLUDE GMCompilerSettings.inc}

unit GMIntf;

interface

uses {$IFDEF JEDIAPI}jwaWinType, jwaWinError, jwaWinNT, jwaWinUser,{$ELSE}Windows,{$ENDIF} 
     GMStrDef ,GMActiveX, GMUnionValue, SysUtils, TypInfo;

const

  cDfltRoutineName = '';
  cStrFieldDataTypeName = 'TGMDBColumnDataType';
  CGMUnknownState = -1;
  CGMUnknownPosition = -1;
  cGMUnknownCount = -1;
  CInvalidEnumPos = High(LongInt);
  cCurrentStrmPos = -1;

  cDfltCoCeateContext = CLSCTX_SERVER;

  cDfltReadString = '';
  cDfltReadInteger = 0;
  cDfltReadBoolean = False;
  cDfltReadFloat = 0;
  cDfltReadDateTime = 0;

  cDfltCopyBufferSize = $10000; // <- 64 KB
  cDfltUiResponseMS = 400; // 330; // <- Milliseconds
  cFormatBufSize = 4096;

  cDfltCoInitFlags = COINIT_APARTMENTTHREADED; // COINIT_MULTITHREADED

  scSubNodesDirSeparator = '.';

  //cStrUnknown = '?';

  cCustomHrError: LongInt = LongInt($A0000000);

  cNewLine = #13#10;
  c2NewLine = cNewLine + cNewLine;


type

  {$IFNDEF JEDIAPI}
  {$IFNDEF FPC}
  {$IFDEF CPU64}
  PtrInt = Int64;
  PtrUInt = QWord;
  {$ELSE}
  PtrInt = LongInt;
  PtrUInt = LongWord;
  {$ENDIF}
  PPtrInt = ^PtrInt;
  PPtrUInt = ^PtrUInt;
  {$ENDIF}
  {$ENDIF}

  TGMCompareResult = (crALessThanB, crAEqualToB, crAGreaterThanB);
  TGMSeverityLevel = (svNone, svConfirmation, svInformation, svWarning, svError);
  //TGMSeverityLevel = svInformation .. svError;
  //TSeverityLevels = set of TGMSeverityLevelBase;

  TGMCharKind = (ckUnknown, ckAnsi, ckUtf8, ckUtf16LE, ckUtf16BE);
  EGMLineEndKind = (lekUnknown, lekCR, lekCRLF, lekLF, leLFCR);
  //TGMCharKind = (ckAnsi, ckUtf8, ckUtf16LE, jccISO_8859_1);


  TGMCheckRefCountProc = procedure(const ARefCount: LongInt; const AObj: TObject);

  PGMPtrIntArray = ^TGMPtrIntArray;
  TGMPtrIntArray = array of PtrInt;

  procedure GMAddIntegersToArray(var ADest: TGMPtrIntArray; const AValues: array of PtrInt);



  //
  // Optionally exported function of plugins to write their resource string PO files
  //

  type

    TDllWriteResStrPOFileProc = procedure (FileExtension: TApiString = ''; OutputFolder: TApiString = ''); stdcall;


  const

    cStrDllWriteResStrPOFileProcName = 'DllWriteResStrPOFile';


  { ------------------------------ }
  { ---- Type Safe Interfaces ---- }
  { ------------------------------ }

  type

  //
  // This generic prevents you from using a different (wrong) IID than the variable was declared for
  // TIntf is meant to be an interface type derived from IUnknown
  //
  RGMTypedIntf<TIntf> = record
   public
    Intf: TIntf;

    //class operator Implicit(const ATypedIntf: RGMTypedIntf<TIntf>): Pointer;
    //class operator Implicit(AValue: Pointer): RGMTypedIntf<TIntf>;
    class operator := (const ATypedIntf: RGMTypedIntf<TIntf>): TIntf;
    class operator := (AValue: IUnknown): RGMTypedIntf<TIntf>;
    class operator := (AObj: TObject): RGMTypedIntf<TIntf>;

    function QueryFrom(AIntf: IUnknown; ACheckResult: Boolean = False): Boolean;
    function GetFrom(AObj: TObject; ACheckResult: Boolean = False): Boolean;
    function Call(ACaller: TObject = nil): TIntf;
  end;


  { ----------------------- }
  { ---- String Arrays ---- }
  { ----------------------- }

  type

  PGMStringArray = ^TGMStringArray;
  TGMStringArray = array of TGMString;

  function GMStringArray(const AStrings: array of TGMString): TGMStringArray;
  procedure GMAddStrToArray(const AValue: TGMString; var AStringArray: TGMStringArray; const AAddEmptyStrings: Boolean = False);
  function GMStrArrayAsText(const AStrings: TGMStringArray; const ASeparator: TGMString = cNewLine): TGMString;
  function GMIndexOfStrInArray(const AValue: TGMString; const AStringArray: TGMStringArray): PtrInt;
  function GMFindStrInArray(const AValue: TGMString; const AStringArray: TGMStringArray; var AIdx: PtrInt): Boolean;
  procedure GMDeleteStrInArray(var AStringArray: TGMStringArray; const AIdx: PtrInt);


  { -------------------------------- }
  { ---- Thread synchronization ---- }
  { -------------------------------- }

  type

  IGMCriticalSection = interface(IUnknown)
    ['{278BDF06-1387-4181-A83D-8DDF4E18CE03}']
    procedure EnterCriticalSection;
    procedure LeaveCriticalSection;
    //function TryEnterCriticalSection: Boolean; 
  end;


  procedure GMEnterCriticalSection(const ACriticalSection: IUnknown);
  procedure GMLeaveCriticalSection(const ACriticalSection: IUnknown);


  { ----------------- }
  { ---- Objects ---- }
  { ----------------- }

  type
  //
  // Getting the object implementing an interface
  //
  IGMObjInfo = interface(IUnknown)
    ['{F8FF8365-3C8F-4730-B628-82280DCC75FB}']
    function GetClassName: TGMString;
    function GetClassType: TClass;
    function GetInstance: TObject;
    function GetTypeInfo: PTypeInfo; // <- will return nil unless class has been declared with $M+ compiler directive!
    property ClassName: TGMString read GetClassName;
    property ClassType: TClass read GetClassType;
    property Instance: TObject read GetInstance;
    property TypeInfo: PTypeInfo read GetTypeInfo;
  end;


  TGMHashCode = PtrInt;

  IGMHashCode = interface(IUnknown)
    ['{9C61B58B-41DF-4695-9716-AC4A343DC2DB}']
    function HashCode: TGMHashCode;
  end;


  { -------------------- }
  { ---- Exceptions ---- }
  { -------------------- }

  IGMGetHRCode = interface(IUnknown)
    ['{B3526DBB-F29F-474e-94A0-C8B3218DABC0}']
    function GetHRCode: HResult; stdcall;
    property HRCode: HResult read GetHRCode;
  end;


  function GMGetObjHRCode(const AObj: TObject; const ADefaultHrCode: HResult = S_OK): HResult;
  function GMGetIntfHRCode(const AIntf: IUnknown; const ADefaultHrCode: HResult = S_OK): HResult;
  function GMIsOneOfIntegers(const AValue: PtrInt; const AIntValues: array of PtrInt): Boolean;


  type

  IGMSetExceptionInformation = interface(IUnknown)
    ['{07870B30-5CFA-4F90-8A22-EEB7EE796543}']
    procedure SetMessage(AMessage: PGMChar); stdcall;
    procedure SetSeverityLevel(ASeverityLevel: TGMSeverityLevel); stdcall;
  end;


  IGMExceptionInformation = interface(IUnknown)
    ['{E9D30915-FAF3-43b3-A3FA-B3AE9E24EA02}']
    //
    // The TGMExceptionHandlerObj will ask raised Exceptions for
    // this Interface. If they have this interface the information
    // will be used to display more comprehensive error information.
    //
    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 GMMessage: PGMChar read GetGMMessage;
    property ExceptionClassName: PGMChar read GetExceptionClassName;
    property ExceptAddress: Pointer read GetExceptAddress;
    property RaisorName: PGMChar read GetRaisorName;
    property RaisorClassName: PGMChar read GetRaisorClassName;
    property RoutineName: PGMChar read GetRoutineName;
    property SeverityLevel: TGMSeverityLevel read GetSeverityLevel;
    property HelpContext: LongInt read GetHelpCtx;
  end;


  TGMDfltVerticalAlignment  = (vaDefault, vaTop, vaCenter, vaBottom);
  TGMVerticalAlignment = vaTop .. vaBottom;

  TGMDfltHorizontalAlignment = (haDefault, haLeft, haCenter, haRight);
  TGMHorizontalAlignment = haLeft .. haRight;


  TGMColumnDescRec = record
   Title: TGMString;
   Width: LongInt;
   Alignment: TGMDfltHorizontalAlignment;
  end;


  IGMClear = interface(IUnknown)
    ['{EC95F51C-8238-40AB-A1A2-406C761E1456}']
    procedure Clear(const ANotify: Boolean = True);
  end;


  { ----------------------------- }
  { ---- Activatable Objects ---- }
  { ----------------------------- }

  IGMGetActive = interface(IUnknown)
    ['{BEB78B21-2B77-11d5-AB38-000021DCAD19}']
    //
    // Anything that can be activated, like:
    //  - Recordsets
    //  - Players
    //  - Connections
    //
    function GetActive: Boolean; stdcall;
    property Active: Boolean read GetActive;
  end;


  IGMGetSetActive = interface(IGMGetActive)
    ['{731F9581-1642-11d5-A5E4-00E0987755DD}']
    procedure SetActive(const Value: Boolean); stdcall;
    property Active: Boolean read GetActive write SetActive;
  end;


  IGMActiveChangeNotifications = interface(IUnknown)
    ['{4D3692B3-522B-4bf2-BA82-EAB98198B755}']
    procedure BeforeActiveChange(const NewActive: Boolean); stdcall;
    procedure AfterActiveChange(const NewActive: Boolean); stdcall;
  end;


  IGMVerifyActivation = interface(IUnknown)
    ['{290C3D48-1C5A-11d5-AB38-000021DCAD19}']
    //
    // Verify the State on an activatable object. Raise if it is not.
    //
    procedure CheckIsActive(const ACallingName: TGMString = cDfltRoutineName); stdcall;
    procedure CheckIsInactive(const NeedInActiveName: TGMString = cDfltRoutineName); stdcall;
  end;


  function GMObjIsActive(const AObj: TObject; const ADefaultValue: Boolean = False): Boolean;
  function GMIntfIsActive(const AIntf: IUnknown; const ADefaultValue: Boolean = False): Boolean;

  function GMSetObjActive(const AObj: TObject; const Active: Boolean; const ACallingName: TGMString = cDfltRoutineName): Boolean;

  function GMSetIntfActive(const AIntf: IUnknown; const Active: Boolean; const ACallingName: TGMString = cDfltRoutineName): Boolean;

  procedure GMCheckObjIsInActive(const AObj: TObject; const NeedInActiveName: TGMString);
  procedure GMCheckIntfIsInActive(const AIntf: IUnknown; const NeedInActiveName: TGMString);

  procedure GMCheckObjIsActive(const AObj: TObject; const ACallingName: TGMString = cDfltRoutineName);
  procedure GMCheckIntfIsActive(const AIntf: IUnknown; const ACallingName: TGMString = cDfltRoutineName);


  type

  { ------------------------------------- }
  { ---- Connections between Objects ---- }
  { ------------------------------------- }

  //
  // There are many situations when Objects need to be connected to each other.
  // Instead of designing my own set of interfaces for connecting objects I decided
  // to use th� interfaces IConnectionPointContainer and IConnectionPoint.
  //
  // There are implementations for Connection points and containers in unit gmdbbase.
  // I did my own implementation because I couldn't agree with the borland one.
  //

  IGMCreateConnectionPoint = interface(IUnknown)
    ['{FD024422-1DE8-11d5-AB38-000021DCAD19}']
    //
    // A Implementation of a IConnectionPointContainer may implement this interface
    // too to let others create new ConnectionPoints from outside.
    //
    procedure CreateConnectionPoint(const AIID: TGUID); stdcall;
  end;


  IGMDisconnectFromConnectionPoint = interface(IUnknown)
    ['{0D697004-1D84-11d5-AB38-000021DCAD19}']
    //
    // A Object that is connected to a connection point may implement this interface.
    // The connection point will call DisconnectFromConnectionPoint on all connected
    // Objects if it wants the Objects to disconnect from itself (because of closing down or destruction).
    //
    procedure DisconnectFromConnectionPoint(const ConnectionPointContainer: IUnknown; const AIID: TGUID; const Cookie: LongInt); stdcall;
  end;



  { ----------------- }
  { ---- Handles ---- }
  { ----------------- }

  //
  // Note: Even if the datatype of a handle can be technically marshalled to
  //       other processes or computers normally a handle will be invalid in
  //       another process (computer).
  //

  IGMGetHandle = interface(IUnknown)
    ['{5BB45961-15A9-11d5-A5E4-00E0987755DD}']
    //
    // Anything that has a Handle:
    // ===========================
    //  - Windows
    //  - Files
    //  - DB Objects
    //  - GDI Objects etc.
    //
    function GetHandle: THandle; stdcall;
    property Handle: THandle read GetHandle;
  end;


  IGMGetSetHandle = interface(IGMGetHandle)
    ['{A6D2A402-1F1E-11d5-AB38-000021DCAD19}']
    //
    // This one allows to set the Handle too.
    //
    procedure SetHandle(const Value: THandle); stdcall;
    property Handle: THandle read GetHandle write SetHandle;
  end;


  IGMGetHandleType = interface(IUnknown)
    ['{39ED6E5A-DD09-4956-B5C3-58F203EA1A08}']
    function GetHandleType: Longword; stdcall;
    property HandleType: Longword read GetHandleType;
  end;


  IGMHandleAllocated = interface(IUnknown)
    ['{81BED96A-D5A7-418a-8808-31CD51E22117}']
    // Windows handles are often created when accessed.
    // So Handle <> 0 doesnt work since it creates the handle if neccessary.
    // In such situations use IGMHandleAllocated.
    function GetHandleAllocated: Boolean; stdcall;
    property HandleAllocated: Boolean read GetHandleAllocated;
  end;


  {IGMEnableDisablePaint = interface(IUnknown)
    ['655E0FB2-6AC8-4b5d-864B-EFCA768090F9']
    function EnablePaint: LongInt; stdcall;
    function DisablePaint: LongInt; stdcall;
    function GetPaintDisabledCount: LongInt; stdcall;
    property PaintDisabledCount: LongInt read GetPaintDisabledCount;
  end;}


  { ---------------------- }
  { ---- Names / Text ---- }
  { ---------------------- }

  type

  IGMGetName = interface(IUnknown)
    ['{D7242466-1DD0-494e-97CF-7944331A9116}']
    function GetName: TGMString; stdcall;
    property Name: TGMString read GetName;
  end;

  IGMGetSetName = Interface(IGMGetName)
    ['{423674CA-F5D1-4c34-ADF6-E592ACD9D4AA}']
    procedure SetName(const Value: TGMString); stdcall;
    property Name: TGMString read GetName write SetName;
  end;


  IGMGetFileName = interface(IUnknown)
    ['{D3ECCB42-A563-4cc4-B375-79931031ECBA}']
    function GetFileName: TGMString; stdcall;
    property FileName: TGMString read GetFileName;
  end;

  IGMGetSetFileName = Interface(IGMGetFileName)
    ['{ECFB879F-86F6-41a3-A685-0C899A2B5BCA}']
    procedure SetFileName(const Value: TGMString); stdcall;
    property FileName: TGMString read GetFileName write SetFileName;
  end;


  IGMGetHint = interface(IUnknown)
    ['{08E916C0-5208-4513-BB23-71747E5140C3}']
    function GetHint: TGMString; stdcall;
    property Hint: TGMString read GetHint;
  end;

  IGMGetSetHint = interface(IGMGetHint)
    ['{225B8C2D-4FD3-4d6e-B331-6AA331F761BC}']
    procedure SetHint(const Value: TGMString); stdcall;
    property Hint: TGMString read GetHint write SetHint;
  end;


  IGMGetText = interface(IUnknown)
    ['{BBDCFBC0-B9A3-4208-AFC1-3EE2903C21C2}']
    function GetText: TGMString; stdcall;
    property Text: TGMString read GetText;
  end;

  IGMGetSetText = interface(IGMGetText)
    ['{547DA16A-5C69-45a2-9FB0-25D93F749168}']
    procedure SetText(const Value: TGMString); stdcall;
    property Text: TGMString read GetText write SetText;
  end;



  { ------------------------------------ }
  { ---- Objects that have an owner ---- }
  { ------------------------------------ }

  type                  

  IGMReleaseReferences = interface(IUnknown)
    ['{A213DBA5-1F9B-11d5-AB38-000021DCAD19}']
    procedure ReleaseReferences; stdcall;
  end;

  procedure GMReleaseMembers(const AIntf: IUnknown);


  type

  IGMGetParentObj = interface(IUnknown)
    ['{B8487F83-E75D-4e5a-BB2D-BA857CC846FE}']
    function GetParentObj: TObject;
    property ParentObj: TObject read GetParentObj;
  end;

  IGMGetSetParentObj = interface(IGMGetParentObj)
    ['{C7306C62-6C64-4d05-85C1-2593F8960951}']
    procedure SetParentObj(const Value: TObject; const Relayout: Boolean = True);
    //property ParentObj: TObject read GetParentObj write SetParentObj;
  end;


  { ------------------------- }
  { ---- File Attributes ---- }
  { ------------------------- }

  TFileAttribute = (faArchive, faCompressed, faDirectory, faEncrypted, faHidden, faNormal, faOffline, faReadOnly, faReparsePoint, faSparse, faSystem, faTemporary);
  TFileAttributes = set of TFileAttribute;

  IGMFileProperties = interface(IUnknown)
    ['{1F883BC2-19F8-4f67-9633-B0CA563F7DC0}']
    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;

    property FileName: TGMString read GetFileName;
    property DisplayName: TGMString read GetDisplayName;
    property Attributes: TFileAttributes read GetAttributes;
    property CreationTime: TDateTime read GetCreationTime;
    property LastAccessTime: TDateTime read GetLastAccessTime;
    property LastWriteTime: TDateTime read GetLastWriteTime;
    property SizeInBytes: Int64 read GetSizeInBytes;
  end;


  function GMDWordToFileAttributes(const AValue: DWORD): TFileAttributes;
  function GMFileAttributesToDWORD(const AValue: TFileAttributes): DWORD;


  { ------------------------- }
  { ---- Enumarte things ---- }
  { ------------------------- }

  type

  IGMTellEnumString = interface(IUnknown)
    ['{C74E385E-C615-4398-BECE-8B7D537DA87E}']
    procedure TellEnumString(const ItemKind: LongInt; const Value: TGMString; const Parameter: Pointer = nil); stdcall;
  end;


  IGMTellEnumIntf = interface(IUnknown)
    ['{54EDEAAA-C059-41d1-9F7A-2611D05A8D73}']
    procedure TellEnumIntf(const Sender: IUnknown; const ItemKind: LongInt; const Value: IUnknown; const Parameter: Pointer = nil); stdcall;
  end;


  IGMEnumerateItems = interface(IUnknown)
    ['{525D8C22-275A-11d5-AB38-000021DCAD19}']
    procedure EnumerateItems(const ItemKind: LongInt; const TellEnumSink: IUnknown; const Parameter: Pointer = nil); stdcall;
  end;


  { ------------------------- }
  { ---- Locate / Lookup ---- }
  { ------------------------- }

  type

  IGMLookupValues = interface(IUnknown)
    ['{40B69A61-2819-11d5-AB38-000021DCAD19}']
    function LookupValues(const SQLCriteria: TGMString; const Values: IUnknown): Boolean; stdcall;
  end;


  TMatchKind = (mkExactMatch, mkNearestMatch);

  IGMPositionOfValues = interface(IUnknown)
    ['{52E31022-3907-4fc8-82CF-7FD9B96285F9}']
    function PositionOfValues(const Values: IUnknown; var FindPos: LongInt): Boolean; stdcall;
  end;

  IGMLocateValues = interface(IUnknown)
    ['{D19ECF62-28E7-11d5-AB38-000021DCAD19}']
    function LocateValues(const Values: IUnknown): Boolean; stdcall;
  end;


  { ------------------------------------- }
  { ---- Getting Interfaces indirect ---- }
  { ------------------------------------- }

  IGMGetIntfByName = interface(IUnknown)
    ['{4694A883-24F6-11d5-AB38-000021DCAD19}']
    function GetIntfByName(const Name: TGMString; const AIID: TGUID; out AIntf): HResult; stdcall;
  end;

  function GMFieldDisplayText(const FieldName: TGMString; const PIFieldByName: IGMGetIntfByName): TGMString;


  type

  IGMGetIntfByPosition = interface(IUnknown)
    ['{4694A884-24F6-11d5-AB38-000021DCAD19}']
    function GetIntfByPosition(const Position: PtrInt; const AIID: TGUID; out AIntf): HResult; stdcall;
  end;


  IGMGetPropertyIntf = interface(IUnknown)
    ['{746A0021-33EC-11d5-AB38-000021DCAD19}']
    function GetPropertyIntf(const PropertyName: TGMString; const AIID: TGUID; out AIntf): HResult; stdcall;
  end;


  IGMGetSubItems = interface(IUnknown)
    ['{967AED57-89B8-4547-8A8F-36A3D8C7CD32}']
    function GetSubItems(const ParentFieldName: TGMString; const ParentFieldValue: RGMUnionValue; const AIID: TGUID; out AIntf): HResult;
  end;


  { ---------------------- }
  { ---- Data Sources ---- }
  { ---------------------- }

  type

  IGMGetInterfaceSource = interface(IUnknown)
    ['{DFB04E9F-BC8D-474c-9134-B242699810EC}']
    function GetInterfaceSource: IUnknown; stdcall;
    property InterfaceSource: IUnknown read GetInterfaceSource;
  end;


  IGMGetSetInterfaceSource = interface(IGMGetInterfaceSource)
    ['{06B67B17-78B5-4a54-8959-3EDE25F0CDEA}']
    procedure SetInterfaceSource(const Value: IUnknown); stdcall;
    property InterfaceSource: IUnknown read GetInterfaceSource write SetInterfaceSource;
  end;


  function GMGetInterfaceSource(const AContainer: IUnknown): IUnknown;
  procedure GMSetInterfaceSource(const AContainer, AIntfSource: IUnknown);


  { ---------------- }
  { ---- Values ---- }
  { ---------------- }

  //
  // The following Value related interfaces may be implemnted by:
  // ============================================================
  //  - Fields
  //  - Parameters
  //  - Cached values
  //  - Anything else that maintains a Value
  //

  type

  IGMGetOleValue = interface(IUnknown)
    ['{5DC49C42-1BBE-11d5-AB38-000021DCAD19}']
    //
    // Anything that has a Value that can be read
    //
    function GetOleValue: OleVariant; stdcall;
    property Value: OleVariant read GetOleValue;
  end;


  IGMGetSetOleValue = interface(IGMGetOleValue)
    ['{5DC49C44-1BBE-11d5-AB38-000021DCAD19}']
    //
    // Anything that has a Read/Write Value
    //
    procedure SetOleValue(const AValue: OleVariant); stdcall;
    property Value: OleVariant read GetOleValue write SetOleValue;
  end;


  function GMGetItemValue(const AContainer: IUnknown; const AItemName: TGMString): RGMUnionValue; overload;
  function GMGetItemValue(const AContainer: IUnknown; const AItemPosition: LongInt): RGMUnionValue; overload;

  function GMCheckGetItemValue(const AContainer: IUnknown; const ItemName: TGMString; const ACallingName: TGMString = cDfltRoutineName): RGMUnionValue; overload;
  function GMCheckGetItemValue(const AContainer: IUnknown; const ItemPosition: LongInt; const ACallingName: TGMString = cDfltRoutineName): RGMUnionValue; overload;

  procedure GMSetItemValue(const AContainer: IUnknown; const AItemName: TGMString; const AValue: RGMUnionValue);
  procedure GMCheckSetItemValue(const AContainer: IUnknown; const ItemName: TGMString; const AValue: RGMUnionValue; const ACallingName: TGMString = cDfltRoutineName);

  function GMGetFieldValueImpl(const AContainer: IUnknown; const AIndex: RGMUnionValue): RGMUnionValue;
  procedure GMSetFieldValueImpl(const AContainer: IUnknown; const AIndex: RGMUnionValue; const AValue: RGMUnionValue);


  type

  IGMGetStringValue = interface(IUnknown)
    ['{601C32E7-A887-44D3-9604-06D128CF0670}']
    function GetStringValue: TGMString;
    property StringValue: TGMString read GetStringValue;
  end;


  IGMGetSetStringValue = interface(IGMGetStringValue)
    ['{D96903C3-4063-401D-AB17-1FC69E87F23A}']
    procedure SetStringValue(const ANewValue: TGMString);
    property StringValue: TGMString read GetStringValue write SetStringValue;
  end;


  IGMGetGUID = interface(IUnknown)
    ['{54A2C24B-EAF3-4de7-9359-27A88214E02D}']
    function GetGUID: TGUID; stdcall;
    property GUID: TGUID read GetGUID;
  end;


  IGMGetSetGUID = interface(IGMGetGUID)
    ['{7A0B2960-72B6-4cee-BAC9-69C58CFCAF3E}']
    procedure SetGUID(const Value: TGUID); stdcall;
    property GUID: TGUID read GetGUID write SetGUID;
  end;


  IGMGetModified = interface(IUnknown)
    ['{CC345281-29B8-11d5-AB38-000021DCAD19}']
    function GetModified: Boolean; stdcall;
    property Modified: Boolean read GetModified;
  end;


  IGMGetSetModified = interface(IGMGetModified)
    ['{CC345282-29B8-11d5-AB38-000021DCAD19}']
    procedure SetModified(const Value: Boolean); stdcall;
    property Modified: Boolean read GetModified write SetModified;
  end;


  IGMValidateValues = interface(IUnknown)
    ['{BB458E41-2C19-11d5-AB38-000021DCAD19}']
    procedure ValidateValues;
  end;


  IGMGetReadOnly = interface(IUnknown)
    ['{88A90C63-47A5-49ae-89CC-E123ACB6D629}']
    function GetReadonly: Boolean; stdcall;
    property ReadOnly: Boolean read GetReadOnly;
  end;

  IGMGetSetReadOnly = interface(IGMGetReadOnly)
    ['{B551AD30-8A05-4b59-9D1C-75FD8F9A478E}']
    procedure SetReadOnly(const Value: Boolean); stdcall;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
  end;


  IGMGetEnabled = interface(IUnknown)
    ['{B460F84A-929B-47d9-8E19-77B63276DB23}']
    function GetEnabled: Boolean; stdcall;
    property Enabled: Boolean read GetEnabled;
  end;

  IGMGetSetEnabled = interface(IGMGetEnabled)
    ['{FB390167-27D1-41a2-8A94-0322E0B64EDD}']
    procedure SetEnabled(const Value: Boolean); stdcall;
    property Enabled: Boolean read GetEnabled write SetEnabled;
  end;

  procedure GMEnableObj(const AObj: TObject; const AEnabled: Boolean);
  procedure GMEnableIntf(const AIntf: IUnknown; const AEnabled: Boolean);

  function GMGetObjEnabled(const AObj: TObject; const ADefaultValue: Boolean = False): Boolean;
  function GMGetIntfEnabled(const AIntf: IUnknown; const ADefaultValue: Boolean = False): Boolean;


  type

  TGMValueBufferAccessMode = (baRead, baWrite);
  EGMValueBufferInstance = (vbiValue, vbiOldValue);

  const

  cStrBufAccessTypeName = 'TGMValueBufferAccessMode';
  cStrValBufInstTypeName = 'EGMValueBufferInstance';


  type

  //IGMAccessValueBuffer = interface(IUnknown)
  //  ['{478594C1-2CE4-11d5-AB38-000021DCAD19}']
  //  function AccessValueBuffer(const AccessMode: LongInt; const AIID: TGUID; out AIntf; const ValueBufferInstance: LongInt = Ord(vbiValue)): HResult; stdcall;
  //end;


  IGMGetValueBufferIntf = interface(IUnknown)
    ['{48E70686-D324-4ef7-B1D7-E646EA0F612A}']
    function GetValueBufferIntf(const ValueBufferInstance: LongInt; const AIID: TGUID; out AIntf): HResult; stdcall;
  end;


  { ----------------------------------- }
  { ---- Objects that have a State ---- }
  { ----------------------------------- }

  IGMGetState = interface(IUnknown)
    ['{427EF9A1-220B-11d5-AB38-000021DCAD19}']
    function GetState: LongInt; stdcall;
    property State: LongInt read GetState;
  end;


  IGMGetSetState = interface(IGMGetState)
    ['{427EF9A2-220B-11d5-AB38-000021DCAD19}']
    procedure SetState(const Value: LongInt); stdcall;
    property State: LongInt read GetState write SetState;
  end;


  IGMStateChangeNotifications = interface(IUnknown)
    ['{C3A9CA45-1ACD-11d5-AB38-000021DCAD19}']
    //
    // Implemented by:
    // ===============
    //  - Fields
    //  - Data aware controls
    //
    // The implementing Object wants to be informed when a Recordset changes it's state.
    //
    // To connect to a recordset the IconnectionPointContainer/IConnectionPoint
    // interfaces should be used.
    //
    procedure BeforeStateChange(const OldState, NewState: LongInt); stdcall;
    procedure AfterStateChange(const OldState, NewState: LongInt); stdcall;
  end;


  IGMSaveRestoreState = interface
    ['{D5DC937A-959B-47d9-96BF-2FB011C6071D}']
    function CaptureState: IUnknown; stdcall; // <- Give the current state represented as IUnknown
    procedure RestoreState(const State: IUnknown); stdcall; // <- Restore from a previously saved state
  end;


  { ------------------ }
  { ---- Progress ---- }
  { ------------------ }

  type

  TGMCalcProgressKind = (cpkAbsolute, cpkRelative);

  TGMOnProgressProc = procedure (const AProgress: Int64; var ACancel: BOOL) of object; stdcall;
//TGMOnTellTotalProgressProc = procedure (const ATotalProgress: Int64) of object; stdcall;

  IGMOnProgress = interface(IUnknown)
    ['{3128A854-FB14-41f1-AFF1-77E67C7F4EA8}']
    procedure OnProgress(const AProgress: Int64; var ACancel: BOOL; const ACalcProgressKind: TGMCalcProgressKind = cpkAbsolute); stdcall;
  end;


  IGMSetCounter = interface(IUnknown)
    ['{63C0E4E8-FDF8-4B75-9133-8C09CC9584A3}']
    procedure SetCounter(const ACounterId: LongInt; const AValue: Int64; const ACalcCountKind: TGMCalcProgressKind = cpkAbsolute); stdcall;
  end;


  IGMSetProgressMax = interface(IGMOnProgress)
    ['{837A4D36-0F99-4ef2-82CF-0F375A522E5C}']
    procedure SetProgressMax(const AProgressMax: Int64); stdcall;
  end;


  IGMSetProgressDescription = interface(IUnknown)
    ['{289F562F-EFC1-4652-AD1E-BDC57A07F245}']
    procedure SetProgressDescription(const AProgressDescription: TGMString; const ATextColor: COLORREF = 0); stdcall;
  end;


//IGMMultiPhaseProgress = interface(IGMSetProgressMax)
//  ['{5B90D670-915B-4900-BAEB-2B0C1633D6F3}']
//  procedure SetPhaseCount(const Value: LongInt);
//  procedure NextProgressPhase(const APhaseDescription: TGMString);
//  //procedure SetupPhaseProgressRange(const AMin, AMax: LongInt; const ACurrentProgress: LongInt = cInvalidProgress);
//end;


  procedure GMSetProgressAndCheckCanceled(const AProgresssable: IUnknown; const AProgress: Int64; var ACancel: BOOL; const ACalcProgressKind: TGMCalcProgressKind = cpkAbsolute);
  procedure GMSetProgressMax(const AProgresssable: IUnknown; const AProgressMax: Int64);
  procedure GMSetProgressDescription(const AProgresssable: IUnknown; const AProgressDescription: TGMString; const ATextColor: COLORREF = 0);

  type

  IGMAppendText = interface(IUnknown)
    ['{3E9D2E3A-7B1A-4757-A7C6-89DE6FF08DD8}']
    procedure AppendText(const Text: TGMString; const Color: COLORREF = 0; const Bold: Boolean = False; const AFontSize: LongInt = 0);
  end;


  IGMAppendTextFromDLL = interface(IUnknown)
    ['{C3502DE5-296C-4274-9283-B8625EA5C639}']
    procedure AppendTextFromDLL(const Text: PGMChar; const Color: COLORREF = 0; const Bold: Boolean = False; const AFontSize: LongInt = 0); stdcall;
  end;



  IGMGetOperationCanceled = interface(IUnknown)
    ['{2DC47225-B370-4C0A-BA1A-4A6FAE9044B4}']
    function GetOperationCanceled: BOOL; stdcall;
    property OperationCanceled: BOOL read GetOperationCanceled;
  end;



  { ------------------- }
  { ---- Questions ---- }
  { ------------------- }

  TGMBoolAskResult = (barUnknown, barFalse, barTrue);

  TGMAskBoolValueId = (// bvFirstByteRead, bvDisplayValue, bvDisplayText, bvDataFetchNeeded,
                       bvIsNULL, bvModified, bvAlwaysNotify, bvIsMultiLine, bvCanModify, bvPositionalInsert,
                       bvIsSigned, bvIsAutoIncrementing, bvConfirmDeletions, bvHasFocus, bvMatchCase, bvDoColorChange,
                       bvCanSetPosition, bvWantsActivationClick, bvCustomStoreValues);

  IGMAskBoolean = interface(IUnknown)
    ['{7AAFA581-DC29-4c9a-B182-0E3F2BB412BB}']
    //function AskBoolean(const ValueId: LongInt): TGMBoolAskResult; stdcall;
    function AskBoolean(const ValueId: LongInt): LongInt; stdcall;
  end;

  function GMObjIsEmpty(const AObj: TObject; const DefaultResult: Boolean = True): Boolean;
  function GMIntfIsEmpty(const AIntf: IUnknown; const DefaultResult: Boolean = True): Boolean;
  function GMBooleanAskResult(const Value: Boolean): LongInt;
  function GMAskBoolean(const AObj: TObject; const ValueId: LongInt; const DefaultResult: Boolean = False): Boolean; overload;
  function GMAskBoolean(const AIntf: IUnknown; const ValueId: LongInt; const DefaultResult: Boolean = False): Boolean; overload;
  function GMAskUnkBoolean(const AIntf: IUnknown; const AValueId: LongInt): TGMBoolAskResult;
  function GMCheckAskBoolean(const AObj: TObject; const ValueId: LongInt; const ACallingName: TGMString = cDfltRoutineName): Boolean; overload;
  function GMCheckAskBoolean(const AIntf: IUnknown; const ValueId: LongInt; const ACallingName: TGMString = cDfltRoutineName): Boolean; overload;


  const cInvalidIntValue = Low(LongInt);

  type

  TGMAskIntValueId = (ivDataSize, ivDataLength, ivMatchKind, ivMaxEditLength, ivId, ivFieldCount, ivCursorType, ivDisplayWidth, ivImageIndex); // ivStoredDataLength

  IGMAskInteger = interface(IUnknown)
    ['{501B3BB4-BF5F-4b7a-8094-76FF8FF5C847}']
    function AskInteger(const ValueId: LongInt): LongInt; stdcall;
  end;

  function GMAskInteger(const AObj: TObject; const ValueId: LongInt; const ADefaultValue: LongInt = cInvalidIntValue): LongInt; overload;
  function GMAskInteger(const AIntf: IUnknown; const ValueId: LongInt; const ADefaultValue: LongInt = cInvalidIntValue): LongInt; overload;
  function GMCheckAskInteger(const AObj: TObject; const ValueId: LongInt; const ACallingName: TGMString = cDfltRoutineName): LongInt; overload;
  function GMCheckAskInteger(const AIntf: IUnknown; const ValueId: LongInt; const ACallingName: TGMString = cDfltRoutineName): LongInt; overload;


  type

  IGMMapIntegerOnInteger = interface(IUnknown)
    ['{1BC6F7EB-C230-48ba-B383-B332D555DA6F}']
    function MapIntegerOnInteger(const MapValue: PtrInt): PtrInt; stdcall;
  end;


  //IGMIntegerMapChange = interface(IUnknown)
  //  ['{1EEF030C-E9BA-478f-809F-81E0EEE100B6}']
  //  procedure IntegerMapChanged(const Value: LongInt); stdcall;
  //end;


  { -------------------- }
  { ---- Operations ---- }
  { -------------------- }

  TGMOperation = (roEdit, roInsert, roDelete, roCancelChanges, roApplyChanges, roRefreshCurrent, roReExecuteStatement, roScheduleReExecution, roLeaveModifyingState, roSetSimplestConfiguration,
                  // opClear, // opFetchData, opInvalidate, opCompressData, opUncompressData,
                  goShow, goHide, goSetFocus, goKillFocus, goRebuildContextMenu, goInitialize, goEnable, goDisable,
                  noNotifyDataChange);


  IGMCanExecuteOperation = interface(IUnknown)
    ['{9BA70E7C-CB2C-4404-8203-2BD68ABED85B}']
    function CanExecuteOperation(const Operation: LongInt; const Parameter: IUnknown = nil): Boolean; stdcall;
  end;


  IGMExecuteOperation = interface(IUnknown)
    ['{DCC23FA6-D77E-44c9-95BA-DFAA264451FD}']
    function ExecuteOperation(const Operation: LongInt; const Parameter: IUnknown = nil): Boolean; stdcall;
  end;


  function GMCanExecOperation(const AIntf: IUnknown; const Operation: LongInt; const Parameter: IUnknown = nil): Boolean;

  function GMExecuteOperation(const AObj: TObject; const Operation: LongInt; const Parameter: IUnknown = nil): Boolean; overload;
  function GMExecuteOperation(const AIntf: IUnknown; const Operation: LongInt; const Parameter: IUnknown = nil): Boolean; overload;

  procedure GMCheckExecOperation(const AObj: TObject; const Operation: LongInt; const OperationName: TGMString; const ACallingName: TGMString = cDfltRoutineName; const Parameter: IUnknown = nil); overload;
  procedure GMCheckExecOperation(const AIntf: IUnknown; const Operation: LongInt; const OperationName: TGMString; const ACallingName: TGMString = cDfltRoutineName; const Parameter: IUnknown = nil); overload;


  type

  IGMOperationNotifications = interface(IUnknown)
    ['{B9FCB8C1-10D6-41fe-83A3-6F85140419FC}']
    procedure BeforeOperation(const Operation: LongInt; const Parameter: IUnknown = nil); stdcall;
    procedure AfterOperation(const Operation: LongInt; const Parameter: IUnknown = nil); stdcall;
  end;


  TGMRefreshGranularity = (rgNone, rgRefreshPosition, rgRefreshCurrent, rgRefeshComplete);

  IGMEnableNotifications = interface(IUnknown)
    ['{D59116D7-62F4-4408-A482-DB2E2B8A5ACD}']
    function GetNotifyDisableCount: LongInt; stdcall;
    function EnableNotifications(const NotificationOnReEnable: LongInt = Ord(rgNone)): LongInt; stdcall;
    function DisableNotifications(const NotificationOnFirstDisable: LongInt = Ord(rgNone)): LongInt; stdcall;
    property NotifyDisableCount: LongInt read GetNotifyDisableCount;
  end;


  { ----------------- }
  { ---- Cursors ---- }
  { ----------------- }

  //
  // Abstract cursor interfaces, not specialized to anything.
  //
  // Implemented easily and meaningful by:
  // =====================================
  //  - TStrem or other stream like classes
  //  - TDataset or any other Recordset
  //  - List boxes, Grids or Comboboxes
  //  - File access classes
  //


  //
  // Cusorposition Changes will be notified by the
  // IGMPositionChangeNotifications interface.
  //

  IGMUnidirectionalCursor = interface(IUnknown)
    ['{C3A9CA46-1ACD-11d5-AB38-000021DCAD19}']
    function GetBOF: Boolean; stdcall;
    function GetEOF: Boolean; stdcall;
    procedure MoveToNext; stdcall;
    property BOF: Boolean read GetBOF;
    property EOF: Boolean read GetEOF;
  end;


  IGMBidirectionalCursor = interface(IGMUnidirectionalCursor)
    ['{C3A9CA47-1ACD-11d5-AB38-000021DCAD19}']
    procedure MoveToPrevious; stdcall;
  end;


  IGMCursorFirstLast = interface(IGMBidirectionalCursor)
    ['{C3A9CA48-1ACD-11d5-AB38-000021DCAD19}']
    procedure MoveToFirst; stdcall;
    procedure MoveToLast; stdcall;
  end;


  TGMCursorMove = (cmFirst, cmPrior, cmNext, cmLast);

  function GMIsValidCursorMove(const AIntf: IUnknown; const Move: TGMCursorMove): Boolean;
  procedure GMMoveCursor(const AIntf: IUnknown; const Move: TGMCursorMove);
  procedure GMMovePosition(const AIntf: IUnknown; const Delta: LongInt);
  procedure GMSafeCursorMove(const AIntf: IUnknown; const Move: TGMCursorMove);


  { ------------------ }
  { ---- Position ---- }
  { ------------------ }

  //
  // All things that have a Position, like:
  // ======================================
  //  - Streams
  //  - Files
  //  - Recordsets
  //  - Listboxes, comboboxes, Grids
  //  - Scrollbars
  //  - Progress Bars
  //

  type

  IGMGetPosition = interface(IUnknown)
    ['{C3A9CA4A-1ACD-11d5-AB38-000021DCAD19}']
    function GetPosition: PtrInt; stdcall;
    property Position: PtrInt read GetPosition;
  end;


  IGMGetSetPosition = interface(IGMGetPosition)
    ['{5DC49C45-1BBE-11d5-AB38-000021DCAD19}']
    procedure SetPosition(const Value: PtrInt); stdcall;
    property Position: PtrInt read GetPosition write SetPosition;
  end;


  IGMPositionChangeNotifications = interface(IUnknown)
    ['{290C3D43-1C5A-11d5-AB38-000021DCAD19}']
    //
    // If others want to be informed when a Position changes
    // they can implement this interface.
    //
    // To connect to the Position holder the IconnectionPointContainer/IConnectionPoint
    // interfaces should be used.
    //
    procedure BeforePositionChange; stdcall;
    procedure AfterPositionChange; stdcall;
  end;


  IGMScrollBar = interface(IGMGetSetPosition)
    ['{3835397C-7C0F-422A-BFD9-763CA068E96C}']
    function GetMinPosition: LongInt; stdcall;
    function GetMaxPosition: LongInt; stdcall;
    function GetPageSize: LongInt; stdcall;
    procedure SetMinPosition(const AValue: LongInt); stdcall;
    procedure SetMaxPosition(const AValue: LongInt); stdcall;
    procedure SetPageSize(const AValue: LongInt); stdcall;
    property MinPosition: LongInt read GetMinPosition write SetMinPosition;
    property MaxPosition: LongInt read GetMaxPosition write SetMaxPosition;
    property PageSize: LongInt read GetPageSize write SetPageSize;
  end;

  function GMGetIntfPosition(const AIntf: IUnknown; const DefaultPos: LongInt = CGMUnknownPosition): LongInt;
  procedure GMSetIntfPosition(const AIntf: IUnknown; const Position: LongInt);


  { ---------------- }
  { ---- colors ---- }
  { ---------------- }

  type

  IGMBkgndColor = interface(IUnknown)
    ['{26A00902-95B8-4854-BCC4-01E5C2E80135}']
    function BkgndColor: COLORREF; stdcall;
    //property BkgndColor: COLORREF read GetBkgndColor;
  end;


  IGMGetSetBkgndColor = interface(IGMBkgndColor)
    ['{2667B51E-1EB9-4c76-99AF-51232F4E13C6}']
    procedure SetBkgndColor(const Value: COLORREF; const Repaint: Boolean = True); stdcall;
    //property BkgndColor: COLORREF read IGMBkgndColor; //  write SetBkgndColor;
  end;


  { --------------- }
  { ---- Count ---- }
  { --------------- }

  IGMGetCount = interface(IUnknown)
    ['{93880081-2684-11d5-AB38-000021DCAD19}']
    function GetCount: PtrInt; stdcall;
    property Count: PtrInt read GetCount;
  end;


  IGMGetSetCount = interface(IGMGetCount)
    ['{93880082-2684-11d5-AB38-000021DCAD19}']
    procedure SetCount(const Value: PtrInt); stdcall;
    property Count: PtrInt read GetCount write SetCount;
  end;


  function GMGetIntfCount(const AIntf: IUnknown; const ADefaultValue: PtrInt = 0): PtrInt;


  { ---------------- }
  { ---- Offset ---- }
  { ---------------- }

  type

  IGMGetOffset = interface(IUnknown)
    ['{AC94E5A1-38AB-11d5-AB38-000021DCAD19}']
    function GetOffset: PtrInt; stdcall;
    property Offset: PtrInt read GetOffset;
  end;


  IGMGetSetOffset = interface(IGMGetOffset)
    ['{AC94E5A2-38AB-11d5-AB38-000021DCAD19}']
    procedure SetOffset(PtrInt: PtrInt); stdcall;
    property Offset: PtrInt read GetOffset write SetOffset;
  end;


  IGMShiftOffset = interface(IUnknown)
    ['{9A57A8D4-2DFE-4aa0-BE1E-6365C3FD2B68}']
    procedure SetOffsetAndShiftData(const NewOffset: LongInt); stdcall;
  end;


  { ------------------- }
  { ---- Placement ---- }
  { ------------------- }

  IGMGetLeft = interface(IUnknown)
    ['{F2589550-F6A9-46d4-AC88-D694B080C0DE}']
    function GetLeft: LongInt; stdcall;
    property Left: LongInt read GetLeft;
  end;


  {IGMGetSetLeft = interface(IGMGetLeft)
    ['567DD2AA-B5B3-4bc3-B68E-2649698A0C05']
    procedure SetLeft(const Value: LongInt); stdcall;
    property Left: LongInt read GetLeft write SetLeft;
  end;}


  {IGMGetTop = interface(IUnknown)
    ['9ABE0B27-B9BD-4c19-878E-30FBB67F9D75']
    function GetTop: LongInt; stdcall;
    property Top: LongInt read GetTop;
  end;}


  {IGMGetSetTop = interface(IGMGetTop)
    ['BBAB652D-AD89-4468-8DDB-C8AE8F20926A']
    procedure SetTop(const Value: LongInt); stdcall;
    property Top: LongInt read GetTop write SetTop;
  end;}


  {IGMGetWidth = interface(IUnknown)
    ['7416B560-6800-4bfb-9F72-FF21F3B91EEA']
    function GetWidth: LongInt; stdcall;
    property Width: LongInt read GetWidth;
  end;}


  {IGMGetSetWidth = interface(IGMGetWidth)
    ['CE61FDA8-FD92-47e6-BCDF-A5599FFEA6AB']
    procedure SetWidth(const Value: LongInt); stdcall;
    property Width: LongInt read GetWidth write SetWidth;
  end;}


  {IGMGetHeight = interface(IUnknown)
    ['E703AB11-7475-45c8-A2DC-ECFB83906E21']
    function GetHeight: LongInt; stdcall;
    property Height: LongInt read GetHeight;
  end;}


  {IGMGetSetHeight = interface(IGMGetHeight)
    ['7E5751E5-C243-4054-8180-A440BDA79DBE']
    procedure SetHeight(const Value: LongInt); stdcall;
    property Height: LongInt read GetHeight write SetHeight;
  end;}                                             


  {IGMSetBounds = interface(IUnknown)
    ['FDEECACF-47A4-4b6d-B2FA-F062FCD3F9D3']
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: LongInt); stdcall;
  end;}


  { ------------------------------- }
  { ---- Assign#ments / Clones ---- }
  { ------------------------------- }

  IGMAssignFromObj = interface(IUnknown)
    ['{347F1FD6-9775-4612-A9D4-828415E0E274}']
    procedure AssignFromObj(const ASource: TObject); stdcall;
  end;


  IGMAssignToObj = interface(IUnknown)
    ['{76BE483F-13F2-408c-A6DC-75F2F10EA32A}']
    procedure AssignToObj(const ADest: TObject); stdcall;
  end;


  IGMAssignFromIntf = interface(IUnknown)
    ['{B4047CE2-4821-4b08-BC3F-0EFA7D2A0481}']
    procedure AssignFromIntf(const ASource: IUnknown); stdcall;
  end;


  IGMAssignToIntf = interface(IUnknown)
    ['{5DC7F8E2-00BD-487f-A8F6-1FCF8706CF7D}']
    procedure AssignToIntf(const ADest: IUnknown); stdcall;
  end;


  IGMCreateCopyQI = interface(IUnknown)
    ['{82C8DD54-9DEC-455f-9C94-CF0D6CC7E0A7}']
    //
    // Anything that allows to create a Copy of itself.
    // Specify the Interface you want use to communicate to
    // the newly created Object in the AIID Parameter.
    //
    function CreateCopyQI(const AIID: TGUID; out AIntf): HResult; stdcall;
  end;


  { -------------------- }
  { ---- Attributes ---- }
  { -------------------- }

  //
  // Bitflag Field interpreted as a Set of Boolean Attributes.
  //

  IGMGetAttributes = interface(IUnknown)
    ['{5771C661-3BF8-11d5-AB38-000021DCAD19}']
    function GetAttributes: Longword; stdcall;
    property Attributes: Longword read GetAttributes;
  end;


  IGMGetSetAttributes = interface(IGMGetAttributes)
    ['{E94E2166-597A-4937-A700-FBE37EEDE291}']
    procedure SetAttributes(const Value: Longword); stdcall;
    property Attributes: Longword read GetAttributes write SetAttributes;
  end;


  { ---------------------- }
  { ---- User Account ---- }
  { ---------------------- }

  IGMUsernameAndPassword = interface(IUnknown)
    ['{CAE0D477-6191-4502-A4B6-7FA36BCC250B}']
    function GetUsername: TGMString;
    procedure SetUsername(const ABypass: TGMString);

    function GetPassword: TGMString;
    procedure SetPassword(const ABypass: TGMString);

    property Username: TGMString read GetUsername write SetUsername;
    property Password: TGMString read GetPassword write SetPassword;
  end;


  IGMUserAccount = interface(IUnknown)
    ['{42129443-AFC0-4103-91E1-0ED04AB8584B}']
    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;
    property Username: PGMChar read GetUsername write SetUsername;
    property Password: PGMChar read GetPassword write SetPassword;
//  property Domain: PGMChar read GetDomain write SetDomain;
    property SaveUserData: Boolean read GetSaveUserData write SetSaveUserData;
  end;


  { ----------------- }
  { ---- Strings ---- }
  { ----------------- }

  {IGMStrings = interface(IUnknown)
    ['FA99E2AC-F393-417a-AA19-5C9501B200B5']
    //
    // Cannot be marshalled
    //
    procedure BeginUpdate;
    procedure EndUpdate;
    
    function Get(Index: LongInt): TGMString;
    function GetSorted: Boolean;
    procedure Put(Index: LongInt; const S: TGMString);
    procedure SetSorted(Value: Boolean);

    procedure Clear;
    function GetCount: LongInt;
    function IsEmpty: Boolean;

    function Add(const Value: TGMString): LongInt;
    procedure Delete(Index: LongInt);

    function IndexOf(const Value: TGMString): LongInt;
    function IndexOfNearest(const Value: TGMString): LongInt;
    function Find(const Value: TGMString; var Index: LongInt): Boolean;
    
    property Count: LongInt read GetCount;
    property Strings[Index: LongInt]: TGMString read Get write Put; default;
    property Sorted: Boolean read GetSorted write SetSorted;
  end;}


  { ------------------------ }
  { ---- Storing Values ---- }
  { ------------------------ }

  PGMCryptCtrlData = ^RGMCryptCtrlData;
  RGMCryptCtrlData = record
    KeyData: AnsiString;
    HashAlgoID: Cardinal;
    CryptAlgoID: Cardinal;
  end;


  TGMReadValStrFunc = function(const AValueName: TGMString; const ADefaultValue: TGMString = ''): TGMString of object; stdcall;
  TGMWriteValStrProc = procedure(const AValueName, AValue: TGMString) of object; stdcall;

  IGMStringStorage = interface(IUnknown)
    ['{6C1E6792-ED8D-4c16-A49E-12CB62F61E7E}']
    function ReadString(const ValueName: TGMString; const ADefaultValue: TGMString = ''): TGMString; stdcall;
    procedure WriteString(const ValueName, Value: TGMString); stdcall;
  end;


  IGMValueStorage = interface(IGMStringStorage)
    ['{5B79A555-D8BA-4062-B84E-A08AD279194B}']
    function ReadInteger(const ValueName: TGMString; const ADefaultValue: LongInt = cDfltReadInteger): LongInt; stdcall;
    function ReadInt64(const ValueName: TGMString; const ADefaultValue: Int64 = cDfltReadInteger): Int64; stdcall;
    function ReadBoolean(const ValueName: TGMString; const ADefaultValue: Boolean = cDfltReadBoolean): Boolean; stdcall;
    function ReadDateTime(const ValueName: TGMString; const ADefaultValue: Double = cDfltReadDateTime): Double; stdcall;
    function ReadDouble(const ValueName: TGMString; const ADefaultValue: Double = cDfltReadFloat): Double; stdcall;
    function ReadVariant(const ValueName: TGMString; const ADefaultValue: OleVariant): OleVariant; stdcall;
    function ReadUnionValue(const ValueName: TGMString; const ADefaultValue: RGMUnionValue): RGMUnionValue; stdcall;
    procedure WriteInteger(const ValueName: TGMString; const Value: LongInt); stdcall;
    procedure WriteInt64(const ValueName: TGMString; const Value: Int64); stdcall;
    procedure WriteBoolean(const ValueName: TGMString; const Value: Boolean); stdcall;
    procedure WriteDateTime(const ValueName: TGMString; const Value: Double); stdcall;
    procedure WriteDouble(const ValueName: TGMString; const Value: Double); stdcall;
    procedure WriteVariant(const ValueName: TGMString; const Value: OleVariant); stdcall;
    procedure WriteUnionValue(const ValueName: TGMString; const Value: RGMUnionValue); stdcall;
  end;

  TGMLoadStoreValuesProc = procedure (const AStorage: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil) of object;


  //IGMBinaryStorage = interface(IUnknown)
  //  ['EF4C4B29-EFEA-4e2d-B483-7EA3DAA608FA}']
  //  function ReadBinary(const ValueName: TGMString; out Data; const DataSize: LongInt; const ZeroInit: Boolean = True): LongWord; stdcall;
  //  procedure WriteBinary(const ValueName: TGMString; const Data; const DataSize: LongInt); stdcall;
  //end;

  IGMContainsValue = interface(IUnknown)
    ['{EFF05048-5460-4A8E-B6D1-2FCCDB184CC2}']
    function ContainsValue(const ValueName: TGMString): Boolean; stdcall;
  end;

  
  IGMValueStorageDirectory = interface(IGMContainsValue)
    ['{E8696A1E-B597-46cd-ABA3-0376EC82609D}']
    function OpenDir(const DirPath: TGMString; const CreateIfNotExist: Boolean = False): Boolean; stdcall;
//  function DirExists(const DirPath: TGMString): Boolean; stdcall;
    procedure ReadSubDirNames(var SubDirNames: TGMStringArray); stdcall;
    procedure ReadValueNames(var ValueNames: TGMStringArray); stdcall;
    function DeleteValue(const ValueName: TGMString): Boolean; stdcall;
    function DeleteDir(const DirPath: TGMString): Boolean; stdcall;
    function CurrentPath: TGMString; stdcall;
    procedure Commit; stdcall;

    function GetBasePath: TGMString; stdcall;
    function GetRootKey: HKEY; stdcall;
    procedure SetBasePath(const Value: TGMString); stdcall;
    procedure SetRootKey(const Value: HKEY); stdcall;

    property BasePath: TGMString read GetBasePath write SetBasePath;
    property RootKey: HKEY read GetRootKey write SetRootKey;
  end;


  IGMLoadStoreData = interface(IUnknown)
    ['{D8D48DE1-AE80-4132-AE40-ECA66F9256C6}']
    procedure LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); stdcall;
    procedure StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); stdcall;
  end;



  { ---------------------------- }
  { ----  Content Container ---- }
  { ---------------------------- }

  IGWriteToStream = interface(IUnknown)
    ['{AEFAA5A9-50C8-43F3-95ED-E0645E74791E}']
    procedure WriteToStream(const ADestStream: ISequentialStream; const ACharCoding: TGMCharKind = ckUtf8; const AIndent: TGMString = '');
  end;


  { ---------------- }
  { ----  Trees ---- }
  { ---------------- }

  IGMTreeable = Interface(IUnknown)
    ['{72EF5208-0379-4C0B-BBDF-4AB64B9050F3}']
    function Parent: IGMTreeable; // <- Level up
    function FirstChild: IGMTreeable; // <- Level down
    function NextSibling: IGMTreeable; // <- Next neighbour on same Level
    function PrevSibling: IGMTreeable; // <- Previous neighbour on same Level
  end;


  IGMCreateTreeNodeWithDataObj = interface(IUnknown)
    ['{6ED27D2A-0349-490E-A42D-F238DCF77D87}']
    function CreateTreeNodeWithDataObj(const ASource: IGMValueStorage; const ParentNode: IGMTreeable; const Parameters: IUnknown = nil): IGMTreeable; // stdcall;
  end;


  IGMCreateNewTreeNode = interface(IUnknown)
    ['{E1AC135B-AB0D-4228-B945-C4B111EE884E}']
    function CreateNewTreeNode(const ParentNode: IGMTreeable; const Title: TGMString; const ImgIdx, SelectedImgIdx: Integer; const DataObj: TObject = nil; const Parameters: IUnknown = nil): IGMTreeable; stdcall;
  end;


  IGMGetTreeNodeFromRaw = interface(IUnknown)
    ['{A1531AA5-68B5-4FD9-A2DB-85F0CD37880B}'] 
    function GetTreeNodeFromRaw(const ANode: Pointer): IGMTreeable; stdcall;
  end;


  IGMGetDataObject = interface(IUnknown)
    ['{66E08396-AD93-4996-B4A0-E506085CAD49}']
    function GetDataObject: TObject; stdcall;
  end;


  IGMSetDataObject = interface(IUnknown)
    ['{F0520DB3-D54A-4E9A-B57A-D2BD2F91F796}']
    procedure SetDataObject(const Value: TObject); stdcall;
  end;

  //
  // Return value True continues iteratiing further nodes, False stops iteration at current node
  //
  TGMNodeVisitFunc = function(const Node: IGMTreeable; const Parameter: Pointer = nil): Boolean;
  TGMNodeVisitMethod = function(const Node: IGMTreeable; const Parameter: Pointer = nil): Boolean of object;

  PGMNodeVisitData = ^RGMNodeVisitData;
  RGMNodeVisitData = record
    DataClass: TClass;
    NodeTitle: TGMString;
    Node: IGMTreeable;
    Index, SearchIdx: LongInt;
  end;


  function GMTreeableNodeLevel(ANode: IGMTreeable): Integer;

  function GMInitNodeVisitData(const ADataClass: TClass; const ANodeTitle: TGMString = ''; const ANode: IGMTreeable = nil; const ASearchIndex: LongInt = 0): RGMNodeVisitData;

  function GMGetDataObject(const AOwner: IUnknown): TObject;
  function GMSetDataObject(const AOwner: IUnknown; const ADataObj: TObject): TObject;

  function GMIntfHasDataClass(const AIntf: IUnknown; const ADataClass: TClass): Boolean;
  function GMGetIntfDataClass(const AIntf: IUnknown): TClass;

  function GMVisitNodesRootFirst(const AStartNode: IGMTreeable;
                                 const AVisitFunc: TGMNodeVisitFunc;
                                 const ARecurse: Boolean = True;
                                 const AParameter: Pointer = nil): Boolean; overload;

  function GMVisitNodesRootFirst(const AStartNode: IGMTreeable;
                                 const AVisitFunc: TGMNodeVisitMethod;
                                 const ARecurse: Boolean = True;
                                 const AParameter: Pointer = nil): Boolean; overload;


  function GMVisitNodesDepthFirst(const AStartNode: IGMTreeable;
                                  const AVisitFunc: TGMNodeVisitFunc;
                                  const ARecurse: Boolean = True;
                                  const AParameter: Pointer = nil): Boolean; overload;

  function GMVisitNodesDepthFirst(const AStartNode: IGMTreeable;
                                  const AVisitFunc: TGMNodeVisitMethod;
                                  const ARecurse: Boolean = True;
                                  const AParameter: Pointer = nil): Boolean; overload;


  function GMIsNodeMatch(ANode: IGMTreeable; const ADataClass: TClass; const ANodeTitle: TGMString = ''): Boolean;
  function GMFindParentNode(const AStartNode: IGMTreeable; const ADataClass: TClass; const ANodeTitle: TGMString = ''): IGMTreeable;

  function GMFindNode(const AStartNode: IGMTreeable; const ADecideFunc: TGMNodeVisitFunc; const ARecurse: Boolean; const AParameter: Pointer = nil): IGMTreeable;  overload;
  function GMFindNode(const AStartNode: IGMTreeable; const ADataClass: TClass; const ANodeTitle: TGMString = ''; const ARecurse: Boolean = True): IGMTreeable; overload;

  function GMFindRootNode(const ANode: IUnknown): IGMTreeable;

  function GMNodePath(const ANode: IUnknown; const ADelimStr: TGMString = '\'): TGMString;


  { ---------------------------------------------------------------- }
  { ----  Classes supporting reference counted lifetime control ---- }
  { ---------------------------------------------------------------- }

  type

  TGMRefCountedObj = class(TObject, IUnknown, IGMObjInfo, IGMCreateCopyQI)
   protected
    FRefLifeTime: Boolean;
    FRefCount: LongInt;

   public
    constructor Create(const ARefLifeTime: Boolean = False); virtual;

    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    destructor Destroy; override;
    procedure OnFinalRelease; virtual;

    // IGMObjInfo
    function GetClassName: TGMString;
    function GetClassType: TClass;
    function GetInstance: TObject;
    function GetTypeInfo: PTypeInfo;

    // 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};

    // IGMCreateCopyQI
    function CreateCopyQI(const AIID: TGUID; out AIntf): HResult; virtual; stdcall;

    property RefCount: LongInt read FRefCount;
    property RefLifeTime: Boolean read FRefLifeTime write FRefLifeTime;
  end;

  TGMRefCountedObjClass = class of TGMRefCountedObj;


  TGMAggregatableObj = class(TGMRefCountedObj, IUnknown)
   //
   // Intended to be aggregated to/by another class via "implements" compiler featrue.
   // Must not be created with RefLifetime when used as an aggregate (Interface delegation member).
   //
   // If used as interface delegation member the owner must refernece this class by a normal
   // object member and not an interface member. Because reference counts are routed back to the
   // owner by this class a cyclic reference by interfaces would keep the owner forever. For the same reason
   // this class must not reference other delegation classes of the owner by interfaces.
   //
   // Can be created standalone (AOwner = nil) too, with or without RefLifeTime.
   //
   protected
    FOwner: Pointer; // <- cannot be a Interface reference, would cause circular reference

   public
    constructor Create(const AOwner: IUnknown; const ARefLifeTime: Boolean = False); virtual; reintroduce; overload;

    function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} AIID: TGUID; out AIntf): HResult; override;
    function _AddRef: LongInt; override;
    function _Release: LongInt; override;

    function GetOwner: IUnknown;
    function GetOwnerObj: TObject;
    property Owner: IUnknown read GetOwner;
    property OwnerObj: TObject read GetOwnerObj;
  end;



  {$IFDEF DELPHIVCL}
  TGMRefLifePersistent = class(TPersistent, IUnknown, IGMObjInfo)
   protected
    FConstructed: Boolean;
    FRefCount: LongInt;
    FRefLifeTime: Boolean;

   public
    constructor Create(const ARefLifeTime: Boolean = False);
    procedure AfterConstruction; override;
    destructor Destroy; override;
    procedure OnFinalRelease; virtual;

    // IGMObjInfo
    function GetClassName: TGMString;
    function GetClassType: TClass;
    function GetInstance: TObject;
    function GetTypeInfo: PTypeInfo;

    // 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};

    property RefCount: LongInt read FRefCount;
    property RefLifeTime: Boolean read FRefLifeTime write FRefLifeTime;
  end;
  {$ENDIF}


  {$IFDEF DELPHIVCL}
  TGMRefLifeComponent = class;

  TGMRefLifeComponentClass = class of TGMRefLifeComponent;

  TGMRefLifeComponent = class(TComponent, IUnknown,
                                          IGMCreateCopyQI,
                                          IGMAssignFromObj,
                                          IGMAssignToObj,
                                          IGMGetName,
                                          IGMObjInfo)
   protected
    FConstructed: Boolean;
    FRefCount: LongInt;
    FRefLifeTime: Boolean;

    function CopyCreateClass: TGMRefLifeComponentClass;

   public
    constructor CreateIntf; // virtual; <- not needed, calls virtual create constructor
    procedure AfterConstruction; override;
    destructor Destroy; override;
    procedure OnFinalRelease; virtual;

    // IGMObjInfo
    function GetClassName: TGMString;
    function GetClassType: TClass;
    function GetInstance: TObject;
    function GetTypeInfo: PTypeInfo;

    // IGMGetName
    function GetName: TGMString; virtual; stdcall;

    // IGMAssignByObj
    procedure AssignFromObj(const ASource: TObject); virtual; stdcall;
    procedure AssignToObj(const ADest: TObject); virtual; stdcall;

    // IGMCreateCopyQI
    function CreateCopyQI(const AIID: TGUID; out AIntf): HResult; virtual; 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};

    property RefCount: LongInt read FRefCount;
    property RefLifeTime: Boolean read FRefLifeTime write FRefLifeTime;
  end;
  {$ENDIF}


  TCPCNotifyProc = procedure (const NotifySink: IUnknown; const Params: array of OleVariant);
  TCPCNotifyProcObj = procedure (const NotifySink: IUnknown; const Params: array of OleVariant) of object;


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

  TGMCriticalSection = class(TGMRefCountedObj, IGMCriticalSection)
   protected
    FCriticalSection: TRTLCriticalSection;
   public
    constructor Create(const ARefLifeTime: Boolean = True); override;
    destructor Destroy; override;
    procedure EnterCriticalSection;
    procedure LeaveCriticalSection;
    function TryEnterCriticalSection: Boolean; 
  end;


  TGMCriticalSectionLock = class(TGMRefCountedObj)
   protected
    FCriticalSection: IGMCriticalSection;
   public
    constructor Create(const ACriticalSection: IUnknown; const ARefLifeTime: Boolean = True); reintroduce;
    destructor Destroy; override;
  end deprecated 'Use RGMCriticalSectionLock instead';


  RGMCriticalSectionLock = record
   private
    LockCount: Int64;
    CriticalSection: IGMCriticalSection;

    class operator Initialize(var ACriticalSectionLock: RGMCriticalSectionLock);
    class operator Finalize(var ACriticalSectionLock: RGMCriticalSectionLock);

   public
    procedure Lock(const ACriticalSection: IGMCriticalSection); overload;
    procedure Lock(const ACriticalSection: IUnknown); overload;
    procedure Lock(const ACriticalSection: TObject); overload;
    procedure LockAgain;
    procedure Unlock;
    procedure UnlockAll;
    function GetLockCount: Int64;
  end;


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

  TGMCOMInitializer = class(TGMRefCountedObj)
   protected
    FInitialized: Boolean;
   public
    constructor Create(const ACoInitFlags: DWORD = cDfltCoInitFlags; const AHrCheck: Boolean = True; const ARefLifeTime: Boolean = True); reintroduce;
    destructor Destroy; override;
  end;


  TGMNotificationDisabler = class(TGMRefCountedObj)
   protected
    FNotifier: IGMEnableNotifications;
    FNotificationOnReEnable: LongInt;
   public
    constructor Create(const ANotifier: IUnknown; const ANotificationOnReEnable: LongInt = Ord(rgNone); const ANotificationOnFirstDisable: LongInt = Ord(rgNone); const ARefLifeTime: Boolean = True); reintroduce;
    destructor Destroy; override;
  end;


  TGMPositionKeeper = class(TGMRefCountedObj)
   protected
    FPosition: LongInt;
    FObjWithPosition: IGMGetSetPosition;
   public
    constructor Create(const AObjWithPosition: IUnknown; const ANewposition: LongInt = -1; const ARefLifeTime: Boolean = True); reintroduce;
    destructor Destroy; override;
  end;


  TGMStateKeeper = class(TGMRefCountedObj)
   protected
    FObjWithState: IGMSaveRestoreState;
    FState: IUnknown;
   public
    constructor Create(const AObjWithState: IUnknown; const ARefLifeTime: Boolean = True); reintroduce;
    destructor Destroy; override;
  end;


  TGMQuietStateKeeper = class(TGMRefCountedObj)
   protected
    FStateKeeper: IUnknown; // <- Released First
    FNotificationDisabler: IUnknown; // <- Released Second
   public
    constructor Create(const AObjWithState: IUnknown; const ANotificationOnReEnable: LongInt = Ord(rgNone); const ANotificationOnFirstDisable: LongInt = Ord(rgNone); const ARefLifeTime: Boolean = True); reintroduce;
  end;


  TGMActiveKeeper = class(TGMRefCountedObj)
   protected
    FActivatableObj: IGMGetSetActive;
    FWasActive: Boolean;
   public
    constructor Create(const AActivatableObj: IUnknown; const ANewActive: Boolean = True; const ARefLifeTime: Boolean = True); reintroduce;
    destructor Destroy; override;
  end;


  TGMVsdDirPathKeeper = class(TGMRefCountedObj)
   protected
    FValStorageDir: IGMValueStorageDirectory;
    FOldDirPath: TGMString;
   public
    constructor Create(const AValStorageDir: IUnknown; const ANewDirPath: TGMString = ''; const ACreateIfNotExists: Boolean = False; const ARefLifeTime: Boolean = True); reintroduce;
    destructor Destroy; override;
  end;


  TGMIStreamPosKeeper = class(TGMRefCountedObj)
   protected
    FStream: IStream;
    FOldPos: Int64;
   public
    constructor Create(const AStream: IUnknown; AStartPos: Int64 = cCurrentStrmPos; const ARefLifeTime: Boolean = True); reintroduce;
    destructor Destroy; override;
  end;


  {TGMPaintDisabler = class(TGMRefCountedObj)
   protected                                                                                
    FPaintObj: IGMEnableDisablePaint;
   public
    constructor Create(const APaintObj: IUnknown; const ARefLifeTime: Boolean = True);
    destructor Destroy; override;
  end;}


{ ---- Key Value Directory Routines ---- }

function GMVsdOpenDir(const AStorage: IUnknown; const ADirPath: TGMString; const ACreateIfNotExist: Boolean = False): Boolean;
function GMVsdDirExists(const AStorage: IUnknown; const ADirPath: TGMString): Boolean;
function GMVsdOpenAbsDir(const AStorage: IUnknown; const ADirPath: TGMString; const ACreateIfNotExist: Boolean = False): Boolean;
function GMVsdDeleteDir(const AStorage: IUnknown; const ADirPath: TGMString): Boolean;
function GMVsdDeleteAbsDir(const Storage: IUnknown; const ADirPath: TGMString): Boolean;
function GMVsdContainsValue(const AStorage: IUnknown; const AValueName: TGMString): Boolean;
function GMVsdDeleteValue(const AStorage: IUnknown; const AValueName: TGMString): Boolean;
//function GMVsdValueNameExists(const AStorage: IUnknown; const ValueName: TGMString): Boolean;
//procedure GMVsdDeletePrefixedValues(const AStorage: IUnknown; const PrefixStr: TGMString);
//procedure GMVsdDeleteValues(const AStorage: IUnknown);
procedure GMVsdReadSubDirNames(const AStorage: IUnknown; var ASubDirNames: TGMStringArray);
procedure GMVsdReadValueNames(const AStorage: IUnknown; var AValueNames: TGMStringArray);
procedure GMVsdCreatePath(const AStorage: IUnknown; const ADirPath: TGMString);
function GMVsdCurrentPath(const AStorage: IUnknown): TGMString;
procedure GMVsdCommit(const AStorage: IUnknown);

procedure GMVsdLoadFromDir(const ASource: IGMValueStorage; const ALoadPath: TGMString; const ALoadProc: TGMLoadStoreValuesProc; const ACryptCtrlData: PGMCryptCtrlData = nil); overload;
procedure GMVsdLoadFromDir(const ASource: IGMValueStorage; const ALoadPath: TGMString; const ALoadIntf: IUnknown; const ACryptCtrlData: PGMCryptCtrlData = nil); overload;
procedure GMVsdStoreToDir(const ADest: IGMValueStorage; const AStorePath: TGMString; const AStoreProc: TGMLoadStoreValuesProc; const ACryptCtrlData: PGMCryptCtrlData = nil); overload;
procedure GMVsdStoreToDir(const ADest: IGMValueStorage; const AStorePath: TGMString; const AStoreIntf: IUnknown; const ACryptCtrlData: PGMCryptCtrlData = nil); overload;

procedure GMVsdLoadTree(const ASource: IGMValueStorage;
                        const AParentTreeNode: IGMTreeable;
                        const ATreeNodeCreator: IGMCreateTreeNodeWithDataObj;
                        const AParameter: IUnknown = nil;
                        const ACryptCtrlData: PGMCryptCtrlData = nil;
                        const ASubDirSeparator: TGMString = scSubNodesDirSeparator);

procedure GMStoreTree(const ADest: IGMValueStorage; ANode: IGMTreeable; var ANodeIdx: LongInt; const AStoreSiblings: Boolean; const ACryptCtrlData: PGMCryptCtrlData = nil);

procedure GMVsdCopyDirValues(const ASource, ADest: IGMStringStorage);
procedure GMVsdCopyStorageContents(const ASource, ADest: IUnknown; AStartDirPath: TGMString = '');

procedure GMStoreString(const ADest: IGMStringStorage; const AValueName, AValue: TGMString; const ADefaultValue: TGMString = cDfltReadString);
procedure GMStoreInteger(const ADest: IGMValueStorage; const AValueName: TGMString; const AValue: LongInt; const ADefaultValue: LongInt = cDfltReadInteger);
procedure GMStoreInt64(const ADest: IGMValueStorage; const AValueName: TGMString; const AValue: Int64; const ADefaultValue: Int64 = cDfltReadInteger);
procedure GMStoreBoolean(const ADest: IGMValueStorage; const AValueName: TGMString; const AValue: Boolean; const ADefaultValue: Boolean = cDfltReadBoolean);
procedure GMStoreDateTime(const ADest: IGMValueStorage; const AValueName: TGMString; const AValue: TDateTime; const ADefaultValue: TDateTime = cDfltReadDateTime);
procedure GMStoreDouble(const ADest: IGMValueStorage; const AValueName: TGMString; const AValue: Double; const ADefaultValue: Double = cDfltReadFloat);
procedure GMStoreVariant(const ADest: IGMValueStorage; const AValueName: TGMString; const AValue, ADefaultValue: OleVariant);


{ ---- ILockByte Routines ---- }

function GMLockByteSize(const LockBytes: ILockBytes): Int64;
procedure GMCopyLockBytes(const ASource, ADest: ILockBytes; const AMaxBytesToCopy: LongInt = 0; const AVerfy: Boolean = True);
procedure GMLockByteSafeReadAt(const ASource: ILockBytes; const AOffset: Int64; const APData: Pointer; const ACount: LongInt; const ACallingName: TGMString = cDfltRoutineName);
procedure GMLockByteSafeWriteAt(const ADest: ILockBytes; const AOffset: Int64; const APData: Pointer; const ACount: LongInt; const ACallingName: TGMString = cDfltRoutineName);


{ ---- Istream Routines ---- }

function GMIStreamSize(const AStream: IUnknown): Int64;
function GMIStreamPos(const AStream: IUnknown): Int64;
function GMSetIStreamAbsPos(const AStream: IUnknown; const ANewPos: Int64; const ACallingName: TGMString = cDfltRoutineName): Int64;
function GMIStreamRead(const ASource: ISequentialStream; const Data: Pointer; const DataSizeInBytes: LongWord): Cardinal;
procedure GMSafeIStreamRead(const ASource: ISequentialStream; const AData: Pointer; const ADataSizeInBytes: LongWord; const ACallingName: TGMString = cDfltRoutineName);
procedure GMSafeIStreamWrite(const ADest: ISequentialStream; const AData: Pointer; const ADataSizeInBytes: LongWord; const ACallingName: TGMString = cDfltRoutineName);
function GMIStreamReadResult(const pcbOut: Pointer; const AllDone: Boolean): HResult;
function GMIStreamWriteResult(const pcbOut: Pointer; const AllDone: Boolean): HResult;
function GMIStreamContentAsString(const ASourceStrm: ISequentialStream; StartPos: Int64 = -1; const ACallingName: TGMString = ''): AnsiString;

procedure GMCopyIStreamTime(const ASourceStrm, ADestStrm: ISequentialStream;
                            const AOnProgressProc: TGMOnProgressProc = nil;
                            const ACallBackTimeInMS: LongWord = cDfltUiResponseMS;
                            const ACallingName: TGMString = cDfltRoutineName);

procedure GMCopyIStreamBufSize(const ASourceStrm, ADestStrm: ISequentialStream;
                               const ACopyBufferSize: LongWord = cDfltCopyBufferSize;
                               const AOnProgressProc: TGMOnProgressProc = nil;
                               const ACallingName: TGMString = cDfltRoutineName);

procedure GMCopyIStream(const ASourceStrm, ADestStrm: ISequentialStream;
                        const ACopyBufferSize: LongInt = cDfltCopyBufferSize;
                        const AOnProgressProc: TGMOnProgressProc = nil;
                        const ACallingName: TGMString = cDfltRoutineName);


{ ---- Objects / Interfaces / Classes ---- }

//function GMIsOneOfClasses(const AObj: TObject; const Classes: array of TClass): Boolean;
function GMIntfClassName(const AIntf: IUnknown): TGMString;
function GMObjFromIntf(const AIntf: IUnknown): TObject;
function GMCompareIUnknown(const AIntf1, AIntf2: IUnknown): TGMCompareResult;
function GMObjAsIntf(const AObj: TObject): IUnknown; inline;
function GMGetIntfName(const AIntf: IUnknown; const ADefaultName: TGMString = ''): TGMString;
function GMGetIntfDisplayName(const AIntf: IUnknown): TGMString; // ; const ADefaultValue: TGMString = cStrUnknown
function GMGetIntfFileName(const AIntf: IUnknown; const ADefaultFileName: TGMString = ''): TGMString;
function GMIntfIIDName(const AIID: TGuid): TGMString; overload;
function GMIntfIIDName(const IIDStr: TGMString): TGMString; overload;
function GMGetObjName(const AObj: TObject; const ADefaultName: TGMString = ''): TGMString;
function GMGetObjDisplayName(const AObj: TObject): TGMString;
function GMObjClassName(const AObj: TObject): TGMString;
function GMClassName(const AClass: TClass): TGMString;
function GMGetPropertyIntf(const AObj: TObject; const PropertyName: TGMString; const AIID: TGUID; out AIntf): HResult;
function GMGetPropIntfFromIntf(const AOwner: IUnknown; const APropertyName: TGMString; const AIID: TGUID; out AIntf): HResult;
//procedure GMCheckGetPropIntfFromIntf(const Owner: IUnknown; const PropertyName: TGMString; const AIID: TGUID; out AIntf; const ACallingName: TGMString = '');
procedure GMCheckGetInterface(const AObj: TObject; const AIID: TGUID; out AIntf; const ACallingName: TGMString = cDfltRoutineName);
function GMGetInterface(const AObj: TObject; const AIID: TGUID; out AIntf): Boolean; inline;
function GMGetWeakInterface(const AObj: TObject; const AIID: TGUID; out AIntf): Boolean; inline;
function GMQueryInterface(const ASource: IUnknown; const AIID: TGUID; out AIntf): Boolean; inline;
procedure GMCheckQueryInterface(const ASource: IUnknown; const AIID: TGUID; out AIntf; const ACallingName: TGMString = cDfltRoutineName);
function GMAllInterfacesSupported(const AIntf: IUnknown; const InterfaceIDs: array of TGUID): Boolean;
procedure GMCheckAllInterfacesSupported(const AIntf: IUnknown; const InterfaceIDs: array of TGUID; const ACallingName: TGMString = cDfltRoutineName);
procedure GMCheckGetIntfByPosition(const ACollection: IGMGetIntfByPosition; const Position: LongInt; const AIID: TGUID; out AIntf; const ElementName, ACallingName: TGMString);

function GMGetIntfHandle(const AIntf: IUnknown; const ADefaultValue: THandle = 0): THandle;
function GMIsHandleAllocated(const AIntf: IUnknown): Boolean;
function GMCheckGetIntfHandle(const AIntf: IUnknown; const ACallingName: TGMString): THandle;
function GMGetAllocatedIntfHandle(const AIntf: IUnknown; var Handle: THandle): Boolean;
function GMGetAllocatedObjHandle(const AObj: TObject; var AHandle: THandle): Boolean;

function GMCreateCopyQI(const ASource: IUnknown; const AIID: TGUID; out AIntf): HResult;
function GMObjCreateCopyQI(const ASource: TObject; const AIID: TGUID; out AIntf): HResult;
function GMFindParentObj(const AObj: TObject; const AParentClass: TClass; out AParent): Boolean;
function GMIsParentObj(AParent, AObj: TObject; const AllowIdentity: Boolean = False; const AStopAtClass: TClass = nil): Boolean;
procedure GMCheckFindParentObj(const AObj: TObject; const ParentClass: TClass; out Parent);

function GMGetObjText(const AObj: TObject; const ADefaultValue: TGMString = ''): TGMString;
procedure GMSetObjText(const AObj: TObject; const AValue: TGMString);
function GMGetIntfText(const AIntf: IUnknown; const ADefaultValue: TGMString = ''): TGMString;
procedure GMSetIntfText(const AIntf: IUnknown; const AValue: TGMString);

function GMGetIntfStrValue(const AIntf: IUnknown; const ADefaultValue: TGMString = ''): TGMSTring;


{ ---- Connection Point Helpers ---- }

function GMDoNotifySink(const NotificationsEnabled: Boolean; const NotifySink: IUnknown; const AIID: TGUID; out AIntf): Boolean;
procedure GMInterfaceConnect(const AObj: TObject; const AContainer: IUnknown; const AIID: TGUID; var Cookie: LongInt; const ACallingName: TGMString = cDfltRoutineName); overload;
procedure GMInterfaceConnect(const Sink, AContainer: IUnknown; const AIID: TGUID; var Cookie: LongInt; const AObj: TObject = nil; const ACallingName: TGMString = cDfltRoutineName); overload;
procedure GMQuietInterfaceConnect(const AObj: TObject; const AContainer: IUnknown; const AIID: TGUID; var Cookie: LongInt);
procedure GMInterfaceDisconnect(const AContainer: IUnknown; const AIID: TGUID; var Cookie: LongInt);
procedure GMCpcCallNotifySinks(const Cpc: IConnectionPointContainer; const ConnectionPointIID: TGUID; const NotifyProc: TCPCNotifyProc; const NotificationsEnabled: Boolean; const Params: array of OleVariant);
procedure GMCpcCallNotifySinksObj(const Cpc: IConnectionPointContainer; const ConnectionPointIID: TGUID; const NotifyProc: TCPCNotifyProcObj; const NotificationsEnabled: Boolean; const Params: array of OleVariant);
procedure GMRequestCPCDisconnect(const Cpc: IConnectionPointContainer);


{ ---- CPC Notifiers ---- }

procedure GMCallSinkClose(const NotifySink: IUnknown; const Params: array of OleVariant);
procedure GMCallSinkBeforeActiveChange(const NotifySink: IUnknown; const Params: array of OleVariant);
procedure GMCallSinkAfterActiveChange(const NotifySink: IUnknown; const Params: array of OleVariant);
procedure GMCallSinkBeforePositionChange(const NotifySink: IUnknown; const Params: array of OleVariant);
procedure GMCallSinkAfterPositionChange(const NotifySink: IUnknown; const Params: array of OleVariant);
procedure GMCallSinkBeforeOperation(const NotifySink: IUnknown; const Params: array of OleVariant);
procedure GMCallSinkAfterOperation(const NotifySink: IUnknown; const Params: array of OleVariant);
procedure GMCallSinkValidateValue(const NotifySink: IUnknown; const Params: array of OleVariant);


{ ---- COM Helpers ---- }

function GMHrSucceeded(const AErrorCode: HResult): Boolean;
function GMSysErrorMsg(const AErrorCode: LongInt; const AParams: array of PGMChar): TGMString;
function GMCreateGuid: TGuid;
function GMIsGUID(const AGuidStr: TGMString): Boolean;
procedure GMCopyGuid(const ASource, ADest: IUnknown; const ACallingName: TGMString = cDfltRoutineName);
function GMGuidToString(const Guid: TGUID): TGMString;
function GMStringToGuid(const AGuidStr: TGMString; const ACaller: TObject = nil; const ACallingName: TGMString = cDfltRoutineName): TGUID;
function GMMakeGuidStr(const GuidStr: TGMString): TGMString;
function GMMakeGuid(GuidStr: TGMString; const AObj: TObject = nil; const ACallingName: TGMString = cDfltRoutineName): TGUID;
function GMCompareGuids(const GuidA, GuidB: TGUID): TGMCompareResult;
function GMEqualGuids(const GuidA, GuidB: TGUID): Boolean;
function GMCreateComObject(const ClassID: TGUID; const CreateContext: DWORD = cDfltCoCeateContext): IUnknown;
function GMCoClassIsRegistered(const ClassId: TGUID): Boolean;


{ ---- Storage Routines ---- }

function GMIsStorageGuid(const Storage: IStorage; const Guid: TGUID; const Caller: TObject = nil): Boolean;
function GMIsStorageFileGuid(const FileName: TGMString; const Guid: TGUID; const Caller: TObject = nil): Boolean;
procedure GMCheckIsStorageGuid(const Storage: IStorage; const Guid: TGUID; const Caller: TObject = nil);
procedure GMCheckIsStorageFileGuid(const FileName: TGMString; const Guid: TGUID; const Caller: TObject = nil);


{ ---- Error Message Format Helpers ---- }

function GMSeverityName(const Aseverity: TGMSeverityLevel): TGMString;
function BuildCallingName(const ACallingName, ThisName: TGMString): TGMString;
function MsgInconsistentClassSize(const ClassName: TGMString): TGMString;
function MsgUnsupportedFieldDataType(const OrdinalValue: LongInt): TGMString;
function MsgUnknownValue(const ValueName: TGMString; const Value: LongInt): TGMString;
function MsgUnsupportedValue(const ValueName: TGMString; const Value: LongInt): TGMString;
function MsgUnknownFieldDataType(const OrdinalValue: LongInt): TGMString;
function MsgUnknownPropVal(const PropertyName: TGMString; const Value: LongInt): TGMString;
function MsgIntfNotSupported(const Name: TGMString; const AIID: TGuid): TGMString;
function MsgNoItemIntfPrefix(const Name: TGMString; const AIID: TGuid): TGMString;
function MsgNoOwnerClass(const ClassName: TGMString): TGMString;
function MsgOutOfRange(const ValueName: TGMString; const Value: LongInt; const MinVal: LongInt; const MaxVal: LongInt): TGMString;
function MsgUnsupportedOperation(const OrdinalValue: LongInt): TGMString;
function MsgInvalidStateTransition(const OldState, NewState: LongInt): TGMString;
function MsgUnknownQestionOrdinal(const Question: LongInt): TGMString;
function MsgMemoryTooSmall(const BufferName: TGMString; const BufferSize, RequiredSize: LongInt): TGMString;
function MsgPointerIsNil(const PointerName: TGMString): TGMString;
//function MsgModuleNotInstalled(const ModuleName, ErrorMsg, DownloadURL: TGMString): TGMString;


procedure GMCheckPointerAssigned(const Ptr: Pointer; const PointerName: TGMString; const AObj: TObject = nil; const ACallingName: TGMString = cDfltRoutineName);
procedure GMCheckIntRange(const ValueName: TGMString; const Value, MinValue, MaxValue: PtrInt; const AObj: TObject = nil; const ACallingName: TGMString = cDfltRoutineName);
procedure GMCheckMemorySize(const BufferName: TGMString; const BufferSize, RequiredSize: PtrInt; const AObj: TObject = nil; const ACallingName: TGMString = cDfltRoutineName);
procedure GMTraceQueryInterface(const AObj: TObject; const AIID: TGuid; const AResult: HResult);
{$IFDEF DEBUG}
procedure GMCheckRefCountIsZero(const ARefCount: LongInt; const AObj: TObject);
{$ENDIF}

function GMCoTaskStrDupW(const AValue: WideString): PWideChar;


{ ---- Lists as Strings ---- }

function GMStringJoin(const ALeftStr, ASeparator, ARightStr: TGMString): TGMString;
function GMSeparatedStrings(const AStrings: array of TGMString; const ASeparator: TGMString = ', '): TGMString;
function GMSeparatedNames(const ACollection: IUnknown; const ASeparator: TGMString = ', '): TGMString;
function GMSeparatedValues(const ACollection: IUnknown; const AVarToStrFunc: TGMUnionValToStrFunc; const ASeparator: TGMString = ', '): TGMString;
function GMNamesAndValuesAsString(const ACollection: IUnknown; const AVarToStrFunc: TGMUnionValToStrFunc; const ASeparator: TGMString = ', '; const AOperator: TGMString = ' = '; const AOmitNullValues: Boolean = False): TGMString;

function GMColumnDesc(const ATitle: TGMString; const AWidth: LongInt; const AAlignment: TGMDfltHorizontalAlignment = haLeft): TGMColumnDescRec;


{ ---- Additional error message modules ---- }

procedure GMRegisterErrorMsgModule(const AModuleName: TGMString);
procedure GMExtendExceptionMsg(const AException: TObject; const AAddition: TGMString; const ASeparator: TGMString = ': '; const APrefix: Boolean = True);

function GMFileAttributeName(const AFileAttribute: TFileAttribute): TGMString;
function GMMatchKindName(const AMatchKind: TMatchKind): TGMString;


resourcestring

  RStrInterface = '<Interface>';
  RStrNil = '<nil>';
  RStrCPC = 'Connection point container';

  RStrUnknownSysErrorMsgFmt = 'Unknown system error code: %d';

  RStrField = 'Field';
//RStrStreamRead = 'Stream read';
//RStrStreamWrite = 'Stream write';
  RStrProperty = 'Property';
  RStrMethod = 'Method';
  //RStrItemByNameNoIntf = '%s %s doesn''t exist or';
  RStrRefCountFmt = '%s [%p] "%s" Reference Count at Destruction = %d';
  RStrAskShowAgain = 'Shall this Message be shown again?';
  RStrNoCPForIntf = '%s has no Connection Point for the Interface: %s';
  RStrSysErrorCodeFmt = 'System Error, Code Hex: 0x%X,  Code Dez: %d';
  RStrInvalidParamCountFmt = 'Unsupported number of Parameter: %d';
  RStrMissingPropVal = 'The "%s" property must be set before the component can be activated';
  RStrUnsupportedIdxType = 'Unsupported Datatype "%s" used for indexing';
  RStrNoIntfFmt = '%s [%p] "%s" Interface not Supported: %s %s';
  RStrNoItemIntf = 'Unable to get interface %s for item "%s"';
  RStrNeedRTTI = 'Class "%s" must be declared with the $M+ compiler directive to access properties.';
  RStrFieldNotFound = 'Field "%s" not found in "%s"';
  RStrNoValueForItemFmt = 'Cannot get a value for item "%s" at position %d';
  RStrCreateDirFailed = 'Failed to create persistent directory "%s"';
  srCannotCallNilIntf = 'RGMTypedIntf<%s>.Call: Cannot call any method on NIL interface pointer';

  srCollectionelement = 'Collection element';
  RStrValue = 'Value';

  RStrExactMatch = 'Exact Match';
  RStrClosestMatch = 'Closest Match';

  RStrArchive = 'Archiv';
  RStrCompressed = 'Compressed';
  RStrDirectory = 'Directory';
  RStrEncrypted = 'Encrypted';
  RStrHidden = 'Hidden';
  RStrNormal = 'Normal';
  RStrOffline = 'Offline';
  RStrReadOnly = 'Readonly';
  RStrReparsePoint = 'Reparse point';
  RStrSparse = 'Sparse';
  RStrSystem = 'System';
  RStrTemporary = 'Temporary';

  RStrError = 'Error';
  RStrInformation = 'Information';
  RStrWarning = 'Warning';
  RStrConfirm = 'Confirm';

  RStrNullAllowed = 'NULL allowed';
  RStrNotNull = 'Not NULL';

  srAscending = 'Ascending';
  srDescending = 'Descending';

  RStrUnique = 'Unique';
  RStrDuplicatesAlloed = 'Duplicates allowed';


  RStrInvalidCompareResult = 'Invalid Compare Result';


const

  cEnumElementCount: array [Boolean] of LongInt = (0, 1);
  cHRSeverity: array [Boolean] of TGMSeverityLevel = (svInformation, svError);

  CQIResult: array [Boolean] of HResult = (E_NOINTERFACE, S_OK);

  GM_E_STREAMWRITE = STG_E_CANTSAVE;
  GM_E_STREAMREAD = E_FAIL; // E_UNEXPECTED;

  {$IFDEF FPC}
  {$IFNDEF JEDIAPI}
  {$EXTERNALSYM IDI_APPLICATION}
  IDI_APPLICATION = PGMChar(ULONG_PTR(WORD(32512)));
  {$EXTERNALSYM IDI_HAND}
  IDI_HAND = LPTSTR(ULONG_PTR(WORD(32513)));
  {$EXTERNALSYM IDI_QUESTION}
  IDI_QUESTION = LPTSTR(ULONG_PTR(WORD(32514)));
  {$EXTERNALSYM IDI_EXCLAMATION}
  IDI_EXCLAMATION = LPTSTR(ULONG_PTR(WORD(32515)));
  {$EXTERNALSYM IDI_ASTERISK}
  IDI_ASTERISK = LPTSTR(ULONG_PTR(WORD(32516)));
  {$EXTERNALSYM IDI_WINLOGO}
  IDI_WINLOGO = LPTSTR(ULONG_PTR(WORD(32517)));
  {$EXTERNALSYM IDI_WARNING}
  IDI_WARNING = IDI_EXCLAMATION;
  {$EXTERNALSYM IDI_ERROR}
  IDI_ERROR = IDI_HAND;
  {$EXTERNALSYM IDI_INFORMATION}
  IDI_INFORMATION = IDI_ASTERISK;
  {$ENDIF}
  {$ENDIF}


var

  vShowRefCountWarnings: Boolean = {$IFDEF DEBUG}True;{$ELSE}False;{$ENDIF}
  {$IFDEF DEBUG}
  vfGMCheckRefCountOnDestroy: TGMCheckRefCountProc = GMCheckRefCountIsZero;
  {$ELSE}
  vfGMCheckRefCountOnDestroy: TGMCheckRefCountProc = nil;
  {$ENDIF}

//vGMFileAttributeNames: array [TFileAttribute] of TGMString =
// (RStrArchive, RStrCompressed, RStrDirectory, RStrEncrypted, RStrHidden, RStrNormal, RStrOffline,
//  RStrReadOnly, RStrReparsePoint, RStrSparse, RStrSystem, RStrTemporary);

  vGMSevrityIcons: array [TGMSeverityLevel] of Pointer = (nil, IDI_QUESTION, IDI_INFORMATION, IDI_WARNING, IDI_ERROR);
//vMatchKindNames: array [TMatchKind] of TGMString = (RStrExactMatch, RStrClosestMatch);

  vGMComInitFlags: LongInt = cDfltCoInitFlags;


implementation

uses GMCommon, GMStrBuilder {$IFDEF JEDIAPI}, jwaWinReg, jwaWinBase{$ENDIF}
     {$IFDEF DELPHI6}, Variants{$ENDIF}
     ;

var

  vGMErrorMsgModules: TGMStringArray;


resourcestring

  RStrUnsupportedValue = 'Unsupported value (%d) for "%s"';
  RStrUnknownValue = 'Unknown Value (%d) for "%s"';
  RStrMsgOutOfRangeFmt = '%s out of range: %d. The Value must be in Interval [%d, %d]';
  RStrMsgUnsupportedOperation = 'Operation not supported, Ord(Operation): %d';
  RStrIntfNotSupported = '%s doesn''t support the Interface: %s';
  RStrUnknownPropVal = 'Unknown Value of Property "%s", value: %d';
  RStrNoOwnerClass = 'No owner Component with class "%s" found';
  RStrInvalidstateTransition = 'Invalid State transition, Ord(OldState): %d, Ord(NewState): %d';
  RStrCheckActive = 'The %s can only be used when the Object is Active';
  RStrCheckInactive = 'The %s cannot be changed while the Object is active';
  RStrUnknownQestionOrdinal = 'Unknown Ordinal Value for Boolean Question: %d';
  RStrOperationExecFailed = 'Failed to execute operation %s';
  RStrUnsupoortedBoolQuestion = 'Unsupported Question ID: %d';
  RStrUnsupportedValueId = 'Unsupported Value ID: %d';
  RStrInconsistentclassSize = 'Inconsistent class Size: %s';
  RStrInvalidStorageGuid = 'Invalid Storage GUID, requested GUID %s storage GUID %s';
  RStrNoParentFmt = 'The object "%s" has no parent of class "%s"';
  RStrMemoryTooSmall = '%s size too small (%d Bytes), must be at least %d Bytes';
  RStrPtrIsNil = '%s is <nil>';
  RStrTheObject = 'The Object';
  RStrTheList = 'The List';


  //RStrModuleNotInstalled = 'The ''%s'' has not been installed on this System.';
  //RStrModuleDownload = 'It can be downloaded from: %s.';
//RStrModuleErrorMsg = 'The System Error Message was:'#13 +
//                     '---------------------------------------------------'#13 +
//                     '%s';



{ -------------------------------------- }
{ ---- Error message Format Helpers ---- }
{ -------------------------------------- }

function GMSeverityName(const ASeverity: TGMSeverityLevel): TGMString;
begin
  case ASeverity of
   svInformation: Result := RStrInformation;
   svConfirmation: Result := RStrConfirm;
   svWarning: Result := RStrWarning;
   svError: Result := RStrError;
   else Result := '';
  end;
end;

function GMFileAttributeName(const AFileAttribute: TFileAttribute): TGMString;
begin
  case AFileAttribute of
   faArchive: Result := RStrArchive;
   faCompressed: Result := RStrCompressed;
   faDirectory: Result := RStrDirectory;
   faEncrypted: Result := RStrEncrypted;
   faHidden: Result := RStrHidden;
   faNormal: Result := RStrNormal;
   faOffline: Result := RStrOffline;
   faReadOnly: Result := RStrReadOnly;
   faReparsePoint: Result := RStrReparsePoint;
   faSparse: Result := RStrSparse;
   faSystem: Result := RStrSystem;
   faTemporary: Result := RStrTemporary;
   else Result := '';
  end;
end;

function GMMatchKindName(const AMatchKind: TMatchKind): TGMString;
begin
  case AMatchKind of
   mkExactMatch: Result := RStrExactMatch;
   mkNearestMatch: Result := RStrClosestMatch;
   else Result := '';
  end;
end;

function BuildCallingName(const ACallingName, ThisName: TGMString): TGMString;
begin
  if ACallingName <> cDfltRoutineName then Result := ACallingName else Result := ThisName;
end;

function MsgInconsistentClassSize(const ClassName: TGMString): TGMString;
begin
  Result := GMFormat(RStrInconsistentclassSize, [ClassName]);
end;

function MsgUnsupportedFieldDataType(const OrdinalValue: LongInt): TGMString;
begin
  Result := GMFormat(RStrUnsupportedValue, [OrdinalValue, cStrFieldDataTypeName]);
end;

function MsgUnknownValue(const ValueName: TGMString; const Value: LongInt): TGMString;
begin
  Result := GMFormat(RStrUnknownValue, [Value, ValueName]);
end;

function MsgUnsupportedValue(const ValueName: TGMString; const Value: LongInt): TGMString;
begin
  Result := GMFormat(RStrUnsupportedValue, [Value, ValueName]);
end;

function MsgUnknownFieldDataType(const OrdinalValue: LongInt): TGMString;
begin
  Result := MsgUnknownValue(cStrFieldDataTypeName, OrdinalValue);
end;

function MsgUnknownPropVal(const PropertyName: TGMString; const Value: LongInt): TGMString;
begin
  Result := GMFormat(RStrUnknownPropVal, [PropertyName, Value]);
end;

function MsgIntfNotSupported(const Name: TGMString; const AIID: TGuid): TGMString;
begin
  Result := GMFormat(RStrIntfNotSupported, [Name, GMGuidToString(AIID)]);
end;

function MsgNoItemIntfPrefix(const Name: TGMString; const AIID: TGuid): TGMString;
begin
  Result := GMFormat(RStrNoItemIntf + ': ', [GMGuidToString(AIID), Name]);
end;

{function MsgNoIntfOrNotExist(const Kind, Name: TGMString; const AIID: TGuid): TGMString;
begin
  Result := MsgIntfNotSupported(GMFormat(RStrItemByNameNoIntf, [Kind, Name]), AIID);
end;}

function MsgNoOwnerClass(const ClassName: TGMString): TGMString;
begin
  Result := GMFormat(RStrNoOwnerClass, [ClassName]);
end;

function MsgOutOfRange(const ValueName: TGMString; const Value: LongInt; const MinVal: LongInt; const MaxVal: LongInt): TGMString;
begin
  Result := GMFormat(RStrMsgOutOfRangeFmt, [ValueName, Value, MinVal, MaxVal]);
end;

function MsgUnsupportedOperation(const OrdinalValue: LongInt): TGMString;
begin
  Result := GMFormat(RStrMsgUnsupportedOperation, [OrdinalValue]);
end;

function MsgInvalidStateTransition(const OldState, NewState: LongInt): TGMString;
begin
  Result := GMFormat(RStrInvalidstateTransition, [OldState, NewState]);
end;

function MsgUnknownQestionOrdinal(const Question: LongInt): TGMString;
begin
  Result := GMFormat(RStrUnknownQestionOrdinal, [Question]);
end;

function MsgMemoryTooSmall(const BufferName: TGMString; const BufferSize, RequiredSize: LongInt): TGMString;
begin
  Result := GMFormat(RStrMemoryTooSmall, [BufferName, BufferSize, RequiredSize]);
end;

function MsgPointerIsNil(const PointerName: TGMString): TGMString;
begin
  Result := GMFormat(RStrPtrIsNil, [PointerName]);
end;

//function MsgModuleNotInstalled(const ModuleName, ErrorMsg, DownloadURL: TGMString): TGMString;
////const C2Line = #13#13;
//begin
//Result := GMFormat(RStrModuleNotInstalled + c2NewLine, [ModuleName]);
//if DownloadURL <> '' then Result := Result + GMFormat(RStrModuleDownload + c2NewLine, [DownloadURL]);
//if ErrorMsg <> '' then Result := Result + GMFormat(RStrModuleErrorMsg, [ErrorMsg]);
//end;


{ ------------------------------- }
{ ---- String array routines ---- }
{ ------------------------------- }

function GMStringArray(const AStrings: array of TGMString): TGMStringArray;
var i: LongInt;
begin
  SetLength(Result, Length(AStrings));
  for i:=Low(AStrings) to High(AStrings) do Result[i] := AStrings[i];
end;

procedure GMAddStrToArray(const AValue: TGMString; var AStringArray: TGMStringArray; const AAddEmptyStrings: Boolean);
begin
  if AAddEmptyStrings or (Length(AValue) > 0) then
   begin
    SetLength(AStringArray, Length(AStringArray)+1);
    AStringArray[High(AStringArray)] := AValue;
   end;
end;

function GMStrArrayAsText(const AStrings: TGMStringArray; const ASeparator: TGMString = cNewLine): TGMString;
var i: LongInt; resStr: RGMStringBuilder;
begin
  //Result := '';
  for i:=Low(AStrings) to High(AStrings) do resStr.Join(ASeparator, AStrings[i]); // Result := GMStringJoin(Result, ASeparator, AStrings[i]);
  Result := resStr;
end;

function GMIndexOfStrInArray(const AValue: TGMString; const AStringArray: TGMStringArray): PtrInt;
begin
  for Result:=Low(AStringArray) to High(AStringArray) do if GMSameText(AStringArray[Result], AValue) then Exit;
  Result := cInvalidItemIdx;
end;

function GMFindStrInArray(const AValue: TGMString; const AStringArray: TGMStringArray; var AIdx: PtrInt): Boolean;
begin
  AIdx := GMIndexOfStrInArray(AValue, AStringArray);
  Result := AIdx <> cInvalidItemIdx;
end;

procedure GMDeleteStrInArray(var AStringArray: TGMStringArray; const AIdx: PtrInt);
var i: LongInt;
begin
  if not GMIsInRange(AIdx, Low(AStringArray), High(AStringArray)) then Exit;
  for i:=AIdx to High(AStringArray)-1 do AStringArray[i] := AStringArray[i+1];
  SetLength(AStringArray, Length(AStringArray)-1);
end;


{ ------------------------- }
{ ---- Buffer Checking ---- }
{ ------------------------- }

procedure GMCheckPointerAssigned(const Ptr: Pointer; const PointerName: TGMString; const AObj: TObject; const ACallingName: TGMString);
begin
  if Ptr = nil then raise EGMException.ObjError(MsgPointerIsNil(PointerName), AObj, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
end;

procedure GMCheckIntRange(const ValueName: TGMString; const Value, MinValue, MaxValue: PtrInt; const AObj: TObject; const ACallingName: TGMString);
begin
  if not GMIsInRange(Value, MinValue, MaxValue) then
     raise EGMException.ObjError(MsgOutOfRange(ValueName, Value, MinValue, MaxValue), AObj, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
end;

procedure GMCheckMemorySize(const BufferName: TGMString; const BufferSize, RequiredSize: PtrInt; const AObj: TObject; const ACallingName: TGMString);
begin
  if BufferSize < RequiredSize then
   raise EGMException.ObjError(MsgMemoryTooSmall(BufferName, BufferSize, RequiredSize), AObj, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
end;

function GMCoTaskStrDupW(const AValue: WideString): PWideChar;
begin
  Result := CoTaskMemAlloc((Length(AValue) + 1) * SizeOf(WideChar));
  if Result = nil then raise EGMHrException.ObjError(E_OUTOFMEMORY, [], nil, {$I %CurrentRoutine%});
  Move(PWideChar(AValue)^, Result^, (Length(AValue) + 1) * SizeOf(WideChar));
end;

{$IFDEF DEBUG}
procedure GMCheckRefCountIsZero(const ARefCount: LongInt; const AObj: TObject);
var Msg: TGMString;
begin
  if ARefCount <> 0 then
   begin
    Msg := GMFormat(RStrRefCountFmt, [GMObjClassName(AObj), Pointer(AObj), GMGetObjName(AObj), ARefCount]);
    GMTrace(Msg, tpWarning);  
    if vShowRefCountWarnings then vShowRefCountWarnings := vfGMMessageBox(Msg + c2NewLine + RStrAskShowAgain, svWarning, MB_YESNO) = IdYes;
   end;
end;
{$ENDIF}

procedure GMTraceQueryInterface(const AObj: TObject; const AIID: TGuid; const AResult: HResult);
begin
  if AResult = S_OK then Exit;
  GMTrace(GMFormat(RStrNoIntfFmt, [GMObjClassName(AObj), Pointer(AObj), GMGetObjName(AObj), GMIntfIIDName(AIID), GMGuidToString(AIID)]), tpInterface);
end;


{ ------------------------------------ }
{ ---- File Attribute conversions ---- }
{ ------------------------------------ }

function GMDWordToFileAttributes(const AValue: DWORD): TFileAttributes;
begin
  Result := [];
  if AValue and FILE_ATTRIBUTE_ARCHIVE <> 0 then Include(Result, faArchive);
  if AValue and FILE_ATTRIBUTE_COMPRESSED <> 0 then Include(Result, faCompressed);
  if AValue and FILE_ATTRIBUTE_DIRECTORY <> 0 then Include(Result, faDirectory);
  if AValue and FILE_ATTRIBUTE_ENCRYPTED <> 0 then Include(Result, faEncrypted);
  if AValue and FILE_ATTRIBUTE_HIDDEN <> 0 then Include(Result, faHidden);
  if AValue and FILE_ATTRIBUTE_NORMAL <> 0 then Include(Result, faNormal);
  if AValue and FILE_ATTRIBUTE_OFFLINE <> 0 then Include(Result, faOffline);
  if AValue and FILE_ATTRIBUTE_READONLY <> 0 then Include(Result, faReadOnly);
  if AValue and FILE_ATTRIBUTE_REPARSE_POINT <> 0 then Include(Result, faReparsePoint);
  if AValue and FILE_ATTRIBUTE_SPARSE_FILE <> 0 then Include(Result, faSparse);
  if AValue and FILE_ATTRIBUTE_SYSTEM <> 0 then Include(Result, faSystem);
  if AValue and FILE_ATTRIBUTE_TEMPORARY <> 0 then Include(Result, faTemporary);
end;

function GMFileAttributesToDWORD(const AValue: TFileAttributes): DWORD;
begin
  Result := 0;
  if faArchive in AValue then Result := Result or FILE_ATTRIBUTE_ARCHIVE;
  if faCompressed in AValue then Result := Result or FILE_ATTRIBUTE_COMPRESSED;
  if faDirectory in AValue then Result := Result or FILE_ATTRIBUTE_DIRECTORY;
  if faEncrypted in AValue then Result := Result or FILE_ATTRIBUTE_ENCRYPTED;
  if faHidden in AValue then Result := Result or FILE_ATTRIBUTE_HIDDEN;
  if faNormal in AValue then Result := Result or FILE_ATTRIBUTE_NORMAL;
  if faOffline in AValue then Result := Result or FILE_ATTRIBUTE_OFFLINE;
  if faReadOnly in AValue then Result := Result or FILE_ATTRIBUTE_READONLY;
  if faReparsePoint in AValue then Result := Result or FILE_ATTRIBUTE_REPARSE_POINT;
  if faSparse in AValue then Result := Result or FILE_ATTRIBUTE_SPARSE_FILE;
  if faSystem in AValue then Result := Result or FILE_ATTRIBUTE_SYSTEM;
  if faTemporary in AValue then Result := Result or FILE_ATTRIBUTE_TEMPORARY;
end;


{ ------------------------- }
{ ---- String Routines ---- }
{ ------------------------- }

function GMStringJoin(const ALeftStr, ASeparator, ARightStr: TGMString): TGMString;
begin
  if Length(ARightStr) <= 0 then Result := ALeftStr
  else
  if Length(ALeftStr) <= 0 then Result := ARightStr
  else
  if Length(ASeparator) <= 0 then Result := ALeftStr + ARightStr
  else
  Result := ALeftStr + ASeparator + ARightStr;
end;

function GMSeparatedStrings(const AStrings: array of TGMString; const ASeparator: TGMString): TGMString;
var i: LongInt; resStr: RGMStringBuilder;
begin
  //Result := '';
  for i:=Low(AStrings) to high(AStrings) do resStr.Join(ASeparator, AStrings[i]);
   //Result := GMStringJoin(Result, ASeparator, AStrings[i]);
  Result := resStr;
end;

function GMSeparatedNames(const ACollection: IUnknown; const ASeparator: TGMString): TGMString;
var i: LongInt; PICount: IGMGetCount; PIIntfByPosition: IGMGetIntfByPosition; PIName: IGMGetName; resStr: RGMStringBuilder;
begin                                                                             
  //Result := '';
  GMCheckQueryInterface(ACollection, IGMGetCount, PICount, {$I %CurrentRoutine%});
  GMCheckQueryInterface(ACollection, IGMGetIntfByPosition, PIIntfByPosition, {$I %CurrentRoutine%});

  for i:=0 to PICount.Count-1 do
   begin
    GMCheckGetIntfByPosition(PIIntfByPosition, i, IGMGetName, PIName, srCollectionelement, {$I %CurrentRoutine%});
    //Result := GMStringJoin(Result, ASeparator, PIName.Name);
    resStr.Join(ASeparator, PIName.Name);
   end;
  Result := resStr;
end;

function GMSeparatedValues(const ACollection: IUnknown; const AVarToStrFunc: TGMUnionValToStrFunc; const ASeparator: TGMString): TGMString;
var i: LongInt; PICount: IGMGetCount; PIIntfByPosition: IGMGetIntfByPosition; PIValue: IGMGetUnionValue; resStr: RGMStringBuilder;
begin
  //Result := '';
  Assert(Assigned(AVarToStrFunc), 'Assigned(AVarToStrFunc)');
  GMCheckQueryInterface(ACollection, IGMGetCount, PICount, {$I %CurrentRoutine%});
  GMCheckQueryInterface(ACollection, IGMGetIntfByPosition, PIIntfByPosition, {$I %CurrentRoutine%});

  for i:=0 to PICount.Count-1 do
   begin
    GMCheckGetIntfByPosition(PIIntfByPosition, i, IGMGetUnionValue, PIValue, srCollectionelement, {$I %CurrentRoutine%});
    //Result := GMStringJoin(Result, ASeparator, AVarToStrFunc(PIValue.Value));
    resStr.Join(ASeparator, AVarToStrFunc(PIValue.Value));
   end;
  Result := resStr;
end;

function GMNamesAndValuesAsString(const ACollection: IUnknown; const AVarToStrFunc: TGMUnionValToStrFunc; const ASeparator, AOperator: TGMString; const AOmitNullValues: Boolean): TGMString;
var i: LongInt; count: IGMGetCount; intfByPos: IGMGetIntfByPosition; getName: IGMGetName; getVal: IGMGetUnionValue; getText: IGMGetText;
    valStr: TGMString; resStr: RGMStringBuilder;
begin
  //Result := '';
  Assert(Assigned(AVarToStrFunc), 'Assigned(AVarToStrFunc)');
  GMCheckQueryInterface(ACollection, IGMGetCount, count, {$I %CurrentRoutine%});
  GMCheckQueryInterface(ACollection, IGMGetIntfByPosition, intfByPos, {$I %CurrentRoutine%});

  for i:=0 to count.Count-1 do
   begin
    GMCheckGetIntfByPosition(intfByPos, i, IGMGetName, getName, srCollectionelement, {$I %CurrentRoutine%});
//  GMCheckGetIntfByPosition(intfByPos, i, IGMGetUnionValue, getVal, srCollectionelement, {$I %CurrentRoutine%});

//  valStr := '';
    if intfByPos.GetIntfByPosition(i, IGMGetUnionValue, getVal) = S_OK then valStr := AVarToStrFunc(getVal.Value)
    else
    if intfByPos.GetIntfByPosition(i, IGMGetText, getText) = S_OK then valStr := getText.Text
    else raise EGMException.IntfError(GMFormat(RStrNoValueForItemFmt, [getName.Name, i]), getName, {$I %CurrentRoutine%});

    if not AOmitNullValues or not getVal.Value.IsNullOrUnassigned then
       //Result := GMStringJoin(Result, ASeparator, getName.Name + AOperator + valStr); // <- dont StrJoin the latter part! GMStringJoin(getName.Name, AOperator, valStr)
       resStr.Join(ASeparator, getName.Name + AOperator + valStr); // <- dont StrJoin the latter part! GMStringJoin(getName.Name, AOperator, valStr)
   end;
  Result := resStr;
end;

function GMColumnDesc(const ATitle: TGMString; const AWidth: LongInt; const AAlignment: TGMDfltHorizontalAlignment = haLeft): TGMColumnDescRec;
begin
  Result.Title := ATitle;
  Result.Width := AWidth;
  Result.Alignment := AAlignment;
end;


{ ------------------------------ }
{ ---- Objects / Interfaces ---- }
{ ------------------------------ }

{function GMIsOneOfClasses(const AObj: TObject; const Classes: array of TClass): Boolean;
var i: LongInt;
begin
  // if Classes is empty Result is True!
  Result := Length(Classes) = 0;
  if not Result then for i:=Low(Classes) to High(Classes) do if Obj is Classes[i] then begin Result := True; Break; end;
end;}

function GMIntfClassName(const AIntf: IUnknown): TGMString;
var obiInfo: IGMObjInfo;
begin
 if not GMQueryInterface(AIntf, IGMObjInfo, obiInfo) then
  Result := RStrInterface
 else
  Result := obiInfo.ClassName;
end;

function GMObjClassName(const AObj: TObject): TGMString;
begin
  if AObj = nil then Result := RStrNil else Result := AObj.ClassName;
end;

function GMClassName(const AClass: TClass): TGMString;
begin
  if AClass = nil then Result := RStrNil else Result := AClass.ClassName;
end;

function GMGetIntfName(const AIntf: IUnknown; const ADefaultName: TGMString): TGMString;
var getName: IGMGetName;
begin
  if GMQueryInterface(AIntf, IGMGetName, getName) then Result := getName.Name else Result := ADefaultName;
end;

function GMGetIntfDisplayName(const AIntf: IUnknown): TGMString; // ; const ADefaultValue: TGMString = cStrUnknown
var name: IGMGetName;
begin
  if AIntf = nil then Result := RStrNil else
    if GMQueryInterface(AIntf, IGMGetName, name) then Result := name.Name else Result := RStrUnknown;
end;

function GMGetIntfFileName(const AIntf: IUnknown; const ADefaultFileName: TGMString): TGMString;
var fileName: IGMGetFileName;
begin
  if AIntf = nil then Result := ADefaultFileName else
   if GMQueryInterface(AIntf, IGMGetFileName, fileName) then Result := fileName.FileName else Result := ADefaultFileName;
end;

function GMIntfIIDName(const IIDStr: TGMString): TGMString;
begin
  Result := GMIntfIIDName(GMStringToGuid(IIDStr));
end;

function GMIntfIIDName(const AIID: TGuid): TGMString;
var RegKey: IGMRegKey;
begin
  RegKey := TGMRegKey.Create;
  if RegKey.Obj.OpenKey(HKEY_CLASSES_ROOT, '\Interface\' + GMGuidToString(AIID)) then
   Result := RegKey.Obj.ReadString('') else Result := RStrUnknown;
end;

function GMGetObjName(const AObj: TObject; const ADefaultName: TGMString = ''): TGMString;
var getName: IGMGetName;
begin
  if GMGetInterface(AObj, IGMGetName, getName) then Result := getName.Name else Result := ADefaultName;
end;

function GMGetObjDisplayName(const AObj: TObject): TGMString;
begin
  if AObj = nil then Result := RStrNil
  else
  {$IFDEF DELPHIVCL}
  if AObj is TComponent then Result := (>Obj as TComponent).Name
  else
  {$ENDIF}
  Result := GMGetObjName(AObj, RStrUnknown);
end;

procedure GMEnableObj(const AObj: TObject; const AEnabled: Boolean);
begin
  GMEnableIntf(GMObjAsIntf(AObj), AEnabled);
end;

function GMGetIntfEnabled(const AIntf: IUnknown; const ADefaultValue: Boolean = False): Boolean;
var getEnabled: IGMGetEnabled;
begin
  if GMQueryInterface(AIntf, IGMGetEnabled, getEnabled) then Result := getEnabled.Enabled else Result := ADefaultValue;
end;

function GMGetObjEnabled(const AObj: TObject; const ADefaultValue: Boolean = False): Boolean;
var getEnabled: IGMGetEnabled;
begin
  if GMGetInterface(AObj, IGMGetEnabled, getEnabled) then Result := getEnabled.Enabled else Result := ADefaultValue;
end;

procedure GMEnableIntf(const AIntf: IUnknown; const AEnabled: Boolean);
var enable: IGMGetSetEnabled;
begin
  if GMQueryInterface(AIntf, IGMGetSetEnabled, enable) then enable.SetEnabled(AEnabled);
end;

function GMTreeableNodeLevel(ANode: IGMTreeable): Integer;
begin
  Result := 0;
  while ANode <> nil do begin ANode := ANode.Parent; Inc(Result); end;
end;

function GMInitNodeVisitData(const ADataClass: TClass; const ANodeTitle: TGMString; const ANode: IGMTreeable; const ASearchIndex: LongInt): RGMNodeVisitData;
begin
  Result.DataClass := ADataClass;
  Result.NodeTitle := ANodeTitle;
  Result.Node := ANode;
  Result.Index := 0;
  Result.SearchIdx := ASearchIndex;
end;

{$push}
{$macro on}
{$define DoNodeVisitRootFirstInnerFunc:=function DoNodeVisit(ANode: IGMTreeable): Boolean;
  begin
    Result := True;
    while (ANode <> nil) and Result do
     begin
      Result := AVisitFunc(ANode, AParameter);
      if ARecurse and Result then Result := DoNodeVisit(ANode.FirstChild);
      ANode := ANode.NextSibling;
     end;
  end;}

function GMVisitNodesRootFirst(const AStartNode: IGMTreeable; const AVisitFunc: TGMNodeVisitFunc; const ARecurse: Boolean; const AParameter: Pointer): Boolean;
  {.$I DoNodeVisit.inc}
  DoNodeVisitRootFirstInnerFunc
begin
  if Assigned(AVisitFunc) then Result := DoNodeVisit(AStartNode) else Result := True;
end;

function GMVisitNodesRootFirst(const AStartNode: IGMTreeable; const AVisitFunc: TGMNodeVisitMethod; const ARecurse: Boolean; const AParameter: Pointer): Boolean;
  {.$I DoNodeVisit.inc}
  DoNodeVisitRootFirstInnerFunc
begin
  if Assigned(AVisitFunc) then Result := DoNodeVisit(AStartNode) else Result := True;
end;

{$define DoNodeVisitDepthFirstInnerFunc:=  function DoNodeVisitDepthFirst(ANode: IGMTreeable): Boolean;
  begin
    Result := True;
    while (ANode <> nil) and Result do
     begin
      if ARecurse and Result then Result := DoNodeVisitDepthFirst(ANode.FirstChild);
      if Result then Result := AVisitFunc(ANode, AParameter);
      ANode := ANode.NextSibling;
     end;
  end;}

function GMVisitNodesDepthfirst(const AStartNode: IGMTreeable; const AVisitFunc: TGMNodeVisitFunc; const ARecurse: Boolean; const AParameter: Pointer): Boolean;
  {.$I DoNodeVisitDepthfirst.inc}
  DoNodeVisitDepthFirstInnerFunc
begin
  if Assigned(AVisitFunc) then Result := DoNodeVisitDepthFirst(AStartNode) else Result := True;
end;

function GMVisitNodesDepthfirst(const AStartNode: IGMTreeable; const AVisitFunc: TGMNodeVisitMethod; const ARecurse: Boolean; const AParameter: Pointer): Boolean;
  {.$I DoNodeVisitDepthfirst.inc}
  DoNodeVisitDepthFirstInnerFunc
begin
  if Assigned(AVisitFunc) then Result := DoNodeVisitDepthFirst(AStartNode) else Result := True;
end;

{$pop}

function GMFindRootNode(const ANode: IUnknown): IGMTreeable;
begin
  GMQueryInterface(ANode, IGMTreeable, Result);
  while (Result <> nil) and (Result.Parent <> nil) do Result := Result.Parent;
  while (Result <> nil) and (Result.PrevSibling <> nil) do Result := Result.PrevSibling;
end;

function GMNodePath(const ANode: IUnknown; const ADelimStr: TGMString): TGMString;
var node: IGMTreeable;
begin
  Result := '';
  if GMQueryInterface(ANode, IGMTreeable, node) then
   while node <> nil do
    begin
     Result := GMStringJoin(GMGetIntfText(node), ADelimStr, Result);
     node := node.Parent;
    end;
end;

function GMIntfHasDataClass(const AIntf: IUnknown; const ADataClass: TClass): Boolean;
begin
  Result := GMGetDataObject(AIntf) is ADataClass;
end;

function GMGetIntfDataClass(const AIntf: IUnknown): TClass;
var dataObj: TObject;
begin
  dataObj := GMGetDataObject(AIntf);
  if dataObj <> nil then Result := dataObj.ClassType else Result := nil;
end;

function GMIsNodeMatch(ANode: IGMTreeable; const ADataClass: TClass; const ANodeTitle: TGMString): Boolean;
begin
  Result := ((ADataClass = nil) or (GMGetDataObject(ANode) is ADataClass)) and
            ((ANodeTitle = '') or GMSameText(ANodeTitle, GMGetIntfText(ANode)));
end;

function GMFindParentNode(const AStartNode: IGMTreeable; const ADataClass: TClass; const ANodeTitle: TGMString): IGMTreeable;
begin
  Result := AStartNode;
  while (Result <> nil) and not GMIsNodeMatch(Result, ADataClass, ANodeTitle) do Result := Result.Parent;
end;

function GMFindNode(const AStartNode: IGMTreeable; const ADecideFunc: TGMNodeVisitFunc; const ARecurse: Boolean; const AParameter: Pointer): IGMTreeable;
//
// Use the same return value semantics of ADecideFunc here as in GMVisitNodesXxxxx (True => continue iteration, False => stop iteration).
// Otherwise a TGMNodeVisitFunc could not be used for both GMFindNode and GMVisitNodesXxxxx.
//
  function DoFind(ANode: IGMTreeable): IGMTreeable;
  begin
    Result := nil;
    while (ANode <> nil) and (Result = nil) do
     begin
      if not ADecideFunc(ANode, AParameter) then Result := ANode else if ARecurse then Result := DoFind(ANode.FirstChild);
      ANode := ANode.NextSibling;
     end;
  end;
begin
  if Assigned(ADecideFunc) then Result := DoFind(AStartNode) else Result := nil;
end;

function GMNodeMatchVisitFunc(const ANode: IGMTreeable; const AParameter: Pointer): Boolean;
begin
  Result := (AParameter = nil) or not GMIsNodeMatch(ANode, PGMNodeVisitData(AParameter).DataClass, PGMNodeVisitData(AParameter).NodeTitle);
end;

function GMFindNode(const AStartNode: IGMTreeable; const ADataClass: TClass; const ANodeTitle: TGMString; const ARecurse: Boolean): IGMTreeable;
var visitData: RGMNodeVisitData;
begin
  visitData := GMInitNodeVisitData(ADataClass, ANodeTitle);
  Result := GMFindNode(AStartNode, GMNodeMatchVisitFunc, ARecurse, @visitData);
end;

function GMGetDataObject(const AOwner: IUnknown): TObject;
var getDataObj: IGMGetDataObject;
begin
  if GMQueryInterface(AOwner, IGMGetDataObject, getDataObj) then Result := getDataObj.GetDataObject else Result := nil;
end;

function GMSetDataObject(const AOwner: IUnknown; const ADataObj: TObject): TObject;
var PIDataObj: IGMSetDataObject;
begin
  if GMQueryInterface(AOwner, IGMSetDataObject, PIDataObj) then PIDataObj.SetDataObject(ADataObj);
  Result := ADataObj;
end;

function GMGetIntfText(const AIntf: IUnknown; const ADefaultValue: TGMString): TGMString;
var getText: IGMGetText;
begin
  if GMQueryInterface(AIntf, IGMGetText, getText) then Result := getText.Text else Result := ADefaultValue;
end;

procedure GMSetIntfText(const AIntf: IUnknown; const AValue: TGMString);
var setText: IGMGetSetText;
begin
  if GMQueryInterface(AIntf, IGMGetSetText, setText) then setText.Text := AValue;
end;

function GMObjFromIntf(const AIntf: IUnknown): TObject;
var PIObiInfo: IGMObjInfo;
begin
 if not GMQueryInterface(AIntf, IGMObjInfo, PIObiInfo) then Result := nil else Result := PIObiInfo.Instance;
end;

function GMGetIntfStrValue(const AIntf: IUnknown; const ADefaultValue: TGMString = ''): TGMSTring;
var strVal: IGMGetStringValue;
begin
 if GMQueryInterface(AIntf, IGMGetStringValue, strVal) then Result := strVal.StringValue else Result := ADefaultValue;
end;

function GMCompareIUnknown(const AIntf1, AIntf2: IUnknown): TGMCompareResult;
var unk1, unk2: IUnknown;
begin
  Result := crALessThanB;
  if GMQueryInterface(AIntf1, IUnknown, unk1) and GMQueryInterface(AIntf2, IUnknown, unk2) then
   begin
    if PtrUInt(unk1) = PtrUInt(unk2) then Result := crAEqualToB
      else
      if PtrUInt(unk1) > PtrUInt(unk2) then Result := crAGreaterThanB;
   end;
end;

function GMObjAsIntf(const AObj: TObject): IUnknown;
begin
  if (AObj = nil) or not AObj.GetInterface(IUnknown, Result) then Result := nil;
end;

procedure GMCheckGetInterface(const AObj: TObject; const AIID: TGUID; out AIntf; const ACallingName: TGMString);
begin
  GMCheckPointerAssigned(AObj, RStrTheObject, AObj, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
  if not AObj.GetInterface(AIID, AIntf) then raise EGMException.ObjError(MsgIntfNotSupported(RStrTheObject, AIID), AObj, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
end;

procedure GMCheckQueryInterface(const ASource: IUnknown; const AIID: TGUID; out AIntf; const ACallingName: TGMString);
var CallerName: TGMString; Hr: HResult;
  function LocalBuildCallingName: TGMString;
  begin
    if CallerName = '' then CallerName := GMStringJoin(BuildCallingName(ACallingName, {$I %CurrentRoutine%}), ' - ',
                                                       GMFormat('QueryInterface<%s>("%s")', [GMIntfClassName(ASource), GMGuidToString(AIID)]));
    Result := CallerName;
  end;
begin
  //GMCheckPointerAssigned(Pointer(Obj), RStrTheObject, nil, CallerName);
  if ASource = nil then raise EGMException.ObjError(MsgPointerIsNil(RStrTheObject), nil, LocalBuildCallingName);

  //GMHrCheckIntf(Obj.QueryInterface(AIID, AIntf), Obj, CallerName);
  Hr := ASource.QueryInterface(AIID, AIntf);
  if not GMHrSucceeded(Hr) then GMHrCheckIntf(ASource.QueryInterface(AIID, AIntf), ASource, LocalBuildCallingName);

  //if Obj.QueryInterface(AIID, AIntf) <> S_OK then raise EGMException.IntfError(MsgIntfNotSupported(RStrTheObject, AIID), Obj, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
end;

function GMQueryInterface(const ASource: IUnknown; const AIID: TGUID; out AIntf): Boolean;
begin
  Result := (ASource <> nil) and (ASource.QueryInterface(AIID, AIntf) = S_OK);
end;

function GMGetInterface(const AObj: TObject; const AIID: TGUID; out AIntf): Boolean;
begin
  Result := (AObj <> nil) and AObj.GetInterface(AIID, AIntf);
end;

function GMGetWeakInterface(const AObj: TObject; const AIID: TGUID; out AIntf): Boolean;
begin
  Result := (AObj <> nil) and AObj.GetInterfaceWeak(AIID, AIntf);
end;

function GMGetIntfHRCode(const AIntf: IUnknown; const ADefaultHrCode: HResult): HResult;
var getHrCode: IGMGetHRCode;
begin
  if GMQueryInterface(AIntf, IGMGetHRCode, getHrCode) then Result := getHrCode.HRCode else Result := ADefaultHrCode
end;

function GMGetObjHRCode(const AObj: TObject; const ADefaultHrCode: HResult): HResult;
begin
  Result := GMGetIntfHRCode(GMObjAsIntf(AObj), ADefaultHrCode);
end;

procedure GMEnterCriticalSection(const ACriticalSection: IUnknown);
var cs: IGMCriticalSection;
begin
  if GMQueryInterface(ACriticalSection, IGMCriticalSection, cs) then cs.EnterCriticalSection;
//if ACriticalSection <> nil then ACriticalSection.EnterCriticalSection;
end;

procedure GMLeaveCriticalSection(const ACriticalSection: IUnknown);
var cs: IGMCriticalSection;
begin
  if GMQueryInterface(ACriticalSection, IGMCriticalSection, cs) then cs.LeaveCriticalSection;
//if ACriticalSection <> nil then ACriticalSection.LeaveCriticalSection;
end;

function GMIsOneOfIntegers(const AValue: PtrInt; const AIntValues: array of PtrInt): Boolean;
var val: PtrInt; // i: PtrInt;
begin
  //for i:=Low(AIntValues) to High(AIntValues) do if AValue = AIntValues[i] then begin Result := True; Exit; end;
  for val in AIntValues do if val = AValue then Exit(True);
  Result := False;
end;

procedure GMAddIntegersToArray(var ADest: TGMPtrIntArray; const AValues: array of PtrInt);
var i: LongInt;
begin
  if Length(AValues) = 0 then Exit;
  SetLength(ADest, Length(ADest) + Length(AValues));
  for i:=Low(AValues) to High(AValues) do ADest[High(ADest) - Length(AValues) - Low(AValues) + i + 1] := AValues[i];
end;

procedure GMCheckAllInterfacesSupported(const AIntf: IUnknown; const InterfaceIDs: array of TGUID; const ACallingName: TGMString);
var i: LongInt; PIUnknown: IUnknown;
begin
  for i:=Low(InterfaceIDs) to High(InterfaceIDs) do GMCheckQueryInterface(AIntf, InterfaceIDs[i], PIUnknown, ACallingName);
end;

function GMAllInterfacesSupported(const AIntf: IUnknown; const InterfaceIDs: array of TGUID): Boolean;
var i: LongInt; PIUnknown: IUnknown;
begin
  if AIntf = nil then Result := False else
   begin
    Result := True;
    for i:=Low(InterfaceIDs) to High(InterfaceIDs) do
     if GMQueryInterface(AIntf, InterfaceIDs[i], PIUnknown) then
      begin Result := False; break; end;
   end;
end;

procedure GMCheckGetIntfByPosition(const ACollection: IGMGetIntfByPosition; const Position: LongInt; const AIID: TGUID; out AIntf; const ElementName, ACallingName: TGMString);
//var Hr: HResult;
begin
  GMCheckPointerAssigned(Pointer(ACollection), RStrTheList, nil, ACallingName);
  //Hr := ACollection.GetIntfByPosition(Position, AIID, AIntf); // <- Save MsgNoItemIntfPrefix overhead on success
  GMHrCheckIntf(ACollection.GetIntfByPosition(Position, AIID, AIntf), ACollection, ACallingName, MsgNoItemIntfPrefix(GMIntToStr(Position), AIID));
  //then raise EGMException.IntfError(MsgIntfNotSupported(GMFormat('%s %d', [ElementName, Position]), AIID), nil, ACallingName);
end;

function GMGetPropertyIntf(const AObj: TObject; const PropertyName: TGMString; const AIID: TGUID; out AIntf): HResult;
var Prop: LongInt;
begin
  if (PropertyName = '') or (AObj = nil) then Result := E_INVALIDARG else
   begin
    if AObj.ClassInfo = nil then raise EGMException.ObjError(GMFormat(RStrNeedRTTI, [AObj.ClassName]), AObj, 'GMGetPropertyIntf');
    if not GMGetOrdinalProperty(AObj, PropertyName, Prop) or (TObject(Prop) = nil) then
     Result := DISP_E_UNKNOWNNAME
    else
     Result := CQIResult[TObject(Prop).GetInterface(AIID, AIntf)];
   end;
   //GMGetOrdinalProperty(Obj, PropertyName, Prop) and
     //(TObject(Prop) <> nil) then Result := TObject(Prop).GetInterface(AIID, AIntf) else Result := False;
end;

function GMGetPropIntfFromIntf(const AOwner: IUnknown; const APropertyName: TGMString; const AIID: TGUID; out AIntf): HResult;
var getPropIntf: IGMGetPropertyIntf;
begin
  if AOwner = nil then begin Result := E_POINTER; Exit; end;
  Result := AOwner.QueryInterface(IGMGetPropertyIntf, getPropIntf);
  if Result = S_OK then Result := getPropIntf.GetPropertyIntf(APropertyName, AIID, AIntf);
end;

//procedure GMCheckGetPropIntfFromIntf(const Owner: IUnknown; const PropertyName: TGMString; const AIID: TGUID; out AIntf; const ACallingName: TGMString = '');
//var PIGetPropIntf: IGMGetPropertyIntf;
//begin
//  GMCheckQueryInterface(Owner, IGMGetPropertyIntf, PIGetPropIntf, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
//  if not PIGetPropIntf.GetPropertyIntf(PropertyName, AIID, AIntf) then
//   raise EGMException.IntfError(MsgNoIntfOrNotExist(RStrProperty, PropertyName, AIID), Owner, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
//end;

procedure GMReleaseMembers(const AIntf: IUnknown);
var ReleaseReferences: IGMReleaseReferences;
begin
  if GMQueryInterface(AIntf, IGMReleaseReferences, ReleaseReferences) then ReleaseReferences.ReleaseReferences;
end;

function GMGetIntfCount(const AIntf: IUnknown; const ADefaultValue: PtrInt): PtrInt;
var PICount: IGMGetCount;
begin
  if GMQueryInterface(AIntf, IGMGetCount, PICount) then Result := PICount.Count else Result := ADefaultValue;
end;

function GMGetIntfHandle(const AIntf: IUnknown; const ADefaultValue: THandle): THandle;
var PIHandle: IGMGetHandle;
begin
  if GMQueryInterface(AIntf, IGMGetHandle, PIHandle) then Result := PIHandle.Handle else Result := ADefaultValue;
end;

function GMCheckGetIntfHandle(const AIntf: IUnknown; const ACallingName: TGMString): THandle;
var PIHandle: IGMGetHandle;
begin
  GMCheckQueryInterface(AIntf, IGMGetHandle, PIHandle, ACallingName);
  Result := PIHandle.Handle;
end;

function GMGetAllocatedIntfHandle(const AIntf: IUnknown; var Handle: THandle): Boolean;
var PIHAlloc: IGMHandleAllocated; PIHandle: IGMGetHandle;
begin
  if (AIntf <> nil) and ((AIntf.QueryInterface(IGMHandleAllocated, PIHAlloc) <> S_OK) or PIHAlloc.HandleAllocated) and
     (AIntf.QueryInterface(IGMGetHandle, PIHandle) = S_OK) then
   begin Handle := PIHandle.Handle; Result := Handle <> 0; end else Result := False;
end;

function GMGetAllocatedObjHandle(const AObj: TObject; var AHandle: THandle): Boolean;
begin
  Result := GMGetAllocatedIntfHandle(GMObjAsIntf(AObj), AHandle);
end;

function GMIsHandleAllocated(const AIntf: IUnknown): Boolean;
var PIHandle: IGMGetHandle; PIHAlloc: IGMHandleAllocated;
begin
  //
  // If we can get a IGMHandleAllocated avoid accessing PIHandle.Handle because this may create a handle
  // but we only want to test for a valid handle here and dont want to create one!
  //
  Result :=  (AIntf <> nil) and ((AIntf.QueryInterface(IGMHandleAllocated, PIHAlloc) <> S_OK) or PIHAlloc.HandleAllocated) and
             (AIntf.QueryInterface(IGMGetHandle, PIHandle) = S_OK) and (PIHandle.Handle <> 0);
end;

function GMCreateCopyQI(const ASource: IUnknown; const AIID: TGUID; out AIntf): HResult;
var PICreateCopy: IGMCreateCopyQI;
begin
  if ASource = nil then Result := E_INVALIDARG else
   begin
    Result := ASource.QueryInterface(IGMCreateCopyQI, PICreateCopy);
    if Result <> S_OK then Exit;
    Result := PICreateCopy.CreateCopyQI(AIID, AIntf);
   end;
end;

function GMObjCreateCopyQI(const ASource: TObject; const AIID: TGUID; out AIntf): HResult;
var PICreateCopy: IGMCreateCopyQI;
begin
  if ASource = nil then Result := E_INVALIDARG else
   begin
    if not ASource.GetInterface(IGMCreateCopyQI, PICreateCopy) then begin Result := E_NOINTERFACE; Exit; end;
    Result := PICreateCopy.CreateCopyQI(AIID, AIntf);
   end;
end;

function GMFindParentObj(const AObj: TObject; const AParentClass: TClass; out AParent): Boolean;
var PIParent: IGMGetParentObj; Prnt: TObject;
begin
  Result := False; TObject(AParent) := nil;
  if AObj = nil then Exit;
  if AObj is AParentClass then begin TObject(AParent) := AObj; Result := True; Exit; end;
  if not AObj.GetInterface(IGMGetParentObj, PIParent) then Exit;
  Prnt := PIParent.ParentObj;
  while (Prnt <> nil) and not (Prnt is AParentClass) do
   begin
    if not Prnt.GetInterface(IGMGetParentObj, PIParent) then Exit;
    Prnt := PIParent.ParentObj;
   end;
  Result := Prnt <> nil;
  if Result then TObject(AParent) := Prnt;
end;

function GMIsParentObj(AParent, AObj: TObject; const AllowIdentity: Boolean; const AStopAtClass: TClass): Boolean;
var PIParent: IGMGetParentObj;
begin
  if not AllowIdentity and (AObj = AParent) then begin Result := False; Exit; end;
  repeat
   Result := (AObj <> nil) and (AObj = AParent);
   if Result or (AObj = nil) or ((AStopAtClass <> nil) and (AObj is AStopAtClass)) then Break;
   if not AObj.GetInterface(IGMGetParentObj, PIParent) then Break;
   AObj := PIParent.ParentObj;
  until Result;
end;

procedure GMCheckFindParentObj(const AObj: TObject; const ParentClass: TClass; out Parent);
begin
  GMCheckPointerAssigned(AObj, RStrTheObject, AObj, {$I %CurrentRoutine%});
  if not GMFindParentObj(AObj, ParentClass, Parent) then
   raise EGMException.ObjError(GMFormat(RStrNoParentFmt, [GMGetObjName(AObj), GMClassName(ParentClass)]), AObj, {$I %CurrentRoutine%});
end;

function GMGetObjText(const AObj: TObject; const ADefaultValue: TGMString): TGMString;
var PIText: IGMGetText;
begin
  if (AObj <> nil) and AObj.GetInterface(IGMGetText, PIText) then Result := PIText.Text else Result := ADefaultValue;
end;

procedure GMSetObjText(const AObj: TObject; const AValue: TGMString);
var PIText: IGMGetSetText;
begin
  if (AObj <> nil) and AObj.GetInterface(IGMGetSetText, PIText) then PIText.Text := AValue;
end;

//function GMFindParentObj(const Area: TObject; const ObjClass: TClass; out AObj): Boolean;
//var PIParent: IGMGetParentObj; PILayout: IGMUiArea; Parent: TObject;
//begin
//  GMCheckGetInterface(Area, IGMGetParentObj, PIParent, {$I %CurrentRoutine%});
//  Parent := PIParent.ParentObj;
//  while (Parent <> nil) and not (Parent is ObjClass) do
//   begin
//    GMCheckGetInterface(Parent, IGMGetParentObj, PIParent, {$I %CurrentRoutine%});
//    Parent := PIParent.ParentObj;
//   end;
//  Result := Parent <> nil;
//  if Result then TObject(AObj) := Parent;
//end;

//function GMObjHandleAllocated(const AObj: TObject): Boolean;
//var PIHandle: IGMGetHandle;
//begin
//  Result := (AObj <> nil) and AObj.GetInterface(IGMGetHandle, PIHandle) and (PIHandle.HAndle <> 0);
//end;

//function GMIntfHandleAllocated(const AIntf: IUnknown): Boolean;
//var PIHandle: IGMGetHandle;
//begin
//  Result := (AIntf <> nil) and (AIntf.QueryInterface(IGMGetHandle, PIHandle) = S_OK) and (PIHandle.HAndle <> 0);
//end;


{ --------------------- }
{ ---- COM Helpers ---- }
{ --------------------- }

function GMHrSucceeded(const AErrorCode: HResult): Boolean;
begin
  Result := AErrorCode and $80000000 = 0;
end;

//function GMSysErrorMsg(const AErrorCode: LongInt): TGMString;
//begin
//  Result := SysErrorMessage(AErrorCode);
//  if Result = '' then Result := GMFormat(RStrSysErrorCodeFmt, [AErrorCode, AErrorCode]);
//end;

procedure GMRegisterErrorMsgModule(const AModuleName: TGMString);
begin
  if not GMIsOneOfStrings(AModuleName, vGMErrorMsgModules) then GMAddStrToArray(AModuleName, vGMErrorMsgModules);
end;

procedure GMExtendExceptionMsg(const AException: TObject; const AAddition: TGMString; const ASeparator: TGMString = ': '; const APrefix: Boolean = True);
var setText: IGMGetSetText;
  function BuildMsg(const ACurrentMsg: TGMString): TGMString;
  begin
    if APrefix then
      Result := GMStringJoin(AAddition, ASeparator, ACurrentMsg)
    else
      Result := GMStringJoin(ACurrentMsg, ASeparator, AAddition);
  end;
begin
  if GMGetInterface(AException, IGMGetSetText, setText) then setText.Text := BuildMsg(setText.Text)
  else
  if GMIsClassByName(AException, Exception) then
     Exception(AException).Message := BuildMsg(Exception(AException).Message);
end;

function GMSysErrorMsg(const AErrorCode: LongInt; const AParams: array of PGMChar): TGMString;
var apiCode: DWORD; pParams: Pointer; i: Integer; unresolved: TGMString;
  function BuildSysErrMsg(AFlags: DWORD): TGMString;
  var buffer: PGMChar; len: DWORD;
  begin
    len := FormatMessage(AFlags or FORMAT_MESSAGE_ALLOCATE_BUFFER, nil, DWORD(AErrorCode), 0, PGMChar(@buffer), 0, pParams);
    if len = 0 then begin apiCode := GetLastError; Result := ''; end else
     begin
      apiCode := ERROR_SUCCESS;

      while (len > 0) do
       case buffer[len - 1] of
        #0..#32, '.': Dec(len);
        else Break;
       end;

      SetString(Result, buffer, len);
      if LocalFree(HLOCAL(buffer)) <> 0 then GMTrace('GMSysErrorMsg - LocalFree failed!', tpWarning);
     end;
  end;

  function DoInserts(const AMsg: TGMString): TGMString;
  var bitMaskInserted, chPos, i, argNo: Integer; strToInsert: TGMString; pCh, pChFound: PGMChar; // unResolved,
  begin
    Result := AMsg;  unResolved := '';  chPos := 1;  bitMaskInserted := 0;
    repeat
     pCh := @Result[chPos]; // <- Result may have been moved due to modifications!
     pChFound := GMStrLScan(pCh, '%', Length(Result) - chPos + 1);
     if pChFound <> nil then
      begin
       Inc(chPos, pChFound - pCh);
       Inc(pChFound);
       argNo := Ord(pChFound^) - 49;
       if GMIsInRange(argNo, Low(AParams), High(AParams)) then
        begin
         strToInsert := AParams[argNo];
         System.Delete(Result, chPos, 2);
         System.Insert(strToInsert, Result, chPos);
         Inc(chPos, Length(strToInsert));
         bitMaskInserted := bitMaskInserted or (1 shl argNo);
        end;
      end;
    until (pChFound = nil) or (pChFound^ = #0);

    for i:=Low(AParams) to High(AParams) do
      if bitMaskInserted and (1 shl i) = 0 then unResolved := GMStringJoin(unResolved, ', ', AParams[i]);
  end;

begin
  if Length(AParams) = 0 then pParams := nil else pParams := @AParams[Low(AParams)];

  //Result := BuildSysErrMsg(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY);

  //if (Length(Result) <= 0) and (apiCode = ERROR_INVALID_PARAMETER) then
  Result := BuildSysErrMsg(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY or FORMAT_MESSAGE_IGNORE_INSERTS);

  if (Length(Result) <= 0) then // and (Length(vGMErrorMsgModules) > 0)
   for i:=Low(vGMErrorMsgModules) to High(vGMErrorMsgModules) do
    begin
     Result := GMModuleErrorMessage(vGMErrorMsgModules[i], LongWord(AErrorCode and $0000FFFF));
     if Length(Result) > 0 then Break;
    end;

  unresolved := '';
  Result := DoInserts(Result);
  Result := GMStringJoin(Result, ': ', unresolved);

  if Length(Result) <= 0 then Result := GMFormat(RStrUnknownSysErrorMsgFmt, [AErrorCode]);
end;

function GMGuidToString(const Guid: TGUID): TGMString;
var PWStr: PWideChar;
begin
  GMHrCheckObj(StringFromCLSID(Guid, PWStr), nil, {$I %CurrentRoutine%});
  Result := PWStr;
  CoTaskMemFree(PWStr);
end;

procedure GMCopyGuid(const ASource, ADest: IUnknown; const ACallingName: TGMString);
var PISrcGuid: IGMGetGuid; PIDstGuid: IGMGetSetGuid;
begin
  GMCheckQueryInterface(ASource, IGMGetGuid, PISrcGuid, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
  GMCheckQueryInterface(ADest, IGMGetSetGuid, PIDstGuid, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
  PIDstGuid.GUID := PISrcGuid.GUID;
end;

function GMMakeGuidStr(const GuidStr: TGMString): TGMString;
begin
  Result := GMStrip(GuidStr, cGuidStripChars);
  if Result <> '' then Result := '{' + Result + '}';
end;

function GMCreateGuid: TGuid;
begin
  GMHrCheckObj(CoCreateGuid(Result), nil, 'GMCreateGuid');
end;

function GMIsGUID(const AGuidStr: TGMString): Boolean;
var GUID: TGUID; guidWStr: UnicodeString;
begin
  guidWStr := GMMakeGuidStr(AGuidStr);
  Result := GMHrSucceeded(CLSIDFromString(PWideChar(guidWStr), GUID));
end;

function GMStringToGuid(const AGuidStr: TGMString; const ACaller: TObject; const ACallingName: TGMString): TGUID;
var guidWStr: UnicodeString;
begin
  guidWStr := GMMakeGuidStr(AGuidStr);
  GMHrCheckObj(CLSIDFromString(PWideChar(guidWStr), Result), ACaller, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
end;

function GMMakeGuid(GuidStr: TGMString; const AObj: TObject; const ACallingName: TGMString): TGUID;
begin
  GuidStr := GMMakeGuidStr(GuidStr);
  if GuidStr <> '' then
   Result := GMStringToGuid(GuidStr, AObj, ACallingName)
  else
   Result := GUID_NULL;
end;

function GMCreateComObject(const ClassID: TGUID; const CreateContext: DWORD): IUnknown;
begin
  GMHrCheckObj(CoCreateInstance(ClassID, nil, CreateContext, IUnknown, Result), nil, {$I %CurrentRoutine%});
end;

function GMCompareGuids(const GuidA, GuidB: TGUID): TGMCompareResult;
var Cmp: LongInt;
begin
  Cmp := CompareText(GMGuidToString(GuidA), GMGuidToString(GuidB));
  if Cmp < 0 then Result := crALessThanB else if Cmp = 0 then Result := crAEqualToB else Result := crAGreaterThanB
end;

function GMEqualGuids(const GuidA, GuidB: TGUID): Boolean;
begin
  Result := CompareMem(@GuidA, @GuidB, SizeOf(TGUID)); // GMCompareGuids(GuidA, GuidB) = crAEqualToB;
end;

function GMCoClassIsRegistered(const ClassId: TGUID): Boolean;
var ProgId: PWideChar;
begin
  ProgId := nil;
  Result := ProgIDFromCLSID(ClassId, ProgId) = S_OK;
  if ProgId <> nil then CoTaskMemFree(ProgId);
end;


{ -------------------------- }
{ ---- Storage Routines ---- }
{ -------------------------- }

function GMIsStorageGuid(const Storage: IStorage; const Guid: TGUID; const Caller: TObject): Boolean;
var Stat: TStatStg;
begin
  if Storage = nil then Result := False else
   begin
    GMHrCheckObj(Storage.Stat(Stat, STATFLAG_NONAME), Caller, {$I %CurrentRoutine%});
    //if Stat.pwcsName <> nil then CoTaskMemFree(Stat.pwcsName);
    Result :=  IsEqualGuid(Stat.clsid, Guid);
   end;
end;

function GMIsStorageFileGuid(const FileName: TGMString; const Guid: TGUID; const Caller: TObject): Boolean;
var Storage: IStorage;
begin
  GMCheckFileExists(FileName, Caller, {$I %CurrentRoutine%});
  //if not FileExists(FileName) then raise EGMException.ObjError(GMFormat(RStrFileNotExists, [FileName]), Caller, {$I %CurrentRoutine%});
  GMHrCheckObj(StgOpenStorage(PWideChar(UnicodeString(FileName)), nil, STGM_READWRITE or STGM_SHARE_EXCLUSIVE, nil, 0, Storage), Caller, {$I %CurrentRoutine%});
  Result := GMIsStorageGuid(Storage, Guid);
end;

procedure GMCheckIsStorageGuid(const Storage: IStorage; const Guid: TGUID; const Caller: TObject);
var Stat: TStatStg;
begin
  if Storage <> nil then
   begin
    GMHrCheckObj(Storage.Stat(Stat, STATFLAG_NONAME), Caller, {$I %CurrentRoutine%});
    //if Stat.pwcsName <> nil then CoTaskMemFree(Stat.pwcsName);
    if not IsEqualGuid(Stat.clsid, Guid) then raise EGMException.ObjError(GMFormat(RStrInvalidStorageGuid, [GMGuidToString(Guid), GMGuidToString(Stat.clsid)]), Caller, {$I %CurrentRoutine%});
   end;
end;

procedure GMCheckIsStorageFileGuid(const FileName: TGMString; const Guid: TGUID; const Caller: TObject = nil);
var Storage: IStorage;
begin
  GMCheckFileExists(FileName, Caller, {$I %CurrentRoutine%});
  //if not FileExists(FileName) then raise EGMException.ObjError(GMFormat(RStrFileNotExists, [FileName]), Caller, {$I %CurrentRoutine%});
  GMHrCheckObj(StgOpenStorage(PWideChar(UnicodeString(FileName)), nil, STGM_READWRITE or STGM_SHARE_EXCLUSIVE, nil, 0, Storage), Caller, {$I %CurrentRoutine%});
  GMCheckIsStorageGuid(Storage, Guid, Caller);
end;


{ ---------------------------------- }
{ ---- Connection Point Helpers ---- }
{ ---------------------------------- }

function GMDoNotifySink(const NotificationsEnabled: Boolean; const NotifySink: IUnknown; const AIID: TGUID; out AIntf): Boolean;
//var PIAskBoolean: IGMAskBoolean;
begin
  if not GMQueryInterface(NotifySink, AIID, AIntf) then Result := False else
   Result := NotificationsEnabled or GMAskBoolean(NotifySink, Ord(bvAlwaysNotify), False); //((NotifySink.QueryInterface(IGMAskBoolean, PIAskBoolean) = S_OK) and (PIAskBoolean.AskBoolean(Ord(bvAlwaysNotify)) = Ord(barTrue)));
end;

procedure GMInterfaceConnect(const AObj: TObject; const AContainer: IUnknown; const AIID: TGUID; var Cookie: LongInt; const ACallingName: TGMString);
var PISink: IUnknown;
begin
  if (AObj <> nil) and (AContainer <> nil) then
   begin
    Cookie := CInvalidCPCookie;
    GMCheckGetInterface(AObj, IUnknown, PISink, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
    GMInterfaceConnect(PISink, AContainer, AIID, Cookie, AObj, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
   end;
end;

procedure GMInterfaceConnect(const Sink, AContainer: IUnknown; const AIID: TGUID; var Cookie: LongInt; const AObj: TObject; const ACallingName: TGMString); overload;
var CPC: IConnectionPointContainer; CP: IConnectionPoint;
begin
  if (Sink <> nil) and (AContainer <> nil) then
   begin
    Cookie := CInvalidCPCookie;
    if not GMQueryInterface(AContainer, IConnectionPointContainer, CPC) then raise EGMException.ObjError(MsgIntfNotSupported(RStrCPC, IConnectionPointContainer), AObj, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
    if CPC.FindConnectionPoint(AIID, CP) <> S_OK then raise EGMException.ObjError(GMFormat(RStrNoCPForIntf, [RStrCPC, GMGuidToString(AIID)]), AObj, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
    GMHrCheckObj(CP.Advise(Sink, Cookie), AObj, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
   end;
end;

procedure GMQuietInterfaceConnect(const AObj: TObject; const AContainer: IUnknown; const AIID: TGUID; var Cookie: LongInt);
var sink: IUnknown; cpc: IConnectionPointContainer; cp: IConnectionPoint;
begin
  if (AObj <> nil) and (AContainer <> nil) then
   begin
    Cookie := CInvalidCPCookie;
    if AObj.GetInterface(IUnknown, sink) and GMQueryInterface(AContainer, IConnectionPointContainer, cpc) and
       (cpc.FindConnectionPoint(AIID, cp) = S_OK) then cp.Advise(sink, Cookie);
   end;
end;

procedure GMInterfaceDisconnect(const AContainer: IUnknown; const AIID: TGUID; var Cookie: LongInt);
var CPC: IConnectionPointContainer; CP: IConnectionPoint;
begin
  if (AContainer <> nil) and (Cookie <> CInvalidCPCookie) then
   if GMHrSucceeded(AContainer.QueryInterface(IConnectionPointContainer, CPC)) then
    if GMHrSucceeded(CPC.FindConnectionPoint(AIID, CP)) then
     if GMHrSucceeded(CP.Unadvise(Cookie)) then Cookie := CInvalidCPCookie;
end;

procedure GMCpcCallNotifySinks(const Cpc: IConnectionPointContainer; const ConnectionPointIID: TGUID; const NotifyProc: TCPCNotifyProc; const NotificationsEnabled: Boolean; const Params: array of OleVariant);
var EnumCP: IEnumConnectionPoints; ConnectionPoint: IConnectionPoint;
  procedure NotifyConnections(const ConnectionPoint: IConnectionPoint);
  var EnumConnections: IEnumConnections; ConnectData: tagConnectData; PISinkUnk: IUnknown;
  begin
   if (ConnectionPoint <> nil) and (ConnectionPoint.EnumConnections(EnumConnections) = S_OK) then
    while EnumConnections.Next(1, ConnectData, nil) = S_OK do
     if GMDoNotifySink(NotificationsEnabled, ConnectData.pUnk, IUnknown, PISinkUnk) then NotifyProc(ConnectData.pUnk, Params)
     //if ConnectData.pUnk <> nil then NotifyProc(ConnectData.pUnk, Params); {(ConnectData.pUnk.QueryInterface(ConnectionPointIID, NotifySink) = S_OK)}
  end;
begin
  if (Cpc <> nil) and Assigned(NotifyProc) then
   begin
    if IsEqualGuid(ConnectionPointIID, GUID_NULL) then
     begin
      if Cpc.EnumConnectionPoints(EnumCP) = S_OK then
       while EnumCP.Next(1, ConnectionPoint, nil) = S_OK do NotifyConnections(ConnectionPoint);
     end
    else
     if Cpc.FindConnectionPoint(ConnectionPointIID, ConnectionPoint) = S_OK then NotifyConnections(ConnectionPoint);
   end;
end;

procedure GMCpcCallNotifySinksObj(const Cpc: IConnectionPointContainer; const ConnectionPointIID: TGUID; const NotifyProc: TCPCNotifyProcObj; const NotificationsEnabled: Boolean; const Params: array of OleVariant);
var EnumCP: IEnumConnectionPoints; ConnectionPoint: IConnectionPoint;
  procedure NotifyConnections(const ConnectionPoint: IConnectionPoint);
  var EnumConnections: IEnumConnections; ConnectData: tagConnectData; PISinkUnk: IUnknown;
  begin
   if (ConnectionPoint <> nil) and (ConnectionPoint.EnumConnections(EnumConnections) = S_OK) then
    while EnumConnections.Next(1, ConnectData, nil) = S_OK do
     if GMDoNotifySink(NotificationsEnabled, ConnectData.pUnk, IUnknown, PISinkUnk) then NotifyProc(ConnectData.pUnk, Params)
     //if ConnectData.pUnk <> nil then NotifyProc(ConnectData.pUnk, Params); {(ConnectData.pUnk.QueryInterface(ConnectionPointIID, NotifySink) = S_OK)}
  end;
begin
  if (Cpc <> nil) and Assigned(NotifyProc) then
   begin
    if IsEqualGuid(ConnectionPointIID, GUID_NULL) then
     begin
      if Cpc.EnumConnectionPoints(EnumCP) = S_OK then
       while EnumCP.Next(1, ConnectionPoint, nil) = S_OK do NotifyConnections(ConnectionPoint);
     end
    else
     if Cpc.FindConnectionPoint(ConnectionPointIID, ConnectionPoint) = S_OK then NotifyConnections(ConnectionPoint);
   end;
end;

procedure GMRequestCPCDisconnect(const Cpc: IConnectionPointContainer);
var EnumCP: IEnumConnectionPoints; ConnectionPoint: IConnectionPoint; CpIID: TGUID;
    EnumConnections: IEnumConnections; ConnectData: tagConnectData; ConnectedObj: IGMDisconnectFromConnectionPoint;
begin
  if (Cpc <> nil) and (Cpc.EnumConnectionPoints(EnumCP) = S_OK) then
   while EnumCP.Next(1, ConnectionPoint, nil) = S_OK do
    if (ConnectionPoint.GetConnectionInterface(CpIID) = S_OK) and (ConnectionPoint.EnumConnections(EnumConnections) = S_OK) then
     while EnumConnections.Next(1, ConnectData, nil) = S_OK do
      if GMQueryInterface(ConnectData.pUnk, IGMDisconnectFromConnectionPoint, ConnectedObj) then
       try ConnectedObj.DisconnectFromConnectionPoint(Cpc, CpIID, ConnectData.dwCookie); except end;
end;


{ ------------------------------------ }
{ ---- Connection Point Notifiers ---- }
{ ------------------------------------ }

procedure GMCallSinkClose(const NotifySink: IUnknown; const Params: array of OleVariant);
var PIActive: IGMGetSetActive;
begin
  if GMQueryInterface(NotifySink, IGMGetSetActive, PIActive) then PIActive.Active := False; // <- Don't eat exceptions!
end;

procedure GMCallSinkBeforeActiveChange(const NotifySink: IUnknown; const Params: array of OleVariant);
var Sink: IGMActiveChangeNotifications;
begin
  if (Length(Params) > 0) and GMQueryInterface(NotifySink, IGMActiveChangeNotifications, Sink) then Sink.BeforeActiveChange(Params[Low(Params)]);
end;

procedure GMCallSinkAfterActiveChange(const NotifySink: IUnknown; const Params: array of OleVariant);
var Sink: IGMActiveChangeNotifications;
begin
  if (Length(Params) > 0) and GMQueryInterface(NotifySink, IGMActiveChangeNotifications, Sink) then {try} Sink.AfterActiveChange(Params[Low(Params)]); //except end;
end;

procedure GMCallSinkBeforePositionChange(const NotifySink: IUnknown; const Params: array of OleVariant);
var Sink: IGMPositionChangeNotifications;
begin
  // No try Except around the Call Here!
  if GMQueryInterface(NotifySink, IGMPositionChangeNotifications, Sink) then Sink.BeforePositionChange;
end;

procedure GMCallSinkAfterPositionChange(const NotifySink: IUnknown; const Params: array of OleVariant);
var Sink: IGMPositionChangeNotifications;
begin
  if GMQueryInterface(NotifySink, IGMPositionChangeNotifications, Sink) then try Sink.AfterPositionChange; except end;
end;

procedure GMCallSinkBeforeOperation(const NotifySink: IUnknown; const Params: array of OleVariant);
var Sink: IGMOperationNotifications;
begin
  if GMQueryInterface(NotifySink, IGMOperationNotifications, Sink) then
   case Length(Params) of
    1: Sink.BeforeOperation(Params[Low(Params)]);
    2: Sink.BeforeOperation(Params[Low(Params)], Params[Low(Params) + 1]);
    else raise EGMException.ObjError(GMFormat(RStrInvalidParamCountFmt, [Length(Params)]), nil, {$I %CurrentRoutine%});
   end;
end;

procedure GMCallSinkAfterOperation(const NotifySink: IUnknown; const Params: array of OleVariant);
var Sink: IGMOperationNotifications;
begin
  if GMQueryInterface(NotifySink, IGMOperationNotifications, Sink) then
   case Length(Params) of
    1: try Sink.AfterOperation(Params[Low(Params)]); except end;
    2: try Sink.AfterOperation(Params[Low(Params)], Params[Low(Params) + 1]); except end;
    else raise EGMException.ObjError(GMFormat(RStrInvalidParamCountFmt, [Length(Params)]), nil, {$I %CurrentRoutine%});
   end;
end;

procedure GMCallSinkValidateValue(const NotifySink: IUnknown; const Params: array of OleVariant);
var Sink: IGMValidateValues;
begin
  // No try Except around the Call Here!
  if GMQueryInterface(NotifySink, IGMValidateValues, Sink) then Sink.ValidateValues;
end;


{ ------------------------------------------- }
{ ---- Value AStorage Directory Routines ---- }
{ ------------------------------------------- }

procedure GMVsdCreatePath(const AStorage: IUnknown; const ADirPath: TGMString);
var valStgDir: RGMTypedIntf<IGMValueStorageDirectory>; chPos: PtrInt; Dir: TGMString; //AbsPath: Boolean;
begin
  if not valStgDir.QueryFrom(AStorage) then Exit;
  chPos := 1;
  if not GMIsRelativePath(ADirPath) then GMVsdOpenDir(AStorage, '\', True);
  repeat
   Dir := GMNextWord(chPos, ADirPath, cDirSep);
   if Length(Dir) > 0 then GMVsdOpenDir(AStorage, Dir, True);
  until Dir = '';
end;

function GMVsdOpenDir(const AStorage: IUnknown; const ADirPath: TGMString; const ACreateIfNotExist: Boolean): Boolean;
var valStgDir: RGMTypedIntf<IGMValueStorageDirectory>;
begin
  if not valStgDir.QueryFrom(AStorage) then Result := False else
   begin
    Result := valStgDir.Intf.OpenDir(ADirPath, ACreateIfNotExist);
    if not Result and ACreateIfNotExist then raise EGMException.IntfError(GMFormat(RStrCreateDirFailed, [ADirPath]), AStorage, {$I %CurrentRoutine%});
   end;
end;

function GMVsdDirExists(const AStorage: IUnknown; const ADirPath: TGMString): Boolean;
var valStgDir: RGMTypedIntf<IGMValueStorageDirectory>; oldDirPath: TGMString; // dirPathKeeper: IUnknown;
begin
  if not valStgDir.QueryFrom(AStorage) then Result := False else
   begin
//  dirPathKeeper := TGMVsdDirPathKeeper.Create(AStorage);
    oldDirPath := valStgDir.Intf.CurrentPath;
    try
     Result := valStgDir.Intf.OpenDir(ADirPath, False);
    finally
     valStgDir.Intf.OpenDir(oldDirPath, False);
    end;
   end;
end;

function GMVsdOpenAbsDir(const AStorage: IUnknown; const ADirPath: TGMString; const ACreateIfNotExist: Boolean): Boolean;
begin
  Result := GMVsdOpenDir(AStorage, GMAbsPath(ADirPath), ACreateIfNotExist);
end;

function GMVsdDeleteAbsDir(const Storage: IUnknown; const ADirPath: TGMString): Boolean;
begin
  Result := GMVsdDeleteDir(Storage, GMAbsPath(ADirPath));
end;

function GMVsdDeleteDir(const AStorage: IUnknown; const ADirPath: TGMString): Boolean;
var valStgDir: RGMTypedIntf<IGMValueStorageDirectory>;
begin
  if valStgDir.QueryFrom(AStorage) then Result := valStgDir.Intf.DeleteDir(ADirPath) else Result := False;
end;

function GMVsdDeleteValue(const AStorage: IUnknown; const AValueName: TGMString): Boolean;
var valStgDir: RGMTypedIntf<IGMValueStorageDirectory>;
begin
  if valStgDir.QueryFrom(AStorage) then Result := valStgDir.Intf.DeleteValue(AValueName) else Result := False;
end;

function GMVsdContainsValue(const AStorage: IUnknown; const AValueName: TGMString): Boolean;
var containsVal: RGMTypedIntf<IGMContainsValue>;
begin
  if containsVal.QueryFrom(AStorage) then Result := containsVal.Intf.ContainsValue(AValueName) else Result := False;
end;

procedure GMVsdReadSubDirNames(const AStorage: IUnknown; var ASubDirNames: TGMStringArray);
var valStgDir: RGMTypedIntf<IGMValueStorageDirectory>;
begin
  if valStgDir.QueryFrom(AStorage) then valStgDir.Intf.ReadSubDirNames(ASubDirNames);
end;

procedure GMVsdReadValueNames(const AStorage: IUnknown; var AValueNames: TGMStringArray);
var valStgDir: RGMTypedIntf<IGMValueStorageDirectory>;
begin
  if valStgDir.QueryFrom(AStorage) then valStgDir.Intf.ReadValueNames(AValueNames);
end;

function GMVsdCurrentPath(const AStorage: IUnknown): TGMString;
var valStgDir: RGMTypedIntf<IGMValueStorageDirectory>;
begin
  if valStgDir.QueryFrom(AStorage) then Result := valStgDir.Intf.CurrentPath else Result := '';
end;

procedure GMVsdCommit(const AStorage: IUnknown);
var valStgDir: RGMTypedIntf<IGMValueStorageDirectory>;
begin
  if valStgDir.QueryFrom(AStorage) then valStgDir.Intf.Commit;
end;

{function GMVsdValueNameExists(const Storage: IUnknown; const ValueName: TGMString): Boolean;
var ValueNames: IGMStrings; valStgDir: IGMValueStorageDirectory;
begin
  if (Storage = nil) or (Storage.QueryInterface(IGMValueStorageDirectory, valStgDir) <> S_OK) then Result := False else
   begin
    ValueNames := TGMStringList.Create(False, True);
    ValueNames.Sorted := True;
    valStgDir.ReadValueNames(ValueNames);
    Result := ValueNames.IndexOf(ValueName) <> CInvalidItemIdx;
   end;
end;}

{procedure GMVsdDeletePrefixedValues(const Storage: IUnknown; const PrefixStr: TGMString);
var i: LongInt; ValueNames: IGMStrings; valStgDir: IGMValueStorageDirectory;
begin
  if (Storage <> nil) and (Storage.QueryInterface(IGMValueStorageDirectory, valStgDir) = S_OK) then
   begin
    ValueNames := TGMStringList.Create(False, True);
    valStgDir.ReadValueNames(ValueNames);
    for i:=0 to ValueNames.Count-1 do if GMIsPrefixStr(PrefixStr, ValueNames[i], True) then valStgDir.DeleteValue(ValueNames[i]);
   end;
end;

procedure GMVsdDeleteValues(const Storage: IUnknown);
begin
  GMVsdDeletePrefixedValues(Storage, '');
end; }

procedure GMStoreString(const ADest: IGMStringStorage; const AValueName, AValue: TGMString; const ADefaultValue: TGMString = cDfltReadString);
begin
  if ADest = nil then Exit;
  if not GMSameText(AValue, ADefaultValue) then ADest.WriteString(AValueName, AValue) else GMVsdDeleteValue(ADest, AValueName);
end;

procedure GMStoreInteger(const ADest: IGMValueStorage; const AValueName: TGMString; const AValue: LongInt; const ADefaultValue: LongInt = cDfltReadInteger);
begin
  if ADest = nil then Exit;
  if AValue <> ADefaultValue then ADest.WriteInteger(AValueName, AValue) else GMVsdDeleteValue(ADest, AValueName);
end;

procedure GMStoreInt64(const ADest: IGMValueStorage; const AValueName: TGMString; const AValue: Int64; const ADefaultValue: Int64 = cDfltReadInteger);
begin
  if ADest = nil then Exit;
  if AValue <> ADefaultValue then ADest.WriteInt64(AValueName, AValue) else GMVsdDeleteValue(ADest, AValueName);
end;

procedure GMStoreBoolean(const ADest: IGMValueStorage; const AValueName: TGMString; const AValue: Boolean; const ADefaultValue: Boolean = cDfltReadBoolean);
begin
  if ADest = nil then Exit;
  if AValue <> ADefaultValue then ADest.WriteBoolean(AValueName, AValue) else GMVsdDeleteValue(ADest, AValueName);
end;

procedure GMStoreDateTime(const ADest: IGMValueStorage; const AValueName: TGMString; const AValue: TDateTime; const ADefaultValue: TDateTime = cDfltReadDateTime);
begin
  if ADest = nil then Exit;
  if AValue <> ADefaultValue then ADest.WriteDateTime(AValueName, AValue) else GMVsdDeleteValue(ADest, AValueName);
end;

procedure GMStoreDouble(const ADest: IGMValueStorage; const AValueName: TGMString; const AValue: Double; const ADefaultValue: Double = cDfltReadFloat);
begin
  if ADest = nil then Exit;
  if AValue <> ADefaultValue then ADest.WriteDouble(AValueName, AValue) else GMVsdDeleteValue(ADest, AValueName);
end;

procedure GMStoreVariant(const ADest: IGMValueStorage; const AValueName: TGMString; const AValue, ADefaultValue: OleVariant);
begin
  if ADest = nil then Exit;
  if (VarType(AValue) <> VarType(ADefaultValue)) or (AValue <> ADefaultValue) then ADest.WriteVariant(AValueName, AValue)
     else GMVsdDeleteValue(ADest, AValueName);
end;

procedure GMVsdLoadFromDir(const ASource: IGMValueStorage; const ALoadPath: TGMString; const ALoadProc: TGMLoadStoreValuesProc; const ACryptCtrlData: PGMCryptCtrlData);
var threadSync: RGMCriticalSectionLock; pathKeeper: IUnknown;
begin
  if (ASource <> nil) and (ALoadPath <> '') and Assigned(ALoadProc) then
   begin
    threadSync.Lock(ASource);
    pathKeeper := TGMVsdDirPathKeeper.Create(ASource);
    if GMVsdOpenDir(ASource, ALoadPath, False) then ALoadProc(ASource, ACryptCtrlData);
   end;
end;

procedure GMVsdStoreToDir(const ADest: IGMValueStorage; const AStorePath: TGMString; const AStoreProc: TGMLoadStoreValuesProc; const ACryptCtrlData: PGMCryptCtrlData);
var threadSync: RGMCriticalSectionLock; pathKeeper: IUnknown;
begin
  if (ADest <> nil) and (AStorePath <> '') and Assigned(AStoreProc) then
   begin
    threadSync.Lock(ADest);
    pathKeeper := TGMVsdDirPathKeeper.Create(ADest, AStorePath, True);
    AStoreProc(ADest, ACryptCtrlData);
   end;
end;

procedure GMVsdLoadFromDir(const ASource: IGMValueStorage; const ALoadPath: TGMString; const ALoadIntf: IUnknown; const ACryptCtrlData: PGMCryptCtrlData);
var threadSync: RGMCriticalSectionLock; pathKeeper: IUnknown; PILoadStore: IGMLoadStoreData;
begin
  if (ASource <> nil) and (Length(ALoadPath) > 0) and GMQueryInterface(ALoadIntf, IGMLoadStoreData, PILoadStore) then
   begin
    threadSync.Lock(ASource);
    pathKeeper := TGMVsdDirPathKeeper.Create(ASource);
    if GMVsdOpenDir(ASource, ALoadPath, False) then PILoadStore.LoadData(ASource, ACryptCtrlData);
   end;
end;

procedure GMVsdStoreToDir(const ADest: IGMValueStorage; const AStorePath: TGMString; const AStoreIntf: IUnknown; const ACryptCtrlData: PGMCryptCtrlData);
var threadSync: RGMCriticalSectionLock; pathKeeper: IUnknown; PILoadStore: IGMLoadStoreData;
begin
  if (ADest <> nil) and (Length(AStorePath) > 0) and GMQueryInterface(AStoreIntf, IGMLoadStoreData, PILoadStore) then
   begin
    threadSync.Lock(ADest);
    pathKeeper := TGMVsdDirPathKeeper.Create(ADest, AStorePath, True);
    PILoadStore.StoreData(ADest, ACryptCtrlData);
   end;
end;

procedure GMVsdLoadTree(const ASource: IGMValueStorage;
                        const AParentTreeNode: IGMTreeable;
                        const ATreeNodeCreator: IGMCreateTreeNodeWithDataObj;
                        const AParameter: IUnknown;
                        const ACryptCtrlData: PGMCryptCtrlData;
                        const ASubDirSeparator: TGMString);
var i: Integer; subDirNames: TGMStringArray; newNode: IGMTreeable; dirKeeper: IUnknown; loadStore: IGMLoadStoreData;
begin
  if (ASubDirSeparator = '') or not GMVsdOpenDir(ASource, ASubDirSeparator) then Exit;

  GMVsdReadSubDirNames(ASource, subDirNames);
  for i:=Low(subDirNames) to High(subDirNames) do
   begin
    dirKeeper := nil; // <- restore previous dir
    dirKeeper := TGMVsdDirPathKeeper.Create(ASource);
    if not GMVsdOpenDir(ASource, subDirNames[i]) then Continue;
    newNode := ATreeNodeCreator.CreateTreeNodeWithDataObj(ASource, AParentTreeNode, AParameter);
    if GMQueryInterface(newNode, IGMLoadStoreData, loadStore) then loadStore.LoadData(ASource, ACryptCtrlData);
    //loadStore := nil; // <- release early, saves some memory
    GMVsdLoadTree(ASource, newNode, ATreeNodeCreator, AParameter, ACryptCtrlData, ASubDirSeparator);
   end;
end;

procedure GMStoreTree(const ADest: IGMValueStorage; ANode: IGMTreeable; var ANodeIdx: LongInt; const AStoreSiblings: Boolean; const ACryptCtrlData: PGMCryptCtrlData);
var dirKeeper: IUnknown; loadStore: IGMLoadStoreData;
begin
  while ANode <> nil do
   begin
    dirKeeper := nil; // <- restore previous dir
    // in TGMIniFileStorage name order must match integer order -> pad node idx with zeros
    dirKeeper := TGMVsdDirPathKeeper.Create(ADest, GMFormat('%s\%.5d', [scSubNodesDirSeparator, ANodeIdx]), True);
    if GMQueryInterface(ANode, IGMLoadStoreData, loadStore) then loadStore.StoreData(ADest, ACryptCtrlData);
    loadStore := nil; // <- release early, saves some memory
    Inc(ANodeIdx);
    GMStoreTree(ADest, ANode.FirstChild, ANodeIdx, True, ACryptCtrlData);
    if AStoreSiblings then ANode := ANode.NextSibling else ANode := nil;
   end;
end;

procedure GMVsdCopyDirValues(const ASource, ADest: IGMStringStorage);
const cDfltString = '';
var threadSync1, threadSync2: RGMCriticalSectionLock; i: LongInt; ValueNames: TGMStringArray;
begin
  if (ASource = nil) or (ADest = nil) then Exit;
  threadSync1.Lock(ASource);
  threadSync2.Lock(ADest);
  GMVsdReadValueNames(ASource, ValueNames);
  for i:=Low(ValueNames) to High(ValueNames) do
     GMStoreString(ADest, ValueNames[i], ASource.ReadString(ValueNames[i], cDfltString), cDfltString);
end;

procedure GMVsdCopyStorageContents(const ASource, ADest: IUnknown; AStartDirPath: TGMString);
var threadSync1, threadSync2: RGMCriticalSectionLock; mousePtrWait: IUnknown; srcValues, dstValues: IGMStringStorage;
  procedure CopyDirContents(const Dir: TGMString);
  var i: LongInt; SubDirNames: TGMStringArray; SrcDirKeeper, DstDirKeeper: IUnknown;
  begin
    SrcDirKeeper := TGMVsdDirPathKeeper.Create(ASource);
    if not GMVsdOpenDir(ASource, Dir, False) then Exit;
    DstDirKeeper := TGMVsdDirPathKeeper.Create(ADest, '\' + GMVsdCurrentPath(ASource), True);
    GMVsdCopyDirValues(srcValues, dstValues);
    GMVsdReadSubDirNames(ASource, SubDirNames);
    for i:=Low(SubDirNames) to High(SubDirNames) do CopyDirContents(SubDirNames[i]);
  end;
begin
  if (ASource = nil) or (ADest = nil) then Exit;
  threadSync1.Lock(ASource);
  threadSync2.Lock(ADest);

  GMCheckQueryInterface(ASource, IGMStringStorage, srcValues, {$I %CurrentRoutine%});
  GMCheckQueryInterface(ADest, IGMStringStorage, dstValues, {$I %CurrentRoutine%});

  if AStartDirPath = '' then AStartDirPath := '\' + GMVsdCurrentPath(ASource);
  mousePtrWait := TGMTempCursor.Create(vGMWaitCursor);
  CopyDirContents(AStartDirPath);
end;


{ ---------------------------- }
{ ---- ILockByte Routines ---- }
{ ---------------------------- }

function GMLockByteSize(const LockBytes: ILockBytes): Int64;
var Stat: TStatStg;
begin
  if LockBytes = nil then Result := 0 else
   begin
    GMHrCheckIntf(LockBytes.Stat(Stat, STATFLAG_NONAME), LockBytes, {$I %CurrentRoutine%});
    //if Stat.pwcsName <> nil then CoTaskMemFree(Stat.pwcsName);
    Result := Stat.cbSize;
   end;
end;

procedure GMCopyLockBytes(const ASource, ADest: ILockBytes; const AMaxBytesToCopy: LongInt = 0; const AVerfy: Boolean = True);
const CCopyBufSize = $20000;
var pBuffer: Pointer; bufSize, readCount, WriteCount, n, sourceSize, sourcePos, destPos: LongInt;
begin
  if (ASource <> nil) and (ADest <> nil) then
   begin
    sourceSize := GMLockByteSize(ASource);
    if AMaxBytesToCopy > 0 then sourceSize := Min(sourceSize, AMaxBytesToCopy);
    GMHrCheckIntf(ADest.SetSize(sourceSize), ADest, {$I %CurrentRoutine%});
    if sourceSize > 0 then
     begin
      sourcePos := 0;
      destPos := 0;
      bufSize := Min(CCopyBufSize, sourceSize);
      GetMem(pBuffer, bufSize);
      try
       while sourcePos < sourceSize do
        begin
         n := Max(0, Min(bufSize, sourceSize - sourcePos));
         GMHrCheckIntf(ASource.ReadAt(sourcePos, pBuffer, n, @readCount), ASource, {$I %CurrentRoutine%});
         if AVerfy and (readCount <> n) then raise EGMException.IntfError(GMFormat(RStrReadErrorFmt, [bufSize, readCount]), ASource, {$I %CurrentRoutine%});
         Inc(sourcePos, readCount);
         GMHrCheckIntf(ADest.WriteAt(destPos, pBuffer, readCount, @WriteCount), ADest, {$I %CurrentRoutine%});
         if AVerfy and (WriteCount <> readCount) then raise EGMException.IntfError(GMFormat(RStrWriteErrorFmt, [readCount, WriteCount]), ADest, {$I %CurrentRoutine%});
         Inc(destPos, WriteCount);
        end;
      finally
       FreeMem(pBuffer);
      end;
     end;
   end;
end;

procedure GMLockByteSafeReadAt(const ASource: ILockBytes; const AOffset: Int64; const APData: Pointer; const ACount: LongInt; const ACallingName: TGMString);
var n: LongInt;
begin
  if (ASource = nil) or (ACount <= 0) then Exit;
  GMHrCheckIntf(ASource.ReadAt(AOffset, APData, ACount, @n), ASource, ACallingName);
  if n <> ACount then raise EGMException.IntfError(GMFormat(RStrReadErrorFmt, [ACount, n]), ASource, ACallingName);
end;

procedure GMLockByteSafeWriteAt(const ADest: ILockBytes; const AOffset: Int64; const APData: Pointer; const ACount: LongInt; const ACallingName: TGMString);
var n: LongInt;
begin
  if (ADest = nil) or (ACount <= 0) then Exit;
  GMHrCheckIntf(ADest.WriteAt(AOffset, APData, ACount, @n), ADest, ACallingName);
  if n <> ACount then raise EGMException.IntfError(GMFormat(RStrWriteErrorFmt, [ACount, n]), ADest, ACallingName);
end;


{ --------------------------- }
{ ---- Progress Routines ---- }
{ --------------------------- }

procedure GMSetProgressAndCheckCanceled(const AProgresssable: IUnknown; const AProgress: Int64; var ACancel: BOOL; const ACalcProgressKind: TGMCalcProgressKind);
var OnProgress: IGMOnProgress;
begin
  if GMQueryInterface(AProgresssable, IGMOnProgress, OnProgress) then
   begin
    OnProgress.OnProgress(AProgress, ACancel, ACalcProgressKind);
    if ACancel then raise EGMAbort.Create(RStrOperationCanceled);
   end;
end;

procedure GMSetProgressMax(const AProgresssable: IUnknown; const AProgressMax: Int64);
var ProgressMax: IGMSetProgressMax;
begin
  if GMQueryInterface(AProgresssable, IGMSetProgressMax, ProgressMax) then ProgressMax.SetProgressMax(AProgressMax);
end;

procedure GMSetProgressDescription(const AProgresssable: IUnknown; const AProgressDescription: TGMString; const ATextColor: COLORREF);
var ProgressDescription: IGMSetProgressDescription;
begin
  if GMQueryInterface(AProgresssable, IGMSetProgressDescription, ProgressDescription) then
     ProgressDescription.SetProgressDescription(AProgressDescription, ATextColor);
end;


{ -------------------------- }
{ ---- Istream Routines ---- }
{ -------------------------- }

function GMIStreamSize(const AStream: IUnknown): Int64;
var Stat: TStatStg; strm: IStream;
begin
  if not GMQueryInterface(AStream, IStream, strm) then Result := 0 else
   begin
    FillByte(Stat, SizeOf(Stat), 0);
    GMHrCheckIntf(strm.Stat(Stat, STATFLAG_NONAME), strm, 'GMIStreamSize');
    if Stat.pwcsName <> nil then CoTaskMemFree(Stat.pwcsName);
    Result := Stat.cbSize;
   end;
end;

function GMIStreamPos(const AStream: IUnknown): Int64;
var strm: IStream;
begin
  if not GMQueryInterface(AStream, IStream, strm) then Result := 0 else
     GMHrCheckIntf(strm.Seek(0, STREAM_SEEK_CUR, @Result), strm, 'GMIStreamPos');
end;

function GMSetIStreamAbsPos(const AStream: IUnknown; const ANewPos: Int64; const ACallingName: TGMString): Int64;
var strm: IStream;
begin
  if not GMQueryInterface(AStream, IStream, strm) then Result := 0 else
     GMHrCheckIntf(strm.Seek(ANewPos, STREAM_SEEK_SET, @Result), strm, ACallingName);
end;

function GMIStreamRead(const ASource: ISequentialStream; const Data: Pointer; const DataSizeInBytes: LongWord): Cardinal;
begin
  if (ASource = nil) or (DataSizeInBytes = 0) then Result := 0 else ASource.Read(Data, DataSizeInBytes, Pointer(@Result));
end;

procedure GMSafeIStreamRead(const ASource: ISequentialStream; const AData: Pointer; const ADataSizeInBytes: LongWord; const ACallingName: TGMString);
var N: LongWord; //RtnName: TGMString;
begin
  if (ASource <> nil) and (ADataSizeInBytes > 0) then
   begin
    //if ACallingName <> cDfltRoutineName then RtnName := ACallingName else RtnName := {$I %CurrentRoutine%};
    N := 0;
    GMHrCheckIntf(ASource.Read(AData, ADataSizeInBytes, Pointer(@N)), ASource, ACallingName); // , RStrStreamRead + ': '
    if N <> ADataSizeInBytes then raise EGMException.IntfError(GMStringJoin(ACallingName, ': ', GMFormat(RStrReadErrorFmt, [ADataSizeInBytes, N])), ASource, ACallingName);
   end;
end;

procedure GMSafeIStreamWrite(const ADest: ISequentialStream; const AData: Pointer; const ADataSizeInBytes: LongWord; const ACallingName: TGMString);
var dwWritten: LongWord; //RtnName: TGMString;
begin
  if (ADest <> nil) and (ADataSizeInBytes > 0) then
   begin
    //if ACallingName <> cDfltRoutineName then RtnName := ACallingName else RtnName := {$I %CurrentRoutine%};
    dwWritten := 0;
    GMHrCheckIntf(ADest.Write(AData, ADataSizeInBytes, Pointer(@dwWritten)), ADest, ACallingName); // , RStrStreamWrite + ':'
    if dwWritten <> ADataSizeInBytes then raise EGMException.IntfError(GMFormat(RStrWriteErrorFmt, [ADataSizeInBytes, dwWritten]), ADest, ACallingName);
   end;
end;

function GMIStreamReadResult(const pcbOut: Pointer; const AllDone: Boolean): HResult;
const CResult: array [Boolean, Boolean] of HResult = ((S_FALSE, S_OK), (GM_E_STREAMREAD, S_OK));
begin
  Result := CResult[pcbOut = nil, AllDone];
end;

function GMIStreamWriteResult(const pcbOut: Pointer; const AllDone: Boolean): HResult;
const CResult: array [Boolean, Boolean] of HResult = ((S_FALSE, S_OK), (GM_E_STREAMWRITE, S_OK));
begin
  Result := CResult[pcbOut = nil, AllDone];
end;

procedure GMCopyIStreamTime(const ASourceStrm, ADestStrm: ISequentialStream; const AOnProgressProc: TGMOnProgressProc; const ACallBackTimeInMS: LongWord; const ACallingName: TGMString);
const cBufAlignSize = $1000;{4KB} cBufSizeMin = 1024; cBufSizeMax = $40000;{256KB} cBufSizeStart = 4096; cOneMilliSecond = 1 / (24 * 60 * 60 * 1000);
var n, bufferSize, newBufSize: LongWord; total: Int64; t1, t2, cbTime: TDateTime; buffer: RawByteString; canceled: BOOL;// PBuffer: Pointer; t1, t2: LongWord;
begin
  //
  // Adjust buffer size during copy so that OnProgress will be called every ACallBackTimeInMS
  //
  // Because Tickcount will wrap every 72 days better use a TDateTime values instead of TickCount here!
  //
  canceled := False; //PBuffer := nil;
  if (ASourceStrm = nil) or (ADestStrm = nil) or (ACallBackTimeInMS <= 0) then Exit;
   //try
    cbTime := ACallBackTimeInMS * cOneMilliSecond;
    bufferSize := 0;
    newBufSize := cBufSizeStart;
    total := 0;
    repeat
     if GMAlignedValue(bufferSize, cBufAlignSize) <> GMAlignedValue(newBufSize, cBufAlignSize) then SetLength(buffer, GMAlignedValue(newBufSize, cBufAlignSize)); //ReAllocMem(PBuffer, GMAlignedValue(newBufSize, cBufAlignSize));
     {$IFDEF DEBUG}
     //GMTrace('Stream Copy bufferSize: '+GMIntToStr(newBufSize)); // <- for testing
     {$ENDIF}
     bufferSize := newBufSize;
     t1 := now; // t1 := GetTickCount;
     n := 0;
     GMHrCheckIntf(ASourceStrm.Read(PAnsiChar(buffer), bufferSize, Pointer(@n)), ASourceStrm, ACallingName); // , RStrStreamRead + ': '
     GMSafeIStreamWrite(ADestStrm, PAnsiChar(buffer), n, ACallingName);
     //Sleep(170);  <- Test
     t2 := Now; // t2 := GetTickCount;
     //if Progress <> nil then begin Inc(total, n); Progress.OnProgress(total, Result); end;
     if Assigned(AOnProgressProc) then begin Inc(total, n); AOnProgressProc(total, canceled); end;
     //if t1 = t2 then newBufSize := cBufSizeMax else newBufSize := GMBoundedInt(Round(n * ACallBackTimeInMS / (t2 - t1)), 1, cBufSizeMax);
     if t1 = t2 then newBufSize := cBufSizeMax else newBufSize := GMBoundedInt(Round(n * (cbTime / (t2 - t1))), cBufSizeMin, cBufSizeMax);
//   Sleep(600);
    until (n < bufferSize) or canceled;
    if canceled then raise EGMAbort.Create(RStrOperationCanceled);
//  Result := not Result;
   //finally
    //FreeMem(PBuffer);
   //end;
end;

procedure GMCopyIStreamBufSize(const ASourceStrm, ADestStrm: ISequentialStream; const ACopyBufferSize: LongWord; const AOnProgressProc: TGMOnProgressProc; const ACallingName: TGMString);
var n: LongWord; total: Int64; buffer: RawByteString; canceled: BOOL; //PIBuffer: IGMMemoryBuffer;
begin
  canceled := False; total := 0;
  if (ASourceStrm = nil) or (ADestStrm = nil) or (ACopyBufferSize = 0) then Exit;
  //PIBuffer := TGMMemoryBuffer.Create(nil, ACopyBufferSize);
  SetLength(buffer, ACopyBufferSize);
  repeat
   n := 0;                 // PIBuffer.Memory
   GMHrCheckIntf(ASourceStrm.Read(PAnsiChar(buffer), ACopyBufferSize, Pointer(@n)), ASourceStrm, ACallingName); // , RStrStreamRead + ': '
   if n > 0 then GMSafeIStreamWrite(ADestStrm, PAnsiChar(buffer), n, ACallingName);
   //if Progress <> nil then begin Inc(total, n); Progress.OnProgress(total, Result); end;
   if Assigned(AOnProgressProc) then begin Inc(total, n); AOnProgressProc(total, canceled); end;
  until (n < ACopyBufferSize) or canceled;
  if canceled then raise EGMAbort.Create(RStrOperationCanceled);
//Result := not Result;
end;

procedure GMCopyIStream(const ASourceStrm, ADestStrm: ISequentialStream; const ACopyBufferSize: LongInt; const AOnProgressProc: TGMOnProgressProc; const ACallingName: TGMString);
begin
  if ACopyBufferSize = 0 then Exit; // begin Result := False; Exit; end;
  if ACopyBufferSize < 0 then
   //Result :=
   GMCopyIStreamTime(ASourceStrm, ADestStrm, AOnProgressProc, -ACopyBufferSize, ACallingName)
  else
   //Result :=
   GMCopyIStreamBufSize(ASourceStrm, ADestStrm, ACopyBufferSize, AOnProgressProc, ACallingName);
end;

function GMIStreamContentAsString(const ASourceStrm: ISequentialStream; StartPos: Int64; const ACallingName: TGMString): AnsiString;
var PosKeeper: IUnknown; seekStrm, strStream: IStream;
begin
  Result := '';
  if ASourceStrm = nil then Exit;

  if GMQueryInterface(ASourceStrm, IStream, seekStrm) then
   begin
    if StartPos < 0 then GMHrCheckObj(seekStrm.Seek(0, STREAM_SEEK_CUR, @StartPos), nil, ACallingName);
    PosKeeper := TGMIStreamPosKeeper.Create(seekStrm, StartPos);
   end;

  strStream := TGMAnsiStringIStream.Create('');
  GMCopyIStream(ASourceStrm, strStream);
  Result := GMGetIntfText(strStream);
//SetLength(Result, GMIStreamSize(ASourceStrm) - StartPos);
//if Length(Result) > 0 then GMSafeIStreamRead(ASourceStrm, PGMChar(Result), Length(Result), ACallingName);
end;


{ ----------------------------- }
{ ---- Activatable Objects ---- }
{ ----------------------------- }

function GMObjIsActive(const AObj: TObject; const ADefaultValue: Boolean = False): Boolean;
var PIActive: IGMGetActive;
begin
  if (AObj <> nil) and AObj.GetInterface(IGMGetActive, PIActive) then Result := PIActive.Active else Result := ADefaultValue;
  //Result := (AObj <> nil) and AObj.GetInterface(IGMGetActive, PIActive) and PIActive.Active;
end;

function GMIntfIsActive(const AIntf: IUnknown; const ADefaultValue: Boolean = False): Boolean;
var PIActive: IGMGetActive;
begin
  if GMQueryInterface(AIntf, IGMGetActive, PIActive) then Result := PIActive.Active else Result := ADefaultValue;
  //Result := (AIntf <> nil) and (AIntf.QueryInterface(IGMGetActive, PIActive) = S_OK) and PIActive.Active;
end;

procedure GMCheckObjIsActive(const AObj: TObject; const ACallingName: TGMString);
var PIActive: IGMGetActive; //RtnName: TGMString;
begin
  //if ACallingName then RtnName := {$I %CurrentRoutine%} else RtnName := ACallingName;
  GMCheckGetInterface(AObj, IGMGetActive, PIActive, {$I %CurrentRoutine%});
  if not PIActive.Active then raise EGMException.ObjError(GMFormat(RStrCheckActive, [ACallingName]), AObj, {$I %CurrentRoutine%});
end;

procedure GMCheckIntfIsActive(const AIntf: IUnknown; const ACallingName: TGMString);
var PIActive: IGMGetActive; //RtnName: TGMString;
begin
  //if ACallingName then RtnName := {$I %CurrentRoutine%} else RtnName := ACallingName;
  GMCheckQueryInterface(AIntf, IGMGetActive, PIActive, {$I %CurrentRoutine%});
  if not PIActive.Active then raise EGMException.IntfError(GMFormat(RStrCheckActive, [ACallingName]), AIntf, {$I %CurrentRoutine%});
end;

procedure GMCheckObjIsInActive(const AObj: TObject; const NeedInActiveName: TGMString);
var PIActive: IGMGetActive;
begin
  GMCheckGetInterface(AObj, IGMGetActive, PIActive, {$I %CurrentRoutine%});
  if PIActive.Active then raise EGMException.ObjError(GMFormat(RStrCheckInactive, [NeedInActiveName]), AObj, {$I %CurrentRoutine%});
end;

procedure GMCheckIntfIsInActive(const AIntf: IUnknown; const NeedInActiveName: TGMString);
var PIActive: IGMGetActive;
begin
  GMCheckQueryInterface(AIntf, IGMGetActive, PIActive, {$I %CurrentRoutine%});
  if PIActive.Active then raise EGMException.IntfError(GMFormat(RStrCheckInactive, [NeedInActiveName]), AIntf, {$I %CurrentRoutine%});
end;

function GMSetObjActive(const AObj: TObject; const Active: Boolean; const ACallingName: TGMString): Boolean;
//var PIActive: IGMGetSetActive;
begin
  //if (AObj <> nil) and AObj.GetInterface(IGMGetSetActive, PIActive) then PIActive.Active := Active;
  Result := GMSetIntfActive(GMObjAsIntf(AObj), Active, ACallingName);
end;

function GMSetIntfActive(const AIntf: IUnknown; const Active: Boolean; const ACallingName: TGMString): Boolean;
var PIActive: IGMGetSetActive;
begin
  if AIntf = nil then Result := False else
   begin
    GMCheckQueryInterface(AIntf, IGMGetSetActive, PIActive, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
    Result := PIActive.Active;
    PIActive.Active := Active;
   end; 
end;


{ -------------------------- }
{ ---- Interface Source ---- }
{ -------------------------- }

function GMGetInterfaceSource(const AContainer: IUnknown): IUnknown;
var getIntfSrc: IGMGetInterfaceSource;
begin
  if GMQueryInterface(AContainer, IGMGetInterfaceSource, getIntfSrc) then Result := getIntfSrc.InterfaceSource else Result := nil;
end;

procedure GMSetInterfaceSource(const AContainer, AIntfSource: IUnknown);
var setIntfSrc: IGMGetSetInterfaceSource;
begin
  if GMQueryInterface(AContainer, IGMGetSetInterfaceSource, setIntfSrc) then setIntfSrc.InterfaceSource := AIntfSource;
end;


{ ---------------------- }
{ ---- Field Values ---- }
{ ---------------------- }

function GMGetItemValue(const AContainer: IUnknown; const AItemName: TGMString): RGMUnionValue;
var fieldByName: IGMGetIntfByName; getVal: IGMGetUnionValue;
begin
  if (AItemName <> '') and GMQueryInterface(AContainer, IGMGetIntfByName, fieldByName) and
     (fieldByName.GetIntfByName(AItemName, IGMGetUnionValue, getVal) = S_OK) then Result := getVal.Value else Result := uvtNull;
end;

function GMGetItemValue(const AContainer: IUnknown; const AItemPosition: LongInt): RGMUnionValue;
var fieldByPos: IGMGetIntfByPosition; getVal: IGMGetUnionValue;
begin
  if GMQueryInterface(AContainer, IGMGetIntfByPosition, fieldByPos) and
     (fieldByPos.GetIntfByPosition(AItemPosition, IGMGetUnionValue, getVal) = S_OK) then Result := getVal.Value else Result := uvtNull;
end;


function GMCheckGetItemValue(const AContainer: IUnknown; const ItemName: TGMString; const ACallingName: TGMString = cDfltRoutineName): RGMUnionValue; overload;
var fieldByName: IGMGetIntfByName; getVal: IGMGetUnionValue;
begin
  GMCheckQueryInterface(AContainer, IGMGetIntfByName, fieldByName, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
  GMHrCheckIntf(fieldByName.GetIntfByName(ItemName, IGMGetUnionValue, getVal), AContainer, BuildCallingName(ACallingName, {$I %CurrentRoutine%}), MsgNoItemIntfPrefix(ItemName, IGMGetUnionValue));
  Result := getVal.Value;
end;

function GMCheckGetItemValue(const AContainer: IUnknown; const ItemPosition: LongInt; const ACallingName: TGMString = cDfltRoutineName): RGMUnionValue; overload;
var fieldByPos: IGMGetIntfByPosition; getVal: IGMGetUnionValue;
begin
  GMCheckQueryInterface(AContainer, IGMGetIntfByPosition, fieldByPos, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
  GMHrCheckIntf(fieldByPos.GetIntfByPosition(ItemPosition, IGMGetUnionValue, getVal), AContainer, BuildCallingName(ACallingName, {$I %CurrentRoutine%}), MsgNoItemIntfPrefix(GMIntToStr(ItemPosition), IGMGetUnionValue));
  Result := getVal.Value;
end;


procedure GMSetItemValue(const AContainer: IUnknown; const AItemName: TGMString; const AValue: RGMUnionValue);
var PIFieldByName: IGMGetIntfByName; getVal: IGMGetSetUnionValue;
begin
   if (AItemName <> '') and GMQueryInterface(AContainer, IGMGetIntfByName, PIFieldByName) and
      (PIFieldByName.GetIntfByName(AItemName, IGMGetSetUnionValue, getVal) = S_OK) then getVal.Value := AValue;
end;

procedure GMCheckSetItemValue(const AContainer: IUnknown; const ItemName: TGMString; const AValue: RGMUnionValue; const ACallingName: TGMString = cDfltRoutineName);
var PIFieldByName: IGMGetIntfByName; setVal: IGMGetSetUnionValue;
begin
  GMCheckQueryInterface(AContainer, IGMGetIntfByName, PIFieldByName, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
  GMHrCheckIntf(PIFieldByName.GetIntfByName(ItemName, IGMGetSetUnionValue, setVal), AContainer, BuildCallingName(ACallingName, {$I %CurrentRoutine%}), MsgNoItemIntfPrefix(ItemName, IGMGetSetUnionValue));
  setVal.Value := AValue;
end;


function GMGetFieldValueImpl(const AContainer: IUnknown; const AIndex: RGMUnionValue): RGMUnionValue;
var intfByPos: IGMGetIntfByPosition; intfByName: IGMGetIntfByName; val: IGMGetUnionValue; fieldPos: LongInt; fieldName: TGMString; hr: HResult;
begin
  GMCheckIntfIsActive(AContainer, 'FieldValue ' + RStrProperty);

  case AIndex.ValueType of
   uvtInt16, uvtInt32, uvtInt64, uvtDouble:
    begin
     GMCheckQueryInterface(AContainer, IGMGetIntfByPosition, intfByPos, {$I %CurrentRoutine%});
     fieldPos := AIndex;
     hr := intfByPos.GetIntfByPosition(fieldPos, IGMGetUnionValue, val);
     if not GMHrSucceeded(hr) then GMHrCheckIntf(hr, AContainer, {$I %CurrentRoutine%}, MsgNoItemIntfPrefix(GMIntToStr(fieldPos), IGMGetUnionValue));
    end;

   uvtString:
    begin
     GMCheckQueryInterface(AContainer, IGMGetIntfByName, intfByName, {$I %CurrentRoutine%});
     fieldName := AIndex;
     hr := intfByName.GetIntfByName(fieldName, IGMGetUnionValue, val);
     if not GMHrSucceeded(hr) then
      begin
       if hr = GMHResultFromWin32(ERROR_FILE_NOT_FOUND) then
         raise EGMException.IntfError(GMFormat(RStrFieldNotFound, [fieldName, GMGetIntfName(AContainer)]), AContainer, {$I %CurrentRoutine%})
       else
         GMHrCheckIntf(hr, AContainer, {$I %CurrentRoutine%}, MsgNoItemIntfPrefix(GMStringJoin(GMGetIntfName(AContainer), '.', fieldName), IGMGetUnionValue));
      end;
    end;

   else raise EGMException.IntfError(GMFormat(RStrUnsupportedIdxType, [AIndex.ValueTypeName]), AContainer, {$I %CurrentRoutine%});
  end;

  if val <> nil then Result := val.Value else Result := uvtNull;
end;

procedure GMSetFieldValueImpl(const AContainer: IUnknown; const AIndex: RGMUnionValue; const AValue: RGMUnionValue);
var intfByPos: IGMGetIntfByPosition; intfByName: IGMGetIntfByName; val: IGMGetSetUnionValue; fieldPos: LongInt; fieldName: TGMString; hr: HResult;
begin
  GMCheckIntfIsActive(AContainer, 'FieldValue ' + RStrProperty);

  case AIndex.ValueType of
   uvtInt16, uvtInt32, uvtInt64, uvtDouble:
    begin
     GMCheckQueryInterface(AContainer, IGMGetIntfByPosition, intfByPos, {$I %CurrentRoutine%});
     fieldPos := AIndex;
     hr := intfByPos.GetIntfByPosition(fieldPos, IGMGetSetUnionValue, val);
     if not GMHrSucceeded(hr) then GMHrCheckIntf(hr, AContainer, {$I %CurrentRoutine%}, MsgNoItemIntfPrefix(GMIntToStr(fieldPos), IGMGetSetUnionValue));
    end;

   uvtString:
    begin
     GMCheckQueryInterface(AContainer, IGMGetIntfByName, intfByName, {$I %CurrentRoutine%});
     fieldName := AIndex;
     hr := intfByName.GetIntfByName(fieldName, IGMGetSetUnionValue, val);
     if not GMHrSucceeded(hr) then
      begin
       if hr = GMHResultFromWin32(ERROR_FILE_NOT_FOUND) then
         raise EGMException.IntfError(GMFormat(RStrFieldNotFound, [fieldName, GMGetIntfName(AContainer)]), AContainer, {$I %CurrentRoutine%})
       else
         GMHrCheckIntf(hr, AContainer, {$I %CurrentRoutine%}, MsgNoItemIntfPrefix(GMStringJoin(GMGetIntfName(AContainer), '.', fieldName), IGMGetSetUnionValue));
      end;
    end;

   else raise EGMException.IntfError(GMFormat(RStrUnsupportedIdxType, [AIndex.ValueTypeName]), AContainer, {$I %CurrentRoutine%});
  end;

  if val <> nil then val.Value := AValue;
end;


{ --------------------- }
{ ---- DisplayText ---- }
{ --------------------- }

function GMFieldDisplayText(const FieldName: TGMString; const PIFieldByName: IGMGetIntfByName): TGMString;
var PIText: IGMGetText;
begin
  if (FieldName <> '') and (PIFieldByName <> nil) and (PIFieldByName.GetIntfByName(FieldName, IGMGetText, PIText) = S_OK) then
   Result := PIText.Text
  else
   Result := '';
end;


{ ------------------------------ }
{ ---- Executing Operations ---- }
{ ------------------------------ }

function GMCanExecOperation(const AIntf: IUnknown; const Operation: LongInt; const Parameter: IUnknown = nil): Boolean;
var PICanExecOp: IGMCanExecuteOperation;
begin
  if AIntf = nil then Result := False
  else
  if GMQueryInterface(AIntf, IGMCanExecuteOperation, PICanExecOp) then
   Result := PICanExecOp.CanExecuteOperation(Ord(Operation))
  else
   Result := True;
end;

procedure GMCheckExecOperation(const AObj: TObject; const Operation: LongInt; const OperationName: TGMString; const ACallingName: TGMString; const Parameter: IUnknown);
begin
  GMCheckExecOperation(GMObjAsIntf(AObj), Operation, OperationName, ACallingName, Parameter);
end;

procedure GMCheckExecOperation(const AIntf: IUnknown; const Operation: LongInt; const OperationName: TGMString; const ACallingName: TGMString; const Parameter: IUnknown);
var PIExecOp: IGMExecuteOperation; OpName: TGMString;
begin
  if not GMCanExecOperation(AIntf, Operation, Parameter) then Exit;
  GMCheckQueryInterface(AIntf, IGMExecuteOperation, PIExecOp, ACallingName);
  if not PIExecOp.ExecuteOperation(Operation, Parameter) then
   begin
    if OperationName = '' then OpName := GMFormat('(%d)', [Operation]) else OpName := GMFormat('(%d) "%s"', [Operation, OperationName]);
    raise EGMException.IntfError(GMFormat(RStrOperationExecFailed, [OpName]), AIntf, ACallingName);
   end;
end;

function GMExecuteOperation(const AObj: TObject; const Operation: LongInt; const Parameter: IUnknown = nil): Boolean;
begin
  Result := GMExecuteOperation(GMObjAsIntf(AObj), Operation, Parameter)
end;

function GMExecuteOperation(const AIntf: IUnknown; const Operation: LongInt; const Parameter: IUnknown = nil): Boolean;
var PIExecOp: IGMExecuteOperation; 
begin
  Result := GMCanExecOperation(AIntf, Operation, Parameter);
  if Result and GMQueryInterface(AIntf, IGMExecuteOperation, PIExecOp) then
     Result := PIExecOp.ExecuteOperation(Ord(Operation), Parameter);
end;


{ ---------------------------------- }
{ ---- Asking Boolean Questions ---- }
{ ---------------------------------- }

function GMBooleanAskResult(const Value: Boolean): LongInt;
const cResultValues: array [Boolean] of LongInt = (Ord(barFalse), Ord(barTrue));
begin
  Result := cResultValues[Value];
end;

function GMAskBoolean(const AObj: TObject; const ValueId: LongInt; const DefaultResult: Boolean): Boolean;
begin
  Result := GMAskBoolean(GMObjAsIntf(AObj), ValueId, DefaultResult)
end;

function GMAskBoolean(const AIntf: IUnknown; const ValueId: LongInt; const DefaultResult: Boolean): Boolean;
var PIAskBoolean: IGMAskBoolean;
begin
  if not GMQueryInterface(AIntf, IGMAskBoolean, PIAskBoolean) then Result := DefaultResult else
   case PIAskBoolean.AskBoolean(ValueId) of
    Ord(barTrue): Result := True;
    Ord(barFalse): Result := False;
    else Result := DefaultResult;
   end;
end;

function GMAskUnkBoolean(const AIntf: IUnknown; const AValueId: LongInt): TGMBoolAskResult;
var PIAskBoolean: IGMAskBoolean;
begin
  if not GMQueryInterface(AIntf, IGMAskBoolean, PIAskBoolean) then Result := barUnknown else
   Result := TGMBoolAskResult(GMBoundedInt(PIAskBoolean.AskBoolean(AValueId), Ord(Low(TGMBoolAskResult)), Ord(High(TGMBoolAskResult))));
end;

function GMCheckAskBoolean(const AObj: TObject; const ValueId: LongInt; const ACallingName: TGMString): Boolean;
begin
  Result := GMCheckAskBoolean(GMObjAsIntf(AObj), ValueId, ACallingName);
end;

function GMCheckAskBoolean(const AIntf: IUnknown; const ValueId: LongInt; const ACallingName: TGMString): Boolean;
var PIAskBoolean: IGMAskBoolean; Answer: LongInt;
begin
  GMCheckQueryInterface(AIntf, IGMAskBoolean, PIAskBoolean, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
  Answer := PIAskBoolean.AskBoolean(ValueId);
  case Answer of
   Ord(barTrue): Result := True;
   Ord(barFalse): Result := False;
   else raise EGMException.IntfError(GMFormat(RStrUnsupoortedBoolQuestion, [ValueId]), AIntf, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
  end;
end;


{ ----------------------------- }
{ ---- Asking for Integers ---- }
{ ----------------------------- }

function GMAskInteger(const AObj: TObject; const ValueId: LongInt; const ADefaultValue: LongInt): LongInt; overload;
//var PIUnk: IUnknown;
begin
//  if (AObj <> nil) and (AObj.GetInterface(IUnknown, PIUnk)) then
//   Result := GMAskInteger(PIUnk, ValueId, ADefaultValue)
//  else
//   Result := ADefaultValue;
  Result := GMAskInteger(GMObjAsIntf(AObj), ValueId, ADefaultValue);
end;

function GMAskInteger(const AIntf: IUnknown; const ValueId: LongInt; const ADefaultValue: LongInt): LongInt; overload;
var PIAskInteger: IGMAskInteger;
begin
  if not GMQueryInterface(AIntf, IGMAskInteger, PIAskInteger) then Result := ADefaultValue else
   begin
    Result := PIAskInteger.AskInteger(ValueId);
    if Result = cInvalidIntValue then Result := ADefaultValue;
   end;
end;

function GMCheckAskInteger(const AObj: TObject; const ValueId: LongInt; const ACallingName: TGMString): LongInt;
begin
  Result := GMCheckAskInteger(GMObjAsIntf(AObj), ValueId, ACallingName);
end;

function GMCheckAskInteger(const AIntf: IUnknown; const ValueId: LongInt; const ACallingName: TGMString): LongInt;
var PIAskInteger: IGMAskInteger;
begin
  GMcheckQueryInterface(AIntf, IGMAskInteger, PIAskInteger, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
  Result := PIAskInteger.AskInteger(ValueId);
  if Result = CInvalidIntValue then raise EGMException.IntfError(GMFormat(RStrUnsupportedValueId, [ValueId]), AIntf, BuildCallingName(ACallingName, {$I %CurrentRoutine%}));
end;


{ ------------------------- }
{ ---- Position Helper ---- }
{ ------------------------- }

function GMGetIntfPosition(const AIntf: IUnknown; const DefaultPos: LongInt): LongInt;
var PIPosition: IGMGetPosition;
begin
  if GMQueryInterface(AIntf, IGMGetPosition, PIPosition) then Result := PIPosition.Position else Result := DefaultPos;
end;

procedure GMSetIntfPosition(const AIntf: IUnknown; const Position: LongInt);
var PIPosition: IGMGetSetPosition;
begin
  if {and GMAskBoolean(AIntf, Ord(bvCanSetPosition), True)}
     GMQueryInterface(AIntf, IGMGetSetPosition, PIPosition) then PIPosition.Position := Position;
end;

procedure GMMovePosition(const AIntf: IUnknown; const Delta: LongInt);
var PIPosition: IGMGetSetPosition;
begin
  if {and GMAskBoolean(AIntf, Ord(bvCanSetPosition), True)}
     GMQueryInterface(AIntf, IGMGetSetPosition, PIPosition) then PIPosition.Position := PIPosition.Position + Delta;
end;


{ ----------------------- }
{ ---- Empty Objects ---- }
{ ----------------------- }

function GMObjIsEmpty(const AObj: TObject; const DefaultResult: Boolean): Boolean;
begin
  Result := GMIntfIsEmpty(GMObjAsIntf(AObj), DefaultResult);
end;

function GMIntfIsEmpty(const AIntf: IUnknown; const DefaultResult: Boolean): Boolean;
var PICount: IGMGetCount;
begin
  if GMQueryInterface(AIntf, IGMGetCount, PICount) then Result := PICount.Count <= 0 else Result := DefaultResult;
end;


{ ---------------------------- }
{ ---- Cursor Move Helper ---- }
{ ---------------------------- }

function GMIsValidCursorMove(const AIntf: IUnknown; const Move: TGMCursorMove): Boolean;
var PIUniCur: IGMUnidirectionalCursor;
begin
  if AIntf = nil then Result := False else
   Case Move of
    cmFirst:
     Result := GMQueryInterface(AIntf, IGMCursorFirstLast, PIUniCur) and not PIUniCur.BOF and
               not GMIntfIsEmpty(PIUniCur) and GMAskBoolean(AIntf, Ord(bvCanSetPosition), True);
    cmPrior:
     Result := GMQueryInterface(AIntf, IGMBidirectionalCursor, PIUniCur) and not PIUniCur.BOF and
               not GMIntfIsEmpty(PIUniCur) and GMAskBoolean(AIntf, Ord(bvCanSetPosition), True);
    cmNext:
     Result := GMQueryInterface(AIntf, IGMUnidirectionalCursor, PIUniCur) and
               not PIUniCur.EOF and not GMIntfIsEmpty(PIUniCur) and GMIntfIsActive(AIntf);
    cmLast:
     Result := GMQueryInterface(AIntf, IGMCursorFirstLast, PIUniCur) and not PIUniCur.EOF and
               not GMIntfIsEmpty(PIUniCur) and GMAskBoolean(AIntf, Ord(bvCanSetPosition), True);
    else Result := False;
   end;
end;

procedure GMMoveCursor(const AIntf: IUnknown; const Move: TGMCursorMove);
var PIUniCur: IGMUnidirectionalCursor; PIBiCur: IGMBidirectionalCursor; PIFreeCur: IGMCursorFirstLast;
begin
  if AIntf <> nil then
   case Move of
    cmFirst: if GMQueryInterface(AIntf, IGMCursorFirstLast, PIFreeCur) and not PIFreeCur.BOF then PIFreeCur.MoveToFirst;
    cmPrior: if GMQueryInterface(AIntf, IGMBidirectionalCursor, PIBiCur) and not PIBiCur.BOF then PIBiCur.MoveToPrevious;
    cmNext:  if GMQueryInterface(AIntf, IGMUnidirectionalCursor, PIUniCur) and not PIUniCur.EOF then PIUniCur.MoveToNext;
    cmLast:  if GMQueryInterface(AIntf, IGMCursorFirstLast, PIFreeCur) and not PIFreeCur.EOF then PIFreeCur.MoveToLast;
   end;
end;

procedure GMSafeCursorMove(const AIntf: IUnknown; const Move: TGMCursorMove);
begin
  if GMIsValidCursorMove(AIntf, Move) then GMMoveCursor(AIntf, Move);
end;


{ ---------------------- }
{ ---- RGMTypedIntf ---- }
{ ---------------------- }

//class operator RGMTypedIntf<TIntf>.Implicit(const ATypedIntf: RGMTypedIntf<TIntf>): Pointer;
//begin
//  Result := Pointer(ATypedIntf.Intf);
//end;

//class operator RGMTypedIntf<TIntf>.Implicit(const ATypedIntf: RGMTypedIntf<TIntf>): TIntf;
//begin
//  Result := ATypedIntf.Intf;
//end;

//class operator RGMTypedIntf<TIntf>.Implicit(AValue: Pointer): RGMTypedIntf<TIntf>;
//begin
//
//end;

//class operator RGMTypedIntf<TIntf>.Implicit(AValue: IUnknown): RGMTypedIntf<TIntf>;
//begin
//  if AValue = nil then Result.Intf := nil else
//   GMCheckQueryInterface(AValue, TIntf, Result.Intf, 'RGMTypedIntf<TIntf>.Implicit');
//end;

class operator RGMTypedIntf<TIntf>.:=(const ATypedIntf: RGMTypedIntf<TIntf>): TIntf;
begin
  Result := ATypedIntf.Intf;
end;

class operator RGMTypedIntf<TIntf>.:=(AValue: IUnknown): RGMTypedIntf<TIntf>;
begin
  if AValue = nil then Result.Intf := nil else
    GMCheckQueryInterface(AValue, TIntf, Result.Intf, 'RGMTypedIntf<'+GMGuidToString(TIntf)+'>.Assign');
end;

class operator RGMTypedIntf<TIntf>.:=(AObj: TObject): RGMTypedIntf<TIntf>;
begin
  if AObj = nil then Result.Intf := nil else
   GMCheckGetInterface(AObj, TIntf, Result.Intf, 'RGMTypedIntf<'+GMGuidToString(TIntf)+'>.Assign');
end;

function RGMTypedIntf<TIntf>.QueryFrom(AIntf: IUnknown; ACheckResult: Boolean): Boolean;
begin
  if ACheckResult then
   begin
    GMCheckQueryInterface(AIntf, TIntf, Intf, {$I %CurrentRoutine%}); Result := True;
   end
  else
    Result := GMQueryInterface(AIntf, TIntf, Intf);
end;

function RGMTypedIntf<TIntf>.GetFrom(AObj: TObject; ACheckResult: Boolean): Boolean;
begin
  if ACheckResult then
   begin
    GMCheckGetInterface(AObj, TIntf, Intf, {$I %CurrentRoutine%}); Result := True;
   end
  else
    Result := GMGetInterface(AObj, TIntf, Intf);
end;

function RGMTypedIntf<TIntf>.Call(ACaller: TObject): TIntf;
begin
  //Assert(Intf <> nil, 'RGMTypedIntf<TIntf>.Intf <> nil');
  if Intf = nil then EGMException.ObjError(GMFormat(srCannotCallNilIntf, [GMGuidToString(TIntf)]), ACaller, 'RGMTypedIntf<'+GMGuidToString(TIntf)+'>.Call');
  Result := Intf;
end;



{ -------------------------------- }
{ ---- RGMCriticalSectionLock ---- }
{ -------------------------------- }

class operator RGMCriticalSectionLock.Initialize(var ACriticalSectionLock: RGMCriticalSectionLock);
begin
  ACriticalSectionLock := Default(RGMCriticalSectionLock);
end;

class operator RGMCriticalSectionLock.Finalize(var ACriticalSectionLock: RGMCriticalSectionLock);
begin
  ACriticalSectionLock.UnlockAll;
end;

procedure RGMCriticalSectionLock.Lock(const ACriticalSection: IGMCriticalSection);
begin
  CriticalSection := ACriticalSection;
  LockAgain;
end;

procedure RGMCriticalSectionLock.Lock(const ACriticalSection: IUnknown);
var cs: IGMCriticalSection;
begin
  if GMQueryInterface(ACriticalSection, IGMCriticalSection, cs) then Lock(cs);
end;

procedure RGMCriticalSectionLock.Lock(const ACriticalSection: TObject);
var cs: IGMCriticalSection;
begin
  if GMGetInterface(ACriticalSection, IGMCriticalSection, cs) then Lock(cs);
end;

procedure RGMCriticalSectionLock.LockAgain;
begin
  if CriticalSection <> nil then
     begin CriticalSection.EnterCriticalSection; Inc(LockCount); end;
end;

procedure RGMCriticalSectionLock.Unlock;
begin
  if (CriticalSection <> nil) and (LockCount > 0) then
     begin CriticalSection.LeaveCriticalSection; Dec(LockCount); end;
end;

procedure RGMCriticalSectionLock.UnlockAll;
begin
  while LockCount > 0 do Unlock;
end;

function RGMCriticalSectionLock.GetLockCount: Int64;
begin
  Result := LockCount;
end;


{ ---------------------------- }
{ ---- TGMCriticalSection ---- }
{ ---------------------------- }

constructor TGMCriticalSection.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  {$IFNDEF JEDIAPI}windows{$ELSE}jwaWinBase{$ENDIF}.InitializeCriticalSection(FCriticalSection);
end;

destructor TGMCriticalSection.Destroy;
begin
  {$IFNDEF JEDIAPI}windows{$ELSE}jwaWinBase{$ENDIF}.DeleteCriticalSection(FCriticalSection);
  inherited Destroy;
end;

procedure TGMCriticalSection.EnterCriticalSection;
begin
  {$IFNDEF JEDIAPI}windows{$ELSE}jwaWinBase{$ENDIF}.EnterCriticalSection(FCriticalSection);
end;

procedure TGMCriticalSection.LeaveCriticalSection;
begin
  {$IFNDEF JEDIAPI}windows{$ELSE}jwaWinBase{$ENDIF}.LeaveCriticalSection(FCriticalSection);
end;

function TGMCriticalSection.TryEnterCriticalSection: Boolean;
begin
  Result := {$IFNDEF JEDIAPI}windows{$ELSE}jwaWinBase{$ENDIF}.TryEnterCriticalSection(FCriticalSection);
end;


{ -------------------------------- }
{ ---- TGMCriticalSectionLock ---- }
{ -------------------------------- }

constructor TGMCriticalSectionLock.Create(const ACriticalSection: IUnknown; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  if ACriticalSection = nil then Exit; // <- allow nil!
  // But force ACriticalSection to support IGMCriticalSection interface if not nil!
  GMCheckQueryInterface(ACriticalSection, IGMCriticalSection, FCriticalSection, {$I %CurrentRoutine%});
  if FCriticalSection <> nil then FCriticalSection.EnterCriticalSection;
end;

destructor TGMCriticalSectionLock.Destroy;
begin
  if FCriticalSection <> nil then FCriticalSection.LeaveCriticalSection;
  inherited Destroy;
end;


{ --------------------------- }
{ ---- TGMCOMInitializer ---- }
{ --------------------------- }

constructor TGMCOMInitializer.Create(const ACoInitFlags: DWORD; const AHrCheck, ARefLifeTime: Boolean);
var hr: HResult;
begin
  inherited Create(ARefLifeTime);
  hr := CoInitializeEx(nil, ACoInitFlags);
  if AHrCheck then GMHrCheckObj(hr, Self, 'CoInitializeEx');
  FInitialized := GMHrSucceeded(hr);
end;

destructor TGMCOMInitializer.Destroy;
begin
  if FInitialized then CoUninitialize;
  inherited Destroy;
end;


{ --------------------------------- }
{ ---- TGMNotificationDisabler ---- }
{ --------------------------------- }

constructor TGMNotificationDisabler.Create(const ANotifier: IUnknown; const ANotificationOnReEnable: LongInt; const ANotificationOnFirstDisable: LongInt; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FNotificationOnReEnable := ANotificationOnReEnable;
  // follow "if possible" semantics here
  if not GMQueryInterface(ANotifier, IGMEnableNotifications, FNotifier) then Exit;
  //GMCheckQueryInterface(ANotifier, IGMEnableNotifications, FNotifier, {$I %CurrentRoutine%});
  FNotifier.DisableNotifications(ANotificationOnFirstDisable);
end;

destructor TGMNotificationDisabler.Destroy;
begin
  if FNotifier <> nil then try FNotifier.EnableNotifications(FNotificationOnReEnable); except end; // <- never raise exceptions in destructors
  inherited Destroy;
end;


{ --------------------------- }
{ ---- TGMPositionKeeper ---- }
{ --------------------------- }

constructor TGMPositionKeeper.Create(const AObjWithPosition: IUnknown; const ANewposition: LongInt; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  // follow "if possible" semantics here
  if not GMQueryInterface(AObjWithPosition, IGMGetSetPosition, FObjWithPosition) then Exit;
  //GMCheckQueryInterface(AObjWithPosition, IGMGetSetPosition, FObjWithPosition, {$I %CurrentRoutine%});
  FPosition := FObjWithPosition.Position;
  if ANewposition <> -1 then FObjWithPosition.Position := ANewposition;
end;

destructor TGMPositionKeeper.Destroy;
//var PICount: IGMGetCount;
begin
  if FObjWithPosition <> nil then try FObjWithPosition.Position := FPosition; except end; // <- never raise exceptions in destructors
   //if FObjWithPosition.QueryInterface(IGMGetCount, PICount) = S_OK then FObjWithPosition.Position := Min(FPosition, PICount.Count) else
  inherited Destroy;
end;


{ ------------------------ }
{ ---- TGMStateKeeper ---- }
{ ------------------------ }

constructor TGMStateKeeper.Create(const AObjWithState: IUnknown; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  // follow "if possible" semantics here
  if not GMQueryInterface(AObjWithState, IGMSaveRestoreState, FObjWithState) then Exit;
  //GMCheckQueryInterface(AObjWithState, IGMSaveRestoreState, FObjWithState, {$I %CurrentRoutine%});
  FState := FObjWithState.CaptureState;
end;

destructor TGMStateKeeper.Destroy;
begin
  // never raise exceptions in destructors
  if FObjWithState <> nil then try FObjWithState.RestoreState(FState); except end; // <- never raise exceptions in destructors
  inherited Destroy;
end;


{ ----------------------------- }
{ ---- TGMQuietStateKeeper ---- }
{ ----------------------------- }

constructor TGMQuietStateKeeper.Create(const AObjWithState: IUnknown; const ANotificationOnReEnable: LongInt; const ANotificationOnFirstDisable: LongInt; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FNotificationDisabler := TGMNotificationDisabler.Create(AObjWithState, ANotificationOnReEnable, ANotificationOnFirstDisable);
  FStateKeeper := TGMStateKeeper.Create(AObjWithState);
end;


{ ------------------------- }
{ ---- TGMActiveKeeper ---- }
{ ------------------------- }

constructor TGMActiveKeeper.Create(const AActivatableObj: IUnknown; const ANewActive: Boolean; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  GMQueryInterface(AActivatableObj, IGMGetSetActive, FActivatableObj);
  FWasActive := GMSetIntfActive(FActivatableObj, ANewActive);
end;

destructor TGMActiveKeeper.Destroy;
begin
  try GMSetIntfActive(FActivatableObj, FWasActive); except end; // <- never raise exceptions in destructors
  inherited Destroy;
end;


{ ----------------------------- }
{ ---- TGMVsdDirPathKeeper ---- }
{ ----------------------------- }

constructor TGMVsdDirPathKeeper.Create(const AValStorageDir: IUnknown; const ANewDirPath: TGMString; const ACreateIfNotExists: Boolean; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  if AValStorageDir = nil then Exit;
  // force AValStorageDir to support IGMValueStorageDirectory interface
  GMCheckQueryInterface(AValStorageDir, IGMValueStorageDirectory, FValStorageDir, {$I %CurrentRoutine%});
  FOldDirPath := FValStorageDir.CurrentPath;
  if Length(ANewDirPath) > 0 then GMVsdOpenDir(FValStorageDir, ANewDirPath, ACreateIfNotExists);
end;

destructor TGMVsdDirPathKeeper.Destroy;
begin
  if FValStorageDir <> nil then GMVsdOpenAbsDir(FValStorageDir, FOldDirPath, False);
  inherited Destroy;
end;


{ ----------------------------- }
{ ---- TGMIStreamPosKeeper ---- }
{ ----------------------------- }

constructor TGMIStreamPosKeeper.Create(const AStream: IUnknown; AStartPos: Int64; const ARefLifeTime: Boolean);
var strm: IStream;
begin
  inherited Create(ARefLifeTime);
//if AStream = nil then Exit;
  if not GMQueryInterface(AStream, IStream, strm) then Exit;
  FStream := strm;
  if AStartPos >= 0 then
   GMHrCheckObj(FStream.Seek(AStartPos, STREAM_SEEK_SET, @FOldPos), Self, {$I %CurrentRoutine%})
  else
   GMHrCheckObj(FStream.Seek(0, STREAM_SEEK_CUR, @FOldPos), Self, {$I %CurrentRoutine%});
end;

destructor TGMIStreamPosKeeper.Destroy;
begin
  if FStream <> nil then FStream.Seek(FOldPos, STREAM_SEEK_SET, @FOldPos); // <- no exceptions in destructors!
  inherited Destroy;
end;


{ -------------------------- }
{ ---- TGMPaintDisabler ---- }
{ -------------------------- }

{constructor TGMPaintDisabler.Create(const APaintObj: IUnknown; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  if APaintObj <> nil then APaintObj.QueryInterface(IGMEnableDisablePaint, FPaintObj);
  if FPaintObj <> nil then FPaintObj.DisablePaint;
end;

destructor TGMPaintDisabler.Destroy;
begin
  if FPaintObj <> nil then FPaintObj.EnablePaint;
  inherited Destroy;
end;}


{ -------------------------- }
{ ---- TGMRefCountedObj ---- }
{ -------------------------- }

constructor TGMRefCountedObj.Create(const ARefLifeTime: Boolean);
begin
  inherited Create;
  FRefLifeTime := ARefLifeTime;
  FRefCount := 1; // <- artificial RefCount during construction, avoiding immediate destruction
                  //    when local interface variables to this instance are used by derived constructors.
end;

procedure TGMRefCountedObj.AfterConstruction;
begin
  Dec(FRefCount);
  inherited AfterConstruction;
end;

procedure TGMRefCountedObj.BeforeDestruction;
begin
  inherited BeforeDestruction;
  InterlockedIncrement(FRefCount); // <- put an artificial RefCount during destruction to avoid reentering destructor if temporary references are used during destruction
end;

destructor TGMRefCountedObj.Destroy;
begin
  inherited Destroy;
  if Assigned(vfGMCheckRefCountOnDestroy) then vfGMCheckRefCountOnDestroy(RefCount-1, Self);
end;

procedure TGMRefCountedObj.OnFinalRelease;
begin
  Free;
end;

function TGMRefCountedObj.CreateCopyQI(const AIID: TGUID; out AIntf): HResult;
var unkCopy: IUnknown; assignFrom: IGMAssignFromObj;
begin
  unkCopy := TGMRefCountedObjClass(ClassType).Create(True);
  Result := unkCopy.QueryInterface(AIID, AIntf);
  if (Result = S_OK) and (unkCopy.QueryInterface(IGMAssignFromObj, assignFrom) = S_OK) then assignFrom.AssignFromObj(Self);
end;


{ ---- IGMGetObjInfo ---- }

function TGMRefCountedObj.GetClassName: TGMString;
//var RetVal: TGMString;
begin
  //RetVal := ClassName;
  //Result := PGMChar(RetVal);
  Result := ClassName;
end;

function TGMRefCountedObj.GetClassType: TClass;
begin
  Result := ClassType;
end;

function TGMRefCountedObj.GetInstance: TObject;
begin
  Result := Self;
end;

function TGMRefCountedObj.GetTypeInfo: PTypeInfo;
begin
  Result := ClassInfo;
end;


{ ---- IUnknown ---- }

function TGMRefCountedObj.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} AIID: TGUID; out AIntf): HResult;
begin
  if GetInterface(AIID, AIntf) then Result := S_OK else Result := E_NOINTERFACE;
  //GMTraceQueryInterface(Self, AIID, Result);
end;

function TGMRefCountedObj._AddRef: LongInt;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TGMRefCountedObj._Release: LongInt;
begin
  Result := InterlockedDecrement(FRefCount);
  if (Result = 0) and RefLifeTime then OnFinalRelease;
end;


{ ---------------------------- }
{ ---- TGMAggregatableObj ---- }
{ ---------------------------- }

constructor TGMAggregatableObj.Create(const AOwner: IUnknown; const ARefLifeTime: Boolean);
begin
  Create(ARefLifeTime);
  FOwner := Pointer(AOwner);
  Assert((AOwner = nil) or not ARefLifeTime, '(AOwner = nil) or not ARefLifeTime');
end;

function TGMAggregatableObj.QueryInterface(constref AIID: TGUID; out AIntf): HResult; stdcall;
begin
  if FOwner <> nil then Result := IUnknown(FOwner).QueryInterface(AIID, AIntf) else Result := E_NOINTERFACE;
  if Result <> S_OK then Result := inherited QueryInterface(AIID, AIntf);
end;

function TGMAggregatableObj._AddRef: LongInt; stdcall;
begin
  if FOwner <> nil then Result := IUnknown(FOwner)._AddRef else Result := inherited _AddRef;
end;

function TGMAggregatableObj._Release: LongInt; stdcall;
begin
  if FOwner <> nil then Result := IUnknown(FOwner)._Release else Result := inherited _Release;
end;

function TGMAggregatableObj.GetOwner: IUnknown;
begin
  Result := IUnknown(FOwner);
end;

function TGMAggregatableObj.GetOwnerObj: TObject;
begin
  Result := GMObjFromIntf(IUnknown(FOwner));
end;


{ ------------------------------ }
{ ---- TGMRefLifePersistent ---- }
{ ------------------------------ }

{$IFDEF DELPHIVCL}
constructor TGMRefLifePersistent.Create(const ARefLifeTime: Boolean);
begin
  inherited Create;
  FRefLifeTime := ARefLifeTime;
end;

procedure TGMRefLifePersistent.AfterConstruction;
begin
  inherited AfterConstruction;
  FConstructed := True;
end;

destructor TGMRefLifePersistent.Destroy;
begin
  inherited Destroy;
  if Assigned(vfGMCheckRefCountOnDestroy) then vfGMCheckRefCountOnDestroy(RefCount, Self);
end;

procedure TGMRefLifePersistent.OnFinalRelease;
begin
  Free;
end;

{ ---- IGMGetObjInfo ---- }

function TGMRefLifePersistent.GetClassName: TGMString;
begin
  Result := ClassName;
end;

function TGMRefLifePersistent.GetClassType: TClass;
begin
  Result := ClassType;
end;

function TGMRefLifePersistent.GetInstance: TObject;
begin
  Result := Self;
end;

function TGMRefLifePersistent.GetTypeInfo: PTypeInfo;
begin
  Result := ClassInfo;
end;

{ ---- IUnknown ---- }

function TGMRefLifePersistent.QueryInterface(const AIID: TGUID; out AIntf): HResult;
begin
  if GetInterface(AIID, AIntf) then Result := S_OK else Result := E_NOINTERFACE;
  //GMTraceQueryInterface(Self, AIID, Result);
end;

function TGMRefLifePersistent._AddRef: LongInt;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TGMRefLifePersistent._Release: LongInt;
begin
  Result := InterlockedDecrement(FRefCount);
  if (Result = 0) and RefLifeTime and FConstructed then OnFinalRelease;
end;
{$ENDIF}


{ ----------------------------- }
{ ---- TGMRefLifeComponent ---- }
{ ----------------------------- }

{$IFDEF DELPHIVCL}
constructor TGMRefLifeComponent.CreateIntf;
begin
  RefLifeTime := True;
  Create(nil); // <- Important: call virtual constructor here, to let derived classes initialize their members
end;

procedure TGMRefLifeComponent.AfterConstruction;
begin
  inherited AfterConstruction;
  FConstructed := True;
end;

destructor TGMRefLifeComponent.Destroy;
begin
  inherited Destroy;
  {if RefLifeTime then} if Assigned(vfGMCheckRefCountOnDestroy) then vfGMCheckRefCountOnDestroy(RefCount, Self);
end;

function TGMRefLifeComponent.CopyCreateClass: TGMRefLifeComponentClass;
begin
  Result := TGMRefLifeComponentClass(ClassType);
end;

procedure TGMRefLifeComponent.OnFinalRelease;
begin
  Free;
end;

{ ---- IGMGetObjInfo ---- }

function TGMRefLifeComponent.GetClassName: TGMString;
begin
  Result := ClassName;
end;

function TGMRefLifeComponent.GetClassType: TClass;
begin
  Result := ClassType;
end;

function TGMRefLifeComponent.GetInstance: TObject;
begin
  Result := Self;
end;

function TGMRefLifeComponent.GetTypeInfo: PTypeInfo;
begin
  Result := ClassInfo;
end;

{ ---- IGMGetName ---- }

function TGMRefLifeComponent.GetName: TGMString;
begin
  Result := Name;
end;

{ ---- IGMAssignByObj ---- }

procedure TGMRefLifeComponent.AssignFromObj(const ASource: TObject);
begin
  if ASource is TPersistent then Assign(TPersistent(ASource));
end;

procedure TGMRefLifeComponent.AssignToObj(const ADest: TObject);
begin
  if ADest is TPersistent then TPersistent(ADest).Assign(Self);
end;

{ ---- IGMCreateCopyQI ---- }

function TGMRefLifeComponent.CreateCopyQI(const AIID: TGUID; out AIntf): HResult;
var PIUnknown: IUnknown; PIAssign: IGMAssignFromObj;
begin
  PIUnknown := CopyCreateClass.CreateIntf;
  Result := PIUnknown.QueryInterface(AIID, AIntf);
  if (Result = S_OK) and (PIUnknown.QueryInterface(IGMAssignFromObj, PIAssign) = S_OK) then PIAssign.AssignFromObj(Self);
end;

{ ---- IUnknown ---- }

function TGMRefLifeComponent.QueryInterface(const AIID: TGUID; out AIntf): HResult;
begin
  if GetInterface(AIID, AIntf) then Result := S_OK else Result := E_NOINTERFACE;
  //GMTraceQueryInterface(Self, AIID, Result);
end;

function TGMRefLifeComponent._AddRef: LongInt;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TGMRefLifeComponent._Release: LongInt;
begin
  Result := InterlockedDecrement(FRefCount);
  if (Result = 0) and RefLifeTime and FConstructed then OnFinalRelease;
end;
{$ENDIF}


end.