/// fast OleDB direct access classes
// - this unit is a part of the freeware Synopse framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit SynOleDB;

{
    This file is part of Synopse framework.

    Synopse framework. Copyright (C) 2022 Arnaud Bouchez
      Synopse Informatique - https://synopse.info

  *** BEGIN LICENSE BLOCK *****
  Version: MPL 1.1/GPL 2.0/LGPL 2.1

  The contents of this file are subject to the Mozilla Public License Version
  1.1 (the "License"); you may not use this file except in compliance with
  the License. You may obtain a copy of the License at
  http://www.mozilla.org/MPL

  Software distributed under the License is distributed on an "AS IS" basis,
  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  for the specific language governing rights and limitations under the License.

  The Original Code is Synopse mORMot framework.

  The Initial Developer of the Original Code is Arnaud Bouchez.

  Portions created by the Initial Developer are Copyright (C) 2022
  the Initial Developer. All Rights Reserved.

  Contributor(s):
  - Esteban Martin (EMartin)
  - Pavel Mashlyakovskii (mpv)

  Alternatively, the contents of this file may be used under the terms of
  either the GNU General Public License Version 2 or later (the "GPL"), or
  the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  in which case the provisions of the GPL or the LGPL are applicable instead
  of those above. If you wish to allow use of your version of this file only
  under the terms of either the GPL or the LGPL, and not to allow others to
  use your version of this file under the terms of the MPL, indicate your
  decision by deleting the provisions above and replace them with the notice
  and other provisions required by the GPL or the LGPL. If you do not delete
  the provisions above, a recipient may use your version of this file under
  the terms of any one of the MPL, the GPL or the LGPL.

  ***** END LICENSE BLOCK *****

  Several implementation notes about Oracle and OleDB:
  - Oracle OleDB provider by Microsoft do not handle BLOBs. Period. :(
  - Oracle OleDB provider by Oracle will handle only 3/4 BLOBs. :(
    See https://stackoverflow.com/a/6640101
  - Oracle OleDB provider by Oracle or Microsoft could trigger some ORA-80040e4B
    error when accessing column data with very low dates value (like 0001-01-01)
  - in all cases, that's why we wrote the SynDBOracle unit, for direct OCI
    access - and it is from 2 to 10 times faster than OleDB, with no setup issue
  - or take a look at latest patches from Oracle support, and pray it's fixed ;)
    https://stackoverflow.com/a/6661058

}

{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER

interface

{$ifdef MSWINDOWS} // compiles as void unit for non-Windows - allow Lazarus package

uses
  Windows,
  {$ifdef ISDELPHIXE2}System.Win.ComObj,{$else}ComObj,{$endif}
  ActiveX,
  SysUtils,
{$ifndef DELPHI5OROLDER}
  Variants,
{$endif}
  Classes,
  Contnrs,
  SynCommons,
  SynLog,
  SynTable,
  SynDB;


{ -------------- OleDB interfaces, constants and types
  (OleDB.pas is not provided e.g. in Delphi 7 Personal) }


const
  IID_IUnknown: TGUID = '{00000000-0000-0000-C000-000000000046}';
  IID_IAccessor: TGUID = '{0C733A8C-2A1C-11CE-ADE5-00AA0044773D}';
  IID_IRowset: TGUID = '{0C733A7C-2A1C-11CE-ADE5-00AA0044773D}';
  IID_IMultipleResults: TGUID = '{0C733A90-2A1C-11CE-ADE5-00AA0044773D}';
  IID_IOpenRowset: TGUID = '{0C733A69-2A1C-11CE-ADE5-00AA0044773D}';
  IID_IDataInitialize: TGUID = '{2206CCB1-19C1-11D1-89E0-00C04FD7A829}';
  IID_IDBInitialize: TGUID = '{0C733A8B-2A1C-11CE-ADE5-00AA0044773D}';
  IID_ICommandText: TGUID = '{0C733A27-2A1C-11CE-ADE5-00AA0044773D}';
  IID_ISSCommandWithParameters: TGUID = '{EEC30162-6087-467C-B995-7C523CE96561}';
  IID_ITransactionLocal: TGUID = '{0C733A5F-2A1C-11CE-ADE5-00AA0044773D}';
  IID_IDBPromptInitialize: TGUID = '{2206CCB0-19C1-11D1-89E0-00C04FD7A829}';
  CLSID_DATALINKS: TGUID = '{2206CDB2-19C1-11D1-89E0-00C04FD7A829}';
  CLSID_MSDAINITIALIZE: TGUID = '{2206CDB0-19C1-11D1-89E0-00C04FD7A829}';
  CLSID_ROWSET_TVP: TGUID = '{C7EF28D5-7BEE-443F-86DA-E3984FCD4DF9}';
  DB_NULLGUID: TGuid = '{00000000-0000-0000-0000-000000000000}';
  DBGUID_DEFAULT: TGUID = '{C8B521FB-5CF3-11CE-ADE5-00AA0044773D}';
  DBSCHEMA_TABLES: TGUID = '{C8B52229-5CF3-11CE-ADE5-00AA0044773D}';
  DBSCHEMA_COLUMNS: TGUID = '{C8B52214-5CF3-11CE-ADE5-00AA0044773D}';
  DBSCHEMA_INDEXES: TGUID = '{C8B5221E-5CF3-11CE-ADE5-00AA0044773D}';
  DBSCHEMA_FOREIGN_KEYS: TGUID = '{C8B522C4-5CF3-11CE-ADE5-00AA0044773D}';

  DBPROPSET_SQLSERVERPARAMETER: TGUID = '{FEE09128-A67D-47EA-8D40-24A1D4737E8D}';
  // PropIds for DBPROPSET_SQLSERVERPARAMETER
  SSPROP_PARAM_XML_SCHEMACOLLECTION_CATALOGNAME = 24;
  SSPROP_PARAM_XML_SCHEMACOLLECTION_SCHEMANAME = 25;
  SSPROP_PARAM_XML_SCHEMACOLLECTIONNAME = 26;
  SSPROP_PARAM_UDT_CATALOGNAME = 27;
  SSPROP_PARAM_UDT_SCHEMANAME = 28;
  SSPROP_PARAM_UDT_NAME = 29;
  SSPROP_PARAM_TYPE_CATALOGNAME = 38;
  SSPROP_PARAM_TYPE_SCHEMANAME = 39;
  SSPROP_PARAM_TYPE_TYPENAME = 40;
  SSPROP_PARAM_TABLE_DEFAULT_COLUMNS = 41;
  SSPROP_PARAM_TABLE_COLUMN_SORT_ORDER = 42;

  DBTYPE_EMPTY = $00000000;
  DBTYPE_NULL = $00000001;
  DBTYPE_I2 = $00000002;
  DBTYPE_I4 = $00000003;
  DBTYPE_R4 = $00000004;
  DBTYPE_R8 = $00000005;
  DBTYPE_CY = $00000006;
  DBTYPE_DATE = $00000007;
  DBTYPE_BSTR = $00000008;
  DBTYPE_IDISPATCH = $00000009;
  DBTYPE_ERROR = $0000000A;
  DBTYPE_BOOL = $0000000B;
  DBTYPE_VARIANT = $0000000C;
  DBTYPE_IUNKNOWN = $0000000D;
  DBTYPE_DECIMAL = $0000000E;
  DBTYPE_UI1 = $00000011;
  DBTYPE_ARRAY = $00002000;
  DBTYPE_BYREF = $00004000;
  DBTYPE_I1 = $00000010;
  DBTYPE_UI2 = $00000012;
  DBTYPE_UI4 = $00000013;
  DBTYPE_I8 = $00000014;
  DBTYPE_UI8 = $00000015;
  DBTYPE_GUID = $00000048;
  DBTYPE_VECTOR = $00001000;
  DBTYPE_RESERVED = $00008000;
  DBTYPE_BYTES = $00000080;
  DBTYPE_STR = $00000081;
  DBTYPE_WSTR = $00000082;
  DBTYPE_NUMERIC = $00000083;
  DBTYPE_UDT = $00000084;
  DBTYPE_DBDATE = $00000085;
  DBTYPE_DBTIME = $00000086;
  DBTYPE_DBTIMESTAMP = $00000087;
  DBTYPE_FILETIME = $00000040;
  DBTYPE_DBFILETIME = $00000089;
  DBTYPE_PROPVARIANT = $0000008A;
  DBTYPE_VARNUMERIC = $0000008B;
  DBTYPE_TABLE = $0000008F; // introduced in SQL 2008

  DBPARAMIO_NOTPARAM = $00000000;
  DBPARAMIO_INPUT = $00000001;
  DBPARAMIO_OUTPUT = $00000002;

  DBPARAMFLAGS_ISINPUT    = $00000001;
  DBPARAMFLAGS_ISOUTPUT   = $00000002;
  DBPARAMFLAGS_ISSIGNED   = $00000010;
  DBPARAMFLAGS_ISNULLABLE = $00000040;
  DBPARAMFLAGS_ISLONG     = $00000080;

  DBPART_VALUE = $00000001;
  DBPART_LENGTH = $00000002;
  DBPART_STATUS = $00000004;

  DBMEMOWNER_CLIENTOWNED = $00000000;
  DBMEMOWNER_PROVIDEROWNED = $00000001;

  DBACCESSOR_ROWDATA = $00000002;
  DBACCESSOR_PARAMETERDATA = $00000004;
  DBACCESSOR_OPTIMIZED = $00000008;

  DB_E_CANCELED = HResult($80040E4E);
  DB_E_NOTSUPPORTED = HResult($80040E53);
  DBCOLUMNFLAGS_MAYBENULL = $00000040;
  ISOLATIONLEVEL_READCOMMITTED = $00001000;
  DBPROMPTOPTIONS_PROPERTYSHEET = $2;
  DB_NULL_HCHAPTER = $00;
  DB_S_ENDOFROWSET = $00040EC6;
  XACTTC_SYNC = $00000002;

  MAXBOUND = 65535; { High bound for arrays }

  DBKIND_GUID_NAME     = 0;
  DBKIND_GUID_PROPID   = ( DBKIND_GUID_NAME + 1 );
  DBKIND_NAME          = ( DBKIND_GUID_PROPID + 1 );
  DBKIND_PGUID_NAME    = ( DBKIND_NAME + 1 );
  DBKIND_PGUID_PROPID  = ( DBKIND_PGUID_NAME + 1 );
  DBKIND_PROPID        = ( DBKIND_PGUID_PROPID + 1 );
  DBKIND_GUID          = ( DBKIND_PROPID + 1 );

type
  /// indicates whether the data value or some other value, such as a NULL,
  // is to be used as the value of the column or parameter
  // - see http://msdn.microsoft.com/en-us/library/ms722617
  // and http://msdn.microsoft.com/en-us/library/windows/desktop/ms716934
  TOleDBStatus = (
    stOK, stBadAccessor, stCanNotConvertValue, stIsNull, stTruncated,
    stSignMismatch, stDataoverFlow, stCanNotCreateValue, stUnavailable,
    stPermissionDenied, stIntegrityViolation, stSchemaViolation, stBadStatus,
    stDefault, stCellEmpty, stIgnoreColumn, stDoesNotExist, stInvalidURL,
    stResourceLocked, stResoruceExists, stCannotComplete, stVolumeNotFound,
    stOutOfSpace, stCannotDeleteSource, stAlreadyExists, stCanceled,
    stNotCollection, stRowSetColumn);

  /// binding status of a given column
  // - see http://msdn.microsoft.com/en-us/library/windows/desktop/ms720969
  // and http://msdn.microsoft.com/en-us/library/windows/desktop/ms716934
  TOleDBBindStatus = (
    bsOK, bsBadOrdinal, bsUnsupportedConversion, bsBadBindInfo,
    bsBadStorageFlags, bsNoInterface, bsMultipleStorage);

  PIUnknown = ^IUnknown;
  HACCESSOR = PtrUInt;
  HACCESSORDynArray = array of HACCESSOR;
  HCHAPTER = PtrUInt;
  HROW = PtrUInt;
  PHROW = ^HROW;

  DBPART = UINT;
  DBMEMOWNER = UINT;
  DBPARAMIO = UINT;
  DBPROPSTATUS = UINT;
  DBPROPID = UINT;
  DBPROPOPTIONS = UINT;
  DBCOLUMNFLAGS = UINT;
  DBKIND = UINT;
  DBSTATUS = DWORD;
  DBPARAMFLAGS = DWORD;
  DBTYPE = Word;
  DBRESULTFLAG = UINT;

  DBLENGTH = PtrUInt;
  DB_UPARAMS = PtrUInt;
  DBORDINAL = PtrUInt;

  PBoid = ^TBoid;
{$ifdef CPU64}
  {$A8} // un-packed records
{$else}
  {$A-} // packed records
{$endif}
  TBoid = record
    rgb_: array[0..15] of Byte;
  end;
  TXactOpt = record
    ulTimeout: UINT;
    szDescription: array[0..39] of Shortint;
  end;
  TXactTransInfo = record
    uow: PBoid;
    isoLevel: Integer;
    isoFlags: UINT;
    grfTCSupported: UINT;
    grfRMSupported: UINT;
    grfTCSupportedRetaining: UINT;
    grfRMSupportedRetaining: UINT;
  end;
  PErrorInfo = ^TErrorInfo;
  TErrorInfo = record
    hrError: HResult;
    dwMinor: UINT;
    clsid: TGUID;
    iid: TGUID;
    dispid: Integer;
  end;
  PDBParams = ^TDBParams;
  TDBParams = record
    pData: Pointer;
    cParamSets: PtrUInt;
    HACCESSOR: HACCESSOR;
  end;
  PDBObject = ^TDBObject;
  TDBObject = record
    dwFlags: UINT;
    iid: TGUID;
  end;
  PDBBindExt = ^TDBBindExt;
  TDBBindExt = record
    pExtension: PByte;
    ulExtension: PtrUInt;
  end;
  PDBBinding = ^TDBBinding;
  TDBBinding = record
    iOrdinal: DBORDINAL;
    obValue: PtrUInt;
    obLength: PtrUInt;
    obStatus: PtrUInt;
    pTypeInfo: ITypeInfo;
    pObject: PDBObject;
    pBindExt: PDBBindExt;
    dwPart: DBPART;
    dwMemOwner: DBMEMOWNER;
    eParamIO: DBPARAMIO;
    cbMaxLen: PtrUInt;
    dwFlags: UINT;
    wType: DBTYPE;
    bPrecision: Byte;
    bScale: Byte;
  end;
  PDBBindingArray = ^TDBBindingArray;
  TDBBindingArray = array[0..MAXBOUND] of TDBBinding;
  TDBBindingDynArray = array of TDBBinding;
  DBIDGUID = record
    case Integer of
      0: (guid: TGUID);
      1: (pguid: ^TGUID);
  end;
  DBIDNAME = record
    case Integer of
      0: (pwszName: PWideChar);
      1: (ulPropid: UINT);
  end;
  PDBID = ^DBID;
  DBID = record
    uGuid: DBIDGUID;
    eKind: DBKIND;
    uName: DBIDNAME;
  end;
  PDBIDArray = ^TDBIDArray;
  TDBIDArray = array[0..MAXBOUND] of DBID;
  PDBColumnInfo = ^TDBColumnInfo;
  TDBColumnInfo = record
    pwszName: PWideChar;
    pTypeInfo: ITypeInfo;
    iOrdinal: DBORDINAL;
    dwFlags: DBCOLUMNFLAGS;
    ulColumnSize: PtrUInt;
    wType: DBTYPE;
    bPrecision: Byte;
    bScale: Byte;
    columnid: DBID;
  end;
  DBSOURCETYPE = DWORD;
  PDBSOURCETYPE = ^DBSOURCETYPE;
  TDBProp = record
    dwPropertyID: DBPROPID;
    dwOptions: DBPROPOPTIONS;
    dwStatus: DBPROPSTATUS;
    colid: DBID;
    vValue: OleVariant;
  end;
  PDBPropArray = ^TDBPropArray;
  TDBPropArray = array[0..MAXBOUND] of TDBProp;
  TDBPropSet = record
    rgProperties: PDBPropArray;
    cProperties: UINT;
    guidPropertySet: TGUID;
  end;
  PDBPropSet = ^TDBPropSet;
  PDBPropSetArray = ^TDBPropSetArray;
  TDBPropSetArray = array[0..MAXBOUND] of TDBPropSet;
  TDBSchemaRec = record
    SchemaGuid: TGuid;
    SupportedRestrictions: Integer;
  end;
  TSSPARAMPROPS = record
    iOrdinal: DBORDINAL;
    cPropertySets: ULONG;
    rgPropertySets: PDBPropSet;
  end;
  PSSPARAMPROPS = ^TSSPARAMPROPS;
  PSSPARAMPROPSArray = ^TSSPARAMPROPSArray;
  TSSPARAMPROPSArray = array[0..MAXBOUND] of TSSPARAMPROPS;
  TSSPARAMPROPSDynArray = array of TSSPARAMPROPS;

  PDBParamInfo = ^TDBParamInfo;
  DBPARAMINFO = record
    dwFlags: UINT;
    iOrdinal: DBORDINAL;
    pwszName: PWideChar;
    pTypeInfo: ITypeInfo;
    ulParamSize: DBLENGTH;
    wType: DBTYPE;
    bPrecision: Byte;
    bScale: Byte;
  end;
  TDBParamInfo = DBPARAMINFO;

  PUintArray = ^TUintArray;
  TUintArray = array[0..MAXBOUND] of UINT;
  TUintDynArray = array of UINT;

  PDBParamBindInfo = ^TDBParamBindInfo;
  DBPARAMBINDINFO = record
    pwszDataSourceType: PWideChar;
    pwszName: PWideChar;
    ulParamSize: DBLENGTH;
    dwFlags: DBPARAMFLAGS;
    bPrecision: Byte;
    bScale: Byte;
  end;
  TDBParamBindInfo = DBPARAMBINDINFO;

  PDBParamBindInfoArray = ^TDBParamBindInfoArray;
  TDBParamBindInfoArray = array[0..MAXBOUND] of TDBParamBindInfo;
  TDBParamBindInfoDynArray = array of TDBParamBindInfo;

{$ifndef CPU64}
  {$A-} // packed records
{$endif}

  /// initialize and uninitialize OleDB data source objects and enumerators
  IDBInitialize = interface(IUnknown)
    ['{0C733A8B-2A1C-11CE-ADE5-00AA0044773D}']
    function Initialize: HResult; stdcall;
    function Uninitialize: HResult; stdcall;
  end;
  /// create an OleDB data source object using a connection string
  IDataInitialize = interface(IUnknown)
    ['{2206CCB1-19C1-11D1-89E0-00C04FD7A829}']
    function GetDataSource(const pUnkOuter: IUnknown; dwClsCtx: DWORD;
      pwszInitializationString: POleStr; const riid: TIID;
      var DataSource: IUnknown): HResult; stdcall;
    function GetInitializationString(const DataSource: IUnknown;
      fIncludePassword: Boolean; out pwszInitString: POleStr): HResult; stdcall;
    function CreateDBInstance(const clsidProvider: TGUID;
      const pUnkOuter: IUnknown; dwClsCtx: DWORD; pwszReserved: POleStr;
      riid: TIID; var DataSource: IUnknown): HResult; stdcall;
    function CreateDBInstanceEx(const clsidProvider: TGUID;
      const pUnkOuter: IUnknown; dwClsCtx: DWORD; pwszReserved: POleStr;
      pServerInfo: PCoServerInfo; cmq: ULONG; rgmqResults: PMultiQI): HResult; stdcall;
    function LoadStringFromStorage(pwszFileName: POleStr;
      out pwszInitializationString: POleStr): HResult; stdcall;
    function WriteStringToStorage(pwszFileName, pwszInitializationString: POleStr;
      dwCreationDisposition: DWORD): HResult; stdcall;
  end;
  /// obtain a new session to a given OleDB data source
  IDBCreateSession = interface(IUnknown)
    ['{0C733A5D-2A1C-11CE-ADE5-00AA0044773D}']
    function CreateSession(const punkOuter: IUnknown; const riid: TGUID;
      out ppDBSession: IUnknown): HResult; stdcall;
  end;
  /// commit, abort, and obtain status information about OleDB transactions
  ITransaction = interface(IUnknown)
    ['{0FB15084-AF41-11CE-BD2B-204C4F4F5020}']
    function Commit(fRetaining: BOOL; grfTC: UINT; grfRM: UINT): HResult; stdcall;
    function Abort(pboidReason: PBOID; fRetaining: BOOL; fAsync: BOOL): HResult; stdcall;
    function GetTransactionInfo(out pinfo: TXactTransInfo): HResult; stdcall;
  end;
  /// gets and sets a suite of options associated with an OleDB transaction
  ITransactionOptions = interface(IUnknown)
    ['{3A6AD9E0-23B9-11CF-AD60-00AA00A74CCD}']
    function SetOptions(var pOptions: TXactOpt): HResult; stdcall;
    function GetOptions(var pOptions: TXactOpt): HResult; stdcall;
  end;
  /// optional interface on OleDB sessions, used to start, commit, and abort
  // transactions on the session
  ITransactionLocal = interface(ITransaction)
    ['{0C733A5F-2A1C-11CE-ADE5-00AA0044773D}']
    function GetOptionsObject(out ppOptions: ITransactionOptions): HResult; stdcall;
    function StartTransaction(isoLevel: Integer; isoFlags: UINT;
      const pOtherOptions: ITransactionOptions; pulTransactionLevel: PUINT): HResult; stdcall;
  end;
  /// provide methods to execute commands
  ICommand = interface(IUnknown)
    ['{0C733A63-2A1C-11CE-ADE5-00AA0044773D}']
    function Cancel: HResult; stdcall;
    function Execute(const punkOuter: IUnknown; const riid: TGUID; var pParams: TDBParams;
      pcRowsAffected: PInteger; ppRowset: PIUnknown): HResult; stdcall;
    function GetDBSession(const riid: TGUID; out ppSession: IUnknown): HResult; stdcall;
  end;
  /// methods to access the ICommand text to be executed
  ICommandText = interface(ICommand)
    ['{0C733A27-2A1C-11CE-ADE5-00AA0044773D}']
    function GetCommandText(var pguidDialect: TGUID;
      out ppwszCommand: PWideChar): HResult; stdcall;
    function SetCommandText(const guidDialect: TGUID;
      pwszCommand: PWideChar): HResult; stdcall;
  end;

  ICommandWithParameters = interface(IUnknown)
    ['{0C733A64-2A1C-11CE-ADE5-00AA0044773D}']
    function GetParameterInfo(var pcParams: UINT; out prgParamInfo: PDBPARAMINFO;
      ppNamesBuffer: PPOleStr): HResult; stdcall;
    function MapParameterNames(cParamNames: DB_UPARAMS; rgParamNames: POleStrList;
      rgParamOrdinals: PPtrUIntArray): HResult; stdcall;
    function SetParameterInfo(cParams: DB_UPARAMS; rgParamOrdinals: PPtrUIntArray;
      rgParamBindInfo: PDBParamBindInfoArray): HResult; stdcall;
  end;

  ISSCommandWithParameters = interface(ICommandWithParameters)
    ['{EEC30162-6087-467C-B995-7C523CE96561}']
    function GetParameterProperties(var pcParams: PtrUInt; var prgParamProperties: PSSPARAMPROPS): HResult; stdcall;
    function SetParameterProperties (cParams: PtrUInt; prgParamProperties: PSSPARAMPROPS): HResult; stdcall;
  end;

  /// provides methods for fetching rows sequentially, getting the data from
  // those rows, and managing rows
  IRowset = interface(IUnknown)
    ['{0C733A7C-2A1C-11CE-ADE5-00AA0044773D}']
    /// Adds a reference count to an existing row handle
    function AddRefRows(cRows: PtrUInt; rghRows: PPtrUIntArray;
      rgRefCounts, rgRowStatus: PCardinalArray): HResult; stdcall;
    /// Retrieves data from the rowset's copy of the row
    function GetData(HROW: HROW; HACCESSOR: HACCESSOR; pData: Pointer): HResult; stdcall;
    /// Fetches rows sequentially, remembering the previous position
    // - this method has been modified from original OleDB.pas to allow direct
    // typecast of prghRows parameter to pointer(fRowStepHandles)
    function GetNextRows(hReserved: HCHAPTER; lRowsOffset: PtrInt; cRows: PtrInt;
      out pcRowsObtained: PtrUInt; var prghRows: pointer): HResult; stdcall;
    /// Releases rows
    function ReleaseRows(cRows: UINT; rghRows: PPtrUIntArray; rgRowOptions,
      rgRefCounts, rgRowStatus: PCardinalArray): HResult; stdcall;
    /// Repositions the next fetch position to its initial position
    // - that is, its position when the rowset was first created
    function RestartPosition(hReserved: HCHAPTER): HResult; stdcall;
  end;

  IOpenRowset = interface(IUnknown)
    ['{0C733A69-2A1C-11CE-ADE5-00AA0044773D}']
    function OpenRowset(const punkOuter: IUnknown; pTableID: PDBID; pIndexID: PDBID;
      const riid: TGUID; cPropertySets: UINT; rgPropertySets: PDBPropSetArray;
      ppRowset: PIUnknown): HResult; stdcall;
  end;

  IMultipleResults = interface(IUnknown)
  ['{0c733a8c-2a1c-11ce-ade5-00aa0044773d}']
    function GetResult(const pUnkOuter: IUnknown; lResultFlag: DBRESULTFLAG;
    const riid: TIID; pcRowsAffected: PInteger;ppRowset: PIUnknown): HResult; stdcall;
  end;

  /// interface used to retrieve enhanced custom error information
  IErrorRecords = interface(IUnknown)
    ['{0c733a67-2a1c-11ce-ade5-00aa0044773d}']
    function AddErrorRecord(pErrorInfo: PErrorInfo; dwLookupID: UINT;
      pDispParams: pointer; const punkCustomError: IUnknown;
      dwDynamicErrorID: UINT): HResult; stdcall;
    function GetBasicErrorInfo(ulRecordNum: UINT;
      pErrorInfo: PErrorInfo): HResult; stdcall;
    function GetCustomErrorObject(ulRecordNum: UINT;
      const riid: TGUID; var ppObject: IUnknown): HResult; stdcall;
    function GetErrorInfo(ulRecordNum: UINT; lcid: LCID;
      var ppErrorInfo: IErrorInfo): HResult; stdcall;
    function GetErrorParameters(ulRecordNum: UINT;
      pDispParams: pointer): HResult; stdcall;
    function GetRecordCount(var pcRecords: UINT): HResult; stdcall;
  end;
  /// used on an OleDB session to obtain a new command
  IDBCreateCommand = interface(IUnknown)
    ['{0C733A1D-2A1C-11CE-ADE5-00AA0044773D}']
    function CreateCommand(const punkOuter: IUnknown; const riid: TGUID;
      out ppCommand: ICommand): HResult; stdcall;
  end;
  /// provides methods for accessor management, to access OleDB data
  // - An accessor is a data structure created by the consumer that describes
  // how row or parameter data from the data store is to be laid out in the
  // consumer's data buffer.
  // - For each column in a row (or parameter in a set of parameters), the
  // accessor contains a binding. A binding is a DBBinding data structure that
  // holds information about a column or parameter value, such as its ordinal
  // value, data type, and destination in the consumer's buffer.
  IAccessor = interface(IUnknown)
    ['{0C733A8C-2A1C-11CE-ADE5-00AA0044773D}']
    function AddRefAccessor(HACCESSOR: HACCESSOR; pcRefCount: PUINT): HResult; stdcall;
    function CreateAccessor(dwAccessorFlags: UINT; cBindings: PtrUInt; rgBindings: PDBBindingArray;
      cbRowSize: PtrUInt; var phAccessor: HACCESSOR; rgStatus: PCardinalArray): HResult; stdcall;
    function GetBindings(HACCESSOR: HACCESSOR; pdwAccessorFlags: PUINT; var pcBindings: PtrUInt;
      out prgBindings: PDBBinding): HResult; stdcall;
    function ReleaseAccessor(HACCESSOR: HACCESSOR; pcRefCount: PUINT): HResult; stdcall;
  end;
  /// expose information about columns of an OleDB rowset or prepared command
  IColumnsInfo = interface(IUnknown)
    ['{0C733A11-2A1C-11CE-ADE5-00AA0044773D}']
    function GetColumnInfo(var pcColumns: PtrUInt; out prgInfo: PDBColumnInfo;
      out ppStringsBuffer: PWideChar): HResult; stdcall;
    function MapColumnIDs(cColumnIDs: PtrUInt; rgColumnIDs: PDBIDArray;
      rgColumns: PPtrUIntArray): HResult; stdcall;
  end;
  /// allows the display of the data link dialog boxes programmatically
  IDBPromptInitialize = interface(IUnknown)
    ['{2206CCB0-19C1-11D1-89E0-00C04FD7A829}']
    function PromptDataSource(const pUnkOuter: IUnknown; hWndParent: HWND;
      dwPromptOptions: UINT; cSourceTypeFilter: ULONG;
      rgSourceTypeFilter: PDBSOURCETYPE; pszProviderFilter: POleStr;
      const riid: TIID; var DataSource: IUnknown): HResult; stdcall;
    function PromptFileName(hWndParent: HWND; dwPromptOptions: UINT;
      pwszInitialDirectory, pwszInitialFile: POleStr;
      var ppwszSelectedFile: POleStr): HResult; stdcall;
  end;
  /// used to retrieve the database metadata (e.g. tables and fields layout)
  IDBSchemaRowset = interface(IUnknown)
    ['{0c733a7b-2a1c-11ce-ade5-00aa0044773d}']
    function GetRowset(pUnkOuter: IUnknown; const rguidSchema: TGUID;
      cRestrictions: Integer; rgRestrictions: pointer;
      const riid: TIID; cPropertySets: Integer; rgPropertySets: PDBPROPSET;
      var ppRowset: IRowset): HResult; stdcall;
    function GetSchemas(var pcSchemas: Integer; var prgSchemas: PGUID;
      var prgRestrictionSupport: PInteger): HResult; stdcall;
  end;


{ -------------- TOleDB* OleDB classes and types }

type
  /// generic Exception type, generated for OleDB connection
  EOleDBException = class(ESQLDBException);

  TOleDBConnection = class;

  TOleDBOnCustomError = function(Connection: TOleDBConnection;
    ErrorRecords: IErrorRecords; RecordNum: UINT): boolean of object;

  /// will implement properties shared by OleDB connections
  TOleDBConnectionProperties = class(TSQLDBConnectionPropertiesThreadSafe)
  protected
    fProviderName: RawUTF8;
    fConnectionString: SynUnicode;
    fOnCustomError: TOleDBOnCustomError;
    fSchemaRec: array of TDBSchemaRec;
    fSupportsOnlyIRowset: boolean;
    function GetSchema(const aUID: TGUID; const Fields: array of RawUTF8;
      var aResult: IRowSet): boolean;
    /// will create the generic fConnectionString from supplied parameters
    procedure SetInternalProperties; override;
    /// initialize fForeignKeys content with all foreign keys of this DB
    // - used by GetForeignKey method
    procedure GetForeignKeys; override;
    /// create the database
    // - shall be called only if necessary (e.g. for file-based database, if
    // the file does not exist yet)
    function CreateDatabase: boolean; virtual;
  public
    /// create a new connection
    // - call this method if the shared MainConnection is not enough (e.g. for
    // multi-thread access)
    // - the caller is responsible of freeing this instance
    // - this overridden method will create an TOleDBConnection instance
    function NewConnection: TSQLDBConnection; override;
    /// display the OleDB/ADO Connection Settings dialog to customize the
    // OleDB connection string
    // - returns TRUE if the connection string has been modified
    // - Parent is an optional GDI Window Handle for modal display
    function ConnectionStringDialogExecute(Parent: HWND=0): boolean;
    /// get all table names
    // - will retrieve the corresponding metadata from OleDB interfaces if SQL
    // direct access was not defined
    procedure GetTableNames(out Tables: TRawUTF8DynArray); override;
    /// retrieve the column/field layout of a specified table
    // - will retrieve the corresponding metadata from OleDB interfaces if SQL
    // direct access was not defined
    procedure GetFields(const aTableName: RawUTF8; out Fields: TSQLDBColumnDefineDynArray); override;
    /// convert a textual column data type, as retrieved e.g. from SQLGetField,
    // into our internal primitive types
    function ColumnTypeNativeToDB(const aNativeType: RawUTF8; aScale: integer): TSQLDBFieldType; override;
    /// the associated OleDB connection string
    // - is set by the Create() constructor most of the time from the supplied
    // server name, user id and password, according to the database provider
    // corresponding to the class
    // - you may want to customize it via the ConnectionStringDialogExecute
    // method, or to provide some additional parameters
    property ConnectionString: SynUnicode read fConnectionString write fConnectionString;
    /// custom Error handler for OleDB COM objects
    // - returns TRUE if specific error was retrieved and has updated
    // ErrorMessage and InfoMessage
    // - default implementation just returns false
    property OnCustomError: TOleDBOnCustomError read fOnCustomError write fOnCustomError;
  published { to be loggged as JSON }
    /// the associated OleDB provider name, as set for each class
    property ProviderName: RawUTF8 read fProviderName;
  end;

  /// OleDB connection properties to an Oracle database using Oracle's Provider
  // - this will use the native OleDB provider supplied by Oracle
  // see @http://download.oracle.com/docs/cd/E11882_01/win.112/e17726/toc.htm
  TOleDBOracleConnectionProperties = class(TOleDBConnectionProperties)
  protected
    /// will set the appropriate provider name, i.e. 'OraOLEDB.Oracle.1'
    procedure SetInternalProperties; override;
  end;

  /// OleDB connection properties to an Oracle database using Microsoft's Provider
  // - this will use the generic (older) OleDB provider supplied by Microsoft
  // which would not be used any more:
  // "This feature will be removed in a future version of Windows. Avoid
  // using this feature in new development work, and plan to modify applications
  // that currently use this feature. Instead, use Oracle's OLE DB provider."
  // see http://msdn.microsoft.com/en-us/library/ms675851
  TOleDBMSOracleConnectionProperties = class(TOleDBOracleConnectionProperties)
  protected
    /// will set the appropriate provider name, i.e. 'MSDAORA'
    procedure SetInternalProperties; override;
  end;

  /// OleDB connection properties to Microsoft SQL Server 2008-2012, via
  // SQL Server Native Client 10.0 (SQL Server 2008)
  // - this will use the native OleDB provider supplied by Microsoft
  // see http://msdn.microsoft.com/en-us/library/ms677227
  // - is aUserID='' at Create, it will use Windows Integrated Security
  // for the connection
  // - will use the SQLNCLI10 provider, which will work on Windows XP;
  // if you want all features, especially under MS SQL 2012, use the
  // inherited class TOleDBMSSQL2012ConnectionProperties; if, on the other
  // hand, you need to connect to a old MS SQL Server 2005, use
  // TOleDBMSSQL2005ConnectionProperties, or set your own provider string
  TOleDBMSSQLConnectionProperties = class(TOleDBConnectionProperties)
  protected
    /// will set the appropriate provider name, i.e. 'SQLNCLI10'
    procedure SetInternalProperties; override;
    /// custom Error handler for OleDB COM objects
    // - will handle Microsoft SQL Server error messages (if any)
    function MSOnCustomError(Connection: TOleDBConnection;
      ErrorRecords: IErrorRecords; RecordNum: UINT): boolean;
  public
  end;

  /// OleDB connection properties to Microsoft SQL Server 2005, via
  // SQL Server Native Client (SQL Server 2005)
  // - this overridden version will use the SQLNCLI provider, which is
  // deprecated but may be an alternative with MS SQL Server 2005
  // - is aUserID='' at Create, it will use Windows Integrated Security
  // for the connection
  TOleDBMSSQL2005ConnectionProperties = class(TOleDBMSSQLConnectionProperties)
  protected
    /// will set the appropriate provider name, i.e. 'SQLNCLI'
    procedure SetInternalProperties; override;
  public
    /// initialize the connection properties
    // - this overridden version will disable the MultipleValuesInsert()
    // optimization as defined in TSQLDBConnectionProperties.Create(),
    // since INSERT with multiple VALUES (..),(..),(..) is available only
    // since SQL Server 2008
    constructor Create(const aServerName, aDatabaseName, aUserID, aPassWord: RawUTF8); override;
  end;

  /// OleDB connection properties to Microsoft SQL Server 2008, via
  // SQL Server Native Client 10.0 (SQL Server 2008)
  // - just maps default TOleDBMSSQLConnectionProperties type
  TOleDBMSSQL2008ConnectionProperties = TOleDBMSSQLConnectionProperties;

  /// OleDB connection properties to Microsoft SQL Server 2008/2012, via
  // SQL Server Native Client 11.0 (Microsoft SQL Server 2012 Native Client)
  // - from http://www.microsoft.com/en-us/download/details.aspx?id=29065 get
  // the sqlncli.msi package corresponding to your Operating System: note that
  // the "X64 Package" will also install the 32-bit version of the client
  // - this overridden version will use newer SQLNCLI11 provider, but won't work
  // under Windows XP - in this case, it will fall back to SQLNCLI10 - see
  // http://msdn.microsoft.com/en-us/library/ms131291
  // - if aUserID='' at Create, it will use Windows Integrated Security
  // for the connection
  // - for SQL Express LocalDB edition, just use aServerName='(localdb)\v11.0'
  TOleDBMSSQL2012ConnectionProperties = class(TOleDBMSSQLConnectionProperties)
  protected
    /// will set the appropriate provider name, i.e. 'SQLNCLI11'
    // - will leave older 'SQLNCLI10' on Windows XP
    procedure SetInternalProperties; override;
  end;

  /// OleDB connection properties to MySQL Server
  TOleDBMySQLConnectionProperties = class(TOleDBConnectionProperties)
  protected
    /// will set the appropriate provider name, i.e. 'MySQLProv'
    procedure SetInternalProperties; override;
  end;

{$ifndef CPU64} // Jet is not available on Win64

  /// OleDB connection properties to Jet/MSAccess .mdb files
  // - the server name should be the .mdb file name
  // - note that the Jet OleDB driver is not available under Win64 platform
  TOleDBJetConnectionProperties = class(TOleDBConnectionProperties)
  protected
    /// will set the appropriate provider name, i.e. 'Microsoft.Jet.OLEDB.4.0'
    procedure SetInternalProperties; override;
  end;

{$endif}

  /// OleDB connection properties to Microsoft Access Database
  TOleDBACEConnectionProperties = class(TOleDBConnectionProperties)
  protected
    /// will set the appropriate provider name, i.e. 'Microsoft.ACE.OLEDB.12.0'
    procedure SetInternalProperties; override;
  end;

  /// OleDB connection properties to IBM AS/400
  TOleDBAS400ConnectionProperties = class(TOleDBConnectionProperties)
  protected
    /// will set the appropriate provider name, i.e. 'IBMDA400.DataSource.1'
    procedure SetInternalProperties; override;
  end;

  /// OleDB connection properties to Informix Server
  TOleDBInformixConnectionProperties = class(TOleDBConnectionProperties)
  protected
    /// will set the appropriate provider name, i.e. 'Ifxoledbc'
    procedure SetInternalProperties; override;
  end;

  /// OleDB connection properties via Microsoft Provider for ODBC
  // - this will use the ODBC provider supplied by Microsoft
  // see http://msdn.microsoft.com/en-us/library/ms675326(v=VS.85).aspx
  // - an ODBC Driver should be specified at creation
  // - you should better use direct connection classes, like
  // TOleDBMSSQLConnectionProperties or TOleDBOracleConnectionProperties
  // as defined in SynDBODBC.pas
  TOleDBODBCSQLConnectionProperties = class(TOleDBConnectionProperties)
  protected
    fDriver: RawUTF8;
    /// will set the appropriate provider name, i.e. 'MSDASQL'
    procedure SetInternalProperties; override;
  public
    /// initialize the properties
    // - an additional parameter is available to set the ODBC driver to use
    // - you may also set aDriver='' and modify the connection string directly,
    // e.g. adding '{ DSN=name | FileDSN=filename };'
    constructor Create(const aDriver, aServerName, aDatabaseName,
      aUserID, aPassWord: RawUTF8); reintroduce;
  published { to be logged as JSON }
    /// the associated ODBC Driver name, as specified at creation
    property Driver: RawUTF8 read fDriver;
  end;

  /// implements an OleDB connection
  // - will retrieve the remote DataBase behavior from a supplied
  // TSQLDBConnectionProperties class, shared among connections
  TOleDBConnection = class(TSQLDBConnectionThreadSafe)
  protected
    fMalloc: IMalloc;
    fDBInitialize: IDBInitialize;
    fTransaction: ITransactionLocal;
    fSession: IUnknown;
    fOleDBProperties: TOleDBConnectionProperties;
    fOleDBErrorMessage, fOleDBInfoMessage: string;
    /// Error handler for OleDB COM objects
    // - will update ErrorMessage and InfoMessage
    procedure OleDBCheck(aStmt: TSQLDBStatement; aResult: HRESULT;
      const aStatus: TCardinalDynArray=nil); virtual;
    /// called just after fDBInitialize.Initialized: could add parameters
    procedure OnDBInitialized; virtual;
  public
    /// connect to a specified OleDB database
    constructor Create(aProperties: TSQLDBConnectionProperties); override;
    /// release all associated memory and OleDB COM objects
    destructor Destroy; override;
    /// initialize a new SQL query statement for the given connection
    // - the caller should free the instance after use
    function NewStatement: TSQLDBStatement; override;
    /// connect to the specified database
    // - should raise an EOleDBException on error
    procedure Connect; override;
    /// stop connection to the specified database
    // - should raise an EOleDBException on error
    procedure Disconnect; override;
    /// return TRUE if Connect has been already successfully called
    function IsConnected: boolean; override;
    /// begin a Transaction for this connection
    // - be aware that not all OleDB provider support nested transactions
    // see http://msdn.microsoft.com/en-us/library/ms716985(v=vs.85).aspx
    procedure StartTransaction; override;
    /// commit changes of a Transaction for this connection
    // - StartTransaction method must have been called before
    procedure Commit; override;
    /// discard changes of a Transaction for this connection
    // - StartTransaction method must have been called before
    procedure Rollback; override;
    /// the associated OleDB database properties
    property OleDBProperties: TOleDBConnectionProperties read fOleDBProperties;
    /// internal error message, as retrieved from the OleDB provider
    property OleDBErrorMessage: string read fOleDBErrorMessage;
    /// internal information message, as retrieved from the OleDB provider
    property OleDBInfoMessage: string read fOleDBInfoMessage;
  end;

  /// used to store properties and value about one TOleDBStatement Param
  // - we don't use a Variant, not the standard TSQLDBParam record type,
  // but manual storage for better performance
  // - whole memory block of a TOleDBStatementParamDynArray will be used as the
  // source Data for the OleDB parameters - so we should align data carefully
  {$ifdef CPU64}
    {$A8} // un-packed records
  {$else}
    {$A-} // packed records
  {$endif}
  TOleDBStatementParam = record
    /// storage used for BLOB (ftBlob) values
    // - will be refered as DBTYPE_BYREF when sent as OleDB parameters, to
    // avoid unnecessary memory copy
    VBlob: RawByteString;
    /// storage used for TEXT (ftUTF8) values
    // - we store TEXT here as WideString, and not RawUTF8, since OleDB
    // expects the text to be provided with Unicode encoding
    // - for some providers (like Microsoft SQL Server 2008 R2, AFAIK), using
    // DBTYPE_WSTR value (i.e. what the doc. says) will raise an OLEDB Error
    // 80040E1D (DB_E_UNSUPPORTEDCONVERSION, i.e. 'Requested conversion is not
    // supported'): we found out that only DBTYPE_BSTR type (i.e. OLE WideString)
    // does work... so we'll use it here! Shame on Microsoft!
    // - what's fine with DBTYPE_BSTR is that it can be resized by the provider
    // in case of VInOut in [paramOut, paramInOut] - so let it be
    VText: WideString;
    /// storage used for ftInt64, ftDouble, ftDate and ftCurrency value
    VInt64: Int64;
    /// storage used for table variables
    VIUnknown: IUnknown;
    /// storage used for table variables
    VArray: TRawUTF8DynArray;
    /// storage used for the OleDB status field
    // - if VStatus=ord(stIsNull), then it will bind a NULL with the type
    // as set by VType (to avoid conversion error like in [e8c211062e])
    VStatus: integer;
    /// the column/parameter Value type
    VType: TSQLDBFieldType;
    /// define if parameter can be retrieved after a stored procedure execution
    VInOut: TSQLDBParamInOutType;
    // so that VInt64 will be 8 bytes aligned
    VFill: array[sizeof(TSQLDBFieldType)+sizeof(TSQLDBParamInOutType)+sizeof(integer)..
      SizeOf(Int64)-1] of byte;
  end;
  {$ifdef CPU64}
    {$A-} // packed records
  {$endif}
  POleDBStatementParam = ^TOleDBStatementParam;

  /// used to store properties about TOleDBStatement Parameters
  // - whole memory block of a TOleDBStatementParamDynArray will be used as the
  // source Data for the OleDB parameters
  TOleDBStatementParamDynArray = array of TOleDBStatementParam;

  /// implements an OleDB SQL query statement
  // - this statement won't retrieve all rows of data, but will allow direct
  // per-row access using the Step() and Column*() methods
  TOleDBStatement = class(TSQLDBStatement)
  protected
    fParams: TOleDBStatementParamDynArray;
    fColumns: TSQLDBColumnPropertyDynArray;
    fParam: TDynArray;
    fColumn: TDynArrayHashed;
    fCommand: ICommandText;
    fRowSet: IRowSet;
    fRowSetAccessor: HACCESSOR;
    fRowSize: integer;
    fRowStepResult: HRESULT;
    fRowStepHandleRetrieved: PtrUInt;
    fRowStepHandleCurrent: PtrUInt;
    fRowStepHandles: TPtrUIntDynArray;
    fRowSetData: array of byte;
    fParamBindings: TDBBindingDynArray;
    fColumnBindings: TDBBindingDynArray;
    fHasColumnValueInlined: boolean;
    fOleDBConnection: TOleDBConnection;
    fDBParams: TDBParams;
    fRowBufferSize: integer;
    fUpdateCount: integer;
    fAlignBuffer: boolean;
    procedure SetRowBufferSize(Value: integer);
    /// resize fParams[] if necessary, set the VType and return pointer to
    // the corresponding entry in fParams[]
    // - first parameter has Param=1
    function CheckParam(Param: Integer; NewType: TSQLDBFieldType;
      IO: TSQLDBParamInOutType): POleDBStatementParam; overload;
    function CheckParam(Param: Integer; NewType: TSQLDBFieldType;
      IO: TSQLDBParamInOutType; ArrayCount: integer): POleDBStatementParam; overload;
    /// raise an exception if Col is incorrect or no IRowSet is available
    // - set Column to the corresponding fColumns[] item
    // - return a pointer to status-data[-length] in fRowSetData[], or
    // nil if status states this column is NULL
    function GetCol(Col: integer; out Column: PSQLDBColumnProperty): pointer;
    procedure GetCol64(Col: integer; DestType: TSQLDBFieldType; var Dest);
      {$ifdef HASINLINE}inline;{$endif}
    procedure FlushRowSetData;
    procedure ReleaseRowSetDataAndRows;
    procedure CloseRowSet;
    ///  retrieve column information, and initialize Bindings[]
    // - add the high-level column information in Column[], initializes
    // OleDB Bindings array and returns the row size (in bytes)
    function BindColumns(ColumnInfo: IColumnsInfo; var Column: TDynArrayHashed;
      out Bindings: TDBBindingDynArray): integer;
    procedure LogStatusError(Status: integer; Column: PSQLDBColumnProperty);
  public
    /// create an OleDB statement instance, from an OleDB connection
    // - the Execute method can be called only once per TOleDBStatement instance
    // - if the supplied connection is not of TOleDBConnection type, will raise
    // an exception
    constructor Create(aConnection: TSQLDBConnection); override;
    /// release all associated memory and COM objects
    destructor Destroy; override;
    /// retrieve column information from a supplied IRowSet
    // - is used e.g. by TOleDBStatement.Execute or to retrieve metadata columns
    // - raise an exception on error
    procedure FromRowSet(RowSet: IRowSet);

    /// bind a NULL value to a parameter
    // - the leftmost SQL parameter has an index of 1
    // - OleDB during MULTI INSERT statements expect BoundType to be set in
    // TOleDBStatementParam, and its VStatus set to ord(stIsNull)
    // - raise an EOleDBException on any error
    procedure BindNull(Param: Integer; IO: TSQLDBParamInOutType=paramIn;
      BoundType: TSQLDBFieldType=ftNull); override;
    /// bind an array of Int64 values to a parameter
    // - using TABLE variable (MSSQl 2008 & UP). Must be created in the database as:
    // $ CREATE TYPE dbo.IDList AS TABLE(id bigint NULL)
    // - Internally BindArray(0, [1, 2,3]) is the same as:
    // $ declare @a dbo.IDList;
    // $ insert into @a (id) values (1), (2), (3);
    // $ SELECT usr.ID   FROM user usr WHERE usr.ID IN  (select id from @a)
    procedure BindArray(Param: Integer;
      const Values: array of Int64); overload; override;
    /// bind a array of RawUTF8 (255 length max) values to a parameter
    // - using TABLE variable (MSSQl 2008 & UP). Must be created in the database as:
    // $ CREATE TYPE dbo.StrList AS TABLE(id nvarchar(255) NULL)
    // - must be declareded in the database
    procedure BindArray(Param: Integer;
      const Values: array of RawUTF8); overload; override;
    /// bind an integer value to a parameter
    // - the leftmost SQL parameter has an index of 1
    // - raise an EOleDBException on any error
    procedure Bind(Param: Integer; Value: Int64;
      IO: TSQLDBParamInOutType=paramIn); overload; override;
    /// bind a double value to a parameter
    // - the leftmost SQL parameter has an index of 1
    // - raise an EOleDBException on any error
    procedure Bind(Param: Integer; Value: double;
      IO: TSQLDBParamInOutType=paramIn); overload; override;
    /// bind a TDateTime value to a parameter
    // - the leftmost SQL parameter has an index of 1
    // - raise an EOleDBException on any error
    procedure BindDateTime(Param: Integer; Value: TDateTime;
      IO: TSQLDBParamInOutType=paramIn); overload; override;
    /// bind a currency value to a parameter
    // - the leftmost SQL parameter has an index of 1
    // - raise an EOleDBException on any error
    procedure BindCurrency(Param: Integer; Value: currency;
      IO: TSQLDBParamInOutType=paramIn); overload; override;
    /// bind a UTF-8 encoded string to a parameter
    // - the leftmost SQL parameter has an index of 1
    // - raise an EOleDBException on any error
    procedure BindTextU(Param: Integer; const Value: RawUTF8;
      IO: TSQLDBParamInOutType=paramIn); overload; override;
    /// bind a UTF-8 encoded buffer text (#0 ended) to a parameter
    // - the leftmost SQL parameter has an index of 1
    // - raise an EOleDBException on any error
    procedure BindTextP(Param: Integer; Value: PUTF8Char;
      IO: TSQLDBParamInOutType=paramIn); overload; override;
    /// bind a VCL string to a parameter
    // - the leftmost SQL parameter has an index of 1
    // - raise an EOleDBException on any error
    procedure BindTextS(Param: Integer; const Value: string;
      IO: TSQLDBParamInOutType=paramIn); overload; override;
    /// bind an OLE WideString to a parameter
    // - the leftmost SQL parameter has an index of 1
    // - raise an EOleDBException on any error
    procedure BindTextW(Param: Integer; const Value: WideString;
      IO: TSQLDBParamInOutType=paramIn); overload; override;
    /// bind a Blob buffer to a parameter
    // - the leftmost SQL parameter has an index of 1
    // - raise an EOleDBException on any error
    procedure BindBlob(Param: Integer; Data: pointer; Size: integer;
      IO: TSQLDBParamInOutType=paramIn); overload; override;
    /// bind a Blob buffer to a parameter
    // - the leftmost SQL parameter has an index of 1
    // - raise an EOleDBException on any error
    procedure BindBlob(Param: Integer; const Data: RawByteString;
      IO: TSQLDBParamInOutType=paramIn); overload; override;

    /// Prepare an UTF-8 encoded SQL statement
    // - parameters marked as ? will be bound later, before ExecutePrepared call
    // - if ExpectResults is TRUE, then Step() and Column*() methods are available
    // to retrieve the data rows
    // - raise an EOleDBException on any error
    procedure Prepare(const aSQL: RawUTF8; ExpectResults: Boolean=false); overload; override;
    /// Execute an UTF-8 encoded SQL statement
    // - parameters marked as ? should have been already bound with Bind*()
    // functions above
    // - raise an EOleDBException on any error
    procedure ExecutePrepared; override;
    /// Reset the previous prepared statement
    // - this overridden implementation will reset all bindings and the cursor state
    // - raise an EOleDBException on any error
    procedure Reset; override;
    /// gets a number of updates made by latest executed statement
    function UpdateCount: integer; override;

    /// retrieve the parameter content, after SQL execution
    // - the leftmost SQL parameter has an index of 1
    // - to be used e.g. with stored procedures
    // - any TEXT parameter will be retrieved as WideString Variant (i.e. as
    // stored in TOleDBStatementParam)
    function ParamToVariant(Param: Integer; var Value: Variant;
      CheckIsOutParameter: boolean=true): TSQLDBFieldType; override;

    /// after a statement has been prepared via Prepare() + ExecutePrepared() or
    // Execute(), this method must be called one or more times to evaluate it
    // - you shall call this method before calling any Column*() methods
    // - return TRUE on success, with data ready to be retrieved by Column*()
    // - return FALSE if no more row is available (e.g. if the SQL statement
    // is not a SELECT but an UPDATE or INSERT command)
    // - access the first or next row of data from the SQL Statement result:
    // if SeekFirst is TRUE, will put the cursor on the first row of results,
    // otherwise, it will fetch one row of data, to be called within a loop
    // - raise an ESQLEOleDBException on any error
    function Step(SeekFirst: boolean=false): boolean; override;
    /// clear result rowset when ISQLDBStatement is back in cache
    procedure ReleaseRows; override;
    /// retrieve a column name of the current Row
    // - Columns numeration (i.e. Col value) starts with 0
    // - it's up to the implementation to ensure than all column names are unique
    function ColumnName(Col: integer): RawUTF8; override;
    /// returns the Column index of a given Column name
    // - Columns numeration (i.e. Col value) starts with 0
    // - returns -1 if the Column name is not found (via case insensitive search)
    function ColumnIndex(const aColumnName: RawUTF8): integer; override;
    /// the Column type of the current Row
    // - ftCurrency type should be handled specificaly, for faster process and
    // avoid any rounding issue, since currency is a standard OleDB type
    // - FieldSize can be set to store the size in chars of a ftUTF8 column
    // (0 means BLOB kind of TEXT column)
    function ColumnType(Col: integer; FieldSize: PInteger=nil): TSQLDBFieldType; override;
    /// returns TRUE if the column contains NULL
    function ColumnNull(Col: integer): boolean; override;
    /// return a Column integer value of the current Row, first Col is 0
    function ColumnInt(Col: integer): Int64; override;
    /// return a Column floating point value of the current Row, first Col is 0
    function ColumnDouble(Col: integer): double; override;
    /// return a Column date and time value of the current Row, first Col is 0
    function ColumnDateTime(Col: integer): TDateTime; override;
    /// return a Column currency value of the current Row, first Col is 0
    // - should retrieve directly the 64 bit Currency content, to avoid
    // any rounding/conversion error from floating-point types
    function ColumnCurrency(Col: integer): currency; override;
    /// return a Column UTF-8 encoded text value of the current Row, first Col is 0
    function ColumnUTF8(Col: integer): RawUTF8; override;
    /// return a Column text generic VCL string value of the current Row, first Col is 0
    function ColumnString(Col: integer): string; override;
    /// return a Column as a blob value of the current Row, first Col is 0
    // - ColumnBlob() will return the binary content of the field is was not ftBlob,
    // e.g. a 8 bytes RawByteString for a vtInt64/vtDouble/vtDate/vtCurrency,
    // or a direct mapping of the RawUnicode
    function ColumnBlob(Col: integer): RawByteString; override;
    /// append all columns values of the current Row to a JSON stream
    // - will use WR.Expand to guess the expected output format
    // - fast overridden implementation with no temporary variable
    // - BLOB field value is saved as Base64, in the '"\uFFF0base64encodedbinary"
    // format and contains true BLOB data
    procedure ColumnsToJSON(WR: TJSONWriter); override;
    /// return a Column as a variant
    // - this implementation will retrieve the data with no temporary variable
    // (since TQuery calls this method a lot, we tried to optimize it)
    // - a ftUTF8 content will be mapped into a generic WideString variant
    // for pre-Unicode version of Delphi, and a generic UnicodeString (=string)
    // since Delphi 2009: you may not loose any data during charset conversion
    // - a ftBlob content will be mapped into a TBlobData AnsiString variant
    function ColumnToVariant(Col: integer; var Value: Variant): TSQLDBFieldType; override;
    /// just map the original Collection into a TOleDBConnection class
    property OleDBConnection: TOleDBConnection read fOleDBConnection;
    /// if TRUE, the data will be 8 bytes aligned in OleDB internal buffers
    // - it's recommended by official OleDB documentation for faster process
    // - is enabled by default, and should not be modified in most cases
    property AlignDataInternalBuffer: boolean read fAlignBuffer write fAlignBuffer;
    /// size in bytes of the internal OleDB buffer used to fetch rows
    // - several rows are retrieved at once into the internal buffer
    // - default value is 16384 bytes, minimal allowed size is 8192
    property RowBufferSize: integer read fRowBufferSize write SetRowBufferSize;
  end;

  TBaseAggregatingRowset = class(TObject, IUnknown, IRowset)
  private
   fcTotalRows: UINT;
   // Defining as an array because in general there can be as many accessors as necessary
   // the reading rules from the provider for such scenarios are describe in the Books online
   fhAccessor: HACCESSORDynArray;
  protected
   fidxRow: UINT;
   fUnkInnerSQLNCLIRowset: IUnknown;
   // Save the handle of the accessor that we create, the indexing is 0 based
   procedure SetAccessorHandle(idxAccessor: ULONG; hAccessor: HACCESSOR );
  public
    constructor Create(cTotalRows: UINT);
    function SetupAccessors(pIAccessorTVP: IAccessor):HRESULT; virtual; abstract;
    destructor Destroy; override;
    {$ifdef FPC}
    function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    {$else}
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    {$endif}
    /// Adds a reference count to an existing row handle
    function AddRefRows(cRows: PtrUInt; rghRows: PPtrUIntArray;
      rgRefCounts, rgRowStatus: PCardinalArray): HResult; stdcall;
    /// Retrieves data from the rowset's copy of the row
    function GetData(HROW: HROW; HACCESSOR: HACCESSOR; pData: Pointer): HResult; virtual; stdcall;
    /// Fetches rows sequentially, remembering the previous position
    // - this method has been modified from original OleDB.pas to allow direct
    // typecast of prghRows parameter to pointer(fRowStepHandles)
    function GetNextRows(hReserved: HCHAPTER; lRowsOffset: PtrInt; cRows: PtrInt;
      out pcRowsObtained: PtrUInt; var prghRows: pointer): HResult; stdcall;
    /// Releases rows
    function ReleaseRows(cRows: UINT; rghRows: PPtrUIntArray; rgRowOptions,
      rgRefCounts, rgRowStatus: PCardinalArray): HResult; stdcall;
    /// Repositions the next fetch position to its initial position
    // - that is, its position when the rowset was first created
    function RestartPosition(hReserved: HCHAPTER): HResult; stdcall;
  end;

  TIDListRec = record
    IDLen: PtrUInt;
    IDST: DBSTATUS;
    IDVal: int64;
    StrVal: PWideChar;
  end;

  PIDListRec = ^TIDListRec;

  TIDListRowset = class(TBaseAggregatingRowset)
  private
    farr: TRawUTF8DynArray;
    fType: TSQLDBFieldType;
  public
    constructor Create(arr: TRawUTF8DynArray; aType: TSQLDBFieldType);

    function Initialize(pIOpenRowset: IOpenRowset): HRESULT;
    function GetData(HROW: HROW; HACCESSOR: HACCESSOR; pData: Pointer): HResult; override; stdcall;
    function SetupAccessors(pIAccessorIDList: IAccessor):HRESULT; override;

    procedure FillRowData(pCurrentRec:PIDListRec);
    procedure FillBindingsAndSetupRowBuffer(pBindingsList: PDBBindingArray);
  end;

/// check from the file beginning if sounds like a valid Jet / MSAccess file
function IsJetFile(const FileName: TFileName): boolean;

/// this global procedure should be called for each thread needing to use OLE
// - it is already called by TOleDBConnection.Create when an OleDb connection
// is instantiated for a new thread
// - every call of CoInit shall be followed by a call to CoUninit
// - implementation will maintain some global counting, to call the CoInitialize
// API only once per thread
// - only made public for user convenience, e.g. when using custom COM objects
procedure CoInit;

/// this global procedure should be called at thread termination
// - it is already called by TOleDBConnection.Destroy, e.g. when thread associated
// to an OleDb connection is terminated
// - every call of CoInit shall be followed by a call to CoUninit
// - only made public for user convenience, e.g. when using custom COM objects
procedure CoUninit;


implementation

function IsJetFile(const FileName: TFileName): boolean;
var F: THandle;
    Header: array[0..31] of AnsiChar;
begin
  F := FileOpen(FileName,fmOpenRead or fmShareDenyNone);
  if F=INVALID_HANDLE_VALUE then
    result := false else begin
    result := (FileRead(F,Header,sizeof(Header))=SizeOf(Header)) and
      IdemPChar(@Header[4],'STANDARD JET');
    FileClose(F);
  end;
end;


{ TOleDBStatement }

procedure TOleDBStatement.BindTextU(Param: Integer; const Value: RawUTF8;
  IO: TSQLDBParamInOutType);
begin
  if (Value='') and fConnection.Properties.StoreVoidStringAsNull then
    CheckParam(Param,ftNull,IO) else
    UTF8ToWideString(Value,CheckParam(Param,ftUTF8,IO)^.VText);
end;

procedure TOleDBStatement.BindTextP(Param: Integer; Value: PUTF8Char;
  IO: TSQLDBParamInOutType);
begin
  if (Value='') and fConnection.Properties.StoreVoidStringAsNull then
    CheckParam(Param,ftNull,IO) else
    UTF8ToWideString(Value,StrLen(Value),CheckParam(Param,ftUTF8,IO)^.VText);
end;

procedure TOleDBStatement.BindTextS(Param: Integer; const Value: string;
  IO: TSQLDBParamInOutType);
begin
  if (Value='') and fConnection.Properties.StoreVoidStringAsNull then
    CheckParam(Param,ftNull,IO) else
    CheckParam(Param,ftUTF8,IO)^.VText := StringToSynUnicode(Value);
end;

procedure TOleDBStatement.BindTextW(Param: Integer;
  const Value: WideString; IO: TSQLDBParamInOutType);
begin
  if (Value='') and fConnection.Properties.StoreVoidStringAsNull then
    CheckParam(Param,ftNull,IO) else
    CheckParam(Param,ftUTF8,IO)^.VText := Value;
end;

procedure TOleDBStatement.BindBlob(Param: Integer;
  const Data: RawByteString; IO: TSQLDBParamInOutType);
begin
  CheckParam(Param,ftBlob,IO)^.VBlob := Data;
end;

procedure TOleDBStatement.BindBlob(Param: Integer; Data: pointer; Size: integer;
  IO: TSQLDBParamInOutType);
begin
  SetString(CheckParam(Param,ftBlob,IO)^.VBlob,PAnsiChar(Data),Size);
end;

procedure TOleDBStatement.Bind(Param: Integer; Value: double;
  IO: TSQLDBParamInOutType);
begin
  CheckParam(Param,ftDouble,IO)^.VInt64 := PInt64(@Value)^;
end;

procedure TOleDBStatement.BindArray(Param: Integer;
  const Values: array of Int64);
var i: integer;
begin
  with CheckParam(Param,ftInt64,paramIn,length(Values))^ do
    for i := 0 to high(Values) do
      VArray[i] := Int64ToUtf8(Values[i]);
end;

procedure TOleDBStatement.BindArray(Param: Integer;
  const Values: array of RawUTF8);
var i: integer;
    StoreVoidStringAsNull: boolean;
begin
  StoreVoidStringAsNull := fConnection.Properties.StoreVoidStringAsNull;
  with CheckParam(Param,ftUTF8,paramIn,length(Values))^ do
    for i := 0 to high(Values) do
      if StoreVoidStringAsNull and (Values[i]='') then
        VArray[i] := 'null' else
        QuotedStr(Values[i],'''',VArray[i]);
end;

procedure TOleDBStatement.Bind(Param: Integer; Value: Int64;
  IO: TSQLDBParamInOutType);
begin
  CheckParam(Param,ftInt64,IO)^.VInt64 := Value;
end;

procedure TOleDBStatement.BindCurrency(Param: Integer; Value: currency;
  IO: TSQLDBParamInOutType);
begin
  CheckParam(Param,ftCurrency,IO)^.VInt64 := PInt64(@Value)^;
end;

procedure TOleDBStatement.BindDateTime(Param: Integer; Value: TDateTime;
  IO: TSQLDBParamInOutType);
begin
  CheckParam(Param,ftDate,IO)^.VInt64 := PInt64(@Value)^;
end;

procedure TOleDBStatement.BindNull(Param: Integer;
  IO: TSQLDBParamInOutType; BoundType: TSQLDBFieldType);
begin
  CheckParam(Param,BoundType,IO)^.VStatus := ord(stIsNull);
end;

function TOleDBStatement.CheckParam(Param: Integer; NewType: TSQLDBFieldType;
  IO: TSQLDBParamInOutType): POleDBStatementParam;
begin
  if Param<=0 then
    raise EOleDBException.CreateUTF8(
      '%.Bind*() called with Param=% should be >= 1',[self,Param]);
  if Param>fParamCount then
    fParam.Count := Param; // resize fParams[] dynamic array if necessary
  result := @fParams[Param-1];
  result^.VType := NewType;
  result^.VInOut := IO;
  result^.VStatus := 0;
end;

function TOleDBStatement.CheckParam(Param: Integer; NewType: TSQLDBFieldType;
  IO: TSQLDBParamInOutType; ArrayCount: integer): POleDBStatementParam;
begin
  result := CheckParam(Param,NewType,IO);
  if (NewType in [ftUnknown,ftNull]) or
     (fConnection.Properties.BatchSendingAbilities*[cCreate,cUpdate,cDelete]=[]) then
    raise ESQLDBException.CreateUTF8('Invalid call to %s.BindArray(Param=%d,Type=%s)',
      [self,Param,TSQLDBFieldTypeToString(NewType)]);
  SetLength(result^.VArray,ArrayCount);
  result^.VInt64 := ArrayCount;
end;

constructor TOleDBStatement.Create(aConnection: TSQLDBConnection);
begin
  if not aConnection.InheritsFrom(TOleDBConnection) then
    raise EOleDBException.CreateUTF8('%.Create(%) expects a TOleDBConnection',
      [self,aConnection]);
  inherited Create(aConnection);
  fOleDBConnection := TOleDBConnection(aConnection);
  fParam.Init(TypeInfo(TOleDBStatementParamDynArray),fParams,@fParamCount);
  fColumn.InitSpecific(TypeInfo(TSQLDBColumnPropertyDynArray),fColumns,djRawUTF8,@fColumnCount,True);
  fRowBufferSize := 16384;
  fAlignBuffer := true;
end;

type
  TColumnValue = packed record
    Status: PtrInt;
    Length: PtrUInt; // ignored for alignment
    case integer of
    0: (Int64: Int64);
    1: (Double: double);
    2: (case integer of
        0: (VData: array[0..0] of byte);
        1: (VWideChar: PWideChar);
        2: (VAnsiChar: PAnsiChar));
  end;
  PColumnValue = ^TColumnValue;

procedure TOleDBStatement.LogStatusError(Status: integer; Column: PSQLDBColumnProperty);
var msg: RawUTF8;
begin
{$ifndef PUREPASCAL}
  if cardinal(Status)<=cardinal(ord(high(TOleDBStatus))) then
    msg := UnCamelCase(TrimLeftLowerCaseShort(GetEnumName(TypeInfo(TOleDBStatus),Status))) else
{$else}
    Int32ToUtf8(Status,msg);
{$endif}
  SynDBLog.Add.Log(sllError,'Invalid [%] status for column [%] at row % for %',
    [msg,Column^.ColumnName,fCurrentRow,fSQL],self);
end;

function TOleDBStatement.GetCol(Col: integer; out Column: PSQLDBColumnProperty): pointer;
begin
  CheckCol(Col); // check Col value
  if not Assigned(fRowSet) or (fColumnCount=0) then
    raise EOleDBException.CreateUTF8('%.Column*() with no prior Execute',[self]);
  if CurrentRow<=0 then
    raise EOleDBException.CreateUTF8('%.Column*() with no prior Step',[self]);
  Column := @fColumns[Col];
  result := @fRowSetData[Column^.ColumnAttr];
  case TOleDBStatus(PColumnValue(result)^.Status) of
    stOk:
      exit; // valid content
    stIsNull:
      result := nil;
    stTruncated:
      LogTruncatedColumn(Column^);
    else
      LogStatusError(PColumnValue(result)^.Status,Column);
  end;
end;

procedure TOleDBStatement.GetCol64(Col: integer;
  DestType: TSQLDBFieldType; var Dest);
var C: PSQLDBColumnProperty;
    V: PColumnValue;
begin
  V := GetCol(Col,C);
  if V=nil then // column is NULL
    Int64(Dest) := 0 else
    if C^.ColumnType=DestType then
      // types match -> fast direct retrieval
      Int64(Dest) := V^.Int64 else
      // need conversion to destination type
      ColumnToTypedValue(Col,DestType,Dest);
end;

function TOleDBStatement.ColumnBlob(Col: integer): RawByteString;
// ColumnBlob will return the binary content of the field
var C: PSQLDBColumnProperty;
    V: PColumnValue;
    P: PAnsiChar;
begin
  V := GetCol(Col,C);
  if V=nil then // column is NULL
    result := '' else
    case C^.ColumnType of
    ftBlob: begin
      if C^.ColumnValueInlined then
        P := @V^.VData else
        P := V^.VAnsiChar;
      SetString(Result,P,V^.Length);
    end;
    ftUTF8:
      if V^.Length=0 then
        result := '' else begin
        if C^.ColumnValueInlined then
          P := @V^.VData else
          P := V^.VAnsiChar;
        // +1 below for trailing WideChar(#0) in the resulting RawUnicode
        SetString(Result,P,V^.Length+1);
      end;
     else SetString(result,PAnsiChar(@V^.Int64),sizeof(Int64));
    end;
end;

function TOleDBStatement.ColumnCurrency(Col: integer): currency;
begin
  GetCol64(Col,ftCurrency,Result);
end;

function TOleDBStatement.ColumnDateTime(Col: integer): TDateTime;
begin
  GetCol64(Col,ftDate,Result);
end;

function TOleDBStatement.ColumnDouble(Col: integer): double;
begin
  GetCol64(Col,ftDouble,Result);
end;

function TOleDBStatement.ColumnIndex(const aColumnName: RawUTF8): integer;
begin
  result := fColumn.FindHashed(aColumnName);
end;

function TOleDBStatement.ColumnNull(Col: integer): boolean;
var C: PSQLDBColumnProperty;
begin
  result := GetCol(Col,C)=nil;
end;

function TOleDBStatement.ColumnInt(Col: integer): Int64;
begin
  GetCol64(Col,ftInt64,Result);
end;

function TOleDBStatement.ColumnName(Col: integer): RawUTF8;
begin
  CheckCol(Col);
  result := fColumns[Col].ColumnName;
end;

function TOleDBStatement.ColumnType(Col: integer; FieldSize: PInteger=nil): TSQLDBFieldType;
begin
  CheckCol(Col);
  with fColumns[Col] do begin
    result := ColumnType;
    if FieldSize<>nil then
      if ColumnValueInlined then
        FieldSize^ := ColumnValueDBSize else
        FieldSize^ := 0;
  end;
end;

function TOleDBStatement.ColumnUTF8(Col: integer): RawUTF8;
var C: PSQLDBColumnProperty;
    V: PColumnValue;
    P: pointer;
begin
  V := GetCol(Col,C);
  if V=nil then // column is NULL
    result := '' else
    case C^.ColumnType of // fast direct conversion from OleDB buffer
    ftInt64: result := Int64ToUtf8(V^.Int64);
    ftDate:  result := DateTimeToIso8601Text(V^.Double);
    ftUTF8: begin
      if C^.ColumnValueInlined then
        P := @V^.VData else
        P := V^.VWideChar;
      result := RawUnicodeToUtf8(P,V^.Length shr 1);
    end;
    ftBlob: begin
      if C^.ColumnValueInlined then
        P := @V^.VData else
        P := V^.VAnsiChar;
      result := BinToBase64WithMagic(P,V^.Length);
    end;
    ftCurrency: result := Curr64ToStr(V^.Int64);
    ftDouble:
      if V^.Int64=0 then
        result := SmallUInt32UTF8[0] else
        result := DoubleToStr(V^.Double);
    end;
end;

function TOleDBStatement.ColumnString(Col: integer): string;
var C: PSQLDBColumnProperty;
    V: PColumnValue;
    P: pointer;
begin
  V := GetCol(Col,C);
  if V=nil then // column is NULL
    result := '' else
    case C^.ColumnType of // fast direct conversion from OleDB buffer
    ftInt64: result := IntToString(V^.Int64);
    ftDouble:
      if V^.Int64=0 then
        result := '0' else
        result := DoubleToString(V^.Double);
    ftCurrency: result := Curr64ToString(V^.Int64);
    ftDate:  result := Ansi7ToString(DateTimeToIso8601Text(V^.Double));
    ftUTF8: begin
      if C^.ColumnValueInlined then
        P := @V^.VData else
        P := V^.VWideChar;
      result := RawUnicodeToString(P,V^.Length shr 1);
    end;
    ftBlob: begin
      if C^.ColumnValueInlined then
        P := @V^.VData else
        P := V^.VAnsiChar;
      result := Ansi7ToString(BinToBase64WithMagic(P,V^.Length));
    end;
    end;
end;

function TOleDBStatement.ColumnToVariant(Col: integer;
  var Value: Variant): TSQLDBFieldType;
var C: PSQLDBColumnProperty;
    V: PColumnValue;
    P: pointer;
begin // dedicated version to avoid as much memory allocation than possible
  V := GetCol(Col,C);
  if V=nil then
    result := ftNull else
    result := C^.ColumnType;
  VarClear(Value);
  with TVarData(Value) do begin
    VType := MAP_FIELDTYPE2VARTYPE[result];
    case result of
      ftInt64, ftDouble, ftCurrency, ftDate:
        VInt64 := V^.Int64; // copy 64 bit content
      ftUTF8: begin
        VAny := nil;
        if C^.ColumnValueInlined then
          P := @V^.VData else
          P := V^.VAnsiChar;
        {$ifndef UNICODE}
        if not Connection.Properties.VariantStringAsWideString then begin
          VType := varString;
          RawUnicodeToString(P,V^.Length shr 1,AnsiString(VAny));
        end else
        {$endif}
          SetString(SynUnicode(VAny),PWideChar(P),V^.Length shr 1);
      end;
      ftBlob:
      if fForceBlobAsNull then
        VType := varNull else begin
        VAny := nil;
        if C^.ColumnValueInlined then
          P := @V^.VData else
          P := V^.VAnsiChar;
        SetString(RawByteString(VAny),PAnsiChar(P),V^.Length);
      end;
      end;
  end;
end;

procedure TOleDBStatement.ColumnsToJSON(WR: TJSONWriter);
var col: integer;
    V: PColumnValue;
    P: Pointer;
label Write;
begin // dedicated version to avoid as much memory allocation than possible
  if CurrentRow<=0 then
    raise EOleDBException.CreateUTF8('%.ColumnsToJSON() with no prior Step',[self]);
  if WR.Expand then
    WR.Add('{');
  for col := 0 to fColumnCount-1 do // fast direct conversion from OleDB buffer
  with fColumns[col] do begin
    if WR.Expand then
      WR.AddFieldName(ColumnName); // add '"ColumnName":'
    V := @fRowSetData[ColumnAttr];
    case TOleDBStatus(V^.Status) of
      stOK:
Write:case ColumnType of
        ftInt64:    WR.Add(V^.Int64);
        ftDouble:   WR.AddDouble(V^.Double);
        ftCurrency: WR.AddCurr64(V^.Int64);
        ftDate: begin
          WR.Add('"');
          WR.AddDateTime(@V^.Double,'T',#0,fForceDateWithMS);
          WR.Add('"');
        end;
        ftUTF8: begin
          WR.Add('"');
          if ColumnValueInlined then
            P := @V^.VData else
            P := V^.VWideChar;
          WR.AddJSONEscapeW(P,V^.Length shr 1);
          WR.Add('"');
        end;
        ftBlob:
          if fForceBlobAsNull then
            WR.AddShort('null') else begin
            if ColumnValueInlined then
              P := @V^.VData else
              P := V^.VAnsiChar;
            WR.WrBase64(P,V^.Length,true); // withMagic=true
          end;
        else WR.AddShort('null');
      end;
      stIsNull:
        WR.AddShort('null');
      stTruncated: begin
        LogTruncatedColumn(fColumns[col]);
        goto Write;
      end;
      else begin
        WR.AddShort('null');
        LogStatusError(V^.Status,@fColumns[col]);
      end;
    end;
    WR.Add(',');
  end;
  WR.CancelLastComma; // cancel last ','
  if WR.Expand then
    WR.Add('}');
end;

function TOleDBStatement.ParamToVariant(Param: Integer; var Value: Variant;
  CheckIsOutParameter: boolean): TSQLDBFieldType;
begin
  inherited ParamToVariant(Param,Value); // raise exception if Param incorrect
  dec(Param); // start at #1
  if CheckIsOutParameter and (fParams[Param].VInOut=paramIn) then
    raise EOleDBException.CreateUTF8('%.ParamToVariant expects an [In]Out parameter',[self]);
  // OleDB provider should have already modified the parameter in-place, i.e.
  // in our fParams[] buffer, especialy for TEXT parameters (OleStr/WideString)
  // -> we have nothing to do but return the current value :)
  with fParams[Param] do begin
    result := VType;
    case VType of
      ftInt64:     Value := {$ifdef DELPHI5OROLDER}integer{$endif}(VInt64);
      ftDouble:    Value := unaligned(PDouble(@VInt64)^);
      ftCurrency:  Value := PCurrency(@VInt64)^;
      ftDate:      Value := PDateTime(@VInt64)^;
      ftUTF8:      Value := VText; // returned as WideString/OleStr variant
      ftBlob:      RawByteStringToVariant(VBlob,Value);
      else         SetVariantNull(Value);
    end;
  end;
end;

const
  PARAMTYPE2OLEDB: array[TSQLDBParamInOutType] of DBPARAMIO = (
    DBPARAMIO_INPUT, DBPARAMIO_OUTPUT, DBPARAMIO_INPUT or DBPARAMIO_OUTPUT);
  FIELDTYPE2OLEDB: array[TSQLDBFieldType] of DBTYPE = (
    DBTYPE_EMPTY, DBTYPE_I4, DBTYPE_I8, DBTYPE_R8, DBTYPE_CY, DBTYPE_DATE,
    DBTYPE_WSTR or DBTYPE_BYREF, DBTYPE_BYTES or DBTYPE_BYREF);
  FIELDTYPE2OLEDBTYPE_NAME: array[TSQLDBFieldType] of WideString = (
    '', 'DBTYPE_I4', 'DBTYPE_I8', 'DBTYPE_R8', 'DBTYPE_CY', 'DBTYPE_DATE',
    'DBTYPE_WVARCHAR', 'DBTYPE_BINARY');
// ftUnknown, ftNull, ftInt64, ftDouble, ftCurrency, ftDate, ftUTF8, ftBlob
   TABLE_PARAM_DATASOURCE: WideString = 'table';
   //See BindArray
   IDList_type: WideString = 'IDList';
   StrList_TYPE: WideString = 'StrList';

procedure TOleDBStatement.Prepare(const aSQL: RawUTF8; ExpectResults: Boolean);
var L: integer;
    SQLW: RawUnicode;
begin
  SQLLogBegin(sllDB);
  if Assigned(fCommand) or Assigned(fRowSet) or (fColumnCount>0) or
     (fColumnBindings<>nil) or (fParamBindings<>nil) then
    raise EOleDBException.CreateUTF8('%.Prepare should be called once',[self]);
  inherited;
  with OleDBConnection do begin
    if not IsConnected then
      Connect;
    OleDBCheck(self,(fSession as IDBCreateCommand).
      CreateCommand(nil,IID_ICommandText,ICommand(fCommand)));
  end;
  L := Length(fSQL);
  if StripSemicolon then
    while (L>0) and (fSQL[L] in [#1..' ',';']) do
      dec(L); // trim ' ' or ';' right (last ';' could be found incorrect)
  SetLength(SQLW,L*2+1);
  UTF8ToWideChar(pointer(SQLW),pointer(fSQL),L);
  fCommand.SetCommandText(DBGUID_DEFAULT,pointer(SQLW));
  SQLLogEnd;
end;

procedure TOleDBStatement.ExecutePrepared;
var i: integer;
    P: POleDBStatementParam;
    B: PDBBinding;
    ParamsStatus: TCardinalDynArray;
    RowSet: IRowSet;
    mr: IMultipleResults;
    res: HResult;
    fParamBindInfo: TDBParamBindInfoDynArray;
    BI: PDBParamBindInfo;
    fParamOrdinals: TPtrUIntDynArray;
    PO: PPtrUInt;
    dbObjTVP: TDBObject;
    ssPropParamIDList: TDBPROP;
    ssPropsetParamIDList: TDBPROPSET;
    ssPropParamStrList: TDBPROP;
    ssPropsetParamStrList: TDBPROPSET;
    ssParamProps: TSSPARAMPROPSDynArray;
    ssParamPropsCount: integer;
    IDLists: array of TIDListRowset;
begin
  SQLLogBegin(sllSQL);
  // 1. check execution context
  if not Assigned(fCommand) then
    raise EOleDBException.CreateUTF8('%s.Prepare should have been called',[self]);
  if Assigned(fRowSet) or (fColumnCount>0) or
     (fColumnBindings<>nil) or (fParamBindings<>nil) then
    raise EOleDBException.CreateUTF8('Missing call to %.Reset',[self]);
  inherited ExecutePrepared; // set fConnection.fLastAccessTicks
  // 2. bind parameters
  SetLength(IDLists,fParamCount);
  try
    if fParamCount=0 then
      // no parameter to bind
      fDBParams.cParamSets := 0 else begin
      // bind supplied parameters, with direct mapping to fParams[]
      for i := 0 to fParamCount-1 do
        case fParams[i].VType of
          ftUnknown: raise EOleDBException.CreateUTF8(
            '%.Execute: missing #% bound parameter for [%]',[self,i+1,fSQL]);
        end;
      P := pointer(fParams);
      SetLength(fParamBindings,fParamCount);
      B := pointer(fParamBindings);
      SetLength(fParamBindInfo, fParamCount);
      BI := pointer(fParamBindInfo);
      SetLength(fParamOrdinals, fParamCount);
      PO := pointer(fParamOrdinals);
      dbObjTVP.dwFlags := STGM_READ;
      dbObjTVP.iid := IID_IRowset;
      FillChar(ssPropParamIDList,SizeOf(ssPropParamIDList),0);
      ssPropParamIDList.dwPropertyID := SSPROP_PARAM_TYPE_TYPENAME;
      ssPropParamIDList.vValue := IDList_TYPE;
      ssPropsetParamIDList.cProperties := 1;
      ssPropsetParamIDList.guidPropertySet := DBPROPSET_SQLSERVERPARAMETER;
      ssPropsetParamIDList.rgProperties := @ssPropParamIDList;
      FillChar(ssPropParamStrList,SizeOf(ssPropParamStrList),0);
      ssPropParamStrList.dwPropertyID := SSPROP_PARAM_TYPE_TYPENAME;
      ssPropParamStrList.vValue := StrList_TYPE;
      ssPropsetParamStrList.cProperties := 1;
      ssPropsetParamStrList.guidPropertySet := DBPROPSET_SQLSERVERPARAMETER;
      ssPropsetParamStrList.rgProperties := @ssPropParamStrList;
      SetLength(ssParamProps, fParamCount);
      ssParamPropsCount := 0;
      for i := 1 to fParamCount do begin
        B^.iOrdinal := i; // parameter index (starting at 1)
        B^.eParamIO := PARAMTYPE2OLEDB[P^.VInOut]; // parameter direction
        B^.wType := FIELDTYPE2OLEDB[P^.VType];     // parameter data type
        B^.dwPart := DBPART_VALUE or DBPART_STATUS;
        B^.obValue := PAnsiChar(@P^.VInt64)-pointer(fParams);
        B^.obStatus := PAnsiChar(@P^.VStatus)-pointer(fParams);
        BI^.dwFlags := PARAMTYPE2OLEDB[P^.VInOut]; // parameter direction
        BI^.pwszName := nil; //unnamed parameters
        BI^.pwszDataSourceType :=  Pointer(FIELDTYPE2OLEDBTYPE_NAME[P^.VType]);
        BI^.ulParamSize := 0;
        PO^ := i;
        // check array binding
        if P.VArray<>nil then begin
          BI^.pwszDataSourceType := Pointer(TABLE_PARAM_DATASOURCE);
          B^.wType := DBTYPE_TABLE;
          B^.cbMaxLen := sizeof(IUnknown);
          B^.pObject := @dbObjTVP;
          B^.obValue := PAnsiChar(@P^.VIUnknown)-pointer(fParams);
          case P^.VType of
            ftInt64: ssParamProps[ssParamPropsCount].rgPropertySets := @ssPropsetParamIDList;
            ftUTF8: ssParamProps[ssParamPropsCount].rgPropertySets := @ssPropsetParamStrList;
            else raise EOleDBException.Create('Unsupported array parameter type');
          end;
          ssParamProps[ssParamPropsCount].cPropertySets := 1;
          ssParamProps[ssParamPropsCount].iOrdinal := i;
          inc(ssParamPropsCount);
          IDLists[i-1] := TIDListRowset.Create(P.VArray, P^.VType);
          IDLists[i-1].Initialize(OleDBConnection.fSession as IOpenRowset);
          P^.VIUnknown := IDLists[i-1];
        end else begin
          P^.VIUnknown := nil;
          case P^.VType of
          ftNull: begin
            P^.VStatus := ord(stIsNull);
            BI.pwszDataSourceType := 'DBTYPE_WVARCHAR';
            BI.dwFlags := BI^.dwFlags or DBPARAMFLAGS_ISNULLABLE;
          end;
          ftInt64, ftDouble, ftCurrency, ftDate:
            // those types match the VInt64 binary representation :)
            B^.cbMaxLen := sizeof(Int64);
          ftBlob: begin
            // sent as DBTYPE_BYREF mapping directly RawByteString VBlob content
            B^.dwPart := DBPART_VALUE or DBPART_LENGTH or DBPART_STATUS;
            B^.obValue := PAnsiChar(@P^.VBlob)-pointer(fParams);
            B^.cbMaxLen := length(P^.VBlob);
            P^.VInt64 := length(P^.VBlob); // store length in unused VInt64 property
            B^.obLength := PAnsiChar(@P^.VInt64)-pointer(fParams);
          end;
          ftUTF8: begin
            B^.obValue := PAnsiChar(@P^.VText)-pointer(fParams);
            if P^.VText='' then begin
              B^.wType := DBTYPE_WSTR; // '' -> bind one #0 wide char
              B^.cbMaxLen := sizeof(WideChar);
            end else begin
              // mapping directly the WideString VText content
              B^.wType := DBTYPE_BSTR; // DBTYPE_WSTR just doesn't work :(
              B^.cbMaxLen := sizeof(Pointer);
              BI^.ulParamSize := length(P^.VText);
            end;
          end;
          end;
          if BI^.ulParamSize = 0 then
            BI^.ulParamSize := B^.cbMaxLen;
        end;
        inc(P);
        inc(B);
        inc(BI);
        inc(PO);
      end;
      if not OleDBConnection.OleDBProperties.fSupportsOnlyIRowset then begin
        OleDBConnection.OleDBCheck(self,
          (fCommand as ICommandWithParameters).SetParameterInfo(
            fParamCount, pointer(fParamOrdinals), pointer(fParamBindInfo)));
        if ssParamPropsCount>0 then
          OleDBConnection.OleDBCheck(self,
            (fCommand as ISSCommandWithParameters).SetParameterProperties(
              ssParamPropsCount, pointer(ssParamProps)));
      end;
      SetLength(ParamsStatus,fParamCount);
      OleDBConnection.OleDBCheck(self,
        (fCommand as IAccessor).CreateAccessor(
          DBACCESSOR_PARAMETERDATA,fParamCount,Pointer(fParamBindings),0,
          fDBParams.HACCESSOR,pointer(ParamsStatus)),ParamsStatus);
      fDBParams.cParamSets := 1;
      fDBParams.pData := pointer(fParams);
    end;
    // 3. Execute SQL
    if fExpectResults then
    try
      // 3.1 SELECT will allow access to resulting rows data from fRowSet
      res := E_UNEXPECTED; // makes compiler happy
      if not OleDBConnection.OleDBProperties.fSupportsOnlyIRowset then begin
        // use IMultipleResults for 'insert into table1 values (...); select ... from table2 where ...'
        res := fCommand.Execute(nil,IID_IMultipleResults,fDBParams,@fUpdateCount,@mr);
        if res=E_NOINTERFACE then
          OleDBConnection.OleDBProperties.fSupportsOnlyIRowset := true else
          if Assigned(mr) then
            repeat
              res := mr.GetResult(nil,0,IID_IRowset,@fUpdateCount,@RowSet);
            until Assigned(RowSet) or (res <> S_OK);
      end;
      if OleDBConnection.OleDBProperties.fSupportsOnlyIRowset then
        res := fCommand.Execute(nil,IID_IRowset,fDBParams,nil,@RowSet);
      OleDBConnection.OleDBCheck(self,res,ParamsStatus);
      FromRowSet(RowSet);
    except
      on E: Exception do begin
        CloseRowSet; // force fRowSet=nil
        raise;
      end;
    end else
      // 3.2 ExpectResults=false (e.g. SQL UPDATE) -> leave fRowSet=nil
      OleDBConnection.OleDBCheck(self,
        fCommand.Execute(nil,DB_NULLGUID,fDBParams,@fUpdateCount,nil));
  finally
    for i := 0 to fParamCount - 1 do
      if Assigned(IDLists[i]) then begin
        fParams[i].VIUnknown := nil;
        IDLists[i].Free;
      end;
  end;
  SQLLogEnd;
end;

procedure TOleDBStatement.FromRowSet(RowSet: IRowSet);
begin
  if fRowSet<>nil then
    EOleDBException.Create('TOleDBStatement.FromRowSet twice');
  if not Assigned(RowSet) then
    exit; // no row returned
  fRowSet := RowSet;
  fRowSize := BindColumns(fRowSet as IColumnsInfo,fColumn,fColumnBindings);
  SetLength(fRowSetData,fRowSize);
  if fRowSize>RowBufferSize then
    RowBufferSize := fRowSize; // enforce at least one row in OleDB buffer
  SetLength(fRowStepHandles,RowBufferSize div fRowSize);
end;

procedure TOleDBStatement.FlushRowSetData;
var c: integer;
begin
  if fHasColumnValueInlined then
    for c := 0 to fColumnCount-1 do
      with fColumns[c] do
      if not ColumnValueInlined then // release DBTYPE_BYREF memory
      with PColumnValue(@fRowSetData[ColumnAttr])^ do
        if VWideChar<>nil then
          OleDBConnection.fMalloc.Free(VWideChar);
  fillchar(fRowSetData[0],fRowSize,0);
end;

function TOleDBStatement.Step(SeekFirst: boolean): boolean;
var Status: TCardinalDynArray;
    sav: integer;
begin
{  if not Assigned(fCommand) then
    raise EOleDBException.CreateUTF8('%.Execute should be called before Step',[self]); }
  result := false;
  sav := fCurrentRow;
  fCurrentRow := 0;
  if not Assigned(fRowSet) or (fColumnCount=0) then
    exit; // no row available at all (e.g. for SQL UPDATE) -> return false
  if fRowSetAccessor=0 then begin
    // first time called -> need to init accessor from fColumnBindings[]
    SetLength(Status,fColumnCount);
    OleDBConnection.OleDBCheck(self,(fRowSet as IAccessor).CreateAccessor(
      DBACCESSOR_ROWDATA or DBACCESSOR_OPTIMIZED,fColumnCount,
      pointer(fColumnBindings),fRowSize,fRowSetAccessor,pointer(Status)),Status);
    fRowStepHandleRetrieved := 0;
    fRowStepHandleCurrent := 0;
    fRowStepResult := 0;
  end else
  if SeekFirst then begin
    // rewind to first row
    ReleaseRowSetDataAndRows;
    OleDBConnection.OleDBCheck(self,fRowSet.RestartPosition(DB_NULL_HCHAPTER));
    fRowStepResult := 0;
  end else
    FlushRowSetData;
  if fRowStepHandleCurrent>=fRowStepHandleRetrieved then begin
    ReleaseRowSetDataAndRows;
    if fRowStepResult=DB_S_ENDOFROWSET then
      exit; // no more row available -> return false
    fRowStepResult := fRowSet.GetNextRows(DB_NULL_HCHAPTER,0,length(fRowStepHandles),
      fRowStepHandleRetrieved,pointer(fRowStepHandles));
    OleDBConnection.OleDBCheck(self,fRowStepResult);
    fRowStepHandleCurrent := 0;
    if fRowStepHandleRetrieved=0 then
      exit; // no more row available
  end;
  // here we have always fRowStepHandleCurrent<fRowStepHandleRetrieved
  OleDBConnection.OleDBCheck(self,fRowSet.GetData(fRowStepHandles[fRowStepHandleCurrent],
    fRowSetAccessor,pointer(fRowSetData)));
  inc(fRowStepHandleCurrent);
  fCurrentRow := sav+1;
  inc(fTotalRowsRetrieved);
  result := true; // mark data available in fRowSetData
end;

destructor TOleDBStatement.Destroy;
begin
  try
    CloseRowSet;
  finally
    fCommand := nil;
    inherited;
  end;
end;

procedure TOleDBStatement.SetRowBufferSize(Value: integer);
begin
  if Value<4096 then
    Value := 4096;
  fRowBufferSize := Value;
end;

procedure TOleDBStatement.ReleaseRowSetDataAndRows;
begin
  FlushRowSetData;
  if fRowStepHandleRetrieved<>0 then begin
    fRowSet.ReleaseRows(fRowStepHandleRetrieved,Pointer(fRowStepHandles),nil,nil,nil);
    fRowStepHandleRetrieved := 0;
  end;
  fCurrentRow := 0;
end;

procedure TOleDBStatement.CloseRowSet;
begin
  if not Assigned(fRowSet) then
    exit;
  ReleaseRowSetDataAndRows;
  if fRowSetAccessor<>0 then begin
    (fRowSet as IAccessor).ReleaseAccessor(fRowSetAccessor,nil);
    fRowSetAccessor := 0;
  end;
  fRowSet := nil;
end;

procedure TOleDBStatement.Reset;
begin
  ReleaseRows;
  if fColumnCount>0 then begin
    fColumn.Clear;
    fColumn.ReHash;
    // faster if full command is re-prepared!
    fCommand := nil;
    Prepare(fSQL,fExpectResults);
  end;
  fUpdateCount := 0;
  inherited Reset;
end;

procedure TOleDBStatement.ReleaseRows;
begin
  if fParamCount>0 then
    fParam.Clear;
  fParamBindings := nil;
  CloseRowSet;
  fColumnBindings := nil;
  inherited ReleaseRows;
end;

function TOleDBStatement.UpdateCount: integer;
begin
  if not fExpectResults then
    result := fUpdateCount else
    result := 0;
end;

function OleDBColumnToFieldType(wType: DBTYPE; bScale: byte): TSQLDBFieldType;
begin
  case wType of
  DBTYPE_EMPTY:
    result := ftUnknown;
  DBTYPE_NULL:
    result := ftNull;
  DBTYPE_I1, DBTYPE_I2, DBTYPE_I4, DBTYPE_I8,
  DBTYPE_UI1, DBTYPE_UI2, DBTYPE_UI4, DBTYPE_UI8, DBTYPE_BOOL:
    result := ftInt64;
  DBTYPE_CY:
    result := ftCurrency;
  DBTYPE_R4, DBTYPE_R8:
    result := ftDouble;
  DBTYPE_DECIMAL, DBTYPE_NUMERIC, DBTYPE_VARNUMERIC:
    case bScale of // number of digits to the right of the decimal point
         0: result := ftInt64;
      1..4: result := ftCurrency;
    else    result := ftDouble;
    end;
  DBTYPE_DATE, DBTYPE_DBDATE, DBTYPE_DBTIME, DBTYPE_FILETIME, DBTYPE_DBTIMESTAMP:
    result := ftDate;
  DBTYPE_BYTES, DBTYPE_UDT:
    result := ftBlob;
  else // all other types will be converted to text
    result := ftUtf8;
  end;
end;


function TOleDBStatement.BindColumns(ColumnInfo: IColumnsInfo;
  var Column: TDynArrayHashed; out Bindings: TDBBindingDynArray): integer;
const
  // column content is inlined up to 4 KB, otherwise will be stored as DBTYPE_BYREF
  MAXCOLUMNSIZE = 4000;
var i, len: integer;
    B: PDBBinding;
    Cols, nfo: PDBColumnInfo;
    Col: PSQLDBColumnProperty;
    nCols: PtrUInt;
    ColsNames: PWideChar;
    aName: RawUTF8;
begin
  nCols := 0;
  Cols := nil;
  ColsNames := nil;
  OleDBConnection.OleDBCheck(self,ColumnInfo.GetColumnInfo(nCols,Cols,ColsNames));
  try
    nfo := Cols;
    SetLength(fColumnBindings,nCols);
    B := pointer(fColumnBindings);
    result := 0; // resulting buffer will map TColumnValue layout
    fColumn.Capacity := nCols;
    for i := 1 to nCols do begin
      if (nfo^.pwszName=nil) or (nfo^.pwszName^=#0) then
        aName := 'col_'+Int32ToUTF8(i) else
        aName := RawUnicodeToUtf8(nfo^.pwszName,StrLenW(nfo^.pwszName));
      Col := fColumn.AddAndMakeUniqueName(aName); // set ColumnName := aName
      Col^.ColumnType := OleDBColumnToFieldType(nfo^.wType,nfo^.bScale);
      Col^.ColumnNonNullable := nfo^.dwFlags and DBCOLUMNFLAGS_MAYBENULL=0;
      Col^.ColumnAttr := result; // offset of status[-length]-value in fRowSetData[]
      Col^.ColumnValueInlined := true;
      B^.iOrdinal := nfo^.iOrdinal;
      B^.eParamIO := DBPARAMIO_NOTPARAM;
      B^.obStatus := result;
      inc(result,sizeof(PtrInt)); // TColumnValue.Status
      B^.wType := FIELDTYPE2OLEDB[Col^.ColumnType];
      case Col^.ColumnType of
      ftInt64, ftDouble, ftCurrency, ftDate: begin
        inc(result,sizeof(PtrUInt)); // ignore TColumnValue.Length
        B^.dwPart := DBPART_STATUS or DBPART_VALUE;
        B^.obValue := result;
        B^.cbMaxLen := sizeof(Int64);
        inc(result,sizeof(Int64));
      end;
      ftUTF8, ftBlob: begin
        B^.dwPart := DBPART_STATUS or DBPART_VALUE or DBPART_LENGTH;
        B^.obLength := result; // need length field in fRowSetData[]
        inc(result,sizeof(PtrUInt)); // TColumnValue.Length
        B^.obValue := result;
        if nfo^.ulColumnSize<MAXCOLUMNSIZE then begin // inline up to 4 KB
          B^.wType :=  B^.wType and not DBTYPE_BYREF;
          Len := nfo^.ulColumnSize;
          Col^.ColumnValueDBSize := Len;
          if Col^.ColumnType=ftUTF8 then begin
            case nfo^.wType of
            DBTYPE_STR, DBTYPE_BSTR, DBTYPE_WSTR:
              Len := Len*2; // ulColumnSize = WideChar count
            DBTYPE_GUID: Len := 78;
            else Len := 62; // 31 widechars will fit any type converted
            end;
            inc(Len,2); // reserve memory for trailing WideChar(#0)
          end;
          if AlignDataInternalBuffer then // 8 bytes alignment
            Len := ((Len-1) shr 3+1)shl 3;
          inc(result,Len);
          B^.cbMaxLen := Len;
        end else begin // get huge content by pointer (includes DBTYPE_BYREF)
          fHasColumnValueInlined := true;
          Col^.ColumnValueInlined := false;
          B^.cbMaxLen := sizeof(Pointer); // value=pointer in fRowSetData[]
          if AlignDataInternalBuffer then
            inc(result,8) else
            inc(result,sizeof(Pointer));
        end;
      end;
      else raise EOleDBException.CreateUTF8(
        '%.Execute: wrong column [%] (%) for [%]',[self,aName,
          GetEnumName(TypeInfo(TSQLDBFieldType),ord(Col^.ColumnType))^,fSQL]);
      end;
      inc(nfo);
      inc(B);
      if AlignDataInternalBuffer then
        Assert((result and 7)=0);
    end;
    assert(not AlignDataInternalBuffer or (result and 7=0));
    assert(fColumnCount=integer(nCols));
  finally
    OleDBConnection.fMalloc.Free(Cols);
    OleDBConnection.fMalloc.Free(ColsNames);
  end;
end;


{ TOleDBConnection }

threadvar
  OleDBCoinitialized: integer;

procedure CoInit;
begin
  inc(OleDBCoInitialized);
  if OleDBCoInitialized=1 then
    CoInitialize(nil);
end;

procedure CoUninit;
begin
  assert(OleDBCoinitialized>0,'You should call TOleDBConnection.Free from the same '+
    'thread which called its Create: i.e. call MyProps.EndCurrentThread from an '+
    'THttpServerGeneric.OnHttpThreadTerminate event - see ticket 213544b2f5');
  dec(OleDBCoinitialized);
  if OleDBCoinitialized=0 then
    CoUninitialize;
end;

procedure TOleDBConnection.Connect;
var DataInitialize : IDataInitialize;
    unknown: IUnknown;
    Log: ISynLog;
begin
  Log := SynDBLog.Enter(self,'Connect');
  // check context
  if Connected then
    Disconnect;
  if OleDBProperties.ConnectionString='' then
    raise EOleDBException.CreateUTF8('%.Connect excepts a ConnectionString',[self]);
  try
    // retrieve initialization parameters from connection string
    OleCheck(CoCreateInstance(CLSID_MSDAINITIALIZE, nil, CLSCTX_INPROC_SERVER,
      IID_IDataInitialize, DataInitialize));
    OleCheck(DataInitialize.GetDataSource(nil,CLSCTX_INPROC_SERVER,
      pointer(OleDBProperties.ConnectionString),
      IID_IDBInitialize,IUnknown(fDBInitialize)));
    DataInitialize := nil;
    // open the connection to the DB
    OleDBCheck(nil,fDBInitialize.Initialize);
    OnDBInitialized; // optionaly set parameters
    OleDBCheck(nil,
      (fDBInitialize as IDBCreateSession).CreateSession(nil,IID_IOpenRowset,fSession));
    // check if DB handle transactions
    if fSession.QueryInterface(IID_ITransactionLocal,unknown)=S_OK then
      fTransaction := unknown as ITransactionLocal else
      fTransaction := nil;
    inherited Connect; // notify any re-connection
  except
    on E: Exception do begin
      fSession := nil; // mark not connected
      fDBInitialize := nil;
      DataInitialize := nil;
      raise;
    end;
  end;
end;

constructor TOleDBConnection.Create(aProperties: TSQLDBConnectionProperties);
var Log: ISynLog;
begin
  Log := SynDBLog.Enter(self,'Create');
  if not aProperties.InheritsFrom(TOleDBConnectionProperties) then
    raise EOleDBException.CreateUTF8('Invalid %.Create(%)',[self,aProperties]);
  fOleDBProperties := TOleDBConnectionProperties(aProperties);
  inherited;
  CoInit;
  OleCheck(CoGetMalloc(1,fMalloc));
end;

destructor TOleDBConnection.Destroy;
var Log: ISynLog;
begin
  Log := SynDBLog.Enter(self,'Destroy');
  try
    inherited Destroy; // call Disconnect;
    fMalloc := nil;
    CoUninit;
  except
    on E: Exception do
      if Log<>nil then
        Log.Log(sllError,E);
  end;
end;

procedure TOleDBConnection.Disconnect;
var Log: ISynLog;
begin
  Log := SynDBLog.Enter(self,'Disconnect');
  try
    inherited Disconnect; // flush any cached statement
  finally
    if Connected then begin
      fTransaction := nil;
      fSession := nil;
      OleDBCheck(nil,fDBInitialize.Uninitialize);
      fDBInitialize := nil;
    end;
  end;
end;

function TOleDBConnection.IsConnected: boolean;
begin
  result := fSession<>nil;
end;

function TOleDBConnection.NewStatement: TSQLDBStatement;
begin
  result := TOleDBStatement.Create(self);
end;

procedure TOleDBConnection.OleDBCheck(aStmt: TSQLDBStatement; aResult: HRESULT;
  const aStatus: TCardinalDynArray);
procedure EnhancedTest;
var ErrorInfo, ErrorInfoDetails: IErrorInfo;
    ErrorRecords: IErrorRecords;
    i: integer;
    Desc: WideString;
    ErrorCount: UINT;
    E: Exception;
    s: string;
begin // get OleDB specific error information
  GetErrorInfo(0,ErrorInfo);
  if Assigned(ErrorInfo) then begin
    ErrorRecords := ErrorInfo as IErrorRecords;
    ErrorRecords.GetRecordCount(ErrorCount);
    for i := 0 to ErrorCount-1 do
      if not Assigned(OleDBProperties.OnCustomError) or
         not OleDBProperties.OnCustomError(self,ErrorRecords,i) then begin
        // retrieve generic error info if OnCustomError() didn't handle it
        OleCheck(ErrorRecords.GetErrorInfo(i,GetSystemDefaultLCID,ErrorInfoDetails));
        OleCheck(ErrorInfoDetails.GetDescription(Desc));
        if fOleDBErrorMessage<>'' then
          fOleDBErrorMessage := fOleDBErrorMessage+'  ';
        fOleDBErrorMessage := fOleDBErrorMessage+UnicodeBufferToString(pointer(Desc));
        ErrorInfoDetails := nil;
      end;
  end;
  // get generic HRESULT error
  if not Succeeded(aResult) or (fOleDBErrorMessage<>'') then begin
    s := SysErrorMessage(aResult);
    if s='' then
      s := 'OLEDB Error '+IntToHex(aResult,8);
    if s<>fOleDBErrorMessage then
      fOleDBErrorMessage := s+' - '+fOleDBErrorMessage;
  end;
  if fOleDBErrorMessage='' then
    exit;
  // retrieve binding information from Status[]
  s := '';
  for i := 0 to high(aStatus) do
    if TOleDBBindStatus(aStatus[i])<>bsOK then begin
      if aStatus[i]<=cardinal(high(TOleDBBindStatus)) then
        s := FormatString('% Status[%]="%"',[s,i,
          GetCaptionFromEnum(TypeInfo(TOleDBBindStatus),aStatus[i])]) else
        s := FormatString('% Status[%]=%',[s,i,aStatus[i]]);

    end;
  if s<>'' then
    fOleDBErrorMessage :=  fOleDBErrorMessage+s;
  StringToUTF8(fOleDBErrorMessage, fErrorMessage);
  // raise exception
  if aStmt=nil then
    E := EOleDBException.Create(fOleDBErrorMessage) else
    E := EOleDBException.CreateUTF8('%: %',[self,StringToUTF8(fOleDBErrorMessage)]);
  SynDBLog.Add.Log(sllError,E);
  raise E;
end;
begin
  fOleDBErrorMessage := '';
  fOleDBInfoMessage := '';
  if not Succeeded(aResult) or Assigned(OleDBProperties.OnCustomError) then
    EnhancedTest;
end;

procedure TOleDBConnection.OnDBInitialized;
begin // do nothing by default
end;

procedure TOleDBConnection.Commit;
var Log: ISynLog;
begin
  Log := SynDBLog.Enter(self,'Commit');
  if assigned(fTransaction) then begin
    inherited Commit;
    try
      OleDbCheck(nil,fTransaction.Commit(False,XACTTC_SYNC,0));
    except
      inc(fTransactionCount); // the transaction is still active
      raise;
    end;
  end;
end;

procedure TOleDBConnection.Rollback;
var Log: ISynLog;
begin
  Log := SynDBLog.Enter(self,'Rollback');
  if assigned(fTransaction) then begin
    inherited Rollback;
    OleDbCheck(nil,fTransaction.Abort(nil,False,False));
  end;
end;

procedure TOleDBConnection.StartTransaction;
var Log: ISynLog;
begin
  Log := SynDBLog.Enter(self,'StartTransaction');
  if assigned(fTransaction) then begin
    inherited StartTransaction;
    OleDbCheck(nil,fTransaction.StartTransaction(ISOLATIONLEVEL_READCOMMITTED,0,nil,nil));
  end;
end;


{ TOleDBConnectionProperties }

function TOleDBConnectionProperties.ConnectionStringDialogExecute(Parent: HWND): boolean;
var DataInitialize: IDataInitialize;
    DBPromptInitialize: IDBPromptInitialize;
    DBInitialize: IUnknown;
    res: HRESULT;
    tmp: PWideChar;
    Log: ISynLog;
begin
  Log := SynDBLog.Enter(self,'ConnectionStringDialog');
  result := false;
  if self<>nil then
  try
    CoInit; // if not already done
    try
      OleCheck(CoCreateInstance(CLSID_DATALINKS, nil, CLSCTX_INPROC_SERVER,
        IID_IDBPromptInitialize, DBPromptInitialize));
      OleCheck(CoCreateInstance(CLSID_MSDAINITIALIZE, nil, CLSCTX_INPROC_SERVER,
        IID_IDataInitialize, DataInitialize));
      if fConnectionString<>'' then
        DataInitialize.GetDataSource(nil,CLSCTX_INPROC_SERVER,Pointer(fConnectionString),
          IID_IDBInitialize,DBInitialize) else
        DBInitialize := nil;
      res := DBPromptInitialize.PromptDataSource(nil,Parent,DBPROMPTOPTIONS_PROPERTYSHEET,
        0,nil,nil,IID_IDBInitialize,DBInitialize);
      case res of
      S_OK: begin
        OleCheck(DataInitialize.GetInitializationString(DBInitialize,True,tmp));
        fConnectionString := tmp;
        if tmp<>nil then
          CoTaskMemFree(tmp);
        if Log<>nil then
          Log.Log(sllDB,'New connection settings set',self);
        result := true;
      end;
      DB_E_CANCELED:
        if Log<>nil then
          Log.Log(sllDB,'Canceled',self);
      else OleCheck(res);
      end;
    finally
      CoUninit;
    end;
  except
    result  := false;
  end;
end;

const
  CLASS_Catalog: TGUID = '{00000602-0000-0010-8000-00AA006D2EA4}';
  IID__Catalog: TGUID = '{00000603-0000-0010-8000-00AA006D2EA4}';

type
  _Catalog = interface(IDispatch)
    ['{00000603-0000-0010-8000-00AA006D2EA4}']
    function Get_Tables: OleVariant; safecall;
    function Get_ActiveConnection: OleVariant; safecall;
    procedure Set_ActiveConnection(pVal: OleVariant); safecall;
    procedure _Set_ActiveConnection(const pVal: IDispatch); safecall;
    function Get_Procedures: OleVariant; safecall;
    function Get_Views: OleVariant; safecall;
    function Get_Groups: OleVariant; safecall;
    function Get_Users: OleVariant; safecall;
    function Create(const ConnectString: WideString): OleVariant; safecall;
    // warning: the following method won't work if you use SynFastWideString.pas
    // but we don't call it in this unit, you we can stay cool for now :)
    function GetObjectOwner(const ObjectName: WideString; ObjectType: OleVariant;
                            ObjectTypeId: OleVariant): WideString; safecall;
    procedure SetObjectOwner(const ObjectName: WideString; ObjectType: OleVariant;
                             const UserName: WideString; ObjectTypeId: OleVariant); safecall;
  end;

function TOleDBConnectionProperties.CreateDatabase: boolean;
var Catalog: _Catalog;
    DB: OleVariant;
begin
  result := false;
  if ConnectionString<>'' then
  try
    CoInit;
    if Succeeded(CoCreateInstance(CLASS_Catalog, nil, CLSCTX_INPROC_SERVER,
      IID__Catalog, Catalog)) then
      try
        DB := Catalog.Create(ConnectionString);
        result := true;
      except
        result := false;
      end;
    SynDBLog.Add.Log(sllDB,'CreateDatabase for [%] returned %',
      [ConnectionString,ord(result)],self);
  finally
    DB := null;
    Catalog := nil;
    CoUninit;
  end;
end;

procedure TOleDBConnectionProperties.GetTableNames(out Tables: TRawUTF8DynArray);
var Rows: IRowset;
    count, schemaCol, nameCol: integer;
    schema, tablename: RawUTF8;
begin
  inherited; // first try from SQL, if any (faster)
  if Tables<>nil then
    exit; // already retrieved directly from engine
  try
    // see http://msdn.microsoft.com/en-us/library/ms716980(v=VS.85).aspx
    // Restriction columns: TABLE_CATALOG, TABLE_SCHEMA, TABLE_NAME, TABLE_TYPE
    if GetSchema(DBSCHEMA_TABLES,['','','','TABLE'],Rows) then
    with TOleDBStatement.Create(MainConnection) do
    try
      FromRowSet(Rows);
      count := 0;
      schemaCol := ColumnIndex('TABLE_SCHEMA');
      nameCol := ColumnIndex('TABLE_NAME');
      if (schemaCol>=0) and (nameCol>=0) then
        while Step do begin
          schema := Trim(ColumnUTF8(schemaCol));
          tablename := Trim(ColumnUTF8(nameCol));
          if schema<>'' then
            tablename := schema+'.'+tablename;
          AddSortedRawUTF8(Tables,count,tableName);
        end;
      SetLength(Tables,count);
    finally
      Free;
    end;
  except
    on Exception do
      SetLength(Tables,0);
  end;
end;

procedure TOleDBConnectionProperties.GetFields(const aTableName: RawUTF8;
  out Fields: TSQLDBColumnDefineDynArray);
var Owner, Table, Column: RawUTF8;
    Rows: IRowset;
    n, i: integer;
    F: TSQLDBColumnDefine;
    FA: TDynArray;
const DBTYPE_DISPLAY: array[TSQLDBFieldType] of RawUTF8 = (
  '???','null','int','double','currency','date','nvarchar','blob');
begin
  inherited; // first try from SQL, if any (faster)
  if Fields<>nil then
    exit; // already retrieved directly from engine
  try
    Split(aTableName,'.',Owner,Table);
    if Table='' then begin
      Table := Owner;
      Owner := '';
    end;
    // see http://msdn.microsoft.com/en-us/library/ms723052(v=VS.85).aspx
    if GetSchema(DBSCHEMA_COLUMNS,['',Owner,Table,''],Rows) then
      // Restriction columns: TABLE_CATALOG,TABLE_SCHEMA,TABLE_NAME,COLUMN_NAME
      with TOleDBStatement.Create(MainConnection) do
      try
        FromRowSet(Rows);
        FA.Init(TypeInfo(TSQLDBColumnDefineDynArray),Fields,@n);
        while Step do begin
          F.ColumnName := Trim(ColumnUTF8('COLUMN_NAME'));
          F.ColumnLength := ColumnInt('CHARACTER_MAXIMUM_LENGTH');
          F.ColumnPrecision := ColumnInt('NUMERIC_PRECISION');
          F.ColumnScale := ColumnInt('NUMERIC_SCALE');
          F.ColumnType:= OleDBColumnToFieldType(ColumnInt('DATA_TYPE'),F.ColumnScale);
          F.ColumnTypeNative := DBTYPE_DISPLAY[F.ColumnType];
          FA.Add(F);
        end;
        SetLength(Fields,n);
      finally
        Free;
      end;
  // now we have Fields[] with the column information -> get indexes and foreign keys
  if GetSchema(DBSCHEMA_INDEXES,['',Owner,'','',Table],Rows) then
    // Restriction columns: TABLE_CATALOG,TABLE_SCHEMA,INDEX_NAME,TYPE,TABLE_NAME
    with TOleDBStatement.Create(MainConnection) do
    try
      FromRowSet(Rows);
      while Step do begin
        Column := Trim(ColumnUTF8('COLUMN_NAME'));
        for i := 0 to high(Fields) do
        with Fields[i] do
        if IdemPropNameU(ColumnName,Column) then begin
          ColumnIndexed := true;
          break;
        end;
      end;
    finally
      Free;
    end;
  except
    on Exception do
      SetLength(Fields,0);
  end;
end;

procedure TOleDBConnectionProperties.GetForeignKeys;
var Rows: IRowset;
begin // retrieve all foreign keys into fForeignKeys list
  try
    if GetSchema(DBSCHEMA_FOREIGN_KEYS,['','','','','',''],Rows) then
    // PK_TABLE_CATALOG,PK_TABLE_SCHEMA,PK_TABLE_NAME,FK_TABLE_CATALOG,FK_TABLE_SCHEMA,FK_TABLE_NAME
    with TOleDBStatement.Create(MainConnection) do
    try
      FromRowSet(Rows);
      while Step do
        fForeignKeys.Add(
          Trim(ColumnUTF8('FK_TABLE_SCHEMA'))+'.'+Trim(ColumnUTF8('FK_TABLE_NAME'))+
            '.'+Trim(ColumnUTF8('FK_COLUMN_NAME')),
          Trim(ColumnUTF8('PK_TABLE_SCHEMA'))+'.'+Trim(ColumnUTF8('PK_TABLE_NAME'))+
            '.'+Trim(ColumnUTF8('PK_COLUMN_NAME')));
    finally
      Free;
    end;
  except
    on Exception do ; // just ignore errors here
  end;
end;

function TOleDBConnectionProperties.GetSchema(const aUID: TGUID;
  const Fields: array of RawUTF8; var aResult: IRowset): boolean;
var i, res, n: integer;
    C: TOleDBConnection;
    SRS: IDBSchemaRowset;
    PG, OG: PGUID;
    PI, OI: PInteger;
    Args: array of Variant;
begin
  result := false;
  if (self=nil) or (high(Fields)<0) then
    exit;
  C := MainConnection as TOleDBConnection;
  if C.fSession=nil then
    C.Connect;
  C.fSession.QueryInterface(IDBSchemaRowset,SRS);
  if not Assigned(SRS) then
    exit; // provider do not support this interface
  if fSchemaRec=nil then begin
    SRS.GetSchemas(n,OG,OI);
    if n>0 then
    try
      SetLength(fSchemaRec,n);
      PG := OG;
      PI := OI;
      for i := 0 to n-1 do
      with fSchemaRec[i] do begin
        SchemaGuid := PG^;
        SupportedRestrictions := PI^;
        inc(PG);
        inc(PI);
      end;
    finally
      C.fMalloc.Free(OG);
      C.fMalloc.Free(OI);
    end;
  end;
  res := 0;
  for i := 0 to high(fSchemaRec) do
    if IsEqualGuid(@fSchemaRec[i].SchemaGuid,@aUID) then begin
      res := fSchemaRec[i].SupportedRestrictions;
      break;
    end;
  if res=0 then
    exit;
  SetLength(Args,length(Fields));
  for i := 0 to high(Fields) do
  if res and (1 shl i)<>0 then
    if Fields[i]<>'' then // '' will leave VT_EMPTY parameter = no restriction
      Args[i] := UTF8ToWideString(Fields[i]); // expect parameter as BSTR
  aResult := nil;
  try
    C.OleDBCheck(nil,SRS.GetRowset(nil,aUID,length(Args),Args,IID_IRowset,0,nil,aResult));
    result := aResult<>nil; // mark some rows retrieved
  except
    result := false;
  end;
end;

function TOleDBConnectionProperties.NewConnection: TSQLDBConnection;
begin
  result := TOleDBConnection.Create(self);
end;

procedure TOleDBConnectionProperties.SetInternalProperties;
var tmp: RawUTF8;
begin
  if fProviderName<>'' then
    tmp := 'Provider='+fProviderName+';';
  if fServerName<>'' then
    tmp := tmp+'Data Source='+fServerName+';';
  if fDatabaseName<>'' then
    tmp := tmp+'Initial Catalog='+fDatabaseName+';';
  fConnectionString := UTF8ToSynUnicode(tmp+'User Id='+fUserID+';Password='+fPassWord+';');
end;

function TOleDBConnectionProperties.ColumnTypeNativeToDB(
  const aNativeType: RawUTF8; aScale: integer): TSQLDBFieldType;
var native, err: integer;
begin
  native := GetInteger(pointer(aNativeType),err);
  if err=0 then
    // type directly retrieved from OleDB as integer
    result := OleDBColumnToFieldType(native,aScale) else
    // type retrieved via a SELECT from INFORMATION_SCHEMA.COLUMNS
    result := inherited ColumnTypeNativeToDB(aNativeType,aScale);
end;


{ TOleDBOracleConnectionProperties }

procedure TOleDBOracleConnectionProperties.SetInternalProperties;
begin
  if fProviderName='' then
    fProviderName := 'OraOLEDB.Oracle.1';
  fDBMS := dOracle;
  inherited SetInternalProperties;
end;


{ TOleDBMSOracleConnectionProperties }

procedure TOleDBMSOracleConnectionProperties.SetInternalProperties;
begin
  fProviderName := 'MSDAORA';
  fDBMS := dOracle;
  inherited SetInternalProperties;
end;

{ TOleDBMSSQLConnectionProperties }

type
  /// to retrieve enhanced Microsoft SQL Server error information
  PSSERRORINFO = ^SSERRORINFO;
  SSERRORINFO = packed record
    pwszMessage: PWideChar;
    pwszServer: PWideChar;
    pwszProcedure: PWideChar;
    lNative: cardinal;
    bState: byte;
    bClass: byte;
    wLineNumber: word;
  end;
  /// to retrieve enhanced Microsoft SQL Server error information
  ISQLServerErrorInfo = interface(IUnknown)
    ['{5CF4CA12-EF21-11d0-97E7-00C04FC2AD98}']
    function GetErrorInfo(out ppErrorInfo: PSSERRORINFO;
                          out Error: PWideChar): HResult; stdcall;
  end;

const
  IID_ISQLServerErrorInfo: TGUID = '{5CF4CA12-EF21-11d0-97E7-00C04FC2AD98}';

function TOleDBMSSQLConnectionProperties.MSOnCustomError(Connection: TOleDBConnection;
  ErrorRecords: IErrorRecords; RecordNum: UINT): boolean;
var SQLServerErrorInfo: ISQLServerErrorInfo;
    SSErrorInfo: PSSERRORINFO;
    SSErrorMsg: PWideChar;
    msg, tmp: string;
    utf8: RawUTF8;
begin
  result := False;
  if (self=nil) or (Connection=nil) then
    exit;
  ErrorRecords.GetCustomErrorObject(RecordNum,IID_ISQLServerErrorInfo,
    IUnknown(SQLServerErrorInfo));
  if Assigned(SQLServerErrorInfo) then
  try
    if (SQLServerErrorInfo.GetErrorInfo(SSErrorInfo,SSErrorMsg)=S_OK) and
       (SSErrorInfo<>nil) then
    with SSErrorInfo^ do
    try
      msg := UnicodeBufferToString(pwszMessage)+#13#10;
      if bClass<=10 then begin
        Connection.fOleDBInfoMessage := Connection.fOleDBInfoMessage+msg;
        RawUnicodeToUtf8(pwszMessage,StrLenW(pwszMessage),utf8);
        SynDBLog.Add.Log(sllDB,utf8,self);
        with Connection.Properties do
          if Assigned(OnStatementInfo) then
            OnStatementInfo(nil,utf8);
      end else begin
        if pwszProcedure<>nil then
          tmp := UnicodeBufferToString(pwszProcedure) else
          tmp := 'Error '+IntToStr(lNative);
        Connection.fOleDBErrorMessage := FormatString('% % (line %): %',
          [Connection.fOleDBErrorMessage,tmp,wLineNumber,msg]);
      end;
    finally
      Connection.fMalloc.Free(SSErrorInfo);
      Connection.fMalloc.Free(SSErrorMsg);
    end;
    result := true;
  finally
    SQLServerErrorInfo := nil;
  end;
end;

procedure TOleDBMSSQLConnectionProperties.SetInternalProperties;
begin
  OnCustomError := MSOnCustomError;
  if fProviderName='' then
    fProviderName := 'SQLNCLI10';
  fDBMS := dMSSQL;
  inherited SetInternalProperties;
  if fUserID='' then
    fConnectionString := fConnectionString+
      'Integrated Security=SSPI;Persist Security Info=False;';
end;

{ TOleDBMSSQL2005ConnectionProperties }

procedure TOleDBMSSQL2005ConnectionProperties.SetInternalProperties;
begin
  fProviderName := 'SQLNCLI';
  inherited SetInternalProperties;
end;

constructor TOleDBMSSQL2005ConnectionProperties.Create(
  const aServerName, aDatabaseName, aUserID, aPassWord: RawUTF8);
begin
  inherited;
  fBatchSendingAbilities := [];
  fOnBatchInsert := nil; // MultipleValuesInsert() does not work with SQL 2005
end;

{ TOleDBMSSQL2012ConnectionProperties }

procedure TOleDBMSSQL2012ConnectionProperties.SetInternalProperties;
begin
  if OSVersion>wVista then
    fProviderName := 'SQLNCLI11';
  inherited SetInternalProperties;
end;


{ TOleDBODBCSQLConnectionProperties }

constructor TOleDBODBCSQLConnectionProperties.Create(const aDriver,
  aServerName, aDatabaseName, aUserID, aPassWord: RawUTF8);
begin
  fDriver := aDriver;
  inherited Create(aServerName,aDatabaseName,aUserID,aPassWord);
end;

procedure TOleDBODBCSQLConnectionProperties.SetInternalProperties;
begin
  fProviderName := 'MSDASQL'; // we could have left it void - never mind
  inherited SetInternalProperties;
  if fDriver<>'' then
    fConnectionString := UTF8ToSynUnicode('Driver='+fDriver+';')+fConnectionString;
end;

{ TOleDBMySQLConnectionProperties }

procedure TOleDBMySQLConnectionProperties.SetInternalProperties;
begin
  fProviderName := 'MYSQLPROV';
  fDBMS := dMySQL;
  inherited;
end;

{ TOleDBAS400ConnectionProperties }

procedure TOleDBAS400ConnectionProperties.SetInternalProperties;
begin
  fProviderName := 'IBMDA400.DataSource.1';
  inherited SetInternalProperties;
end;

{ TOleDBInformixConnectionProperties }

procedure TOleDBInformixConnectionProperties.SetInternalProperties;
begin
  fProviderName := 'Ifxoledbc';
  fDBMS := dInformix;
  inherited SetInternalProperties;
end;

{$ifndef CPU64}

{ TOleDBJetConnectionProperties }

procedure TOleDBJetConnectionProperties.SetInternalProperties;
begin
  fProviderName := 'Microsoft.Jet.OLEDB.4.0';
  fDBMS := dJet;
  inherited SetInternalProperties;
  if not FileExists(UTF8ToString(ServerName)) then
    CreateDatabase;
end;

{$endif CPU64}

{ TOleDBACEConnectionProperties }

procedure TOleDBACEConnectionProperties.SetInternalProperties;
begin
  fProviderName := 'Microsoft.ACE.OLEDB.12.0';
  fDBMS := dJet;
  inherited SetInternalProperties;
  if not FileExists(UTF8ToString(ServerName)) then
    CreateDatabase;
end;


{ TBaseAggregatingRowset }

function TBaseAggregatingRowset.AddRefRows(cRows: PtrUInt;
  rghRows: PPtrUIntArray; rgRefCounts, rgRowStatus: PCardinalArray): HResult;
begin
  // Never gets called, so we can return E_NOTIMPL
  Result := E_NOTIMPL;
end;

constructor TBaseAggregatingRowset.Create(cTotalRows: UINT);
begin
  fidxRow := 1;
  fcTotalRows := cTotalRows;
  fUnkInnerSQLNCLIRowset := nil;
  SetLength(fhAccessor,1);
  fhAccessor[0] := 0;
  inherited Create;
end;

destructor TBaseAggregatingRowset.Destroy;
var pIAccessor: IAccessor;
begin
  if (fhAccessor[0]<>0) then begin
    pIAccessor := nil;
    OleCheck(fUnkInnerSQLNCLIRowset.QueryInterface(IID_IAccessor, pIAccessor));
    OleCheck(pIAccessor.ReleaseAccessor(fhAccessor[0], nil));
  end;
  inherited;
end;

function TBaseAggregatingRowset.GetData(HROW: HROW; HACCESSOR: HACCESSOR;
  pData: Pointer): HResult;
begin
  Result := S_OK;
end;

function TBaseAggregatingRowset.GetNextRows(hReserved: HCHAPTER; lRowsOffset,
  cRows: PtrInt; out pcRowsObtained: PtrUInt; var prghRows: pointer): HResult;
begin
  assert(lRowsOffset = 0);
  assert(cRows = 1);
  assert(Assigned(prghRows));
  pcRowsObtained := 0;
  // If we still have rows to give back
  if (fidxRow <= fcTotalRows) then begin
     pcRowsObtained := 1;
     // For us, row handle is simply an index in our row list
     PHROW(prghRows)^ := fidxRow;
     Inc(fidxRow);
     Result := S_OK;
  end else
     Result := DB_S_ENDOFROWSET;
end;

{$ifdef FPC}
function TBaseAggregatingRowset.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;
  {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
{$else}
function TBaseAggregatingRowset.QueryInterface(const IID: TGUID; out Obj): HResult;
{$endif FPC}
begin
  if IsEqualGUID(@IID, @IID_IUnknown) then begin
    IUnknown(Obj) := Self;
  end else begin
    if not Assigned(fUnkInnerSQLNCLIRowset) then begin
      Pointer(Obj) := nil;
      Result := E_NOINTERFACE;
      Exit;
    end;
    if IsEqualGUID(@IID, @IID_IRowset)then begin
      IUnknown(Obj) := self;
    end else begin
      Result := fUnkInnerSQLNCLIRowset.QueryInterface(IID, Obj);
      exit;
    end;
  end;
  IUnknown(Obj)._AddRef;
  Result := S_OK;
end;

function TBaseAggregatingRowset.ReleaseRows(cRows: UINT; rghRows: PPtrUIntArray;
  rgRowOptions, rgRefCounts, rgRowStatus: PCardinalArray): HResult;
begin
  assert(cRows = 1);
  assert(rghRows[0] <= fcTotalRows);
  Result := S_OK;
end;

function TBaseAggregatingRowset.RestartPosition(hReserved: HCHAPTER): HResult;
begin
  fidxRow := 1;
  Result := S_OK;
end;

procedure TBaseAggregatingRowset.SetAccessorHandle(idxAccessor: ULONG;
  hAccessor: HACCESSOR);
begin
  fhAccessor[idxAccessor] := hAccessor;
end;

{$ifdef FPC}
function TBaseAggregatingRowset._AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
{$else}
function TBaseAggregatingRowset._AddRef: Integer;
{$endif FPC}
begin
  Result := 1;
end;

{$ifdef FPC}
function TBaseAggregatingRowset._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
{$else}
function TBaseAggregatingRowset._Release: Integer;
{$endif FPC}
begin
  Result := 1;
end;

{ TIDListRowset }

constructor TIDListRowset.Create(arr: TRawUTF8DynArray; aType: TSQLDBFieldType);
begin
  farr := arr;
  fType := aType;
  inherited Create(Length(farr ));
end;

procedure TIDListRowset.FillBindingsAndSetupRowBuffer(
  pBindingsList: PDBBindingArray);
var i: Integer;
    rec: TIDListRec; // pseudo record to compute offset within TIDListRec
begin
  fillchar(rec,sizeof(rec),0); // makes Win64 compiler happy
  pBindingsList[0].pTypeInfo := nil;
  pBindingsList[0].pObject := nil;
  pBindingsList[0].pBindExt := nil;
  pBindingsList[0].eParamIO := DBPARAMIO_NOTPARAM;
  pBindingsList[0].iOrdinal := 1;
  pBindingsList[0].dwPart := DBPART_VALUE or DBPART_STATUS or DBPART_LENGTH;
  pBindingsList[0].dwMemOwner := DBMEMOWNER_CLIENTOWNED;
  pBindingsList[0].dwFlags := 0;
  case fType of
    ftInt64: begin
      pBindingsList[0].cbMaxLen := sizeof(int64);
      pBindingsList[0].obValue := PAnsiChar(@rec.IDVal)-pointer(@rec);
      pBindingsList[0].wType := DBTYPE_I8;
    end;
    ftUTF8: begin
      pBindingsList[0].cbMaxLen := sizeof(PWideChar); //Check bind ''
      for I := 0 to Length(farr)-1 do
        if Length(farr[i])*SizeOf(WideChar)>Integer(pBindingsList[0].cbMaxLen) then
          pBindingsList[0].cbMaxLen := Length(farr[i])*SizeOf(WideChar);
      pBindingsList[0].obValue := PAnsiChar(@rec.StrVal)-pointer(@rec);
      pBindingsList[0].wType := DBTYPE_BSTR
    end;
  end;
  pBindingsList[0].obStatus := PAnsiChar(@rec.IDST)-pointer(@rec);
  pBindingsList[0].obLength := PAnsiChar(@rec.IDLen)-pointer(@rec);
end;

procedure TIDListRowset.FillRowData(pCurrentRec: PIDListRec);
var curInd: Integer;
    tmp: RawUTF8;
begin
  curInd := fidxRow-2;
  if farr[curInd]='null' then begin
    pCurrentRec.IDST := ord(stIsNull);
  end else begin
    pCurrentRec.IDST := 0;
    case fType of
      ftInt64: begin
        SetInt64(pointer(farr[curInd]),pCurrentRec.IDVal);
        pCurrentRec.IDLen := SizeOf(Int64);
      end;
      ftUTF8: begin
        tmp := UnQuoteSQLString(farr[curInd]);
        pCurrentRec.IDLen := (Length(tmp)+1)*SizeOf(WideChar);
        pCurrentRec.StrVal := Pointer(UTF8ToWideString(tmp));
      end
      else raise EOleDBException.Create('Unsupported array parameter type');
    end;
  end;
end;

function TIDListRowset.GetData(HROW: HROW; HACCESSOR: HACCESSOR;
  pData: Pointer): HResult;
var currentRec: PIDListRec;
begin
  inherited GetData(HROW, HACCESSOR, pData);
  currentRec := pData;
  FillRowData(currentRec);
  Result := S_OK;
end;

function TIDListRowset.Initialize(pIOpenRowset: IOpenRowset): HRESULT;
var dbidID: DBID;
begin
  dbidID.eKind := DBKIND_GUID_NAME;
  dbidID.uGuid.guid := CLSID_ROWSET_TVP;
  case fType of
    ftInt64: dbidID.uName.pwszName := pointer(IDList_type);
    ftUTF8:  dbidID.uName.pwszName := pointer(StrList_type);
  end;
  OleCheck(pIOpenRowset.OpenRowset(self, @dbidID, nil, IID_IUnknown, 0, nil, @fUnkInnerSQLNCLIRowset));
  SetupAccessors(self as IAccessor);
  Result := S_OK;
end;

function TIDListRowset.SetupAccessors(pIAccessorIDList: IAccessor): HRESULT;
var binding: array [0..0] of TDBBinding;
    bindStatus: array [0..0] of DWORD;
    hAccessorIDList: HACCESSOR;
begin
  FillBindingsAndSetupRowBuffer(@binding);
  bindStatus[0] := 0;
  OleCheck(pIAccessorIDList.CreateAccessor(DBACCESSOR_ROWDATA, 1, @binding, SizeOf(TIDListRec),
    hAccessorIDList, @bindStatus));
  SetAccessorHandle(0, hAccessorIDList);
  Result := S_OK;
end;


initialization
  assert(sizeof(TOleDBStatementParam) and (sizeof(Int64)-1)=0);
  TOleDBConnectionProperties.RegisterClassNameForDefinition;
  TOleDBOracleConnectionProperties.RegisterClassNameForDefinition;
  TOleDBMSOracleConnectionProperties.RegisterClassNameForDefinition;
  TOleDBMSSQLConnectionProperties.RegisterClassNameForDefinition;
  TOleDBMSSQL2005ConnectionProperties.RegisterClassNameForDefinition;
  TOleDBMSSQL2008ConnectionProperties.RegisterClassNameForDefinition;
  TOleDBMSSQL2012ConnectionProperties.RegisterClassNameForDefinition;
  TOleDBMySQLConnectionProperties.RegisterClassNameForDefinition;
  {$ifndef CPU64} // Jet is not available on Win64
  TOleDBJetConnectionProperties.RegisterClassNameForDefinition;
  {$endif}
  TOleDBACEConnectionProperties.RegisterClassNameForDefinition;
  TOleDBAS400ConnectionProperties.RegisterClassNameForDefinition;
  TOleDBODBCSQLConnectionProperties.RegisterClassNameForDefinition;

finalization
  if OleDBCoinitialized<>0 then
    SynDBLog.Add.Log(sllError,'Missing TOleDBConnection.Destroy call = %',
      OleDBCoInitialized);

{$else}

implementation

{$endif MSWINDOWS} // compiles as void unit for non-Windows - allow Lazarus package

end.