{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   GM-Software                                               | }
{ |   ===========                                               | }
{ |                                                             | }
{ |   Project: DB Projects                                      | }
{ |                                                             | }
{ |   Description: Base Database functionality not dependend    | }
{ |                on BorlandDB Units, not even on classes.     | }
{ |                                                             | }
{ |   Copyright (C) - 2001 - Gerrit Moeller.                    | }
{ |                                                             | }
{ |   Source code distributed under MIT license.                | }
{ |                                                             | }
{ |   See: https://www.gm-software.de                           | }
{ |                                                             | }
{ +-------------------------------------------------------------+ }

{$INCLUDE GMCompilerSettings.inc}

unit GMSql;

interface

uses {$IFNDEF JEDIAPI}Windows,{$ELSE}jwaWinType,{$ENDIF}
     GMStrDef, GMCommon, GMIntf, GMCollections, GMUnionValue, GMActiveX, GMPrsStg, SysUtils;

type

  TExploreConnectionFlag = (efDoExecute, efShowSchema);
  TExploreConnectionFlags = set of TExploreConnectionFlag;

  TGMSqlStatementKind = (skUnknown, skSelect, skExecute, skInsert, skUpdate, skDelete, skDDL, skSetting);

  TGMSchemaList = (slTables, slProcedures, slColumns, slProcedureColumns, slStatistics, slPrimaryKeys, slForeignKeys,
                   slTablePrivileges, slColumnPrivileges, slTypeInfo, slUnknown);

  //TGMSchemaRootList = slTables .. slStatistics;
  //TGMSchemaRootLists = set of TGMSchemaRootList;
  TGMSchemaLists = set of TGMSchemaList;

  TGMDBColumnDataType = (fdtUnknown, fdtBoolean, fdtInt8, fdtUInt8, fdtInt16, fdtUInt16, fdtInt32, fdtUInt32, fdtInt64, fdtUInt64,
                         fdtSingle, fdtDouble, fdtNumeric, fdtDate, fdtTime, fdtDateTime, fdtAnsiString,
                         fdtUnicodeString, fdtAnsiText, fdtUnicodeText, fdtBinary, fdtGUID);

  TGMAllowNullValues = (nvNullValuesNotAllowed, nvNullValuesAllowed, nvNullableUnknown);


const

  cSqlWhiteSpace                 = cWhiteSpace;
  cSqlOperators                  = '=<>!*+-/';
  cSqlSeparators                 = ',;()' + cSqlWhiteSpace;
  cSqlParamPrefixChar            = ':';
  cCnStrEntrySep                 = ';';
  cCnStrValSep                   = '=';

  cSqlFrom                       = 'FROM';
  cSqlLeft                       = 'LEFT';
  cSqlRight                      = 'RIGHT';
  cSqlInner                      = 'INNER';
  cSqlOuter                      = 'OUTER';
  cSqlJoin                       = 'JOIN';
  cSqlOn                         = 'ON';
  cSqlWhere                      = 'WHERE';
  cSqlGroupBy                    = 'GROUP BY';
  cSqlHaving                     = 'HAVING';
  cSqlOrderBy                    = 'ORDER BY';
  cSqlParameters                 = 'PARAMETERS';
  cSqlForUpdateOf                = 'FOR UPDATE OF';
  cSqlSet                        = 'SET';
  cSqlInto                       = 'INTO';
  cSqlValues                     = 'VALUES';

  cSqlSelect                     = 'SELECT';
  cSqlInsert                     = 'INSERT';
  cSqlUpdate                     = 'UPDATE';
  cSqlDelete                     = 'DELETE';
  cSqlExecute                    = 'EXECUTE';
  cSqlCreate                     = 'CREATE';
  cSqlAlter                      = 'ALTER';
  cSqlDrop                       = 'DROP';

  cSqlAsc                        = 'ASC';
  cSqlDesc                       = 'DESC';
  cSqlAscending                  = 'ASCENDING';
  cSqlDescending                 = 'DESCENDING';

  cStrAnd                        = 'AND';
  cStrOr                         = 'OR';
  cStrEqual                      = '=';

  cSqlWildcardChar               = '%';
  CAccessWildcardChar            = '*';

  cSqlStrQuoteChar               = '''';
  cAccessDateQuoteChar           = '#';

//CFieldNameLeftQuote            = '[';
//CFieldNameRightQuote           = ']';
//CFieldNameQuotes               = CFieldNameLeftQuote + CFieldNameRightQuote;
  cSQLStmtTerm                   = ';';
  cFieldListSeparators           = ',;';
  cSqlParamMarker                = '?';
  cSqlQualSep                    = '.';
  cSqlPartSep                    = cNewLine;

  cSqlCountAll                   = 'Count(*)';

  cSqlIdQuoteCh                  = '"';

  cSqlSelectAllFmt               = cSqlSelect + ' * ' + cSqlFrom + ' %s';
  cSqlSelectCountFmt             = cSqlSelect + ' ' + cSqlCountAll + ' ' + cSqlFrom + ' %s';

//cSqlAggregatFunctions: array [0..4] of TGMString = ('min', 'max', 'avg', 'count', 'sum');

  cStrTGMRecordsetState          = 'TGMRecordsetState';

  cDfltFieldDisplayWidth         = 50;
  cMaxFieldDisplayWidth          = 180;
  cMinFieldDisplayWidth          = 20;
  CUnknownFieldDisplayWidth      = -1;

  cInvalidColumnPos              = -1;

  cDfltReExecutionDelay          = 300;
  cAvgCharWidth                  = 10;

  CBookmarkColPos                = 0;

  cDfltReExecAfterParamValChange = True;
  cDfltReExecuteAfterSQLChange = False;
  cDfltTreeNotify = True;
  cDfltAutoActivate = True;

  cDfltColumnSeparator = ';'; // #9;
  cDfltRowSeparator = #13#10;

  cStrCnStrDriver = 'DRIVER';
  cStrCnStrDSN = 'DSN';
  cStrCnStrUserName = 'UID';
  cStrCnStrPassword = 'PWD';
  cStrCnStrDatabase = 'DATABASE';
  cStrCnStrFileDSN = 'FILEDSN';
  cStrCnStrDBQ = 'DBQ';
  cStrCnStrSaveFile = 'SAVEFILE';
  cStrCnDir = 'DIR';
  cStrCnDefaultDir = 'DEFAULTDIR';

  cStrTableKindTable = 'TABLE';
  cStrNil = '<nil>';

  cDfltSchemaList = slTables;
  //cDfltSchemaLists = [slTables];

  cReExecuteAfterPropertyValueChange = True;

  cDfltExploreConnectionFlags = [efShowSchema];

  cIntegerFieldDataTypes: set of TGMDBColumnDataType = [fdtInt8, fdtUInt8, fdtInt16, fdtUInt16, fdtInt32, fdtUInt32, fdtInt64, fdtUInt64];
  cSignedIntFieldDataTypes: set of TGMDBColumnDataType = [fdtInt8, fdtInt16, fdtInt32, fdtInt64];
  cStreamedFieldDataTypes: set of TGMDBColumnDataType = [fdtAnsiText, fdtUnicodeText, fdtBinary];
  cMemoFieldDataTypes: set of TGMDBColumnDataType = [fdtAnsiText, fdtUnicodeText];
  cStringFieldDataTypes: set of TGMDBColumnDataType = [fdtAnsiString, fdtUnicodeString];
  cQuotedFieldDataTypes: set of TGMDBColumnDataType = [fdtAnsiText, fdtUnicodeText, fdtAnsiString, fdtUnicodeString];
  cDateTimeDataTypes: set of TGMDBColumnDataType = [fdtDate, fdtTime, fdtDateTime];
  cVariableLengthDataTypes: set of TGMDBColumnDataType = [fdtAnsiString, fdtUnicodeString, fdtAnsiText, fdtUnicodeText, fdtBinary];

  //cStrSelectedPositions = 'SelectedPositions';
  cStrSQL = 'SQL'; // <- used for SQL property of TGMSqlStatementBase 
  

type

  TAccessMode = (amReadWrite, amReadOnly);
  TGMCursorType = (ctUnidirectional, ctStatic, ctKeyset, ctDynamic);
  TGMRecordsetState = (rsInactive, rsBrowsing, rsInserting, rsEditing);
  TGMRecordsetOperation = roEdit .. roSetSimplestConfiguration;

  TGMRecordsetAttribute = (raAutoSaveChanges, raAutoEdit, raConfrimDeletions, raExposeBookmarkColumn, raBookmarksEnabled, raStripTrailingBlanks);
  TGMRecordsetAttributes = set of TGMRecordsetAttribute;

  TConnectionStrCompareKind = (cnpExactMatch, cnpLazyMatch);

  TValueArray = array of RGMUnionValue;


  RGMFieldCreateData = record
   Name: TGMString;
   Position: PtrInt;
   DataType: TGMDBColumnDataType;
   AllowNullValues: TGMAllowNullValues;
   Updatable: Boolean;
   IsSigned: Boolean;
   IsAutoincrementing: Boolean;
// BlobCompressionType: Integer; // TGMCompressionType;
   SizeInBytes: PtrInt; // <- must match datatype of ODBC functions!
   MaxStrLength: PtrUInt; // <- must match datatype of ODBC functions!
  end;

  TGMSqlStmtVisitFunc = function(const ASqlStatement: TGMString; const AOpaqueAppData: Pointer = nil): Boolean of object;


  IGMGetMasterSource = interface(IUnknown)
    ['{C70F6863-3F6D-4371-BFD7-29F73401C989}']
    function GetMasterSource: IUnknown;
    property MasterSource: IUnknown read GetMasterSource;
  end;


  IGMGetSetMasterSource = interface(IGMGetMasterSource)
    ['{34F5D167-51E2-4F08-9B8D-ACCEC6262AA6}']
    procedure SetMasterSource(const AValue: IUnknown);
    property MasterSource: IUnknown read GetMasterSource write SetMasterSource;
  end;


  IGMSqlSyntaxElements = interface(IUnknown)
    ['{89C93C0F-A433-4818-95D5-C54A95585833}']
    function SqlIdentifierQuoteChar: TGMString;
    function SqlDateTimeFormatStr: TGMString;
  end;


  PGMQualifiedDBName = ^RGMQualifiedDBName;
  RGMQualifiedDBName = record
   CatalogName: TGMString;
   SchemaName: TGMString;
   TableName: TGMString;
   function QualifiedName(const ASeparator: TGMString = '.'): TGMString;
   function CompareTo(const AOtherQName: RGMQualifiedDBName): TGMCompareResult;
  end;

  TGMQualifiedDBNameArray = Array of RGMQualifiedDBName;

  function GMInitRQualifiedDBName(const AElementName: TGMString; const ACatalogName: TGMString = ''; const ASchemaName: TGMString = ''): RGMQualifiedDBName;
  function GMBuildQualifiedDBName(const AElementName: TGMString; const ACatalogName: TGMString = ''; const ASchemaName: TGMString = ''; const ASeparator: TGMString = '.'): TGMString;
  function GMCompareQualifiedDBName(const AQNameA, AQNameB: RGMQualifiedDBName): TGMCompareResult;
  function GMSplitSqlQualifiedName(const AQualifiedName: TGMString; const ASeparatorChar: TGMChar = '.'): RGMQualifiedDBName;


  { -------------------- }
  { ---- Recordsets ---- }
  { -------------------- }

  type

  IGMGetFieldName = interface(IUnknown)
    ['{A4650FA2-2522-11d5-AB38-000021DCAD19}']
    function GetFieldName: TGMString;
    property FieldName: TGMString read GetFieldName;
  end;

  IGMGetSetFieldName = interface(IGMGetFieldName)
    ['{E9FB6119-3353-4e77-A555-DB4F4DB8838A}']
    procedure SetFieldName(const Value: TGMString);
    property FieldName: TGMString read GetFieldName write SetFieldName;
  end;


  IGMGetValueDefinition = interface(IUnknown)
    ['{37239761-153F-11d5-A5E4-00E0987755DD}']
    function GetDataType: TGMDBColumnDataType; stdcall;
    function GetNullValuesAllowed: TGMAllowNullValues; stdcall;
    function GetUpdatable: Boolean; stdcall;
    property DataType: TGMDBColumnDataType read GetDataType;
    property NullValuesAllowed: TGMAllowNullValues read GetNullValuesAllowed;
    property Updatable: Boolean read GetUpdatable;
  end;


  TGMEnumItemKind = (eidTableNames, eidFieldNames, eidKeyFieldNames);


  IGMNamedValueChange = interface(IUnknown)
    ['{40B69A62-2819-11d5-AB38-000021DCAD19}']
    procedure AfterValueChange(const ValueName: TGMString);
  end;


  IGMCascadedContentsProperties = interface(IUnknown)
    ['{56975886-A8AA-452b-A7C6-4C3AA4AE9C32}']
    function GetKeyValueName: TGMString; stdcall;
    function GetParentReferenceValueName: TGMString; stdcall;
    function ConfigurationIsValid: Boolean; stdcall;
    property KeyValueName: TGMString read GetKeyValueName;
    property ParentReferenceValueName: TGMString read GetParentReferenceValueName;
  end;


  TGMSortOrderDirection = (soNone, soAscending, soDescending);
  TGMAllowDuplicates = (adUnknown, adDuplicatesAllowed, adDuplicatesNotAllowed);

  IGMGetColumnSortOrder = interface(IUnknown)
    ['{A975D209-850C-4d39-A030-3C0D8A7CF6E7}']
    function GetColumnSortOrder(const ColumnName: TGMString): LongInt; stdcall;
  end;

  IGMSetColumnSortOrder = interface(IUnknown)
    ['{5020ABAB-9EB1-4fd0-8CD5-27A73754F0FA}']
    procedure SetColumnSortOrder(const ColumnName: TGMString; const SortOrder: LongInt; const Cumulative, ReExecuteWhenChanged: Boolean); stdcall;
  end;

  IGMGetSortColumnName = interface(IUnknown)
    ['{B3F7B46B-C6E7-47c5-B8E1-64309331CC0C}']
    function GetSortColumnName(var ColumnName: TGMString): Boolean; stdcall;
  end;


  { ---------------------- }
  { ---- Transactions ---- }
  { ---------------------- }

  IGMTransactions = interface(IUnknown)
    ['{BD7DDC1B-2F93-4294-8E34-669A17342685}']
    function GetTransactionLevel: LongInt; stdcall;
    procedure BeginTransaction; stdcall;
    procedure CommitTransaction; stdcall;
    procedure RollbackTransaction; stdcall;
    property TransactionLevel: LongInt read GetTransactionLevel;
  end;



  TGMSqlParameter = class(TGMRefCountedObj, IGMGetName, IGMGetUnionValue, IGMGetSetUnionValue)
   protected
    FOwner: TObject;
    FName: TGMString;
    FValue: RGMUnionValue;
    FIsLiteral: Boolean;

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

    // ---- IGMGetSetUnionValue ----
    function GetUnionValue: RGMUnionValue; virtual;
    procedure SetUnionValue(const AUnionValue: RGMUnionValue); virtual;

   public
    constructor Create(const AOwner: TObject; const AName: TGMString; const AValue: RGMUnionValue; const AIsLiteral: Boolean); reintroduce;
    procedure AssignValue(const AValue: RGMUnionValue; const AIsLiteral: Boolean); virtual;

    property Owner: TObject read FOwner;

    property Name: TGMString read GetName;
    property Value: RGMUnionValue read GetUnionValue write SetUnionValue;
    property IsLiteral: Boolean read FIsLiteral write FIsLiteral;
  end;


  TGMSqlParameterList = class(TGMRefCountedObj, IGMGetCount, IGMGetIntfByName, IGMGetIntfByPosition, IGMAssignFromObj)
   protected
    FOwner: TObject;
    FReExecuteAfterParamValueChange: Boolean;
    FParameterList: IGMObjArrayCollection;

    function GetParameter(const AIndex: RGMUnionValue): TGMSqlParameter;
    //procedure SetParameter(const Idx: RGMUnionValue; const Value: TGMSqlParameter);

    // ---- IGMGetCount ----
    function GetCount: PtrInt; virtual; stdcall;

    // ---- IGMGetIntfByName ----
    function GetIntfByName(const Name: TGMString; const IID: TGUID; out Intf): HResult; stdcall;

    // ---- IGMGetIntfByPosition ----
    function GetIntfByPosition(const Position: PtrInt; const IID: TGUID; out Intf): HResult; stdcall;

   public
    constructor Create(const AOwner: TObject); reintroduce;
    //destructor Destroy; override;

    procedure AssignFromObj(const Source: TObject); stdcall;
    procedure AssignParamValues(const Source: TObject); virtual;
    procedure ParseForParameters; virtual;
    procedure OnParameterValueChanged; virtual;

    function FindParameterByName(const ParameterName: TGMString; var Parameter: TGMSqlParameter): Boolean;

    property Count: PtrInt read GetCount;
    property Owner: TObject read FOwner;
    property ParameterList: IGMObjArrayCollection read FParameterList;
    property Parameters[const Idx: RGMUnionValue]: TGMSqlParameter read GetParameter; default;//write SetParameter;

   //published
    property ReExecuteAfterParamValueChange: Boolean read FReExecuteAfterParamValueChange write FReExecuteAfterParamValueChange default cDfltReExecAfterParamValChange;
  end;


  TDoParseSQLXxxxPropFunc = function: Boolean of object;


  IGMGetTableName = interface(IUnknown)
    ['{A8689741-25B6-11d5-AB38-000021DCAD19}']
    function GetTablename: TGMString;
    property Tablename: TGMString read GetTablename;
  end;


  IGMGetSetTableName = interface(IGMGetTableName)
    ['{A8689742-25B6-11d5-AB38-000021DCAD19}']
    procedure SetTablename(Value: TGMString);
    property Tablename: TGMString read GetTablename write SetTablename;
  end;


  IGMSQLChangeNotifications = interface(IUnknown)
    ['{139A2141-26B2-11d5-AB38-000021DCAD19}']
    procedure AfterSQLChange;
  end;


  IGMExecuteSQL = interface(IUnknown)
    ['{4C1C3F7F-975C-4508-96DA-3AB1417D955E}']
    function ExecuteSQL(const ASQL: TGMString): PtrInt;
  end;


  IGMSqlStatementParts = interface(IUnknown)
    ['{94564601-0E67-11d5-A5E4-00E0987755DD}']
    //
    // Partitions of a SQL Statement.
    //
    // The class TGMSQLStatmentPartitioner in unit GMDBBase offers a nice
    // implementation of this interface. It is capable to be used as aggregate
    // via compiler implements fetaure by another object.
    //
    function GetTableName: TGMString; virtual;
    procedure SetTableName(Value: TGMString); virtual;
    function GetSQLSelectedFields: TGMString; virtual;
    procedure SetSQLSelectedFields(Value: TGMString); virtual;
    function GetSQLWhere: TGMString; virtual;
    procedure SetSQLWhere(Value: TGMString); virtual;
    function GetSQLGroupBy: TGMString; virtual;
    procedure SetSQLGroupBy(Value: TGMString); virtual;
    function GetSQLHaving: TGMString; virtual;
    procedure SetSQLHaving(Value: TGMString); virtual;
    function GetSQLOrderBy: TGMString; virtual;
    procedure SetSQLOrderBy(Value: TGMString); virtual;
    function GetSQLForUpdateOf: TGMString; virtual;
    procedure SetSQLForUpdateOf(Value: TGMString); virtual;

    property SQLTableName: TGMString read GetTableName write SetTableName;
    property SQLSelectedFields: TGMString read GetSQLSelectedFields write SetSQLSelectedFields;
    property SQLWhere: TGMString read GetSQLWhere write SetSQLWhere;
    property SQLGroupBy: TGMString read GetSQLGroupBy write SetSQLGroupBy;
    property SQLHaving: TGMString read GetSQLHaving write SetSQLHaving;
    property SQLOrderBy: TGMString read GetSQLOrderBy write SetSQLOrderBy;
    property SQLForUpdateOf: TGMString read GetSQLForUpdateOf write SetSQLForUpdateOf;
  end;


  TGMSQLStatmentPartitioner = class(TGMAggregatableObj, IGMGetText,
                                                        IGMGetSetText,
                                                        IGMGetTableName,
                                                        IGMGetSetTableName,
                                                        IGMSqlStatementParts)
   protected
    FGetSQLText: TGMGetStringFunc;
    FSetSQLText: TGMSetStringProc;
    FParseSQLXxxxPropFunc: TDoParseSQLXxxxPropFunc;

    function GetText: TGMString; virtual; stdcall;
    procedure SetText(const Value: TGMString); virtual; stdcall;
    function GetTableName: TGMString; virtual;
    procedure SetTableName(Value: TGMString); virtual;
    function GetSQLSelectedFields: TGMString; virtual;
    procedure SetSQLSelectedFields(Value: TGMString); virtual;
    function GetSQLWhere: TGMString; virtual;
    procedure SetSQLWhere(Value: TGMString); virtual;
    function GetSQLGroupBy: TGMString; virtual;
    procedure SetSQLGroupBy(Value: TGMString); virtual;
    function GetSQLHaving: TGMString; virtual;
    procedure SetSQLHaving(Value: TGMString); virtual;
    function GetSQLOrderBy: TGMString; virtual;
    procedure SetSQLOrderBy(Value: TGMString); virtual;
    function GetSQLForUpdateOf: TGMString; virtual;
    procedure SetSQLForUpdateOf(Value: TGMString); virtual;

    function ParseForSQLXxxxProperties: Boolean;

   public
    constructor Create(const AOwner: IUnknown;
                       const AGetSQLText: TGMGetStringFunc;
                       const ASetSQLText: TGMSetStringProc;
                       const ADoParseSQLXxxxPropFunc: TDoParseSQLXxxxPropFunc = nil;
                       const ARefLifeTime: Boolean = False); reintroduce;

    property SQLTableName: TGMString read GetTableName write SetTableName;
    property SQLSelectedFields: TGMString read GetSQLSelectedFields write SetSQLSelectedFields;
    property SQLWhere: TGMString read GetSQLWhere write SetSQLWhere;
    property SQLGroupBy: TGMString read GetSQLGroupBy write SetSQLGroupBy;
    property SQLHaving: TGMString read GetSQLHaving write SetSQLHaving;
    property SQLOrderBy: TGMString read GetSQLOrderBy write SetSQLOrderBy;
    property SQLForUpdateOf: TGMString read GetSQLForUpdateOf write SetSQLForUpdateOf;
    //function TerminateSQL(const SQLText: TGMString): TGMString; virtual;
    //property SQLStrings: TGMStringArray read FSQLStrings; //write SetSQLStrings;
  end;


  TGMSqlProperty = class(TGMRefCountedObj, IGMGetTableName,
                                           IGMGetSetTableName,
                                           IGMSqlStatementParts,
                                           IGMGetText,
                                           IGMGetSetText,
                                           IGMEnumerateItems,
                                           IGMAssignFromObj)
   protected
    FOwner: TObject;
    FSQLText: TGMString;
    FSQLParser: TGMSQLStatmentPartitioner;
    FParameterList: TGMSqlParameterList;
    FOnAfterSQLChange: TGMObjNotifyProc;
    FReExecuteAfterSQLChange: Boolean;

    procedure SetParameterList(const AValue: TGMSqlParameterList);

    function GetSQLText: TGMString; virtual;
    procedure SetSQLText(const AValue: TGMString); virtual;

    // Published IDE property Get/Set routines cannot be stdcall!
    function IDEGetTableName: TGMString; virtual;
    procedure IDESetTableName(Value: TGMString); virtual;
    function IDEGetSQLSelectedFields: TGMString; virtual;
    procedure IDESetSQLSelectedFields(Value: TGMString); virtual;
    function IDEGetSQLWhere: TGMString; virtual;
    procedure IDESetSQLWhere(Value: TGMString); virtual;
    function IDEGetSQLGroupBy: TGMString; virtual;
    procedure IDESetSQLGroupBy(Value: TGMString); virtual;
    function IDEGetSQLHaving: TGMString; virtual;
    procedure IDESetSQLHaving(Value: TGMString); virtual;
    function IDEGetSQLOrderBy: TGMString; virtual;
    procedure IDESetSQLOrderBy(Value: TGMString); virtual;
    function IDEGetSQLForUpdateOf: TGMString; virtual;
    procedure IDESetSQLForUpdateOf(Value: TGMString); virtual;

    { ---- IGMEnumerateTableNames ---- }
    procedure EnumerateItems(const ItemKind: LongInt; const TellEnumSink: IUnknown; const Parameter: Pointer = nil); virtual; stdcall;

    procedure SQLChanged(const ASender: TObject); virtual;

   public
    constructor Create(const AOwner: TObject; const ASqlText: TGMString; const AParseSQLXxxxPropFunc: TDoParseSQLXxxxPropFunc = nil; const ARefLifeTime: Boolean = False); reintroduce;
    destructor Destroy; override;

    procedure AssignFromObj(const ASource: TObject); stdcall;
    function BuildResolvedSQLText: TGMString; virtual;

    property Owner: TObject read FOwner;
    property SQLParser: TGMSQLStatmentPartitioner read FSQLParser implements IGMSqlStatementParts, IGMGetTableName, IGMGetSetTableName, IGMGetText, IGMGetSetText;
    property OnAfterSQLChange: TGMObjNotifyProc read FOnAfterSQLChange write FOnAfterSQLChange;

   //published
    property SQLText: TGMString read GetSQLText write SetSQLText;
    property SQLSelectedFields: TGMString read IDEGetSQLSelectedFields write IDESetSQLSelectedFields;
    property SQLWhere: TGMString read IDEGetSQLWhere write IDESetSQLWhere stored False;
    property SQLGroupBy: TGMString read IDEGetSQLGroupBy write IDESetSQLGroupBy stored False;
    property SQLHaving: TGMString read IDEGetSQLHaving write IDESetSQLHaving stored False;
    property SQLOrderBy: TGMString read IDEGetSQLOrderBy write IDESetSQLOrderBy stored False;
    property SQLForUpdateOf: TGMString read IDEGetSQLForUpdateOf write IDESetSQLForUpdateOf stored False;
    property TableName: TGMString read IDEGetTableName write IDESetTableName stored False;
    property SQLParameter: TGMSqlParameterList read FParameterList write SetParameterList;
    property ReExecuteAfterSQLChange: Boolean read FReExecuteAfterSQLChange write FReExecuteAfterSQLChange default cDfltReExecuteAfterSQLChange;
  end;


  TGMCascadedContentsProperties = class(TGMRefCountedObj, IGMCascadedContentsProperties, IGMEnumerateItems, IGMAssignFromObj)
   protected
    FOwner: TObject;
    FKeyValueName: TGMString;
    FParentReferenceValueName: TGMString;

    { ---- IGMEnumerateItems ---- }
    procedure EnumerateItems(const ItemKind: LongInt; const TellEnumSink: IUnknown; const Parameter: Pointer = nil); stdcall;

    { ---- IGMCascadedContentsProperties ---- }
    function GetKeyValueName: TGMString; virtual; stdcall;
    function GetParentReferenceValueName: TGMString; virtual; stdcall;

   public
    constructor Create(const AOwner: TObject); reintroduce; virtual;

    procedure AssignFromObj(const Source: TObject); stdcall;
    function ConfigurationIsValid: Boolean; virtual; stdcall;

    property Owner: TObject read FOwner;

   //published
    property KeyValueName: TGMString read FKeyValueName write FKeyValueName;
    property ParentReferenceValueName: TGMString read FParentReferenceValueName write FParentReferenceValueName;
  end;


  TConnectionStringValue = class(TGMNameAndStrValueObj, IGMLoadStoreData)
   public
    procedure LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); stdcall;
    procedure StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); stdcall;
  end;


  TGMConnectionStringStorage = class;

  IGMConnectionStringStorage = interface(IUnknown)
    ['{6419C74F-E585-4C36-BF66-EB9BB18314A7}']
    function Obj: TGMConnectionStringStorage;
  end;

  TGMConnectionStringStorage = class(TGMRefCountedObj, IGMValueStorage, IGMGetText, IGMContainsValue, IGMLoadStoreData, IGMConnectionStringStorage)
   protected
    FValues: IGMIntfArrayCollection;
    FValueStorage: TGMValueStorageImpl;

    function GetValueByName(const AValueName: TGMString; const ADefaultValue: TGMString = ''): TGMString; stdcall;
    procedure SetValueByName(const AValueName, AValue: TGMString); stdcall;

   public
    constructor Create(const ARefLifeTime: Boolean = True); overload; override;
    constructor Create(const AConnectionString: TGMString; const ARefLifeTime: Boolean = True); reintroduce; overload;
    destructor Destroy; override;
    function Obj: TGMConnectionStringStorage;

    procedure ParseConnectionString(const AConnectionString: TGMString); virtual;

    function ContainsValue(const ValueName: TGMString): Boolean; virtual; stdcall;
    function GetText: TGMString; virtual; stdcall;

    procedure LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); virtual; stdcall;
    procedure StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); virtual; stdcall;

    property Values: IGMIntfArrayCollection read FValues;
    property ValueStorage: TGMValueStorageImpl read FValueStorage implements IGMValueStorage;
    property Text: TGMString read GetText;
  end;


  IGMSchemaProperties = interface(IUnknown)
    ['{66ECFFC2-4F49-4542-A56E-C5B081DBA9EB}']
    //procedure Reset;
    procedure SetAll(ASchemaList: TGMSchemaList = cDfltSchemaList;
                     ACatalogName: TGMString = cStrNil;
                     ASchemaName: TGMString = cStrNil;
                     ATableName: TGMString = cSqlWildcardChar;
                     ATableKind: TGMString = cStrNil; // ''; // cStrTableKindTable;
                     AColumnName: TGMString = cSqlWildcardChar;
                     AForeignCatalogName: TGMString = cStrNil;
                     AForeignSchemaName: TGMString = cStrNil;
                     AForeignTableName: TGMString = cSqlWildcardChar);

    function GetSchemaList: TGMSchemaList;
    function GetCatalogName: TGMString;
    function GetSchemaName: TGMString;
    function GetTableName: TGMString;
    function GetColumnName: TGMString;
    function GetTableKind: TGMString;
    function GetForeignCatalogName: TGMString;
    function GetForeignSchemaName: TGMString;
    function GetForeignTableName: TGMString;

    procedure SetSchemaList(const AValue: TGMSchemaList);
    procedure SetCatalogName(const AValue: TGMString);
    procedure SetSchemaName(const AValue: TGMString);
    procedure SetTableName(const AValue: TGMString);
    procedure SetColumnName(const AValue: TGMString);
    procedure SetTableKind(const AValue: TGMString);
    procedure SetForeignCatalogName(const AValue: TGMString);
    procedure SetForeignSchemaName(const AValue: TGMString);
    procedure SetForeignTableName(const AValue: TGMString);

    property SchemaList: TGMSchemaList read GetSchemaList write SetSchemaList default cDfltSchemaList;
    property CatalogName: TGMString read GetCatalogName write SetCatalogName;
    property SchemaName: TGMString read GetSchemaName write SetSchemaName;
    property TableName: TGMString read GetTableName write SetTableName;
    property ColumnName: TGMString read GetColumnName write SetColumnName;
    property TableKind: TGMString read GetTableKind write SetTableKind;
    property ForeignCatalogName: TGMString read GetForeignCatalogName write SetForeignCatalogName;
    property ForeignSchemaName: TGMString read GetForeignSchemaName write SetForeignSchemaName;
    property ForeignTableName: TGMString read GetForeignTableName write SetForeignTableName;
  end;


  TGMSchemaProperties = class(TGMAggregatableObj, IGMSchemaProperties, IGMAssignFromObj, IGMGetText)
   protected
    FSchemaList: TGMSchemaList;
    FCatalogName: TGMString;
    FSchemaName: TGMString;
    FTableName: TGMString;
    FColumnName: TGMString;
    FForeignCatalogName: TGMString;
    FForeignSchemaName: TGMString;
    FForeignTableName: TGMString;
    FTableKind: TGMString;

    FReExecuteAfterPropertyValueChange: Boolean;

    FOnAfterSchemaDataChange: TGMObjNotifyProc;

    procedure AfterPropertyValueChange; virtual;

   public
    constructor Create(const ARefLifeTime: Boolean = False); override; overload;
    function GetText: TGMString; virtual; stdcall;
    procedure AssignFromObj(const Source: TObject); stdcall;

    //procedure Reset;
    procedure SetAll(ASchemaList: TGMSchemaList = cDfltSchemaList;
                     ACatalogName: TGMString = cStrNil;
                     ASchemaName: TGMString = cStrNil;
                     ATableName: TGMString = cSqlWildcardChar;
                     ATableKind: TGMString = cStrNil; // ''; // cStrTableKindTable;
                     AColumnName: TGMString = cSqlWildcardChar;
                     AForeignCatalogName: TGMString = cStrNil;
                     AForeignSchemaName: TGMString = cStrNil;
                     AForeignTableName: TGMString = cSqlWildcardChar);

    function GetSchemaList: TGMSchemaList;
    function GetCatalogName: TGMString;
    function GetSchemaName: TGMString;
    function GetTableName: TGMString;
    function GetColumnName: TGMString;
    function GetTableKind: TGMString;
    function GetForeignCatalogName: TGMString;
    function GetForeignSchemaName: TGMString;
    function GetForeignTableName: TGMString;

    procedure SetSchemaList(const AValue: TGMSchemaList);
    procedure SetCatalogName(const AValue: TGMString);
    procedure SetSchemaName(const AValue: TGMString);
    procedure SetTableName(const AValue: TGMString);
    procedure SetColumnName(const AValue: TGMString);
    procedure SetTableKind(const AValue: TGMString);
    procedure SetForeignCatalogName(const AValue: TGMString);
    procedure SetForeignSchemaName(const AValue: TGMString);
    procedure SetForeignTableName(const AValue: TGMString);

    //property Owner: TObject read FOwner;
    property SchemaList: TGMSchemaList read GetSchemaList write SetSchemaList default cDfltSchemaList;
    property CatalogName: TGMString read GetCatalogName write SetCatalogName;
    property SchemaName: TGMString read GetSchemaName write SetSchemaName;
    property TableName: TGMString read GetTableName write SetTableName;
    property ColumnName: TGMString read GetColumnName write SetColumnName;
    property TableKind: TGMString read GetTableKind write SetTableKind;
    property ForeignCatalogName: TGMString read GetForeignCatalogName write SetForeignCatalogName;
    property ForeignSchemaName: TGMString read GetForeignSchemaName write SetForeignSchemaName;
    property ForeignTableName: TGMString read GetForeignTableName write SetForeignTableName;

    property ReExecuteAfterPropertyValueChange: Boolean read FReExecuteAfterPropertyValueChange write FReExecuteAfterPropertyValueChange default cReExecuteAfterPropertyValueChange;
    property OnAfterSchemaDataChange: TGMObjNotifyProc read FOnAfterSchemaDataChange write FOnAfterSchemaDataChange;
  end;


  //TGMObjectProc = procedure of object;
  TGMOperationNotifyEvent = procedure (const Operation: LongInt; const Parameter: IUnknown = nil) of object;
  TGMFieldValueChangeNotifyEvent = procedure (Sender: IUnknown; const FieldName: TGMString) of object;
  TGMFieldNameChangeNotifyEvent = procedure (Sender: IUnknown; const OldFieldName, NewFieldName: TGMString) of object;

  TGMRecordsetIntfSource = class(TGMActivatableIntfSource, IGMPositionChangeNotifications,
                                                           IGMOperationNotifications,
                                                           IGMNamedValueChange,
                                                           IGMSQLChangeNotifications,
                                                           IGMValidateValues,
                                                           IGMEnumerateItems
                                                           {$IFDEF FPC},IGMGetInterfaceSource,
                                                           IGMGetSetInterfaceSource{$ENDIF})
   protected
    FOnBeforePositionChange: TGMObjectProc;
    FOnAfterPositionChange: TGMObjectProc;
    FOnBeforeOperation: TGMOperationNotifyEvent;
    FOnAfterOperation: TGMOperationNotifyEvent;
    FOnAfterFieldValueChange: TGMFieldValueChangeNotifyEvent;
    FOnAfterSQLChange: TGMObjectProc;
    FOnValidateFieldValues: TGMObjectProc;

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

    function FieldCanModify(const FieldName: TGMString): Boolean;
    function GetIntfByName(const FieldName: TGMString; const IID: TGUID; out Intf): HResult;
    function GetIntfByPosition(const Position: LongInt; const IID: TGUID; out Intf): HResult;
    //function DesignTimeDisplayText: TGMString; virtual;
    function SourceState: LongInt; override;
    function CanEdit: Boolean; virtual;
    function Edit: Boolean; virtual;

    // ---- IGMEnumerateItems ----
    procedure EnumerateItems(const ItemKind: LongInt; const TellEnumSink: IUnknown; const Parameter: Pointer = nil); virtual; stdcall;

    // ---- IGMPositionChangeNotifications ----
    procedure BeforePositionChange; virtual; stdcall;
    procedure AfterPositionChange; virtual; stdcall;

    // ---- IGMOperationNotifications ----
    procedure BeforeOperation(const Operation: LongInt; const Parameter: IUnknown = nil); virtual; stdcall;
    procedure AfterOperation(const Operation: LongInt; const Parameter: IUnknown = nil); virtual; stdcall;

    // ---- IGMNamedValueChange ----
    procedure AfterValueChange(const ValueName: TGMString); virtual;

    // ---- IGMSQLChangeNotification ----
    procedure AfterSQLChange; virtual;

    // ---- IGMValidateValues ---- 
    procedure ValidateValues; virtual;

   //published
    property OnBeforePositionChange: TGMObjectProc read FOnBeforePositionChange write FOnBeforePositionChange;
    property OnAfterPositionChange: TGMObjectProc read FOnAfterPositionChange write FOnAfterPositionChange;
    property OnBeforeOperation: TGMOperationNotifyEvent read FOnBeforeOperation write FOnBeforeOperation;
    property OnAfterOperation: TGMOperationNotifyEvent read FOnAfterOperation write FOnAfterOperation;
    property OnAfterFieldValueChange: TGMFieldValueChangeNotifyEvent read FOnAfterFieldValueChange write FOnAfterFieldValueChange;
    property OnAfterSQLChange: TGMObjectProc read FOnAfterSQLChange write FOnAfterSQLChange;
    property OnValidateFieldValues: TGMObjectProc read FOnValidateFieldValues write FOnValidateFieldValues;
  end;


  TGMRecordsetMasterSource = class(TGMRecordsetIntfSource)
   protected
    FAutoActivate: Boolean;
   public
    constructor Create(const AOwner: TObject; const ANeededInterfaceIDs: array of TGUID);
   //published
    property AutoActivate: Boolean read FAutoActivate write FAutoActivate default cDfltAutoActivate;
  end;


  TGMFieldIntfSource = class(TGMRecordsetIntfSource, IGMGetFieldName, IGMGetSetFieldName
                                                     {$IFDEF FPC},IGMGetInterfaceSource, IGMGetSetInterfaceSource{$ENDIF})
   protected
    FFieldName: TGMString;
    FOnAfterFieldNameChange: TGMFieldNameChangeNotifyEvent;

    // ---- IGMGetSetFieldName ----
    function GetFieldName: TGMString; virtual;
    procedure SetFieldName(const Value: TGMString); virtual;

   public
    //function DesignTimeDisplayText: TGMString; override;
    function FieldCanModify: Boolean; overload;
    function GetFieldIntf(const IID: TGUID; out Intf): HResult; overload;
    function Edit: Boolean; override;

    property FieldName: TGMString read GetFieldName write SetFieldName;
    property OnAfterFieldNameChange: TGMFieldNameChangeNotifyEvent read FOnAfterFieldNameChange write FOnAfterFieldNameChange;
  end;


  TGMLookupIntfSource = class(TGMRecordsetIntfSource)
   protected
    FKeyFieldName: TGMString;
    FDisplayFieldNames: TGMString;
    FDisplaySearchFieldIdx: Integer;
    FDisplayFieldNameList: TGMStringArray;

    procedure SetDisplayFieldNames(const Value: TGMString);
    procedure SetDisplaySearchFieldIdx(const Value: Integer);
    procedure LimitSearchFieldIndex;

   public
    constructor Create(const AOwner: TObject);

    property DisplayFieldNameList: TGMStringArray read FDisplayFieldNameList;

   //published
    property KeyFieldName: TGMString read FKeyFieldName write FKeyFieldName;
    property DisplayFieldNames: TGMString read FDisplayFieldNames write SetDisplayFieldNames;
    property DisplaySearchFieldIdx: Integer read FDisplaySearchFieldIdx write SetDisplaySearchFieldIdx;
  end;


  TGMTreeIntfSource = class(TGMRecordsetIntfSource)
   protected
    FKeyFieldName: TGMString;
    FNodeTitleFieldNames: TGMString;
    FParentFieldName: TGMString;
    FImageIndexFieldName: TGMString;
    FSelectedIndexFieldName: TGMString;
    FStateImageIdxFieldName: TGMString;
    FFixedImageIndex: PtrInt;
    FFixedSelectedImageIndex: PtrInt;
    FNodeTitleFieldNameList: TGMStringArray;

    FOnAfterFieldNameChange: TGMFieldNameChangeNotifyEvent;

    procedure SetKeyFieldName(const Value: TGMString);
    procedure SetNodeTitleFieldNames(const Value: TGMString);
    procedure SetParentFieldName(const Value: TGMString);
    procedure SetImageIndexFieldName(const Value: TGMString);
    procedure SetSelectedIndexFieldName(const Value: TGMString);
    procedure SetStateImageIdxFieldName(const Value: TGMString);

   public
    constructor Create(const AOwner: TObject);

    //function DesignTimeDisplayText: TGMString; override;

    property NodeTitleFieldNameList: TGMStringArray read FNodeTitleFieldNameList;

   //published
    property AlwaysNotify default cDfltTreeNotify;
    property KeyFieldName: TGMString read FKeyFieldName write SetKeyFieldName;
    property NodeTitleFieldNames: TGMString read FNodeTitleFieldNames write SetNodeTitleFieldNames;
    property ParentFieldName: TGMString read FParentFieldName write SetParentFieldName;
    property ImageIndexFieldName: TGMString read FImageIndexFieldName write SetImageIndexFieldName;
    property SelectedIndexFieldName: TGMString read FSelectedIndexFieldName write SetSelectedIndexFieldName;
    property StateImageIdxFieldName: TGMString read FStateImageIdxFieldName write SetStateImageIdxFieldName;
    property FixedImageIndex: PtrInt read FFixedImageIndex write FFixedImageIndex default cInvalidItemIdx;
    property FixedSelectedImageIndex: PtrInt read FFixedSelectedImageIndex write FFixedSelectedImageIndex default cInvalidItemIdx;

    property OnAfterFieldNameChange: TGMFieldNameChangeNotifyEvent read FOnAfterFieldNameChange write FOnAfterFieldNameChange;
  end;


  TGMInterfaceSourceLink = class(TGMActivatableObject, IGMGetState,
                                                       IGMEnumerateItems,
                                                       IGMCanExecuteOperation,
                                                       IGMExecuteOperation,
                                                       IGMGetPosition,
                                                       IGMGetSetPosition,
                                                       IGMAskBoolean,
                                                       IGMAskInteger,
                                                       IGMGetIntfByName,
                                                       IGMGetIntfByPosition,
                                                       IGMGetCount,
                                                       IGMSaveRestoreState,
                                                       IGMUnidirectionalCursor,
                                                       IGMBidirectionalCursor,
                                                       IGMCursorFirstLast,
                                                       IGMNamedValueChange,
                                                       IGMGetAttributes,
                                                       IGMGetSetAttributes,
                                                       IGMLookupValues,
                                                       IGMLocateValues,
                                                       IGMPositionOfValues,
                                                       IGMGetColumnSortOrder,
                                                       IGMSetColumnSortOrder)
   protected
    FInterfaceSource: TGMRecordsetIntfSource;

    FOnAfterIntfSourceChange: TGMIntfSourceChangeEvent;
    FOnBeforePositionChange: TGMObjectProc;
    FOnAfterPositionChange: TGMObjectProc;
    FOnBeforeOperation: TGMOperationNotifyEvent;
    FOnAfterOperation: TGMOperationNotifyEvent;
    FOnAfterFieldValueChange: TGMFieldValueChangeNotifyEvent;
    FOnAfterSQLChange: TGMObjectProc;
    FOnValidateFieldValues: TGMObjectProc;

    function GetActive: Boolean; override;
    procedure SetInterfaceSource(const Value: TGMRecordsetIntfSource);
    procedure InternalOpen; override;
    procedure SetupIntfSourceConnector(const IntfConnector: TGMRecordsetIntfSource);
    function NeededSourceIIDs: TGMInterfaceIDArray; virtual;

    function GetState: LongInt; virtual; stdcall;
    procedure EnumerateItems(const ItemKind: LongInt; const TellEnumSink: IUnknown; const Parameter: Pointer = nil); virtual; stdcall;
    function CanExecuteOperation(const Operation: LongInt; const Parameter: IUnknown = nil): Boolean; virtual; stdcall;
    function ExecuteOperation(const Operation: LongInt; const Parameter: IUnknown = nil): Boolean; virtual; stdcall;
    function GetPosition: PtrInt; virtual; stdcall;
    procedure SetPosition(const Value: PtrInt); virtual; stdcall;
    function AskBoolean(const ValueId: LongInt): LongInt; virtual; stdcall;
    function AskInteger(const ValueId: LongInt): LongInt; virtual; stdcall;
    function GetIntfByName(const FieldName: TGMString; const IID: TGUID; out Intf): HResult; virtual; stdcall;
    function GetIntfByPosition(const Position: PtrInt; const IID: TGUID; out Intf): HResult; virtual; stdcall;
    function GetCount: PtrInt; virtual; stdcall;
    function CaptureState: IUnknown; virtual; stdcall;
    procedure RestoreState(const State: IUnknown); virtual; stdcall;
    function GetBOF: Boolean; virtual; stdcall;
    function GetEOF: Boolean; virtual; stdcall;
    //function GetIsEmpty: Boolean; virtual; stdcall;
    procedure MoveToNext; virtual; stdcall;
    procedure MoveToPrevious; virtual; stdcall;
    procedure MoveToFirst; virtual; stdcall;
    procedure MoveToLast; virtual; stdcall;
    procedure AfterValueChange(const FieldName: TGMString); virtual;
    function GetAttributes: Longword; virtual; stdcall;
    procedure SetAttributes(const Value: Longword); virtual; stdcall;
    function LookupValues(const SQLCriteria: TGMString; const Values: IUnknown): Boolean; virtual; stdcall;
    function LocateValues(const Values: IUnknown): Boolean; virtual; stdcall;
    function PositionOfValues(const Values: IUnknown; var FindPos: LongInt): Boolean; virtual; stdcall;
    function GetColumnSortOrder(const ColumnName: TGMString): LongInt; stdcall;
    procedure SetColumnSortOrder(const ColumnName: TGMString; const SortOrder: LongInt; const Cumulative, ReExecuteWhenChanged: Boolean); stdcall;

    { ---- Notification Handler ---- }
    procedure AfterInterfaceSrcObjChange(const OldSource, NewSource: IUnknown); virtual;
    procedure BeforeActiveChange(const NewActive: Boolean); virtual;
    procedure AfterActiveChange(const NewActive: Boolean); virtual;
    procedure BeforePositionChange; virtual;
    procedure AfterPositionChange; virtual;
    procedure BeforeOperation(const Operation: LongInt; const Parameter: IUnknown = nil); virtual;
    procedure AfterOperation(const Operation: LongInt; const Parameter: IUnknown = nil); virtual;
    procedure AfterValueChange2(Sender: IUnknown; const FieldName: TGMString); virtual;
    procedure ValidateValues;
    procedure AfterSQLChange; virtual;

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

    { ---- IGMEnableNotifications ---- }
    function GetNotifyDisableCount: LongInt; override;
    function EnableNotifications(const NotificationOnReEnable: LongInt = Ord(rgNone)): LongInt; override;
    function DisableNotifications(const NotificationOnFirstDisable: LongInt = Ord(rgNone)): LongInt; override;

    { ---- IGMGetPropertyIntf ---- }
    function GetPropertyIntf(const PropertyName: TGMString; const IID: TGUID; out Intf): HResult; override;

   //published
    //property ActivationProperties;
    property InterfaceSource: TGMRecordsetIntfSource read FInterfaceSource write SetInterfaceSource;

    property OnAfterIntfSourceChange: TGMIntfSourceChangeEvent read FOnAfterIntfSourceChange write FOnAfterIntfSourceChange;
    property OnBeforeActiveChange;
    property OnAfterActiveChange;
    property OnBeforePositionChange: TGMObjectProc read FOnBeforePositionChange write FOnBeforePositionChange;
    property OnAfterPositionChange: TGMObjectProc read FOnAfterPositionChange write FOnAfterPositionChange;
    property OnBeforeOperation: TGMOperationNotifyEvent read FOnBeforeOperation write FOnBeforeOperation;
    property OnAfterOperation: TGMOperationNotifyEvent read FOnAfterOperation write FOnAfterOperation;
    property OnAfterFieldValueChange: TGMFieldValueChangeNotifyEvent read FOnAfterFieldValueChange write FOnAfterFieldValueChange;
    property OnAfterSQLChange: TGMObjectProc read FOnAfterSQLChange write FOnAfterSQLChange;
    property OnValidateFieldValues: TGMObjectProc read FOnValidateFieldValues write FOnValidateFieldValues;
  end;


  TGMQualifiedSourceLink = class(TGMInterfaceSourceLink, IGMTellEnumString)
   protected
    FQualifierParseChPos: PtrInt;
    FEnumQualifierName: TGMString;
    FTellEnumSink: IGMTellEnumString;

    procedure InternalEnumerateValues(const ItemKind: LongInt); virtual;
    procedure EnumerateValuesOfIntfSource(const Source: TGMRecordsetIntfSource; const ItemKind: LongInt); virtual;
    procedure EnumerateItems(const ItemKind: LongInt; const ATellEnumSink: IUnknown; const Parameter: Pointer = nil); override;
    procedure TellEnumString(const ItemKind: LongInt; const Value: TGMString; const Parameter: Pointer); virtual; stdcall;
  end;


  TGMSourceStateWrapper = class(TGMRefCountedObj, IGMGetName)
   protected
    FName: TGMString;
    FSourceState: IUnknown;
    function GetName: TGMString; stdcall;
   public
    constructor Create(const Source: IUnknown); reintroduce;
    procedure RestoreState(const Dest: IUnknown);
  end;


  TGMInterfaceMultiSourceLink = class;

  IMultiLinkSources = interface(IUnknown)
    ['{DD609D1E-0C45-4074-9969-30F5DAFB63E8}']
    function GetSourceCount: LongInt; stdcall;
    function GetSource(Idx: LongInt): IUnknown; stdcall;
    property SourceCount: LongInt read GetSourceCount;
    property Sources[Idx: LongInt]: IUnknown read GetSource;
  end;


  IRestoreToMultiLink = interface(IUnknown)
    ['{20A7356F-545B-4d32-9E4B-61D1875F477F}']
    procedure RestoreToMultiLink(const MultiLink: IMultiLinkSources); stdcall;
  end;


  TGMMultiLinkStateHolder = class(TGMRefCountedObj, IRestoreToMultiLink)
   protected
    FMasterState: TGMSourceStateWrapper;
    FSourceStates: TGMObjArrayCollection;

   public
    constructor Create(const AMultiLink: TGMInterfaceMultiSourceLink); reintroduce;
    destructor Destroy; override;
    procedure RestoreToMultiLink(const AMultiLink: IMultiLinkSources); stdcall;
  end;


  TGMInterfaceMultiSourceLink = class(TGMQualifiedSourceLink, IMultiLinkSources)
   protected
    FSourceList: TGMObjArrayCollection;

    procedure InternalOpen; override;
    function NeededSourceIIDs: TGMInterfaceIDArray; override;
    function FindSourceForQualifier(const Qualifier: TGMString; var Source: TGMRecordsetIntfSource): Boolean;

    { ---- IMultiLinkSources ---- }
    function GetMasterSource: IUnknown; stdcall;
    function GetSourceCount: LongInt; stdcall;
    function GetSource(Idx: LongInt): IUnknown; stdcall;

    { ---- override with new semantic ---- }
    procedure InternalEnumerateValues(const ItemKind: LongInt); override;
    function GetIntfByName(const QualifiedName: TGMString; const IID: TGUID; out Intf): HResult; override;
    function GetIntfByPosition(const Position: PtrInt; const IID: TGUID; out Intf): HResult; override;
    procedure AfterValueChange(const QualifiedName: TGMString); override;
    function CaptureState: IUnknown; override;
    procedure RestoreState(const State: IUnknown); override;

    { ---- simple distributions to all sources ---- }
    function ExecuteOperation(const Operation: LongInt; const Parameter: IUnknown = nil): Boolean; override;
    procedure SetPosition(const Value: PtrInt); override;
    procedure MoveToNext; override;
    procedure MoveToPrevious; override;
    procedure MoveToFirst; override;
    procedure MoveToLast; override;

   public
    constructor Create(const ARefLifeTime: Boolean); override;
    destructor Destroy; override;
    procedure AddSourceObj(const SourceObj: TObject);
    procedure RemoveSourceObj(const SourceObj: TObject);

    property SourceList: TGMObjArrayCollection read FSourceList;
  end;


  TGMInterfaceGroupSourceLink = class;

  TColumnSet = class(TGMRefCountedObj, IGMGetName, IGMTellEnumString)
   protected
    FOwner: TGMInterfaceGroupSourceLink;
    FInterfaceSource: IUnknown;
    FQualifiedName: TGMString;

    function GetName: TGMString; stdcall;

   public
    constructor Create(const AOwner: TGMInterfaceGroupSourceLink; const AQualifiedName: TGMString; const AInterfaceSource: IUnknown); reintroduce;
    procedure TellEnumString(const ItemKind: LongInt; const Value: TGMString; const Parameter: Pointer); virtual; stdcall;
    procedure EnumerateItems(const ItemKind: LongInt);
    function GetIntfByName(const QualifiedName: TGMString; const IID: TGUID; out Intf): HResult;

    property InterfaceSource: IUnknown read FInterfaceSource;
  end;


  TGMInterfaceGroupSourceLink = class(TGMQualifiedSourceLink)
   protected
    FColumnSetList: IGMObjArrayCollection;

    procedure InternalEnumerateValues(const ItemKind: LongInt); override;

   public
    constructor Create(const ARefLifeTime: Boolean); override;
    //destructor Destroy; override;
    function GetIntfByName(const QualifiedName: TGMString; const IID: TGUID; out Intf): HResult; override;
    function GetIntfByPosition(const Position: PtrInt; const IID: TGUID; out Intf): HResult; override;
    procedure AddColumnSet(const QualifiedName: TGMString; const InterfaceSource: IUnknown);
    function ExecuteOperation(const Operation: LongInt; const Parameter: IUnknown = nil): Boolean; override;

    property ColumnGroupList: IGMObjArrayCollection read FColumnSetList;
  end;


  RGMDisplayTextData = record
    Text: TGMString;
    IsValid: Boolean;
    procedure Invalidate;
  end;


  RGMCachedUnionValue = record
    Value: RGMUnionValue;
    IsValid: Boolean;
    procedure Invalidate;
  end;


  TGMValueBuffer = class(TGMMemoryLockBytes, IGMGetModified,
                                             IGMGetSetModified,
                                             IGMGetUnionValue,
                                             IGMGetSetUnionValue,
                                             //IGMAskInteger,
                                             IGMAskBoolean,
                                             //IGMExecuteOperation,
                                             IGMGetText,
                                             IGMAssignFromObj)
   protected
    FOwner: TObject;
    FModified: Boolean;
    FDataType: TGMDBColumnDataType;
    FIsNull: Boolean;
    FMaxStrLength: PtrUInt;
    FCachedValue: RGMCachedUnionValue;

    // ---- Volatile members ----
    FValueReadStream: ISequentialStream; // <- used to hold the Stream
//  FValueWriteStream: ISequentialStream; // <- used to hold the Stream


    function CalculateBufferSize: LongInt; virtual;
    //procedure InternalFetchData(const AForDisplayText: Boolean = False); virtual;
    function GetDataLength: PtrInt; virtual;
    procedure SetDataLength(const AValue: PtrInt); virtual;

    function InternalGetUnionValue: RGMUnionValue; virtual;
    procedure InternalSetUnionValue(const AValue: RGMUnionValue); virtual;
    procedure InternalSetNullValue; virtual;
    procedure InternalSetSize(ANewSize: Int64); override;
    function InternalBuildDisplayText: TGMString; virtual;

   public
    // ---- IGMGetSetModified ---- //
    function GetModified: Boolean; virtual; stdcall;
    procedure SetModified(const AValue: Boolean); virtual; stdcall;

    // ---- IGMGetSetUnionValue ---- //
    function GetUnionValue: RGMUnionValue; virtual;
    procedure SetUnionValue(const AUnionValue: RGMUnionValue); virtual;

    // ---- IGMGetText ---- //
    function GetText: TGMString; virtual; stdcall;

    { ---- IGMExecuteOperation ---- }
    //function ExecuteOperation(const AOperation: LongInt; const AParameter: IUnknown = nil): Boolean; virtual; stdcall;

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

    procedure AssignFromObj(const Source: TObject); virtual; stdcall;
    procedure AssignFromIntf(const Source: IUnknown); override;

   public
    DisplayText: RGMDisplayTextData;

    constructor Create(const AOwner: TObject;
                       const ADataType: TGMDBColumnDataType;
                       const AZeroInit: Boolean = False;
                       const AFreeMemoryOnDestroy: Boolean = True;
                       const ARefLifeTime: Boolean = False); reintroduce; virtual;

    function WriteAt(ulOffset: Int64; pv: Pointer; cb: LongInt; pcbWritten: PLongint): HResult; override;

    function CreateValueStream(const AMode: DWORD): ISequentialStream; virtual;

    procedure Invalidate(const AResetOffset, ASetToNULL: Boolean); virtual;

    function IsNull: Boolean; virtual;
    function IsFixedBufferSize: Boolean; virtual;
//  function DataIsCompressed: Boolean; virtual;

    property Owner: TObject read FOwner;
    property Modified: Boolean read GetModified write SetModified;
    property DataType: TGMDBColumnDataType read FDataType write FDataType;
    property Value: RGMUnionValue read GetUnionValue write SetUnionValue;
    property DataLength: PtrInt read GetDataLength write SetDataLength;
  end;

  TGMValueBufferClass = class of TGMValueBuffer;

  TGMValueBuffers = array [EGMValueBufferInstance] of TGMValueBuffer;


  TGMFieldValueBuffer = class(TGMValueBuffer)
   protected
    FColumnPosition: LongInt;
    FieldName: TGMString;
    SizeInBytes: PtrUInt;
    StatementHandle: THandle;

   public
    constructor CreateFieldBuffer(const AOwner: TObject;
                                  const ADataType: TGMDBColumnDataType;
                                  const AColumnPosition: LongInt;
                                  const AFieldName: TGMString;
                                  const ASizeInBytes: PtrUInt;
                                  const AMaxStrLength: PtrUInt;
                                  const AStatementHandle: THandle); virtual;
  end;

  TGMFieldValueBufferClass = class of TGMFieldValueBuffer;


  TGMDBField = class(TGMRefCountedObj, IGMGetName, IGMGetPosition, IGMGetValueDefinition, IGMGetModified,
                                       IGMGetSetModified, IGMAskInteger, IGMAskBoolean, IGMActiveChangeNotifications,
                                       IGMPositionChangeNotifications, IGMOperationNotifications, IGMGetValueBufferIntf,
                                       IGMGetUnionValue, IGMGetSetUnionValue, IGMGetText, IGMGetSetText)
   protected
    FOwner: TObject;
    FCreateData: RGMFieldCreateData;
    FValueBufferIdxMap: array [EGMValueBufferInstance] of EGMValueBufferInstance;
    FValueBuffers: array [EGMValueBufferInstance] of TGMFieldValueBuffer;

    procedure SetModified(const Value: Boolean); virtual; stdcall;
    function ValueBufferCreateClass: TGMFieldValueBufferClass; virtual;
    function ValueBuffer(const AValueBufferInstance: EGMValueBufferInstance): TGMFieldValueBuffer; virtual;
    function GetUnionValue: RGMUnionValue; virtual;
    function GetText: TGMString; virtual; stdcall;
    procedure SetUnionValue(const AUnionValue: RGMUnionValue); virtual;
    procedure SetText(const AValue: TGMString); virtual; stdcall;
    procedure NotifyDataChange; virtual;
    function EditOrInsertRecordset: Boolean; virtual;
    procedure CheckupdatableState(const AMethodName: TGMString = '');
    function RecordsetState: LongInt;
    function RecordsetAttributes: TGMRecordsetAttributes;
    procedure SwapBufferMap; virtual;
    procedure FreeValueBuffers;

   public
    // ---- Interfaces ---- //
    function GetName: TGMString; virtual; stdcall;
    function GetPosition: PtrInt; virtual; stdcall;
    function GetModified: Boolean; virtual; stdcall;
    function GetDataType: TGMDBColumnDataType; virtual; stdcall;
    function GetNullValuesAllowed: TGMAllowNullValues; virtual; stdcall;
    function GetUpdatable: Boolean; virtual; stdcall;
    function AskInteger(const ValueId: LongInt): LongInt; stdcall;
    function AskBoolean(const ValueId: LongInt): LongInt; virtual; stdcall;
    procedure BeforeActiveChange(const NewActive: Boolean); virtual; stdcall;
    procedure AfterActiveChange(const NewActive: Boolean); virtual; stdcall;
    procedure BeforePositionChange; virtual; stdcall;
    procedure AfterPositionChange; virtual; stdcall;
    procedure BeforeOperation(const Operation: Integer; const Parameter: IUnknown = nil); virtual; stdcall;
    procedure AfterOperation(const Operation: Integer; const Parameter: IUnknown = nil); virtual; stdcall;
    function GetValueBufferIntf(const AValueBufferInstance: LongInt; const AIID: TGUID; out AIntf): HResult; stdcall;

   public
    constructor Create(const AOwner: TObject; const ACreateData: RGMFieldCreateData); reintroduce; virtual;
    destructor Destroy; override;

    function IsSigned: Boolean; virtual;
    function IsAutoIncrementing: Boolean; virtual;
    function SizeInBytes: PtrInt; virtual;
    function DisplayWidth: PtrInt; virtual;
    function EditLength: PtrInt; virtual;

    property Owner: TObject read FOwner;
    property Name: TGMString read GetName;
    property Position: PtrInt read GetPosition;
    property Modified: Boolean read GetModified write SetModified;
    property CreateData: RGMFieldCreateData read FCreateData;
    property DataType: TGMDBColumnDataType read GetDataType;
    property NullValuesAllowed: TGMAllowNullValues read GetNullValuesAllowed;
    property Updatable: Boolean read GetUpdatable;
    property Value: RGMUnionValue read GetUnionValue write SetUnionValue;
  end;


  TGMFieldClass = class of TGMDBField;


  //TGMDBFieldList = TGMGenericArrayCollection<TGMDBField>;


  TGMFieldStateBuffer = class(TGMValueBuffer)
   public
    function IsFixedBufferSize: Boolean; override;
  end;


  TGMFieldStateHolder = class(TGMRefCountedObj, IGMGetName,
                                                IGMGetSetName,
                                                IGMAssignFromObj,
                                                IGMAssignToObj,
                                                IGMAssignFromIntf,
                                                IGMAssignToIntf,
                                                IGMGetValueBufferIntf)
   protected
    FName: TGMString;
    FDataType: TGMDBColumnDataType;
    FValueBuffers: TGMValueBuffers;

    function ValueBufferCreateClass: TGMValueBufferClass; virtual;
    function ValueBuffer(const ValueBufferInstance: EGMValueBufferInstance): TGMValueBuffer; virtual;

    { ---- IGMGetSetName ---- }
    function GetName: TGMString; virtual; stdcall;
    procedure SetName(const AValue: TGMString); virtual; stdcall;

    { ---- IGMGetValueBufferIntf ---- }
    function GetValueBufferIntf(const ValueBufferInstance: LongInt; const IID: TGUID; out Intf): HResult; virtual; stdcall;

    { ---- IGMAssignByObj ---- }
    procedure AssignFromObj(const Source: TObject); virtual; stdcall;
    procedure AssignToObj(const Dest: TObject); virtual; stdcall;

    { ---- IGMAssignByIntf ---- }
    procedure AssignFromIntf(const Source: IUnknown); virtual; stdcall;
    procedure AssignToIntf(const Dest: IUnknown); virtual; stdcall;

   public
    constructor Create(const Source: IUnknown = nil); reintroduce; virtual;
    destructor Destroy; override;

    procedure ResetContents; virtual;

    property Name: TGMString read FName write FName;
    property DataType: TGMDBColumnDataType read FDataType write FDataType;
  end;

  TGMFieldStateCreateClass = class of TGMFieldStateHolder;


  TGMRecordsetStateHolder = class(TGMRefCountedObj, IGMAssignFromObj,
                                                    IGMAssignToObj,
                                                    IGMAssignFromIntf,
                                                    IGMAssignToIntf,
                                                    IGMTellEnumString)
   protected
    FFieldStates: TGMObjArrayCollection;
    FState: LongInt;
    FPosition: LongInt;
    FSource: IUnknown;

    function FieldStateCreateClass: TGMFieldStateCreateClass; virtual;

    procedure ResetContents; virtual;
    procedure TellEnumString(const ItemKind: LongInt; const Value: TGMString; const Parameter: Pointer); virtual; stdcall;
    procedure AssignFields(const Dest: IUnknown); virtual;

    property FieldStates: TGMObjArrayCollection read FFieldStates;

   public
    constructor Create(const Source: IUnknown = nil); reintroduce;
    destructor Destroy; override;

    procedure AssignFromIntf(const Source: IUnknown); virtual; stdcall;
    procedure AssignToIntf(const Dest: IUnknown); virtual; stdcall;

    procedure AssignFromObj(const Source: TObject); virtual; stdcall;
    procedure AssignToObj(const Dest: TObject); virtual; stdcall;

    property State: LongInt read FState write FState;
    property Position: LongInt read FPosition write FPosition;
  end;


  { ---- Locate Types ---- }

  TNameAndValueMatch = record
    Name: TGMString;
    Value: RGMUnionValue;
    MatchKind: TMatchKind;
    MatchCase: Boolean;
  end;

  function NameAndValueMatch(const FieldName: TGMString; const FieldValue: RGMUnionValue; const MatchKind: TMatchKind = GMIntf.mkExactMatch; const MatchCase: Boolean = True): TNameAndValueMatch;

  type


  TGMNameAndValueMatchObj = class(TGMRefCountedObj, IGMGetName, IGMGetUnionValue, IGMGetSetUnionValue, IGMAskBoolean, IGMAskInteger)
   public
    FData: TNameAndValueMatch;

    function GetName: TGMString; virtual; stdcall;
    function GetUnionValue: RGMUnionValue; virtual;
    procedure SetUnionValue(const AUnionValue: RGMUnionValue); virtual;
    function AskBoolean(const ValueId: LongInt): LongInt; virtual; stdcall;
    function AskInteger(const ValueId: LongInt): LongInt; virtual; stdcall;

    constructor Create(const AData: TNameAndValueMatch; const RefLifeTime: Boolean = False); reintroduce;
  end;


  TGMNamedValueCollection = class(TGMObjArrayCollection, IGMGetIntfByName)
   public
    constructor Create(const Names: array of TGMString; const RefLifeTime: Boolean = True);
    function GetIntfByName(const Name: TGMString; const IID: TGUID; out Intf): HResult; stdcall;
    function FindValueByName(const ValueName: TGMString; var Value: TGMNameAndValueObj): Boolean;
    procedure SaveValues;
    procedure RestoreValues;
    procedure ClearOldValues;
  end;


  TGMNameAndValueMatchList = class(TGMObjArrayCollection)
   public
    constructor Create(const Values: array of TNameAndValueMatch; const RefLifeTime: Boolean = True);
  end;


  TGMFieldNameAndValue = class(TGMNameAndValueObj, IGMGetValueDefinition)
   protected
    FOwner: TObject;
    FOldValue: RGMUnionValue;
    FReadOnly: Boolean;

   public
    constructor Create(const AOwner: TObject; const AName: TGMString; const AValue: RGMUnionValue; const AReadOnly: Boolean = False; const ARefLifeTime: Boolean = False); reintroduce; overload;
    procedure SetUnionValue(const AUnionValue: RGMUnionValue); override;
    procedure NotifyValueChange;
    function GetDataType: TGMDBColumnDataType; stdcall;
    function GetNullValuesAllowed: TGMAllowNullValues; stdcall;
    function GetUpdatable: Boolean; stdcall;
    procedure SaveValue;
    procedure RestoreValue;
    procedure ClearOldValue;

    property ReadOnly: Boolean read FReadOnly write FReadOnly;
  end;


  TGMNamedValuesContainer = Class;
  TGMNamedValueChangeEvent = procedure (Sender: TGMNamedValuesContainer; const ValueName: TGMString) of object;
  TRecalculateValuesEvent = procedure (Sender: TGMNamedValuesContainer) of object;

  TGMNamedValuesContainer = Class(TGMActivatableObject, IGMAskboolean, IGMGetState, IGMEnumerateItems, IGMSaveRestoreState,
                                                        IGMGetPosition, IGMGetIntfByName, IGMGetIntfByPosition, IGMGetCount,
                                                        IGMExecuteOperation, IGMCanExecuteOperation, IGMNamedValueChange,
                                                        IGMLoadStoreData, IGMGetMasterSource, IGMGetSetMasterSource)
   protected
    FState: TGMRecordsetState;
    FNamedValuesList: TGMNamedValueCollection;
    FMasterSource: TGMRecordsetMasterSource;
    FReCalculationTimer: TGMThreadTimer;
    FTimedReCalculationDelay: Integer;
    FOnAfterValueChange: TGMNamedValueChangeEvent;
    FOnRecalculateValues: TRecalculateValuesEvent;

    function GetValue(const AIndex: RGMUnionValue): RGMUnionValue;
    function GetMasterSourceConnector: TGMRecordsetMasterSource;
    procedure SetValue(const AIndex: RGMUnionValue; const Value: RGMUnionValue);
    procedure SetMasterSourceConnector(const Value: TGMRecordsetMasterSource);

    procedure AfterMasterActiveChange(const NewActive: Boolean); virtual;
    procedure AfterMasterPositionChange; virtual;
    procedure AfterMasterOperation(const Operation: LongInt; const Parameter: IUnknown = nil); virtual;

    function GetActive: Boolean; override;
    procedure InternalOpen; override;
    procedure InternalClose; override;

   public // Interfaces
    function GetMasterSource: IUnknown;
    procedure SetMasterSource(const AValue: IUnknown);
    function AskBoolean(const ValueId: LongInt): LongInt; virtual; stdcall;
    function GetCount: PtrInt; virtual; stdcall;
    function GetState: LongInt; virtual; stdcall;
    procedure EnumerateItems(const ItemKind: LongInt; const TellEnumSink: IUnknown; const Parameter: Pointer = nil); virtual; stdcall;
    function CaptureState: IUnknown; virtual; stdcall;
    procedure RestoreState(const State: IUnknown); virtual; stdcall;
    function GetPosition: PtrInt; virtual; stdcall;
    function GetIntfByName(const Name: TGMString; const IID: TGUID; out Intf): HResult; virtual; stdcall;
    function GetIntfByPosition(const Position: PtrInt; const IID: TGUID; out Intf): HResult; virtual; stdcall;
    procedure AfterValueChange(const ValueName: TGMString); virtual;
    function CanExecuteOperation(const Operation: LongInt; const Parameter: IUnknown = nil): Boolean; virtual; stdcall;
    function ExecuteOperation(const Operation: LongInt; const Parameter: IUnknown = nil): Boolean; virtual; stdcall;
    procedure LoadData(const Source: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); stdcall;
    procedure StoreData(const Dest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); stdcall;

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

    procedure AddNamedValue(const Name: TGMString; const Value: RGMUnionValue; const ReadOnly: Boolean = False; const NotifyValueChange: Boolean = False);

    procedure RecalculateValues(const Sender: TObject); virtual;
    procedure ScheduleReCalculation;

    property ReCalculationTimer: TGMThreadTimer read FReCalculationTimer;
    property Values[const Idx: RGMUnionValue]: RGMUnionValue read GetValue write SetValue; default;
    property NamedValuesList: TGMNamedValueCollection read FNamedValuesList;

   //published
    property ActivationProperties;
    property MasterSource: TGMRecordsetMasterSource read GetMasterSourceConnector write SetMasterSourceConnector;
    property TimedReCalculationDelay: Integer read FTimedReCalculationDelay write FTimedReCalculationDelay default cDfltReExecutionDelay;
    property OnAfterValueChange: TGMNamedValueChangeEvent read FOnAfterValueChange write FOnAfterValueChange;
    property OnBeforeActiveChange;
    property OnAfterActiveChange;
    property OnRecalculateValues: TRecalculateValuesEvent read FOnRecalculateValues write FOnRecalculateValues;
  end;


  TGMSqlStatementBase = class(TGMHandleActivateObj, IGMGetName, IGMGetState, IGMEnumerateItems, IGMCanExecuteOperation,
                                                    IGMSaveRestoreState, IGMExecuteOperation,
                                                    IGMGetColumnSortOrder, IGMSetColumnSortOrder,
                                                    IGMGetSortColumnName, IGMGetSubItems, IGMAssignFromObj)
   protected
    FState: TGMRecordsetState;
    FSQL: TGMSqlProperty;
    FReExecutionTimer: TGMThreadTimer;
    FInternalExecuted: Boolean;
    FColumnsStayValidOnReExecution: Boolean;
    FOnAfterSQLChange: TGMObjNotifyProc;

    function GetTimedReExecutionDelay: Integer;
    function GetConnectionIntf: IUnknown;

    procedure SetSQL(const AValue: TGMSqlProperty);
    procedure SetTimedReExecutionDelay(const AValue: Integer);
    procedure SetConnectionIntf(const AValue: IUnknown);

    procedure SQLChanged(const Sender: TObject); virtual;
    procedure OnTimedReExecution(const Sender: TObject); virtual;

    procedure CallSinkAfterSQLChange(const ANotifySink: IUnknown; const AParams: array of RGMUnionValue);

    procedure NotifyAfterSQLChange; virtual;
    procedure NotifyBeforeOperation(const Operation: Integer; const Parameter: IUnknown = nil); virtual;
    procedure NotifyAfterOperation(const Operation: Integer; const Parameter: IUnknown = nil); virtual;

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

    procedure OnBeforeIntfSourceChange(const OldSource, NewSource: IUnknown);

    procedure ResetMembers; virtual;

    function GetResolvedSQLStatement: TGMString; virtual;
    procedure CheckSQLStatementText(const ASQL: TGMString); virtual;

    procedure InternalExecute; virtual;
    procedure APIExecuteSQL(const ASQLText: TGMString); virtual; abstract;
    procedure AllocHandle; override;
    procedure ReleaseHandle; override;

    procedure DoStateChange(const AOperation: TGMRecordsetOperation; const AInternalOperationProc: TGMObjectProc = nil; const AParameter: IUnknown = nil); virtual;

   public
    constructor Create(const ARefLifeTime: Boolean = False); overload; override;
    constructor Create(const AConnection: IUnknown; const ASql: TGMString; const ARefLifeTime: Boolean = True); reintroduce; overload;
    destructor Destroy; override;

    procedure AssignFromObj(const Source: TObject); virtual; stdcall;
    procedure Execute; virtual;
    function CanModify: Boolean; virtual;
    procedure ReExecuteStatement(const AColumnsStayValid: Boolean = True; APreserveState: Boolean = True); virtual;
    procedure ScheduleReExecution(const AColumnsStayValid: Boolean = True); virtual;

    function GetName: TGMString; stdcall;

    // IGMGetPropertyIntf
    function GetPropertyIntf(const APropertyName: TGMString; const AIID: TGUID; out AIntf): HResult; override;

    // IGMGetState
    function GetState: LongInt; virtual; stdcall;

    // IGMEnumerateItems
    procedure EnumerateItems(const AItemKind: LongInt; const ATellEnumSink: IUnknown; const AParameter: Pointer = nil); virtual; stdcall;

    // Operations
    function CanExecuteOperation(const AOperation: Integer; const AParameter: IUnknown = nil): Boolean; virtual; stdcall;
    function ExecuteOperation(const AOperation: Integer; const AParameter: IUnknown = nil): Boolean; virtual; stdcall;

    // IGMSaveRestoreState
    function CaptureState: IUnknown; virtual; stdcall;
    procedure RestoreState(const AState: IUnknown); virtual; stdcall;

    // IGMGetColumnSortOrder
    function GetColumnSortOrder(const AColumnName: TGMString): LongInt; stdcall;
    procedure SetColumnSortOrder(const AColumnName: TGMString; const ASortOrder: LongInt; const ACumulative, AReExecuteWhenChanged: Boolean); stdcall;

    // IGMGetSortColumnName
    function GetSortColumnName(var AColumnName: TGMString): Boolean; stdcall;

    // ---- IGMGetSubItems ----
    function GetSubItems(const AParentFieldName: TGMString; const AParentFieldValue: RGMUnionValue; const AIID: TGUID; out Intf): HResult;

    property InternalExecuted: Boolean read FInternalExecuted;
    property State: TGMRecordsetState read FState;
    property ReExecutionTimer: TGMThreadTimer read FReExecutionTimer;
    property SQL: TGMSqlProperty read FSQL write SetSQL; // implements IGMGetText;
    property ConnectionIntf: IUnknown read GetConnectionIntf write SetConnectionIntf;
    property OnAfterSQLChange: TGMObjNotifyProc read FOnAfterSQLChange write FOnAfterSQLChange;
  end;


  IGMModifyViaSQL = interface(IUnknown)
    ['{5A6F4EDD-0BFB-4609-B493-334EA9E04051}']
    procedure Update(const ASQLExecuter: IUnknown); stdcall;
    procedure Insert(const ASQLExecuter: IUnknown); stdcall;
    procedure Delete(const ASQLExecuter: IUnknown); stdcall;
    procedure Refresh;
    procedure Reset;
  end;


  TGMModifyViaSql = class(TGMRefCountedObj, IGMModifyViaSQL, IGMTellEnumString)
   protected
    FOwner: TObject;
    FFieldList: TGMStringArray;
    FKeyFieldList: TGMStringArray;
    FFieldListsValid: Boolean;

    //function FieldList: TGMStringArray;
    //function KeyFieldList: TGMStringArray;
    procedure BuildFieldLists;
    function KeyValuesSQL(const BufferInstance: EGMValueBufferInstance): TGMString;
    procedure TellEnumString(const ItemKind: LongInt; const Value: TGMString; const Parameter: Pointer); stdcall;

   public
    constructor Create(const AOwner: TObject; const ARefLiftetime: Boolean = False); reintroduce;

    procedure Reset;

    procedure Update(const ASQLExecuter: IUnknown); stdcall;
    procedure Insert(const ASQLExecuter: IUnknown); stdcall;
    procedure Delete(const ASQLExecuter: IUnknown); stdcall;
    procedure Refresh;

    property Owner: TObject read FOwner;
    property FieldList: TGMStringArray read FFieldList;
    property KeyFieldList: TGMStringArray read FKeyFieldList;
  end;


  { ---- BLOB Types ---- }

//TGMCompressedBlobHeaderData = packed record
// Guid: TGUID;
// DataSize: Longword;
// Reserved: LongWord;
//end;

function GMEmptyStrAsNil(const AValue: TGMString): TGMString;

function IsSelectSQL(const ASQLText: TGMString): Boolean;
function GMSqlStatmentKind(const ASQLText: TGMString): TGMSqlStatementKind;
function GMIterateAllSqlStatements(const ASqlText: TGMString; const ASqlStmtVisitFunc: TGMSqlStmtVisitFunc; const AOpaqueAppData: Pointer = nil): Integer;

function GMNextSqlStatement(var AChPos: PtrInt; const ASQLText: TGMString): TGMString;
function GMPreviousSqlStatement(var AChPos: PtrInt; const ASQLText: TGMString): TGMString;
function GMLastSqlStatement(const ASQLText: TGMString; const AKind: TGMSqlStatementKind = skSelect): TGMString;

function GMDbColDataTypeOfUnionValue(const AValue: RGMUnionValue): TGMDBColumnDataType;

function IsIntegerFieldDataType(const AFieldDataType: TGMDBColumnDataType): Boolean;
function IsStreamedFieldDataType(const AFieldDataType: TGMDBColumnDataType): Boolean;
function IsTextFieldDataType(const AFieldDataType: TGMDBColumnDataType): Boolean;
function IsStringFieldDataType(const AFieldDataType: TGMDBColumnDataType): Boolean;
function IsFixedLengthDataType(const AFieldDataType: TGMDBColumnDataType): Boolean;
function IsSortableDataType(const AFieldDataType: TGMDBColumnDataType): Boolean;
//function IsAggregatSelectList(const SQLSelectList: TGMString): Boolean;

function GMExtractNameFromConnectionString(const AConnectionString: TGMString): TGMString;
//function GMReplaceDSNInConnectionString(const ConnectionString, NewDSN: TGMString): TGMString;
function GMAddOrReplaceValueInConnectionString(const ConnectionString, ValueName, Value: TGMString): TGMString;
function ExtractDSNFromDisplayName(const ADSNDisplayName: TGMString): TGMString;
//function GMCompareConnectionStrings(const ConnectionStr1, ConnectionStr2: TGMString; const CompareKind: TConnectionStrCompareKind = cnpLazyMatch): Boolean;

function DataTypeCanEditAsString(const AFieldDataType: TGMDBColumnDataType): Boolean;

//function GMVarTypeOfDataType(const AFieldDataType: TGMDBColumnDataType; const ACallingName: TGMString): Integer;
//function GMDataTypeOfVarType(const AVarType: Integer; const ACallingName: TGMString): TGMDBColumnDataType;

function GMUnionTypeOfDbDataType(const ADbDataType: TGMDBColumnDataType): EGMUnionValueType;
function GMDbDataTypeOfUnionType(const AValueType: EGMUnionValueType): TGMDBColumnDataType;
//function GMDataTypeOfUnionType(const AVarType: Integer; const ACallingName: TGMString): TGMDBColumnDataType;

function GMValueBufferSizeOfFieldDataType(const FieldDataType: TGMDBColumnDataType): Integer;

function GMFieldEditLength(const AFielDataType: TGMDBColumnDataType; const AMaxStrLength: PtrUInt): PtrUInt;
function GMFieldDisplayWidth(const AFielDataType: TGMDBColumnDataType; const AMaxStrLength: PtrUInt): PtrInt;
function GMCharSizeInBytes(const AFieldDataType: TGMDBColumnDataType): Word;

function GMStripSQLComments(const ASQLText: TGMString): TGMString;
function GMNextSQLToken(var AChPos: PtrInt; const ASQLText, ASeparators: TGMString): TGMString;
function GMPreviousSQLToken(var AChPos: PtrInt; const ASQLText, ASeparators: TGMString; const ASkipTrailingSeparators: Boolean = True): TGMString;

function GMExtractQualifier(const QualifiedName: TGMString; var chPos: PtrInt; var Qualifier: TGMString; const Separators: TGMString = cSqlQualSep): Boolean;
function GMSplitQualifiedName(const QualifiedName: TGMString; var Qualifier, FieldName: TGMString): Boolean;

function GMVarToConnectionStrLiteral(const AValue: RGMUnionValue): TGMString;
function GMUnionValueAsSqlLiteral(const AValue: RGMUnionValue; ASQLFormatStrForDateTime: TGMString = ''): TGMString;
function GMStringAsSqlLiteral(const AValue: TGMString; const AQuoteChar: TGMChar = cSqlStrQuoteChar): TGMString;

//function DuplicateQuotes(const SQL: TGMString; const QuoteChar: TGMChar = cSqlStrQuoteChar): TGMString;
function ExtractSQLSelectList(const ASQLText: TGMString): TGMString;
procedure GMCheckSQLNotEmpty(const SQL: TGMString; const Caller: TObject = nil; const CallingName: TGMString = '');

function GMCalcParamCount(const SQLString: TGMString): SmallInt;

function IsUpdatableState(const State: Longword): Boolean;

function GMObjectIsInUpdatableState(const Intf: IUnknown): Boolean;
function GMObjectCanBeEdited(const Intf: IUnknown): Boolean;
function GMEditOrInsertIntf(const AIntf: IUnknown): Boolean;

procedure GMCheckExecRSOperation(const Obj: TObject; const Operation: TGMRecordsetOperation; const CallingName: TGMString = ''; const Parameter: IUnknown = nil); overload;
procedure GMCheckExecRSOperation(const Intf: IUnknown; const Operation: TGMRecordsetOperation; const CallingName: TGMString = ''; const Parameter: IUnknown = nil); overload;

function ConvertStringToFieldType(const AValAsStr: TGMString; const ADbDataType: TGMDBColumnDataType): RGMUnionValue;

function RecordsetStateAfterOperation(const AOperation: TGMRecordsetOperation; const AObj: TObject = nil): TGMRecordsetState;

function RSAttributesToLongWord(const Value: TGMRecordsetAttributes): Longword;
function RSAttributesFromLongWord(const Value: Longword): TGMRecordsetAttributes;

function SchemaListsToLongWord(const Value: TGMSchemaLists): Longword;
function SchemaListsFromLongWord(const Value: Longword): TGMSchemaLists;

function GMExtractNextFieldName(var AChPos: PtrInt; const FieldNames: TGMString): TGMString;
function GMExtractTableName(const ASQLText: TGMString): TGMString;

function GMSqlIdentifierNeedsQuotation(const AIdentifier: TGMString): Boolean;
function GMSqlQuoteIdentifierIfNeeded(const AIdentifier: TGMString; const AIdQuoteChar: TGMString = cSqlIdQuoteCh): TGMString;
function GMBuildSelectAllSQL(ATableName: TGMString; const AIdQuoteChar: TGMString = cSqlIdQuoteCh; const AOrderBy: TGMString = ''): TGMString;

function GMBuildSelectCountSQL(ATableName: TGMString; const AIdQuoteChar: TGMString = cSqlIdQuoteCh; const AWhereClause: TGMString = ''): TGMString;
function GMModifyToSelectCountSQL(const ASqlText: TGMString; const ACaller: TObject = nil): TGMString;

function GMBuildSQLDelete(ATableName: TGMString; const AWhere: TGMString = ''): TGMString;
function GMReplaceSqlValue(const SQLPart, FieldName, OpInner, OpOuter: TGMString; const FieldValue: RGMUnionValue): TGMString;

function GMConfirmDeletion(const Container: IUnknown; ConfirmQuestion: TGMString = ''): Boolean;
procedure GMDoDeletion(const AContainer: IUnknown; const ASelection: IUnknown = nil);
procedure GMDeleteCascaded(const Container: IUnknown; const KeyValueName, ParentRefValueName: TGMString); overload;
procedure GMDeleteCascaded(const Container: IUnknown); overload;
procedure GMInsertChild(const Container: IUnknown);

function GMLookupValues(const Container, Values: IUnknown; const SQLCriteria: TGMString; const GlobalLookup: Boolean = True): Boolean;
function GMLookupValue(const Container: IUnknown; const ValueName, SQLCriteria: TGMString; const GlobalLookup: Boolean = True): RGMUnionValue;

function GetSqlIdQuoteChFromConnection(const AConnection: IUnknown): TGMString;
function GetSqlIdQuoteChFromStatement(const AStatement: IUnknown): TGMString;

//function GMExecSqlSelectCount(const AStatement: IUnknown; const ASqlText: TGMString): RGMUnionValue;
function GMGetSubItemsBySQL(const Container: IUnknown; const ParentFieldName: TGMString; ParentFieldValue: RGMUnionValue; const IID: TGUID; out Intf): HResult;

function RecordsetAttributesToInt(const Value: TGMRecordsetAttributes): LongInt;
function RecordsetAttributesFromInt(const Value: LongInt): TGMRecordsetAttributes;

function GMBuildContentsString(const Source: IUnknown;
                               const FieldNames: TGMStringArray;
                               SelectionSource: IUnknown = nil;
                               const IncludeTitles: Boolean = True;
                               const ColumnSeparator: TGMString = cDfltColumnSeparator;
                               const RowSeparator: TGMString = cDfltRowSeparator): TGMString;

//function GMCompressedBlobHeaderData(const DataSize: LongWord = 0): TGMCompressedBlobHeaderData;
//function GMIsCompressedBlobHeaderData(const Data: TGMCompressedBlobHeaderData): Boolean;

function GMSetSortOrder(const AFieldName: TGMString; const ASortOrder: LongInt; const ASQLOrderBy: TGMString; const ACumulative: Boolean = True): TGMString;

// Return values: Negative values = DESC, 0 and positive values = ASC, the number represents the position inside the applied sortings 
function GMFindSortOrderPos(const AFieldName, ASQLOrderBy: TGMString; var AChPos: PtrInt): PtrInt;
function GMFindSortOrder(const AFieldName, ASQLOrderBy: TGMString): LongInt;

procedure GMNotifyFieldsBeforeOperation(const AFieldList: TGMObjArrayCollection; const AOperation: Integer; const AParameter: IUnknown = nil);
procedure GMNotifyFieldsAfterOperation(const AFieldList: TGMObjArrayCollection; const AOperation: Integer; const AParameter: IUnknown = nil);
procedure GMNotifyFieldsBeforePositionChange(const AFieldList: TGMObjArrayCollection);
procedure GMNotifyFieldsAfterPositionChange(const AFieldList: TGMObjArrayCollection);
procedure GMNotifyFieldsBeforeActiveChange(const AFieldList: TGMObjArrayCollection; const ANewActive: Boolean);
procedure GMNotifyFieldsAfterActiveChange(const AFieldList: TGMObjArrayCollection; const ANewActive: Boolean);


function GMRecordsetAttributeName(const ARSAttribute: TGMRecordsetAttribute): TGMString;
function GMRSOperationName(const ARSOperation: TGMRecordsetOperation): TGMString;
function GMSchemaListName(const ASchemList: TGMSchemaList): TGMString;
function GMFieldDataTypeName(const AFieldDataType: TGMDBColumnDataType): TGMString;
function GMRecordsetStateName(const ARSState: TGMRecordsetState): TGMString;

procedure GMCallSinkAfterSQLChange(const NotifySink: IUnknown; const Params: array of OleVariant);
procedure GMCallSinkAfterFieldValueChange(const NotifySink: IUnknown; const Params: array of OleVariant);

function GMNullableYN(const AValue: TGMAllowNullValues): TGMString;
function GMNullableName(const AValue: TGMAllowNullValues): TGMString;
function GMSortOrderDirectionName(const ASortOrderDirection: TGMSortOrderDirection): TGMString;
function GMAllowDuplicatesName(const AValue: TGMAllowDuplicates): TGMString;


resourcestring

  RStrNULLValue = '<Unknown>';

  RStrAutoSaveChanges = 'Automatically save changes before moving to another record';
  RStrAutoEdit = 'Automatically enter editing state when a field value is modified';
  RStrConfrimDeletions = 'Confirm record deletions';
  RStrBookmarksEnabled = 'Enable bookmarks';
  RStrExposeBookmarkColumn = 'Make bookmark column accessible';
  RStrStripTrailingBlanks = 'Strip trailing blanks from string values when reading data';

  RStRroEdit = 'Edit';
  RStRroInsert = 'Insert';
  RStRroDelete = 'Delete';
  RStRroCancelChanges = '';
  RStRroApplyChanges = 'Apply changes';
  RStRroRefreshCurrent = 'Refresh current';
  RStRroReExecuteStatement = 're-Execute';
  RStRroScheduleReExecution = 'Schedule re-Execute';
  RStRroLeaveModifyingState = 'Leave modfying state';
  RStRroSetSimplestConfiguration = 'Set simplest configuration';

//RStrSystemTables = 'System Tables';
  RStrTables = 'Tables';
//RStrViews = 'Views';
  RStrProcedures = 'Procedures';
  RStrTablePrivilegs = 'Table Privileges';
  RStrColumnPrivilegs = 'Column Privileges';
  RStrStatistics = 'Indexes';
  RStrColumns = 'Columns';
  RStrProcedureColumns = 'Procedure Columns';
  RStrPrimaryKeys = 'Primary Keys';
  RStrForeignKeys = 'Foreign Keys';
  RStrTypeInfo = 'Type Info';

  RStrfdtBit = 'Bool';
  RStrfdtInt8 = 'Int8';
  RStrfdtUInt8 = 'UInt8';
  RStrfdtInt16 = 'Int16';
  RStrfdtUInt16 = 'UInt16';
  RStrfdtInt32 = 'Int32';
  RStrfdtUInt32 = 'UInt32';
  RStrfdtInt64 = 'Int64';
  RStrfdtUInt64 = 'UInt64';
  RStrfdtSingle = 'Single';
  RStrfdtDouble = 'Double';
  RStrfdtNumeric = 'Numeric';
  RStrfdtDate = 'Date';
  RStrfdtTime = 'Time';
  RStrfdtDateTime = 'Datetime';
  RStrfdtAnsiString = 'String (Ansi)';
  RStrfdtWideString = 'String (Unicode)';
  RStrfdtAnsiMemo = 'Memo (Ansi)';
  RStrfdtWideMemo = 'Memo (Unicode)';
  RStrfdtBinary = 'Binary';
  RStrfdtGUID = 'GUID';

  RStrrsInactive = 'Inactive';
  RStrrsBrowsing = 'Browsing';
  RStrrsInserting = 'Inserting';
  RStrrsEditing = 'Editing';
  RStrrsUnknown = '<Unknown>';



const

  cStrCascadePropertyName = 'CascadedContentsProperties';
  cUpdatableStates = [Ord(rsInserting), Ord(rsEditing)];
  cGeneralOperationtypeName = 'TDBGeneralOperation';
//cGMBlobCompressionSignature: TGUID = '{DB81F896-A3C3-4e00-BE3A-98A594A2B7CC}';

  //cStrSchemaData = 'SchemaData'; // <- must match property name
  cStrSchemaList = 'TGMSchemaList';


  cOdbcSchemaNameColPos: array [TGMSchemaList] of Integer = (3, 3, 4, 4, 6, 6, 12, 6, 7, 1, -1);

  //cSqlSortOrderNames: array [TGMSortOrder] of TGMString = ('', cSqlAsc, cSqlDesc);

  cEnableNotify: array [Boolean] of Integer = (Ord(rgNone), Ord(rgRefeshComplete));


var

  vDBWaitCursor: TGMCursor = crWait;
  vSQLDatTimeFmtStr: TGMString = '"''"yyyy"-"mm"-"dd"T"hh":"nn":"ss"."zzz"''"';


resourcestring

  srNotInUpdatableState = 'Not in updatable state';
  srTreeDesignDisplayFmt = 'Table:'#9'%s'#13#13'Key:'#9'%s'#13'Parent:'#9'%s'#13'Title:'#9'%s'#13'Image:'#9'%s'#13'Selected:'#9'%s'#13'State:'#9'%s';
  srUnresolvedParams = 'Failed to prepare the SQL Statement because the following Parameters are unresolved or have no Value assigned to them: ';
  srNoBlobField = 'BLOB Data Interfaces can only be used with BLOB Fields';
  srNoValue = 'The Value cannot be used with BLOB fields. Use the BLOB Data Interfaces instead';
  srConfirmRecordDeletion = 'Delete current record';
  srConfirmMultipleDelete = 'Delete %d records';
  srConfirmDeleteCascaded = 'Delete current record and all cascaded records ?';
  srBinaryDataFmt = '<binary data: %s byte>';
  srCnStrEmpty = 'The connection TGMString is empty';
//RStrOnlyModfifiyngSQL = 'Only Modifying SQL Statements can be executed with this Component.';
//RStrNoModfifiyngSQL = 'Only SQL SELECT Statements can be executed with this Component.';
  srNoSQLKeyValues = 'No Key values found';
  srSQLIsEmpty = 'The SQL text of the statement is empty';
  //RStrCascadeInfoIncomplete = 'Cascading Information is incomplete';


implementation

{$IFDEF JEDIAPI}uses jwaWinError, jwaWinUser;{$ENDIF}


resourcestring

  srInvalidSQLVariantFmt = 'Union-Value type "%s" cannot be expressed as SQL literal';
  srParamNameNotFound = 'A parameter with name ''%s'' doesn''t exist';
  //RStrNoFieldTypeForVarType = 'Union-Value type "%s" cannot be mapped on any field data type';
  srAskContinueDeletion = 'Continue deleting remaining records';
  srValueNameNotFound = 'A value with name ''%s'' doesn''t exist';
  srUnableBuildCountSQL = 'Unable to build "SELECT Count(*)" SQL';
  //RStrBlobData = '<Binary BLOB Data>';
  //RStrFixedBufSizeViolation = 'Requested value buffer size (%d Bytes) of fixed buffer is larger than current buffer size (%d Bytes)';



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

function GMDbColDataTypeOfUnionValue(const AValue: RGMUnionValue): TGMDBColumnDataType;
begin
  case AValue.ValueType of
   //uvtUnassigned, uvtNull: Result := fdtUnknown;
   uvtString: Result := {$IFDEF UNICODE}fdtUnicodeString{$ELSE}fdtAnsiString{$ENDIF};
   uvtBoolean: Result := fdtBoolean;
   uvtInt16: Result := fdtInt16;
   uvtInt32: Result := fdtInt32;
   uvtInt64: Result := fdtInt64;
   uvtDouble: Result := fdtDouble;
   uvtDateTime: Result := fdtDateTime;
   //uvtPointer
   else Result := fdtUnknown;
  end;
end;

function IsIntegerFieldDataType(const AFieldDataType: TGMDBColumnDataType): Boolean;
begin
  Result := AFieldDataType in cIntegerFieldDataTypes;
end;

function IsStreamedFieldDataType(const AFieldDataType: TGMDBColumnDataType): Boolean;
begin
  Result := AFieldDataType in cStreamedFieldDataTypes;
end;

function IsTextFieldDataType(const AFieldDataType: TGMDBColumnDataType): Boolean;
begin
  Result := AFieldDataType in cMemoFieldDataTypes;
end;

function IsStringFieldDataType(const AFieldDataType: TGMDBColumnDataType): Boolean;
begin
  Result := AFieldDataType in cStringFieldDataTypes;
end;

function IsFixedLengthDataType(const AFieldDataType: TGMDBColumnDataType): Boolean;
begin
  Result := not (AFieldDataType in cVariableLengthDataTypes);
end;

function IsSortableDataType(const AFieldDataType: TGMDBColumnDataType): Boolean;
begin
  Result := not (AFieldDataType in cStreamedFieldDataTypes);
end;

function DataTypeCanEditAsString(const AFieldDataType: TGMDBColumnDataType): Boolean;
begin
  Result := AFieldDataType <> fdtBinary;
end;

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

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

procedure GMCallSinkAfterSQLChange(const NotifySink: IUnknown; const Params: array of OleVariant);
var Sink: IGMSQLChangeNotifications;
begin
  if GMQueryInterface(NotifySink, IGMSQLChangeNotifications, Sink) then try Sink.AfterSQLChange; except end;
end;

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

//function ReadNextSQLChar(var AChPos: PtrInt; const ASQLText: TGMString; var AChar: TGMChar): Boolean;
//var nextCh, lastCh: TGMChar; inLineComment, inComment1: Boolean;
//begin
//Result := False; inLineComment := False; inComment1 := False;
//while AChPos <= Length(ASQLText) do
// begin
//  AChar := ASQLText[AChPos];
//  Inc(AChPos);
//
//  if inLineComment then
//   begin
//    inLineComment := (AChar <> #10) and (AChar <> #13); if inLineComment then Continue;
//   end
//  else
//  if inComment1 then
//   begin
//    if AChPos-2 >= 1 then lastCh := ASQLText[AChPos-2] else lastCh := #0;
//    inComment1 := (lastCh <> '*') or (AChar <> '/');
//    Continue;
//   end
//  else
//   begin
//    if AChPos < Length(ASQLText) then nextCh := ASQLText[AChPos+1] else nextCh := #0;
//    case AChar of
//     '-': if nextCh = '-' then begin inLineComment := True; Continue; end;
//     '/': if nextCh = '*' then begin inComment1 := True; Continue; end;
//    end;
//
//    Result := True;
//    Break;
//   end;
//  end;
//end;

//function GMStripSQLComments(const ASQLText: TGMString): TGMString;
//var chPos, resultChPos: PtrInt; inLineComment1, inLineComment2, inComment1: Boolean; lastCh, ch, nextCh: TGMChar;
//begin
//  Result := ''; inLineComment1 := False; inLineComment2 := False; inComment1 := False; lastCh := #0;
//  resultChPos := 1;
//
//  for chPos:=1 to Length(ASQLText) do
//   begin
//    ch := ASQLText[chPos];
//
//    if inLineComment1 then inLineComment1 := (ch <> #10) and (ch <> #13)
//    else
//    if inLineComment2 then inLineComment2 := (ch <> #10) and (ch <> #13)
//    else
//    if inComment1 then begin inComment1 := (lastCh <> '*') or (ch <> '/'); lastCh := ch; Continue; end
//    else
//     begin
//      if chPos < Length(ASQLText) then nextCh := ASQLText[chPos+1] else nextCh := #0;
//      case ch of
//       '-': inLineComment1 := nextCh = '-';
//       '/': begin inComment1 := nextCh = '*'; inLineComment2 := nextCh = '/'; end;
//      end;
//     end;
//
//    if not (inLineComment1 or inLineComment2 or inComment1) then Result := Result + ch;
//    lastCh := ch;
//   end;
//end;

function GMStripSQLComments(const ASQLText: TGMString): TGMString;
var chPos, resultChPos: PtrInt; inLineComment1, inLineComment2, inComment1: Boolean; lastCh, ch, nextCh: TGMChar;
begin
  SetLength(Result, Length(ASQLText));
  inLineComment1 := False; inLineComment2 := False; inComment1 := False; lastCh := #0;
  resultChPos := 1;

  for chPos:=1 to Length(ASQLText) do
   begin
    ch := ASQLText[chPos];

    if inLineComment1 then inLineComment1 := (ch <> #10) and (ch <> #13)
    else
    if inLineComment2 then inLineComment2 := (ch <> #10) and (ch <> #13)
    else
    if inComment1 then begin inComment1 := (lastCh <> '*') or (ch <> '/'); lastCh := ch; Continue; end
    else
     begin
      if chPos < Length(ASQLText) then nextCh := ASQLText[chPos+1] else nextCh := #0;
      case ch of
       '-': inLineComment1 := nextCh = '-';
       '/': begin inComment1 := nextCh = '*'; inLineComment2 := nextCh = '/'; end;
      end;
     end;

    if not (inLineComment1 or inLineComment2 or inComment1) then begin Result[resultChPos] := ch; Inc(resultChPos); end;
    lastCh := ch;
   end;
  SetLength(Result, resultChPos-1);
end;

//function SkipSQLCommentsCharPos(AChPos: PtrInt; const ASQLText: TGMString): PtrInt;
//var ch, nextCh, lastCh: TGMChar; inLineComment, inComment1: Boolean;
//begin
//Result := AChPos;
//inLineComment := False; inComment1 := False;
//while AChPos <= Length(ASQLText) do
// begin
//  ch := ASQLText[AChPos];
//
//  if inLineComment then
//   begin
//    inLineComment := (ch <> #10) and (ch <> #13); if inLineComment then begin Inc(AChPos); Continue; end;
//   end
//  else
//  if inComment1 then
//   begin
//    if AChPos-1 >= 1 then lastCh := ASQLText[AChPos-1] else lastCh := #0;
//    inComment1 := (lastCh <> '*') or (ch <> '/');
//    Inc(AChPos);
//    Continue;
//   end
//  else
//   begin
//    if AChPos < Length(ASQLText) then nextCh := ASQLText[AChPos+1] else nextCh := #0;
//    case ch of
//     '-': if nextCh = '-' then begin inLineComment := True; Inc(AChPos, 2); Continue; end;
//     '/': if nextCh = '*' then begin inComment1 := True; Inc(AChPos, 2); Continue; end;
//    end;
//
//    Result := AChPos;
//    Break;
//   end;
// end;
//end;

function GMNextSQLToken(var AChPos: PtrInt; const ASQLText, ASeparators: TGMString): TGMString;
var startPos: Integer; inSquareBrackets, inSingleQuotes, inDblQuotes, inGravisQuotes: Boolean;
  procedure SkipSeparators;
  begin
    while (AChPos <= Length(ASQLText)) and GMIsDelimiter(ASeparators, ASQLText, AChPos) do Inc(AChPos);
  end;
begin
  if AChPos < 1 then AChPos := 1;
  SkipSeparators;
  startPos := AChPos; inSquareBrackets := False; inDblQuotes := False; inSingleQuotes := False; inGravisQuotes := False;

  //for chPos:=1 to Length(ASQLText) do
  while AChPos <= Length(ASQLText) do
   begin
    case ASQLText[AChPos] of
     '[': inSquareBrackets := True;
     ']': inSquareBrackets := False;
     '"': inDblQuotes := not inDblQuotes;
     '`': inGravisQuotes := not inGravisQuotes;
     '''': inSingleQuotes := not inSingleQuotes;
     else if not (inSquareBrackets or inDblQuotes or inSingleQuotes or inGravisQuotes) and
                 GMIsDelimiter(ASeparators, ASQLText, AChPos) then Break;
    end;

    Inc(AChPos);
//  AChPos := SkipSQLCommentsCharPos(AChPos+1, ASQLText);
   end;

  if AChPos > startPos then Result := System.Copy(ASQLText, startPos, AChPos-startPos) else Result := '';
//SkipSeparators;
//while (AChPos <= Length(ASQLText)) and GMIsDelimiter(ASeparators, ASQLText, AChPos) do AChPos := SkipSQLCommentsCharPos(AChPos+1, ASQLText);
end;

function GMPreviousSQLToken(var AChPos: PtrInt; const ASQLText, ASeparators: TGMString; const ASkipTrailingSeparators: Boolean = True): TGMString;
var endPos: Integer; inSquareBrackets, inSingleQuotes, inDblQuotes, inGravisQuotes: Boolean;
  procedure SkipSeparators;
  begin
//  AChPos := SkipSQLCommentsCharPos(AChPos, ASQLText); // cWhiteSpace
    while (AChPos >= 1) and GMIsDelimiter(ASeparators, ASQLText, AChPos) do Dec(AChPos); // AChPos := SkipSQLCommentsCharPos(AChPos+1, ASQLText);
  end;
begin
  if AChPos > Length(ASQLText) then AChPos := Length(ASQLText);
  if ASkipTrailingSeparators then SkipSeparators;
  endPos := AChPos; inSquareBrackets := False; inDblQuotes := False; inSingleQuotes := False; inGravisQuotes := False;

  while AChPos >= 1 do
   begin
    case ASQLText[AChPos] of
     '[': inSquareBrackets := False;
     ']': inSquareBrackets := True;
     '"': inDblQuotes := not inDblQuotes;
     '`': inGravisQuotes := not inGravisQuotes;
     '''': inSingleQuotes := not inSingleQuotes;
     else if not (inSquareBrackets or inDblQuotes or inSingleQuotes or inGravisQuotes) and
                 GMIsDelimiter(ASeparators, ASQLText, AChPos) then Break;
    end;

    Dec(AChPos);
//  AChPos := SkipSQLCommentsCharPos(AChPos+1, ASQLText);
   end;

  if AChPos < endPos then Result := System.Copy(ASQLText, AChPos+1, endPos-AChPos) else Result := '';
//SkipSeparators;
//while (AChPos <= Length(ASQLText)) and GMIsDelimiter(ASeparators, ASQLText, AChPos) do AChPos := SkipSQLCommentsCharPos(AChPos+1, ASQLText);
end;

function GMNextSqlStatement(var AChPos: PtrInt; const ASQLText: TGMString): TGMString;
begin
//if not GMIsInRange(AChPos, 1, Length(ASQLText)) then begin Result := ''; Exit; end;
  if AChPos < 1 then AChPos := 1;
  while (AChPos <= Length(ASQLText)) and (ASQLText[AChPos] = cSQLStmtTerm) do Inc(AChPos); // (AChPos <= Length(ASQLText))
  Result := GMNextSQLToken(AChPos, ASQLText, cSQLStmtTerm);
end;

function GMPreviousSqlStatement(var AChPos: PtrInt; const ASQLText: TGMString): TGMString;
begin
  //if not GMIsInRange(AChPos, 1, Length(ASQLText)) then begin Result := ''; Exit; end;
  if AChPos > Length(ASQLText) then AChPos := Length(ASQLText);
  while (AChPos >= 1) and (ASQLText[AChPos] = cSQLStmtTerm) do Dec(AChPos);
  Result := GMPreviousSQLToken(AChPos, ASQLText, cSQLStmtTerm);
end;

function GMLastSqlStatement(const ASQLText: TGMString; const AKind: TGMSqlStatementKind): TGMString;
var chPos: PtrInt; stmt: TGMString;
begin
  chPos := Length(ASQLText);
  repeat
   stmt := GMPreviousSqlStatement(chPos, ASQLText);
  until (chPos < 1) or (GMSqlStatmentKind(stmt) = AKind); // (Length(stmt) <= 0)
  Result := stmt;
end;

//function GMNextSqlStatement(var AChPos: Integer; const ASqlStatements: TGMString): TGMString;
//var pStart, pEnd: PGMChar;
//begin
//if not GMIsInRange(AChPos, 1, Length(ASqlStatements)) then begin Result := ''; Exit; end;
//
//while (AChPos <= Length(ASqlStatements)) and (ASqlStatements[AChPos] = ';') do Inc(AChPos);
//
//pStart := @ASqlStatements[AChPos];
//pEnd := GMStrLScan(pStart, ';', Length(ASqlStatements));
//if pEnd = nil then Result := ASqlStatements else
//   Result := Copy(ASqlStatements, AChPos, pEnd - pStart);
//Inc(AChPos, Length(Result));
//end;

function GMSqlStatmentKind(const ASQLText: TGMString): TGMSqlStatementKind;
//const separators = cSqlSeparators + cSqlOperators;
var firstToken: TGMString; chPos: PtrInt;

  function IsWhiteSpace(AChar: TGMChar): Boolean;
  begin
    case AChar of
     ' ', #9, #10, #13: Result := True;
     else Result := False;
    end;
  end;

  function ParseForFirstToken: TGMString;
  var chPos, resultChPos: PtrInt; inLineComment1, inLineComment2, inComment1: Boolean; lastCh, ch, nextCh: TGMChar; leadingWS: Boolean;
  begin
    Result := ''; inLineComment1 := False; inLineComment2 := False; inComment1 := False; lastCh := #0;
    resultChPos := 1; leadingWS := True;

    for chPos:=1 to Length(ASQLText) do
     begin
      ch := ASQLText[chPos];

      if inLineComment1 then inLineComment1 := (ch <> #10) and (ch <> #13)
      else
      if inLineComment2 then inLineComment2 := (ch <> #10) and (ch <> #13)
      else
      if inComment1 then begin inComment1 := (lastCh <> '*') or (ch <> '/'); lastCh := ch; Continue; end
      else
       begin
        if chPos < Length(ASQLText) then nextCh := ASQLText[chPos+1] else nextCh := #0;
        case ch of
         '-': inLineComment1 := nextCh = '-';
         '/': begin inComment1 := nextCh = '*'; inLineComment2 := nextCh = '/'; end;
        end;
       end;
      // Not a comment => then process it ..
      if not (inLineComment1 or inLineComment2 or inComment1) then
       begin
        if leadingWS then leadingWS := IsWhiteSpace(ch);

        if not leadingWS then
         if IsWhiteSpace(ch) then break else Result := Result + ch;
       end;

      lastCh := ch;
     end;
  end;

begin
  chPos := 1;
  //firstToken := GMStrip(GMNextSQLToken(chPos, GMStripSQLComments(ASQLText), separators), separators);
  firstToken := ParseForFirstToken;

  if Length(firstToken) <= 0 then Result := skUnknown
  else
  //if GMSameText(firstToken, cSqlSelect) or GMSameText(firstToken, 'VALUES') or GMSameText(firstToken, 'WITH') then Result := skSelect
  if GMIsOneOfStrings(firstToken, [cSqlSelect, 'VALUES', 'WITH']) then Result := skSelect
  else
  if GMSameText(firstToken, cSqlSet) then Result := skSetting
  else
  if GMSameText(firstToken, cSqlExecute) then Result := skExecute
  else
  if GMSameText(firstToken, cSqlInsert) then Result := skInsert
  else
  if GMSameText(firstToken, cSqlUpdate) then Result := skUpdate
  else
  if GMSameText(firstToken, cSqlDelete) then Result := skDelete
  else
//if GMIsOneOfStrings(firstToken, [cSqlInsert, cSqlUpdate, cSqlDelete]) then Result := skDataModify
//else
  if GMIsOneOfStrings(firstToken, [cSqlCreate, cSqlAlter, cSqlDrop]) then Result := skDDL
  else Result := skUnknown;
end;

function GMIterateAllSqlStatements(const ASqlText: TGMString; const ASqlStmtVisitFunc: TGMSqlStmtVisitFunc; const AOpaqueAppData: Pointer): Integer;
var chPos: PtrInt; sql: TGMString;
begin
  Result := 0;
  if not Assigned(ASqlStmtVisitFunc) then Exit;

  chPos := 1; sql := '';
  while chPos <= Length(ASqlText) do
   begin
    sql := GMStrip(GMNextSqlStatement(chPos, ASqlText), cWhiteSpace + cSQLStmtTerm);
    if Length(sql) > 0 then
     begin
      if not ASqlStmtVisitFunc(sql, AOpaqueAppData) then Break;
      Inc(Result);
     end;
   end;
end;

function GMEmptyStrAsNil(const AValue: TGMString): TGMString;
begin
  if Length(AValue) > 0 then Result := AValue else Result := cStrNil;
end;

function IsSelectSQL(const ASQLText: TGMString): Boolean;
begin
  Result := GMSqlStatmentKind(ASQLText) = skSelect;
end;

function GMExtractNameFromConnectionString(const AConnectionString: TGMString): TGMString;
var CnStrParser: IGMValueStorage;
begin
  CnStrParser := TGMConnectionStringStorage.Create(AConnectionString, True);
  Result := CnStrParser.ReadString(cStrCnStrDSN);
  if Result = '' then Result := CnStrParser.ReadString(cStrCnStrFileDSN);
  if Result = '' then Result := CnStrParser.ReadString(cSTrCnStrDatabase);
  if Result = '' then Result := GMExtractFileName(CnStrParser.ReadString(cStrCnStrDBQ));
  if Result = '' then Result := GMExtractFileName(GMStripRight(CnStrParser.ReadString(cStrCnDir), cDirSep));
  if Result = '' then Result := GMExtractFileName(GMStripRight(CnStrParser.ReadString(cStrCnDefaultDir), cDirSep));
end;

function GMRecordsetAttributeName(const ARSAttribute: TGMRecordsetAttribute): TGMString;
begin
  case ARSAttribute of
   raAutoSaveChanges:      Result := RStrAutoSaveChanges;
   raAutoEdit:             Result := RStrAutoEdit;
   raConfrimDeletions:     Result := RStrConfrimDeletions;
   raExposeBookmarkColumn: Result := RStrExposeBookmarkColumn;
   raBookmarksEnabled:     Result := RStrBookmarksEnabled;
   raStripTrailingBlanks:  Result := RStrStripTrailingBlanks;
   else Result := '';
  end;
end;

function GMRSOperationName(const ARSOperation: TGMRecordsetOperation): TGMString;
begin
  case ARSOperation of
   roEdit: Result := RStRroEdit;
   roInsert: Result := RStRroInsert;
   roDelete: Result := RStRroDelete;
   roCancelChanges: Result := RStRroCancelChanges;
   roApplyChanges: Result := RStRroApplyChanges;
   roRefreshCurrent: Result := RStRroRefreshCurrent;
   roReExecuteStatement: Result := RStRroReExecuteStatement;
   roScheduleReExecution: Result := RStRroScheduleReExecution;
   roLeaveModifyingState: Result := RStRroLeaveModifyingState;
   roSetSimplestConfiguration: Result := RStRroSetSimplestConfiguration;
   else Result := '';
  end;
end;

function GMSchemaListName(const ASchemList: TGMSchemaList): TGMString;
begin
  case ASchemList of
// slSystemTables: Result := RStrSystemTables;
   slTables: Result := RStrTables;
// slViews: Result := RStrViews;
   slProcedures: Result := RStrProcedures;
   slTablePrivileges: Result := RStrTablePrivilegs;
   slColumnPrivileges: Result := RStrColumnPrivilegs;
   slStatistics: Result := RStrStatistics;
   slColumns: Result := RStrColumns;
   slProcedureColumns: Result := RStrProcedureColumns;
   slPrimaryKeys: Result := RStrPrimaryKeys;
   slForeignKeys: Result := RStrForeignKeys;
   slTypeInfo: Result := RStrTypeInfo;
   else Result := '';
  end;
end;

function GMFieldDataTypeName(const AFieldDataType: TGMDBColumnDataType): TGMString;
begin
  case AFieldDataType of
   fdtBoolean: Result := RStrfdtBit;
   fdtInt8: Result := RStrfdtInt8;
   fdtUInt8: Result := RStrfdtUInt8;
   fdtInt16: Result := RStrfdtInt16;
   fdtUInt16: Result := RStrfdtUInt16;
   fdtInt32: Result := RStrfdtInt32;
   fdtUInt32: Result := RStrfdtUInt32;
   fdtInt64: Result := RStrfdtInt64;
   fdtUInt64: Result := RStrfdtUInt64;
   fdtSingle: Result := RStrfdtSingle;
   fdtDouble: Result := RStrfdtDouble;
   fdtNumeric: Result := RStrfdtNumeric;
   fdtDate: Result := RStrfdtDate;
   fdtTime: Result := RStrfdtTime;
   fdtDateTime: Result := RStrfdtDateTime;
   fdtAnsiString: Result := RStrfdtAnsiString;
   fdtUnicodeString: Result := RStrfdtWideString;
   fdtAnsiText: Result := RStrfdtAnsiMemo;
   fdtUnicodeText: Result := RStrfdtWideMemo;
   fdtBinary: Result := RStrfdtBinary;
   fdtGUID: Result := RStrfdtGUID;
   else Result := '';
  end;
end;

function GMRecordsetStateName(const ARSState: TGMRecordsetState): TGMString;
begin
  case ARSState of
   rsInactive: Result := RStrrsInactive;
   rsBrowsing: Result := RStrrsBrowsing;
   rsInserting: Result := RStrrsInserting;
   rsEditing: Result := RStrrsEditing;
   else Result := RStrrsUnknown;
  end;
end;

//function GMReplaceDSNInConnectionString(const ConnectionString, NewDSN: TGMString): TGMString;
////var CnStrParser: IGMValueStorage; PIAsString: IGMGetText;
//begin
//  //CnStrParser := TGMConnectionStringStorage.Create(ConnectionString, True);
//  //CnStrParser.WriteString(cStrCnStrDSN, NewDSN);
//  //GMCheckQueryInterface(CnStrParser, IGMGetText, PIAsString, {$I %CurrentRoutine%});
//  //Result := PIAsString.AsString;
//  Result := GMAddOrReplaceValueInConnectionString(ConnectionString, cStrCnStrDSN, NewDSN);
//end;

function GMAddOrReplaceValueInConnectionString(const ConnectionString, ValueName, Value: TGMString): TGMString;
var CnStrParser: IGMValueStorage; PIText: IGMGetText;
begin
  CnStrParser := TGMConnectionStringStorage.Create(ConnectionString, True);
  CnStrParser.WriteString(ValueName, Value);
  GMCheckQueryInterface(CnStrParser, IGMGetText, PIText, {$I %CurrentRoutine%});
  Result := PIText.Text;
end;

{function GMCompareConnectionStrings(const ConnectionStr1, ConnectionStr2: TGMString; const CompareKind: TConnectionStrCompareKind = cnpLazyMatch): Boolean;
var CnStrParser1, CnStrParser2: IGMValueStorage; i: Integer;
begin
  CnStrParser1 := TGMConnectionStringStorage.Create(ConnectionStr1, True);
  CnStrParser2 := TGMConnectionStringStorage.Create(ConnectionStr2, True);

  case CompareKind of
   cnpExactMatch:
    begin
     Result := True;
     for i:=0 to CnStrParser1.Count-1 do
      if GMSameText(CnStrParser1.ReadString[CnStrParser1.Names[i]], CnStrParser2.Values[CnStrParser1.Names[i]]) <> 0 then
       begin Result := False; Break; end;

     if Result then
      for i:=0 to CnStrParser2.Count-1 do
       if GMSameText(CnStrParser1.Values[CnStrParser2.Names[i]], CnStrParser2.Values[CnStrParser2.Names[i]]) <> 0 then
        begin Result := False; Break; end;
    end;

   cnpLazyMatch: Result := (GMSameText(CnStrParser1.Values[cStrCnStrDSN], CnStrParser2.Values[cStrCnStrDSN]) = 0) or
                           (GMSameText(CnStrParser1.Values[cStrCnStrFileDSN], CnStrParser2.Values[cStrCnStrFileDSN]) = 0);
   else Result := False;
  end;
end;}

procedure SetupDSNStringBounds(const ADSN: TGMString; var C1, C2: Integer);
begin
  C1 := Pos(':', ADSN);
  if C1 = 0 then C1 := 1 else Inc(C1);
  C2 := Pos('[', ADSN);
  if C2 = 0 then C2 := Length(ADSN) + 1;
end;

function ExtractDSNFromDisplayName(const ADSNDisplayName: TGMString): TGMString;
var C1, C2: Integer;
begin
  SetupDSNStringBounds(ADSNDisplayName, C1, C2);
  Result := GMStrip(Copy(ADSNDisplayName, C1, C2 - C1), cWhiteSpace + '"');
end;

//function IsAggregatSelectList(const SQLSelectList: TGMString): Boolean;
//var chPos: Integer; Token: TGMString;
//begin
//if SQLSelectList = '' then Result := False else
// begin
//  Result := True; chPos := 1;
//  repeat
//   Token := GMFirstWord(GMNextWord(chPos, SQLSelectList, cFieldListSeparators), cSqlSeparators);
//   if Token <> '' then Result := Result and GMIsOneOfStrings(Token, cSqlAggregatFunctions);
//  until (Token = '') or not Result;
// end;
//end;

//function GMVarTypeOfDataType(const AFieldDataType: TGMDBColumnDataType; const ACallingName: TGMString): Integer;
//begin
//  case AFieldDataType of
//   fdtBoolean: Result := varBoolean;
//   fdtInt8:    Result := varshortint;
//   fdtUInt8:   Result := varByte;
//   fdtInt16:   Result := varSmallInt;
//   fdtUInt16:  Result := varWord;
//   fdtInt32:   Result := varInteger;
//   fdtUInt32:  Result := varLongword;
//   fdtInt64:   Result := varInt64;
//   {$IFDEF DELPHI9}
//   fdtUInt64:  Result := varQword;
//   {$ELSE}
//   fdtUInt64:  Result := varInt64;
//   {$ENDIF}
//   fdtSingle: Result := varSingle;
//   fdtDouble, fdtNumeric: Result := varDouble;
//   fdtDate, fdtTime, fdtDateTime: Result := varDate;
//   fdtAnsiString, fdtAnsiText, fdtGUID: Result := varString;
//   fdtUnicodeString, fdtUnicodeText: Result := varOleStr;
//   else raise EGMException.ObjError(MsgUnsupportedFieldDataType(Ord(AFieldDataType)), nil, ACallingName);
//  end;
//end;

//function GMDataTypeOfVarType(const AVarType: Integer; const ACallingName: TGMString): TGMDBColumnDataType;
//  procedure VarTypeError;
//  begin
//    raise EGMException.ObjError(GMFormat(RStrNoFieldTypeForVarType, [VarTypeAsText(AVarType)]), nil, ACallingName);
//  end;
//begin
//  if (AVarType and varArray <> 0) or (AVarType and varByRef <> 0) then VarTypeError;
//
//  case AVarType and varTypeMask of
//   varNull, varEmpty: Result := fdtUnknown;
//   varshortint:  Result := fdtInt8;
//   varByte:      Result := fdtUInt8;
//   varSmallint:  Result := fdtInt16;
//   varWord:      Result := fdtUInt16;
//   varInteger:   Result := fdtInt32;
//   varLongword:  Result := fdtUInt32;
//   varInt64:     Result := fdtInt64;
//   varString:    Result := fdtAnsiString;
//   {$IFDEF DELPHI9}
//   varQword:     Result := fdtUInt64;
//   varUString:   Result := fdtUnicodeString;
//   {$ENDIF}
//   varSingle:    Result := fdtSingle;
//   varDouble:    Result := fdtDouble;
//   varCurrency:  Result := fdtDouble;
//   varDate:      Result := fdtDateTime;
//   varOleStr:    Result := fdtUnicodeString;
//   varBoolean:   Result := fdtBoolean;
//   varStrArg:    Result := fdtGUID;
//   else begin VarTypeError; Result := fdtUnknown; end; // <- avoid compiler warning
//  end;
//end;

function GMUnionTypeOfDbDataType(const ADbDataType: TGMDBColumnDataType): EGMUnionValueType;
begin
  case ADbDataType of
   fdtBoolean: Result := uvtBoolean;
   fdtInt8, fdtUInt8, fdtInt16: Result := uvtInt16;
   fdtUInt16, fdtInt32: Result := UvtInt32;
   fdtUInt32, fdtInt64: Result := uvtInt64;
   {$IFDEF DELPHI9}
   fdtUInt64:  Result := uvtInt64;
   {$ELSE}
   fdtUInt64:  Result := uvtInt64;
   {$ENDIF}
   fdtSingle, fdtDouble, fdtNumeric: Result := uvtDouble;
   fdtDate, fdtTime, fdtDateTime: Result := uvtDatetime;
   fdtAnsiString, fdtAnsiText, fdtGUID, fdtUnicodeString, fdtUnicodeText: Result := uvtString;
   fdtBinary: Result := uvtPointer;
   else Result := uvtUnassigned;
   //else raise EGMException.ObjError(MsgUnsupportedFieldDataType(Ord(ADbDataType)), nil, ACallingName);
  end;
end;

function GMDbDataTypeOfUnionType(const AValueType: EGMUnionValueType): TGMDBColumnDataType;
begin
  case AValueType of
   //uvtUnassigned, uvtNull: Result := fdtUnknown;
   uvtString: {$IFDEF UNICODE}Result := fdtUnicodeString;{$ELSE}Result := fdtAnsiString;{$ENDIF}
   uvtBoolean: Result := fdtBoolean;
   uvtInt16: Result := fdtInt16;
   uvtInt32: Result := fdtInt32;
   uvtInt64: Result := fdtInt64;
   uvtDouble: Result := fdtDouble;
   uvtDateTime: Result := fdtDateTime;
   uvtPointer: Result := fdtBinary;
   else Result := fdtUnknown
  end;
end;


function IsUpdatableState(const State: Longword): Boolean;
begin
  Result := State in cUpdatableStates;
end;

function NameAndValueMatch(const FieldName: TGMString; const FieldValue: RGMUnionValue; const MatchKind: TMatchKind = GMIntf.mkExactMatch; const MatchCase: Boolean = True): TNameAndValueMatch;
//var vt: LongInt;
begin
  //vt := VarType(FieldValue);
  Result.Name := FieldName;
  Result.Value := FieldValue;
  Result.MatchKind := MatchKind;
  Result.MatchCase := MatchCase;
end;

//function GMCompressedBlobHeaderData(const DataSize: LongWord = 0): TGMCompressedBlobHeaderData;
//begin
//Result.DataSize := DataSize;
//Result.Guid := CGMBlobCompressionSignature;
//Result.Reserved := 0;
//end;

//function GMIsCompressedBlobHeaderData(const Data: TGMCompressedBlobHeaderData): Boolean;
//begin
//Result := IsEqualGUID(CGMBlobCompressionSignature, Data.Guid);
//end;

function GMValueBufferSizeOfFieldDataType(const FieldDataType: TGMDBColumnDataType): Integer;
begin
  case FieldDataType of
   fdtBoolean:                    Result := SizeOf(Boolean);
   fdtInt8, fdtUInt8:             Result := SizeOf(Byte);
   fdtInt16, fdtUInt16:           Result := SizeOf(SmallInt);
   fdtInt32, fdtUInt32:           Result := SizeOf(LongInt);
   fdtInt64, fdtUInt64:           Result := SizeOf(Int64);
   fdtSingle:                     Result := SizeOf(Single);
   fdtDouble, fdtNumeric:         Result := SizeOf(Double);
   fdtDate, fdtTime, fdtDateTime: Result := SizeOf(TDateTime);
   fdtGUID:                       Result := SizeOf(TGUID);
   // fdtAnsiString, fdtUnicodeString, fdtAnsiText, fdtUnicodeText, fdtBinary:
   else Result := 0;
  end;
end;

function GMFieldDisplayWidth(const AFielDataType: TGMDBColumnDataType; const AMaxStrLength: PtrUInt): PtrInt;
const cMaxChars = cMaxFieldDisplayWidth div cAvgCharWidth;
begin
  case AFielDataType of
   fdtBoolean:            Result := 6;
   fdtInt8, fdtUInt8:     Result := 3;
   fdtInt16, fdtUInt16:   Result := 5;
   fdtInt32, fdtUInt32:   Result := 8;
   fdtInt64, fdtUInt64:   Result := 10;
   fdtSingle:             Result := 10;
   fdtDouble, fdtNumeric: Result := 12;
   fdtDate:               Result := 10;
   fdtTime:               Result := 8;
   fdtDateTime:           Result := 15;
   fdtAnsiText, fdtUnicodeText:  Result := cMaxChars;
   fdtGUID:               Result := 38;
   fdtBinary:             Result := cMaxChars;
   fdtAnsiString, fdtUnicodeString: if AMaxStrLength = 0 then Result := cMaxChars else Result := AMaxStrLength; // div SizeOf(AnsiChar));
// fdtUnicodeString:         if ASizeInBytes = 0 then Result := cMaxChars else Result := (ASizeInBytes div SizeOf(WideChar));
   else Result := cDfltFieldDisplayWidth div cAvgCharWidth;
  end;
  Result := GMBoundedInt(Result * cAvgCharWidth, cMinFieldDisplayWidth, cMaxFieldDisplayWidth);
end;

function GMFieldEditLength(const AFielDataType: TGMDBColumnDataType; const AMaxStrLength: PtrUInt): PtrUInt;
begin
  case AFielDataType of
   fdtBoolean:            Result := 6;
   fdtInt8, fdtUInt8:     Result := 3;
   fdtInt16, fdtUInt16:   Result := 5;
   fdtInt32, fdtUInt32:   Result := 10;
   fdtInt64, fdtUInt64:   Result := 20;
   fdtSingle:             Result := 10;
   fdtDouble, fdtNumeric: Result := 15;
   fdtDate:               Result := 20;
   fdtTime:               Result := 8;
   fdtDateTime:           Result := 30;
   fdtGUID:               Result := 40;
   fdtAnsiString, fdtUnicodeString: if AMaxStrLength = 0 then Result := 0 else Result := AMaxStrLength;
// fdtUnicodeString:         if AMaxStrLength = 0 then Result := (ASizeInBytes div SizeOf(WideChar)) else Result := AMaxStrLength;
   else Result := 0; // <- Unlimited
  end;
end;

function GMCharSizeInBytes(const AFieldDataType: TGMDBColumnDataType): Word;
begin
  case AFieldDataType of
   fdtAnsiString, fdtAnsiText: Result := SizeOf(AnsiChar);
   fdtUnicodeString, fdtUnicodeText: Result := SizeOf(WideChar);
   else Result := 0;
  end;
end;

function GMNullableYN(const AValue: TGMAllowNullValues): TGMString;
begin
  case AValue of
   nvNullValuesNotAllowed: Result := RStrNo;
   nvNullValuesAllowed: Result := RStrYes;
   else Result := '?';
  end;
end;

function GMNullableName(const AValue: TGMAllowNullValues): TGMString;
begin
  case AValue of
   nvNullValuesAllowed: Result := RStrNullAllowed;
   nvNullValuesNotAllowed: Result := RStrNotNull;
   else Result := '';
  end;
end;

function GMSortOrderDirectionName(const ASortOrderDirection: TGMSortOrderDirection): TGMString;
begin
  Case ASortOrderDirection of
   soAscending: Result := srAscending;
   soDescending: Result := srDescending;
   else Result := '';
  end;
end;

function GMAllowDuplicatesName(const AValue: TGMAllowDuplicates): TGMString;
begin
  case AValue of
   adDuplicatesAllowed: Result := RStrDuplicatesAlloed;
   adDuplicatesNotAllowed: Result := RStrUnique;
   else Result := '';
  end;
end;


//function DuplicateQuotes(const SQL: TGMString; const QuoteChar: TGMChar = cSqlStrQuoteChar): TGMString;
//var i,j: Integer;
//begin
//J:=0; Result := SQL;
//for i:=1 to Length(Result) do if Result[i+j] = QuoteChar then begin Insert(QuoteChar, Result, i+j); Inc(j); end;
//end;

function ExtractSQLSelectList(const ASQLText: TGMString): TGMString;
begin
  Result := GMFindTextPart(ASQLText, cSqlSeparators, [cSqlSelect, cSqlUpdate, cSqlInsert, cSqlDelete], [cSqlSet, cSqlValues, cSqlFrom, cSqlLeft, cSqlRight, cSqlInner, cSqlOuter, cSqlJoin, cSqlWhere, cSqlGroupBy, cSqlHaving, cSqlOrderBy, cSqlForUpdateOf], True);
end;

procedure GMCheckSQLNotEmpty(const SQL: TGMString; const Caller: TObject = nil; const CallingName: TGMString = '');
begin
  if GMStrip(SQL, cWhiteSpace) = '' then
     raise EGMException.ObjError(srSQLIsEmpty, Caller, BuildCallingName(CallingName, {$I %CurrentRoutine%}));
end;

function GMVarToConnectionStrLiteral(const AValue: RGMUnionValue): TGMString;
var pScan: PGMChar;
begin
  Result := AValue.AsStringDflt;
  pScan := GMStrLScan(PGMChar(Result), ';', Length(Result));
  if pScan <> nil then Result := GMQuote(Result, '{', '}'); // GMQuote(Result, '"', '"');
end;

function GMStringAsSqlLiteral(const AValue: TGMString; const AQuoteChar: TGMChar): TGMString;
var i,j: Integer;
begin
  J:=0; Result := AValue;
//for i:=1 to Length(Result) do if Result[i+j] = AQuoteChar then begin Insert('\', Result, i+j); Inc(j); end;
  for i:=1 to Length(Result) do if Result[i+j] = AQuoteChar then begin Insert(AQuoteChar, Result, i+j); Inc(j); end;
  Result := AQuoteChar + Result + AQuoteChar;
end;

function GMUnionValueAsSqlLiteral(const AValue: RGMUnionValue; ASQLFormatStrForDateTime: TGMString): TGMString;
  procedure Error;
  begin
    raise EGMException.ObjError(GMFormat(srInvalidSQLVariantFmt, [AValue.ValueTypeName]), nil, {$I %CurrentRoutine%});
  end;
begin
  case AValue.ValueType of
   uvtNull: Result := cStrNULL;

   uvtString:
    if GMIsGUID(AValue) then
     Result := AValue
    else
     Result := GMStringAsSqlLiteral(AValue, cSqlStrQuoteChar);

   uvtDateTime:
     if Length(ASQLFormatStrForDateTime) > 0 then
       Result := FormatDateTime(ASQLFormatStrForDateTime, AValue)
     else
       Result := FormatDateTime(vSQLDatTimeFmtStr, AValue);

   uvtDouble, uvtInt16, uvtInt32, uvtInt64, uvtBoolean: Result := AValue;
   //Result := GMReplaceChars(GMDeleteChars(AValue, '.'), ',', '.');
   else Error;
  end;
end;

function GMObjectIsInUpdatableState(const Intf: IUnknown): Boolean;
var PIState: IGMGetState;
begin
  if Intf = nil then Result := False else
   Result := (Intf.QueryInterface(IGMGetState, PIState) = S_OK) and IsUpdatableState(PIState.State);
end;

function GMObjectCanBeEdited(const Intf: IUnknown): Boolean;
var PICanExecOp: IGMCanExecuteOperation;
begin
  if Intf = nil then Result := False else
   Result := GMObjectIsInUpdatableState(Intf) or
             ((Intf.QueryInterface(IGMCanExecuteOperation, PICanExecOp) = S_OK) and
              ((GMIntfIsEmpty(Intf) and PICanExecOp.CanExecuteOperation(Ord(roInsert))) or
               (not GMIntfIsEmpty(Intf) and PICanExecOp.CanExecuteOperation(Ord(roEdit)))));
end;

function GMEditOrInsertIntf(const AIntf: IUnknown): Boolean;
var rsState: IGMGetState;
begin
  Result := False;
  if AIntf <> nil then
   begin
    GMCheckQueryInterface(AIntf, IGMGetState, rsState, {$I %CurrentRoutine%});
    Result := IsUpdatableState(rsState.State);
    if not Result then
     if GMIntfIsEmpty(AIntf) then
       Result := GMExecuteOperation(AIntf, Ord(roInsert))
     else
       Result := GMExecuteOperation(AIntf, Ord(roEdit));
   end;
end;

procedure GMCheckExecRSOperation(const Obj: TObject; const Operation: TGMRecordsetOperation; const CallingName: TGMString = ''; const Parameter: IUnknown = nil);
begin
  GMCheckExecOperation(Obj, Ord(Operation), GMRSOperationName(Operation), CallingName, Parameter);
end;

procedure GMCheckExecRSOperation(const Intf: IUnknown; const Operation: TGMRecordsetOperation; const CallingName: TGMString = ''; const Parameter: IUnknown = nil);
begin
  GMCheckExecOperation(Intf, Ord(Operation), GMRSOperationName(Operation), CallingName, Parameter);
end;

function ConvertStringToFieldType(const AValAsStr: TGMString; const ADbDataType: TGMDBColumnDataType): RGMUnionValue;
begin
  case ADbDataType of
   fdtBoolean: Result := GMStrToBool(AValAsStr);
   fdtInt8, fdtUInt8, fdtInt16, fdtUInt16, fdtInt32, fdtUInt32, fdtInt64, fdtUInt64: //Result := GMStrToInt(GMMakeDezInt(AValAsStr));
     Result := GMUnionValueAsType(GMMakeDezInt(AValAsStr), GMUnionTypeOfDbDataType(ADbDataType));

   fdtSingle, fdtDouble, fdtNumeric: Result := StrToFloat(AValAsStr);
   fdtDate, fdtTime, fdtDateTime:    Result := StrToDateTime(AValAsStr);
   fdtGUID, fdtAnsiString, fdtUnicodeString: Result := AValAsStr;
   else raise EGMException.ObjError(MsgUnsupportedFieldDataType(Ord(ADbDataType)), nil, {$I %CurrentRoutine%});
  end;
end;

function RecordsetStateAfterOperation(const AOperation: TGMRecordsetOperation; const AObj: TObject = nil): TGMRecordsetState;
begin
  case AOperation of
   roEdit: Result := rsEditing;
   roInsert: Result := rsInserting;
   roCancelChanges, roApplyChanges, roLeaveModifyingState, roRefreshCurrent, roReExecuteStatement, roScheduleReExecution, roDelete: Result := rsBrowsing;
   else raise EGMException.ObjError(MsgUnsupportedOperation(Ord(AOperation)), AObj, {$I %CurrentRoutine%});
  end;
end;

function GMExtractNextFieldName(var AChPos: PtrInt; const FieldNames: TGMString): TGMString;
begin
  Result := GMStrip(GMNextSQLToken(AChPos, FieldNames, cSqlSeparators + cSqlOperators), cSqlSeparators + cSqlOperators);
end;

function GMExtractTableName(const ASQLText: TGMString): TGMString;
begin
  Result := GMFindTextPart(ASQLText, cSqlSeparators, [cSqlUpdate, cSqlInto, cSqlFrom], [cSqlSet, cSqlValues, cSqlLeft, cSqlRight, cSqlInner, cSqlOuter, cSqlJoin, cSqlWhere, cSqlGroupBy, cSqlHaving, cSqlOrderBy, cSqlForUpdateOf], True);
end;

//function GMExtractTableName(const SQL: TGMString): TGMString;
//var SQLPartitioner: IGMGetTableName;
//begin
//  SQLStrings := TStringList.Create;
//  try
//   SQLStrings.Text := SQL;
//   SQLPartitioner := TGMSQLStatmentPartitioner.Create(nil, SQLStrings, nil, True);
//   Result := SQLPartitioner.TableName;
//  finally
//   SQLStrings.Free;
//  end;
//end;

function GMBuildSQLDelete(ATableName: TGMString; const AWhere: TGMString = ''): TGMString;
begin
  ATableName := cSqlIdQuoteCh + GMStrip(ATableName, cSqlIdQuoteCh) + cSqlIdQuoteCh;
  if ATableName <> '' then
   begin
    Result := GMFormat('%s %s %s', [cSqlDelete, cSqlFrom, ATableName]);
    if AWhere <> '' then Result := GMFormat('%s %s %s', [Result, cSqlWhere, GMStrip(AWhere, ';')]);
    Result := Result + ';';
   end;
end;

function GMBuildSQLWhere(const AList: IUnknown; const AOparator: TGMString = ' AND '; const ACompare: TGMString = ' = '): TGMString;
var i: Integer; PICount: IGMGetCount; PIIntfByPosition: IGMGetIntfByPosition; PIName: IGMGetName; PIValue: IGMGetUnionValue;
begin
  GMCheckQueryInterface(AList, IGMGetCount, PICount, {$I %CurrentRoutine%});
  GMCheckQueryInterface(AList, IGMGetIntfByPosition, PIIntfByPosition, {$I %CurrentRoutine%});

  Result := '';
  for i:=0 to PICount.Count-1 do
   begin
    GMCheckGetIntfByPosition(PIIntfByPosition, i, IGMGetName, PIName, srCollectionelement, {$I %CurrentRoutine%});
    GMCheckGetIntfByPosition(PIIntfByPosition, i, IGMGetUnionValue, PIValue, srCollectionelement, {$I %CurrentRoutine%});

    if PIValue.Value.IsNullOrUnassigned then
     Result := GMStringJoin(Result, AOparator, GMFormat('(%s IS NULL)', [PIName.Name]))
    else
     Result := GMStringJoin(Result, AOparator, GMFormat('(%s%s%s)', [PIName.Name, ACompare, GMUnionValueAsSqlLiteral(PIValue.Value)]));
   end;
end;

function GMConfirmDeletion(const Container: IUnknown; ConfirmQuestion: TGMString): Boolean;
begin
  if Container = nil then Result := False else
   begin
    if ConfirmQuestion = '' then ConfirmQuestion := srConfirmRecordDeletion + '?';
    Result := not GMAskBoolean(Container, Ord(bvConfirmDeletions), True)
              or (vfGMMessageBox(ConfirmQuestion, svConfirmation, mb_YesNo) = IdYes);
   end;
end;

procedure GMDoDeletion(const AContainer: IUnknown; const ASelection: IUnknown);
var PISelectedCount: IGMGetCount;
    PISelectedPositions: IGMMapIntegerOnInteger;
    PISourcePosition: IGMGetSetPosition;

  procedure ClearSelection;
  var clearSel: IGMClear;
  begin
    if GMQueryInterface(ASelection, IGMClear, clearSel) then clearSel.Clear;
  end;

  procedure DeleteOne;
  begin
    if GMConfirmDeletion(AContainer, '') then GMCheckExecRSOperation(AContainer, roDelete, {$I %CurrentRoutine%});
  end;

  procedure DeleteMultiple;
  var i: Integer; mousePtrWait: IUnknown; PIEnableNotify: IGMEnableNotifications; ReExecutionneeded: Boolean;
  begin
    //GMCheckQueryInterface(AContainer, IGMEnableNotifications, PIEnableNotify, {$I %CurrentRoutine%});
    AContainer.QueryInterface(IGMEnableNotifications, PIEnableNotify);
    if GMConfirmDeletion(AContainer, GMFormat(srConfirmMultipleDelete + '?', [PISelectedCount.Count])) then
     begin
      mousePtrWait := TGMTempCursor.Create(vDBWaitCursor);
      ReExecutionneeded := False;
      if PIEnableNotify <> nil then PIEnableNotify.DisableNotifications;
      try
       for i:=PISelectedCount.Count-1 downto 0 do
        begin
         PISourcePosition.Position := PISelectedPositions.MapIntegerOnInteger(i);
         try
          GMCheckExecRSOperation(AContainer, roDelete, {$I %CurrentRoutine%});
          ReExecutionneeded := True;
         except
          on E: Exception do if not GMAskExceptionContinue(E, eaAskUser, srAskContinueDeletion) then raise; else raise;
         end;
        end;
       ClearSelection;
      finally
       if PIEnableNotify <> nil then PIEnableNotify.EnableNotifications(CEnableNotify[ReExecutionneeded]);
      end;
     end;
  end;

begin
  if AContainer = nil then Exit;
  if //(ASelection <> nil) and
     //(GMGetPropIntfFromIntf(ASelection, cStrSelectedPositions, IGMGetCount, PISelectedCount) = S_OK) and (PISelectedCount.Count > 1) and
     GMQueryInterface(ASelection, IGMGetCount, PISelectedCount) and (PISelectedCount.Count > 1) and
     (PISelectedCount.QueryInterface(IGMMapIntegerOnInteger, PISelectedPositions) = S_OK) and
     (AContainer.QueryInterface(IGMGetSetPosition, PISourcePosition) = S_OK) then
   DeleteMultiple else DeleteOne;
end;

procedure GMDeleteCascaded(const Container: IUnknown);
var PICascade: IGMCascadedContentsProperties;
begin
  if (Container <> nil) and
     (GMGetPropIntfFromIntf(Container, cStrCascadePropertyName, IGMCascadedContentsProperties, PICascade) = S_OK) and
     PICascade.ConfigurationIsValid then
   GMDeleteCascaded(Container, PICascade.KeyValueName, PICascade.ParentReferenceValueName);
end;

procedure GMDeleteCascaded(const Container: IUnknown; const KeyValueName, ParentRefValueName: TGMString);
var PIEnableNotify: IGMEnableNotifications;
    ReExecutionneeded: Boolean;
    mousePtrWait: IUnknown;

  procedure DeleteItem(const SubContainer: IUnknown);
  var PICount: IGMGetCount; PIGetSubItems: IGMGetSubItems;
  begin
    //if SubContainer = nil then Exit;
    GMCheckQueryInterface(SubContainer, IGMGetSubItems, PIGetSubItems, {$I %CurrentRoutine%});
    GMHrCheckIntf(PIGetSubItems.GetSubItems(ParentRefValueName, GMCheckGetItemValue(SubContainer, KeyValueName, {$I %CurrentRoutine%}), IGMGetCount, PICount), SubContainer, {$I %CurrentRoutine%});
    //GMCheckExecRSOperation(PICount, roSetSimplestConfiguration, {$I %CurrentRoutine%}); <- readonly!
    GMSetIntfActive(PICount, True, {$I %CurrentRoutine%});

    while PICount.Count > 0 do
     try DeleteItem(PICount); except
      on E: Exception do if not GMAskExceptionContinue(E, eaAskUser, srAskContinueDeletion) then raise; else raise;
     end;

    GMCheckExecRSOperation(SubContainer, roDelete, {$I %CurrentRoutine%});
    ReExecutionneeded := True;
  end;
begin
  if (Container = nil) or (KeyValueName = '') or (ParentRefValueName = '') or not GMIntfIsActive(Container) then Exit;
  Container.QueryInterface(IGMEnableNotifications, PIEnableNotify);

  if GMConfirmDeletion(Container, srConfirmDeleteCascaded) then
   begin
    mousePtrWait := TGMTempCursor.Create(vDBWaitCursor);
    if PIEnableNotify <> nil then PIEnableNotify.DisableNotifications;
    try
     ReExecutionneeded := False;
     DeleteItem(Container);
    finally
     if PIEnableNotify <> nil then PIEnableNotify.EnableNotifications(CEnableNotify[ReExecutionneeded]);
    end;
   end;
end;

procedure GMInsertChild(const Container: IUnknown);
var PICascade: IGMCascadedContentsProperties; ParentKey: RGMUnionValue;
begin
  if (GMGetPropIntfFromIntf(Container, cStrCascadePropertyName, IGMCascadedContentsProperties, PICascade) = S_OK) and
     PICascade.ConfigurationIsValid then
   begin
    ParentKey := GMCheckGetItemValue(Container, PICascade.KeyValueName, {$I %CurrentRoutine%});
    GMCheckExecRSOperation(Container, roInsert, {$I %CurrentRoutine%}, PICascade);
    GMCheckSetItemValue(Container, PICascade.ParentReferenceValueName, ParentKey, {$I %CurrentRoutine%});
   end;
end;

function GMLookupValues(const Container, Values: IUnknown; const SQLCriteria: TGMString; const GlobalLookup: Boolean = True): Boolean;
var PIValueCount: IGMGetCount;
    PILookupRS: IUnknown;

  function DoLookupValues: Boolean;
  // Own Scope for Interface Pointers
  var i: Integer;
      PIUniCursor: IGMUnidirectionalCursor;
      PIFieldIntfByName: IGMGetIntfByName;
      PIFieldValue: IGMGetUnionValue;
      PISql: IGMSqlStatementParts;
      PIIntfByPos: IGMGetIntfByPosition;
      PIValue: IGMGetSetUnionValue;
      PIValueName: IGMGetName;
  begin
    if (PILookupRS.QueryInterface(IGMUnidirectionalCursor, PIUniCursor) = S_OK) and
       (PILookupRS.QueryInterface(IGMGetIntfByName, PIFieldIntfByName) = S_OK) and
       (GMGetPropIntfFromIntf(PILookupRS, cStrSQL, IGMSqlStatementParts, PISql) = S_OK) and
       (Values.QueryInterface(IGMGetIntfByPosition, PIIntfByPos) = S_OK) then
     begin
      GMCheckExecRSOperation(PILookupRS, roSetSimplestConfiguration, {$I %CurrentRoutine%});

      if GlobalLookup or (PISql.SQLWhere = '') then
       PISql.SQLWhere := SQLCriteria
      else
       PISql.SQLWhere := GMFormat('(%s) AND (%s)', [PISql.SQLWhere, SQLCriteria]);

      GMSetIntfActive(PILookupRS, True, {$I %CurrentRoutine%});

      if GMIntfIsEmpty(PILookupRS) then
       begin
        for i:=0 to PIValueCount.Count-1 do
         if (PIIntfByPos.GetIntfByPosition(i, IGMGetSetUnionValue, PIValue) = S_OK) then PIValue.Value := uvtNull;
        Result := False;
       end
      else
       begin
        for i:=0 to PIValueCount.Count-1 do
         if (PIIntfByPos.GetIntfByPosition(i, IGMGetSetUnionValue, PIValue) = S_OK) then
          if (PIIntfByPos.GetIntfByPosition(i, IGMGetName, PIValueName) = S_OK) and
             (PIFieldIntfByName.GetIntfByName(PIValueName.Name, IGMGetUnionValue, PIFieldValue) = S_OK) then
           PIValue.Value := PIFieldValue.Value
          else
           PIValue.Value := uvtNull;

        Result := True;
       end;
     end
    else Result := False;
  end;

begin
  Result := False;
  if (SQLCriteria <> '') and (Values <> nil) and
     (Values.QueryInterface(IGMGetCount, PIValueCount) = S_OK) and (PIValueCount.Count > 0) and
     (Container <> nil) and (GMCreateCopyQI(Container, IUnknown, PILookupRS) = S_OK) then Result := DoLookupValues;
end;

function GMLookupValue(const Container: IUnknown; const ValueName, SQLCriteria: TGMString; const GlobalLookup: Boolean = True): RGMUnionValue;
var LookupValues: IGMObjArrayCollection;
begin
  Result := uvtNull;
  LookupValues := TGMNamedValueCollection.Create([ValueName]);
  if GMLookupValues(Container, LookupValues, SQLCriteria, GlobalLookup) then Result := GMGetItemValue(LookupValues, 0);
end;

function GMReplaceSqlValue(const SQLPart, FieldName, OpInner, OpOuter: TGMString; const FieldValue: RGMUnionValue): TGMString;
const CSep = cSqlSeparators + cSqlOperators;
var chPos: PtrInt;
  function BuildClause: TGMString;
  begin
    if FieldValue.IsNullOrUnassigned then
     Result := GMFormat('%s IS NULL', [FieldName])
    else
     Result := GMFormat('%s %s %s', [FieldName, GMStrip(OpInner, cWhiteSpace), GMUnionValueAsSqlLiteral(FieldValue)]);
  end;
begin
  Result := SQLPart;
  chPos := 1;
  if GMFindToken(Result, FieldName, chPos, CSep) then
   begin
    // needs a space between operator and value ..
    while not GMIsDelimiter(CSep, Result, chPos) and (Length(Result) >= chPos) do Delete(Result, chPos, 1);
    while GMIsDelimiter(cSqlSeparators, Result, chPos) and (Length(Result) >= chPos) do Delete(Result, chPos, 1);
    while not GMIsDelimiter(cSqlSeparators, Result, chPos) and (Length(Result) >= chPos) do Delete(Result, chPos, 1);
    while GMIsDelimiter(cSqlSeparators, Result, chPos) and (Length(Result) >= chPos) do Delete(Result, chPos, 1);
    while not GMIsDelimiter(cSqlSeparators, Result, chPos) and (Length(Result) >= chPos) do Delete(Result, chPos, 1);

    //while not GMIsDelimiter(CSep, Result, chPos) and (Length(Result) >= chPos) do Delete(Result, chPos, 1);
    //while GMIsDelimiter(CSep, Result, chPos) and (Length(Result) >= chPos) do Delete(Result, chPos, 1);
    //while not GMIsDelimiter(CSep, Result, chPos) and (Length(Result) >= chPos) do Delete(Result, chPos, 1);

    Insert(BuildClause, Result, chPos);
   end
  else
   Result := GMStringJoin(GMStrip(Result, cWhiteSpace), ' ' + GMStrip(OpOuter, cWhiteSpace) + ' ', '(' + BuildClause + ')');
end;

function GetSqlIdQuoteChFromConnection(const AConnection: IUnknown): TGMString;
var syntaxElements: RGMTypedIntf<IGMSqlSyntaxElements>;
begin
  //if GMQueryInterface(AConnection, IGMSqlSyntaxElements, syntaxElements) then
  if syntaxElements.QueryFrom(AConnection) then
     Result := syntaxElements.Intf.SqlIdentifierQuoteChar else Result := ''; // cSqlIdQuoteCh;
end;

function GetSqlIdQuoteChFromStatement(const AStatement: IUnknown): TGMString;
var intfSrc: RGMTypedIntf<IGMGetInterfaceSource>;
begin
  //if GMQueryInterface(AStatement, IGMGetInterfaceSource, intfSrc) then
  if intfSrc.QueryFrom(AStatement) then
     Result := GetSqlIdQuoteChFromConnection(intfSrc.Intf.InterfaceSource) else Result := '';
end;

//function GMExecSqlSelectCount(const AStatement: IUnknown; const ASqlText: TGMString): RGMUnionValue;
//var setSqlText: IGMGetSetText; //ActiveKeeper: IUnknown;
//begin
//  Result := uvtNull;
//  if (Length(ASqlText) > 0) and (AStatement <> nil) then
//   try
////  ATableName := cSqlIdQuoteCh + GMStrip(ATableName, cSqlIdQuoteCh) + cSqlIdQuoteCh;
//    GMSetIntfActive(AStatement, False);
////  ActiveKeeper := TGMActiveKeeper.Create(AStatement, False);
//    if GMGetPropIntfFromIntf(AStatement, cStrSQL, IGMGetSetText, setSqlText) = S_OK then
//     begin
//      setSqlText.Text := ASqlText; // GMBuildSelectCountSQL(ATableName, GetSqlIdQuoteChFromStatement(AStatement), AWhereClause);
//      GMSetIntfActive(AStatement, True);
//      Result := GMGetItemValue(AStatement, 1); // <- Result of select count(*) will always be first field in first record!
//     end;
//   except
//    on ex: TObject do begin GMTraceException(ex); Result := uvtNull; end;
//   end;
//end;

function GMGetSubItemsBySQL(const Container: IUnknown; const ParentFieldName: TGMString; ParentFieldValue: RGMUnionValue; const IID: TGUID; out Intf): HResult;
var clone: IUnknown; sqlParts: IGMSqlStatementParts;
begin
  if (Container = nil) or (ParentFieldName = '') then begin Result := E_INVALIDARG; Exit; end;

  Result := GMCreateCopyQI(Container, IUnknown, clone);
  if Result <> S_OK then Exit;

  Result := clone.QueryInterface(IID, Intf);
  if Result <> S_OK then Exit;

  try
   Result := GMGetPropIntfFromIntf(clone, cStrSQL, IGMSqlStatementParts, sqlParts);
   if Result <> S_OK then Exit;
   sqlParts.SQLWhere := GMReplaceSqlValue(sqlParts.SQLWhere, ParentFieldName, cStrEqual, cStrAnd, ParentFieldValue);
   Result := S_OK;
  finally
   if Result <> S_OK then IUnknown(Intf) := nil; // <- release early if not successful
  end;
end;

function GMBuildContentsString(const Source: IUnknown;
                               const FieldNames: TGMStringArray;
                               SelectionSource: IUnknown = nil;
                               const IncludeTitles: Boolean = True;
                               const ColumnSeparator: TGMString = cDfltColumnSeparator;
                               const RowSeparator: TGMString = cDfltRowSeparator): TGMString;
var PINotify: IGMEnableNotifications;
    PIState: IGMSaveRestoreState;
    PISourcePosition: IGMGetSetPosition;
    PIFieldIntf: IGMGetIntfByName;
    PISelectedCount: IGMGetCount;
    SaveState: IUnknown;
    mousePtrWait: IUnknown;

  procedure AddTitleRow;
  var i: Integer; RowStr: TGMString;
  begin
    RowStr := '';
    for i := Low(FieldNames) to High(FieldNames) do RowStr := RowStr + FieldNames[i] + ColumnSeparator;
    RowStr := GMStrip(RowStr, ColumnSeparator);
    if RowStr <> '' then Result := Result + RowStr + RowSeparator;
  end;

  procedure AddCurrentPosition;
  var i: Integer; RowStr: TGMString; PIText: IGMGetText;
  begin
    RowStr := '';
    for i := Low(FieldNames) to High(FieldNames) do
     if (PIFieldIntf.GetIntfByName(FieldNames[i], IGMGetText, PIText) = S_OK) then RowStr := RowStr + PIText.Text + ColumnSeparator;

    RowStr := GMStrip(RowStr, ColumnSeparator);
    if RowStr <> '' then Result := Result + RowStr + RowSeparator;
  end;

  procedure AddAllPositions;
  var i: Integer; PISourceCount: IGMGetCount;
  begin
    GMCheckQueryInterface(Source, IGMGetCount, PISourceCount, {$I %CurrentRoutine%});

    for i:=1 to PISourceCount.Count do
     begin
      PISourcePosition.Position := i;
      AddCurrentPosition;
     end;
  end;

  procedure AddSelectedPositions;
  var i: Integer; PISelectedPositions: IGMMapIntegerOnInteger;
  begin
    GMCheckQueryInterface(PISelectedCount, IGMMapIntegerOnInteger, PISelectedPositions, {$I %CurrentRoutine%});

    for i:=0 to PISelectedCount.Count-1 do
     begin
      PISourcePosition.Position := PISelectedPositions.MapIntegerOnInteger(i);
      AddCurrentPosition;
     end;
  end;

begin
  if (Source <> nil) and (Length(FieldNames) > 0) then
   begin
    if SelectionSource = nil then SelectionSource := Source;

    Source.QueryInterface(IGMEnableNotifications, PINotify);
    //GMCheckQueryInterface(Source, IGMEnableNotifications, PINotify, {$I %CurrentRoutine%});
    GMCheckQueryInterface(Source, IGMSaveRestoreState, PIState, {$I %CurrentRoutine%});
    GMCheckQueryInterface(Source, IGMGetIntfByName, PIFieldIntf, {$I %CurrentRoutine%});
    GMCheckQueryInterface(Source, IGMGetSetPosition, PISourcePosition, {$I %CurrentRoutine%});

    mousePtrWait := TGMTempCursor.Create(vDBWaitCursor);
    if PINotify <> nil then PINotify.DisableNotifications;
    try
     SaveState := PIState.CaptureState;
     try
      GMCheckExecRSOperation(Source, roLeaveModifyingState, {$I %CurrentRoutine%});

      if IncludeTitles then AddTitleRow;

      if //(SelectionSource <> nil) and //(GMGetPropIntfFromIntf(SelectionSource, cStrSelectedPositions, IGMGetCount, PISelectedCount) = S_OK) and
         GMQueryInterface(SelectionSource, IGMGetCount, PISelectedCount) and
         (PISelectedCount.Count > 0) then AddSelectedPositions else AddAllPositions;

      Result := GMStrip(Result, ColumnSeparator + RowSeparator);
     finally
      PIState.RestoreState(SaveState);
     end;
    finally
     if PINotify <> nil then PINotify.EnableNotifications;
    end;
   end;
end;

function GMFindSortOrderPos(const AFieldName, ASQLOrderBy: TGMString; var AChPos: PtrInt): PtrInt;
const cStrDesc: TGMString = 'DESC'; // cStrAsc: TGMString = 'ASC';
var chPos1, chPos2: PtrInt; clause, sortOrder, token: TGMString;
  function NextClause: TGMString;
  begin
//  Result := GMNextWord(chPos1, ASQLOrderBy, cFieldListSeparators);
    Result := GMNextSQLToken(chPos1, ASQLOrderBy, cFieldListSeparators);
    Result := GMStrip(Result, cSqlWhiteSpace + cFieldListSeparators);
  end;
begin
  Result := 0; chPos1 := 1;
  clause := NextClause;
  while clause <> '' do
   begin
    chPos2 := 1;
    Inc(Result);
    token := GMstripRight(GMStripLeft(GMNextSQLToken(chPos2, clause, cSqlSeparators), '["`'), ']"`');
    if GMSameText(token, AFieldName) then
     begin
      sortOrder := GMNextSQLToken(chPos2, clause, cSqlSeparators);
      if GMSameText(sortOrder, cStrDesc) then Result := -Result;
      Exit; // <- NOTE: Exit here!
     end;

    AChPos := chPos1;
    clause := NextClause;
   end;
  Result := 0; // <- will be skipped by Exit statement!
end;

function GMFindSortOrder(const AFieldName, ASQLOrderBy: TGMString): LongInt;
var chPos: PtrInt;
begin
  chPos := 1;
  Result := GMFindSortOrderPos(AFieldName, ASQLOrderBy, chPos);
end;

function GMSetSortOrder(const AFieldName: TGMString; const ASortOrder: LongInt; const ASQLOrderBy: TGMString; const ACumulative: Boolean): TGMString;
var startChPos, endChPos: PtrInt; comma, sortToken: TGMString;
begin
  startChPos := 1;
  comma := ',';
  Result := ASQLOrderBy;
  if not ACumulative then Result := '' else
   begin
    GMFindSortOrderPos(AFieldName, Result, startChPos);
    endChPos := startChPos;
    GMNextSQLToken(endChPos, Result, cFieldListSeparators);
    Delete(Result, startChPos, endChPos - startChPos);
    if startChPos <= Length(Result) then comma := '';
    Result := GMStrip(Result, cFieldListSeparators);
   end;

  if ASortOrder <> 0 then
   begin
    if ASortOrder < 0 then sortToken := cSqlDesc else sortToken := cSqlAsc;
    Insert(GMFormat('%s %s %s,', [comma, GMSqlQuoteIdentifierIfNeeded(AFieldName), sortToken]), Result, startChPos);
   end;

  Result := GMStrip(Result, cFieldListSeparators + cWhiteSpace);
end;

function GMSqlIdentifierNeedsQuotation(const AIdentifier: TGMString): Boolean;
var chPos: Integer;
begin
  Result := False;
  for chPos:=1 to Length(AIdentifier) do
   case AIdentifier[chPos] of
    'a' .. 'z', 'A' .. 'Z', '0' .. '9', '_', '.': ; // <- Nothing!
    else Exit(True);
   end;
end;

function GMSqlQuoteIdentifierIfNeeded(const AIdentifier: TGMString; const AIdQuoteChar: TGMString = cSqlIdQuoteCh): TGMString;
begin
  if (Length(AIdQuoteChar) > 0) and GMSqlIdentifierNeedsQuotation(AIdentifier) then
     Result := AIdQuoteChar + GMStrip(AIdentifier, AIdQuoteChar) + AIdQuoteChar
   else
     Result := AIdentifier;

  //Result := AIdentifier;
  //if (Length(AIdQuoteChar) > 0) and GMSqlIdentifierNeedsQuotation(Result) then
  //   Result := AIdQuoteChar + GMStrip(Result, AIdQuoteChar) + AIdQuoteChar;
end;

function GMBuildSelectAllSQL(ATableName: TGMString; const AIdQuoteChar, AOrderBy: TGMString): TGMString;
begin
  if GMSqlIdentifierNeedsQuotation(ATableName) then ATableName := AIdQuoteChar + GMStrip(ATableName, AIdQuoteChar) + AIdQuoteChar;
  if Length(AOrderBy) <= 0 then
    Result := GMFormat(cSqlSelectAllFmt, [ATableName]) + ';'
  else
    Result := GMFormat('%s * %s %s %s %s %s;', [cSqlSelect, cSqlFrom, ATableName, cSqlOrderBy, AOrderBy, cSqlAsc]);
end;

function GMBuildSelectCountSQL(ATableName: TGMString; const AIdQuoteChar: TGMString; const AWhereClause: TGMString): TGMString;
begin
  ATableName := GMSqlQuoteIdentifierIfNeeded(ATableName, AIdQuoteChar);
  Result := GMFormat(cSqlSelectCountFmt, [ATableName]);
  if Length(AWhereClause) > 0 then Result := Result + cNewLine + cSqlWhere + ' ' + AWhereClause;
end;

function GMStripSQLOrderBy(const ASqlText: TGMString; var AChPos: PtrInt): TGMString;
var token: TGMString; tokenStartPos, orderStartChPos, resultChPos: PtrInt; inOrderBy: Boolean; // , lastToken
  procedure AppendToken(AEndChPos: PtrInt); // (AStartChPos: PtrInt);
  var len: PtrInt;
  begin
    len := AEndChPos - tokenStartPos;
    if len > 0 then
     begin
      System.Move(ASqlText[tokenStartPos], Result[resultChPos], len * SizeOf(TGMChar));
      Inc(resultChPos, len);
     end;
    //for i:=tokenStartPos to AEndChPos-1 do // Result += ASqlText[i];
    //  begin Result[resultChPos] := ASqlText[i]; Inc(resultChPos); end;
  end;
begin
  //Result := '';
  Setlength(Result, Length(ASqlText));
  resultChPos := 1; inOrderBy := False; orderStartChPos := -1;

  repeat
   tokenStartPos := AChPos;
   token := GMNextSQLToken(AChPos, ASqlText, cSqlSeparators + cSqlOperators);

   if (orderStartChPos > 0) and GMSameText(token, 'BY') then inOrderBy := True;

   if not inOrderBy then
    begin
     if GMSameText(token, 'ORDER') then
      begin orderStartChPos := tokenStartPos; AppendToken(AChPos - Length(token)); end
     else
      orderStartChPos := -1;

     if orderStartChPos < 0 then AppendToken(AChPos);
    end
   else
    if GMSameText(token, 'LIMIT') then begin AppendToken(AChPos); orderStartChPos := -1; inOrderBy := False; end;

   //lastToken := token; // lastLastChPos := tokenStartPos;
  until Length(token) <= 0;

  SetLength(Result, resultChPos - 1);
end;

function GMModifyToSelectCountSQL(const ASqlText: TGMString; const ACaller: TObject): TGMString;
var chPos: PtrInt; strippedSQL, token: TGMString; stmtKind: TGMSqlStatementKind; sqlParts: TGMSqlProperty; // firstToken: Boolean;
begin
  Result := ''; chPos := 1;
  strippedSQL := GMStripRight(GMStripSQLOrderBy(GMStrip(GMStripSQLComments(ASqlText)), chPos), ';');

  stmtKind := GMSqlStatmentKind(strippedSQL);

  case stmtKind of
   skSelect, skDelete:
    begin
     chPos := 1;
     repeat
      token := GMNextSQLToken(chPos, strippedSQL, cSqlSeparators + cSqlOperators);

      if GMSameText(token, cSqlFrom) then
         Exit('SELECT Count(*) FROM ' + System.Copy(strippedSQL, chPos, Length(strippedSQL) - chPos + 1) + ';')
      else
      if GMIsOneOfStrings(token, ['AVG', 'SUM', 'MIN', 'MAX', 'COUNT']) then
         Exit('SELECT Count(*) FROM ('+ GMStripRight(strippedSQL, ';'+cWhiteSpace) +');');

     until Length(token) <= 0;
    end;

   skUpdate:
    begin
     sqlParts := TGMSqlProperty.Create(nil, strippedSQL, nil, False);
     try
      Exit('SELECT Count(*) FROM ' + sqlParts.TableName + ' WHERE ' + sqlParts.SQLWhere + ';');
     finally
      sqlParts.Free;
     end;
    end;
  end;

  raise EGMException.ObjError(srUnableBuildCountSQL+': '+strippedSQL, ACaller, {$I %CurrentRoutine%});
end;

function GMCalcParamCount(const SQLString: TGMString): SmallInt;
var chPos: PtrInt;
begin
  chPos := 1; Result := 0;
  while GMFindToken(SQLString, cSqlParamMarker, chPos, cSqlSeparators + cSqlOperators) do
   begin Inc(Result); Inc(chPos, Length(cSqlParamMarker)); end;
end;

function GMExtractQualifier(const QualifiedName: TGMString; var chPos: PtrInt; var Qualifier: TGMString; const Separators: TGMString = cSqlQualSep): Boolean;
begin
  Qualifier := GMNextWord(chPos, QualifiedName, Separators, False);
  Result := Qualifier <> '';
end;

function GMSplitQualifiedName(const QualifiedName: TGMString; var Qualifier, FieldName: TGMString): Boolean;
var chPos: PtrInt;
begin
  chPos:=1;
  Result := GMExtractQualifier(QualifiedName, chPos, Qualifier) and GMExtractQualifier(QualifiedName, chPos, FieldName);
end;


{ ---------------------------- }
{ ---- RGMQualifiedDBName ---- }
{ ---------------------------- }

function GMInitRQualifiedDBName(const AElementName: TGMString; const ACatalogName: TGMString = ''; const ASchemaName: TGMString = ''): RGMQualifiedDBName;
begin
  Result.CatalogName := ACatalogName;
  Result.SchemaName := ASchemaName;
  Result.TableName := AElementName;
end;

function RGMQualifiedDBName.QualifiedName(const ASeparator: TGMString): TGMString;
begin
  Result := GMStringJoin(CatalogName, ASeparator, GMStringJoin(SchemaName, ASeparator, TableName));
end;

function RGMQualifiedDBName.CompareTo(const AOtherQName: RGMQualifiedDBName): TGMCompareResult; // TGMCompareResult = (crALessThanB, crAEqualToB, crAGreaterThanB);
  function IsWildCard(const AValue: TGMString): Boolean; inline;
  begin
    Result := (AValue = '') or (AValue = '*') or (AValue = '%');
  end;
  function CompareParts(const APart, AOtherPart: TGMString): TGMCompareResult; inline;
  begin
    if IsWildCard(APart) or IsWildCard(AOtherPart) then Result := crAEqualToB else Result := GMCompareNames(APart, AOtherPart);
  end;
begin
  Result := CompareParts(CatalogName, AOtherQName.CatalogName);
  if Result = crAEqualToB then
   begin
    Result := CompareParts(SchemaName, AOtherQName.SchemaName);
    if Result = crAEqualToB then Result := CompareParts(TableName, AOtherQName.TableName);
   end;
end;

function GMBuildQualifiedDBName(const AElementName, ACatalogName, ASchemaName, ASeparator: TGMString): TGMString;
begin
  Result := GMInitRQualifiedDBName(AElementName, ACatalogName, ASchemaName).QualifiedName(ASeparator);
end;

function GMCompareQualifiedDBName(const AQNameA, AQNameB: RGMQualifiedDBName): TGMCompareResult;
begin
  //Result := GMCompareNames(AQNameA.QualifiedName, AQNameB.QualifiedName);
  Result := AQNameA.CompareTo(AQNameB);
end;

function GMSplitSqlQualifiedName(const AQualifiedName: TGMString; const ASeparatorChar: TGMChar): RGMQualifiedDBName;
var chPos: PtrInt;
  procedure SkipSeparator;
  begin
    if (chPos >= 1) and (AQualifiedName[chPos] = ASeparatorChar) then Dec(chPos);
  end;
begin
  chPos := Length(AQualifiedName);
  Result.TableName := GMPreviousSQLToken(chPos, AQualifiedName, ASeparatorChar + cSqlWhiteSpace, False);
  SkipSeparator;
  Result.SchemaName := GMPreviousSQLToken(chPos, AQualifiedName, ASeparatorChar + cSqlWhiteSpace, False);
  SkipSeparator;
  Result.CatalogName := GMPreviousSQLToken(chPos, AQualifiedName, ASeparatorChar + cSqlWhiteSpace, False);
end;


{ ------------------------------ }
{ ---- Field List Notifyers ---- }
{ ------------------------------ }

procedure GMNotifyFieldsBeforePositionChange(const AFieldList: TGMObjArrayCollection);
var i: Integer; // notifySink: IGMPositionChangeNotifications;
begin
  if AFieldList <> nil then
   for i:=0 to AFieldList.Count-1 do (AFieldList[i] as TGMDBField).BeforePositionChange;
    //if GMGetInterface(AFieldList[i], IGMPositionChangeNotifications, notifySink) then
    //   notifySink.BeforePositionChange;
end;

procedure GMNotifyFieldsAfterPositionChange(const AFieldList: TGMObjArrayCollection);
var i: Integer; // notifySink: IGMPositionChangeNotifications;
begin
  if AFieldList <> nil then
   for i:=0 to AFieldList.Count-1 do try (AFieldList[i] as TGMDBField).AfterPositionChange; except end;
    //if GMGetInterface(AFieldList[i], IGMPositionChangeNotifications, notifySink) then
    // try notifySink.AfterPositionChange; except {on E: EGMOdbcError do raise;} end;
end;

procedure GMNotifyFieldsBeforeOperation(const AFieldList: TGMObjArrayCollection; const AOperation: Integer; const AParameter: IUnknown);
var i: Integer; // notifySink: IGMOperationNotifications;
begin
  if AFieldList <> nil then
   for i:=0 to AFieldList.Count-1 do (AFieldList[i] as TGMDBField).BeforeOperation(AOperation, AParameter);
    //if GMGetInterface(AFieldList[i], IGMOperationNotifications, notifySink) then
    // notifySink.BeforeOperation(AOperation, AParameter);
end;

procedure GMNotifyFieldsAfterOperation(const AFieldList: TGMObjArrayCollection; const AOperation: Integer; const AParameter: IUnknown);
var i: Integer; // notifySink: IGMOperationNotifications;
begin
  if AFieldList <> nil then
   for i:=0 to AFieldList.Count-1 do try (AFieldList[i] as TGMDBField).AfterOperation(AOperation, AParameter); except end;
    //if GMGetInterface(AFieldList[i], IGMOperationNotifications, notifySink) then
    // try notifySink.AfterOperation(AOperation, AParameter); except {on E: EGMOdbcError do raise;} end;
end;

procedure GMNotifyFieldsBeforeActiveChange(const AFieldList: TGMObjArrayCollection; const ANewActive: Boolean);
var i: Integer; // notifySink: IGMActiveChangeNotifications;
begin
  if AFieldList <> nil then
   for i:=0 to AFieldList.Count-1 do (AFieldList[i] as TGMDBField).BeforeActiveChange(ANewActive);
    //if GMGetInterface(AFieldList[i], IGMActiveChangeNotifications, notifySink) then
    // notifySink.BeforeActiveChange(ANewActive);
end;

procedure GMNotifyFieldsAfterActiveChange(const AFieldList: TGMObjArrayCollection; const ANewActive: Boolean);
var i: Integer; // notifySink: IGMActiveChangeNotifications;
begin
  if AFieldList <> nil then
   for i:=0 to AFieldList.Count-1 do try (AFieldList[i] as TGMDBField).AfterActiveChange(ANewActive); except end;
    //if GMGetInterface(AFieldList[i], IGMActiveChangeNotifications, notifySink) then
    // try notifySink.AfterActiveChange(ANewActive); except {on E: EGMOdbcError do raise;} end;
end;


{ ------------------------------------------ }
{ ---- Recordset Attributes conversions ---- }
{ ------------------------------------------ }

function RSAttributesToLongWord(const Value: TGMRecordsetAttributes): Longword;
var i: TGMRecordsetAttribute;
begin
  Result := 0;
  for i:=Low(i) to High(i) do if i in Value then Result := Result or Longword(1 shl Ord(i));
end;

function RSAttributesFromLongWord(const Value: Longword): TGMRecordsetAttributes;
var i: TGMRecordsetAttribute;
begin
  Result := [];
  for i:=Low(i) to High(i) do if Value and (1 shl Ord(i)) <> 0 then Include(Result, i);
end;


{ ------------------------------------- }
{ ---- Schema Root Lists converions---- }
{ ------------------------------------- }

function SchemaListsToLongWord(const Value: TGMSchemaLists): Longword;
var i: TGMSchemaList;
begin
  Result := 0;
  for i:=Low(i) to High(i) do if i in Value then Result := Result or Longword(1 shl Ord(i));
end;

function SchemaListsFromLongWord(const Value: Longword): TGMSchemaLists;
var i: TGMSchemaList;
begin
  Result := [];
  for i:=Low(i) to High(i) do if Value and (1 shl Ord(i)) <> 0 then Include(Result, i);
end;


{ ----------------------------- }
{ ---- TGMFieldValueBuffer ---- }
{ ----------------------------- }

constructor TGMFieldValueBuffer.CreateFieldBuffer(const AOwner: TObject;
                                                  const ADataType: TGMDBColumnDataType;
                                                  const AColumnPosition: LongInt;
                                                  const AFieldName: TGMString;
                                                  const ASizeInBytes: PtrUInt;
                                                  const AMaxStrLength: PtrUInt;
                                                  const AStatementHandle: THandle);
begin
  FColumnPosition := AColumnPosition;
  FieldName := AFieldName;
  SizeInBytes := ASizeInBytes;
  StatementHandle := AStatementHandle;
  FMaxStrLength := AMaxStrLength;
  Create(AOwner, ADataType, False, True, False); // <- "inherited Create" would not call virtual overriden versions of create
end;


{ -------------------- }
{ ---- TGMDBField ---- }
{ -------------------- }

constructor TGMDBField.Create(const AOwner: TObject; const ACreateData: RGMFieldCreateData);
var bi: EGMValueBufferInstance;
begin
  inherited Create(False);
  FOwner := AOwner;
  FCreateData := ACreateData;
  for bi:=Low(bi) to High(bi) do FValueBufferIdxMap[bi] := bi;
end;

destructor TGMDBField.Destroy;
begin
  FreeValueBuffers;
  inherited Destroy;
end;

procedure TGMDBField.FreeValueBuffers;
var i: EGMValueBufferInstance;
begin
  for i:=Low(FValueBuffers) to High(FValueBuffers) do GMFreeAndNil(FValueBuffers[i]);
end;

function TGMDBField.ValueBufferCreateClass: TGMFieldValueBufferClass;
begin
  Result := TGMFieldValueBuffer;
end;

function TGMDBField.GetName: TGMString;
begin
  Result := CreateData.Name;
end;

function TGMDBField.GetPosition: PtrInt;
begin
  Result := CreateData.Position;
end;

function TGMDBField.GetDataType: TGMDBColumnDataType;
begin
  Result := CreateData.DataType;
end;

function TGMDBField.GetNullValuesAllowed: TGMAllowNullValues;
begin
  Result := CreateData.AllowNullValues;
end;

function TGMDBField.IsSigned: Boolean;
begin
  Result := CreateData.IsSigned;
end;

function TGMDBField.IsAutoIncrementing: Boolean;
begin
  Result := CreateData.IsAutoincrementing;
end;

function TGMDBField.DisplayWidth: PtrInt;
begin
  with FCreateData do Result := GMFieldDisplayWidth(DataType, MaxStrLength);
end;

function TGMDBField.EditLength: PtrInt;
begin
  with FCreateData do Result := GMFieldEditLength(DataType, MaxStrLength);
end;

function TGMDBField.SizeInBytes: PtrInt;
begin
  Result := CreateData.SizeInBytes;
end;

function TGMDBField.GetModified: Boolean;
begin
  Result := ValueBuffer(vbiValue).Modified;
end;

procedure TGMDBField.SetModified(const Value: Boolean);
begin
  ValueBuffer(vbiValue).Modified := Value;
end;

function TGMDBField.GetUpdatable: Boolean;
begin
  Result := CreateData.Updatable and GMAskBoolean(Owner, Ord(bvCanModify), False);
end;

function TGMDBField.ValueBuffer(const AValueBufferInstance: EGMValueBufferInstance): TGMFieldValueBuffer;
var rsHandle: IGMGetHandle;
begin
  if FValueBuffers[FValueBufferIdxMap[AValueBufferInstance]] = nil then
   begin
    GMCheckGetInterface(Owner, IGMGetHandle, rsHandle, {$I %CurrentRoutine%});
    FValueBuffers[FValueBufferIdxMap[AValueBufferInstance]] := ValueBufferCreateClass.CreateFieldBuffer(
            Owner, GetDataType, GetPosition, GetName, SizeInBytes, CreateData.MaxStrLength, rsHandle.Handle);
   end;
  Result := FValueBuffers[FValueBufferIdxMap[AValueBufferInstance]];
end;

function TGMDBField.AskInteger(const ValueId: LongInt): LongInt;
begin
  case ValueId of
   Ord(ivMaxEditLength): Result := EditLength;
   Ord(ivDisplayWidth):  Result := Displaywidth;
   Ord(ivDataSize):      Result := SizeInBytes;
   else Result := CInvalidIntValue;
  end;
end;

function TGMDBField.AskBoolean(const ValueId: LongInt): LongInt;
begin
  case ValueId of
   Ord(bvIsNULL):             Result := GMBooleanAskResult(ValueBuffer(vbiValue).IsNull);
   //Ord(bvDisplayText):        Result := GMBooleanAskResult(ValueBuffer(vbiValue).DisplayText.IsValid);
   Ord(bvIsSigned):           Result := GMBooleanAskResult(IsSigned);
   Ord(bvIsAutoIncrementing): Result := GMBooleanAskResult(IsAutoIncrementing);
   else Result := Ord(barUnknown);
  end;
end;

procedure TGMDBField.SwapBufferMap;
var Tmp: EGMValueBufferInstance;
begin
  Tmp := FValueBufferIdxMap[vbiValue];
  FValueBufferIdxMap[vbiValue] := FValueBufferIdxMap[vbiOldValue];
  FValueBufferIdxMap[vbiOldValue] := Tmp;
end;

procedure TGMDBField.NotifyDataChange;
var PIChangeNotify: IGMNamedValueChange;
begin
  GMCheckGetInterface(Owner, IGMNamedValueChange, PIChangeNotify, {$I %CurrentRoutine%});
  PIChangeNotify.AfterValueChange(Name);
end;

function TGMDBField.RecordsetState: LongInt;
var PIState: IGMGetState;
begin
  GMCheckgetInterface(Owner, IGMGetState, PIState, {$I %CurrentRoutine%});
  Result := PIState.State;
end;

function TGMDBField.RecordsetAttributes: TGMRecordsetAttributes;
var PIAttributes: IGMGetAttributes;
begin
  if (Owner <> nil) and Owner.GetInterface(IGMGetAttributes, PIAttributes) then
   Result := RSAttributesFromLongWord(PIAttributes.Attributes)
  else
   Result := [];
end;

procedure TGMDBField.CheckupdatableState(const AMethodName: TGMString = '');
var mtdName: TGMString;
begin
  if AMethodName = '' then mtdName := {$I %CurrentRoutine%} else mtdName := AMethodName;
  if not IsUpdatableState(RecordsetState) then raise EGMexception.ObjError(srNotInUpdatableState, Owner, mtdName);
end;

function TGMDBField.EditOrInsertRecordset: Boolean;
begin
  if raAutoEdit in RecordsetAttributes then Result := GMEditOrInsertIntf(GMObjAsIntf(Owner)) else Result := False;
end;

function TGMDBField.GetText: TGMString;
begin
  Result := ValueBuffer(vbiValue).GetText;
end;

function TGMDBField.GetUnionValue: RGMUnionValue;
begin
  Result := ValueBuffer(vbiValue).GetUnionValue;
end;

procedure TGMDBField.SetUnionValue(const AUnionValue: RGMUnionValue);
begin
  EditOrInsertRecordset;
  CheckUpdatableState({$I %CurrentRoutine%});
  ValueBuffer(vbiValue).SetUnionValue(AUnionValue);
  NotifyDataChange;
end;

procedure TGMDBField.SetText(const AValue: TGMString);
var FieldDataType: TGMDBColumnDataType;
begin
  if AValue = '' then SetUnionValue(uvtNull)
  else
   begin
    FieldDataType := GetDataType;
    case FieldDataType of
     fdtBoolean:                       SetUnionValue(GMStrToBool(AValue));
     fdtInt8, fdtUInt8, fdtInt16, fdtUInt16, fdtInt32, fdtUInt32, fdtInt64, fdtUInt64: //SetValue(GMStrToInt(AValue));
         SetUnionValue(GMUnionValueAsType(AValue, GMUnionTypeOfDbDataType(FieldDataType)));

     fdtSingle, fdtDouble, fdtNumeric: SetUnionValue(StrToFloat(AValue));
     fdtDate:                          SetUnionValue(StrToDate(AValue));
     fdtTime:                          SetUnionValue(StrToTime(AValue));
     fdtDateTime:                      SetUnionValue(StrToDateTime(AValue));
     fdtAnsiString, fdtUnicodeString, fdtGUID, fdtAnsiText, fdtUnicodeText: SetUnionValue(AValue);
     else raise EGMException.ObjError(MsgUnsupportedFieldDataType(Ord(FieldDataType)), Owner, {$I %CurrentRoutine%});
    end;
   end;
end;

function TGMDBField.GetValueBufferIntf(const AValueBufferInstance: LongInt; const AIID: TGUID; out AIntf): HResult;
begin
  GMCheckIntRange(cStrValBufInstTypeName, AValueBufferInstance, Ord(Low(EGMValueBufferInstance)), Ord(High(EGMValueBufferInstance)), Owner, {$I %CurrentRoutine%});
  if FValueBuffers[FValueBufferIdxMap[EGMValueBufferInstance(AValueBufferInstance)]] <> nil then
   Result := CQIResult[FValueBuffers[FValueBufferIdxMap[EGMValueBufferInstance(AValueBufferInstance)]].GetInterface(AIID, AIntf)]
  else
   Result := E_FAIL;
end;


{ ---- Notifications ---- }

procedure TGMDBField.BeforeActiveChange(const NewActive: Boolean);
begin
end;

procedure TGMDBField.AfterActiveChange(const NewActive: Boolean);
begin
  if not NewActive then FreeValueBuffers else ValueBuffer(vbiValue).Invalidate(True, False);
end;

procedure TGMDBField.BeforePositionChange;
begin
end;

procedure TGMDBField.AfterPositionChange;
begin
  ValueBuffer(vbiValue).Invalidate(True, False);
end;

procedure TGMDBField.BeforeOperation(const Operation: Integer; const Parameter: IUnknown = nil);
begin
end;

procedure TGMDBField.AfterOperation(const Operation: Integer; const Parameter: IUnknown = nil);
begin
  case Operation of
   Ord(roCancelChanges):
    begin
     SwapBufferMap;
     ValueBuffer(vbiOldValue).Invalidate(True, True);
    end;

   Ord(roApplyChanges):
    begin
     ValueBuffer(vbiOldValue).Invalidate(True, True);
     Modified := False;
    end;

   Ord(roEdit), Ord(roInsert):
    begin
     // prevent delayed fetches in edit/insert state, and after cancelchanges. And provide proper OldValue!
     ValueBuffer(vbiValue).Value;
     ValueBuffer(vbiOldValue).AssignFromIntf(ValueBuffer(vbiValue));
     if Operation = Ord(roInsert) then
      begin
       ValueBuffer(vbiValue).SetUnionValue(uvtNull);
       ValueBuffer(vbiValue).Modified := False;
      end;
    end;

   Ord(roRefreshCurrent): ValueBuffer(vbiValue).Invalidate(True, False);
  end;
end;


{ ------------------------- }
{ ---- TGMSqlParameter ---- }
{ ------------------------- }

constructor TGMSqlParameter.Create(const AOwner: TObject; const AName: TGMString; const AValue: RGMUnionValue; const AIsLiteral: Boolean);
begin
  inherited Create;
  FOwner := AOwner;
  FName := AName;
  FValue := AValue;
  FIsLiteral := AIsLiteral;
end;

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

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

procedure TGMSqlParameter.SetUnionValue(const AUnionValue: RGMUnionValue);
begin
  //if FValue = Value then Exit;
  FValue := AUnionValue;
  if Owner is TGMSqlParameterList then TGMSqlParameterList(Owner).OnParameterValueChanged;
end;

procedure TGMSqlParameter.AssignValue(const AValue: RGMUnionValue; const AIsLiteral: Boolean);
begin
  FValue := AValue;
  FIsLiteral := AIsLiteral;
end;


{ ----------------------------- }
{ ---- TGMSqlParameterList ---- }
{ ----------------------------- }

constructor TGMSqlParameterList.Create(const AOwner: TObject);
begin
  inherited Create;
  FOwner := AOwner;
  FParameterList := TGMObjArrayCollection.Create(True, False, True, GMCompareByName, True);
  FReExecuteAfterParamValueChange := cDfltReExecAfterParamValChange;
end;

{destructor TGMSqlParameterList.Destroy;
begin
  GMFreeAndNil(FParameterList);
  inherited Destroy;
end;}

function TGMSqlParameterList.GetCount: PtrInt;
begin
  Result := ParameterList.Count;
end;

function TGMSqlParameterList.GetIntfByName(const Name: TGMString; const IID: TGUID; out Intf): HResult;
begin
  Result := CQIResult[Parameters[Name].GetInterface(IID, Intf)];
end;

function TGMSqlParameterList.GetIntfByPosition(const Position: PtrInt; const IID: TGUID; out Intf): HResult;
begin
  Result := CQIResult[Parameters[Position].GetInterface(IID, Intf)];
end;

procedure TGMSqlParameterList.OnParameterValueChanged;
begin
  if ReExecuteAfterParamValueChange then
   GMCheckExecOperation(Owner, Ord(roScheduleReExecution), '', {$I %CurrentRoutine%});
end;

function TGMSqlParameterList.FindParameterByName(const ParameterName: TGMString; var Parameter: TGMSqlParameter): Boolean;
var PIName: IGMGetName;
begin
  //Result := False;
  //if ParameterName <> '' then
   //begin
    PIName := TGMNameObj.Create(ParameterName, True);
    Result := ParameterList.Find(PIName, Parameter);
   //end;
end;

function TGMSqlParameterList.GetParameter(const AIndex: RGMUnionValue): TGMSqlParameter;
//var Parameter: TGMSqlParameter;
begin
  case AIndex.ValueType of
   uvtInt16, uvtInt32, uvtInt64, uvtDouble:
    Result := ParameterList[AIndex] as TGMSqlParameter;

   uvtString:
    if not FindParameterByName(AIndex, Result) then // Result := Parameter else
     raise EGMException.ObjError(GMFormat(srParamNameNotFound, [AIndex.AsStringDflt]), Owner, {$I %CurrentRoutine%});

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

procedure TGMSqlParameterList.AssignFromObj(const Source: TObject);
var i: Integer; SourceParamList: TGMSqlParameterList;
begin
  if Source is TGMSqlParameterList then
   begin
    ParameterList.Clear;
    SourceParamList := Source as TGMSqlParameterList;
    for i:=0 to SourceParamList.Count-1 do
     ParameterList.Add(TGMSqlParameter.Create(Self, SourceParamList[i].Name, SourceParamList[i].Value, SourceParamList[i].IsLiteral));
     
    ReExecuteAfterParamValueChange := TGMSqlParameterList(Source).ReExecuteAfterParamValueChange;
   end;
end;

procedure TGMSqlParameterList.AssignParamValues(const Source: TObject);
var i: Integer; SourceParamList: TGMSqlParameterList; Parameter: TGMSqlParameter;
begin
  if Source is TGMSqlParameterList then
   begin
    SourceParamList := Source as TGMSqlParameterList;
    for i:=0 to SourceParamList.Count-1 do
     if FindParameterByName(SourceParamList[i].Name, Parameter) then Parameter.AssignValue(SourceParamList[i].Value, SourceParamList[i].IsLiteral);
   end;
end;

procedure TGMSqlParameterList.ParseForParameters;
var oldValues: TGMSqlParameterList; getSqlText: IGMGetText; parameter: TGMSqlParameter; sqlStr, sqlToken: TGMString; chPos: PtrInt;
begin
  if GMGetPropIntfFromIntf(GMObjAsIntf(Owner), cStrSQL, IGMGetText, getSqlText) = S_OK then
   begin
    oldValues := TGMSqlParameterList.Create(nil);
    try
     oldValues.AssignFromObj(Self);
     ParameterList.Clear;
     sqlStr := getSqlText.Text;
     chPos := 1;

     while chPos <= Length(sqlStr) do
      begin
       sqlToken := GMNextSQLToken(chPos, sqlStr, cSqlSeparators + cSqlOperators);
       if (Length(sqlToken) > 1) and (sqlToken[1] = cSqlParamPrefixChar) then
        begin
         System.Delete(sqlToken, 1, 1);
         if not FindParameterByName(sqlToken, parameter) then ParameterList.Add(TGMSqlParameter.Create(Self, sqlToken, uvtNull, False));
        end;
      end;

     AssignParamValues(oldValues);
    finally
     oldValues.Free;
    end;
  end;
end;


{ ----------------------------------- }
{ ---- TGMSQLStatmentPartitioner ---- }
{ ----------------------------------- }

constructor TGMSQLStatmentPartitioner.Create(const AOwner: IUnknown;
                                             const AGetSQLText: TGMGetStringFunc;
                                             const ASetSQLText: TGMSetStringProc;
                                             const ADoParseSQLXxxxPropFunc: TDoParseSQLXxxxPropFunc;
                                             const ARefLifeTime: Boolean);
begin
  inherited Create(AOwner, ARefLifeTime);
  FGetSQLText := AGetSQLText;
  FSetSQLText := ASetSQLText;
  FParseSQLXxxxPropFunc := ADoParseSQLXxxxPropFunc;
end;

function TGMSQLStatmentPartitioner.ParseForSQLXxxxProperties: Boolean;
begin
  if Assigned(FParseSQLXxxxPropFunc) then Result := FParseSQLXxxxPropFunc else Result := True;
end;

function TGMSQLStatmentPartitioner.GetText: TGMString;
begin
  if Assigned(FGetSQLText) then Result := FGetSQLText;
end;

procedure TGMSQLStatmentPartitioner.SetText(const Value: TGMString);
begin
  if Assigned(FSetSQLText) then FSetSQLText(Value);
end;

function TGMSQLStatmentPartitioner.GetTableName: TGMString;
begin
  Result := GMFindTextPart(GetText, cSqlSeparators, [cSqlUpdate, cSqlInto, cSqlFrom], [cSqlSet, cSqlValues, cSqlLeft, cSqlRight, cSqlInner, cSqlOuter, cSqlJoin, cSqlWhere, cSqlGroupBy, cSqlHaving, cSqlOrderBy, cSqlForUpdateOf], True);
end;

procedure TGMSQLStatmentPartitioner.SetTableName(Value: TGMString);
begin
  if Value <> '' then Value := cSqlPartSep + cSqlFrom + ' ' + Value + cSqlPartSep;
  SetText(GMReplaceTextPart(GetText, cSqlSeparators, Value, [cSqlUpdate, cSqlInto, cSqlFrom], [cSqlSet, cSqlValues, cSqlLeft, cSqlRight, cSqlInner, cSqlOuter, cSqlJoin, cSqlWhere, cSqlGroupBy, cSqlHaving, cSqlOrderBy, cSqlForUpdateOf], True));
end;

function TGMSQLStatmentPartitioner.GetSQLSelectedFields: TGMString;
begin
  if ParseForSQLXxxxProperties then
   Result := ExtractSQLSelectList(GetText)
   //Result := GMFindTextPart(GetText, cSqlSeparators, [cSqlSelect, cSqlUpdate, cSqlInsert, cSqlDelete], [cSqlFrom, cSqlLeft, cSqlRight, cSqlInner, cSqlOuter, cSqlJoin, cSqlWhere, cSqlGroupBy, cSqlHaving, cSqlOrderBy, cSqlForUpdateOf], True)
  else
   Result := '';
end;

procedure TGMSQLStatmentPartitioner.SetSQLSelectedFields(Value: TGMString);
begin
  if ParseForSQLXxxxProperties and (GetSQLSelectedFields <> Value) then
   begin
    if Value <> '' then Value := cSqlSelect + ' ' + Value + cSqlPartSep;
    SetText(GMReplaceTextPart(GetText, cSqlSeparators, Value, [cSqlSelect, cSqlUpdate, cSqlInsert, cSqlDelete], [cSqlSet, cSqlValues, cSqlFrom, cSqlLeft, cSqlRight, cSqlInner, cSqlOuter, cSqlJoin, cSqlWhere, cSqlGroupBy, cSqlHaving, cSqlOrderBy, cSqlForUpdateOf], True));
   end;
end;

function TGMSQLStatmentPartitioner.GetSQLWhere: TGMString;
begin
  if ParseForSQLXxxxProperties then
   Result := GMFindTextPart(GetText, cSqlSeparators, [cSqlWhere], [cSqlGroupBy, cSqlHaving, cSqlOrderBy, cSqlForUpdateOf], True)
  else
   Result := '';
end;

procedure TGMSQLStatmentPartitioner.SetSQLWhere(Value: TGMString);
begin
  if ParseForSQLXxxxProperties and (GetSQLWhere <> Value) then
   begin
    if Value <> '' then Value := cSqlPartSep + cSqlWhere + ' ' + Value + cSqlPartSep;
    SetText(GMReplaceTextPart(GetText, cSqlWhiteSpace, Value, [cSqlWhere], [cSqlGroupBy, cSqlHaving, cSqlOrderBy, cSqlForUpdateOf], True));
   end;
end;

function TGMSQLStatmentPartitioner.GetSQLGroupBy: TGMString;
begin
  if ParseForSQLXxxxProperties then
   Result := GMStrip(GMDeleteFirstWord(GMFindTextPart(GetText, cSqlSeparators, [cSqlGroupBy], [cSqlHaving, cSqlOrderBy, cSqlForUpdateOf], True), cSqlSeparators), cSqlSeparators)
  else
   Result := '';
end;

procedure TGMSQLStatmentPartitioner.SetSQLGroupBy(Value: TGMString);
begin
  if ParseForSQLXxxxProperties and (GetSQLGroupBy <> Value) then
   begin
    if Value <> '' then Value := cSqlPartSep + cSqlGroupBy + ' ' + Value + cSqlPartSep;
    SetText(GMReplaceTextPart(GetText, cSqlWhiteSpace, Value, [cSqlGroupBy], [cSqlHaving, cSqlOrderBy, cSqlForUpdateOf], True));
   end;
end;

function TGMSQLStatmentPartitioner.GetSQLHaving: TGMString;
begin
  if ParseForSQLXxxxProperties then
   Result := GMFindTextPart(GetText, cSqlSeparators, [cSqlHaving], [cSqlOrderBy, cSqlForUpdateOf], True)
  else
   Result := '';
end;

procedure TGMSQLStatmentPartitioner.SetSQLHaving(Value: TGMString);
begin
  if ParseForSQLXxxxProperties and (GetSQLHaving <> Value) then
   begin
    if Value <> '' then Value := cSqlPartSep + cSqlHaving + ' ' + Value + cSqlPartSep;
    SetText(GMReplaceTextPart(GetText, cSqlSeparators, Value, [cSqlHaving], [cSqlOrderBy, cSqlForUpdateOf], True));
   end;
end;

function TGMSQLStatmentPartitioner.GetSQLOrderBy: TGMString;
begin
  if ParseForSQLXxxxProperties then
   Result := GMStrip(GMDeleteFirstWord(GMFindTextPart(GetText, cSqlSeparators, [cSqlOrderBy], [cSqlForUpdateOf], True), cSqlSeparators), cSqlSeparators)
  else
   Result := '';
end;

procedure TGMSQLStatmentPartitioner.SetSQLOrderBy(Value: TGMString);
begin
  if ParseForSQLXxxxProperties and (GetSQLOrderBy <> Value) then
   begin
    if Value <> '' then Value := cSqlPartSep + cSqlOrderBy + ' ' + Value + cSqlPartSep;
    SetText(GMReplaceTextPart(GetText, cSqlSeparators, Value, [cSqlOrderBy], [cSqlForUpdateOf], True));
   end;
end;

function TGMSQLStatmentPartitioner.GetSQLForUpdateOf: TGMString;
begin
  if ParseForSQLXxxxProperties then
   Result := GMStrip(GMDeleteFirstWords(GMFindTextPart(GetText, cSqlSeparators, [cSqlForUpdateOf], [''], True), 2, cSqlSeparators), cSqlSeparators)
  else
   Result := '';
end;

procedure TGMSQLStatmentPartitioner.SetSQLForUpdateOf(Value: TGMString);
begin
  if ParseForSQLXxxxProperties and (GetSQLForUpdateOf <> Value) then
   begin
    if Value <> '' then Value := cSqlPartSep + cSqlForUpdateOf + ' ' + Value + cSqlPartSep;
    SetText(GMReplaceTextPart(GetText, cSqlSeparators, Value, [cSqlForUpdateOf], [''], True));
   end;
end;


{ ------------------------ }
{ ---- TGMSqlProperty ---- }
{ ------------------------ }

constructor TGMSqlProperty.Create(const AOwner: TObject; const ASqlText: TGMString; const AParseSQLXxxxPropFunc: TDoParseSQLXxxxPropFunc; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FOwner := AOwner;
  FSQLParser := TGMSQLStatmentPartitioner.Create(Self, GetSQLText, SetSQLText, AParseSQLXxxxPropFunc, False);
  FParameterList := TGMSqlParameterList.Create(AOwner);
  FReExecuteAfterSQLChange := cDfltReExecuteAfterSQLChange;
  FSqlText := ASqlText;
end;

destructor TGMSqlProperty.Destroy;
begin
  GMFreeAndNil(FSQLParser);
  GMFreeAndNil(FParameterList);
  inherited Destroy;
end;

function TGMSqlProperty.GetSQLText: TGMString;
begin
  Result := FSQLText;
end;

procedure TGMSqlProperty.SetSQLText(const AValue: TGMString);
begin
  if GMSameText(AValue, FSQLText) then Exit;
  FSQLText := AValue;
  SQLChanged(Self);
end;

procedure TGMSqlProperty.AssignFromObj(const ASource: TObject);
begin
  if ASource is TGMSqlProperty then 
   begin
    ReExecuteAfterSQLChange := (ASource as TGMSqlProperty).ReExecuteAfterSQLChange;
    SQLText := (ASource as TGMSqlProperty).SQLText;
    SQLParameter := (ASource as TGMSqlProperty).SQLParameter;
   end;
end;

procedure TGMSqlProperty.SQLChanged(const ASender: TObject);
begin
  SQLParameter.ParseForParameters;
  if Assigned(OnAfterSQLChange) then OnAfterSQLChange(ASender);
  if ReExecuteAfterSQLChange then GMCheckExecRSOperation(Owner, roScheduleReExecution, {$I %CurrentRoutine%});
end;

procedure TGMSqlProperty.SetParameterList(const AValue: TGMSqlParameterList);
begin
  SQLParameter.AssignFromObj(AValue);
end;

function TGMSqlProperty.BuildResolvedSQLText: TGMString;
//var i, chPos, NextPos, EndPos: Integer;
//  ParamToken, ParamName, ErrMsg, InsertStr: TGMString;
//  Parameter: TGMSqlParameter;
//  UnresolvedParams: TGMStringArray;
begin
  Result := SQLText;
//chPos := 1;
//while GMFindToken(Result, cSqlParamPrefixChar, chPos, cSqlSeparators + cSqlOperators, False) do
// begin
//  NextPos := chPos;
//  ParamToken := GMNextWord(NextPos, Result, cSqlSeparators + cSqlOperators);
//  ParamName := GMStrip(ParamToken, cSqlParamPrefixChar + cSqlSeparators);
//  if SQLParameter.FindParameterByName(ParamName, Parameter) {and not VarIsEmpty(Parameter.Value)} then
//   begin
//    System.Delete(Result, chPos, Length(ParamToken));
//    if GMVarIsNullOrEmpty(Parameter.Value) then
//     begin
//      Dec(chPos); EndPos := chPos;
//      while (chPos >= 1) and GMIsDelimiter(cSqlOperators + cSqlWhiteSpace, Result, chPos) do Dec(chPos);
//      Inc(chPos);
//      if EndPos >= chPos then System.Delete(Result, chPos, EndPos - chPos + 1);
//      System.Insert(cStrSqlIsNull, Result, chPos);
//      Inc(chPos, Length(cStrSqlIsNull));
//     end
//    else
//     begin
//      if Parameter.IsLiteral then InsertStr := Parameter.Value else InsertStr := GMUnionValueAsSqlLiteral(Parameter.Value);
//      System.Insert(InsertStr, Result, chPos);
//      Inc(chPos, Length(InsertStr));
//     end;
//   end
//  else
//   begin
//    Inc(chPos, Length(ParamToken));
//    GMAddStrToArray(ParamName, UnresolvedParams);
//   end;
// end;
//
//if Length(UnresolvedParams) > 0 then
// begin
//  ErrMsg := srUnresolvedParams;
//  for i:=Low(UnresolvedParams) to High(UnresolvedParams) do ErrMsg := ErrMsg + UnresolvedParams[i] + ', ';
//  raise EGMException.ObjError(GMStrip(ErrMsg, ', '), Self, {$I %CurrentRoutine%});
// end;
end;

{ ---- Properties ---- }

{procedure TGMSqlProperty.SetSQLStrings(const Value: TGMStringArray);
begin
  if Value = nil then Exit;
  SQLParser.SetText(Value.Text);
end;}

function TGMSqlProperty.IDEGetSQLSelectedFields: TGMString;
begin
  Result := SQLParser.GetSQLSelectedFields;
end;

procedure TGMSqlProperty.IDESetSQLSelectedFields(Value: TGMString);
begin
  SQLParser.SetSQLSelectedFields(Value);
end;

function TGMSqlProperty.IDEGetSQLWhere: TGMString;
begin
  Result := SQLParser.GetSQLWhere;
end;

procedure TGMSqlProperty.IDESetSQLWhere(Value: TGMString);
begin
  SQLParser.SetSQLWhere(Value);
end;

function TGMSqlProperty.IDEGetSQLGroupBy: TGMString;
begin
  Result := SQLParser.GetSQLGroupBy;
end;

procedure TGMSqlProperty.IDESetSQLGroupBy(Value: TGMString);
begin
  SQLParser.SetSQLGroupBy(Value);
end;

function TGMSqlProperty.IDEGetSQLHaving: TGMString;
begin
  Result := SQLParser.GetSQLHaving;
end;

procedure TGMSqlProperty.IDESetSQLHaving(Value: TGMString);
begin
  SQLParser.SetSQLHaving(Value);
end;

function TGMSqlProperty.IDEGetTableName: TGMString;
begin
  Result := SQLParser.GetTableName;
end;

procedure TGMSqlProperty.IDESetTableName(Value: TGMString);
begin
  SQLParser.SetTableName(Value);
end;

function TGMSqlProperty.IDEGetSQLOrderBy: TGMString;
begin
  Result := SQLParser.GetSQLOrderBy;
end;

procedure TGMSqlProperty.IDESetSQLOrderBy(Value: TGMString);
begin
  SQLParser.SetSQLOrderBy(Value);
end;

function TGMSqlProperty.IDEGetSQLForUpdateOf: TGMString;
begin
  Result := SQLParser.GetSQLForUpdateOf;
end;

procedure TGMSqlProperty.IDESetSQLForUpdateOf(Value: TGMString);
begin
  SQLParser.SetSQLForUpdateOf(Value);
end;

{ ---- IGMEnumerateItems ---- }

procedure TGMSqlProperty.EnumerateItems(const ItemKind: LongInt; const TellEnumSink: IUnknown; const Parameter: Pointer);
var PIEnumValues: IGMEnumerateItems;
begin
  if (Owner <> nil) and Owner.GetInterface(IGMEnumerateItems, PIEnumValues) then
     PIEnumValues.EnumerateItems(ItemKind, TellEnumSink, Parameter);
end;


{ --------------------------------------- }
{ ---- TGMCascadedContentsProperties ---- }
{ --------------------------------------- }

constructor TGMCascadedContentsProperties.Create(const AOwner: TObject);
begin
  inherited Create;
  FOwner := AOwner;
end;

procedure TGMCascadedContentsProperties.AssignFromObj(const Source: TObject);
begin
  if Source is TGMCascadedContentsProperties then 
   begin
    KeyValueName := TGMCascadedContentsProperties(Source).KeyValueName;
    ParentReferenceValueName := TGMCascadedContentsProperties(Source).ParentReferenceValueName;
   end;
end;

function TGMCascadedContentsProperties.ConfigurationIsValid: Boolean;
begin
  Result := (KeyValueName <> '') and (ParentReferenceValueName <> '');
end;

procedure TGMCascadedContentsProperties.EnumerateItems(const ItemKind: Integer; const TellEnumSink: IUnknown; const Parameter: Pointer);
var PIEnum: IGMEnumerateItems;
begin
  if (Owner <> nil) and Owner.GetInterface(IGMEnumerateItems, PIEnum) then PIEnum.EnumerateItems(ItemKind, TellEnumSink, Parameter);
end;

function TGMCascadedContentsProperties.GetKeyValueName: TGMString;
begin
  Result := KeyValueName;
end;

function TGMCascadedContentsProperties.GetParentReferenceValueName: TGMString;
begin
  Result := ParentReferenceValueName;
end;


{ --------------------------- }
{ ---- TOdbcConnectValue ---- }
{ --------------------------- }

procedure TConnectionStringValue.LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData);
begin
  if ASource <> nil then FStrValue := ASource.ReadString(FName);
end;

procedure TConnectionStringValue.StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData);
begin
  if ADest <> nil then GMStoreString(ADest, FName, FStrValue);
end;


{ ------------------------------------ }
{ ---- TGMConnectionStringStorage ---- }
{ ------------------------------------ }

constructor TGMConnectionStringStorage.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FValues := TGMIntfArrayCollection.Create(True, True, GMCompareByName, True);
  //
  // Aggregated FValueStorage must be created without RefLifeTime to avoid circular reference count problem
  //
  FValueStorage := TGMValueStorageImpl.Create(Self, GetValueByName, SetValueByName, False);
end;

constructor TGMConnectionStringStorage.Create(const AConnectionString: TGMString; const ARefLifeTime: Boolean);
begin
  Create(ARefLifeTime);
  if Length(AConnectionString) > 0 then ParseConnectionString(AConnectionString);
end;

destructor TGMConnectionStringStorage.Destroy;
begin
  FValueStorage.Free;
  inherited;
end;

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

procedure TGMConnectionStringStorage.ParseConnectionString(const AConnectionString: TGMString);
type TQuoteKind = (qkNone, qkSingle, qkDouble, qkBraces);
var startPos, chPos: LongInt; inQuote: TQuoteKind; valName: TGMString; parseVal: Boolean;
  procedure AddEntry;
  var valStr: TGMString;
  begin
    valStr := Copy(AConnectionString, startPos, chPos - StartPos);
    if Length(valStr) >= 1 then
     case valStr[1] of
      '''': valStr := GMRemoveQuotes(valStr, '''', '''');
      '"':  valStr := GMRemoveQuotes(valStr, '"', '"');
      '{':  valStr := GMRemoveQuotes(valStr, '{', '}');
     end;

    if Length(valName) > 0 then SetValueByName(valName, valStr); // GMStrip(Copy(AConnectionString, startPos, chPos - StartPos), '"''{}=')
    valName := '';
    parseVal := False;
    startPos := chPos + 1;
  end;
begin
//if AClearValues then Values.Clear;
  chPos := 1; startPos := chPos; inQuote := qkNone; parseVal := False;

  while chPos <= Length(AConnectionString) do
   begin
    if inQuote <> qkNone then
     begin
      case inQuote of
       qkSingle: if AConnectionString[chPos] = '''' then inQuote := qkNone;
       qkDouble: if AConnectionString[chPos] = '"' then inQuote := qkNone;
       qkBraces: if AConnectionString[chPos] = '}' then inQuote := qkNone;
      end;
     end
    else
     case AConnectionString[chPos] of
      '''': if parseVal then inQuote := qkSingle;
      '"':  if parseVal then inQuote := qkDouble;
      '{':  if parseVal then inQuote := qkBraces;
      '=': if parseVal then Inc(chPos) else
            begin
             valName := Copy(AConnectionString, startPos, chPos - StartPos);
             parseVal := True;
             startPos := chPos + 1;
            end;

      cCnStrEntrySep: AddEntry;
     end;
    Inc(chPos);
   end;
  AddEntry; // <- in case connection string not terminated by ";"
end;

function TGMConnectionStringStorage.ContainsValue(const ValueName: TGMString): Boolean;
var searchName: IGMGetName;
begin
  searchName := TGMNameObj.Create(ValueName);
  Result := GMCollectionContains(Values, searchName);
end;

function TGMConnectionStringStorage.GetValueByName(const AValueName: TGMString; const ADefaultValue: TGMString): TGMString;
var nameObj, foundEntry: IUnknown; getStrVal: IGMGetStringValue;
begin
  nameObj := TGMNameObj.Create(AValueName);
  if Values.Find(nameObj, foundEntry) and GMQueryInterface(foundEntry, IGMGetStringValue, getStrVal) then
    Result := getStrVal.StringValue
  else
    Result := ADefaultValue;
end;

procedure TGMConnectionStringStorage.SetValueByName(const AValueName, AValue: TGMString);
var nameObj, foundEntry: IUnknown; setStrVal: IGMGetSetStringValue;
begin
  nameObj := TGMNameObj.Create(AValueName);
  if not Values.Find(nameObj, foundEntry) then
    Values.Add(TConnectionStringValue.Create(AValueName, AValue))
  else
    if GMQueryInterface(foundEntry, IGMGetSetStringValue, setStrVal) then setStrVal.SetStringValue(AValue);
end;

function TGMConnectionStringStorage.GetText: TGMString; stdcall;
begin
  Result := GMNamesAndValuesAsString(FValues, GMVarToConnectionStrLiteral, cCnStrEntrySep, cCnStrValSep);
end;

procedure TGMConnectionStringStorage.LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData);
var valStgDir: RGMTypedIntf<IGMValueStorageDirectory>; valueNames: TGMStringArray; valName: TGMString; // loadData: IGMLoadStoreData;
begin
  if valStgDir.QueryFrom(ASource) then
   begin
    valStgDir.Intf.ReadValueNames(valueNames);
    for valName in valueNames do SetValueByName(valName, ASource.ReadString(valName));
   end;

  //
  // The following cannot be used here, values existing here but not in the source would be set to empty:
  //
  //if GMQueryInterface(Values, IGMLoadStoreData, loadData) then loadData.LoadData(ASource, ACryptCtrlData);
  //GMIntfCollectionLoadAll(Values, ADest, ACryptCtrlData);
end;

procedure TGMConnectionStringStorage.StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData);
//var storeData: IGMLoadStoreData;
begin
  GMIntfCollectionStoreAll(Values, ADest, ACryptCtrlData);
  //if GMQueryInterface(Values, IGMLoadStoreData, storeData) then storeData.StoreData(ADest, ACryptCtrlData);
end;


{ ------------------------------------ }
{ ---- TGMConnectionStringStorage ---- }
{ ------------------------------------ }

{constructor TGMConnectionStringStorage.Create(const AConnectionString: TGMString = ''; const ARefLifeTime: Boolean = False);
begin
  inherited Create(False, ARefLifeTime, False);
  FValueStorage := TGMValueStorageImpl.Create(Self, ReadString, WriteString, False);
  AsValueString := AConnectionString;
end;

destructor TGMConnectionStringStorage.Destroy;
begin
  GMFreeAndNil(FValueStorage);
  inherited Destroy;
end;

function TGMConnectionStringStorage.GetText: TGMString;
begin
  Result := AsValueString;
end;}


{ ----------------------------- }
{ ---- TGMSchemaProperties ---- }
{ ----------------------------- }

constructor TGMSchemaProperties.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FReExecuteAfterPropertyValueChange := cReExecuteAfterPropertyValueChange;
  SetAll;
  //Reset;
end;

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

//procedure TGMSchemaProperties.Reset;
//begin
//  FSchemaList := cDfltSchemaList;
//  FCatalogName := ''; //cStrNil;
//  FSchemaName := ''; // cStrNil;
//  FTableName := cSqlWildcardChar;
//  FColumnName := cSqlWildcardChar;
//  FTableKind := ''; // cStrTableKindTable;
//  FForeignCatalogName := ''; // cStrNil;
//  FForeignSchemaName := ''; // cStrNil;
//  FForeignTableName := cSqlWildcardChar;
//end;

procedure TGMSchemaProperties.SetAll(ASchemaList: TGMSchemaList; ACatalogName, ASchemaName, ATableName, ATableKind,
                                     AColumnName, AForeignCatalogName, AForeignSchemaName, AForeignTableName: TGMString);
begin
  FSchemaList := ASchemaList;
  FCatalogName := ACatalogName;
  FSchemaName := ASchemaName;
  FTableName := ATableName;
  FTableKind := ATableKind;
  FColumnName := AColumnName;
  FForeignCatalogName := AForeignCatalogName;
  FForeignSchemaName := AForeignSchemaName;
  FForeignTableName := AForeignTableName;
end;

function TGMSchemaProperties.GetSchemaList: TGMSchemaList;
begin
  Result := FSchemaList;
end;

function TGMSchemaProperties.GetCatalogName: TGMString;
begin
  Result := FCatalogName;
end;

function TGMSchemaProperties.GetSchemaName: TGMString;
begin
  Result := FSchemaName;
end;

function TGMSchemaProperties.GetTableName: TGMString;
begin
  Result := FTableName;
end;

function TGMSchemaProperties.GetColumnName: TGMString;
begin
  Result := FColumnName;
end;

function TGMSchemaProperties.GetTableKind: TGMString;
begin
  Result := FTableKind;
end;

function TGMSchemaProperties.GetForeignCatalogName: TGMString;
begin
  Result := FForeignCatalogName;
end;

function TGMSchemaProperties.GetForeignSchemaName: TGMString;
begin
  Result := FForeignSchemaName;
end;

function TGMSchemaProperties.GetForeignTableName: TGMString;
begin
  Result := FForeignTableName;
end;

procedure TGMSchemaProperties.AssignFromObj(const Source: TObject); stdcall;
begin
  if Source is TGMSchemaProperties then
   begin
    SchemaList := TGMSchemaProperties(Source).SchemaList;
    CatalogName := TGMSchemaProperties(Source).CatalogName;
    SchemaName := TGMSchemaProperties(Source).SchemaName;
    TableName := TGMSchemaProperties(Source).TableName;
    ColumnName := TGMSchemaProperties(Source).ColumnName;
    ForeignCatalogName := TGMSchemaProperties(Source).ForeignCatalogName;
    ForeignSchemaName := TGMSchemaProperties(Source).ForeignSchemaName;
    ForeignTableName := TGMSchemaProperties(Source).ForeignTableName;

    ReExecuteAfterPropertyValueChange := TGMSchemaProperties(Source).ReExecuteAfterPropertyValueChange;
   end;
end;

function TGMSchemaProperties.GetText: TGMString; stdcall;
const cStrSchemaDataDiaplayTextFmt = 'List:'#9'%s'#13#13 +
                                     'Database:'#9'%s'#13 +
                                     'Schema:'#9'%s'#13 +
                                     'Table/Proc:'#9'%s'#13 +
                                     'Columnname:'#9'%s'#13 +
                                     'FK Database:'#9'%s'#13 +
                                     'FK Schema:'#9'%s'#13 +
                                     'FK Table:'#9'%s';
begin
  Result := GMFormat(cStrSchemaDataDiaplayTextFmt,
             [GMSchemaListName(SchemaList),
              CatalogName,
              SchemaName,
              TableName,
              ColumnName,
              ForeignCatalogName,
              ForeignSchemaName,
              ForeignTableName]);

end;

procedure TGMSchemaProperties.AfterPropertyValueChange;
begin
  if ReExecuteAfterPropertyValueChange and GMObjIsActive(OwnerObj) then
     GMCheckExecRSOperation(Owner, roReExecuteStatement, {$I %CurrentRoutine%}, Self); // <-- Pass Self because Columns may Change

  //if ReExecuteAfterPropertyValueChange and (Owner is TGMOdbcRecordsetBase) and TGMOdbcRecordsetBase(Owner).Active then
   //TGMOdbcRecordsetBase(Owner).ReExecuteStatement(False);
  if Assigned(OnAfterSchemaDataChange) then OnAfterSchemaDataChange(Self);
end;

procedure TGMSchemaProperties.SetSchemaList(const AValue: TGMSchemaList);
begin
  if AValue <> SchemaList then
   begin
    FSchemaList := AValue;
    AfterPropertyValueChange;
   end;
end;

procedure TGMSchemaProperties.SetCatalogName(const AValue: TGMString);
begin
  if AValue <> CatalogName then
   begin
    FCatalogName := AValue;
    AfterPropertyValueChange;
   end;
end;

procedure TGMSchemaProperties.SetSchemaName(const AValue: TGMString);
begin
  if AValue <> SchemaName then
   begin
    FSchemaName := AValue;
    AfterPropertyValueChange;
   end;
end;

procedure TGMSchemaProperties.SetTableName(const AValue: TGMString);
begin
  if AValue <> TableName then
   begin
    FTableName := AValue;
    AfterPropertyValueChange;
   end;
end;

procedure TGMSchemaProperties.SetColumnName(const AValue: TGMString);
begin
  if AValue <> ColumnName then
   begin
    FColumnName := AValue;
    AfterPropertyValueChange;
   end;
end;

procedure TGMSchemaProperties.SetTableKind(const AValue: TGMString);
begin
  if AValue <> TableKind then
   begin
    FTableKind := AValue;
    AfterPropertyValueChange;
   end;
end;

procedure TGMSchemaProperties.SetForeignCatalogName(const AValue: TGMString);
begin
  if AValue <> ForeignCatalogName then
   begin
    FForeignCatalogName := AValue;
    AfterPropertyValueChange;
   end;
end;

procedure TGMSchemaProperties.SetForeignSchemaName(const AValue: TGMString);
begin
  if AValue <> ForeignSchemaName then
   begin
    FForeignSchemaName := AValue;
    AfterPropertyValueChange;
   end;
end;

procedure TGMSchemaProperties.SetForeignTableName(const AValue: TGMString);
begin
  if AValue <> ForeignTableName then
   begin
    FForeignTableName := AValue;
    AfterPropertyValueChange;
   end;
end;


{ -------------------------------- }
{ ---- TGMRecordsetIntfSource ---- }
{ -------------------------------- }

constructor TGMRecordsetIntfSource.Create(const AOwner: TObject; const ANeededInterfaceIDs: array of TGUID; const AIntfIDsToConnect: array of TGMIntfConnectDataRec);
begin
  inherited Create(AOwner, [IGMGetIntfByName, IConnectionPointContainer],
                           [GMIntfConnectData(IGMPositionChangeNotifications, False),
                            GMIntfConnectData(IGMOperationNotifications, False),
                            GMIntfConnectData(IGMNamedValueChange, False),
                            GMIntfConnectData(IGMSQLChangeNotifications, False),
                            GMIntfConnectData(IGMValidateValues, False)]);

  AddNeededIntfIDs(ANeededInterfaceIDs);
  AddIntfIDsToConnect(AIntfIDsToConnect);
end;

function TGMRecordsetIntfSource.SourceState: LongInt;
begin
  Result := inherited SourceState;
  if Result = CGMUnknownState then Result := Ord(rsInactive);
end;

function TGMRecordsetIntfSource.GetIntfByName(const FieldName: TGMString; const IID: TGUID; out Intf): HResult;
var PIIntfByName: IGMGetIntfByName;
begin
  if GetSourceIntf(IGMGetIntfByName, PIIntfByName) then
   Result := PIIntfByName.GetIntfByName(FieldName, IID, Intf) else Result := E_FAIL;
end;

function TGMRecordsetIntfSource.GetIntfByPosition(const Position: LongInt; const IID: TGUID; out Intf): HResult;
var PIIntfByPosition: IGMGetIntfByPosition;
begin
  if GetSourceIntf(IGMGetIntfByPosition, PIIntfByPosition) then
   Result := PIIntfByPosition.GetIntfByPosition(Position, IID, Intf) else Result := E_FAIL;
end;

function TGMRecordsetIntfSource.FieldCanModify(const FieldName: TGMString): Boolean;
var FieldDef: IGMGetValueDefinition;
begin
  if GetIntfByName(FieldName, IGMGetValueDefinition, FieldDef) = S_OK then
   Result := FieldDef.Updatable
  else
   Result := False;
end;

{function TGMRecordsetIntfSource.DesignTimeDisplayText: TGMString;
var PISqlStr: IGMGetText; PIText: IGMGetText;
begin
  if GetSourceIntf(IGMGetText, PIText) then Result := PIText.DisplayText else
   if (GetPropertyIntf(cStrSQL, IGMGetText, PISqlStr) = S_OK) then Result := PISqlStr.AsString else Result := '';
end;}

function TGMRecordsetIntfSource.CanEdit: Boolean;
begin
  Result := GMObjectCanBeEdited(InterfaceSource);
end;

function TGMRecordsetIntfSource.Edit: Boolean;
begin
  Result := GMEditOrInsertIntf(InterfaceSource);
end;


{ ---- IGMEnumerateItems ---- }

procedure TGMRecordsetIntfSource.EnumerateItems(const ItemKind: LongInt; const TellEnumSink: IUnknown; const Parameter: Pointer);
var PIEnumValues: IGMEnumerateItems;
begin
  if GetSourceIntf(IGMEnumerateItems, PIEnumValues) then PIEnumValues.EnumerateItems(ItemKind, TellEnumSink, Parameter);
end;


{ ---- IGMPositionChangeNotifications ---- }

procedure TGMRecordsetIntfSource.BeforePositionChange;
begin
  if Assigned(OnbeforePositionChange) then OnbeforePositionChange;
end;

procedure TGMRecordsetIntfSource.AfterPositionChange;
begin
  if Assigned(OnAfterPositionChange) then OnAfterPositionChange;
end;


{ ---- IGMOperationNotifications ----}

procedure TGMRecordsetIntfSource.BeforeOperation(const Operation: LongInt; const Parameter: IUnknown = nil);
begin
  if Assigned(OnBeforeOperation) then OnBeforeOperation(Operation, Parameter);
end;

procedure TGMRecordsetIntfSource.AfterOperation(const Operation: LongInt; const Parameter: IUnknown = nil);
begin
  if Assigned(OnAfterOperation) then OnAfterOperation(Operation, Parameter);
end;


{ ---- IGMNamedValueChange ----}

procedure TGMRecordsetIntfSource.AfterValueChange(const ValueName: TGMString);
begin
  if Assigned(OnAfterFieldValueChange) then OnAfterFieldValueChange(InterfaceSource, ValueName);
end;


{ ---- IGMSQLChangeNotification ----}

procedure TGMRecordsetIntfSource.AfterSQLChange;
begin
  if Assigned(OnAfterSQLChange) then OnAfterSQLChange;
end;

procedure TGMRecordsetIntfSource.ValidateValues;
begin
  if Assigned(OnValidateFieldValues) then OnValidateFieldValues;
end;


{ ---------------------------------- }
{ ---- TGMRecordsetMasterSource ---- }
{ ---------------------------------- }

constructor TGMRecordsetMasterSource.Create(const AOwner: TObject; const ANeededInterfaceIDs: array of TGUID);
begin
  inherited Create(AOwner, ANeededInterfaceIDs, []);
  FAutoActivate := cDfltAutoActivate;
end;


{ ---------------------------- }
{ ---- TGMFieldIntfSource ---- }
{ ---------------------------- }

{procedure TGMFieldIntfSource.AssignFromObj(Source: TPersistent);
begin
  inherited AssignFromObj(Source);
  if Source is TGMFieldIntfSource then FieldName := TGMFieldIntfSource(Source).FieldName;
end;}

function TGMFieldIntfSource.GetFieldIntf(const IID: TGUID; out Intf): HResult;
begin
  Result := GetIntfByName(FieldName, IID, Intf);
end;

{function TGMFieldIntfSource.DesignTimeDisplayText: TGMString;
var PITableName: IGMGetTableName; TableName: TGMString;
begin
  if (GetPropertyIntf(cStrSQL, IGMGetTableName, PITableName) = S_OK) then TableName := PITableName.TableName else TableName := '';
  Result := GMStrip(GMFormat('%s.%s', [TableName, FieldName]), '.');
end;}

function TGMFieldIntfSource.FieldCanModify: Boolean;
begin
  Result := FieldCanModify(FieldName);
end;

function TGMFieldIntfSource.Edit: Boolean;
begin
  Result := FieldCanModify and inherited Edit;
end;

function TGMFieldIntfSource.GetFieldName: TGMString;
begin
  Result := FFieldName;
end;

procedure TGMFieldIntfSource.SetFieldName(const Value: TGMString);
var OldFieldName: TGMString;
begin
  if Value <> FieldName then
   begin
    OldFieldName := FFieldName;
    FFieldName := Value;
    if Assigned(OnAfterFieldNameChange) then OnAfterFieldNameChange(Self, OldFieldName, Value);
   end;
end;


{ ----------------------------- }
{ ---- TGMLookupIntfSource ---- }
{ ----------------------------- }

constructor TGMLookupIntfSource.Create(const AOwner: TObject);
begin
  inherited Create(AOwner, [IGMLookupValues], []);
end;

procedure TGMLookupIntfSource.LimitSearchFieldIndex;
begin
  FDisplaySearchFieldIdx := GMBoundedInt(DisplaySearchFieldIdx, Low(DisplayFieldNameList), High(DisplayFieldNameList));
end;

procedure TGMLookupIntfSource.SetDisplaySearchFieldIdx(const Value: Integer);
begin
  if Value <> DisplaySearchFieldIdx then
   begin
    FDisplaySearchFieldIdx := Value;
    LimitSearchFieldIndex;
   end;
end;

procedure TGMLookupIntfSource.SetDisplayFieldNames(const Value: TGMString);
var chPos: PtrInt; NextFieldName: TGMString;
begin
  if Value <> DisplayFieldNames then
   begin
    SetLength(FDisplayFieldNameList, 0);
    chPos := 1;
    repeat
     NextFieldName := GMExtractNextFieldName(chPos, Value);
     if NextFieldName <> '' then GMAddStrToArray(NextFieldName, FDisplayFieldNameList);
    until NextFieldName = '';
    FDisplayFieldNames := Value;
    LimitSearchFieldIndex;
   end;
end;

{procedure TGMLookupIntfSource.AssignFromObj(Source: TPersistent);
begin
  inherited AssignFromObj(Source);
  if Source is TGMLookupIntfSource then
   begin
    KeyFieldName := TGMLookupIntfSource(Source).KeyFieldName;
    DisplayFieldNames := TGMLookupIntfSource(Source).DisplayFieldNames;
    DisplaySearchFieldIdx := TGMLookupIntfSource(Source).DisplaySearchFieldIdx;
   end;
end;}


{ --------------------------- }
{ ---- TGMTreeIntfSource ---- }
{ --------------------------- }

constructor TGMTreeIntfSource.Create(const AOwner: TObject);
begin
  inherited Create(AOwner, [IGMCreateCopyQI, IGMGetPropertyIntf, IGMUnidirectionalCursor], []);
  FFixedImageIndex := cInvalidItemIdx;
  FFixedSelectedImageIndex := cInvalidItemIdx;
  FAlwaysNotify := cDfltTreeNotify;
end;

procedure TGMTreeIntfSource.SetKeyFieldName(const Value: TGMString);
var OldFieldName: TGMString;
begin
  if Value <> KeyFieldName then
   begin
    OldFieldName := KeyFieldName;
    FKeyFieldName := Value;
    if Assigned(OnAfterFieldNameChange) then OnAfterFieldNameChange(Self, OldFieldName, Value);
   end;
end;

procedure TGMTreeIntfSource.SetNodeTitleFieldNames(const Value: TGMString);
var chPos: PtrInt; OldFieldName, NextFieldName: TGMString;
begin
  if Value <> NodeTitleFieldNames then
   begin
    OldFieldName := NodeTitleFieldNames;
    SetLength(FNodeTitleFieldNameList, 0);
    chPos := 1;
    repeat
     NextFieldName := GMExtractNextFieldName(chPos, Value);
     if NextFieldName <> '' then GMAddStrToArray(NextFieldName, FNodeTitleFieldNameList);
    until NextFieldName = '';
    FNodeTitleFieldNames := Value;
    if Assigned(OnAfterFieldNameChange) then OnAfterFieldNameChange(Self, OldFieldName, Value);
   end;
end;

procedure TGMTreeIntfSource.SetParentFieldName(const Value: TGMString);
var OldFieldName: TGMString;
begin
  if Value <> ParentFieldName then
   begin
    OldFieldName := ParentFieldName;
    FParentFieldName := Value;
    if Assigned(OnAfterFieldNameChange) then OnAfterFieldNameChange(Self, OldFieldName, Value);
   end;
end;

procedure TGMTreeIntfSource.SetImageIndexFieldName(const Value: TGMString);
var OldFieldName: TGMString;
begin
  if Value <> ImageIndexFieldName then
   begin
    OldFieldName := ImageIndexFieldName;
    FImageIndexFieldName := Value;
    if Assigned(OnAfterFieldNameChange) then OnAfterFieldNameChange(Self, OldFieldName, Value);
   end;
end;

procedure TGMTreeIntfSource.SetSelectedIndexFieldName(const Value: TGMString);
var OldFieldName: TGMString;
begin
  if Value <> SelectedIndexFieldName then
   begin
    OldFieldName := SelectedIndexFieldName;
    FSelectedIndexFieldName := Value;
    if Assigned(OnAfterFieldNameChange) then OnAfterFieldNameChange(Self, OldFieldName, Value);
   end;
end;

procedure TGMTreeIntfSource.SetStateImageIdxFieldName(const Value: TGMString);
var OldFieldName: TGMString;
begin
  if Value <> StateImageIdxFieldName then
   begin
    OldFieldName := StateImageIdxFieldName;
    FStateImageIdxFieldName := Value;
    if Assigned(OnAfterFieldNameChange) then OnAfterFieldNameChange(Self, OldFieldName, Value);
   end;
end;

{function TGMTreeIntfSource.DesignTimeDisplayText: TGMString;
var PITableName: IGMGetTableName; TableName: TGMString;
begin
  if (GetPropertyIntf(cStrSQL, IGMGetTableName, PITableName) = S_OK) then TableName := PITableName.TableName else TableName := RStrUnknown;
  Result := GMFormat(srTreeDesignDisplayFmt, [TableName, KeyFieldName, ParentFieldName, NodeTitleFieldNames, ImageIndexFieldName, SelectedIndexFieldName, StateImageIdxFieldName]);
end;}

{procedure TGMTreeIntfSource.AssignFromObj(Source: TPersistent);
begin
  inherited AssignFromObj(Source);
  if Source is TGMTreeIntfSource then
   begin
    KeyFieldName := TGMTreeIntfSource(Source).KeyFieldName;
    NodeTitleFieldNames := TGMTreeIntfSource(Source).NodeTitleFieldNames;
    ParentFieldName := TGMTreeIntfSource(Source).ParentFieldName;
    ImageIndexFieldName := TGMTreeIntfSource(Source).ImageIndexFieldName;
    SelectedIndexFieldName := TGMTreeIntfSource(Source).SelectedIndexFieldName;
   end;
end;}


{ -------------------------------- }
{ ---- TGMInterfaceSourceLink ---- }
{ -------------------------------- }

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

  CreateConnectionPoint(IGMActiveChangeNotifications);
  CreateConnectionPoint(IGMOperationNotifications);
  CreateConnectionPoint(IGMPositionChangeNotifications);
  CreateConnectionPoint(IGMNamedValueChange);
  CreateConnectionPoint(IGMValidateValues);
  CreateConnectionPoint(IGMSQLChangeNotifications);

  FInterfaceSource := TGMRecordsetIntfSource.Create(Self, NeededSourceIIDs, []);
  SetupIntfSourceConnector(FInterfaceSource);
end;

destructor TGMInterfaceSourceLink.Destroy;
begin
  inherited Destroy;
  GMFreeAndNil(FInterfaceSource);
end;

function TGMInterfaceSourceLink.NeededSourceIIDs: TGMInterfaceIDArray;
begin
  Result := Default(TGMInterfaceIDArray);
  //SetLength(Result, 0);
end;

procedure TGMInterfaceSourceLink.SetupIntfSourceConnector(const IntfConnector: TGMRecordsetIntfSource);
begin
  if IntfConnector <> nil then
   begin
    IntfConnector.OnAfterIntfSourceChange := AfterInterfaceSrcObjChange;
    IntfConnector.OnBeforeActiveChange := BeforeActiveChange;
    IntfConnector.OnAfterActiveChange := AfterActiveChange;
    IntfConnector.OnBeforePositionChange := BeforePositionChange;
    IntfConnector.OnAfterPositionChange := AfterPositionChange;
    IntfConnector.OnBeforeOperation := BeforeOperation;
    IntfConnector.OnAfterOperation := AfterOperation;
    IntfConnector.OnAfterFieldValueChange := AfterValueChange2;
    IntfConnector.OnValidateFieldValues := ValidateValues;
    IntfConnector.OnAfterSQLChange := AfterSQLChange;
   end;
end;

procedure TGMInterfaceSourceLink.SetInterfaceSource(const Value: TGMRecordsetIntfSource);
begin
  InterfaceSource.AssignFromObj(Value);
end;

procedure TGMInterfaceSourceLink.AfterInterfaceSrcObjChange(const OldSource, NewSource: IUnknown);
begin
  if Assigned(OnAfterIntfSourceChange) then OnAfterIntfSourceChange(OldSource, NewSource);
end;

function TGMInterfaceSourceLink.GetActive: Boolean;
begin
  Result := InterfaceSource.SourceIsActive;
end;

procedure TGMInterfaceSourceLink.InternalOpen;
begin
  GMSetIntfActive(InterfaceSource.InterFaceSource, True, {$I %CurrentRoutine%});
end;

function TGMInterfaceSourceLink.GetNotifyDisableCount: LongInt;
var notifications: IGMEnableNotifications;
begin
  //Result := inherited GetNotifyDisableCount;
  if InterfaceSource.GetSourceIntf(IGMEnableNotifications, notifications) then
     Result := notifications.NotifyDisableCount else Result := 0;
end;

function TGMInterfaceSourceLink.EnableNotifications(const NotificationOnReEnable: LongInt = Ord(rgNone)): LongInt;
var notifications: IGMEnableNotifications;
begin
  //Result := inherited EnableNotifications(NotificationOnReEnable);
  if InterfaceSource.GetSourceIntf(IGMEnableNotifications, notifications) then
     Result := notifications.EnableNotifications(NotificationOnReEnable) else Result := 0;
end;

function TGMInterfaceSourceLink.DisableNotifications(const NotificationOnFirstDisable: LongInt = Ord(rgNone)): LongInt;
var notifications: IGMEnableNotifications;
begin
  //Result := inherited DisableNotifications(NotificationOnFirstDisable);
  if InterfaceSource.GetSourceIntf(IGMEnableNotifications, notifications) then
     Result := notifications.DisableNotifications(NotificationOnFirstDisable) else Result := 0;
end;

function TGMInterfaceSourceLink.GetPropertyIntf(const PropertyName: TGMString; const IID: TGUID; out Intf): HResult;
begin
  Result := GMGetPropIntfFromIntf(InterfaceSource.InterfaceSource, PropertyName, IID, Intf);
end;

function TGMInterfaceSourceLink.GetColumnSortOrder(const ColumnName: TGMString): LongInt;
var getSort: IGMGetColumnSortOrder;
begin
  if InterfaceSource.GetSourceIntf(IGMGetColumnSortOrder, getSort) then
     Result := getSort.GetColumnSortOrder(ColumnName) else Result := 0;
end;

procedure TGMInterfaceSourceLink.SetColumnSortOrder(const ColumnName: TGMString; const SortOrder: LongInt; const Cumulative, ReExecuteWhenChanged: Boolean);
var setSort: IGMSetColumnSortOrder;
begin
  if InterfaceSource.GetSourceIntf(IGMSetColumnSortOrder, setSort) then
     setSort.SetColumnSortOrder(ColumnName, SortOrder, Cumulative, ReExecuteWhenChanged);
end;

function TGMInterfaceSourceLink.GetState: LongInt; stdcall;
begin
  Result := InterfaceSource.SourceState;
end;

procedure TGMInterfaceSourceLink.EnumerateItems(const ItemKind: LongInt; const TellEnumSink: IUnknown; const Parameter: Pointer); stdcall;
begin
  InterfaceSource.EnumerateItems(ItemKind, TellEnumSink, Parameter);
end;

function TGMInterfaceSourceLink.CanExecuteOperation(const Operation: LongInt; const Parameter: IUnknown = nil): Boolean; stdcall;
var PICanExecOp: IGMCanExecuteOperation;
begin
  Result := InterfaceSource.GetSourceIntf(IGMCanExecuteOperation, PICanExecOp) and PICanExecOp.CanExecuteOperation(Operation, Parameter);
end;

function TGMInterfaceSourceLink.ExecuteOperation(const Operation: LongInt; const Parameter: IUnknown = nil): Boolean; stdcall;
var execOp: IGMExecuteOperation;
begin
  Result := InterfaceSource.GetSourceIntf(IGMExecuteOperation, execOp) and execOp.ExecuteOperation(Operation, Parameter);
end;

function TGMInterfaceSourceLink.GetPosition: PtrInt;
var getPos: IGMGetPosition;
begin
  if InterfaceSource.GetSourceIntf(IGMGetPosition, getPos) then Result := getPos.Position else Result := CGMUnknownPosition;
end;

procedure TGMInterfaceSourceLink.SetPosition(const Value: PtrInt);
var getSetPos: IGMGetSetPosition;
begin
  if InterfaceSource.GetSourceIntf(IGMGetSetPosition, getSetPos) then getSetPos.Position := Value;
end;

function TGMInterfaceSourceLink.AskBoolean(const ValueId: LongInt): LongInt;
var askBool: IGMAskBoolean;
begin
  if InterfaceSource.GetSourceIntf(IGMAskBoolean, askBool) then Result := askBool.AskBoolean(ValueId) else Result := Ord(barUnknown);
end;

function TGMInterfaceSourceLink.AskInteger(const ValueId: LongInt): LongInt;
var askInt: IGMAskInteger;
begin
  if InterfaceSource.GetSourceIntf(IGMAskInteger, askInt) then Result := askInt.AskInteger(ValueId) else Result := 0;
end;

function TGMInterfaceSourceLink.GetIntfByName(const FieldName: TGMString; const IID: TGUID; out Intf): HResult;
begin
  Result := InterfaceSource.GetIntfByName(FieldName, IID, Intf);
end;

function TGMInterfaceSourceLink.GetIntfByPosition(const Position: PtrInt; const IID: TGUID; out Intf): HResult;
var intfByPos: IGMGetIntfByPosition;
begin
  if InterfaceSource.GetSourceIntf(IGMGetIntfByPosition, intfByPos) then
   Result := intfByPos.GetIntfByPosition(Position, IID, Intf) else Result := E_FAIL;
end;

function TGMInterfaceSourceLink.GetCount: PtrInt;
var count: IGMGetCount;
begin
  if InterfaceSource.GetSourceIntf(IGMGetCount, count) then Result := count.Count else Result := cGMUnknownCount;
end;

function TGMInterfaceSourceLink.CaptureState: IUnknown;
var PISaveRestore: IGMSaveRestoreState;
begin
  if InterfaceSource.GetSourceIntf(IGMSaveRestoreState, PISaveRestore) then Result := PISaveRestore.CaptureState else Result := nil;
end;

procedure TGMInterfaceSourceLink.RestoreState(const State: IUnknown);
var PISaveRestore: IGMSaveRestoreState;
begin
  if InterfaceSource.GetSourceIntf(IGMSaveRestoreState, PISaveRestore) then PISaveRestore.RestoreState(State);
end;

function TGMInterfaceSourceLink.GetBOF: Boolean;
var PIUniCur: IGMUnidirectionalCursor;
begin
  if InterfaceSource.GetSourceIntf(IGMUnidirectionalCursor, PIUniCur) then Result := PIUniCur.BOF else Result := True;
end;

function TGMInterfaceSourceLink.GetEOF: Boolean;
var PIUniCur: IGMUnidirectionalCursor;
begin
  if InterfaceSource.GetSourceIntf(IGMUnidirectionalCursor, PIUniCur) then Result := PIUniCur.EOF else Result := True;
end;

procedure TGMInterfaceSourceLink.MoveToNext;
var PIUniCur: IGMUnidirectionalCursor;
begin
  if InterfaceSource.GetSourceIntf(IGMUnidirectionalCursor, PIUniCur) then PIUniCur.MoveToNext;
end;

procedure TGMInterfaceSourceLink.MoveToPrevious;
var PIBiCur: IGMBidirectionalCursor;
begin
  if InterfaceSource.GetSourceIntf(IGMBidirectionalCursor, PIBiCur) then PIBiCur.MoveToPrevious;
end;

procedure TGMInterfaceSourceLink.MoveToFirst;
var PIFirstLast: IGMCursorFirstLast;
begin
  if InterfaceSource.GetSourceIntf(IGMCursorFirstLast, PIFirstLast) then PIFirstLast.MoveToFirst;
end;

procedure TGMInterfaceSourceLink.MoveToLast;
var PIFirstLast: IGMCursorFirstLast;
begin
  if InterfaceSource.GetSourceIntf(IGMCursorFirstLast, PIFirstLast) then PIFirstLast.MoveToLast;
end;

procedure TGMInterfaceSourceLink.AfterValueChange(const FieldName: TGMString);
var PIFieldValChange: IGMNamedValueChange;
begin
  if InterfaceSource.GetSourceIntf(IGMNamedValueChange, PIFieldValChange) then PIFieldValChange.AfterValueChange(FieldName);
end;

function TGMInterfaceSourceLink.GetAttributes: Longword;
var PIGetAttr: IGMGetAttributes;
begin
  if InterfaceSource.GetSourceIntf(IGMGetAttributes, PIGetAttr) then Result := PIGetAttr.Attributes else Result := 0;
end;

procedure TGMInterfaceSourceLink.SetAttributes(const Value: Longword);
var PISetAttr: IGMGetSetAttributes;
begin
  if InterfaceSource.GetSourceIntf(IGMGetSetAttributes, PISetAttr) then PISetAttr.Attributes := Value;
end;

function TGMInterfaceSourceLink.LookupValues(const SQLCriteria: TGMString; const Values: IUnknown): Boolean;
var PILookup: IGMLookupValues;
begin
  if InterfaceSource.GetSourceIntf(IGMLookupValues, PILookup) then Result := PILookup.LookupValues(SQLCriteria, Values) else Result := False;
end;

function TGMInterfaceSourceLink.LocateValues(const Values: IUnknown): Boolean;
var PILocate: IGMLocateValues;
begin
  if InterfaceSource.GetSourceIntf(IGMLocateValues, PILocate) then Result := PILocate.LocateValues(Values) else Result := False;
end;

function TGMInterfaceSourceLink.PositionOfValues(const Values: IUnknown; var FindPos: LongInt): Boolean;
var PIPosOfValues: IGMPositionOfValues;
begin
  if InterfaceSource.GetSourceIntf(IGMPositionOfValues, PIPosOfValues) then Result := PIPosOfValues.PositionOfValues(Values, FindPos) else Result := False;
end;


{ ---- Notifications from source ---- }

procedure TGMInterfaceSourceLink.BeforeActiveChange(const NewActive: Boolean);
begin
  NotifyBeforeActiveChange(NewActive);
end;

procedure TGMInterfaceSourceLink.AfterActiveChange(const NewActive: Boolean);
begin
  NotifyAfterActiveChange(NewActive);
end;

procedure TGMInterfaceSourceLink.BeforePositionChange;
begin
  if Assigned(OnBeforePositionChange) then OnBeforePositionChange;
  GMCpcCallNotifySinks(Self, IGMPositionChangeNotifications, GMCallSinkBeforePositionChange, NotifyDisableCount = 0, []);
end;

procedure TGMInterfaceSourceLink.AfterPositionChange;
begin
  GMCpcCallNotifySinks(Self, IGMPositionChangeNotifications, GMCallSinkAfterPositionChange, NotifyDisableCount = 0, []);
  if Assigned(OnAfterPositionChange) then try OnAfterPositionChange; except end;
end;

procedure TGMInterfaceSourceLink.BeforeOperation(const Operation: LongInt; const Parameter: IUnknown = nil);
begin
  if Assigned(OnBeforeOperation) then OnBeforeOperation(Operation, Parameter);
  GMCpcCallNotifySinks(Self, IGMOperationNotifications, GMCallSinkBeforeOperation, NotifyDisableCount = 0, [Operation, Parameter]);
end;

procedure TGMInterfaceSourceLink.AfterOperation(const Operation: LongInt; const Parameter: IUnknown = nil);
begin
  GMCpcCallNotifySinks(Self, IGMOperationNotifications, GMCallSinkAfterOperation, NotifyDisableCount = 0, [Operation, Parameter]);
  if Assigned(OnAfterOperation) then try OnAfterOperation(Operation, Parameter); finally end;
end;

procedure TGMInterfaceSourceLink.AfterValueChange2(Sender: IUnknown; const FieldName: TGMString);
begin
  GMCpcCallNotifySinks(Self, IGMNamedValueChange, GMCallSinkAfterFieldValueChange, NotifyDisableCount = 0, [FieldName]);
  if Assigned(OnAfterFieldValueChange) then try OnAfterFieldValueChange(Sender, FieldName); except end;
end;

procedure TGMInterfaceSourceLink.ValidateValues;
begin
  GMCpcCallNotifySinks(Self, IGMValidateValues, GMCallSinkValidateValue, NotifyDisableCount = 0, []);
  if Assigned(OnValidateFieldValues) then OnValidateFieldValues;
end;

procedure TGMInterfaceSourceLink.AfterSQLChange;
begin
  GMCpcCallNotifySinks(Self, IGMSQLChangeNotifications, GMCallSinkAfterSQLChange, NotifyDisableCount = 0, []);
  if Assigned(OnAfterSQLChange) then try OnAfterSQLChange; except end;
end;


{ -------------------------------- }
{ ---- TGMQualifiedSourceLink ---- }
{ -------------------------------- }

procedure TGMQualifiedSourceLink.TellEnumString(const ItemKind: LongInt; const Value: TGMString; const Parameter: Pointer);
begin
  if FTellEnumSink <> nil then FTellEnumSink.TellEnumString(ItemKind, GMStringJoin(FEnumQualifierName, cSqlQualSep, Value), Parameter);
end;

procedure TGMQualifiedSourceLink.EnumerateValuesOfIntfSource(const Source: TGMRecordsetIntfSource; const ItemKind: LongInt);
var PIName: IGMGetName;
begin
  if (Source <> nil) and Source.GetSourceIntf(IGMGetName, PIName) then
   begin
    FEnumQualifierName := PIName.Name;
    Source.EnumerateItems(ItemKind, Self);
   end;
end;

procedure TGMQualifiedSourceLink.InternalEnumerateValues(const ItemKind: LongInt);
begin
  EnumerateValuesOfIntfSource(InterfaceSource, ItemKind);
end;

procedure TGMQualifiedSourceLink.EnumerateItems(const ItemKind: LongInt; const ATellEnumSink: IUnknown; const Parameter: Pointer);
begin
  if (ATellEnumSink <> nil) and (ATellEnumSink.QueryInterface(IGMTellEnumString, FTellEnumSink) = S_OK) then
   try
    InternalEnumerateValues(ItemKind);
   finally
    FTellEnumSink := nil;
   end;
end;


{ ------------------------------- }
{ ---- TGMSourceStateWrapper ---- }
{ ------------------------------- }

constructor TGMSourceStateWrapper.Create(const Source: IUnknown);
var PISRState: IGMSaveRestoreState; PISourceName: IGMGetName;
begin
  inherited Create(False);
  if Source <> nil then
   begin
    if Source.QueryInterface(IGMSaveRestoreState, PISRState) = S_OK then FSourceState := PISRState.CaptureState;
    if Source.QueryInterface(IGMGetName, PISourceName) = S_OK then FName := PISourceName.Name;
   end;
end;

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

procedure TGMSourceStateWrapper.RestoreState(const Dest: IUnknown);
var PISRState: IGMSaveRestoreState; PIDestName: IGMGetName;
begin
  if (Dest <> nil) and
     (Dest.QueryInterface(IGMGetName, PIDestName) = S_OK) and
     GMSameText(FName, PIDestName.Name) and
     (Dest.QueryInterface(IGMSaveRestoreState, PISRState) = S_OK) then PISRState.RestoreState(FSourceState);
end;


{ --------------------------------- }
{ ---- TGMMultiLinkStateHolder ---- }
{ --------------------------------- }

constructor TGMMultiLinkStateHolder.Create(const AMultiLink: TGMInterfaceMultiSourceLink);
var i: Integer;
begin
  inherited Create(True);
  Assert(AMultiLink <> nil);
  FMasterState := TGMSourceStateWrapper.Create(AMultiLink.InterfaceSource.InterfaceSource);
  FSourceStates := TGMObjArrayCollection.Create(True, True, True, GMCompareByName);
  for i:=0 to AMultiLink.SourceList.Count-1 do
   FSourceStates.Add(TGMSourceStateWrapper.Create((AMultiLink.SourceList[i] as TGMObjInterfaceConnector).InterfaceSource));
end;

destructor TGMMultiLinkStateHolder.Destroy;
begin
  GMFreeAndNil(FMasterState);
  GMFreeAndNil(FSourceStates);
  inherited Destroy;                                               
end;

procedure TGMMultiLinkStateHolder.RestoreToMultiLink(const AMultiLink: IMultiLinkSources);
var i: LongInt; PISourceName: IGMGetName; PINameObj: IUnknown; intfSrc: IGMGetInterfaceSource; State: TGMSourceStateWrapper;
begin
  if GMQueryInterface(AMultiLink, IGMGetInterfaceSource, intfSrc) then
   begin
    FMasterState.RestoreState(intfSrc.InterfaceSource);
    for i:=0 to AMultiLink.SourceCount-1 do
     if AMultiLink.Sources[i].QueryInterface(IGMGetName, PISourceName) = S_OK then
      begin
       PINameObj := TGMNameObj.Create(PISourceName.Name, True);
       if FSourceStates.Find(PINameObj, State) then State.RestoreState(AMultiLink.Sources[i]);
      end;
   end;
end;


{ ------------------------------------- }
{ ---- TGMInterfaceMultiSourceLink ---- }
{ ------------------------------------- }

constructor TGMInterfaceMultiSourceLink.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FSourceList := TGMObjArrayCollection.Create(True);
end;

destructor TGMInterfaceMultiSourceLink.Destroy;
begin
  GMFreeAndNil(FSourceList);
  inherited Destroy;
end;

function TGMInterfaceMultiSourceLink.NeededSourceIIDs: TGMInterfaceIDArray;
begin
  Result := inherited NeededSourceIIDs;
  SetLength(Result, Length(Result)+1);
  Result[High(Result)] := IGMGetName;
end;

procedure TGMInterfaceMultiSourceLink.InternalOpen;
var i: integer;
begin
  for i:=0 to SourceList.Count-1 do GMSetIntfActive((SourceList[i] as TGMObjInterfaceConnector).InterfaceSource, True, {$I %CurrentRoutine%});
  inherited InternalOpen;
end;

procedure TGMInterfaceMultiSourceLink.AddSourceObj(const SourceObj: TObject);
var Connector: TGMRecordsetIntfSource; i: integer;
begin
  Connector := TGMRecordsetIntfSource.Create(Self, NeededSourceIIDs, []);
  //SetupIntfSourceConnector(Connector); <- mmmhhh?
  Connector.InterfaceSource := GMObjAsIntf(SourceObj);
  SourceList.Add(Connector);

  if Active then
   begin
    GMSetIntfActive(InterfaceSource.InterFaceSource, False, {$I %CurrentRoutine%});
    for i:=0 to SourceList.Count-1 do GMSetIntfActive((SourceList[i] as TGMObjInterfaceConnector).InterfaceSource, False, {$I %CurrentRoutine%});
    Open;
   end;
end;

procedure TGMInterfaceMultiSourceLink.RemoveSourceObj(const SourceObj: TObject);
var i: Integer;
begin
  for i:=SourceList.Count-1 downto 0 do
   if (SourceList[i] as TGMRecordsetIntfSource).InterfaceSource = GMObjAsIntf(SourceObj) then SourceList.RemoveByIdx(i);
end;

{ ---- IMultiLinkSources ---- }

function TGMInterfaceMultiSourceLink.GetMasterSource: IUnknown;
begin
  Result := InterfaceSource.InterfaceSource;
end;

function TGMInterfaceMultiSourceLink.GetSourceCount: LongInt;
begin
  Result := SourceList.Count;
end;

function TGMInterfaceMultiSourceLink.GetSource(Idx: LongInt): IUnknown;
begin
  Result := (SourceList[Idx] as TGMObjInterfaceConnector).InterfaceSource;
end;

{ ---- override with new semantic ---- }

procedure TGMInterfaceMultiSourceLink.InternalEnumerateValues(const ItemKind: LongInt);
var i: Integer;
begin
  inherited InternalEnumerateValues(ItemKind);
  for i:=0 to SourceList.Count-1 do EnumerateValuesOfIntfSource(SourceList[i] as TGMRecordsetIntfSource, ItemKind);
end;

function TGMInterfaceMultiSourceLink.FindSourceForQualifier(const Qualifier: TGMString; var Source: TGMRecordsetIntfSource): Boolean;
var i: integer; PIName: IGMGetName;
begin
  Result := False;
  if Qualifier <> '' then
   if InterfaceSource.GetSourceIntf(IGMGetName, PIName) and GMSameText(Qualifier, PIName.Name) then
    begin
     Source := InterfaceSource; Result := True;
    end
   else
    for i:=0 to SourceList.Count-1 do
     if (SourceList[i] as TGMObjInterfaceConnector).GetSourceIntf(IGMGetName, PIName) and GMSameText(Qualifier, PIName.Name) then
      begin
       Source := (SourceList[i] as TGMRecordsetIntfSource); Result := True; Break;
      end;
end;

function TGMInterfaceMultiSourceLink.GetIntfByName(const QualifiedName: TGMString; const IID: TGUID; out Intf): HResult;
var Qualifier, FieldName: TGMString; Source: TGMRecordsetIntfSource;
begin
  if GMSplitQualifiedName(QualifiedName, Qualifier, FieldName) and
     FindSourceForQualifier(Qualifier, Source) then Result := Source.GetIntfByName(FieldName, IID, Intf) else Result := E_FAIL;
end;

function TGMInterfaceMultiSourceLink.GetIntfByPosition(const Position: PtrInt; const IID: TGUID; out Intf): HResult;
var i, n: Integer;
  function SourceFieldCount(const Source: TGMObjInterfaceConnector): Integer;
  begin
    Result := 0;
    if Source <> nil then Result := GMAskInteger(Source.InterfaceSource, Ord(ivFieldCount), 0)
  end;
begin
  Result := E_FAIL; n:=0;
  if GMIsInRange(Position, n, n + SourceFieldCount(InterfaceSource) - 1) then
   Result := InterfaceSource.GetIntfByPosition(Position - n, IID, Intf)
  else
   begin
    Inc(n, SourceFieldCount(InterfaceSource));
    for i:=0 to SourceList.Count-1 do
     if not GMIsInRange(Position, n, n + SourceFieldCount(SourceList[i] as TGMObjInterfaceConnector) - 1) then
      Inc(n, SourceFieldCount(SourceList[i] as TGMObjInterfaceConnector))
     else
      begin
       Result := (SourceList[i] as TGMRecordsetIntfSource).GetIntfByPosition(Position - n, IID, Intf);
       Break;
      end
   end;
end;

procedure TGMInterfaceMultiSourceLink.AfterValueChange(const QualifiedName: TGMString);
var Qualifier, FldName: TGMString; Source: TGMRecordsetIntfSource;
begin
  if GMSplitQualifiedName(QualifiedName, Qualifier, FldName) and
     FindSourceForQualifier(Qualifier, Source) then Source.AfterValueChange(FldName);
end;

function TGMInterfaceMultiSourceLink.CaptureState: IUnknown;
begin
  Result := TGMMultiLinkStateHolder.Create(Self);
end;

procedure TGMInterfaceMultiSourceLink.RestoreState(const State: IUnknown);
var PIRestore: IRestoreToMultiLink;
begin
  if (State <> nil) and (State.QueryInterface(IRestoreToMultiLink, PIRestore) = S_OK) then PIRestore.RestoreToMultiLink(Self);
end;


{ ---- simple distributions to all sources ---- }

function TGMInterfaceMultiSourceLink.ExecuteOperation(const Operation: LongInt; const Parameter: IUnknown = nil): Boolean;
var i: Integer; PIExecOp: IGMExecuteOperation;
begin
  //if Operation <> Ord(roScheduleReExecution) then ... ???
   for i:=0 to SourceList.Count-1 do
    if (SourceList[i] as TGMObjInterfaceConnector).GetSourceIntf(IGMExecuteOperation, PIExecOp) then PIExecOp.ExecuteOperation(Operation, Parameter);
  Result := inherited ExecuteOperation(Operation, Parameter);
end;

procedure TGMInterfaceMultiSourceLink.SetPosition(const Value: PtrInt);
var i: Integer; PIGetSetPos: IGMGetSetPosition;
begin
  for i:=0 to SourceList.Count-1 do
   if (SourceList[i] as TGMObjInterfaceConnector).GetSourceIntf(IGMGetSetPosition, PIGetSetPos) then PIGetSetPos.Position := Value;
  inherited SetPosition(Value);
end;

procedure TGMInterfaceMultiSourceLink.MoveToNext;
var i: Integer; PIUniCur: IGMUnidirectionalCursor;
begin
  for i:=0 to SourceList.Count-1 do
   if (SourceList[i] as TGMObjInterfaceConnector).GetSourceIntf(IGMUnidirectionalCursor, PIUniCur) then PIUniCur.MoveToNext;
  inherited MoveToNext;
end;

procedure TGMInterfaceMultiSourceLink.MoveToPrevious;
var i: Integer; PIBiDiCur: IGMBidirectionalCursor;
begin
  for i:=0 to SourceList.Count-1 do
   if (SourceList[i] as TGMObjInterfaceConnector).GetSourceIntf(IGMBidirectionalCursor, PIBiDiCur) then PIBiDiCur.MoveToPrevious;
  inherited MoveToPrevious;
end;

procedure TGMInterfaceMultiSourceLink.MoveToFirst;
var i: Integer; PIFirstLast: IGMCursorFirstLast;
begin
  for i:=0 to SourceList.Count-1 do
   if (SourceList[i] as TGMObjInterfaceConnector).GetSourceIntf(IGMCursorFirstLast, PIFirstLast) then PIFirstLast.MoveToFirst;
  inherited MoveToFirst;
end;

procedure TGMInterfaceMultiSourceLink.MoveToLast;
var i: Integer; PIFirstLast: IGMCursorFirstLast;
begin
  for i:=0 to SourceList.Count-1 do
   if (SourceList[i] as TGMObjInterfaceConnector).GetSourceIntf(IGMCursorFirstLast, PIFirstLast) then PIFirstLast.MoveToLast;
  inherited MoveToLast;
end;


{ -------------------- }
{ ---- TColumnSet ---- }
{ -------------------- }

constructor TColumnSet.Create(const AOwner: TGMInterfaceGroupSourceLink; const AQualifiedName: TGMString; const AInterfaceSource: IUnknown);
var masterSrc: IGMGetSetMasterSource;
begin
  Assert(AOwner <> nil);
  inherited Create(False);
  FOwner := AOwner;
  FInterfaceSource := AInterfaceSource;
  FQualifiedName := AQualifiedName;
  if GMQueryInterface(FInterfaceSource, IGMGetMasterSource, masterSrc) then
   begin
    //GMCheckQueryInterface(FInterfaceSource, IGMGetSetReferencedObject, masterSrc, {$I %CurrentRoutine%});
    masterSrc.MasterSource := FOwner.InterfaceSource.InterfaceSource;
   end;
end;

procedure TColumnSet.TellEnumString(const ItemKind: LongInt; const Value: TGMString; const Parameter: Pointer);
begin
  if FOwner.FTellEnumSink <> nil then
   FOwner.FTellEnumSink.TellEnumString(ItemKind, GMFormat('%s%s%s', [FQualifiedName, cSqlQualSep, Value]), Parameter);
end;

function TColumnSet.GetName: TGMString;
begin
  Result := FQualifiedName;
end;

procedure TColumnSet.EnumerateItems(const ItemKind: LongInt);
var PIEnumValues: IGMEnumerateItems;
begin
  GMSetIntfActive(FInterfaceSource, True, {$I %CurrentRoutine%});
  if (FInterfaceSource <> nil) and (FInterfaceSource.QueryInterface(IGMEnumerateItems, PIEnumValues) = S_OK) then PIEnumValues.EnumerateItems(ItemKind, Self);
end;

function TColumnSet.GetIntfByName(const QualifiedName: TGMString; const IID: TGUID; out Intf): HResult;
var PIIntfByName: IGMGetIntfByName;
begin
  Result := E_FAIL;
  GMSetIntfActive(FInterfaceSource, True, {$I %CurrentRoutine%});
  if (FInterfaceSource <> nil) and (FInterfaceSource.QueryInterface(IGMGetIntfByName, PIIntfByName) = S_OK) then
   Result := PIIntfByName.GetIntfByName(GMLastWord(QualifiedName, cSqlQualSep), IID, Intf);
end;


{ ------------------------------------- }
{ ---- TGMInterfaceGroupSourceLink ---- }
{ ------------------------------------- }

constructor TGMInterfaceGroupSourceLink.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FColumnSetList := TGMObjArrayCollection.Create(True, True, False, GMCompareByName, True);
end;

{destructor TGMInterfaceGroupSourceLink.Destroy;
begin
  GMFreeAndNil(FColumnSetList);
  inherited Destroy;
end;}

procedure TGMInterfaceGroupSourceLink.AddColumnSet(const QualifiedName: TGMString; const InterfaceSource: IUnknown);
var PINameObj: IUnknown; ColumnSet: TObject;
begin
  PINameObj := TGMNameObj.Create(QualifiedName, True);
  if not FColumnSetList.Find(PINameObj, ColumnSet) then FColumnSetList.Add(TColumnSet.Create(Self, QualifiedName, InterfaceSource));
end;

procedure TGMInterfaceGroupSourceLink.InternalEnumerateValues(const ItemKind: LongInt);
var i: Integer;
begin
  inherited InternalEnumerateValues(ItemKind);

  if (ItemKind = Ord(eidFieldNames)) and (FTellEnumSink <> nil) then
   for i:=0 to FColumnSetList.Count-1 do (FColumnSetList[i] as TColumnSet).EnumerateItems(ItemKind);
end;

function TGMInterfaceGroupSourceLink.GetIntfByName(const QualifiedName: TGMString; const IID: TGUID; out Intf): HResult;
var Qualifier, FldName: TGMString; PIName: IGMGetName; ColumnSet: TColumnSet;
begin
  Result := E_FAIL;
  FQualifierParseChPos := 1;
  if GMExtractQualifier(QualifiedName, FQualifierParseChPos, Qualifier) then
   if InterfaceSource.GetSourceIntf(IGMGetName, PIName) and GMSameText(Qualifier, PIName.Name) then
    begin
     if GMExtractQualifier(QualifiedName, FQualifierParseChPos, FldName) then Result := InterfaceSource.GetIntfByName(FldName, IID, Intf)
    end
   else
    begin
     PIName := TGMNameObj.Create(GMDeleteLastWord(QualifiedName, cSqlQualSep), True);
     if FColumnSetList.Find(PIName, ColumnSet) then Result := ColumnSet.GetIntfByName(QualifiedName, IID, Intf);
    end;
end;

function TGMInterfaceGroupSourceLink.GetIntfByPosition(const Position: PtrInt; const IID: TGUID; out Intf): HResult;
begin
  Assert(False);
  Result := E_FAIL;
end;

function TGMInterfaceGroupSourceLink.ExecuteOperation(const Operation: LongInt; const Parameter: IUnknown = nil): Boolean;
var i: Integer;
begin
  Result := inherited ExecuteOperation(Operation, Parameter);
  for i:=0 to FColumnSetList.Count-1 do
   //if FColumnSetList[i] is TColumnSet then
    GMCheckExecOperation((FColumnSetList[i] as TColumnSet).InterfaceSource, Operation, '', {$I %CurrentRoutine%}, Parameter);
end;


{ ------------------------------- }
{ ---- Invalidatable records ---- }
{ ------------------------------- }

procedure RGMDisplayTextData.Invalidate;
begin
  Text := ''; IsValid := False;
end;

procedure RGMCachedUnionValue.Invalidate;
begin
  Value := uvtUnassigned; IsValid := False;
end;


{ ------------------------ }
{ ---- TGMValueBuffer ---- }
{ ------------------------ }

constructor TGMValueBuffer.Create(const AOwner: TObject;
                                  const ADataType: TGMDBColumnDataType;
                                  const AZeroInit: Boolean = False;
                                  const AFreeMemoryOnDestroy: Boolean = True;
                                  const ARefLifeTime: Boolean = False);
//const cMemAllocDelta: array [Boolean] of LongInt = (1, 512);
var bufSize: Integer; // , allocDelta
begin
  FOwner := AOwner;
  FDataType := ADataType;
  FIsNull := True;
  if IsFixedBufferSize then bufSize := CalculateBufferSize else bufSize := 0;

//case DataType of
// fdtAnsiString, fdtUnicodeString, fdtAnsiText, fdtUnicodeText, fdtBinary: allocDelta := 1;
// else allocDelta := SizeOf(Pointer);
//end;

  inherited Create(SizeOf(Pointer), AZeroInit, AFreeMemoryOnDestroy, bufSize, ARefLifeTime);
  FFullDataSize := bufSize;
end;

function TGMValueBuffer.IsFixedBufferSize: Boolean;
begin
  Result := IsFixedLengthDataType(DataType);
end;

function TGMValueBuffer.CalculateBufferSize: LongInt;
begin
  Result := GMValueBufferSizeOfFieldDataType(DataType);
end;

procedure TGMValueBuffer.InternalSetSize(ANewSize: Int64);
begin
  if not IsFixedBufferSize then inherited InternalSetSize(ANewSize); //  else
// if ANewSize > MemoryBuffer.SizeInBytes then
//    raise EGMException.ObjError(GMFormat(RStrFixedBufSizeViolation, [ANewSize, MemoryBuffer.SizeInBytes]), Self, {$I %CurrentRoutine%});
end;

function TGMValueBuffer.WriteAt(ulOffset: Int64; pv: Pointer; cb: LongInt; pcbWritten: PLongint): HResult;
begin
  Result := inherited WriteAt(ulOffset, pv, cb, pcbWritten);
  Modified := True;
  DisplayText.Invalidate;
end;

//function TGMValueBuffer.ExecuteOperation(const AOperation: LongInt; const AParameter: IUnknown = nil): Boolean;
//begin
//  Result := True;
//  case AOperation of
//   Ord(opInvalidate): Invalidate(True, False);
//   else Result := False;
//  end;
//end;

function TGMValueBuffer.AskBoolean(const AValueId: LongInt): LongInt;
begin
  //Result := inherited AskBoolean(AValueId);

  //if Result = Ord(barUnknown) then
   case AValueId of
    Ord(bvIsNull): Result := GMBooleanAskResult(IsNull);
    Ord(bvModified): Result := GMBooleanAskResult(Modified);
    //Ord(bvDisplayText): Result := GMBooleanAskResult(DisplayText.IsValid);
    else Result := Ord(barUnknown);
   end;
end;

function TGMValueBuffer.CreateValueStream(const AMode: DWORD): ISequentialStream;
begin
  Result := TGMLockBytesIStream.Create(Self, True);
end;

//procedure TGMValueBuffer.InternalFetchData(const AForDisplayText: Boolean);
//begin
//end;

function TGMValueBuffer.GetDataLength: PtrInt;
begin
  Result := DataSize;
end;

procedure TGMValueBuffer.SetDataLength(const AValue: PtrInt);
begin
end;

function TGMValueBuffer.IsNull: Boolean;
begin
  Result := FIsNull;
end;

function TGMValueBuffer.GetModified: Boolean;
begin
  Result := FModified;
end;

procedure TGMValueBuffer.SetModified(const AValue: Boolean);
begin
  FModified := AValue;
end;

//function TGMValueBuffer.DataIsCompressed: Boolean;
//var Header: TGMCompressedBlobHeaderData;
//begin
//Result := False;
//if DataSize >= SizeOf(Header) then
// begin
//  GMLockByteSafeReadAt(Self, 0, @Header, SizeOf(Header));
//  Result := GMIsCompressedBlobHeaderData(Header);
// end;
//end;

function TGMValueBuffer.InternalGetUnionValue: RGMUnionValue;
//var unkStrm: IUnknown;
begin
  case DataType of
   fdtBoolean:                    Result := Boolean(Memory^);
   fdtInt8, fdtUInt8:             Result := Byte(Memory^);
   fdtInt16:                      Result := SmallInt(Memory^);
   fdtUInt16:                     Result := Word(Memory^);
   fdtInt32:                      Result := LongInt(Memory^);
   {$IFDEF DELPHI9}
   fdtUInt32:                     Result := Longword(Memory^);
   fdtInt64:                      Result := Int64(Memory^);
   fdtUInt64:                     Result := QWord(Memory^);
   {$ELSE}
   fdtUInt32:                     Result := LongInt(Longword(Memory^));
   {$IFDEF DELPHI6}
   fdtInt64, fdtUInt64:           Result := Int64(Memory^);
   {$ELSE}
   fdtInt64, fdtUInt64:           Result := LongInt(Int64(Memory^));
   {$ENDIF}
   {$ENDIF}
   fdtSingle:                     Result := Single(Memory^);
   fdtDouble, fdtNumeric:         Result := Double(Memory^);
   fdtDate, fdtTime, fdtDateTime: Result := TDateTime(Memory^);
   fdtGUID:                       Result := GMGuidToString(TGUID(Memory^));
   fdtAnsiString, fdtAnsiText:    Result := AnsiString(PAnsiChar(Memory));
   fdtUnicodeString, fdtUnicodeText: Result := UnicodeString(PUnicodeChar(Memory));
   //fdtAnsiString, fdtAnsiText:  Result := GMBufferAsString(Memory, GMStrLen(Memory, GMBoundedInt(DataLength, 0, DataSize)));
   //fdtUnicodeString, fdtUnicodeText: Result := GMBufferAsWideString(Memory, GMWStrLen(Memory, GMBoundedInt(DataLength, 0, DataSize div SizeOf(WideChar))));

   fdtBinary: begin
               FValueReadStream := CreateValueStream(STGM_READ);
               Result := FValueReadStream;
               //if GMQueryInterface(FValueReadStream, IUnknown, unkStrm) then Result := unkStrm else Result := uvtUnassigned;
               //Result := uvtNull;
              end;

   else Result := uvtUnassigned;
  end;
end;

function TGMValueBuffer.GetUnionValue: RGMUnionValue;
begin
  if not FCachedValue.IsValid then
   begin
    //
    // Some DOBC drivers may not assign the DataLength indicator with SQL_NULL_DATA even if the indicator is bound via SQLBindCol
    // Then a first call to SQLGetData ist needed to retrieve the NULL status of the value
    //
    if IsTextFieldDataType(DataType) then FCachedValue.Value := InternalGetUnionValue // <- IsNULL may be termined by InternalGetUnionValue in derived classes
    else
     if IsNull then FCachedValue.Value := uvtNull else FCachedValue.Value := InternalGetUnionValue;

    FCachedValue.IsValid := True;
   end;

  Result := FCachedValue.Value;
end;

procedure TGMValueBuffer.InternalSetUnionValue(const AValue: RGMUnionValue);
var aStr: AnsiString; wStr: UnicodeString; valByteSize, bufByteSize: Cardinal; unkStrm: IUnknown;
begin
  case DataType of
   fdtBoolean:                    Boolean(Memory^) := AValue; // <- the assignent may convert the data type!
   fdtInt8, fdtUInt8:             Byte(Memory^) := AValue; // <- the assignent may convert the data type!
   fdtInt16:                      SmallInt(Memory^) := AValue; // <- the assignent may convert the data type!
   fdtUInt16:                     Word(Memory^) := AValue; // <- the assignent may convert the data type!
   fdtInt32:                      LongInt(Memory^) := AValue; // <- the assignent may convert the data type!
   fdtUInt32:                     LongWord(Memory^) := AValue; // <- the assignent may convert the data type!
   {$IFDEF DELPHI9}
   fdtInt64:                      case AValue.ValueType of
                                   uvtString: Int64(Memory^) := GMStrToInt64(AValue);
                                   else Int64(Memory^) := AValue;
                                  end;
   fdtUInt64:                     case AValue.ValueType of
                                   uvtString: QWord(Memory^) := GMStrToUInt64(AValue);
                                   else QWord(Memory^) := AValue;
                                  end;
   {$ELSE}
   {$IFDEF DELPHI6}
   fdtInt64, fdtUInt64:           case VarType(AValue) of
                                   varOleStr, varString: Int64(Memory^) := GMStrToInt64(AValue);
                                   else Int64(Memory^) := AValue;
                                  end;
   {$ELSE}
   fdtInt64, fdtUInt64:           case VarType(AValue) of
                                   varOleStr, varString: Int64(Memory^) := GMStrToInt64(AValue);
                                   else Int64(Memory^) := LongInt(AValue);
                                  end;
   {$ENDIF}
   {$ENDIF}
   fdtSingle:                     case AValue.ValueType of
                                   uvtString: Single(Memory^) := GMStrToSingle(AValue);
                                   else Single(Memory^) := AValue; // <- the assignent may convert the data type!
                                  end;

   fdtDouble, fdtNumeric:         case AValue.ValueType of
                                   uvtString: Double(Memory^) := GMStrToDouble(AValue);
                                   else Double(Memory^) := AValue; // <- the assignent may convert the data type!
                                  end;

   fdtDate, fdtTime, fdtDateTime: TDateTime(Memory^) := AValue; // <- the assignent may convert the data type!
   fdtGUID:                       TGUID(Memory^) := GMStringToGuid(GMQuote(GMStrip(AValue, cStrHexChars + '-', True), '{', '}'), Owner, {$I %CurrentRoutine%});

   fdtAnsiString, fdtAnsiText:    begin
                                   aStr := AValue; // <- the assignent may convert the data type!
                                   valByteSize := Length(aStr) + 1;

                                   bufByteSize := valByteSize;
                                   if (FMaxStrLength > 0) and (bufByteSize > FMaxStrLength + 1) then bufByteSize := FMaxStrLength + 1;

                                   if IsFixedBufferSize then
                                     bufByteSize := GMBoundedInt(bufByteSize, 0, GetDataSize)
                                   else
                                     GMHrCheckObj(SetSize(bufByteSize), Self, {$I %CurrentRoutine%}); // <- sets FFullDataSize which will be used for copying the contents

                                   Move(PAnsiChar(aStr)^, Memory^, bufByteSize);
                                   if bufByteSize < valByteSize then PAnsiChar(GMAddPtr(Memory, bufByteSize - 1))^ := #0;
                                   DataLength := Max(0, bufByteSize - 1);
                                  end;

   fdtUnicodeString, fdtUnicodeText: begin
                                   wStr := AValue; // <- the assignent may convert the data type!
                                   valByteSize := (Length(wStr) + 1) * SizeOf(WideChar); // (lstrlenw(TVarData(AValue).VOleStr) + 1) * SizeOf(WideChar);

                                   bufByteSize := valByteSize;
                                   if (FMaxStrLength > 0) and (bufByteSize > ((FMaxStrLength + 1) * SizeOf(WideChar))) then bufByteSize := (FMaxStrLength + 1) * SizeOf(WideChar);

                                   if IsFixedBufferSize then
                                     bufByteSize := GMBoundedInt(bufByteSize, 0, GetDataSize)
                                   else
                                     GMHrCheckObj(SetSize(bufByteSize), Self, {$I %CurrentRoutine%}); // <- sets FFullDataSize which will be used for copying the contents

                                   Move(PUnicodeChar(wStr)^, Memory^, bufByteSize); // PUnicodeChar(TVarData(AValue).VOleStr)^
                                   if bufByteSize < valByteSize then PUnicodeChar(GMAddPtr(Memory, bufByteSize - SizeOf(WideChar)))^ := #0;
                                   DataLength := Max(0, bufByteSize - SizeOf(WideChar)); // <- must contain the size in Bytes!
                                  end;

   fdtBinary:                     if AValue.ValueType in [uvtPointer, uvtInterface] then
                                   begin
                                    //unkStrm := AValue; // .AsPointer;
                                    //GMQueryInterface(unkStrm, ISequentialStream, FValueReadStream);
                                    GMQueryInterface(AValue, ISequentialStream, FValueReadStream);
                                   end;


//                                else
//                                 begin
//                                  aStr := AValue; // <- the assignent may convert the data type!
//                                  valByteSize := Length(aStr);
//                                  GMHrCheckObj(SetSize(valByteSize), Self, {$I %CurrentRoutine%}); // <- will raise if fixed and buffer too small
//                                  Move(PAnsiChar(aStr)^, Memory^, valByteSize);
//                                  DataLength := valByteSize;
//                                 end;

   else raise EGMException.ObjError(MsgUnsupportedFieldDataType(Ord(DataType)), Owner, {$I %CurrentRoutine%});
  end;
  FIsNull := False;
end;

procedure TGMValueBuffer.InternalSetNullValue;
begin
  FIsNull := True;
end;

procedure TGMValueBuffer.SetUnionValue(const AUnionValue: RGMUnionValue);
begin
  if AUnionValue.IsNullOrUnassigned then InternalSetNullValue else InternalSetUnionValue(AUnionValue);
  DisplayText.Invalidate;
  FCachedValue.Invalidate;
  //DataFetched := True;
  Modified := True;
end;

function TGMValueBuffer.InternalBuildDisplayText: TGMString;
begin
  Result := GetUnionValue.AsStringDflt;
end;

function TGMValueBuffer.GetText: TGMString;
begin
  if not DisplayText.IsValid then
   begin
    DisplayText.Text := InternalBuildDisplayText;
    DisplayText.IsValid := True;
   end;

  Result := DisplayText.Text;
end;

procedure TGMValueBuffer.Invalidate(const AResetOffset, ASetToNULL: Boolean);
begin
  if AResetOffset then Offset := 0;
  Modified := False;
  DisplayText.Invalidate;
  //DataFetched := False;
  if ASetToNULL then FIsNull := True;
  FValueReadStream := nil;
  FCachedValue.Invalidate;
  //FCachedValue.IsValid := False;
  //FCachedValue.Value := uvtUnassigned;
end;

procedure TGMValueBuffer.AssignFromObj(const Source: TObject);
var PIUnknown: IUnknown;
begin
  GMCheckGetInterface(Source, IUnknown, PIUnknown, {$I %CurrentRoutine%});
  AssignFromIntf(PIUnknown);
end;

procedure TGMValueBuffer.AssignFromIntf(const Source: IUnknown);
begin
  FIsNull := GMCheckAskBoolean(Source, Ord(bvIsNull), {$I %CurrentRoutine%});
  if not IsNull then inherited AssignFromIntf(Source);
  Modified := GMCheckAskBoolean(Source, Ord(bvModified), {$I %CurrentRoutine%});
end;


{ ----------------------------- }
{ ---- TGMFieldStateBuffer ---- }
{ ----------------------------- }

function TGMFieldStateBuffer.IsFixedBufferSize: Boolean;
begin
  // field state buffers are not frequently reassigned, to save memory they can be tight
  Result := False;
end;


{ ----------------------------- }
{ ---- TGMFieldStateHolder ---- }
{ ----------------------------- }

constructor TGMFieldStateHolder.Create(const Source: IUnknown = nil);
begin
  inherited Create;
  if Source <> nil then AssignFromIntf(Source);
end;

destructor TGMFieldStateHolder.Destroy;
var i: EGMValueBufferInstance;
begin
  for i:=Low(FValueBuffers) to High(FValueBuffers) do GMFreeAndNil(FValueBuffers[i]);
  inherited Destroy;
end;

function TGMFieldStateHolder.ValueBufferCreateClass: TGMValueBufferClass;
begin
  Result := TGMFieldStateBuffer;
end;

function TGMFieldStateHolder.ValueBuffer(const ValueBufferInstance: EGMValueBufferInstance): TGMValueBuffer;
begin
  if FValueBuffers[ValueBufferInstance] = nil then FValueBuffers[ValueBufferInstance] := ValueBufferCreateClass.Create(Self, DataType);
  Result := FValueBuffers[ValueBufferInstance];
end;

procedure TGMFieldStateHolder.ResetContents;
var i: EGMValueBufferInstance;
begin
  for i:=Low(FValueBuffers) to High(FValueBuffers) do
   if FValueBuffers[i] <> nil then FValueBuffers[i].Invalidate(True, True);
  Name := '';
end;

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

procedure TGMFieldStateHolder.SetName(const AValue: TGMString);
begin
  Name := AValue;
end;

function TGMFieldStateHolder.GetValueBufferIntf(const ValueBufferInstance: LongInt; const IID: TGUID; out Intf): HResult;
begin
  GMCheckIntRange(cStrValBufInstTypeName, ValueBufferInstance, Ord(Low(EGMValueBufferInstance)), Ord(High(EGMValueBufferInstance)), Self, {$I %CurrentRoutine%});
  // Always create the desired Valuebuffer in neccessary
  Result := CQIResult[ValueBuffer(EGMValueBufferInstance(ValueBufferInstance)).GetInterface(IID, Intf)];
end;

procedure TGMFieldStateHolder.AssignToObj(const Dest: TObject);
var PUnk: IUnknown;
begin
  if (Dest <> nil) and Dest.GetInterface(IUnknown, PUnk) then AssignToIntf(PUnk);
end;

procedure TGMFieldStateHolder.AssignFromObj(const Source: TObject);
var PUnk: IUnknown;
begin
  if (Source <> nil) and Source.GetInterface(IUnknown, PUnk) then AssignFromIntf(PUnk);
end;

procedure TGMFieldStateHolder.AssignFromIntf(const Source: IUnknown);
var i: EGMValueBufferInstance;
    PIName: IGMGetName;
    PISourceValBufIntf: IGMGetValueBufferIntf;
    PIUnkSrcBuf: IUnknown;
    PIIntfAssign: IGMAssignFromIntf;
    PIFieldDef: IGMGetValueDefinition;
begin
  ResetContents;

  GMCheckQueryInterface(Source, IGMGetName, PIName, {$I %CurrentRoutine%});
  GMCheckQueryInterface(Source, IGMGetValueDefinition, PIFieldDef, {$I %CurrentRoutine%});

  Name := PIName.Name;
  DataType := PIFieldDef.DataType;

  for i:=Low(FValueBuffers) to High(FValueBuffers) do
   if FValueBuffers[i] <> nil then FValueBuffers[i].DataType := DataType;

  if Source.QueryInterface(IGMGetValueBufferIntf, PISourceValBufIntf) = S_OK then
   for i:=Low(FValueBuffers) to High(FValueBuffers) do
    if PISourceValBufIntf.GetValueBufferIntf(Ord(i), IUnknown, PIUnkSrcBuf) and
       GetValueBufferIntf(Ord(i), IGMAssignFromIntf, PIIntfAssign) = S_OK then
     PIIntfAssign.AssignFromIntf(PIUnkSrcBuf);
end;

procedure TGMFieldStateHolder.AssignToIntf(const Dest: IUnknown);
var i: EGMValueBufferInstance;
    PIDestValBufIntf: IGMGetValueBufferIntf;
    PIDestBufAssign: IGMAssignFromIntf;
    PIUnkSrcBuf: IUnknown;
begin
  if Dest <> nil then
   begin
    if Dest.QueryInterface(IGMGetValueBufferIntf, PIDestValBufIntf) = S_OK then
     for i:=Low(FValueBuffers) to High(FValueBuffers) do
      if (PIDestValBufIntf.GetValueBufferIntf(Ord(i), IGMAssignFromIntf, PIDestBufAssign) = S_OK) and
         (GetValueBufferIntf(Ord(i), IUnknown, PIUnkSrcBuf) = S_OK) then
       PIDestBufAssign.AssignFromIntf(PIUnkSrcBuf);
   end;
end;


{ --------------------------------- }
{ ---- TGMRecordsetStateHolder ---- }
{ --------------------------------- }

constructor TGMRecordsetStateHolder.Create(const Source: IUnknown = nil);
begin
  inherited Create(True);
  FFieldStates := TGMObjArrayCollection.Create(True);
  if Source <> nil then AssignFromIntf(Source);
end;

destructor TGMRecordsetStateHolder.Destroy;
begin
  GMFreeAndNil(FFieldStates);
  inherited Destroy;
end;

procedure TGMRecordsetStateHolder.ResetContents;
begin
  Fieldstates.Clear;
  State := CGMUnknownState;
  Position := CGMUnknownPosition;
end;

function TGMRecordsetStateHolder.FieldStateCreateClass: TGMFieldStateCreateClass;
begin
  Result := TGMFieldStateHolder;
end;

procedure TGMRecordsetStateHolder.TellEnumString(const ItemKind: LongInt; const Value: TGMString; const Parameter: Pointer);
var FieldByName: IGMGetIntfByName; PUnk: IUNknown;
begin
  if (ItemKind = Ord(eidFieldNames)) and (FSource <> nil) and
     (FSource.QueryInterface(IGMGetIntfByName, FieldByName) = S_OK) and
     (FieldByName.GetIntfByName(Value, IUnknown, PUnk) = S_OK) then
   FieldStates.Add(FieldStateCreateClass.Create(PUnk));
end;

procedure TGMRecordsetStateHolder.AssignFromObj(const Source: TObject);
var PIUnk: IUnknown;
begin
  GMCheckGetInterface(Source, IUnknown, PIUnk, {$I %CurrentRoutine%});
  AssignFromIntf(PIUnk);
end;

procedure TGMRecordsetStateHolder.AssignToObj(const Dest: TObject);
var PIUnk: IUnknown;
begin
  GMCheckGetInterface(Dest, IUnknown, PIUnk, {$I %CurrentRoutine%});
  AssignToIntf(PIUnk);
end;

procedure TGMRecordsetStateHolder.AssignFromIntf(const Source: IUnknown);
var PIPosition: IGMGetPosition;
    PIState: IGMGetState;
    PIEnumValues: IGMEnumerateItems;
begin
  if Source <> nil then
   begin
    //GMCheckIntfIsActive(Source, {$I %CurrentRoutine%}); <- Allow Inactive State!
    ResetContents;

    if (Source.QueryInterface(IGMGetPosition, PIPosition) = S_OK) then
     Position := PIPosition.Position
    else
     Position := CGMUnknownPosition;

    if (Source.QueryInterface(IGMGetState, PIState) = S_OK) then
     State := PIState.State
    else
     State := CGMUnknownState;

    if (State in cUpdatableStates) and (Source.QueryInterface(IGMEnumerateItems, PIEnumValues) = S_OK) then
     try
      FSource := Source;
      PIEnumValues.EnumerateItems(Ord(eidFieldNames), Self);
     finally
      FSource := nil; // <- Dont hold a reference, otherwise use a TGMRecordsetIntfSource
     end;
   end;
end;

procedure TGMRecordsetStateHolder.AssignFields(const Dest: IUnknown);
var i: Integer; PIFieldByName: IGMGetIntfByName; PIDestField: IUnknown;
begin
  if Dest.QueryInterface(IGMGetIntfByName, PIFieldByName) = S_OK then
   for i:=0 to Fieldstates.Count-1 do
    if PIFieldByName.GetIntfByName((Fieldstates[i] as TGMFieldStateHolder).Name, IUnknown, PIDestField) = S_OK then
       (Fieldstates[i] as TGMFieldStateHolder).AssignToIntf(PIDestField);
end;

procedure TGMRecordsetStateHolder.AssignToIntf(const Dest: IUnknown);
var PIDestPosition: IGMGetSetPosition; PIDestState: IGMGetState;
  procedure InvalidStateTransition(const OldState, NewState: LongInt);
  begin
    raise EGMException.ObjError(MsgInvalidStateTransition(OldState, NewState), Self, {$I %CurrentRoutine%});
  end;
begin
  if Dest <> nil then
   begin
    if Position <> CGMUnknownPosition then
     begin
      GMCheckQueryInterface(Dest, IGMGetSetPosition, PIDestPosition, {$I %CurrentRoutine%});
      if Position <> PIDestPosition.Position then
       begin
        GMCheckExecRSOperation(Dest, roLeaveModifyingState, {$I %CurrentRoutine%});
        PIDestPosition.Position := Position;
       end;
     end;

    if State <> CGMUnknownState then
     begin
      GMCheckQueryInterface(Dest, IGMGetState, PIDestState, {$I %CurrentRoutine%});
      if State <> PIDestState.State then
       case State of
        Ord(rsInactive): GMSetIntfActive(Dest, False);
        Ord(rsBrowsing):
         case PIDestState.State of
          Ord(rsInactive): GMSetIntfActive(Dest, True); 
          Ord(rsInserting), Ord(rsEditing): if not GMExecuteOperation(Dest, Ord(roLeaveModifyingState)) then
                                             InvalidStateTransition(PIDestState.State, State);
         end;

        Ord(rsInserting):
         if PIDestState.State <> Ord(rsBrowsing) then InvalidStateTransition(PIDestState.State, State)
         else GMCheckExecRSOperation(Dest, roInsert, {$I %CurrentRoutine%});

        Ord(rsEditing):
         if PIDestState.State <> Ord(rsBrowsing) then InvalidStateTransition(PIDestState.State, State)
         else GMCheckExecRSOperation(Dest, roEdit, {$I %CurrentRoutine%});

        else InvalidStateTransition(PIDestState.State, State);
       end;

      if State in cUpdatableStates then AssignFields(Dest);
     end;
   end;
end;


{ --------------------------------- }
{ ---- TGMNameAndValueMatchObj ---- }
{ --------------------------------- }

constructor TGMNameAndValueMatchObj.Create(const AData: TNameAndValueMatch; const RefLifeTime: Boolean = False);
begin
  inherited Create(RefLifeTime);
  FData := AData;
end;

function TGMNameAndValueMatchObj.GetName: TGMString;
begin
  Result := FData.Name;
end;

function TGMNameAndValueMatchObj.GetUnionValue: RGMUnionValue;
begin
  Result := FData.Value;
end;

procedure TGMNameAndValueMatchObj.SetUnionValue(const AUnionValue: RGMUnionValue);
begin
  FData.Value := AUnionValue;
end;

function TGMNameAndValueMatchObj.AskBoolean(const ValueId: LongInt): LongInt;
begin
  case ValueId of
   Ord(bvMatchCase): Result := GMBooleanAskResult(FData.MatchCase);
   else Result := Ord(barUnknown);
  end;
end;

function TGMNameAndValueMatchObj.AskInteger(const ValueId: LongInt): LongInt;
begin
  case ValueId of
   Ord(ivMatchKind): Result := Ord(FData.MatchKind);
   else Result := CInvalidIntValue;
  end;
end;


{ ---------------------------------- }
{ ---- TGMNameAndValueMatchList ---- }
{ ---------------------------------- }

constructor TGMNamedValueCollection.Create(const Names: array of TGMString; const RefLifeTime: Boolean = True);
var i: Integer;
begin
  inherited Create(True, False, False, GMCompareByName, RefLifeTime);
  for i:=Low(Names) to High(Names) do Add(TGMNameAndValueObj.Create(Names[i], uvtNull, False));
end;

function TGMNamedValueCollection.GetIntfByName(const Name: TGMString; const IID: TGUID; out Intf): HResult;
var PIName: IUnknown; Entry: TObject;
begin
  Result := E_FAIL;
  PIName := TGMNameObj.Create(Name, True);
  if Find(PIName, Entry) then Result := CQIResult[Entry.GetInterface(IID, Intf)];
end;

function TGMNamedValueCollection.FindValueByName(const ValueName: TGMString; var Value: TGMNameAndValueObj): Boolean;
var PIName: IUnknown;
begin
  PIName := TGMNameObj.Create(ValueName, True);
  Result := Find(PIName, Value);
  //if Result then Value := Items[Idx] as TGMNameAndValueObj;
end;

procedure TGMNamedValueCollection.SaveValues;
var i: Integer;
begin
  for i:=0 to Count-1 do if Entries[i] is TGMFieldNameAndValue then (Entries[i] as TGMFieldNameAndValue).SaveValue;
end;

procedure TGMNamedValueCollection.RestoreValues;
var i: Integer;
begin
  for i:=0 to Count-1 do if Entries[i] is TGMFieldNameAndValue then (Entries[i] as TGMFieldNameAndValue).RestoreValue;
end;

procedure TGMNamedValueCollection.ClearOldValues;
var i: Integer;
begin
  for i:=0 to Count-1 do if Entries[i] is TGMFieldNameAndValue then (Entries[i] as TGMFieldNameAndValue).ClearOldValue;
end;


{ ---------------------------------- }
{ ---- TGMNameAndValueMatchList ---- }
{ ---------------------------------- }

constructor TGMNameAndValueMatchList.Create(const Values: array of TNameAndValueMatch; const RefLifeTime: Boolean = True);
var i: Integer;
begin
  inherited Create(True, False, False, nil, RefLifeTime);
  for i:=Low(Values) to High(Values) do Add(TGMNameAndValueMatchObj.Create(Values[i]));
end;


{ ------------------------------ }
{ ---- TGMFieldNameAndValue ---- }
{ ------------------------------ }

constructor TGMFieldNameAndValue.Create(const AOwner: TObject; const AName: TGMString; const AValue: RGMUnionValue; const AReadOnly: Boolean = False; const ARefLifeTime: Boolean = False);
begin
  inherited Create(AName, AValue, ARefLifeTime);
  FReadOnly := AReadOnly;
  FOwner := AOwner;
end;

procedure TGMFieldNameAndValue.NotifyValueChange;
var PIChangeNotify: IGMNamedValueChange;
begin
  if (FOwner <> nil) and FOwner.GetInterface(IGMNamedValueChange, PIChangeNotify) then PIChangeNotify.AfterValueChange(Name);
end;

procedure TGMFieldNameAndValue.SetUnionValue(const AUnionValue: RGMUnionValue);
begin
  inherited SetUnionValue(AUnionValue);
  NotifyValueChange;
end;

function TGMFieldNameAndValue.GetDataType: TGMDBColumnDataType;
begin
  Result := GMDbDataTypeOfUnionType(FValue.ValueType);
end;

function TGMFieldNameAndValue.GetNullValuesAllowed: TGMAllowNullValues;
begin
  Result := nvNullableUnknown;
end;

function TGMFieldNameAndValue.GetUpdatable: Boolean;
//const CUpdatable: array [Boolean] of TGMUpdatable = (upUpdatable, upReadonly);
begin
  Result := not ReadOnly;
end;

procedure TGMFieldNameAndValue.SaveValue;
begin
  FOldValue := FValue;
end;

procedure TGMFieldNameAndValue.RestoreValue;
begin
  FValue := FOldValue;
  ClearOldValue;
end;

procedure TGMFieldNameAndValue.ClearOldValue;
begin
  FOldValue := uvtUnassigned;
end;


{ --------------------------------- }
{ ---- TGMNamedValuesContainer ---- }
{ --------------------------------- }

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

  FTimedReCalculationDelay := cDfltReExecutionDelay;

  FNamedValuesList := TGMNamedValueCollection.Create([], False);
  FMasterSource := TGMRecordsetMasterSource.Create(Self, []);
  FReCalculationTimer := TGMThreadTimer.Create(RecalculateValues, Self, FTimedReCalculationDelay);

  MasterSource.OnAfterActiveChange := AfterMasterActiveChange;
  MasterSource.OnAfterPositionChange := AfterMasterPositionChange;
  MasterSource.OnAfterOperation := AfterMasterOperation;

  CreateConnectionPoint(IGMNamedValueChange);

  FState := rsInactive;
end;

destructor TGMNamedValuesContainer.Destroy;
begin
  inherited Destroy; // <- may access members during closing

  GMFreeAndNil(FReCalculationTimer);
  GMFreeAndNil(FMasterSource);
  GMFreeAndNil(FNamedValuesList);
end;

function TGMNamedValuesContainer.GetActive: Boolean;
begin
  Result := FState <> rsInactive;
end;

procedure TGMNamedValuesContainer.InternalOpen;
begin
  FState := rsBrowsing;
end;

procedure TGMNamedValuesContainer.InternalClose;
begin
  ReCalculationTimer.Stop;
  FState := rsInactive;
end;

procedure TGMNamedValuesContainer.AddNamedValue(const Name: TGMString; const Value: RGMUnionValue; const ReadOnly: Boolean = False; const NotifyValueChange: Boolean = False);
begin
  NamedValuesList.Add(TGMFieldNameAndValue.Create(Self, Name, Value, ReadOnly));
  if NotifyValueChange then AfterValueChange(Name);
end;

function TGMNamedValuesContainer.GetValue(const AIndex: RGMUnionValue): RGMUnionValue;
var NamedValue: TGMNameAndValueObj;
begin
  case AIndex.ValueType of
   uvtInt16, uvtInt32, uvtInt64, uvtDouble:
    Result := (NamedValuesList[AIndex] as TGMFieldNameAndValue).Value;

   uvtString:
    if NamedValuesList.FindValueByName(AIndex, NamedValue) then Result := NamedValue.Value else
     raise EGMException.ObjError(GMFormat(srValueNameNotFound, [AIndex.AsStringDflt]), Self, {$I %CurrentRoutine%});

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

procedure TGMNamedValuesContainer.SetValue(const AIndex: RGMUnionValue; const Value: RGMUnionValue);
var NamedValue: TGMNameAndValueObj;
begin
  case AIndex.ValueType of
   uvtInt16, uvtInt32, uvtInt64, uvtDouble:
    (NamedValuesList[AIndex] as TGMFieldNameAndValue).Value := Value;

   uvtString:
    if NamedValuesList.FindValueByName(AIndex, NamedValue) then NamedValue.Value := Value else
     raise EGMException.ObjError(GMFormat(srValueNameNotFound, [AIndex.AsStringDflt]), Self, {$I %CurrentRoutine%});

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

function TGMNamedValuesContainer.GetMasterSourceConnector: TGMRecordsetMasterSource;
begin
  Result := FMasterSource;
end;

procedure TGMNamedValuesContainer.SetMasterSourceConnector(const Value: TGMRecordsetMasterSource);
begin
  FMasterSource.AssignFromObj(Value);
end;

function TGMNamedValuesContainer.GetMasterSource: IUnknown;
begin
  Result := MasterSource.InterfaceSource;
end;

procedure TGMNamedValuesContainer.SetMasterSource(const AValue: IUnknown);
begin
  MasterSource.InterfaceSource := AValue;
end;

procedure TGMNamedValuesContainer.ScheduleReCalculation;
begin
  if ReCalculationTimer.Interval = 0 then RecalculateValues(Self) else ReCalculationTimer.Restart(FTimedReCalculationDelay);
end;

procedure TGMNamedValuesContainer.RecalculateValues(const Sender: TObject);
begin
  if Assigned(OnRecalculateValues) then OnRecalculateValues(Self);
  Close; Open; // <- will stop timer and notify connected objects
end;

procedure TGMNamedValuesContainer.AfterMasterActiveChange(const NewActive: Boolean);
begin
  if not MasterSource.AutoActivate then Exit;
  if NewActive then ScheduleReCalculation else Close;
end;

procedure TGMNamedValuesContainer.AfterMasterPositionChange;
begin
  ScheduleReCalculation;
end;

procedure TGMNamedValuesContainer.AfterMasterOperation(const Operation: LongInt; const Parameter: IUnknown = nil);
begin
  case Operation of
   Ord(roInsert), Ord(roCancelChanges), Ord(roApplychanges), Ord(roRefreshCurrent), Ord(roReExecuteStatement): ScheduleReCalculation;
  end;
end;


{ ---- Interfaces ---- }

function TGMNamedValuesContainer.AskBoolean(const ValueId: LongInt): LongInt;
begin
  case ValueId of
   Ord(bvCanModify){, Ord(bvCursorValid)}: Result := GMBooleanAskResult(True);
   //Ord(bvCanSetPosition): Result := GMBooleanAskResult(False);
   //Ord(bvIsEmpty): Result := GMBooleanAskResult(False);
   else Result := Ord(barUnknown);
  end;
end;

function TGMNamedValuesContainer.GetCount: PtrInt;
begin
  Result := 1; // <- we have only one record
end;

function TGMNamedValuesContainer.GetState: LongInt;
begin
  Result := Ord(FState);
end;

procedure TGMNamedValuesContainer.EnumerateItems(const ItemKind: LongInt; const TellEnumSink: IUnknown; const Parameter: Pointer);
var PIEnumSink: IGMTellEnumString; i: Integer; WasActive: Boolean;
begin
  if (TellEnumSink = nil) or (TellEnumSink.QueryInterface(IGMTellEnumString, PIEnumSink) <> S_OK) then Exit;
  case ItemKind of
   Ord(eidFieldNames):
    begin
     WasActive := Active;
     try
      Open;
      for i:=0 to NamedValuesList.Count-1 do
       if (NamedValuesList[i] is TGMNameAndValueObj) then
        try PIEnumSink.TellEnumString(ItemKind, TGMNameAndValueObj(NamedValuesList[i]).Name, Pointer(Parameter)); except end;
     finally
      if not WasActive then Close;
     end;
    end;
  end;
end;

function TGMNamedValuesContainer.CaptureState: IUnknown;
begin
  Result := nil;
end;

procedure TGMNamedValuesContainer.RestoreState(const State: IUnknown);
begin
end;

function TGMNamedValuesContainer.GetPosition: PtrInt;
begin
  Result := 1;
end;

function TGMNamedValuesContainer.GetIntfByName(const Name: TGMString; const IID: TGUID; out Intf): HResult;
begin
  Result := NamedValuesList.GetIntfByName(Name, IID, Intf);
end;

function TGMNamedValuesContainer.GetIntfByPosition(const Position: PtrInt; const IID: TGUID; out Intf): HResult;
begin
  Result := NamedValuesList.GetIntfByPosition(Position, IID, Intf);
end;

procedure TGMNamedValuesContainer.AfterValueChange(const ValueName: TGMString);
begin
  GMCpcCallNotifySinks(Self, IGMNamedValueChange, GMCallSinkAfterFieldValueChange, NotifyDisableCount = 0, [ValueName]);
  if Assigned(FOnAfterValueChange) then FOnAfterValueChange(Self, ValueName);
end;

function TGMNamedValuesContainer.CanExecuteOperation(const Operation: LongInt; const Parameter: IUnknown = nil): Boolean;
begin
  case Operation of
   //Ord(roSetSimplestConfiguration)
   Ord(roReExecuteStatement), Ord(roScheduleReExecution): Result := FState in [rsInactive, rsBrowsing];
   Ord(roRefreshCurrent), Ord(roInsert), Ord(roEdit), Ord(roDelete): Result := FState = rsBrowsing;
   Ord(roCancelChanges), Ord(roApplyChanges), Ord(roLeaveModifyingState): Result := IsUpdatableState(Ord(FState));
   else Result := False;
  end;
end;

function TGMNamedValuesContainer.ExecuteOperation(const Operation: LongInt; const Parameter: IUnknown = nil): Boolean;
begin
  Result := True;
  case Operation of
   //  Ord(roDelete) Ord(roSetSimplestConfiguration)
   Ord(roReExecuteStatement): RecalculateValues(Self);
   Ord(roScheduleReExecution): ScheduleReCalculation;
   Ord(roEdit): begin NamedValuesList.SaveValues; FState := rsEditing; end;
   Ord(roInsert): begin NamedValuesList.SaveValues; FState := rsInserting; end;
   Ord(roRefreshCurrent), Ord(roDelete): ; // <- Nothing
   Ord(roLeaveModifyingState), Ord(roApplyChanges): begin NamedValuesList.ClearOldValues; FState := rsBrowsing; end;
   Ord(roCancelChanges): begin NamedValuesList.RestoreValues; FState := rsBrowsing; end;
   else Result := False;
  end;
end;

procedure TGMNamedValuesContainer.LoadData(const Source: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData);
begin
  NamedValuesList.LoadData(Source, ACryptCtrlData);
end;

procedure TGMNamedValuesContainer.StoreData(const Dest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData);
begin
  NamedValuesList.StoreData(Dest, ACryptCtrlData);
end;


{ ----------------------------- }
{ ---- TGMSqlStatementBase ---- }
{ ----------------------------- }

constructor TGMSqlStatementBase.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  ObjectConnectedTo.OnBeforeIntfSourceChange := OnBeforeIntfSourceChange;
  FReExecutionTimer := TGMThreadTimer.Create(OnTimedReExecution, Self, cDfltReExecutionDelay);
  FSQL := TGMSqlProperty.Create(Self, '');
  FSQL.OnAfterSQLChange := SQLChanged;
  FState := rsInactive;
  CreateConnectionPoint(IGMSQLChangeNotifications);
end;

constructor TGMSqlStatementBase.Create(const AConnection: IUnknown; const ASql: TGMString; const ARefLifeTime: Boolean);
begin
  Create(ARefLifeTime);
  SQL.SQLText := ASql;
  ConnectionIntf := AConnection;
end;

destructor TGMSqlStatementBase.Destroy;
begin
  ReExecutionTimer.Stop;
  inherited Destroy;
  GMFreeAndNil(FReExecutionTimer);
  GMFreeAndNil(FSQL);
end;

procedure TGMSqlStatementBase.OnBeforeIntfSourceChange(const OldSource, NewSource: IUnknown);
begin
  if Oldsource <> NewSource then CheckIsInactive('ConnectionIntf ' + RStrProperty);
end;

procedure TGMSqlStatementBase.AssignFromObj(const Source: TObject);
begin
  if Source is TGMSqlStatementBase then 
   begin
    Close;
    ConnectionIntf := TGMSqlStatementBase(Source).ConnectionIntf;
    SQL := TGMSqlStatementBase(Source).SQL;
   end;
end;

procedure TGMSqlStatementBase.SQLChanged(const Sender: TObject);
begin
  NotifyAfterSQLChange;
  if Assigned(OnAfterSQLChange) then OnAfterSQLChange(Self);
end;

procedure TGMSqlStatementBase.ResetMembers;
begin
  FInternalExecuted := False;
  FState := rsInactive;
end;

procedure TGMSqlStatementBase.DoStateChange(const AOperation: TGMRecordsetOperation; const AInternalOperationProc: TGMObjectProc; const AParameter: IUnknown);
var newState: TGMRecordsetState;
begin
  newState := RecordsetStateAfterOperation(AOperation, Self);
  if (State <> newState) or (AOperation in [roDelete, roRefreshCurrent, roReExecuteStatement, roScheduleReExecution, roLeaveModifyingState]) then
   begin
    NotifyBeforeOperation(Ord(AOperation), AParameter);
    if Assigned(AInternalOperationProc) then AInternalOperationProc;
    FState := newState;
    NotifyAfterOperation(Ord(AOperation), AParameter);
   end;
end;

function TGMSqlStatementBase.GetTimedReExecutionDelay: Integer;
begin
  Result := ReExecutionTimer.Interval;
end;

procedure TGMSqlStatementBase.SetTimedReExecutionDelay(const AValue: Integer);
begin
  ReExecutionTimer.Interval := AValue;
end;

procedure TGMSqlStatementBase.SetSQL(const AValue: TGMSqlProperty);
begin
  SQL.AssignFromObj(AValue);
end;

function TGMSqlStatementBase.GetConnectionIntf: IUnknown;
begin
  Result := ObjectConnectedTo.InterfaceSource;
end;

procedure TGMSqlStatementBase.SetConnectionIntf(const AValue: IUnknown);
begin
  ObjectConnectedTo.InterfaceSource := AValue; // <- will be checked via OnBeforeIntfSourceChange
  {if AValue <> ConnectionIntf then
   begin
    CheckIsInactive('ConnectionIntf ' + RStrProperty);
    ObjectConnectedTo.InterfaceSource := AValue;
   end;}
end;

function TGMSqlStatementBase.GetSubItems(const AParentFieldName: TGMString; const AParentFieldValue: RGMUnionValue; const AIID: TGUID; out Intf): HResult;
begin
  Result := GMGetSubItemsBySQL(Self, AParentFieldName, AParentFieldValue, AIID, Intf);
end;

{ ---- Handles ---- }

procedure TGMSqlStatementBase.InternalExecute;
var sqlTxt: TGMString;
begin
  sqlTxt := GetResolvedSQLStatement;
  CheckSQLStatementText(sqlTxt);
  if vfGMDoTracing then GMTrace('===================================================' + cNewLine + sqlTxt, tpSQL);
  APIExecuteSQL(sqlTxt);
end;

procedure TGMSqlStatementBase.AllocHandle;
begin
  //if HandleAllocated {nd not InternalExecuted ?} then
   //begin
    InternalExecute;
    FInternalExecuted := True;
   //end;
end;

procedure TGMSqlStatementBase.ReleaseHandle;
begin
  ReExecutionTimer.Stop;
  ResetMembers;
end;


{ ---- Execute ---- }

function TGMSqlStatementBase.GetResolvedSQLStatement: TGMString;
begin
  Result := GMStrip(SQL.BuildResolvedSQLText, cSqlWhiteSpace + ';');
end;

procedure TGMSqlStatementBase.CheckSQLStatementText(const ASQL: TGMString);
begin
  GMCheckSQLNotEmpty(ASQL, Self, {$I %CurrentRoutine%});
//if IsSelectSQL(ASQL) then raise EGMException.ObjError(RStrOnlyModfifiyngSQL, Self, {$I %CurrentRoutine%});
end;

procedure TGMSqlStatementBase.Execute;
begin
  Close; Open;
end;

function TGMSqlStatementBase.CanModify: Boolean;
begin
  Result := (ConnectionIntf <> nil) and GMAskBoolean(ConnectionIntf, Ord(bvCanModify), False);
end;

{ ---- IGMSaveRestoreState ---- }

function TGMSqlStatementBase.CaptureState: IUnknown;
begin
  Result := nil;
end;

procedure TGMSqlStatementBase.RestoreState(const AState: IUnknown);
begin
end;


{ ---- IGMGetSetSortOrder ---- }

function TGMSqlStatementBase.GetColumnSortOrder(const AColumnName: TGMString): LongInt;
begin
  Result := GMFindSortOrder(AColumnName, Sql.SQLOrderBy)
end;

procedure TGMSqlStatementBase.SetColumnSortOrder(const AColumnName: TGMString; const ASortOrder: LongInt; const ACumulative, AReExecuteWhenChanged: Boolean);
var oldOrderBy, newOrderBy: TGMString;
begin
  oldOrderBy := Sql.SqlOrderBy;
  newOrderBy := GMSetSortOrder(AColumnName, ASortOrder, oldOrderBy, ACumulative);
  if GMSameText(oldOrderBy, newOrderBy) then Exit;
  Sql.SQLOrderBy := newOrderBy;
  if AReExecuteWhenChanged then ReExecuteStatement(True, True);
end;

function TGMSqlStatementBase.GetSortColumnName(var AColumnName: TGMString): Boolean;
begin
  AColumnName := GMStrip(GMDeleteWords(GMStrip(GMFirstWord(SQL.SQLOrderBy, cFieldListSeparators), cFieldListSeparators), [cSqlAscending, cSqlAsc, cSqlDescending, cSqlDesc], cSqlSeparators), cSqlSeparators);
  Result := AColumnName <> '';
end;

{ ---- ReExecute ---- }

procedure TGMSqlStatementBase.ScheduleReExecution(const AColumnsStayValid: Boolean);
begin
  FColumnsStayValidOnReExecution := AColumnsStayValid;
  if ReExecutionTimer.Interval = 0 then OnTimedReExecution(Self) else ReExecutionTimer.Restart;
end;

procedure TGMSqlStatementBase.ReExecuteStatement(const AColumnsStayValid: Boolean; APreserveState: Boolean);
var State: IUnknown;
begin
  if not Active then
   begin
    ReExecutionTimer.Stop; // <- is normaly done by Close, but when inactive close does nothing
    APreserveState := False; // <- makes no sense!
   end;

  try
   if AColumnsStayValid then DisableNotifications(Ord(rgRefeshComplete)) else APreserveState := False;
   try
    if APreserveState then State := CaptureState;
    try
     Execute; // <-- Close; Open;
    finally
     if APreserveState and Active then RestoreState(State);
    end;
   finally
    if AColumnsStayValid then EnableNotifications(Ord(rgRefeshComplete));
   end;
  finally
   // if notifications were disabled but re-execution failed notify that we are not active anymore
   if AColumnsStayValid and not Active then
    begin
     NotifyBeforeActiveChange(Active);
     NotifyAfterActiveChange(Active);
    end;
  end;
end;

procedure TGMSqlStatementBase.OnTimedReExecution(const Sender: TObject);
begin
  ReExecuteStatement(FColumnsStayValidOnReExecution);
end;

function TGMSqlStatementBase.GetName: TGMString;
begin
  Result := SQL.TableName;
end;

function TGMSqlStatementBase.GetPropertyIntf(const APropertyName: TGMString; const AIID: TGUID; out AIntf): HResult;
begin
  if GMSameText(APropertyName, cStrSQL) then Result := Sql.QueryInterface(AIID, AIntf) else Result := DISP_E_UNKNOWNNAME;
end;

function TGMSqlStatementBase.GetState: LongInt;
begin
  Result := Ord(FState);
end;

procedure TGMSqlStatementBase.EnumerateItems(const AItemKind: LongInt; const ATellEnumSink: IUnknown; const AParameter: Pointer);
begin
end;

function TGMSqlStatementBase.CanExecuteOperation(const AOperation: Integer; const AParameter: IUnknown = nil): Boolean;
begin
  case AOperation of
   Ord(roReExecuteStatement), Ord(roScheduleReExecution): Result := State in [rsInactive, rsBrowsing];
   else Result := False;
  end;
end;

function TGMSqlStatementBase.ExecuteOperation(const AOperation: Integer; const AParameter: IUnknown = nil): Boolean;
begin
  Result := True;
  case AOperation of
   Ord(roReExecuteStatement): ReExecuteStatement(AParameter = nil);
   Ord(roScheduleReExecution): ScheduleReExecution(AParameter = nil);
   else Result := False;
  end;
end;

{ ---- Notifications ---- }

procedure TGMSqlStatementBase.CallSinkAfterSQLChange(const ANotifySink: IUnknown; const AParams: array of RGMUnionValue);
var Sink: IGMSQLChangeNotifications;
begin
  if DoNotifySink(ANotifySink, IGMSQLChangeNotifications, Sink) then try Sink.AfterSQLChange; except end;
end;

procedure TGMSqlStatementBase.NotifyAfterSQLChange;
begin
  GMCpcCallNotifySinks(Self, IGMSQLChangeNotifications, GMCallSinkAfterSQLChange, NotifyDisableCount = 0, []);
end;

procedure TGMSqlStatementBase.NotifyConnectedObjectsBeforePositionChange;
begin
  // overridden in derived classes
end;

procedure TGMSqlStatementBase.NotifyConnectedObjectsAfterPositionChange;
begin
  // overridden in derived classes
end;

procedure TGMSqlStatementBase.NotifyBeforeOperation(const Operation: Integer; const Parameter: IUnknown = nil);
begin
  // overridden in derived classes
end;

procedure TGMSqlStatementBase.NotifyAfterOperation(const Operation: Integer; const Parameter: IUnknown = nil);
begin
  // overridden in derived classes
end;

procedure TGMSqlStatementBase.NotifyConnectedObjectsOnFirstDisable(const NotificationOnFirstDisable: LongInt = Ord(rgNone));
begin
  inherited NotifyConnectedObjectsOnFirstDisable(NotificationOnFirstDisable);

  case NotificationOnFirstDisable of
   Ord(rgRefreshPosition): NotifyConnectedObjectsBeforePositionChange;
   Ord(rgRefreshCurrent):  NotifyBeforeOperation(Ord(roRefreshCurrent));
   Ord(rgRefeshComplete):  NotifyBeforeOperation(Ord(roReExecuteStatement));
  end;
end;

procedure TGMSqlStatementBase.NotifyConnectedObjectsOnReEnable(const NotificationOnReEnable: LongInt = Ord(rgNone));
begin
  inherited NotifyConnectedObjectsOnReEnable(NotificationOnReEnable);

  case NotificationOnReEnable of
   Ord(rgRefreshPosition): NotifyConnectedObjectsAfterPositionChange;
   Ord(rgRefreshCurrent):  NotifyAfterOperation(Ord(roRefreshCurrent));
   Ord(rgRefeshComplete): NotifyAfterOperation(Ord(roReExecuteStatement));
  end;
end;


{ ------------------------- }
{ ---- TGMModifyViaSql ---- }
{ ------------------------- }

constructor TGMModifyViaSql.Create(const AOwner: TObject; const ARefLiftetime: Boolean = False);
begin
  inherited Create(ARefLiftetime);
  FOwner := AOwner;
end;

{function TGMModifyViaSql.FieldList: IGMStringList;
begin
  if FFieldList = nil then FFieldList := TGMStringList.Create(False, True);
  Result := FFieldList;
end;

function TGMModifyViaSql.KeyFieldList: IGMStringList;
begin
  if FKeyFieldList = nil then FKeyFieldList := TGMStringList.Create(False, True);
  Result := FKeyFieldList;
end;}

procedure TGMModifyViaSql.TellEnumString(const ItemKind: LongInt; const Value: TGMString; const Parameter: Pointer); stdcall;
begin
  case ItemKind of
   Ord(eidFieldNames): GMAddStrToArray(Value, FFieldList);
   Ord(eidKeyFieldNames): GMAddStrToArray(Value, FKeyFieldList);
  end;
end;

procedure TGMModifyViaSql.Reset;
begin
  SetLength(FFieldList, 0);
  SetLength(FKeyFieldList, 0);
  FFieldListsValid := False;
end;

procedure TGMModifyViaSql.BuildFieldLists;
const cStrMehodName = 'TGMModifyViaSql.BuildKeyFieldList';
var PIEnumKeyFields: IGMEnumerateItems;
begin
  if FFieldListsValid then Exit;
  //FieldList.Clear;
  //KeyFieldList.Clear;
  if Owner = nil then Exit;
  GMCheckGetInterface(Owner, IGMEnumerateItems, PIEnumKeyFields, cStrMehodName);
  PIEnumKeyFields.EnumerateItems(Ord(eidKeyFieldNames), Self);
  PIEnumKeyFields.EnumerateItems(Ord(eidFieldNames), Self);
  FFieldListsValid := True;
end;

function TGMModifyViaSql.KeyValuesSQL(const BufferInstance: EGMValueBufferInstance): TGMString;
var i: Integer; PIGetByName: IGMGetIntfByName; PIValBuf: IGMGetValueBufferIntf; PIValue: IGMGetUnionValue;
begin
  Result := '';
  BuildFieldLists;
  GMCheckGetInterface(Owner, IGMGetIntfByName, PIGetByName, {$I %CurrentRoutine%});
  for i:=Low(KeyFieldList) to High(KeyFieldList) do
   if (PIGetByName.GetIntfByName(KeyFieldList[i], IGMGetValueBufferIntf, PIValBuf) = S_OK) and
      (PIValBuf.GetValueBufferIntf(Ord(BufferInstance), IGMGetUnionValue, PIValue) = S_OK) then
    Result := GMStringJoin(Result, ' AND ', GMFormat('%s = %s', [KeyFieldList[i], GMUnionValueAsSqlLiteral(PIValue.Value)]));
  if Result = '' then raise EGMException.ObjError(srNoSQLKeyValues, Owner, {$I %CurrentRoutine%});
end;

procedure TGMModifyViaSql.Update(const ASQLExecuter: IUnknown);
var Values: TGMString; PIExecSql: IGMExecuteSQL; PITableName: IGMGetTableName;
    i: Integer; PIGetByName: IGMGetIntfByName; PIModified: IGMGetModified; PIValue: IGMGetUnionValue;
begin
  GMCheckQueryInterface(ASQLExecuter, IGMExecuteSQL, PIExecSql, {$I %CurrentRoutine%});
  GMCheckGetInterface(Owner, IGMGetTableName, PITableName, {$I %CurrentRoutine%});
  GMCheckGetInterface(Owner, IGMGetIntfByName, PIGetByName, {$I %CurrentRoutine%});

  BuildFieldLists;
  for i:=Low(FieldList) to High(FieldList) do
   if (PIGetByName.GetIntfByName(FieldList[i], IGMGetUnionValue, PIValue) = S_OK) and
      (PIGetByName.GetIntfByName(FieldList[i], IGMGetModified, PIModified) = S_OK) and PIModified.Modified then
    Values := GMStringJoin(Values, ', ', GMFormat('%s = %s', [FieldList[i], GMUnionValueAsSqlLiteral(PIValue.Value)]));

  Assert(Values <> '');
  PIExecSql.ExecuteSQL(GMFormat('UPDATE %s SET %S WHERE %S', [PITableName.TableName, Values, KeyValuesSQL(vbiOldValue)]));
end;

procedure TGMModifyViaSql.Insert(const ASQLExecuter: IUnknown);
var i: Integer; Names, Values: TGMString; PIExecSql: IGMExecuteSQL; PIValue: IGMGetUnionValue;
    PITableName: IGMGetTableName; PIGetByName: IGMGetIntfByName; PIModified: IGMGetModified;
begin
  GMCheckQueryInterface(ASQLExecuter, IGMExecuteSQL, PIExecSql, {$I %CurrentRoutine%});
  GMCheckGetInterface(Owner, IGMGetTableName, PITableName, {$I %CurrentRoutine%});
  GMCheckGetInterface(Owner, IGMGetIntfByName, PIGetByName, {$I %CurrentRoutine%});

  BuildFieldLists;
  for i:=Low(FieldList) to High(FieldList) do
   if (PIGetByName.GetIntfByName(FieldList[i], IGMGetUnionValue, PIValue) = S_OK) and
      (PIGetByName.GetIntfByName(FieldList[i], IGMGetModified, PIModified) = S_OK) and PIModified.Modified then
    begin
     Names := GMStringJoin(Names, ', ', FieldList[i]);
     Values := GMStringJoin(Values, ', ', GMUnionValueAsSqlLiteral(PIValue.Value));
    end;

  if (Length(Names) > 0) and (Length(Values) > 0) then
     PIExecSql.ExecuteSQL(GMFormat('INSERT INTO %s (%s) VALUES (%S)', [PITableName.TableName, Names, Values]));
end;

procedure TGMModifyViaSql.Delete(const ASQLExecuter: IUnknown);
var PIExecSql: IGMExecuteSQL; PITableName: IGMGetTableName;
begin
  GMCheckQueryInterface(ASQLExecuter, IGMExecuteSQL, PIExecSql, {$I %CurrentRoutine%});
  GMCheckGetInterface(Owner, IGMGetTableName, PITableName, {$I %CurrentRoutine%});
  PIExecSql.ExecuteSQL(GMFormat('DELETE FROM %s WHERE %S', [PITableName.TableName, KeyValuesSQL(vbiValue)]));
end;

procedure TGMModifyViaSql.Refresh;
var i: Integer; PIGetByName, PIOwnerGetByName: IGMGetIntfByName;
    PISQL: IGMSqlStatementParts; PIValBuf: IGMGetValueBufferIntf; PIValue: IGMGetSetUnionValue;
begin
  BuildFieldLists;
  GMHrCheckObj(GMObjCreateCopyQI(Owner, IGMGetIntfByName, PIGetByName), Self, {$I %CurrentRoutine%});
  GMCheckGetInterface(Owner, IGMGetIntfByName, PIOwnerGetByName, {$I %CurrentRoutine%});
  GMHrCheckObj(GMGetPropIntfFromIntf(PIGetByName, cStrSQL, IGMSqlStatementParts, PISQL), Self, {$I %CurrentRoutine%});
  PISQL.SQLWhere := KeyValuesSQL(vbiValue);
  GMSetIntfActive(PIGetByName, True, {$I %CurrentRoutine%});
  for i:=Low(FieldList) to High(FieldList) do
   if (PIOwnerGetByName.GetIntfByName(FieldList[i], IGMGetValueBufferIntf, PIValBuf) = S_OK) and
      (PIValBuf.GetValueBufferIntf(Ord(vbiValue), IGMGetSetUnionValue, PIValue) = S_OK) then
    PIValue.Value := GMCheckGetItemValue(PIGetByName, FieldList[i], {$I %CurrentRoutine%});
end;


end.