// If OCI_OBJECTCOPY_NONULL is specified when freeing an instance, the null
  // structure is not freed.
  OCI_OBJECTFREE_FORCE : ub2 = $0001;
  OCI_OBJECTFREE_NONULL: ub2 = $0002;
  OCI_OBJECTFREE_HEADER: ub2 = $0004;

  OCI_PREP2_CACHE_SEARCHONLY: ub4 = $0010;

type
  /// Oracle native number low-level representation
  OCINumber = packed record
    OCINumberPart: array [0..OCI_NUMBER_SIZE-1] of ub1;
  end;

{ TSQLDBOracleLib }
................................................................................
    // 2. prepare statement
    Env := (Connection as TSQLDBOracleConnection).fEnv;
    with OCI do begin
      HandleAlloc(Env,fError,OCI_HTYPE_ERROR);
      if fUseServerSideStatementCache then begin
        if StmtPrepare2(TSQLDBOracleConnection(Connection).fContext,fStatement,
          fError,pointer(oSQL),length(oSQL),nil,0,OCI_NTV_SYNTAX,OCI_PREP2_CACHE_SEARCHONLY) = OCI_SUCCESS then
          SynDBLog.Add.Log(sllDebug, 'Statemet cache HIT')
        else begin
          Check(nil,self,StmtPrepare2(TSQLDBOracleConnection(Connection).fContext,fStatement,
            fError,pointer(oSQL),length(oSQL),nil,0,OCI_NTV_SYNTAX,OCI_DEFAULT),fError);
          SynDBLog.Add.Log(sllDebug, 'Statemet cache miss');
        end;
      end else begin
        HandleAlloc(Env,fStatement,OCI_HTYPE_STMT);
        Check(nil,self,StmtPrepare(fStatement,fError,pointer(oSQL),length(oSQL),
          OCI_NTV_SYNTAX,OCI_DEFAULT),fError);
      end;
    end;

  // If OCI_OBJECTCOPY_NONULL is specified when freeing an instance, the null
  // structure is not freed.
  OCI_OBJECTFREE_FORCE : ub2 = $0001;
  OCI_OBJECTFREE_NONULL: ub2 = $0002;
  OCI_OBJECTFREE_HEADER: ub2 = $0004;

  OCI_PREP2_CACHE_SEARCHONLY: ub4 = $0010;

type
  /// Oracle native number low-level representation
  OCINumber = packed record
    OCINumberPart: array [0..OCI_NUMBER_SIZE-1] of ub1;
  end;

{ TSQLDBOracleLib }
................................................................................
    // 2. prepare statement
    Env := (Connection as TSQLDBOracleConnection).fEnv;
    with OCI do begin
      HandleAlloc(Env,fError,OCI_HTYPE_ERROR);
      if fUseServerSideStatementCache then begin
        if StmtPrepare2(TSQLDBOracleConnection(Connection).fContext,fStatement,
          fError,pointer(oSQL),length(oSQL),nil,0,OCI_NTV_SYNTAX,OCI_PREP2_CACHE_SEARCHONLY) = OCI_SUCCESS then
          SynDBLog.Add.Log(sllDebug, 'Statement cache HIT')
        else begin
          Check(nil,self,StmtPrepare2(TSQLDBOracleConnection(Connection).fContext,fStatement,
            fError,pointer(oSQL),length(oSQL),nil,0,OCI_NTV_SYNTAX,OCI_DEFAULT),fError);
          SynDBLog.Add.Log(sllDebug, 'Statement cache miss');
        end;
      end else begin
        HandleAlloc(Env,fStatement,OCI_HTYPE_STMT);
        Check(nil,self,StmtPrepare(fStatement,fError,pointer(oSQL),length(oSQL),
          OCI_NTV_SYNTAX,OCI_DEFAULT),fError);
      end;
    end;

    raise ESQLDBZEOS.CreateUTF8('%.BindArray() not supported',[self]) else
  {$endif}
    for i := 1 to fParamCount do
    with fParams[i-1] do begin
      if (Length(VArray)>0) and (fConnection.Properties.DBMS = dPostgreSQL) then begin
        case VType of
        ftInt64, ftUTF8: VData := UTF8Array2PostgreArray(VArray);
        else raise ESQLDBZEOS.CreateUTF8('%s.ExecutePrepared: Invalid array type on bound parameter #%d', [Self,i]);
        end;
        VType := ftUTF8;
      end;
      case VType of
      ftNull:     fStatement.SetNull(i,stUnknown);
      ftInt64:    fStatement.SetLong(i,VInt64);
      ftDouble:   fStatement.SetDouble(i,PDouble(@VInt64)^);

    raise ESQLDBZEOS.CreateUTF8('%.BindArray() not supported',[self]) else
  {$endif}
    for i := 1 to fParamCount do
    with fParams[i-1] do begin
      if (Length(VArray)>0) and (fConnection.Properties.DBMS = dPostgreSQL) then begin
        case VType of
        ftInt64, ftUTF8: VData := UTF8Array2PostgreArray(VArray);
        else raise ESQLDBZEOS.CreateUTF8('%.ExecutePrepared: Invalid array type on bound parameter #%', [Self,i]);
        end;
        VType := ftUTF8;
      end;
      case VType of
      ftNull:     fStatement.SetNull(i,stUnknown);
      ftInt64:    fStatement.SetLong(i,VInt64);
      ftDouble:   fStatement.SetDouble(i,PDouble(@VInt64)^);

  The Initial Developer of the Original Code is Arnaud Bouchez.

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

  Contributor(s):


  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
................................................................................
  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,
................................................................................
  DBPROPID = UINT;
  DBPROPOPTIONS = UINT;
  DBCOLUMNFLAGS = UINT;
  DBKIND = UINT;
  DBSTATUS = DWORD;
  DBPARAMFLAGS = DWORD;
  DBTYPE = Word;
  DBRESULTFLAG = LONG;
  PBoid = ^TBoid;
{$ifdef CPU64}
  {$A+} // un-packed records
{$else}
  {$A-} // packed records
{$endif}
  TBoid = record
................................................................................
    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}']
................................................................................
  /// will implement properties shared by OleDB connections
  TOleDBConnectionProperties = class(TSQLDBConnectionPropertiesThreadSafe)
  protected
    fProviderName: RawUTF8;
    fConnectionString: SynUnicode;
    fOnCustomError: TOleDBOnCustomError;
    fSchemaRec: array of TDBSchemaRec;

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

    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;
................................................................................
    /// 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 a array if Int64 values to a parameter
    // using TABLE variable (MSSQl 2008 & UP). Type:
    // CREATE TYPE dbo.IDList AS TABLE(id bigint NULL)
    // must be declareded in the database.
    // 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). Type:
    // 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;
................................................................................
    // - 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
   fcRef: integer;
   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;
................................................................................
    // 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]);
    SetLength(IDLists, fParamCount);
    for i := 0 to fParamCount - 1 do
      IDLists[i] := nil;
    try
      // 2. bind parameters
      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
................................................................................
        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';//This type must be declared in DB

        ssPropsetParamIDList.cProperties := 1;
        ssPropsetParamIDList.guidPropertySet := DBPROPSET_SQLSERVERPARAMETER;
        ssPropsetParamIDList.rgProperties := @ssPropParamIDList;

        FillChar(ssPropParamStrList,SizeOf(ssPropParamStrList),0);
        ssPropParamStrList.dwPropertyID := SSPROP_PARAM_TYPE_TYPENAME;
        ssPropParamStrList.vValue := 'StrList';//This type must be declared in DB

        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 Length(P.VArray) >0 then begin
................................................................................
              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;
................................................................................
                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;

        OleDBConnection.OleDBCheck(self,
          (fCommand as ISSCommandWithParameters).SetParameterInfo(
            fParamCount, pointer(fParamOrdinals), pointer(fParamBindInfo)));

        if ssParamPropsCount>0 then
          OleDBConnection.OleDBCheck(self,
            (fCommand as ISSCommandWithParameters).SetParameterProperties(
              ssParamPropsCount, pointer(ssParamProps)));


        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

        OleDBConnection.OleDBCheck(self,
  //        fCommand.Execute(nil,IID_IRowset,fDBParams,@fUpdateCount,@RowSet),ParamsStatus);
  //  Use IMultipleResults for 'insert into table1 values (...); select ... from table2 where ...'
          fCommand.Execute(nil,IID_IMultipleResults,fDBParams,@fUpdateCount,@mr),ParamsStatus);


        repeat
          res := mr.GetResult(nil,0,IID_IRowset,@fUpdateCount,@RowSet);
        until Assigned(RowSet) or (res <> S_OK);




        OleDBConnection.OleDBCheck(self, res);
        FromRowSet(RowSet);
      except
        on E: Exception do begin
          CloseRowSet; // force fRowSet=nil
          raise;
        end;
      end else
................................................................................
      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);

    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
................................................................................

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

procedure TIDListRowset.FillBindingsAndSetupRowBuffer(
  pBindingsList: PDBBindingArray);
var  rec: TIDListRec;
     i: Integer;

begin

  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;
................................................................................
      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 := 'IDList';
    ftUTF8: dbidID.uName.pwszName := 'StrList';
  end;
  OleCheck(pIOpenRowset.OpenRowset(self, @dbidID, nil, IID_IUnknown, 0, nil, @fUnkInnerSQLNCLIRowset));
  OleCheck(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;

  The Initial Developer of the Original Code is Arnaud Bouchez.

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

  Contributor(s):
  - Pavel (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
................................................................................
  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,
................................................................................
  DBPROPID = UINT;
  DBPROPOPTIONS = UINT;
  DBCOLUMNFLAGS = UINT;
  DBKIND = UINT;
  DBSTATUS = DWORD;
  DBPARAMFLAGS = DWORD;
  DBTYPE = Word;
  DBRESULTFLAG = UINT;
  PBoid = ^TBoid;
{$ifdef CPU64}
  {$A+} // un-packed records
{$else}
  {$A-} // packed records
{$endif}
  TBoid = record
................................................................................
    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}']
................................................................................
  /// 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;
................................................................................
    // 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;
................................................................................
    /// 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;
................................................................................
    // - 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;
................................................................................
    // 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]);
    SetLength(IDLists, fParamCount);


    try
      // 2. bind parameters
      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
................................................................................
        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';//This type must be declared in DB

        ssPropsetParamIDList.cProperties := 1;
        ssPropsetParamIDList.guidPropertySet := DBPROPSET_SQLSERVERPARAMETER;
        ssPropsetParamIDList.rgProperties := @ssPropParamIDList;

        FillChar(ssPropParamStrList,SizeOf(ssPropParamStrList),0);
        ssPropParamStrList.dwPropertyID := SSPROP_PARAM_TYPE_TYPENAME;
        ssPropParamStrList.vValue := 'StrList';//This type must be declared in DB

        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 Length(P.VArray) >0 then begin
................................................................................
              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;
................................................................................
                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 ISSCommandWithParameters).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 begin
            repeat
              res := mr.GetResult(nil,0,IID_IRowset,@fUpdateCount,@RowSet);
            until Assigned(RowSet) or (res <> S_OK);
          end;
        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
................................................................................
      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
................................................................................

    end;
  if s<>'' then
    fOleDBErrorMessage :=  fOleDBErrorMessage+s;
  // 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
................................................................................
  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;
................................................................................
      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 := 'IDList';
    ftUTF8:  dbidID.uName.pwszName := 'StrList';
  end;
  OleCheck(pIOpenRowset.OpenRowset(self, @dbidID, nil, IID_IUnknown, 0, nil, @fUnkInnerSQLNCLIRowset));
  OleCheck(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;

'1.18.2017'

'1.18.2018'