uses
  Windows,
  ComObj,
  ActiveX,
  SysUtils,
  Variants,
  Classes,

  SynCommons;

  
{ -------------- TSQLDB* generic classes and types }

type
  /// the handled field/parameter/column types by this unit
................................................................................
  TSQLDBColumnPropertyDynArray = array of TSQLDBColumnProperty;

  TSQLDBStatement = class;

  {$M+} { published properties to be logged as JSON }

  TSQLDBConnection = class;
















































































  /// abstract class used to set Database-related properties
  // - handle e.g. the Database server location and connection parameters (like
  // UserID and password)
  // - should also provide some Database-specific generic SQL statement creation
  // (e.g. how to create a Table), to be used e.g. by the mORMot layer
  TSQLDBConnectionProperties = class
................................................................................
    /// will be called at the end of constructor
    procedure SetInternalProperties; virtual; abstract;
  public
    /// initialize the properties
    // - children may optionaly handle the fact that no UserID or Password
    // is supplied here, by displaying a corresponding Dialog box
    constructor Create(const aServerName, aDatabaseName, aUserID, aPassWord: RawUTF8);

    /// release related memory, and close MainConnection
    destructor Destroy; override;
    /// 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
    function NewConnection: TSQLDBConnection; virtual; abstract;































    /// get all field/column names for a specified Table
    // - should return a SQL "SELECT" statement with the field names as
    // first column (any other columns will be ignored)
    function SQLGetFieldNames(const aOwner, aTableName: RawUTF8): RawUTF8; virtual; abstract;
    /// used to create a Table
    // - should return the SQL "CREATE" statement needed to create a table with
................................................................................
    /// used to add a column to a Table
    // - should return the SQL "ALTER TABLE" statement needed to add a column to
    // an existing table
    function SQLAddColumn(const aOwner, aTableName: RawUTF8;
      const aField: TSQLDBColumnProperty): RawUTF8; virtual; abstract;

    /// return a shared connection, corresponding to the given
    // - call the NewConnection method instead e.g. for multi-thread access

    property MainConnection: TSQLDBConnection read GetMainConnection;
    /// the associated User Identifier, as specified at creation
    property UserID: RawUTF8 read fUserID;
    /// the associated User Password, as specified at creation
    property PassWord: RawUTF8 read fPassWord;
  published { to be logged as JSON - no UserID nor Password for security :) }
    /// the associated server name, as specified at creation
................................................................................
    /// some information message, as retrieved during execution
    property LastErrorMessage: string read fErrorMessage;
    /// some information message, as retrieved during execution
    property InfoMessage: string read fInfoMessage;
  end;

  /// generic abstract class to implement a SQL query
  TSQLDBStatement = class
  protected
    fConnection: TSQLDBConnection;
    fSQL: RawUTF8;
    fParamCount: integer;
    fColumnCount: integer;
    fTotalRowsRetrieved: Integer;

    /// raise an exception if Col is out of range according to fColumnCount
    function CheckCol(Col: integer): PSQLDBColumnProperty;
    {{ will set a Int64/Double/Currency/TDateTime/RawUTF8/TBlobData Dest variable
      from a given column value
     - internal conversion will use a temporary Variant and ColumnToVariant method
     - expects Dest to be of the exact type (e.g. Int64, not Integer) }
    function ColumnToTypedValue(Col: integer; DestType: TSQLDBFieldType; var Dest): TSQLDBFieldType;







  public
    {{ create a statement instance }
    constructor Create(aConnection: TSQLDBConnection); virtual;

    {{ bind an integer value to a parameter }

    procedure Bind(Param: Integer; Value: Int64;
      IO: TSQLDBParamInOutType=paramIn); overload; virtual; abstract;
    {{ bind a double value to a parameter }

    procedure Bind(Param: Integer; Value: double;
      IO: TSQLDBParamInOutType=paramIn); overload; virtual; abstract;
    {{ bind a TDateTime value to a parameter }

    procedure BindDateTime(Param: Integer; Value: TDateTime;
      IO: TSQLDBParamInOutType=paramIn); overload; virtual; abstract;
    {{ bind a currency value to a parameter }

    procedure BindCurrency(Param: Integer; Value: currency;
      IO: TSQLDBParamInOutType=paramIn); overload; virtual; abstract;
    {{ bind a UTF-8 encoded string to a parameter }

    procedure BindTextU(Param: Integer; const Value: RawUTF8;
      IO: TSQLDBParamInOutType=paramIn); overload; virtual; abstract;
    {{ bind a UTF-8 encoded string to a parameter }

    procedure BindTextS(Param: Integer; const Value: string;
      IO: TSQLDBParamInOutType=paramIn); overload; virtual; abstract;
    {{ bind a UTF-8 encoded string to a parameter }

    procedure BindTextW(Param: Integer; const Value: WideString;
      IO: TSQLDBParamInOutType=paramIn); overload; virtual; abstract;
    {{ bind a Blob buffer to a parameter }

    procedure BindBlob(Param: Integer; Data: pointer; Size: integer;
      IO: TSQLDBParamInOutType=paramIn); overload; virtual; abstract;
    {{ bind a Blob buffer to a parameter }

    procedure BindBlob(Param: Integer; const Data: RawByteString;
      IO: TSQLDBParamInOutType=paramIn); overload; virtual; abstract;
    {{ bind a Variant value to a parameter

     - will call all virtual Bind*() methods from the Data type
     - if DataIsBlob is TRUE, will call BindBlob(RawByteString(Data)) instead
       of BindTextW(WideString(Variant)) - used e.g. by TQuery.AsBlob/AsBytes }
    procedure BindVariant(Param: Integer; const Data: Variant; DataIsBlob: boolean;
      IO: TSQLDBParamInOutType=paramIn); virtual;

    {{ Prepare and Execute an UTF-8 encoded SQL statement
................................................................................
     - if ExpectResults is TRUE, then Step() and Column*() methods are available
       to retrieve the data rows
     - should raise an Exception on any error
     - this method will bind parameters, then call Excecute() virtual method }
    procedure Execute(const aSQL: RawUTF8; ExpectResults: Boolean;
      const Params: array of const); overload;
    {{ retrieve the parameter content, after SQL execution

     - to be used e.g. with stored procedures
     - the parameter should have been bound with IO=paramOut or IO=paramInOut

     - this implementation just check that Param is correct: overriden method
       should fill Value content }
    function ParamToVariant(Param: Integer; var Value: Variant): TSQLDBFieldType; virtual;
    {{ Access a row data of the SQL Statement result


     - 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)
     - if SeekFirst is TRUE, will put the cursor on the first row of results
     - should raise an Exception on any error }
    function Step(SeekFirst: boolean=false): boolean; virtual; abstract;

................................................................................
    {{ 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; virtual; abstract;
    {{ the Column type of the current Row }
    function ColumnType(Col: integer): TSQLDBFieldType; virtual; abstract;
    {{ return a Column integer value of the current Row, first Col is 0 }
    function ColumnInt(Col: integer): Int64; virtual; abstract;
    {{ return a Column floating point value of the current Row, first Col is 0 }
    function ColumnDouble(Col: integer): double; virtual; abstract;
    {{ return a Column floating point value of the current Row, first Col is 0 }
    function ColumnDateTime(Col: integer): TDateTime; virtual; abstract;
    {{ return a Column currency value of the current Row, first Col is 0 }
    function ColumnCurrency(Col: integer): currency; virtual; abstract;
    {{ return a Column UTF-8 encoded text value of the current Row, first Col is 0 }
    function ColumnUTF8(Col: integer): RawUTF8; virtual; abstract;
    {{ return a Column as a blob value of the current Row, first Col is 0 }
    function ColumnBlob(Col: integer): RawByteString; virtual; abstract;





















    {{ return a Column as a variant
     - this default implementation will call Column*() methods above
     - a ftUTF8 TEXT 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 BLOB content will be mapped into a TBlobData AnsiString variant }
    function ColumnToVariant(Col: integer; var Value: Variant): TSQLDBFieldType; virtual;
................................................................................
    // - similar to corresponding TSQLRequest.Execute method in SQLite3 unit
    procedure FetchAllToJSON(JSON: TStream; Expanded: boolean);

    /// the associated database connection
    property Connection: TSQLDBConnection read fConnection;
    /// the prepared SQL statement, as supplied to Prepare() method
    property SQL: RawUTF8 read fSQL;



    /// the total number of data rows retrieved by this instance
    // - is not reset when there is no more row of available data (Step returns
    // false), or when Step() is called with SeekFirst=true
    property TotalRowsRetrieved: Integer read fTotalRowsRetrieved;
  end;





































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


const
................................................................................

  TOleDBConnection = class;

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

  /// will implement properties shared by OleDB connections
  TOleDBConnectionProperties = class(TSQLDBConnectionProperties)
  protected
    fProviderName: RawUTF8;
    fConnectionString: SynUnicode;
    fOnCustomError: TOleDBOnCustomError;
    /// will create the generic fConnectionString from supplied parameters
    procedure SetInternalProperties; override;
  public
................................................................................
    /// 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(TSQLDBConnection)
  protected
    fMalloc: IMalloc;
    fDBInitialize: IDBInitialize;
    fTransaction: ITransactionLocal;
    fSession: IUnknown;
    fOleDBProperties: TOleDBConnectionProperties;
    function IsConnected: boolean; override;
................................................................................
     - parameters marked as ? should have been already bound with Bind*()
       functions below
     - if ExpectResults is TRUE, then Step() and Column*() methods are available
       to retrieve the data rows
     - raise an EOleDBException on any error }
    procedure Execute(const aSQL: RawUTF8; ExpectResults: Boolean); override;
    {{ retrieve the parameter content, after SQL execution

     - 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): TSQLDBFieldType; override;


    {{ Evaluate a SQL Statement

     - return true on success, with data ready to be retrieved by Column*() methods
     - return false if no more row is available (e.g. if the SQL statement
      is not a SELECT but an UPDATE or INSERT command)
     - if SeekFirst is TRUE, will put the cursor on the first row of results
     - raise an ESQLEOleDBException on any error }
    function Step(SeekFirst: boolean=false): boolean; override;
    {{ retrieve a column name of the current Row
................................................................................
      with fParams[i] do
      if fColumnIndex>0 then // leftmost SQL parameter has an index of 1
        fPrepared.BindVariant(fColumnIndex,fValue,fValueBlob,DB2OLE[ParamType]);
    except
      on E: Exception do
        raise ESQLQueryException.CreateFmt(
          'Error "%s" at binding value for parameter "%s" in "%s"',
          [E.Message,fParams[i-1].fName,req]);
    end;
  fPrepared.Execute(new,ExpectResults);
end;

{$endif EMULATES_TQUERY}


................................................................................
end;

destructor TSQLDBConnectionProperties.Destroy;
begin
  FreeAndNil(fMainConnection);
  inherited;
end;























function TSQLDBConnectionProperties.GetMainConnection: TSQLDBConnection;
begin
  if self=nil then
    result := nil else begin
    if fMainConnection=nil then
      fMainConnection := NewConnection;
    result := fMainConnection;
  end;
end;

































































{ TSQLDBStatement }

function TSQLDBStatement.CheckCol(Col: integer): PSQLDBColumnProperty;
begin
  if (self=nil) or (cardinal(Col)>=cardinal(fColumnCount)) then
    raise EOleDBException.CreateFmt('Invalid call to Column*(Col=%d)',[Col]);
................................................................................
  fConnection := aConnection;
end;

function TSQLDBStatement.ColumnCount: integer;
begin
  result := fColumnCount;
end;






function TSQLDBFieldTypeToString(aType: TSQLDBFieldType): string;
var PS: PShortString;
begin
  if cardinal(aType)<=Cardinal(high(aType)) then begin
    PS := GetEnumName(TypeInfo(TSQLDBFieldType),ord(aType));
    result := Ansi7ToString(@PS^[3],ord(PS^[0])-2);
................................................................................
  ftUTF8:     RawUTF8(Dest) := StringToUTF8(Temp);
  ftBlob:     TBlobData(Dest) := TBlobData(Temp);
    else raise EOleDBException.CreateFmt('%s.ColumnToTypedValue: Invalid Type "%s"',
      [ClassName,TSQLDBFieldTypeToString(result)]);
  end;
end;

function TSQLDBStatement.ParamToVariant(Param: Integer; var Value: Variant): TSQLDBFieldType;

begin

  if (self=nil) or (cardinal(Param)>=cardinal(fParamCount)) then
    raise EOleDBException.CreateFmt('ParamToVariant(%d)',[Param]);
  // overriden method should fill Value with proper data
  result := ftUnknown;
end;

procedure TSQLDBStatement.Execute(const aSQL: RawUTF8; ExpectResults: Boolean);
................................................................................
    if DataIsBlob then
      // no conversion if was set via TQuery.AsBlob property e.g.
      BindBlob(Param,RawByteString(Data),IO) else
      // also use TEXT for any non native VType parameter
      BindTextW(Param,WideString(Data),IO);
  end;
end;






































































































{ TOleDBStatement }

procedure TOleDBStatement.BindTextU(Param: Integer; const Value: RawUTF8;
  IO: TSQLDBParamInOutType=paramIn);
begin
  CheckParam(Param,ftUTF8,IO)^.VText := UTF8ToWideString(Value);
................................................................................
    WR.Add(',');
  end;
  WR.CancelLastComma; // cancel last ','
  if WR.Expand then
    WR.Add('}');
end;

function TOleDBStatement.ParamToVariant(Param: Integer; var Value: Variant): TSQLDBFieldType;

begin
  inherited ParamToVariant(Param,Value); // raise exception if Param incorrect

  if fParams[Param].VInOut=paramIn then
    raise EOleDBException.CreateFmt('%s.ParamToVariant expects an [In]Out parameter',[ClassName]);
  // 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
................................................................................
begin
  Log := OleDBSynLogClass.Enter(self);
  try
    if Assigned(fCommand) or Assigned(fRowSet) or (fColumnCount>0) or
       (fColumnBindings<>nil) or (fParamBindings<>nil) then
      raise EOleDBException.CreateFmt('%s.Execute should be called only once',[ClassName]);
    // 1. prepare command
    Log.Log(sllSQL,aSQL,self);
    inherited; // fSQL := aSQL



    with OleDBConnection do begin
      if not IsConnected then
        Connect;
      OleDBCheck((fSession as IDBCreateCommand).
        CreateCommand(nil,IID_ICommandText,ICommand(fCommand)));
    end;
    L := Length(aSQL);
................................................................................
  finally
    OleDBConnection.fMalloc.Free(Cols);
    OleDBConnection.fMalloc.Free(ColsNames);
  end;
end;

{ TOleDBConnection }



















procedure TOleDBConnection.Connect;
var DataInitialize : IDataInitialize;
    unknown: IUnknown;
    Log: ISynLog;
begin
  Log := OleDBSynLogClass.Enter(self);
................................................................................
begin
  Log := OleDBSynLogClass.Enter(self);
  if not aProperties.InheritsFrom(TOleDBConnectionProperties) then
    raise EOleDBException.CreateFmt('Invalid %s.Create',[ClassName]);
  Log.Log(sllInfo,aProperties);
  fOleDBProperties := TOleDBConnectionProperties(aProperties);
  inherited;

  OleCheck(CoGetMalloc(1,fMalloc));
end;

destructor TOleDBConnection.Destroy;
var Log: ISynLog;
begin
  Log := OleDBSynLogClass.Enter(self);
  try
    inherited Destroy;
    fMalloc := nil;

  except
    on E: Exception do
      Log.Log(sllError,E);
  end;
end;

procedure TOleDBConnection.Disconnect;
................................................................................
    tmp: PWideChar;
    Log: ISynLog;
begin
  Log := OleDBSynLogClass.Enter(self);
  result := false;
  if self<>nil then
  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);
      Log.Log(sllInfo,'New connection settings set',self);
      result := true;
    end;
    DB_E_CANCELED:
      Log.Log(sllInfo,'Canceled',self);
    else OleCheck(res);



    end;
  except
    on E: Exception do 
      Log.Log(sllError,E);
  end;
end;

................................................................................

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


var st: TOleDBStatus;
initialization
  assert(sizeof(TOleDBStatementParam)=sizeof(PTrUInt)*4+sizeof(Int64));
  assert(SizeOf(TSQLDBColumnProperty)=sizeof(PtrUint)*2+4);
  for st := Low(st) to High(st) do
    OLEDBSTATUS_CAPTION[ord(st)] := UnCamelCase(TrimLeftLowerCase(
      GetEnumName(TypeInfo(TOleDBStatus),ord(st))));
  CoInitialize(nil);

finalization


  CoUninitialize;
end.

uses
  Windows,
  ComObj,
  ActiveX,
  SysUtils,
  Variants,
  Classes,
  Contnrs,
  SynCommons;

  
{ -------------- TSQLDB* generic classes and types }

type
  /// the handled field/parameter/column types by this unit
................................................................................
  TSQLDBColumnPropertyDynArray = array of TSQLDBColumnProperty;

  TSQLDBStatement = class;

  {$M+} { published properties to be logged as JSON }

  TSQLDBConnection = class;

  /// generic interface to access a SQL query result rows
  // - not all TSQLDBStatement methods are available, but only those to retrieve
  // data from a statement result: the purpose of this interface is to make easy
  // some simple inline statements, not provide all available features - i.e.
  // you only have access to the Step() and Column*() methods
  ISQLDBRows = interface
    ['{11291095-9C15-4984-9118-974F1926DB9F}']
    {{ Access the next or first row of data from the SQL Statement result
     - 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)
     - if SeekFirst is TRUE, will put the cursor on the first row of results
     - should raise an Exception on any error }
    function Step(SeekFirst: boolean=false): boolean; 
    {{ the column/field count of the current Row }
    function ColumnCount: integer;
    {{ the 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;
    {{ 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;
    {{ the Column type of the current Row }
    function ColumnType(Col: integer): TSQLDBFieldType; overload;
    {{ return a Column integer value of the current Row, first Col is 0 }
    function ColumnInt(Col: integer): Int64; overload;
    {{ return a Column floating point value of the current Row, first Col is 0 }
    function ColumnDouble(Col: integer): double; overload;
    {{ return a Column floating point value of the current Row, first Col is 0 }
    function ColumnDateTime(Col: integer): TDateTime; overload;
    {{ return a Column currency value of the current Row, first Col is 0 }
    function ColumnCurrency(Col: integer): currency; overload;
    {{ return a Column UTF-8 encoded text value of the current Row, first Col is 0 }
    function ColumnUTF8(Col: integer): RawUTF8; overload;
    {{ return a Column as a blob value of the current Row, first Col is 0 }
    function ColumnBlob(Col: integer): RawByteString; overload;
    {{ return a Column as a variant
     - a ftUTF8 TEXT 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 BLOB content will be mapped into a TBlobData AnsiString variant }
    function ColumnVariant(Col: integer): Variant; overload;
    {{ return a Column integer value of the current Row, first Col is 0 }
    function ColumnInt(const ColName: RawUTF8): Int64; overload;
    {{ return a Column floating point value of the current Row, first Col is 0 }
    function ColumnDouble(const ColName: RawUTF8): double; overload;
    {{ return a Column floating point value of the current Row, first Col is 0 }
    function ColumnDateTime(const ColName: RawUTF8): TDateTime; overload;
    {{ return a Column currency value of the current Row, first Col is 0 }
    function ColumnCurrency(const ColName: RawUTF8): currency; overload;
    {{ return a Column UTF-8 encoded text value of the current Row, first Col is 0 }
    function ColumnUTF8(const ColName: RawUTF8): RawUTF8; overload;
    {{ return a Column as a blob value of the current Row, first Col is 0 }
    function ColumnBlob(const ColName: RawUTF8): RawByteString; overload;
    {{ return a Column as a variant }
    function ColumnVariant(const ColName: RawUTF8): Variant; overload;
    {{ return a Column as a variant
      - since a property getter can't be an overloaded method, we define one
      for the Column[] property }
    function GetColumnVariant(const ColName: RawUTF8): Variant;
    /// return the associated statement instance
    function Instance: TSQLDBStatement;
    {{ return a Column as a variant
      - this default property can be used to write simple code like this:
       ! procedure WriteFamily(const aName: RawUTF8);
       ! var I: ISQLDBRows;
       ! begin
       !   I := MyConnProps.Execute('select * from table where name=?',[aName]);
       !   while I.Step do
       !     writeln(I['FirstName'],' ',DateToStr(I['BirthDate']));
       ! end;
      - of course, using a variant and a column name will be a bit slower than
       direct access via the Column*() dedicated methods, but resulting code
       is fast in practice }
    property Column[const ColName: RawUTF8]: Variant read GetColumnVariant; default;
  end;

  /// abstract class used to set Database-related properties
  // - handle e.g. the Database server location and connection parameters (like
  // UserID and password)
  // - should also provide some Database-specific generic SQL statement creation
  // (e.g. how to create a Table), to be used e.g. by the mORMot layer
  TSQLDBConnectionProperties = class
................................................................................
    /// will be called at the end of constructor
    procedure SetInternalProperties; virtual; abstract;
  public
    /// initialize the properties
    // - children may optionaly handle the fact that no UserID or Password
    // is supplied here, by displaying a corresponding Dialog box
    constructor Create(const aServerName, aDatabaseName, aUserID, aPassWord: RawUTF8);
      virtual;
    /// release related memory, and close MainConnection
    destructor Destroy; override;
    /// 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
    function NewConnection: TSQLDBConnection; virtual; abstract;
    /// create a new thread-safe connection
    // - this default implementation will return the MainConnection shared
    // instance, so the provider should be thread-safe by itself
    // - TSQLDBConnectionPropertiesThreadSafe will implement a per-thread
    // connection pool, via an internal TSQLDBConnection pool, per thread
    // if necessary (e.g. for OleDB, which expect one TOleDBConnection instance
    // per thread)
    function NewThreadSafeConnection: TSQLDBConnection; virtual;
    /// create a new thread-safe statement
    // - this implementation will call the NewThreadSafeConnection virtual method
    function NewThreadSafeStatement: TSQLDBStatement;
    /// execute a SQL query, returning a statement interface instance to retrieve
    // the result rows
    // - will call NewThreadSafeStatement method to retrieve a thread-safe
    // statement instance, then run the corresponding Execute() method
    // - returns an ISQLDBRows to access any resulting rows (if
    // ExpectResults is TRUE), and provide basic garbage collection, as such:
    // ! procedure WriteFamily(const aName: RawUTF8);
    // ! var I: ISQLDBRows;
    // ! begin
    // !   I := MyConnProps.Execute('select * from table where name=?',[aName]);
    // !   while I.Step do
    // !     writeln(I['FirstName'],' ',DateToStr(I['BirthDate']));
    // ! end;
    function Execute(const aSQL: RawUTF8; const Params: array of const): ISQLDBRows;
    /// execute a SQL query, without returning any rows
    // - can be used to launch INSERT or UPDATE queries, e.g.
    // - will call NewThreadSafeStatement method to retrieve a thread-safe
    // statement instance, then run the corresponding Execute() method
    procedure ExecuteDirect(const aSQL: RawUTF8; const Params: array of const); 

    /// get all field/column names for a specified Table
    // - should return a SQL "SELECT" statement with the field names as
    // first column (any other columns will be ignored)
    function SQLGetFieldNames(const aOwner, aTableName: RawUTF8): RawUTF8; virtual; abstract;
    /// used to create a Table
    // - should return the SQL "CREATE" statement needed to create a table with
................................................................................
    /// used to add a column to a Table
    // - should return the SQL "ALTER TABLE" statement needed to add a column to
    // an existing table
    function SQLAddColumn(const aOwner, aTableName: RawUTF8;
      const aField: TSQLDBColumnProperty): RawUTF8; virtual; abstract;

    /// return a shared connection, corresponding to the given
    // - call the NewThreadSafeConnection method instead e.g. for multi-thread
    // access, or NewThreadSafeStatement for direct retrieval of a statement 
    property MainConnection: TSQLDBConnection read GetMainConnection;
    /// the associated User Identifier, as specified at creation
    property UserID: RawUTF8 read fUserID;
    /// the associated User Password, as specified at creation
    property PassWord: RawUTF8 read fPassWord;
  published { to be logged as JSON - no UserID nor Password for security :) }
    /// the associated server name, as specified at creation
................................................................................
    /// some information message, as retrieved during execution
    property LastErrorMessage: string read fErrorMessage;
    /// some information message, as retrieved during execution
    property InfoMessage: string read fInfoMessage;
  end;

  /// generic abstract class to implement a SQL query
  TSQLDBStatement = class(TInterfacedObject, ISQLDBRows)
  protected
    fConnection: TSQLDBConnection;
    fSQL: RawUTF8;
    fParamCount: integer;
    fColumnCount: integer;
    fTotalRowsRetrieved: Integer;
    function GetSQLWithInlinedParams: RawUTF8;
    /// raise an exception if Col is out of range according to fColumnCount
    function CheckCol(Col: integer): PSQLDBColumnProperty;
    {{ will set a Int64/Double/Currency/TDateTime/RawUTF8/TBlobData Dest variable
      from a given column value
     - internal conversion will use a temporary Variant and ColumnToVariant method
     - expects Dest to be of the exact type (e.g. Int64, not Integer) }
    function ColumnToTypedValue(Col: integer; DestType: TSQLDBFieldType; var Dest): TSQLDBFieldType;
    {{ retrieve the inlined value of a given parameter, e.g. 1 or 'name'
    - use ParamToVariant() virtual method }
    function GetParamValueAsText(Param: integer): RawUTF8; virtual; 
    {{ return a Column as a variant }
    function GetColumnVariant(const ColName: RawUTF8): Variant; 
    /// return the associated statement instance for a ISQLDBRows interface
    function Instance: TSQLDBStatement;
  public
    {{ create a statement instance }
    constructor Create(aConnection: TSQLDBConnection); virtual;

    {{ bind an integer value to a parameter
     - the leftmost SQL parameter has an index of 1 }
    procedure Bind(Param: Integer; Value: Int64;
      IO: TSQLDBParamInOutType=paramIn); overload; virtual; abstract;
    {{ bind a double value to a parameter
     - the leftmost SQL parameter has an index of 1 }
    procedure Bind(Param: Integer; Value: double;
      IO: TSQLDBParamInOutType=paramIn); overload; virtual; abstract;
    {{ bind a TDateTime value to a parameter
     - the leftmost SQL parameter has an index of 1 }
    procedure BindDateTime(Param: Integer; Value: TDateTime;
      IO: TSQLDBParamInOutType=paramIn); overload; virtual; abstract;
    {{ bind a currency value to a parameter
     - the leftmost SQL parameter has an index of 1 }
    procedure BindCurrency(Param: Integer; Value: currency;
      IO: TSQLDBParamInOutType=paramIn); overload; virtual; abstract;
    {{ bind a UTF-8 encoded string to a parameter
     - the leftmost SQL parameter has an index of 1 }
    procedure BindTextU(Param: Integer; const Value: RawUTF8;
      IO: TSQLDBParamInOutType=paramIn); overload; virtual; abstract;
    {{ bind a UTF-8 encoded string to a parameter
     - the leftmost SQL parameter has an index of 1 }
    procedure BindTextS(Param: Integer; const Value: string;
      IO: TSQLDBParamInOutType=paramIn); overload; virtual; abstract;
    {{ bind a UTF-8 encoded string to a parameter
     - the leftmost SQL parameter has an index of 1 }
    procedure BindTextW(Param: Integer; const Value: WideString;
      IO: TSQLDBParamInOutType=paramIn); overload; virtual; abstract;
    {{ bind a Blob buffer to a parameter
     - the leftmost SQL parameter has an index of 1 }
    procedure BindBlob(Param: Integer; Data: pointer; Size: integer;
      IO: TSQLDBParamInOutType=paramIn); overload; virtual; abstract;
    {{ bind a Blob buffer to a parameter
     - the leftmost SQL parameter has an index of 1 }
    procedure BindBlob(Param: Integer; const Data: RawByteString;
      IO: TSQLDBParamInOutType=paramIn); overload; virtual; abstract;
    {{ bind a Variant value to a parameter
     - the leftmost SQL parameter has an index of 1 
     - will call all virtual Bind*() methods from the Data type
     - if DataIsBlob is TRUE, will call BindBlob(RawByteString(Data)) instead
       of BindTextW(WideString(Variant)) - used e.g. by TQuery.AsBlob/AsBytes }
    procedure BindVariant(Param: Integer; const Data: Variant; DataIsBlob: boolean;
      IO: TSQLDBParamInOutType=paramIn); virtual;

    {{ Prepare and Execute an UTF-8 encoded SQL statement
................................................................................
     - if ExpectResults is TRUE, then Step() and Column*() methods are available
       to retrieve the data rows
     - should raise an Exception on any error
     - this method will bind parameters, then call Excecute() virtual method }
    procedure Execute(const aSQL: RawUTF8; ExpectResults: Boolean;
      const Params: array of const); overload;
    {{ retrieve the parameter content, after SQL execution
     - the leftmost SQL parameter has an index of 1 
     - to be used e.g. with stored procedures
     - the parameter should have been bound with IO=paramOut or IO=paramInOut
       if CheckIsOutParameter is TRUE
     - this implementation just check that Param is correct: overriden method
       should fill Value content }
    function ParamToVariant(Param: Integer; var Value: Variant;

      CheckIsOutParameter: boolean=true): TSQLDBFieldType; virtual;
    {{ Access the next or first row of data from the SQL Statement result
     - 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)
     - if SeekFirst is TRUE, will put the cursor on the first row of results
     - should raise an Exception on any error }
    function Step(SeekFirst: boolean=false): boolean; virtual; abstract;

................................................................................
    {{ 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; virtual; abstract;
    {{ the Column type of the current Row }
    function ColumnType(Col: integer): TSQLDBFieldType; virtual; abstract;
    {{ return a Column integer value of the current Row, first Col is 0 }
    function ColumnInt(Col: integer): Int64; overload; virtual; abstract;
    {{ return a Column floating point value of the current Row, first Col is 0 }
    function ColumnDouble(Col: integer): double; overload; virtual; abstract;
    {{ return a Column floating point value of the current Row, first Col is 0 }
    function ColumnDateTime(Col: integer): TDateTime; overload; virtual; abstract;
    {{ return a Column currency value of the current Row, first Col is 0 }
    function ColumnCurrency(Col: integer): currency; overload; virtual; abstract;
    {{ return a Column UTF-8 encoded text value of the current Row, first Col is 0 }
    function ColumnUTF8(Col: integer): RawUTF8; overload; virtual; abstract;
    {{ return a Column as a blob value of the current Row, first Col is 0 }
    function ColumnBlob(Col: integer): RawByteString; overload; virtual; abstract;
    {{ return a Column as a variant
     - this default implementation will call ColumnToVariant() method
     - a ftUTF8 TEXT 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 BLOB content will be mapped into a TBlobData AnsiString variant }
    function ColumnVariant(Col: integer): Variant; overload;
    {{ return a Column integer value of the current Row, first Col is 0 }
    function ColumnInt(const ColName: RawUTF8): Int64; overload;
    {{ return a Column floating point value of the current Row, first Col is 0 }
    function ColumnDouble(const ColName: RawUTF8): double; overload;
    {{ return a Column floating point value of the current Row, first Col is 0 }
    function ColumnDateTime(const ColName: RawUTF8): TDateTime; overload;
    {{ return a Column currency value of the current Row, first Col is 0 }
    function ColumnCurrency(const ColName: RawUTF8): currency; overload;
    {{ return a Column UTF-8 encoded text value of the current Row, first Col is 0 }
    function ColumnUTF8(const ColName: RawUTF8): RawUTF8; overload;
    {{ return a Column as a blob value of the current Row, first Col is 0 }
    function ColumnBlob(const ColName: RawUTF8): RawByteString; overload;
    {{ return a Column as a variant }
    function ColumnVariant(const ColName: RawUTF8): Variant; overload;
    {{ return a Column as a variant
     - this default implementation will call Column*() methods above
     - a ftUTF8 TEXT 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 BLOB content will be mapped into a TBlobData AnsiString variant }
    function ColumnToVariant(Col: integer; var Value: Variant): TSQLDBFieldType; virtual;
................................................................................
    // - similar to corresponding TSQLRequest.Execute method in SQLite3 unit
    procedure FetchAllToJSON(JSON: TStream; Expanded: boolean);

    /// the associated database connection
    property Connection: TSQLDBConnection read fConnection;
    /// the prepared SQL statement, as supplied to Prepare() method
    property SQL: RawUTF8 read fSQL;
    /// the prepared SQL statement, with all '?' changed into the supplied
    // parameter values
    property SQLWithInlinedParams: RawUTF8 read GetSQLWithInlinedParams;
    /// the total number of data rows retrieved by this instance
    // - is not reset when there is no more row of available data (Step returns
    // false), or when Step() is called with SeekFirst=true
    property TotalRowsRetrieved: Integer read fTotalRowsRetrieved;
  end;

  /// abstract connection created from TSQLDBConnectionProperties
  // - this overriden class will defined an hidden thread ID, to ensure
  // that one connection will be create per thread
  // - an Ole DB connection will inherit from this class
  TSQLDBConnectionThreadSafe = class(TSQLDBConnection)
  protected
    fThreadID: DWORD;
  end;

  TSQLDBConnectionPropertiesThreadSafe = class(TSQLDBConnectionProperties)
  protected
    fConnectionPool: TObjectList;
    /// returns nil if none was defined yet
    function CurrentThreadConnection: TSQLDBConnection;
    /// returns -1 if none was defined yet
    function CurrentThreadConnectionIndex: Integer;
  public
    /// initialize the properties
    // - this overriden method will initialize the internal per-thread connection
    // pool
    constructor Create(const aServerName, aDatabaseName, aUserID, aPassWord: RawUTF8);
      override;
    /// release related memory, and all per-thread connections
    destructor Destroy; override;
    /// create a new thread-safe connection
    // - this overriden implementation will define a per-thread TSQLDBConnection
    // connection pool, via an internal  pool
    function NewThreadSafeConnection: TSQLDBConnection; override;
    /// you can call this method just before a thread is finished to ensure
    // that the associated Connection will be released
    // - could be used e.g. in a try...finally block inside a TThread.Execute
    // overriden method
    procedure EndCurrentThread;
  end;


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


const
................................................................................

  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;
    /// will create the generic fConnectionString from supplied parameters
    procedure SetInternalProperties; override;
  public
................................................................................
    /// 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;
    function IsConnected: boolean; override;
................................................................................
     - parameters marked as ? should have been already bound with Bind*()
       functions below
     - if ExpectResults is TRUE, then Step() and Column*() methods are available
       to retrieve the data rows
     - raise an EOleDBException on any error }
    procedure Execute(const aSQL: RawUTF8; ExpectResults: Boolean); 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;


    {{ Access the next or first row of data from the SQL Statement result
     - return true on success, with data ready to be retrieved by Column*() methods
     - return false if no more row is available (e.g. if the SQL statement
      is not a SELECT but an UPDATE or INSERT command)
     - if SeekFirst is TRUE, will put the cursor on the first row of results
     - raise an ESQLEOleDBException on any error }
    function Step(SeekFirst: boolean=false): boolean; override;
    {{ retrieve a column name of the current Row
................................................................................
      with fParams[i] do
      if fColumnIndex>0 then // leftmost SQL parameter has an index of 1
        fPrepared.BindVariant(fColumnIndex,fValue,fValueBlob,DB2OLE[ParamType]);
    except
      on E: Exception do
        raise ESQLQueryException.CreateFmt(
          'Error "%s" at binding value for parameter "%s" in "%s"',
          [E.Message,fParams[i].fName,UTF8ToString(fPrepared.SQLWithInlinedParams)]);
    end;
  fPrepared.Execute(new,ExpectResults);
end;

{$endif EMULATES_TQUERY}


................................................................................
end;

destructor TSQLDBConnectionProperties.Destroy;
begin
  FreeAndNil(fMainConnection);
  inherited;
end;

function TSQLDBConnectionProperties.Execute(const aSQL: RawUTF8;
  const Params: array of const): ISQLDBRows;
var Query: TSQLDBStatement;
begin
  OleDBSynLogClass.Enter(self);
  Query := NewThreadSafeStatement;
  Query.Execute(aSQL,true,Params);
  result := Query;
end;

procedure TSQLDBConnectionProperties.ExecuteDirect(const aSQL: RawUTF8;
  const Params: array of const);
begin
  OleDBSynLogClass.Enter(self);
  with NewThreadSafeStatement do
  try
    Execute(aSQL,false,Params);
  finally
    Free;
  end;
end;

function TSQLDBConnectionProperties.GetMainConnection: TSQLDBConnection;
begin
  if self=nil then
    result := nil else begin
    if fMainConnection=nil then
      fMainConnection := NewConnection;
    result := fMainConnection;
  end;
end;

function TSQLDBConnectionProperties.NewThreadSafeConnection: TSQLDBConnection;
begin
  result := MainConnection; // provider should be thread-safe
end;

function TSQLDBConnectionProperties.NewThreadSafeStatement: TSQLDBStatement;
begin
  result := NewThreadSafeConnection.NewStatement;
end;


{ TSQLDBConnectionPropertiesThreadSafe }

constructor TSQLDBConnectionPropertiesThreadSafe.Create(const aServerName,
  aDatabaseName, aUserID, aPassWord: RawUTF8);
begin
  fConnectionPool := TObjectList.Create;
  inherited;
end;

function TSQLDBConnectionPropertiesThreadSafe.CurrentThreadConnection: TSQLDBConnection;
var i: integer;
begin
  i := CurrentThreadConnectionIndex;
  if i<0 then
    result := nil else
    result := fConnectionPool.List[i];
end;

function TSQLDBConnectionPropertiesThreadSafe.CurrentThreadConnectionIndex: Integer;
var ID: DWORD;
begin
  ID := GetCurrentThreadId;
  if self<>nil then
  for result := 0 to fConnectionPool.Count-1 do
    if TSQLDBConnectionThreadSafe(fConnectionPool.List[result]).fThreadID=ID then
      exit;
  result := -1;
end;

destructor TSQLDBConnectionPropertiesThreadSafe.Destroy;
begin
  FreeAndNil(fConnectionPool);
  inherited;
end;

procedure TSQLDBConnectionPropertiesThreadSafe.EndCurrentThread;
var i: integer;
begin
  i := CurrentThreadConnectionIndex;
  if i>=0 then
    fConnectionPool.Delete(i);
end;

function TSQLDBConnectionPropertiesThreadSafe.NewThreadSafeConnection: TSQLDBConnection;
begin
  result := CurrentThreadConnection;
  if result<>nil then
    exit;
  result := NewConnection;
  (result as TSQLDBConnectionThreadSafe).fThreadID := GetCurrentThreadId;
  fConnectionPool.Add(result);
end;

{ TSQLDBStatement }

function TSQLDBStatement.CheckCol(Col: integer): PSQLDBColumnProperty;
begin
  if (self=nil) or (cardinal(Col)>=cardinal(fColumnCount)) then
    raise EOleDBException.CreateFmt('Invalid call to Column*(Col=%d)',[Col]);
................................................................................
  fConnection := aConnection;
end;

function TSQLDBStatement.ColumnCount: integer;
begin
  result := fColumnCount;
end;

function TSQLDBStatement.ColumnVariant(Col: integer): Variant;
begin
  ColumnToVariant(Col,result);
end;

function TSQLDBFieldTypeToString(aType: TSQLDBFieldType): string;
var PS: PShortString;
begin
  if cardinal(aType)<=Cardinal(high(aType)) then begin
    PS := GetEnumName(TypeInfo(TSQLDBFieldType),ord(aType));
    result := Ansi7ToString(@PS^[3],ord(PS^[0])-2);
................................................................................
  ftUTF8:     RawUTF8(Dest) := StringToUTF8(Temp);
  ftBlob:     TBlobData(Dest) := TBlobData(Temp);
    else raise EOleDBException.CreateFmt('%s.ColumnToTypedValue: Invalid Type "%s"',
      [ClassName,TSQLDBFieldTypeToString(result)]);
  end;
end;

function TSQLDBStatement.ParamToVariant(Param: Integer; var Value: Variant;
  CheckIsOutParameter: boolean=true): TSQLDBFieldType;
begin
  dec(Param); // start at #1
  if (self=nil) or (cardinal(Param)>=cardinal(fParamCount)) then
    raise EOleDBException.CreateFmt('ParamToVariant(%d)',[Param]);
  // overriden method should fill Value with proper data
  result := ftUnknown;
end;

procedure TSQLDBStatement.Execute(const aSQL: RawUTF8; ExpectResults: Boolean);
................................................................................
    if DataIsBlob then
      // no conversion if was set via TQuery.AsBlob property e.g.
      BindBlob(Param,RawByteString(Data),IO) else
      // also use TEXT for any non native VType parameter
      BindTextW(Param,WideString(Data),IO);
  end;
end;

function TSQLDBStatement.ColumnBlob(const ColName: RawUTF8): RawByteString;
begin
  result := ColumnBlob(ColumnIndex(ColName));
end;

function TSQLDBStatement.ColumnCurrency(const ColName: RawUTF8): currency;
begin
  result := ColumnCurrency(ColumnIndex(ColName));
end;

function TSQLDBStatement.ColumnDateTime(const ColName: RawUTF8): TDateTime;
begin
  result := ColumnDateTime(ColumnIndex(ColName));
end;

function TSQLDBStatement.ColumnDouble(const ColName: RawUTF8): double;
begin
  result := ColumnDouble(ColumnIndex(ColName));
end;

function TSQLDBStatement.ColumnInt(const ColName: RawUTF8): Int64;
begin
  result := ColumnInt(ColumnIndex(ColName));
end;

function TSQLDBStatement.ColumnUTF8(const ColName: RawUTF8): RawUTF8;
begin
  result := ColumnUTF8(ColumnIndex(ColName));
end;

function TSQLDBStatement.ColumnVariant(const ColName: RawUTF8): Variant;
begin
  ColumnToVariant(ColumnIndex(ColName),result);
end;

function TSQLDBStatement.GetColumnVariant(const ColName: RawUTF8): Variant;
begin
  ColumnToVariant(ColumnIndex(ColName),result);
end;

function TSQLDBStatement.Instance: TSQLDBStatement;
begin
  Result := Self;
end;

function TSQLDBStatement.GetSQLWithInlinedParams: RawUTF8;
var P,B: PAnsiChar;
    tmp: RawUTF8;
    num: integer;
begin
  result := '';
  num := 0;
  P := PAnsiChar(fSQL); // P^ := ' ' below -> ensure unique
  if P<>nil then
  repeat
    B := P;
    while not (P^ in ['?',#0]) do begin
      case P^ of
      '''':
        if P[1]<>'''' then begin
          repeat // ignore chars inside ' quotes
            inc(P);
          until P^ in ['''',#0];
          if P^=#0 then break;
        end;
      #1..#31:
        P^ := ' '; // convert #13/#10 into ' '
      end;
      inc(P);
    end;
    SetString(tmp,B,P-B);
    if P^=#0 then begin
      result := result+tmp;
      exit;
    end;
    inc(num);
    result := result+tmp+GetParamValueAsText(num); // Params start at #1
    inc(P); // jump '?'
  until P^=#0;
end;

function TSQLDBStatement.GetParamValueAsText(Param: integer): RawUTF8;
var V: Variant;
begin
  if cardinal(Param-1)>=cardinal(fParamCount) then
    result := '???' else begin
    case ParamToVariant(Param,V,false) of
    ftNull: result := 'NULL';
    ftDate: result := DateTimeToIso8601(V,True,' ');
    ftUTF8: begin
      result := V;
      if length(result)>4096 then // truncate in log
        result := copy(result,1,4096)+'...';
      result := ''''+result+'''';
    end;
    ftBlob: result := '*BLOB*';
    else    result := V;
    end;
  end;
end;

{ TOleDBStatement }

procedure TOleDBStatement.BindTextU(Param: Integer; const Value: RawUTF8;
  IO: TSQLDBParamInOutType=paramIn);
begin
  CheckParam(Param,ftUTF8,IO)^.VText := UTF8ToWideString(Value);
................................................................................
    WR.Add(',');
  end;
  WR.CancelLastComma; // cancel last ','
  if WR.Expand then
    WR.Add('}');
end;

function TOleDBStatement.ParamToVariant(Param: Integer; var Value: Variant;
  CheckIsOutParameter: boolean=true): 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.CreateFmt('%s.ParamToVariant expects an [In]Out parameter',[ClassName]);
  // 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
................................................................................
begin
  Log := OleDBSynLogClass.Enter(self);
  try
    if Assigned(fCommand) or Assigned(fRowSet) or (fColumnCount>0) or
       (fColumnBindings<>nil) or (fParamBindings<>nil) then
      raise EOleDBException.CreateFmt('%s.Execute should be called only once',[ClassName]);
    // 1. prepare command

    inherited; // fSQL := aSQL
    with Log.Instance do
    if sllSQL in Family.Level then
      Log(sllSQL,SQLWithInlinedParams,self);
    with OleDBConnection do begin
      if not IsConnected then
        Connect;
      OleDBCheck((fSession as IDBCreateCommand).
        CreateCommand(nil,IID_ICommandText,ICommand(fCommand)));
    end;
    L := Length(aSQL);
................................................................................
  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);
  dec(OleDBCoinitialized);
  if OleDBCoinitialized=0 then
    CoUninitialize;
end;

procedure TOleDBConnection.Connect;
var DataInitialize : IDataInitialize;
    unknown: IUnknown;
    Log: ISynLog;
begin
  Log := OleDBSynLogClass.Enter(self);
................................................................................
begin
  Log := OleDBSynLogClass.Enter(self);
  if not aProperties.InheritsFrom(TOleDBConnectionProperties) then
    raise EOleDBException.CreateFmt('Invalid %s.Create',[ClassName]);
  Log.Log(sllInfo,aProperties);
  fOleDBProperties := TOleDBConnectionProperties(aProperties);
  inherited;
  CoInit;
  OleCheck(CoGetMalloc(1,fMalloc));
end;

destructor TOleDBConnection.Destroy;
var Log: ISynLog;
begin
  Log := OleDBSynLogClass.Enter(self);
  try
    inherited Destroy;
    fMalloc := nil;
    CoUninit;
  except
    on E: Exception do
      Log.Log(sllError,E);
  end;
end;

procedure TOleDBConnection.Disconnect;
................................................................................
    tmp: PWideChar;
    Log: ISynLog;
begin
  Log := OleDBSynLogClass.Enter(self);
  result := false;
  if self<>nil then
  try
    CoInitialize(nil); // 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);
        Log.Log(sllInfo,'New connection settings set',self);
        result := true;
      end;
      DB_E_CANCELED:
        Log.Log(sllInfo,'Canceled',self);
      else OleCheck(res);
      end;
    finally
      CoUninitialize;
    end;
  except
    on E: Exception do 
      Log.Log(sllError,E);
  end;
end;

................................................................................

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


var st: TOleDBStatus;
initialization
  assert(sizeof(TOleDBStatementParam)=sizeof(PTrUInt)*4+sizeof(Int64));
  assert(SizeOf(TSQLDBColumnProperty)=sizeof(PtrUint)*2+4);
  for st := Low(st) to High(st) do
    OLEDBSTATUS_CAPTION[ord(st)] := UnCamelCase(TrimLeftLowerCase(
      GetEnumName(TypeInfo(TOleDBStatus),ord(st))));


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