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

uses
  Windows,
  SysUtils,
  SynCrtSock,
  SynCommons,
  SQLite3Commons,
{$ifdef COMPRESSDEFLATE}
  SynZip
{$endif}
{$ifdef COMPRESSSYNLZ}
  SynLZ
{$endif}
  ;


const
  /// the default access rights used by the HTTP server if none is specified
  HTTP_DEFAULT_ACCESS_RIGHTS: PSQLAccessRights = @SUPERVISOR_ACCESS_RIGHTS;

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

uses
  Windows,
  SysUtils,
  SynCrtSock,
  SynCommons,
  SQLite3Commons
{$ifdef COMPRESSDEFLATE}
  , SynZip
{$endif}
{$ifdef COMPRESSSYNLZ}
  , SynLZ
{$endif}
  ;


const
  /// the default access rights used by the HTTP server if none is specified
  HTTP_DEFAULT_ACCESS_RIGHTS: PSQLAccessRights = @SUPERVISOR_ACCESS_RIGHTS;

  - check of QueryPerformanceFrequency failure, and rollback to low-resolution timer
  - handle properly old .synlz layout (reading compatibility was broken)
  - added TObjectListHashed class, which behaves like TList/TObjectList, but
    will use hashing for (much) faster IndexOf() method, and associated
    TObjectListPropertyHashed class, which allows hashing of a sub-property
    of an object (including some changes made to TDynArray/TDynArrayHashed)
  - new TTextWriter.AddDateTime() overloaded method able to quote the output

  - both TTextWriter.AddDateTime() overloaded methods will store '' when value
    is 0, or a pure ISO-8601 date or time if the value is defined as such,
    just as expected by http://www.sqlite.org/lang_datefunc.html - it will also
    reduce average generated JSON/text content size
  - fixed issue about BLOB unproperly serialized into JSON (e.g. now uses null)
  - changed the non expanded JSON format to use lowercase first column names:
    {"fieldCount":1,"values":["col1"... instead of {"FieldCount":1,"Values":[..
................................................................................
    procedure AddDateTime(Value: PDateTime; FirstChar: AnsiChar='T'; QuoteChar: AnsiChar=#0); overload;
    /// append a TDateTime value, expanded as Iso-8601 encoded text
    procedure AddDateTime(const Value: TDateTime); overload;
    /// append an Unsigned Integer Value as a String
    procedure AddU(Value: cardinal);
    /// append a floating-point Value as a String
    procedure Add(Value: double); overload;



{$ifndef DELPHI5OROLDER} { array of const is buggy in Delphi 5 :( }
    /// append strings or integers with a specified format
    // - % = #37 indicates a string, integer, floating-point, or class parameter
    // to be appended as text (e.g. class name)
    // - $ = #36 indicates an integer to be written with 2 digits and a comma
    // - � = #163 indicates an integer to be written with 4 digits and a comma
    // - � = #181 indicates an integer to be written with 3 digits without any comma
................................................................................
{$ifdef CPU64}
  P := StrInt32(@tmp[23],Value); // StrInt32 use PtrInt, i.e. Int64
{$else}
  P := StrInt64(@tmp[23],Value);
{$endif}
  AddNoJSONEscape(P,@tmp[23]-P);
end;


























procedure TTextWriter.Add(c: AnsiChar);
begin
  if B>=BEnd then
    FlushInc^ := c else begin
    B[1] := c;
    inc(B);

  - check of QueryPerformanceFrequency failure, and rollback to low-resolution timer
  - handle properly old .synlz layout (reading compatibility was broken)
  - added TObjectListHashed class, which behaves like TList/TObjectList, but
    will use hashing for (much) faster IndexOf() method, and associated
    TObjectListPropertyHashed class, which allows hashing of a sub-property
    of an object (including some changes made to TDynArray/TDynArrayHashed)
  - new TTextWriter.AddDateTime() overloaded method able to quote the output
  - new TTextWriter.AddFloatStr() method handling partial floating-point text
  - both TTextWriter.AddDateTime() overloaded methods will store '' when value
    is 0, or a pure ISO-8601 date or time if the value is defined as such,
    just as expected by http://www.sqlite.org/lang_datefunc.html - it will also
    reduce average generated JSON/text content size
  - fixed issue about BLOB unproperly serialized into JSON (e.g. now uses null)
  - changed the non expanded JSON format to use lowercase first column names:
    {"fieldCount":1,"values":["col1"... instead of {"FieldCount":1,"Values":[..
................................................................................
    procedure AddDateTime(Value: PDateTime; FirstChar: AnsiChar='T'; QuoteChar: AnsiChar=#0); overload;
    /// append a TDateTime value, expanded as Iso-8601 encoded text
    procedure AddDateTime(const Value: TDateTime); overload;
    /// append an Unsigned Integer Value as a String
    procedure AddU(Value: cardinal);
    /// append a floating-point Value as a String
    procedure Add(Value: double); overload;
    /// append a floating-point text buffer
    // - will correct on the fly '.5' -> '0.5' and '-.5' -> '-0.5'
    procedure AddFloatStr(P: PUTF8Char);
{$ifndef DELPHI5OROLDER} { array of const is buggy in Delphi 5 :( }
    /// append strings or integers with a specified format
    // - % = #37 indicates a string, integer, floating-point, or class parameter
    // to be appended as text (e.g. class name)
    // - $ = #36 indicates an integer to be written with 2 digits and a comma
    // - � = #163 indicates an integer to be written with 4 digits and a comma
    // - � = #181 indicates an integer to be written with 3 digits without any comma
................................................................................
{$ifdef CPU64}
  P := StrInt32(@tmp[23],Value); // StrInt32 use PtrInt, i.e. Int64
{$else}
  P := StrInt64(@tmp[23],Value);
{$endif}
  AddNoJSONEscape(P,@tmp[23]-P);
end;

procedure TTextWriter.AddFloatStr(P: PUTF8Char);
var L: cardinal;
begin
  L := StrLen(P);
  assert(L<29);
  if L=0 then
    Add('0') else begin
    if B+31>=BEnd then
      FlushInc else
      inc(B);
    if PWord(P)^=ord('-')+ord('.')shl 8 then begin
      PWord(B)^ := ord('-')+ord('.')shl 8; // '-.3' -> '-0.3'
      inc(B,2);
      inc(P);
      dec(L);
    end else
    if P^='.' then begin
      B^ := '0'; // '.5' -> '0.5'
      inc(B);
    end;
    move(P^,B^,L);
    inc(B,L-1);
  end;
end;

procedure TTextWriter.Add(c: AnsiChar);
begin
  if B>=BEnd then
    FlushInc^ := c else begin
    B[1] := c;
    inc(B);

  - new TSQLDBConnectionProperties.SQLSelectAll method to retrieve a SELECT
    statement according to a DB column expected layout
  - new TSQLDBConnectionProperties.ClearConnectionPool method (could be used
    to recreate all connections in case of DB or network failure/timeout)
  - fixed issue in TSQLDBConnection.GetServerTimeStamp method

  Version 1.17

  - fixed random issue in TSQLDBConnection.GetServerTimeStamp method (using
    wrongly TTimeLog direct arithmetic, therefore raising EncodeTime() errors)  
  - fixed issue about creating unexisting NCLOB instead of CLOB/NCLOB
  - fixed TQuery implementation to match the expected original behavior
    (e.g. SQL.Clear) - also undefined buggy Last method (use ORDER DESC instead)
  - fixed issue in TQuery when executing requests with parameters 
  - fixed issues in TQuery when translated SQL from named parameters to
................................................................................
    /// should be TRUE if the column is indexed
    ColumnIndexed: boolean;
  end;

  /// used to define the column layout of a table schema
  // - e.g. for TSQLDBConnectionProperties.GetFields
  TSQLDBColumnDefineDynArray = array of TSQLDBColumnDefine;




  
  /// used to define a field/column layout
  // - for TSQLDBConnectionProperties.SQLCreate to describe the table
  // - for TOleDBStatement.Execute/Column*() methods to map the IRowSet content
  TSQLDBColumnProperty = packed record
    /// the Column name
    ColumnName: RawUTF8;
................................................................................
    ColumnType: TSQLDBFieldType;
    /// set if the Column must exists (i.e. should not be null)
    ColumnNonNullable: boolean;
    /// set if the Column shall have unique value (add the corresponding constraint)
    ColumnUnique: boolean;
    /// for TOleDBStatement: set if column was NOT defined as DBTYPE_BYREF
    // - which is the most common case, when column data < 4 KB
    // - for TSQLDBOracleStatement: set if column is an array of POCILobLocator


    ColumnValueInlined: boolean;
    /// for TSQLDBOracleStatement: used to store one value size (in bytes)
    ColumnValueDBSize: cardinal;
    /// for SQLT_STR/SQLT_CLOB: used to store the ftUTF8 column char set encoding
    // - for SynDBOracle, equals to the OCI char set
    ColumnValueDBCharSet: integer;

    /// for TSQLDBOracleStatement: used to store the DefineByPos() TypeCode
    // - can be  SQLT_STR/SQLT_CLOB, SQLT_FLT, SQLT_INT, SQLT_DAT and SQLT_BLOB



    ColumnValueDBType: byte;
    /// for SQLT_CLOB: used to store the ftUTF8 column
    // - for SynDBOracle, equals either to SQLCS_NCHAR or SQLCS_IMPLICIT
    ColumnValueDBForm: byte;
    /// some unsignificant bytes for memory structure alignment
    Padding: array[0..1] of byte;


  end;
               
  PSQLDBColumnProperty = ^TSQLDBColumnProperty;

  /// used to define a table/field column layout 
  TSQLDBColumnPropertyDynArray = array of TSQLDBColumnProperty;

................................................................................
    function SQLIso8601ToDate(const Iso8601: RawUTF8): RawUTF8; virtual; 
    /// retrieve the column/field layout of a specified table
    // - this default implementation will use protected SQLGetField virtual
    // method to retrieve the field names and properties
    // - used e.g. by GetFieldDefinitions
    // - will call ColumnTypeNativeToDB protected virtual method to guess the
    // each mORMot TSQLDBFieldType
    procedure GetFields(const aTableName: RawUTF8; var Fields: TSQLDBColumnDefineDynArray);  virtual;
    /// get all field/column definition for a specified Table as text
    // - call the GetFields method and retrieve the column field name and
    // type as 'Name [Type Length Precision Scale]'
    // - if WithForeignKeys is set, will add external foreign keys as '% tablename'
    procedure GetFieldDefinitions(const aTableName: RawUTF8;
      var Fields: TRawUTF8DynArray; WithForeignKeys: boolean);
    /// get one field/column definition as text
................................................................................
  protected
    fProperties: TSQLDBConnectionProperties;
    fErrorMessage: string;
    fInfoMessage: string;
    fTransactionCount: integer;
    fServerTimeStampOffset: TDateTime;
    function GetServerTimeStamp: TTimeLog; virtual; 
    function IsConnected: boolean; virtual; abstract;
    /// raise an exception
    procedure CheckConnection;
  public
    /// connect to a specified database engine
    constructor Create(aProperties: TSQLDBConnectionProperties); virtual;
    /// release memory and connection
    destructor Destroy; override;
................................................................................

    /// connect to the specified database
    // - should raise an Exception on error
    procedure Connect; virtual; abstract;
    /// stop connection to the specified database
    // - should raise an Exception on error
    procedure Disconnect; virtual; abstract;


    /// initialize a new SQL query statement for the given connection
    // - the caller should free the instance after use
    function NewStatement: TSQLDBStatement; virtual; abstract;
    /// initialize a new SQL query statement for the given connection
    // - this default implementation will call the NewStatement method
    // - but children may override this method to handle statement caching
    // - this method should return nil in case of error, or a prepared statement
................................................................................
     - the leftmost SQL parameter has an index of 1
     - to be used e.g. with stored procedures
     - this overriden function will retrieve the value stored in the protected
       fParams[] array: the ExecutePrepared method should have updated its
       content as exepcted}
    function ParamToVariant(Param: Integer; var Value: Variant;
      CheckIsOutParameter: boolean=true): TSQLDBFieldType; override;



  end;

  /// generic abstract class handling prepared statements with binding
  // and column description
  // - will provide protected fields and methods for handling both TSQLDBParam
  // parameters and standard TSQLDBColumnProperty column description
  TSQLDBStatementWithParamsAndColumns = class(TSQLDBStatementWithParams)
................................................................................
    {/ the Column type of the current Row
     - ftCurrency type should be handled specificaly, for faster process and
       avoid any rounding issue, since currency is a standard OleDB type
     - FieldSize can be set to store the size in chars of a ftUTF8 column
       (0 means BLOB kind of TEXT column) - this implementation will store
       fColumns[Col].ColumnValueDBSize if ColumnValueInlined=true}
    function ColumnType(Col: integer; FieldSize: PInteger=nil): TSQLDBFieldType; override;
    {/ Reset the previous prepared statement
     - this overriden implementation will just do reset the internal fColumn[] }
    procedure Reset; override;
    /// direct access to the columns description
    // - gives more details than the default ColumnType() function
    property Columns: TSQLDBColumnPropertyDynArray read fColumns;
  end;





/// function helper logging some column truncation information text
procedure LogTruncatedColumn(const Col: TSQLDBColumnProperty);

/// retrieve a table name without any left schema
// - e.g. TrimLeftSchema('SCHEMA.TABLENAME')='TABLENAME'
function TrimLeftSchema(const TableName: RawUTF8): RawUTF8;

................................................................................
    /// release associated memory and linked library
    destructor Destroy; override;
    /// the associated library handle
    property Handle: HMODULE read fHandle write fHandle;
  end;


{ -------------- Oracle specific functions - shared by SynOleDB and SynDBOracle }







const
  /// the Oracle column data types corresponding to our TSQLDBFieldType types

  ORA_FIELDS: TSQLDBFieldTypeDefinition = (


  ' NVARCHAR2(%)',' NUMBER(22,0)',' BINARY_DOUBLE',' NUMBER(19,4)',' DATE',
  ' NCLOB',' BLOB');
  // ftNull, ftInt64, ftDouble, ftCurrency, ftDate, ftUTF8, ftBlob
  // NCLOB (National Character Large Object) is an Oracle data type that can hold
  // up to 4 GB of character data. It's similar to a CLOB, but characters are
  // stored in a NLS or multibyte national character set (like NVARCHAR2)









  /// the Oracle SQL statement to retrieve the server date and time


  ORA_SERVERTIME = 'select sysdate from dual';








/// get all field/column names for a specified Table using Oracle SQL syntax
// - returns a SQL "SELECT" statement with the field names as first column,
// a textual field type as 2nd column, field type as the 3rd column,
// field length and precision as 4th and 5th columns, and the index count in 6th
// column
// - is made global, since may be used by both SynDBOracle and SynOleDB units
................................................................................
end;


{ TSQLDBConnectionProperties }

constructor TSQLDBConnectionProperties.Create(const aServerName, aDatabaseName,
  aUserID, aPassWord: RawUTF8);
const ASCII_FIELDS: TSQLDBFieldTypeDefinition = (
  ' NVARCHAR(%)',' BIGINT',' DOUBLE',' NUMERIC(19,4)',' TIMESTAMP',' CLOB',' BLOB');
  // ftNull, ftInt64, ftDouble, ftCurrency, ftDate, ftUTF8, ftBlob
begin
  fServerName := aServerName;
  fDatabaseName := aDatabaseName;
  fUserID := aUserID;
  fPassWord := aPassWord;
  fEngineName := EngineName;
  fSQLCreateField := ASCII_FIELDS;
  fSQLCreateFieldMax := 1000;
  SetInternalProperties; // virtual method used to override default parameters
end;

destructor TSQLDBConnectionProperties.Destroy;
begin
  fMainConnection.Free;
................................................................................
        WR.AddJSONEscape(pointer(ColumnUTF8(col)));
        WR.Add('"');
      end;
      ftBlob: begin
        blob := ColumnBlob(col);
        WR.WrBase64(pointer(blob),length(blob),true); // withMagic=true
      end;
      else raise ESQLDBException.CreateFmt('%s: Invalid ColumnType() %s',
        [ClassName,TSQLDBFieldTypeToString(ColumnType(col))]);
    end;
    WR.Add(',');
  end;
  WR.CancelLastComma; // cancel last ','
  if WR.Expand then
    WR.Add('}');
end;

function TSQLDBStatement.ColumnToVariant(Col: integer; var Value: Variant): TSQLDBFieldType;
begin


  result := ColumnType(Col); // will call GetCol() to check Col
  case result of
    ftNull:     Value := Null;
    ftInt64:    Value := {$ifdef DELPHI5OROLDER}integer{$endif}(ColumnInt(Col));
    ftDouble:   Value := ColumnDouble(Col);
    ftDate:     Value := ColumnDateTime(Col);
    ftCurrency: Value := ColumnCurrency(Col);
    ftBlob:     Value := ColumnBlob(Col);
    ftUTF8:     Value := UTF8ToSynUnicode(ColumnUTF8(Col));
    else raise ESQLDBException.CreateFmt('%s.ColumnToVariant: Invalid Type "%s"',
      [ClassName,TSQLDBFieldTypeToString(result)]);


  end;
end;

function TSQLDBStatement.ColumnToVarData(Col: Integer; var Value: TVarData;
  var Temp: RawByteString): TSQLDBFieldType;
// TVarData handled types are varNull, varInt64, varDouble, varString
// (mapping a constant PUTF8Char), and varAny (BLOB with size = VLongs[0])
const MAP: array[TSQLDBFieldType] of word = (
   varNull,varNull,varInt64,varDouble,varDouble,varString,varString,varAny);
// ftUnknown, ftNull, ftInt64, ftDouble, ftCurrency, ftDate, ftUTF8, ftBlob
begin


  result := ColumnType(Col); // will call GetCol() to check Col
  Value.VType := MAP[result];
  case result of
    ftInt64:    Value.VInt64  := ColumnInt(Col);
    ftCurrency: Value.VDouble := ColumnCurrency(Col);
    ftDouble:   Value.VDouble := ColumnDouble(Col);
    ftDate: begin // date time as TEXT (idem TSQLDBStatement.ColumnsToJSON)
      Temp := DateTimeToIso8601Text(ColumnDateTime(Col),'T');
................................................................................
var i: integer;
begin
  with CheckParam(Param,ftDouble,paramIn,length(Values))^ do
    for i := 0 to high(Values) do
      VArray[i] := ''''+DateTimeToIso8601Text(Values[i])+'''';
end;







{ TSQLDBStatementWithParamsAndColumns }

function TSQLDBStatementWithParamsAndColumns.ColumnIndex(const aColumnName: RawUTF8): integer;
begin
  result := fColumn.FindHashed(aColumnName);
end;
................................................................................
begin
  CheckCol(Col);
  result := fColumns[Col].ColumnName;
end;

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

constructor TSQLDBStatementWithParamsAndColumns.Create(aConnection: TSQLDBConnection);
begin
  inherited Create(aConnection);
  fColumn.Init(TypeInfo(TSQLDBColumnPropertyDynArray),fColumns,nil,nil,nil,@fColumnCount,True);
end;

procedure TSQLDBStatementWithParamsAndColumns.Reset;
begin
  fColumn.Clear;
end;


procedure LogTruncatedColumn(const Col: TSQLDBColumnProperty);
begin
  {$ifdef DELPHI5OROLDER}
  SynDBLog.Add.Log(sllDB,'Truncated column '+Col.ColumnName);
  {$else}
  SynDBLog.Add.Log(sllDB,'Truncated column %',Col.ColumnName);

  - new TSQLDBConnectionProperties.SQLSelectAll method to retrieve a SELECT
    statement according to a DB column expected layout
  - new TSQLDBConnectionProperties.ClearConnectionPool method (could be used
    to recreate all connections in case of DB or network failure/timeout)
  - fixed issue in TSQLDBConnection.GetServerTimeStamp method

  Version 1.17
  - code refactoring to allow direct ODBC connection implementation
  - fixed random issue in TSQLDBConnection.GetServerTimeStamp method (using
    wrongly TTimeLog direct arithmetic, therefore raising EncodeTime() errors)  
  - fixed issue about creating unexisting NCLOB instead of CLOB/NCLOB
  - fixed TQuery implementation to match the expected original behavior
    (e.g. SQL.Clear) - also undefined buggy Last method (use ORDER DESC instead)
  - fixed issue in TQuery when executing requests with parameters 
  - fixed issues in TQuery when translated SQL from named parameters to
................................................................................
    /// should be TRUE if the column is indexed
    ColumnIndexed: boolean;
  end;

  /// used to define the column layout of a table schema
  // - e.g. for TSQLDBConnectionProperties.GetFields
  TSQLDBColumnDefineDynArray = array of TSQLDBColumnDefine;

  /// possible column retrieval patterns
  // - used by TSQLDBColumnProperty.ColumnValueState
  TSQLDBStatementGetCol = (colNone, colNull, colWrongType, colTmpUsed, colTmpUsedTruncated);
  
  /// used to define a field/column layout
  // - for TSQLDBConnectionProperties.SQLCreate to describe the table
  // - for TOleDBStatement.Execute/Column*() methods to map the IRowSet content
  TSQLDBColumnProperty = packed record
    /// the Column name
    ColumnName: RawUTF8;
................................................................................
    ColumnType: TSQLDBFieldType;
    /// set if the Column must exists (i.e. should not be null)
    ColumnNonNullable: boolean;
    /// set if the Column shall have unique value (add the corresponding constraint)
    ColumnUnique: boolean;
    /// for TOleDBStatement: set if column was NOT defined as DBTYPE_BYREF
    // - which is the most common case, when column data < 4 KB
    // - for TSQLDBOracleStatement: FALSE if column is an array of POCILobLocator
    // - for TSQLDBODBCStatement: FALSE if bigger than 255 WideChar (ftUTF8) or
    // 255 bytes (ftBlob) 
    ColumnValueInlined: boolean;
    /// for TSQLDBOracleStatement: used to store one value size (in bytes)
    ColumnValueDBSize: cardinal;
    /// for SQLT_STR/SQLT_CLOB: used to store the ftUTF8 column char set encoding
    // - for SynDBOracle, equals to the OCI char set
    ColumnValueDBCharSet: integer;
    /// internal DB column data type
    // - for TSQLDBOracleStatement: used to store the DefineByPos() TypeCode,
    // can be SQLT_STR/SQLT_CLOB, SQLT_FLT, SQLT_INT, SQLT_DAT and SQLT_BLOB
    // - for TSQLDBODBCStatement: used to store the DataType as returned
    // by ODBC.DescribeColW() - use private ODBC_TYPE_TO[ColumnType] to
    // retrieve the marshalled type used during column retrieval
    ColumnValueDBType: smallint;
    /// for SynDBOracle: used to store the ftUTF8 column encoding, i.e. for
    // SQLT_CLOB, equals either to SQLCS_NCHAR or SQLCS_IMPLICIT
    ColumnValueDBForm: byte;


    /// for SynDBODBC: state of the latest SQLGetData() call
    ColumnValueState: TSQLDBStatementGetCol;
  end;
               
  PSQLDBColumnProperty = ^TSQLDBColumnProperty;

  /// used to define a table/field column layout 
  TSQLDBColumnPropertyDynArray = array of TSQLDBColumnProperty;

................................................................................
    function SQLIso8601ToDate(const Iso8601: RawUTF8): RawUTF8; virtual; 
    /// retrieve the column/field layout of a specified table
    // - this default implementation will use protected SQLGetField virtual
    // method to retrieve the field names and properties
    // - used e.g. by GetFieldDefinitions
    // - will call ColumnTypeNativeToDB protected virtual method to guess the
    // each mORMot TSQLDBFieldType
    procedure GetFields(const aTableName: RawUTF8; var Fields: TSQLDBColumnDefineDynArray); virtual;
    /// get all field/column definition for a specified Table as text
    // - call the GetFields method and retrieve the column field name and
    // type as 'Name [Type Length Precision Scale]'
    // - if WithForeignKeys is set, will add external foreign keys as '% tablename'
    procedure GetFieldDefinitions(const aTableName: RawUTF8;
      var Fields: TRawUTF8DynArray; WithForeignKeys: boolean);
    /// get one field/column definition as text
................................................................................
  protected
    fProperties: TSQLDBConnectionProperties;
    fErrorMessage: string;
    fInfoMessage: string;
    fTransactionCount: integer;
    fServerTimeStampOffset: TDateTime;
    function GetServerTimeStamp: TTimeLog; virtual; 

    /// raise an exception
    procedure CheckConnection;
  public
    /// connect to a specified database engine
    constructor Create(aProperties: TSQLDBConnectionProperties); virtual;
    /// release memory and connection
    destructor Destroy; override;
................................................................................

    /// connect to the specified database
    // - should raise an Exception on error
    procedure Connect; virtual; abstract;
    /// stop connection to the specified database
    // - should raise an Exception on error
    procedure Disconnect; virtual; abstract;
    /// return TRUE if Connect has been already successfully called
    function IsConnected: boolean; virtual; abstract;
    /// initialize a new SQL query statement for the given connection
    // - the caller should free the instance after use
    function NewStatement: TSQLDBStatement; virtual; abstract;
    /// initialize a new SQL query statement for the given connection
    // - this default implementation will call the NewStatement method
    // - but children may override this method to handle statement caching
    // - this method should return nil in case of error, or a prepared statement
................................................................................
     - the leftmost SQL parameter has an index of 1
     - to be used e.g. with stored procedures
     - this overriden function will retrieve the value stored in the protected
       fParams[] array: the ExecutePrepared method should have updated its
       content as exepcted}
    function ParamToVariant(Param: Integer; var Value: Variant;
      CheckIsOutParameter: boolean=true): TSQLDBFieldType; override;
    {/ Reset the previous prepared statement
     - this overriden implementation will just do reset the internal fParams[] }
    procedure Reset; override;
  end;

  /// generic abstract class handling prepared statements with binding
  // and column description
  // - will provide protected fields and methods for handling both TSQLDBParam
  // parameters and standard TSQLDBColumnProperty column description
  TSQLDBStatementWithParamsAndColumns = class(TSQLDBStatementWithParams)
................................................................................
    {/ the Column type of the current Row
     - ftCurrency type should be handled specificaly, for faster process and
       avoid any rounding issue, since currency is a standard OleDB type
     - FieldSize can be set to store the size in chars of a ftUTF8 column
       (0 means BLOB kind of TEXT column) - this implementation will store
       fColumns[Col].ColumnValueDBSize if ColumnValueInlined=true}
    function ColumnType(Col: integer; FieldSize: PInteger=nil): TSQLDBFieldType; override;



    /// direct access to the columns description
    // - gives more details than the default ColumnType() function
    property Columns: TSQLDBColumnPropertyDynArray read fColumns;
  end;

const
  /// TSQLDBFieldType kind of columns which have a fixed width
  FIXEDLENGTH_SQLDBFIELDTYPE = [ftInt64, ftDouble, ftCurrency, ftDate];

/// function helper logging some column truncation information text
procedure LogTruncatedColumn(const Col: TSQLDBColumnProperty);

/// retrieve a table name without any left schema
// - e.g. TrimLeftSchema('SCHEMA.TABLENAME')='TABLENAME'
function TrimLeftSchema(const TableName: RawUTF8): RawUTF8;

................................................................................
    /// release associated memory and linked library
    destructor Destroy; override;
    /// the associated library handle
    property Handle: HMODULE read fHandle write fHandle;
  end;


{ -------------- Database specific functions - shared by several SynDB units }

type
  /// the known database definitions
  // - will be used e.g. for TSQLDBConnectionProperties.SQLFieldCreate(), or
  // for ODBC definition
  TSQLDBDefinition = (dDefault,dOracle,dMSSQL,dJet,dMySQL,dSQLite);

const
  /// the known column data types corresponding to our TSQLDBFieldType types
  // - will be used e.g. for TSQLDBConnectionProperties.SQLFieldCreate()
  DB_FIELDS: array[TSQLDBDefinition] of TSQLDBFieldTypeDefinition = (
  // ftNull, ftInt64, ftDouble, ftCurrency, ftDate, ftUTF8, ftBlob
  (' NVARCHAR(%)',' BIGINT',' DOUBLE',' NUMERIC(19,4)',' TIMESTAMP',' CLOB',' BLOB'),
  (' NVARCHAR2(%)',' NUMBER(22,0)',' BINARY_DOUBLE',' NUMBER(19,4)',' DATE',
   ' NCLOB',' BLOB'),

  // NCLOB (National Character Large Object) is an Oracle data type that can hold
  // up to 4 GB of character data. It's similar to a CLOB, but characters are
  // stored in a NLS or multibyte national character set (like NVARCHAR2)
  (' nvarchar(%)',' bigint',' float',' money',' datetime',' nvarchar(max)',
   ' varbinary(max)'),
  (' VarChar(%)',' Decimal(19,0)',' Double',' Currency',' DateTime',
   ' LongText',' LongBinary'),
  (' varchar(%) character set UTF8',' bigint',' double',' decimal(19,4)',' datetime',
   ' text character set UTF8',' blob'),
  (' TEXT',' INTEGER',' FLOAT',' FLOAT',' TEXT',' TEXT',' BLOB')
  );

  /// the known SQL statement to retrieve the server date and time
  DB_SERVERTIME: array[TSQLDBDefinition] of RawUTF8 = (
    '', // return local server time by default
    'select sysdate from dual',
    'select GETDATE()',
    '', // Jet is local -> return local time
    'SELECT NOW()',
    '' // SQlite is local -> return local time
  );

{ -------------- Oracle specific functions - shared by SynOleDB and SynDBOracle }

/// get all field/column names for a specified Table using Oracle SQL syntax
// - returns a SQL "SELECT" statement with the field names as first column,
// a textual field type as 2nd column, field type as the 3rd column,
// field length and precision as 4th and 5th columns, and the index count in 6th
// column
// - is made global, since may be used by both SynDBOracle and SynOleDB units
................................................................................
end;


{ TSQLDBConnectionProperties }

constructor TSQLDBConnectionProperties.Create(const aServerName, aDatabaseName,
  aUserID, aPassWord: RawUTF8);



begin
  fServerName := aServerName;
  fDatabaseName := aDatabaseName;
  fUserID := aUserID;
  fPassWord := aPassWord;
  fEngineName := EngineName;
  fSQLCreateField := DB_FIELDS[dDefault];
  fSQLCreateFieldMax := 1000;
  SetInternalProperties; // virtual method used to override default parameters
end;

destructor TSQLDBConnectionProperties.Destroy;
begin
  fMainConnection.Free;
................................................................................
        WR.AddJSONEscape(pointer(ColumnUTF8(col)));
        WR.Add('"');
      end;
      ftBlob: begin
        blob := ColumnBlob(col);
        WR.WrBase64(pointer(blob),length(blob),true); // withMagic=true
      end;
      else raise ESQLDBException.CreateFmt('TSQLDBStatement: Invalid ColumnType()=%d',
        [ord(ColumnType(col))]);
    end;
    WR.Add(',');
  end;
  WR.CancelLastComma; // cancel last ','
  if WR.Expand then
    WR.Add('}');
end;

function TSQLDBStatement.ColumnToVariant(Col: integer; var Value: Variant): TSQLDBFieldType;
begin
  if ColumnNull(Col) then
    result := Null else begin
    result := ColumnType(Col); // will call GetCol() to check Col
    case result of
      ftNull:     Value := Null;
      ftInt64:    Value := {$ifdef DELPHI5OROLDER}integer{$endif}(ColumnInt(Col));
      ftDouble:   Value := ColumnDouble(Col);
      ftDate:     Value := ColumnDateTime(Col);
      ftCurrency: Value := ColumnCurrency(Col);
      ftBlob:     Value := ColumnBlob(Col);
      ftUTF8:     Value := UTF8ToSynUnicode(ColumnUTF8(Col));
      else raise ESQLDBException.CreateFmt(

        'TSQLDBStatement.ColumnToVariant: Invalid ColumnType()=%d',[ord(result)]);
    end;
  end;
end;

function TSQLDBStatement.ColumnToVarData(Col: Integer; var Value: TVarData;
  var Temp: RawByteString): TSQLDBFieldType;
// TVarData handled types are varNull, varInt64, varDouble, varString
// (mapping a constant PUTF8Char), and varAny (BLOB with size = VLongs[0])
const MAP: array[TSQLDBFieldType] of word = (
   varNull,varNull,varInt64,varDouble,varDouble,varString,varString,varAny);
// ftUnknown, ftNull, ftInt64, ftDouble, ftCurrency, ftDate, ftUTF8, ftBlob
begin
  if ColumnNull(Col) then // will call GetCol() to check Col
    result := ftNull else
    result := ColumnType(Col);
  Value.VType := MAP[result];
  case result of
    ftInt64:    Value.VInt64  := ColumnInt(Col);
    ftCurrency: Value.VDouble := ColumnCurrency(Col);
    ftDouble:   Value.VDouble := ColumnDouble(Col);
    ftDate: begin // date time as TEXT (idem TSQLDBStatement.ColumnsToJSON)
      Temp := DateTimeToIso8601Text(ColumnDateTime(Col),'T');
................................................................................
var i: integer;
begin
  with CheckParam(Param,ftDouble,paramIn,length(Values))^ do
    for i := 0 to high(Values) do
      VArray[i] := ''''+DateTimeToIso8601Text(Values[i])+'''';
end;

procedure TSQLDBStatementWithParams.Reset;
begin
  fParam.Clear;
end;


{ TSQLDBStatementWithParamsAndColumns }

function TSQLDBStatementWithParamsAndColumns.ColumnIndex(const aColumnName: RawUTF8): integer;
begin
  result := fColumn.FindHashed(aColumnName);
end;
................................................................................
begin
  CheckCol(Col);
  result := fColumns[Col].ColumnName;
end;

function TSQLDBStatementWithParamsAndColumns.ColumnType(Col: integer; FieldSize: PInteger=nil): TSQLDBFieldType;
begin

  with fColumns[Col] do begin
    result := ColumnType;
    if FieldSize<>nil then
      if ColumnValueInlined then
        FieldSize^ := ColumnValueDBSize else
        FieldSize^ := 0;
  end;
................................................................................

constructor TSQLDBStatementWithParamsAndColumns.Create(aConnection: TSQLDBConnection);
begin
  inherited Create(aConnection);
  fColumn.Init(TypeInfo(TSQLDBColumnPropertyDynArray),fColumns,nil,nil,nil,@fColumnCount,True);
end;







procedure LogTruncatedColumn(const Col: TSQLDBColumnProperty);
begin
  {$ifdef DELPHI5OROLDER}
  SynDBLog.Add.Log(sllDB,'Truncated column '+Col.ColumnName);
  {$else}
  SynDBLog.Add.Log(sllDB,'Truncated column %',Col.ColumnName);

/// ODBC 3.5 library direct access classes to be used with our SynDB architecture
// - this unit is a part of the freeware Synopse mORMot framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.16
unit SynDBODBC;

{
    This file is part of Synopse mORMot framework.

    Synopse mORMot framework. Copyright (C) 2012 Arnaud Bouchez
      Synopse Informatique - http://synopse.info
................................................................................
  the terms of any one of the MPL, the GPL or the LGPL.

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

  Version 1.16
  - first public release, corresponding to mORMot Framework 1.16










}

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

interface

uses
................................................................................
  Variants,
{$endif}
  Classes,
  Contnrs,
  SynCommons,
  SynDB;































































































































































{ -------------- ODBC library interfaces, constants and types }



























































































































































































































































































































type
  SqlSmallint = Smallint;
  SqlDate = Byte;
  SqlTime = Byte;
  SqlDecimal = Byte;
  SqlDouble = Double;
................................................................................

  SqlHandle = Pointer;
  SqlHEnv = SqlHandle;
  SqlHDbc = SqlHandle;
  SqlHStmt = SqlHandle;
  SqlHDesc = SqlHandle;








































  /// direct access to the ODBC library
  // - this wrapper will initialize both Ansi and Wide versions of the ODBC
  // driver functions, and will work with 32 bit and 64 bit version of the
  // interfaces, on Windows or POSIX platforms
  // - within this unit, we will only use Wide version, and UTF-8 conversion
  TSQLDBODBCLib = class(TSQLDBLib)



  public
    AllocConnect: function(EnvironmentHandle: SqlHEnv; var ConnectionHandle: SqlHDbc): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    AllocEnv: function (var EnvironmentHandle: SqlHEnv): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    AllocHandle: function(HandleType: SqlSmallint; InputHandle: SqlHandle;
      var OutputHandle: SqlHandle): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    AllocStmt: function(ConnectionHandle: SqlHDbc; var StatementHandle: SqlHStmt): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    BindCol: function(StatementHandle: SqlHStmt; ColumnNumber: SqlUSmallint;
      TargetType: SqlSmallint; TargetValue: SqlPointer;
      BufferLength: SqlLen; StrLen_or_Ind: PSqlLen): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    BindParam: function (StatementHandle: SqlHStmt;
      ParameterNumber: SqlUSmallint; ValueType: SqlSmallint;
      ParameterType: SqlSmallint; LengthPrecision: SqlULen;
      ParameterScale: SqlSmallint; ParameterValue: SqlPointer;
      var StrLen_or_Ind: SqlLen): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    Cancel: function(StatementHandle: SqlHStmt): SqlReturn;

      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    CloseCursor: function(StatementHandle: SqlHStmt): SqlReturn;
    
 {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    ColAttributeA: function(StatementHandle: SqlHStmt; ColumnNumber: SqlUSmallint;
      FieldIdentifier: SqlUSmallint; CharacterAttribute: PAnsiChar;
      BufferLength: SqlSmallint; StringLength: PSqlSmallint; NumericAttributePtr: PSqlLen): SqlReturn;

      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    ColAttributeW: function(StatementHandle: SqlHStmt; ColumnNumber: SqlUSmallint;
      FieldIdentifier: SqlUSmallint; CharacterAttribute: PWideChar;
      BufferLength: SqlSmallint; StringLength: PSqlSmallint; NumericAttributePtr: PSqlLen): SqlReturn;

       {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    ColumnsA: function(StatementHandle: SqlHStmt;
      CatalogName: PAnsiChar; NameLength1: SqlSmallint;
      SchemaName: PAnsiChar;  NameLength2: SqlSmallint;
      TableName: PAnsiChar;   NameLength3: SqlSmallint;
      ColumnName: PAnsiChar;  NameLength4: SqlSmallint): SqlReturn;

      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    ColumnsW: function(StatementHandle: SqlHStmt;
      CatalogName: PWideChar; NameLength1: SqlSmallint;
      SchemaName: PWideChar;  NameLength2: SqlSmallint;
      TableName: PWideChar;   NameLength3: SqlSmallint;
      ColumnName: PWideChar;  NameLength4: SqlSmallint): SqlReturn;

      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    ConnectA: function(ConnectionHandle: SqlHDbc;
      ServerName: PAnsiChar; NameLength1: SqlSmallint;
      UserName: PAnsiChar; NameLength2: SqlSmallint;
      Authentication: PAnsiChar; NameLength3: SqlSmallint): SqlReturn;

      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    ConnectW: function(ConnectionHandle: SqlHDbc;
      ServerName: PWideChar; NameLength1: SqlSmallint;
      UserName: PWideChar; NameLength2: SqlSmallint;
      Authentication: PWideChar; NameLength3: SqlSmallint): SqlReturn;

      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    CopyDesc: function(SourceDescHandle, TargetDescHandle: SqlHDesc): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    DataSourcesA: function(EnvironmentHandle: SqlHEnv; Direction: SqlUSmallint;
      ServerName: PAnsiChar;  BufferLength1: SqlSmallint; var NameLength1: SqlSmallint;
      Description: PAnsiChar; BufferLength2: SqlSmallint; var NameLength2: SqlSmallint): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
................................................................................
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    SetConnectAttrA: function(ConnectionHandle: SqlHDbc; Attribute: SqlInteger;
      ValuePtr: SqlPointer; StringLength: SqlInteger): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    SetConnectAttrW: function(ConnectionHandle: SqlHDbc; Attribute: SqlInteger;
      ValuePtr: SqlPointer; StringLength: SqlInteger): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
  end;

const
  ODBC_ENTRIES: array[0..55] of PChar =
    ('SQLAllocConnect','SQLAllocEnv','SQLAllocHandle','SQLAllocStmt',
     'SQLBindCol','SQLBindParam','SQLCancel','SQLCloseCursor',
     'SQLColAttribute','SQLColAttributeW','SQLColumns','SQLColumnsW',
     'SQLConnect','SQLConnectW','SQLCopyDesc','SQLDataSources','SQLDataSourcesW',
     'SQLDescribeCol','SQLDescribeColW','SQLDisconnect','SQLEndTran',
     'SQLError','SQLErrorW','SQLExecDirect','SQLExecDirectW','SQLExecute',
     'SQLFetch','SQLFetchScroll','SQLFreeConnect','SQLFreeEnv','SQLFreeHandle',
     'SQLFreeStmt','SQLGetConnectAttr','SQLGetConnectAttrW',
     'SQLGetCursorName','SQLGetCursorNameW','SQLGetData',
     'SQLGetDescField','SQLGetDescFieldW','SQLGetDescRec','SQLGetDescRecW',
     'SQLGetDiagField','SQLGetDiagFieldW','SQLGetDiagRec','SQLGetDiagRecW',
     'SQLPrepare','SQLPrepareW','SQLRowCount','SQLNumResultCols',
     'SQLGetInfo','SQLGetInfoW','SQLSetStmtAttr','SQLSetStmtAttrW','SQLSetEnvAttr',
     'SQLSetConnectAttr','SQLSetConnectAttrW');


{ -------------- TSQLDBODBC* classes and types implementing an ODBC library connection  }

type
  /// will implement properties shared by the ODBC library
  TSQLDBODBCConnectionProperties = class(TSQLDBConnectionProperties)
  protected
    /// get all table names of this ODBC database
    function SQLGetTableNames: RawUTF8; override;
    /// convert a textual column data type, as retrieved e.g. from SQLGetField,
    // into our internal primitive types
    function ColumnTypeNativeToDB(const aNativeType: RawUTF8; aScale: integer): TSQLDBFieldType; override;
    /// initialize fForeignKeys content with all foreign keys of this DB
    // - used by GetForeignKey method
    procedure GetForeignKeys; override;
  public
    /// initialize the properties
    // - only used parameter is aServerName, which should point to the ODBC
    // database file to be opened (one will be created if none exists)
    // - other parameters (DataBaseName, UserID, Password) are ignored
    constructor Create(const aServerName, aDatabaseName, aUserID, aPassWord: RawUTF8); 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; override;
    /// convert an ISO-8601 encoded time and date into a date appropriate to
    // be pasted in the SQL request
    // - returns 'YYYY-MM-DD HH24:MI:SS' i.e. change the in-between 'T' into ' '
    function SQLIso8601ToDate(const Iso8601: RawUTF8): RawUTF8; override;
    /// retrieve the column/field layout of a specified table
    // - this overriden method will call PRAGMA table_info()
    // - used e.g. by GetFieldDefinitions
    procedure GetFields(const aTableName: RawUTF8; var Fields: TSQLDBColumnDefineDynArray); override;
  end;

  /// implements a direct connection to the ODBC library
  TSQLDBODBCConnection = class(TSQLDBConnection)
  protected
    function IsConnected: boolean; override;
  public
    /// release internal memory, handles and statement cache
    destructor Destroy; override;
    /// connect to the ODBC library, i.e. create the DB instance
    // - should raise an Exception on error
    procedure Connect; override;
    /// stop connection to the ODBC library, i.e. release the DB instance
    // - should raise an Exception on error
    procedure Disconnect; override;
    /// initialize a new SQL query statement for the given connection
    // - the caller should free the instance after use
    function NewStatement: TSQLDBStatement; override;
    /// begin a Transaction for this connection
    // - current implementation do not support nested transaction with those
    // methods: exception will be raised in such case
    procedure StartTransaction; override;
    /// commit changes of a Transaction for this connection
    // - StartTransaction method must have been called before
    procedure Commit; override;
    /// discard changes of a Transaction for this connection
    // - StartTransaction method must have been called before
    procedure Rollback; override;
  end;

  /// implements a statement using a ODBC connection
  TSQLDBODBCStatement = class(TSQLDBStatement)
  protected
    {{ retrieve the inlined value of a given parameter, e.g. 1 or 'name' }
    function GetParamValueAsText(Param: integer): RawUTF8; override;
  public
    {{ create a ODBC statement instance, from an existing ODBC connection
     - the Execute method can be called once per TSQLDBODBCStatement instance,
       but you can use the Prepare once followed by several ExecutePrepared methods
     - if the supplied connection is not of TOleDBConnection type, will raise
       an exception }
    constructor Create(aConnection: TSQLDBConnection); override;
    {{ release all associated memory and ODBC handles }
    destructor Destroy; override;

    {{ bind a NULL value to a parameter
     - the leftmost SQL parameter has an index of 1 }
    procedure BindNull(Param: Integer; IO: TSQLDBParamInOutType=paramIn); override;
    {{ 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; override;
    {{ 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; override;
    {{ 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; override;
    {{ 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; override;
    {{ 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; override;
    {{ bind a UTF-8 encoded buffer text (#0 ended) to a parameter
     - the leftmost SQL parameter has an index of 1 }
    procedure BindTextP(Param: Integer; Value: PUTF8Char;
      IO: TSQLDBParamInOutType=paramIn); overload; override;
    {{ 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; override;
    {{ 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; override;
    {{ 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; override;
    {{ 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; override;

    {{ Prepare an UTF-8 encoded SQL statement
     - parameters marked as ? will be bound later, before ExecutePrepared call
     - if ExpectResults is TRUE, then Step() and Column*() methods are available
       to retrieve the data rows
     - raise an ESQLDBException on any error }
    procedure Prepare(const aSQL: RawUTF8; ExpectResults: Boolean=false); overload; override;
    {{ Execute a prepared SQL statement
     - parameters marked as ? should have been already bound with Bind*() functions
     - raise an ESQLDBException on any error }
    procedure ExecutePrepared; 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 ESQLDBException on any error }
    function Step(SeekFirst: boolean=false): boolean; override;
    {{ retrieve a column name of the current Row
     - Columns numeration (i.e. Col value) starts with 0
     - it's up to the implementation to ensure than all column names are unique }
    function ColumnName(Col: integer): RawUTF8; override;
    {{ returns the Column index of a given Column name
     - Columns numeration (i.e. Col value) starts with 0
     - returns -1 if the Column name is not found (via case insensitive search) }
    function ColumnIndex(const aColumnName: RawUTF8): integer; override;
    {{ the Column type of the current Row
     - ftCurrency type should be handled specificaly, for faster process and
     avoid any rounding issue, since currency is a standard OleDB type }
    function ColumnType(Col: integer): TSQLDBFieldType; override;
    {{ Reset the previous prepared statement }
    procedure Reset; override;
    {{ returns TRUE if the column contains NULL }
    function ColumnNull(Col: integer): boolean; override;
    {{ return a Column integer value of the current Row, first Col is 0 }
    function ColumnInt(Col: integer): Int64; override;
    {{ return a Column floating point value of the current Row, first Col is 0 }
    function ColumnDouble(Col: integer): double; override;
    {{ return a Column floating point value of the current Row, first Col is 0 }
    function ColumnDateTime(Col: integer): TDateTime; override;
    {{ return a Column currency value of the current Row, first Col is 0
     - should retrieve directly the 64 bit Currency content, to avoid
     any rounding/conversion error from floating-point types }
    function ColumnCurrency(Col: integer): currency; override;
    {{ return a Column UTF-8 encoded text value of the current Row, first Col is 0 }
    function ColumnUTF8(Col: integer): RawUTF8; override;
    {{ return a Column as a blob value of the current Row, first Col is 0
    - ColumnBlob() will return the binary content of the field is was not ftBlob,
      e.g. a 8 bytes RawByteString for a vtInt64/vtDouble/vtDate/vtCurrency,
      or a direct mapping of the RawUnicode  }
    function ColumnBlob(Col: integer): RawByteString; override;
    {{ append all columns values of the current Row to a JSON stream
     - will use WR.Expand to guess the expected output format
     - fast overriden implementation with no temporary variable 
     - BLOB field value is saved as Base64, in the '"\uFFF0base64encodedbinary"
       format and contains true BLOB data }
    procedure ColumnsToJSON(WR: TJSONWriter); override;
  end;

  
implementation

{ TSQLDBODBCConnectionProperties }

function TSQLDBODBCConnectionProperties.ColumnTypeNativeToDB(
  const aNativeType: RawUTF8; aScale: integer): TSQLDBFieldType;
const
  PCHARS: array[0..21] of PUTF8Char = (
    'TEXT COLLATE ISO8601','TIME','DATE', 'INT','BIGINT',
    'TEXT','CBLO','CHAR','NCHAR','VARCHAR','NVARCHAR',
    'DOUBLE','NUMBER','FLOAT', 'MONEY','CURR', 'NULL',
    'BLOB','VARRAW','RAW','LONG RAW','LONG VARRAW');
  TYPES: array[-1..high(PCHARS)] of TSQLDBFieldType = (
    ftUnknown, ftDate,ftDate,ftDate, ftInt64,ftInt64,
    ftUTF8,ftUTF8,ftUTF8,ftUTF8,ftUTF8,ftUTF8,
    ftDouble,ftDouble,ftDouble, ftCurrency,ftCurrency, ftNull,
    ftBlob,ftBlob,ftBlob,ftBlob,ftBlob);
begin
  result := TYPES[IdemPCharArray(pointer(aNativeType),PCHARS)];
end;

constructor TSQLDBODBCConnectionProperties.Create(const aServerName,
  aDatabaseName, aUserID, aPassWord: RawUTF8);
const
  ODBC_FIELDS: TSQLDBFieldTypeDefinition = (
  ' TEXT COLLATE SYSTEMNOCASE',' INTEGER',' FLOAT',' FLOAT',
  ' TEXT COLLATE ISO8601',' TEXT COLLATE SYSTEMNOCASE',' BLOB');
  // ftNull, ftInt64, ftDouble, ftCurrency, ftDate, ftUTF8, ftBlob
begin
  inherited Create(aServerName,aDatabaseName,aUserID,aPassWord);
  fSQLCreateField := ODBC_FIELDS;
  fSQLCreateFieldMax := 0; // ODBC doesn't expect any field length
end;

procedure TSQLDBODBCConnectionProperties.GetFields(
  const aTableName: RawUTF8; var Fields: TSQLDBColumnDefineDynArray);
var n, i: integer;
    F: TSQLDBColumnDefine;
    FA: TDynArray;
begin
  FA.Init(TypeInfo(TSQLDBColumnDefineDynArray),Fields,@n);
  FA.Compare := SortDynArrayAnsiStringI; // FA.Find() case insensitive
  fillchar(F,sizeof(F),0);
  with Execute(FormatUTF8('PRAGMA table_info(%)',[aTableName]),[]) do
  while Step do begin
    // cid,name,type,notnull,dflt_value,pk
    F.ColumnName := ColumnUTF8(1);
    F.ColumnTypeNative := ColumnUTF8(2);
    F.ColumnType := ColumnTypeNativeToDB(F.ColumnTypeNative,0);
    FA.Add(F);
  end;
  with Execute(FormatUTF8('PRAGMA index_list(%)',[aTableName]),[]) do
    while Step do
      // seq,name,unique
      with Execute(FormatUTF8('PRAGMA index_info(%)',[ColumnUTF8(1)]),[]) do
        while Step do begin
          F.ColumnName := ColumnUTF8(2); // seqno,cid,name
          i := FA.Find(F);
          if i>=0 then
            Fields[i].ColumnIndexed := true;
        end;
  SetLength(Fields,n);
end;

procedure TSQLDBODBCConnectionProperties.GetForeignKeys;
begin
  // do nothing (yet)
end;

function TSQLDBODBCConnectionProperties.NewConnection: TSQLDBConnection;
begin
  result := TSQLDBODBCConnection.Create(self);
end;

function TSQLDBODBCConnectionProperties.SQLGetTableNames: RawUTF8;
begin
  // TBD
end;

function TSQLDBODBCConnectionProperties.SQLIso8601ToDate(const Iso8601: RawUTF8): RawUTF8;
begin
  result := Iso8601;
  if length(result)>10 then
    result[11] := ' '; // 'T' -> ' '
end;


{ TSQLDBODBCConnection }

procedure TSQLDBODBCConnection.Commit;
begin
  inherited Commit;
  // TBD
end;

procedure TSQLDBODBCConnection.Connect;
var Log: ISynLog;
begin
  Log := SynDBLog.Enter;
  if self=nil then
    raise ESQLDBException.Create('Invalid Connect call');
  Disconnect; // force fTrans=fError=fServer=fContext=nil
  // TBD
end;

destructor TSQLDBODBCConnection.Destroy;
begin
  // TBD
  inherited;
end;

procedure TSQLDBODBCConnection.Disconnect;
begin
  // TBD
end;

function TSQLDBODBCConnection.IsConnected: boolean;
begin
  // TBD
//  result := (self<>nil) and (fDB<>nil);
end;

function TSQLDBODBCConnection.NewStatement: TSQLDBStatement;
begin
  result := TSQLDBODBCStatement.Create(self);
end;

procedure TSQLDBODBCConnection.Rollback;
begin
  inherited;
  // TBD
end;

procedure TSQLDBODBCConnection.StartTransaction;
begin
  inherited;
  // TBD
end;


{ TSQLDBODBCStatement }

procedure TSQLDBODBCStatement.Bind(Param: Integer; Value: double;
  IO: TSQLDBParamInOutType);
begin
  // TBD
{  if fBindShouldStoreValue and (cardinal(Param-1)<cardinal(fParamCount)) then
    fBindValues[Param-1] := DoubleToStr(Value,DOUBLE_STR_PRECISION);
  fStatement.Bind(Param,Value);}
end;

procedure TSQLDBODBCStatement.Bind(Param: Integer; Value: Int64;
  IO: TSQLDBParamInOutType);
begin
  // TBD
{  if fBindShouldStoreValue and (cardinal(Param-1)<cardinal(fParamCount)) then
    fBindValues[Param-1] := Int64ToUtf8(Value);
  fStatement.Bind(Param,Value); }
end;

procedure TSQLDBODBCStatement.BindBlob(Param: Integer; Data: pointer;
  Size: integer; IO: TSQLDBParamInOutType);
begin
  // TBD
{  if fBindShouldStoreValue and (cardinal(Param-1)<cardinal(fParamCount)) then
    fBindValues[Param-1] := '*BLOB*';
  fStatement.Bind(Param,Data,Size);}
end;

procedure TSQLDBODBCStatement.BindBlob(Param: Integer;
  const Data: RawByteString; IO: TSQLDBParamInOutType);
begin
  // TBD
//  fStatement.Bind(Param,pointer(Data),length(Data));
end;

procedure TSQLDBODBCStatement.BindCurrency(Param: Integer;
  Value: currency; IO: TSQLDBParamInOutType);
begin
  // TBD
{  if fBindShouldStoreValue and (cardinal(Param-1)<cardinal(fParamCount)) then
    fBindValues[Param-1] := Curr64ToStr(PInt64(@Value)^);
  fStatement.Bind(Param,Value);}
end;

procedure TSQLDBODBCStatement.BindDateTime(Param: Integer;
  Value: TDateTime; IO: TSQLDBParamInOutType);
begin
  // TBD
end;
{var tmp: RawUTF8;
begin
  tmp := DateTimeToIso8601Text(Value,True,'T');
  if fBindShouldStoreValue and (cardinal(Param-1)<cardinal(fParamCount)) then
    fBindValues[Param-1] := tmp;
  fStatement.Bind(Param,tmp);
end;}

procedure TSQLDBODBCStatement.BindNull(Param: Integer;
  IO: TSQLDBParamInOutType);
begin
  // TBD
end;

procedure TSQLDBODBCStatement.BindTextP(Param: Integer;
  Value: PUTF8Char; IO: TSQLDBParamInOutType);
begin
  // TBD
end;
{var Len: integer;
begin
  Len := StrLen(Value);
  if fBindShouldStoreValue and (cardinal(Param-1)<cardinal(fParamCount)) then
    SetString(fBindValues[Param-1],PAnsiChar(Value),Len);
  ODBC_check(fStatement.RequestDB,
    ODBC_bind_text(fStatement.Request,Param,pointer(Value),Len,
    SQLITE_TRANSIENT)); // make private copy of the data
end;}

procedure TSQLDBODBCStatement.BindTextS(Param: Integer;
  const Value: string; IO: TSQLDBParamInOutType);
begin
  BindTextU(Param,StringToUTF8(Value));
end;

procedure TSQLDBODBCStatement.BindTextU(Param: Integer;
  const Value: RawUTF8; IO: TSQLDBParamInOutType);
begin
  // TBD
end;
{begin
  if fBindShouldStoreValue and (cardinal(Param-1)<cardinal(fParamCount)) then
    fBindValues[Param-1] := Value;
  fStatement.Bind(Param,Value);
end;}

procedure TSQLDBODBCStatement.BindTextW(Param: Integer;
  const Value: WideString; IO: TSQLDBParamInOutType);
begin
  BindTextU(Param,WideStringToUTF8(Value));
end;

function TSQLDBODBCStatement.ColumnBlob(Col: integer): RawByteString;
begin
  // TBD
end;
{begin
  result := fStatement.FieldBlob(Col);
end;}

function TSQLDBODBCStatement.ColumnCurrency(Col: integer): currency;
begin
  // TBD
end;

function TSQLDBODBCStatement.ColumnDateTime(Col: integer): TDateTime;
begin
  // TBD
end;
{var Time: Iso8601;
begin
  case ColumnType(Col) of
  ftUTF8:
    result := Iso8601ToDateTime(fStatement.FieldUTF8(Col));
  ftInt64: begin
    Time.Value := fStatement.FieldInt(Col);
    result := Time.ToDateTime;
  end;
  else result := 0;
  end;
end;}

function TSQLDBODBCStatement.ColumnDouble(Col: integer): double;
begin
  // TBD
end;
{begin
  result := fStatement.FieldDouble(Col);
end;}

function TSQLDBODBCStatement.ColumnIndex(const aColumnName: RawUTF8): integer;
begin
  // TBD
end;
{begin
  result := fStatement.FieldIndex(aColumnName);
end;}

function TSQLDBODBCStatement.ColumnInt(Col: integer): Int64;
begin
  // TBD
end;
{begin
  result := fStatement.FieldInt(Col);
end;}

function TSQLDBODBCStatement.ColumnName(Col: integer): RawUTF8;
begin
  // TBD
end;
{begin
  result := fStatement.FieldName(Col);
end;}

function TSQLDBODBCStatement.ColumnNull(Col: integer): boolean;
begin
  // TBD
end;
{begin
  result := fStatement.FieldNull(Col);
end;}

procedure TSQLDBODBCStatement.ColumnsToJSON(WR: TJSONWriter);
begin
  // TBD
end;
{begin
  fStatement.FieldsToJSON(WR);
end;}

function TSQLDBODBCStatement.ColumnType(Col: integer): TSQLDBFieldType;
begin
  // TBD
end;
{begin
  case fStatement.FieldType(Col) of
  SQLITE_NULL:    result := ftNull;
  SQLITE_INTEGER: result := ftInt64;
  SQLITE_FLOAT:   result := ftDouble;
  SQLITE_TEXT:    result := ftUTF8;
  SQLITE_BLOB:    result := ftBlob;
  else            result := ftUnknown;
  end;
end;}

function TSQLDBODBCStatement.ColumnUTF8(Col: integer): RawUTF8;
begin
  // TBD
end;
{begin
  result := fStatement.FieldUTF8(Col);
end;}

constructor TSQLDBODBCStatement.Create(aConnection: TSQLDBConnection);
begin
  if not aConnection.InheritsFrom(TSQLDBODBCConnection) then
    raise ESQLDBException.CreateFmt('%s.Create expects a TSQLDBODBCConnection',[ClassName]);
  inherited Create(aConnection);
end;

destructor TSQLDBODBCStatement.Destroy;
begin
  // TBD
  inherited Destroy;
end;

procedure TSQLDBODBCStatement.ExecutePrepared;
begin
  // TBD
end;
{begin
  if not fExpectResults then
    // INSERT/UPDATE/DELETE (i.e. not SELECT) -> try to execute directly now
    repeat // Execute all steps of the first statement
    until fStatement.Step<>SQLITE_ROW;
end;}

function TSQLDBODBCStatement.GetParamValueAsText(Param: integer): RawUTF8;
begin
  // TBD
end;
{begin
  if not fBindShouldStoreValue or (cardinal(Param-1)>=cardinal(fParamCount)) then
    result := '' else
    result := fBindValues[Param-1];
end;}

procedure TSQLDBODBCStatement.Prepare(const aSQL: RawUTF8;
  ExpectResults: Boolean);
begin
  // TBD
end;
{begin
  inherited Prepare(aSQL,ExpectResults); // set fSQL + Connect if necessary
  fStatement.Prepare(TSQLDBODBCConnection(Connection).fDB.DB,aSQL);
  AfterPrepare;
end;}

procedure TSQLDBODBCStatement.Reset;
begin
  // TBD
end;
{begin
  fStatement.Reset;
  fStatement.BindReset;
end;}

function TSQLDBODBCStatement.Step(SeekFirst: boolean): boolean;
begin
  // TBD
end;
{begin
  if SeekFirst then
    fStatement.Reset;
  result := fStatement.Step=SQLITE_ROW;
end;}

end.

/// ODBC 3.5 library direct access classes to be used with our SynDB architecture
// - this unit is a part of the freeware Synopse mORMot framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.17
unit SynDBODBC;

{
    This file is part of Synopse mORMot framework.

    Synopse mORMot framework. Copyright (C) 2012 Arnaud Bouchez
      Synopse Informatique - http://synopse.info
................................................................................
  the terms of any one of the MPL, the GPL or the LGPL.

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

  Version 1.16
  - first public release, corresponding to mORMot Framework 1.16

  Version 1.17
  - initial working code, tested with ODBC Oracle provider

  TODO:
  - implement array binding of parameters
    http://msdn.microsoft.com/en-us/library/windows/desktop/ms709287
  - implement row-wise binding when all columns are inlined 
    http://msdn.microsoft.com/en-us/library/windows/desktop/ms711730

}

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

interface

uses
................................................................................
  Variants,
{$endif}
  Classes,
  Contnrs,
  SynCommons,
  SynDB;


{ -------------- TODBC* classes and types implementing an ODBC library connection  }

type
  /// generic Exception type, generated for ODBC connection
  EODBCException = class(ESQLDBException);

  /// will implement properties shared by the ODBC library
  TODBCConnectionProperties = class(TSQLDBConnectionPropertiesThreadSafe)
  protected
  public
    /// initialize the connection properties
    // - will raise an exception if the ODBC library is not available
    constructor Create(const aServerName, aDatabaseName, aUserID, aPassWord: RawUTF8); 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
    // - this overriden method will create an TODBCConnection instance
    function NewConnection: TSQLDBConnection; override;
    /// used to create a Table
    // - should return the SQL "CREATE" statement needed to create a table with
    // the specified field/column names and types
    // - this overriden implementation will connect to the remote DB, and
    // try to guess the expected SQL statement according to its type
    function SQLCreate(const aTableName: RawUTF8;
      const aFields: TSQLDBColumnPropertyDynArray): RawUTF8; override;
    /// get all table names
    // - will retrieve the corresponding metadata from ODBC library if SQL
    // direct access was not defined
    procedure GetTableNames(var Tables: TRawUTF8DynArray); override;
    /// retrieve the column/field layout of a specified table
    // - will retrieve the corresponding metadata from ODBC library if SQL
    // direct access was not defined
    // - if GetForeignKey is TRUE, will retrieve ColumnForeignKey* properties,
    // but will be much slower
    procedure GetFields(const aTableName: RawUTF8; var Fields: TSQLDBColumnDefineDynArray); override;
  end;

  /// implements a direct connection to the ODBC library
  TODBCConnection = class(TSQLDBConnectionThreadSafe)
  protected
    fODBCProperties: TODBCConnectionProperties;
    fEnv: pointer;
    fDbc: pointer;
    fDBMS: TSQLDBDefinition;  
    fDBMSName, fDBMSVersion: RawUTF8;
  public
    /// connect to a specified ODBC database
    constructor Create(aProperties: TSQLDBConnectionProperties); override;
    /// release memory and connection
    destructor Destroy; override;
    /// connect to the ODBC library, i.e. create the DB instance
    // - should raise an Exception on error
    procedure Connect; override;
    /// stop connection to the ODBC library, i.e. release the DB instance
    // - should raise an Exception on error
    procedure Disconnect; override;
    /// return TRUE if Connect has been already successfully called
    function IsConnected: boolean; override;

    /// initialize a new SQL query statement for the given connection
    // - the caller should free the instance after use
    function NewStatement: TSQLDBStatement; override;
    /// begin a Transaction for this connection
    // - current implementation do not support nested transaction with those
    // methods: exception will be raised in such case
    procedure StartTransaction; override;
    /// commit changes of a Transaction for this connection
    // - StartTransaction method must have been called before
    procedure Commit; override;
    /// discard changes of a Transaction for this connection
    // - StartTransaction method must have been called before
    procedure Rollback; override;

    /// the remote DBMS type, as retrieved at ODBC connection opening
    property DBMS: TSQLDBDefinition read fDBMS;
  published
    /// the remote DBMS name, as retrieved at ODBC connection opening
    property DBMSName: RawUTF8 read fDBMSName;
    /// the remote DBMS version, as retrieved at ODBC connection opening
    property DBMSVersion: RawUTF8 read fDBMSVersion;
  end;

  /// implements a statement using a ODBC connection
  TODBCStatement = class(TSQLDBStatementWithParamsAndColumns)
  protected
    fStatement: pointer;
    fColTmp: pointer;
    fColTmpLen: cardinal;
    fGetColIndicator: PtrInt; // as PtrInt=SqlLen
    fGetColStatus: SmallInt; // as SqlReturn
    fSQLW: RawUnicode;
    procedure AllocStatement;
    procedure BindColumns;
    function GetCol(Col: integer; ExpectedType: TSQLDBFieldType): TSQLDBStatementGetCol;
    function GetUpdateCount: integer; override;
  public
    {{ create a ODBC statement instance, from an existing ODBC connection
     - the Execute method can be called once per TODBCStatement instance,
       but you can use the Prepare once followed by several ExecutePrepared methods
     - if the supplied connection is not of TOleDBConnection type, will raise
       an exception }
    constructor Create(aConnection: TSQLDBConnection); override;
    {{ release all associated memory and ODBC handles }
    destructor Destroy; override;

    {{ Prepare an UTF-8 encoded SQL statement
     - parameters marked as ? will be bound later, before ExecutePrepared call
     - if ExpectResults is TRUE, then Step() and Column*() methods are available
       to retrieve the data rows
     - raise an ESQLDBException on any error }
    procedure Prepare(const aSQL: RawUTF8; ExpectResults: Boolean=false); overload; override;
    {{ Execute a prepared SQL statement
     - parameters marked as ? should have been already bound with Bind*() functions
     - raise an ESQLDBException on any error }
    procedure ExecutePrepared; 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 ESQLDBException on any error }
    function Step(SeekFirst: boolean=false): boolean; override;
    {{ returns TRUE if the column contains NULL }
    function ColumnNull(Col: integer): boolean; override;
    {{ return a Column integer value of the current Row, first Col is 0 }
    function ColumnInt(Col: integer): Int64; override;
    {{ return a Column floating point value of the current Row, first Col is 0 }
    function ColumnDouble(Col: integer): double; override;
    {{ return a Column floating point value of the current Row, first Col is 0 }
    function ColumnDateTime(Col: integer): TDateTime; override;
    {{ return a Column currency value of the current Row, first Col is 0
     - should retrieve directly the 64 bit Currency content, to avoid
     any rounding/conversion error from floating-point types }
    function ColumnCurrency(Col: integer): currency; override;
    {{ return a Column UTF-8 encoded text value of the current Row, first Col is 0 }
    function ColumnUTF8(Col: integer): RawUTF8; override;
    {{ return a Column as a blob value of the current Row, first Col is 0
    - ColumnBlob() will return the binary content of the field is was not ftBlob,
      e.g. a 8 bytes RawByteString for a vtInt64/vtDouble/vtDate/vtCurrency,
      or a direct mapping of the RawUnicode  }
    function ColumnBlob(Col: integer): RawByteString; override;
    {{ append all columns values of the current Row to a JSON stream
     - will use WR.Expand to guess the expected output format
     - fast overriden implementation with no temporary variable
     - BLOB field value is saved as Base64, in the '"\uFFF0base64encodedbinary"
       format and contains true BLOB data }
    procedure ColumnsToJSON(WR: TJSONWriter); override;
  end;


implementation

uses DateUtils;


{ -------------- ODBC library interfaces, constants and types }

const
  SQL_NULL_DATA = -1;
  SQL_DATA_AT_EXEC = -2;
  SQL_NO_TOTAL = -4;

  // return values from functions
  SQL_SUCCESS = 0;
  SQL_SUCCESS_WITH_INFO = 1;

  SQL_NO_DATA = 100;

  SQL_PARAM_TYPE_UNKNOWN = 0;
  SQL_PARAM_INPUT = 1;
  SQL_PARAM_INPUT_OUTPUT = 2;
  SQL_RESULT_COL = 3;
  SQL_PARAM_OUTPUT = 4;
  SQL_RETURN_VALUE = 5;
  SQL_PARAM_DATA_AVAILABLE = 101;

  SQL_ERROR = (-1);
  SQL_INVALID_HANDLE = (-2);

  SQL_STILL_EXECUTING = 2;
  SQL_NEED_DATA = 99;

  // flags for null-terminated string
  SQL_NTS = (-3);
  SQL_NTSL = (-3);

  // maximum message length
  SQL_MAX_MESSAGE_LENGTH = 512;

  // date/time length constants
  SQL_DATE_LEN = 10;
  // add P+1 if precision is nonzero
  SQL_TIME_LEN = 8;
  // add P+1 if precision is nonzero
  SQL_TIMESTAMP_LEN = 19;

  // handle type identifiers
  SQL_HANDLE_ENV = 1;
  SQL_HANDLE_DBC = 2;
  SQL_HANDLE_STMT = 3;
  SQL_HANDLE_DESC = 4;

  // env attribute
  SQL_ATTR_ODBC_VERSION = 200;
  SQL_ATTR_CONNECTION_POOLING = 201;
  SQL_ATTR_CP_MATCH = 202;
  SQL_ATTR_OUTPUT_NTS = 10001;
  SQL_OV_ODBC3 = pointer(3);

  // connection attributes
  SQL_ACCESS_MODE = 101;
  SQL_AUTOCOMMIT = 102;
  SQL_LOGIN_TIMEOUT = 103;
  SQL_OPT_TRACE = 104;
  SQL_OPT_TRACEFILE = 105;
  SQL_TRANSLATE_DLL = 106;
  SQL_TRANSLATE_OPTION = 107;
  SQL_TXN_ISOLATION = 108;
  SQL_CURRENT_QUALIFIER = 109;
  SQL_ODBC_CURSORS = 110;
  SQL_QUIET_MODE = 111;
  SQL_PACKET_SIZE = 112;
  SQL_ATTR_AUTO_IPD = 10001;
  SQL_ATTR_METADATA_ID = 10014;

  // statement attributes
  SQL_ATTR_APP_ROW_DESC = 10010;
  SQL_ATTR_APP_PARAM_DESC = 10011;
  SQL_ATTR_IMP_ROW_DESC = 10012;
  SQL_ATTR_IMP_PARAM_DESC = 10013;
  SQL_ATTR_CURSOR_SCROLLABLE = (-1);
  SQL_ATTR_CURSOR_SENSITIVITY = (-2);

  // SQL_ATTR_CURSOR_SCROLLABLE values
  SQL_NONSCROLLABLE = 0;
  SQL_SCROLLABLE = 1;

	// SQL_AUTOCOMMIT options
  SQL_AUTOCOMMIT_OFF = pointer(0);
  SQL_AUTOCOMMIT_ON = pointer(1);

  // identifiers of fields in the SQL descriptor
  SQL_DESC_COUNT = 1001;
  SQL_DESC_TYPE = 1002;
  SQL_DESC_LENGTH = 1003;
  SQL_DESC_OCTET_LENGTH_PTR = 1004;
  SQL_DESC_PRECISION = 1005;
  SQL_DESC_SCALE = 1006;
  SQL_DESC_DATETIME_INTERVAL_CODE = 1007;
  SQL_DESC_NULLABLE = 1008;
  SQL_DESC_INDICATOR_PTR = 1009;
  SQL_DESC_DATA_PTR = 1010;
  SQL_DESC_NAME = 1011;
  SQL_DESC_UNNAMED = 1012;
  SQL_DESC_OCTET_LENGTH = 1013;
  SQL_DESC_ALLOC_TYPE = 1099;

  // identifiers of fields in the diagnostics area
  SQL_DIAG_RETURNCODE = 1;
  SQL_DIAG_NUMBER = 2;
  SQL_DIAG_ROW_COUNT = 3;
  SQL_DIAG_SQLSTATE = 4;
  SQL_DIAG_NATIVE = 5;
  SQL_DIAG_MESSAGE_TEXT = 6;
  SQL_DIAG_DYNAMIC_FUNCTION = 7;
  SQL_DIAG_CLASS_ORIGIN = 8;
  SQL_DIAG_SUBCLASS_ORIGIN = 9;
  SQL_DIAG_CONNECTION_NAME = 10;
  SQL_DIAG_SERVER_NAME = 11;
  SQL_DIAG_DYNAMIC_FUNCTION_CODE = 12;

  // SQL data type codes
  SQL_UNKNOWN_TYPE = 0;
  SQL_CHAR = 1;
  SQL_NUMERIC = 2;
  SQL_DECIMAL = 3;
  SQL_INTEGER = 4;
  SQL_SMALLINT = 5;
  SQL_FLOAT = 6;
  SQL_REAL = 7;
  SQL_DOUBLE = 8;
  SQL_DATETIME = 9;
  SQL_DATE = 9;
  SQL_INTERVAL = 10;
  SQL_TIME = 10;
  SQL_TIMESTAMP = 11;
  SQL_VARCHAR = 12;
  SQL_LONGVARCHAR = -1;
  SQL_BINARY = -2;
  SQL_VARBINARY = -3;
  SQL_LONGVARBINARY = -4;
  SQL_BIGINT = -5;
  SQL_TINYINT = -6;
  SQL_BIT = -7;
  SQL_WCHAR = -8;
  SQL_WVARCHAR = -9;
  SQL_WLONGVARCHAR = -10;
  SQL_GUID = -11;

  // One-parameter shortcuts for date/time data types
  SQL_TYPE_DATE = 91;
  SQL_TYPE_TIME = 92;
  SQL_TYPE_TIMESTAMP = 93;

  // C datatype to SQL datatype mapping
  SQL_C_CHAR = SQL_CHAR;
  SQL_C_WCHAR = SQL_WCHAR;
  SQL_C_LONG = SQL_INTEGER;
  SQL_C_SHORT = SQL_SMALLINT;
  SQL_C_FLOAT = SQL_REAL;
  SQL_C_DOUBLE = SQL_DOUBLE;
  SQL_C_NUMERIC = SQL_NUMERIC;
  SQL_C_DEFAULT = 99;
  SQL_SIGNED_OFFSET = (-20);
  SQL_UNSIGNED_OFFSET = (-22);
  SQL_C_DATE = SQL_DATE;
  SQL_C_TIME = SQL_TIME;
  SQL_C_TIMESTAMP = SQL_TIMESTAMP;
  SQL_C_TYPE_DATE = SQL_TYPE_DATE;
  SQL_C_TYPE_TIME = SQL_TYPE_TIME;
  SQL_C_TYPE_TIMESTAMP = SQL_TYPE_TIMESTAMP;
  SQL_C_BINARY = SQL_BINARY;
  SQL_C_BIT = SQL_BIT;
  SQL_C_SBIGINT = (SQL_BIGINT+SQL_SIGNED_OFFSET);
  SQL_C_UBIGINT = (SQL_BIGINT+SQL_UNSIGNED_OFFSET);
  SQL_C_TINYINT = SQL_TINYINT;
  SQL_C_SLONG = (SQL_C_LONG+SQL_SIGNED_OFFSET);
  SQL_C_SSHORT = (SQL_C_SHORT+SQL_SIGNED_OFFSET);
  SQL_C_STINYINT = (SQL_TINYINT+SQL_SIGNED_OFFSET);
  SQL_C_ULONG = (SQL_C_LONG+SQL_UNSIGNED_OFFSET);
  SQL_C_USHORT = (SQL_C_SHORT+SQL_UNSIGNED_OFFSET);
  SQL_C_UTINYINT = (SQL_TINYINT+SQL_UNSIGNED_OFFSET);

  // Statement attribute values for cursor sensitivity
  SQL_UNSPECIFIED = 0;
  SQL_INSENSITIVE = 1;
  SQL_SENSITIVE = 2;

  // GetTypeInfo() request for all data types
  SQL_ALL_TYPES = 0;

  // Default conversion code for SQLBindCol(), SQLBindParam() and SQLGetData()
  SQL_DEFAULT = 99;

  // SQLSQLLEN GetData() code indicating that the application row descriptor
  // specifies the data type
  SQL_ARD_TYPE = (-99);

  SQL_APD_TYPE = (-100);

  // SQL date/time type subcodes
  SQL_CODE_DATE = 1;
  SQL_CODE_TIME = 2;
  SQL_CODE_TIMESTAMP = 3;

  // CLI option values
  SQL_FALSE = 0;
  SQL_TRUE = 1;

  // values of NULLABLE field in descriptor
  SQL_NO_NULLS = 0;
  SQL_NULLABLE = 1;

  // Value returned by SQLGetTypeInfo() to denote that it is
  // not known whether or not a data type supports null values.
  SQL_NULLABLE_UNKNOWN = 2;

  // Values returned by SQLGetTypeInfo() to show WHERE clause supported
  SQL_PRED_NONE = 0;
  SQL_PRED_CHAR = 1;
  SQL_PRED_BASIC = 2;

  // values of UNNAMED field in descriptor
  SQL_NAMED = 0;
  SQL_UNNAMED = 1;

  // values of ALLOC_TYPE field in descriptor
  SQL_DESC_ALLOC_AUTO = 1;
  SQL_DESC_ALLOC_USER = 2;

  // FreeStmt() options
  SQL_CLOSE = 0;
  SQL_DROP = 1;
  SQL_UNBIND = 2;
  SQL_RESET_PARAMS = 3;

  // Codes used for FetchOrientation in SQLFetchScroll() and SQLDataSources()
  SQL_FETCH_NEXT = 1;
  SQL_FETCH_FIRST = 2;

  // Other codes used for FetchOrientation in SQLFetchScroll()
  SQL_FETCH_LAST = 3;
  SQL_FETCH_PRIOR = 4;
  SQL_FETCH_ABSOLUTE = 5;
  SQL_FETCH_RELATIVE = 6;

  // SQLEndTran() options
  SQL_COMMIT = 0;
  SQL_ROLLBACK = 1;

  // null handles returned by SQLAllocHandle()
  SQL_NULL_HENV = 0;
  SQL_NULL_HDBC = 0;
  SQL_NULL_HSTMT = 0;
  SQL_NULL_HDESC = 0;

  // null handle used in place of parent handle when allocating HENV
  SQL_NULL_HANDLE = nil;

// Information requested by SQLGetInfo()
  SQL_MAX_DRIVER_CONNECTIONS = 0;
  SQL_MAXIMUM_DRIVER_CONNECTIONS = SQL_MAX_DRIVER_CONNECTIONS;
  SQL_MAX_CONCURRENT_ACTIVITIES = 1;
  SQL_MAXIMUM_CONCURRENT_ACTIVITIES = SQL_MAX_CONCURRENT_ACTIVITIES;
  SQL_DATA_SOURCE_NAME = 2;
  SQL_FETCH_DIRECTION = 8;
  SQL_SERVER_NAME = 13;
  SQL_SEARCH_PATTERN_ESCAPE = 14;
  SQL_DBMS_NAME = 17;
  SQL_DBMS_VER = 18;
  SQL_ACCESSIBLE_TABLES = 19;
  SQL_ACCESSIBLE_PROCEDURES = 20;
  SQL_CURSOR_COMMIT_BEHAVIOR = 23;
  SQL_DATA_SOURCE_READ_ONLY = 25;
  SQL_DEFAULT_TXN_ISOLATION = 26;
  SQL_IDENTIFIER_CASE = 28;
  SQL_IDENTIFIER_QUOTE_CHAR = 29;
  SQL_MAX_COLUMN_NAME_LEN = 30;
  SQL_MAXIMUM_COLUMN_NAME_LENGTH = SQL_MAX_COLUMN_NAME_LEN;
  SQL_MAX_CURSOR_NAME_LEN = 31;
  SQL_MAXIMUM_CURSOR_NAME_LENGTH = SQL_MAX_CURSOR_NAME_LEN;
  SQL_MAX_SCHEMA_NAME_LEN = 32;
  SQL_MAXIMUM_SCHEMA_NAME_LENGTH = SQL_MAX_SCHEMA_NAME_LEN;
  SQL_MAX_CATALOG_NAME_LEN = 34;
  SQL_MAXIMUM_CATALOG_NAME_LENGTH = SQL_MAX_CATALOG_NAME_LEN;
  SQL_MAX_TABLE_NAME_LEN = 35;
  SQL_SCROLL_CONCURRENCY = 43;
  SQL_TXN_CAPABLE = 46;
  SQL_TRANSACTION_CAPABLE = SQL_TXN_CAPABLE;
  SQL_USER_NAME = 47;
  SQL_TXN_ISOLATION_OPTION = 72;
  SQL_TRANSACTION_ISOLATION_OPTION = SQL_TXN_ISOLATION_OPTION;
  SQL_INTEGRITY = 73;
  SQL_GETDATA_EXTENSIONS = 81;
  SQL_NULL_COLLATION = 85;
  SQL_ALTER_TABLE = 86;
  SQL_ORDER_BY_COLUMNS_IN_SELECT = 90;
  SQL_SPECIAL_CHARACTERS = 94;
  SQL_MAX_COLUMNS_IN_GROUP_BY = 97;
  SQL_MAXIMUM_COLUMNS_IN_GROUP_BY = SQL_MAX_COLUMNS_IN_GROUP_BY;
  SQL_MAX_COLUMNS_IN_INDEX = 98;
  SQL_MAXIMUM_COLUMNS_IN_INDEX = SQL_MAX_COLUMNS_IN_INDEX;
  SQL_MAX_COLUMNS_IN_ORDER_BY = 99;
  SQL_MAXIMUM_COLUMNS_IN_ORDER_BY = SQL_MAX_COLUMNS_IN_ORDER_BY;
  SQL_MAX_COLUMNS_IN_SELECT = 100;
  SQL_MAXIMUM_COLUMNS_IN_SELECT = SQL_MAX_COLUMNS_IN_SELECT;
  SQL_MAX_COLUMNS_IN_TABLE = 101;
  SQL_MAX_INDEX_SIZE = 102;
  SQL_MAXIMUM_INDEX_SIZE = SQL_MAX_INDEX_SIZE;
  SQL_MAX_ROW_SIZE = 104;
  SQL_MAXIMUM_ROW_SIZE = SQL_MAX_ROW_SIZE;
  SQL_MAX_STATEMENT_LEN = 105;
  SQL_MAXIMUM_STATEMENT_LENGTH = SQL_MAX_STATEMENT_LEN;
  SQL_MAX_TABLES_IN_SELECT = 106;
  SQL_MAXIMUM_TABLES_IN_SELECT = SQL_MAX_TABLES_IN_SELECT;
  SQL_MAX_USER_NAME_LEN = 107;
  SQL_MAXIMUM_USER_NAME_LENGTH = SQL_MAX_USER_NAME_LEN;
  SQL_OJ_CAPABILITIES = 115;
  SQL_OUTER_JOIN_CAPABILITIES = SQL_OJ_CAPABILITIES;


type
  SqlSmallint = Smallint;
  SqlDate = Byte;
  SqlTime = Byte;
  SqlDecimal = Byte;
  SqlDouble = Double;
................................................................................

  SqlHandle = Pointer;
  SqlHEnv = SqlHandle;
  SqlHDbc = SqlHandle;
  SqlHStmt = SqlHandle;
  SqlHDesc = SqlHandle;

  {$A-}
  /// memory structure used to store SQL_C_TYPE_TIMESTAMP values
  SQL_TIMESTAMP_STRUCT = object
    Year:     SqlSmallint;
    Month:    SqlUSmallint;
    Day:      SqlUSmallint;
    Hour:     SqlUSmallint;
    Minute:   SqlUSmallint;
    Second:   SqlUSmallint;
    Fraction: SqlUInteger;
    /// convert an ODBC date and time into Delphi TDateTime
    // - depending on the original column data type specified, it will return
    // either a TDate (for SQL_TYPE_DATE), either a TTime (for SQL_TYPE_TIME),
    // either a TDateTime content (for SQL_TYPE_TIMESTAMP)
    function ToDateTime(DataType: SqlSmallint=SQL_TYPE_TIMESTAMP): TDateTime;
    /// convert an ODBC date and time into its textual expanded ISO-8601
    // - will fill up to 21 characters, including double quotes
    // - depending on the column data type specified, it will return either an
    // ISO-8601 date (for SQL_TYPE_DATE), either a time (for SQL_TYPE_TIME),
    // either a full date+time ISO-8601 content (for SQL_TYPE_TIMESTAMP)
    function ToIso8601(Dest: PUTF8Char; DataType: SqlSmallint): integer;
    /// convert a TDateTime into ODBC date or timestamp
    // - returns the corresponding C type, i.e. either SQL_C_TYPE_DATE,
    // either SQL_C_TYPE_TIMESTAMP
    function From(DateTime: TDateTime): SqlSmallint;
  end;
  SQL_TIME_STRUCT	= record
    Hour:     SqlUSmallint;
    Minute:   SqlUSmallint;
    Second:   SqlUSmallint;
  end;
  SQL_DATE_STRUCT	= record
    year:	SQLSMALLINT;
    month:	SQLUSMALLINT;
    day:	SQLUSMALLINT;
  end;
  {$A+}
  PSQL_TIMESTAMP_STRUCT = ^SQL_TIMESTAMP_STRUCT;

  /// direct access to the ODBC library
  // - this wrapper will initialize both Ansi and Wide versions of the ODBC
  // driver functions, and will work with 32 bit and 64 bit version of the
  // interfaces, on Windows or POSIX platforms
  // - within this unit, we will only use Wide version, and UTF-8 conversion
  TODBCLib = class(TSQLDBLib)
  protected
    procedure HandleError(Status: SqlReturn; HandleType: SqlSmallint; Handle: SqlHandle;
      InfoRaiseException: Boolean; LogLevelNoRaise: TSynLogInfo);
  public


    AllocEnv: function (var EnvironmentHandle: SqlHEnv): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    AllocHandle: function(HandleType: SqlSmallint; InputHandle: SqlHandle;
      var OutputHandle: SqlHandle): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    AllocStmt: function(ConnectionHandle: SqlHDbc; var StatementHandle: SqlHStmt): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    BindCol: function(StatementHandle: SqlHStmt; ColumnNumber: SqlUSmallint;
      TargetType: SqlSmallint; TargetValue: SqlPointer;
      BufferLength: SqlLen; StrLen_or_Ind: PSqlLen): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    BindParameter: function (StatementHandle: SqlHStmt; ParameterNumber: SqlUSmallint;

      InputOutputType, ValueType, ParameterType: SqlSmallint; ColumnSize: SqlULen;
      DecimalDigits: SqlSmallint; ParameterValue: SqlPointer; BufferLength: SqlLen;
      var StrLen_or_Ind: SqlLen): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    Cancel: function(StatementHandle: SqlHStmt): SqlReturn;

      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    CloseCursor: function(StatementHandle: SqlHStmt): SqlReturn;

     {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    ColAttributeA: function(StatementHandle: SqlHStmt; ColumnNumber: SqlUSmallint;
      FieldIdentifier: SqlUSmallint; CharacterAttribute: PAnsiChar;
      BufferLength: SqlSmallint; StringLength: PSqlSmallint; NumericAttributePtr: PSqlLen): SqlReturn;

      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    ColAttributeW: function(StatementHandle: SqlHStmt; ColumnNumber: SqlUSmallint;
      FieldIdentifier: SqlUSmallint; CharacterAttribute: PWideChar;
      BufferLength: SqlSmallint; StringLength: PSqlSmallint; NumericAttributePtr: PSqlLen): SqlReturn;

       {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    ColumnsA: function(StatementHandle: SqlHStmt;
      CatalogName: PAnsiChar; NameLength1: SqlSmallint;
      SchemaName: PAnsiChar;  NameLength2: SqlSmallint;
      TableName: PAnsiChar;   NameLength3: SqlSmallint;
      ColumnName: PAnsiChar;  NameLength4: SqlSmallint): SqlReturn;

      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    ColumnsW: function(StatementHandle: SqlHStmt;
      CatalogName: PWideChar; NameLength1: SqlSmallint;
      SchemaName: PWideChar;  NameLength2: SqlSmallint;
      TableName: PWideChar;   NameLength3: SqlSmallint;
      ColumnName: PWideChar;  NameLength4: SqlSmallint): SqlReturn;

      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    ConnectA: function(ConnectionHandle: SqlHDbc;
      ServerName: PAnsiChar; NameLength1: SqlSmallint;
      UserName: PAnsiChar; NameLength2: SqlSmallint;
      Authentication: PAnsiChar; NameLength3: SqlSmallint): SqlReturn;

      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    ConnectW: function(ConnectionHandle: SqlHDbc;
      ServerName: PWideChar; NameLength1: SqlSmallint;
      UserName: PWideChar; NameLength2: SqlSmallint;
      Authentication: PWideChar; NameLength3: SqlSmallint): SqlReturn;

      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    CopyDesc: function(SourceDescHandle, TargetDescHandle: SqlHDesc): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    DataSourcesA: function(EnvironmentHandle: SqlHEnv; Direction: SqlUSmallint;
      ServerName: PAnsiChar;  BufferLength1: SqlSmallint; var NameLength1: SqlSmallint;
      Description: PAnsiChar; BufferLength2: SqlSmallint; var NameLength2: SqlSmallint): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
................................................................................
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    SetConnectAttrA: function(ConnectionHandle: SqlHDbc; Attribute: SqlInteger;
      ValuePtr: SqlPointer; StringLength: SqlInteger): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    SetConnectAttrW: function(ConnectionHandle: SqlHDbc; Attribute: SqlInteger;
      ValuePtr: SqlPointer; StringLength: SqlInteger): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    TablesA: function(StatementHandle: SqlHStmt;
      CatalogName: PAnsiChar; NameLength1: SqlSmallint;
      SchemaName: PAnsiChar; NameLength2: SqlSmallint;
      TableName: PAnsiChar; NameLength3: SqlSmallint;
      TableType: PAnsiChar; NameLength4: SqlSmallint): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
     TablesW: function(StatementHandle: SqlHStmt;
       CatalogName: PWideChar; NameLength1: SqlSmallint;
      SchemaName: PWideChar; NameLength2: SqlSmallint;
      TableName: PWideChar; NameLength3: SqlSmallint;
      TableType: PWideChar; NameLength4: SqlSmallint): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
   public
     /// load the ODBC library
     // - and retrieve all SQL*() addresses for ODBC_ENTRIES[] items
    constructor Create;
    /// raise an exception on error
    procedure Check(Status: SqlReturn; HandleType: SqlSmallint; Handle: SqlHandle; 
      InfoRaiseException: Boolean=false; LogLevelNoRaise: TSynLogInfo=sllNone);
      {$ifdef HASINLINE} inline; {$endif}
   end;

const
  ODBC_ENTRIES: array[0..56] of PChar =
    ('SQLAllocEnv','SQLAllocHandle','SQLAllocStmt',
     'SQLBindCol','SQLBindParameter','SQLCancel','SQLCloseCursor',
     'SQLColAttribute','SQLColAttributeW','SQLColumns','SQLColumnsW',
     'SQLConnect','SQLConnectW','SQLCopyDesc','SQLDataSources','SQLDataSourcesW',
     'SQLDescribeCol','SQLDescribeColW','SQLDisconnect','SQLEndTran',
     'SQLError','SQLErrorW','SQLExecDirect','SQLExecDirectW','SQLExecute',
     'SQLFetch','SQLFetchScroll','SQLFreeConnect','SQLFreeEnv','SQLFreeHandle',
     'SQLFreeStmt','SQLGetConnectAttr','SQLGetConnectAttrW',
     'SQLGetCursorName','SQLGetCursorNameW','SQLGetData',
     'SQLGetDescField','SQLGetDescFieldW','SQLGetDescRec','SQLGetDescRecW',
     'SQLGetDiagField','SQLGetDiagFieldW','SQLGetDiagRec','SQLGetDiagRecW',
     'SQLPrepare','SQLPrepareW','SQLRowCount','SQLNumResultCols',
     'SQLGetInfo','SQLGetInfoW','SQLSetStmtAttr','SQLSetStmtAttrW','SQLSetEnvAttr',
     'SQLSetConnectAttr','SQLSetConnectAttrW','SQLTables','SQLTablesW');

var
  ODBC: TODBCLib = nil;


{ TODBCConnection }

procedure TODBCConnection.Connect;
var Log: ISynLog;
    Len: SqlSmallint;
    Info: array[byte] of WideChar;
begin
  Log := SynDBLog.Enter;
  Disconnect; // force fDbc=nil
  if fEnv=nil then
    if (ODBC=nil) or (ODBC.AllocHandle(SQL_HANDLE_ENV,SQL_NULL_HANDLE,fEnv)=SQL_ERROR) then
      raise EODBCException.CreateFmt('%s: Unable to allocate an environment handle',[ClassName]);
  with ODBC do
  try
    Check(SetEnvAttr(fEnv,SQL_ATTR_ODBC_VERSION,SQL_OV_ODBC3,0),SQL_HANDLE_ENV,fEnv);
    Check(AllocHandle(SQL_HANDLE_DBC,fEnv,fDbc),SQL_HANDLE_ENV,fEnv);
    with fODBCProperties do
      Check(ConnectA(fDbc,pointer(fServerName),length(fServerName),
        pointer(fUserID),length(fUserID),pointer(fPassWord),length(fPassWord)),
        SQL_HANDLE_DBC,fDbc);
    Check(GetInfoW(fDbc,SQL_DBMS_NAME,@Info,sizeof(Info)shr 1,@Len),SQL_HANDLE_DBC,fDbc);
    fDBMSName := RawUnicodeToUtf8(Info,Len shr 1);
    fDBMS := dDefault;
    if fDBMSName<>'' then
      if IdemPChar(pointer(fDBMSName),'ORACLE') then
        fDBMS := dOracle else
      if IdemPChar(pointer(fDBMSName),'MICROSOFT SQL') then
        fDBMS := dMSSQL else
      if IdemPChar(pointer(fDBMSName),'ACCESS') then
        fDBMS := dJet else
      if IdemPChar(pointer(fDBMSName),'MYSQL') then
        fDBMS := dMySQL else
      if IdemPChar(pointer(fDBMSName),'SQLITE') then
        fDBMS := dSQLite;
    Check(GetInfoW(fDbc,SQL_DBMS_VER,@Info,sizeof(Info)shr 1,@Len),SQL_HANDLE_DBC,fDbc);
    fDBMSVersion := RawUnicodeToUtf8(Info,Len shr 1);
  except
    on E: Exception do begin
      Log.Log(sllError,E);
      self.Disconnect; // clean up on fail
      raise;
    end;
  end;
end;

constructor TODBCConnection.Create(aProperties: TSQLDBConnectionProperties);
var Log: ISynLog;
begin
  Log := SynDBLog.Enter(self);
  if not aProperties.InheritsFrom(TODBCConnectionProperties) then
    raise EODBCException.CreateFmt('Invalid %s.Create',[ClassName]);
  Log.Log(sllDB,aProperties);
  fODBCProperties := TODBCConnectionProperties(aProperties);
  inherited;
end;

destructor TODBCConnection.Destroy;
begin
  inherited Destroy;
  if (ODBC<>nil) and (fEnv<>nil) then
    ODBC.FreeHandle(SQL_HANDLE_ENV,fEnv);
end;

procedure TODBCConnection.Disconnect;
begin
  if (ODBC<>nil) and (fDbc<>nil) then
  with ODBC do begin
    SynDBLog.Enter(self);
    Disconnect(fDbc);
    FreeHandle(SQL_HANDLE_DBC,fDbc);
    fDbc := nil;
  end;
end;

function TODBCConnection.IsConnected: boolean;
begin
  result := fDbc<>nil;
end;

function TODBCConnection.NewStatement: TSQLDBStatement;
begin
  result := TODBCStatement.Create(self);
end;

procedure TODBCConnection.Commit;
begin
  inherited Commit;
  with ODBC do begin
    Check(EndTran(SQL_HANDLE_DBC,fDBc,SQL_COMMIT),SQL_HANDLE_DBC,fDBc);
    Check(SetConnectAttrW(fDBc,SQL_AUTOCOMMIT,SQL_AUTOCOMMIT_ON,0),
      SQL_HANDLE_DBC,fDBc); // back to default AUTO COMMIT ON mode
  end;
end;

procedure TODBCConnection.Rollback;
begin
  inherited RollBack;
  with ODBC do begin
    Check(EndTran(SQL_HANDLE_DBC,fDBc,SQL_ROLLBACK),SQL_HANDLE_DBC,fDBc);
    Check(SetConnectAttrW(fDBc,SQL_AUTOCOMMIT,SQL_AUTOCOMMIT_ON,0),
      SQL_HANDLE_DBC,fDBc); // back to default AUTO COMMIT ON mode
  end;
end;

procedure TODBCConnection.StartTransaction;
begin
  if TransactionCount>0 then
    raise EODBCException.Create('TODBCConnection do not provide nested transactions');
  inherited StartTransaction;
  ODBC.Check(ODBC.SetConnectAttrW(fDBc,SQL_AUTOCOMMIT,SQL_AUTOCOMMIT_OFF,0),
    SQL_HANDLE_DBC,fDBc);
end;


{ TODBCStatement }

procedure TODBCStatement.AllocStatement;
var hDbc: SqlHDbc;
begin
  if fStatement<>nil then
    raise EODBCException.Create('AllocStatement called twice');
  fCurrentRow := 0;
  if not fConnection.Connected then
    fConnection.Connect;
  hDbc := (fConnection as TODBCConnection).fDbc;
  with ODBC do 
    Check(AllocHandle(SQL_HANDLE_STMT,hDBC,fStatement),SQL_HANDLE_DBC,hDBC);
end;

function ODBCColumnToFieldType(DataType, ColumnPrecision, ColumnScale: integer): TSQLDBFieldType;
begin // ftUnknown, ftNull, ftInt64, ftDouble, ftCurrency, ftDate, ftUTF8, ftBlob
  case DataType of
    SQL_DECIMAL, SQL_NUMERIC, SQL_FLOAT: begin
      result := ftDouble;
      if ColumnPrecision=10 then
        case ColumnScale of
        0:    result := ftInt64;
        1..4: result := ftCurrency;
        end;
    end;
    SQL_REAL, SQL_DOUBLE:
      result := ftDouble;
    SQL_SMALLINT, SQL_INTEGER, SQL_TINYINT, SQL_BIT, SQL_BIGINT:
      result := ftInt64;
    SQL_BINARY, SQL_VARBINARY, SQL_LONGVARBINARY:
      result := ftBlob;
    SQL_TIME, SQL_DATETIME,
    SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TYPE_TIMESTAMP:
      result := ftDate;
    else // all other types will be converted to text
      result := ftUtf8;
  end;
end;

const
  /// internal mapping to handled GetData() type for Column*() methods
  // - numerical values (integer or floating-point) are converted to SQL_C_CHAR
  // - date/time to SQL_C_TYPE_TIMESTAMP object
  // - text columns to SQL_C_WCHAR (for proper UTF-8 data retrieval)
  // - BLOB columns to SQL_C_BINARY
  ODBC_TYPE_TO: array[TSQLDBFieldType] of ShortInt = (
   SQL_C_CHAR, SQL_C_CHAR, SQL_C_CHAR, SQL_C_CHAR, SQL_C_CHAR,
   SQL_C_TYPE_TIMESTAMP, SQL_C_WCHAR, SQL_C_BINARY);
   // ftUnknown, ftNull, ftInt64, ftDouble, ftCurrency, ftDate, ftUTF8, ftBlob

procedure TODBCStatement.BindColumns;
var nCols, NameLength, DataType, DecimalDigits, Nullable: SqlSmallint;
    ColumnSize, siz: SqlULen;
    c: integer;
    Name: array[byte] of WideChar;
begin
  if (fColumnCount>0) or (fColTmp<>nil) then
    raise EODBCException.Create('TODBCStatement.BindColumns twice');
  with ODBC do begin
    Check(NumResultCols(fStatement,nCols),SQL_HANDLE_STMT,fStatement);
    for c := 1 to nCols do begin
      Check(DescribeColW(fStatement,c,Name,256,NameLength,DataType,ColumnSize,
        DecimalDigits,Nullable),SQL_HANDLE_STMT,fStatement);
      with PSQLDBColumnProperty(fColumn.AddAndMakeUniqueName(
         RawUnicodeToUtf8(Name,NameLength)))^ do begin
        ColumnValueInlined := true;
        ColumnValueDBType := DataType;
        ColumnValueDBSize := ColumnSize;
        ColumnNonNullable := (Nullable=SQL_NO_NULLS);
        ColumnType := ODBCColumnToFieldType(DataType,10,DecimalDigits);
        if ColumnType=ftUTF8 then
          siz := ColumnSize*2+2 else // guess max size as WideChar buffer
          siz := ColumnSize;
        if siz>fColTmpLen then
          fColTmpLen := siz;
      end;
    end;
    assert(fColumnCount=nCols);
    if fColTmpLen<63 then
      fColTmpLen := 64; /// ODBC never truncates fixed-length data: ensure enough
    GetMem(fColTmp,fColTmpLen);
  end;
end;

function TODBCStatement.GetCol(Col: integer; ExpectedType: TSQLDBFieldType): TSQLDBStatementGetCol;
const MINIMUM_CHUNK_SIZE = 65536;
begin // colNull, colWrongType, colTmpUsed, colTmpUsedTruncated
  CheckCol(Col); // check Col value
  if not Assigned(fStatement) or (fColumnCount=0) or (fColTmp=nil) then
    raise EODBCException.Create('TODBCStatement.Column*() with no prior Execute');
  with fColumns[Col] do
    if ColumnValueState=colNull then
      result := colNull else begin
    if (ColumnValueState=colTmpUsedTruncated) and (fColTmpLen<MINIMUM_CHUNK_SIZE) then begin
      FreeMem(fColTmp);
      GetMem(fColTmp,MINIMUM_CHUNK_SIZE);
      fColTmpLen := MINIMUM_CHUNK_SIZE;
    end;
    if ColumnValueState<>colWrongType then
      fGetColStatus := ODBC.GetData(fStatement,Col+1,ODBC_TYPE_TO[ColumnType],
        fColTmp,fColTmpLen,@fGetColIndicator);
    if ColumnType<>ExpectedType then begin
      if fGetColIndicator=SQL_NULL_DATA then
        result := colNull else
        result := colWrongType;
    end else begin
      if fGetColStatus<>SQL_SUCCESS then 
        if (fGetColStatus=SQL_SUCCESS_WITH_INFO) and
           (ColumnType in FIXEDLENGTH_SQLDBFIELDTYPE) then
          fGetColStatus := SQL_SUCCESS else // allow rounding problem
          ODBC.HandleError(fGetColStatus,SQL_HANDLE_STMT,fStatement,false,sllNone);
      case fGetColIndicator of
      SQL_NULL_DATA:
        result := colNull;
      SQL_NO_TOTAL:
        if ColumnType in [ftInt64, ftDouble, ftCurrency, ftDate] then
          result := colTmpUsed else
          raise EODBCException.CreateFmt('"%s" column returned no size',[ColumnName]);
      else
        if fGetColIndicator<0 then
          raise EODBCException.CreateFmt('"%s" column returned invalid size',[ColumnName]) else
          if fGetColStatus=SQL_SUCCESS then
            result := colTmpUsed else
            result := colTmpUsedTruncated;
      end;
    end;
    ColumnValueState := result;
  end;
end;

function TODBCStatement.ColumnBlob(Col: integer): RawByteString;
var res: TSQLDBStatementGetCol;
    offs: integer;
begin
  res := GetCol(Col,ftBlob);
  case res of
    colNull:      result := '';
    colWrongType: ColumnToTypedValue(Col,ftBlob,result);
    else begin
      SetString(result,PAnsiChar(fColTmp),fGetColIndicator);
      offs := 0;
      while res=colTmpUsedTruncated do begin
        inc(offs,fGetColIndicator);
        res := GetCol(Col,ftBlob); // get next chunk of data
        if fGetColIndicator<=0 then
          break;
        SetLength(result,offs+fGetColIndicator);
        move(fColTmp^,PByteArray(result)^[offs],fGetColIndicator);
      end;
    end;
  end;
end;

function TODBCStatement.ColumnUTF8(Col: integer): RawUTF8;
var res: TSQLDBStatementGetCol;
begin
  res := GetCol(Col,ftUTF8);
  case res of
    colNull:      result := '';
    colWrongType: ColumnToTypedValue(Col,ftUTF8,result);
    else begin
      result := RawUnicodeToUtf8(fColTmp,fGetColIndicator shr 1);
      while res=colTmpUsedTruncated do begin
        res := GetCol(Col,ftUTF8); // get next chunk of Unicode text
        if fGetColIndicator<=0 then
          break;
        result := result+RawUnicodeToUtf8(fColTmp,fGetColIndicator shr 1);
      end;
    end;
  end;
end;

function TODBCStatement.ColumnCurrency(Col: integer): currency;
begin
  case GetCol(Col,ftCurrency) of
    colNull:      result := 0;
    colWrongType: ColumnToTypedValue(Col,ftCurrency,result);
    else PInt64(@result)^ := StrToCurr64(fColTmp); // encoded as SQL_C_CHAR
  end;
end;

function TODBCStatement.ColumnDateTime(Col: integer): TDateTime;
begin
  case GetCol(Col,ftDate) of
    colNull:      result := 0;
    colWrongType: ColumnToTypedValue(Col,ftDate,result);
    else result := PSQL_TIMESTAMP_STRUCT(fColTmp)^.ToDateTime(
      fColumns[Col].ColumnValueDBType);
  end;
end;

function TODBCStatement.ColumnDouble(Col: integer): double;
begin
  case GetCol(Col,ftDouble) of
    colNull:      result := 0;
    colWrongType: ColumnToTypedValue(Col,ftDouble,result);
    else result := GetExtended(fColTmp); // encoded as SQL_C_CHAR
  end;
end;

function TODBCStatement.ColumnInt(Col: integer): Int64;
begin
  case GetCol(Col,ftInt64) of
    colNull:      result := 0;
    colWrongType: ColumnToTypedValue(Col,ftInt64,result);
    else SetInt64(fColTmp,result); // encoded as SQL_C_CHAR
  end;
end;

function TODBCStatement.ColumnNull(Col: integer): boolean;
begin // ftUnknown will only retrieve up to 32 bytes, but check for NULL
  result := GetCol(Col,ftUnknown)=colNull;
end;

procedure TODBCStatement.ColumnsToJSON(WR: TJSONWriter);
var res: TSQLDBStatementGetCol;
    col, offs: integer;
    tmp: array[0..31] of AnsiChar;
    blob: RawByteString;
begin
  if not Assigned(fStatement) or (CurrentRow<=0) then
    raise EODBCException.Create('TODBCStatement.ColumnsToJSON() with no prior Step');
  if WR.Expand then
    WR.Add('{');
  for col := 0 to fColumnCount-1 do // fast direct conversion from OleDB buffer
  with fColumns[col] do begin
    if WR.Expand then
      WR.AddFieldName(ColumnName); // add '"ColumnName":'
    res := GetCol(Col,ColumnType);
    if res=colNull then
      WR.AddShort('null') else
      case ColumnType of
      ftInt64:
        WR.AddNoJSONEscape(fColTmp);  // already as SQL_C_CHAR
      ftDouble, ftCurrency:
        WR.AddFloatStr(fColTmp);      // already as SQL_C_CHAR
      ftDate:
        WR.AddNoJSONEscape(@tmp,
          PSQL_TIMESTAMP_STRUCT(fColTmp)^.ToIso8601(tmp,ColumnValueDBType));
      ftUTF8: begin
        WR.Add('"');
        WR.AddJSONEscapeW(fColTmp,fGetColIndicator shr 1);
        while res=colTmpUsedTruncated do begin
          res := GetCol(col,ftUTF8);  // get next chunk of Unicode text
          if fGetColIndicator<=0 then
            break;
          WR.AddJSONEscapeW(fColTmp,fGetColIndicator shr 1);
        end;
        WR.Add('"');
      end;
      ftBlob: begin
        SetString(blob,PAnsiChar(fColTmp),fGetColIndicator);
        offs := 0;
        while res=colTmpUsedTruncated do begin
          inc(offs,fGetColIndicator);
          res := GetCol(Col,ftBlob); // get next chunk of data
          if fGetColIndicator<=0 then
            break;
          SetLength(blob,offs+fGetColIndicator);
          move(fColTmp^,PByteArray(blob)^[offs],fGetColIndicator);
        end;
        WR.WrBase64(pointer(blob),length(blob),true);
      end;
      else assert(false);
    end;
    WR.Add(',');
  end;
  WR.CancelLastComma; // cancel last ','
  if WR.Expand then
    WR.Add('}');
end;

constructor TODBCStatement.Create(aConnection: TSQLDBConnection);
begin
  if not aConnection.InheritsFrom(TODBCConnection) then
    raise ESQLDBException.CreateFmt('%s.Create expects a TODBCConnection',[ClassName]);
  inherited Create(aConnection);
end;

destructor TODBCStatement.Destroy;
begin
  try
    if fStatement<>nil then begin
      ODBC.FreeStmt(fStatement,SQL_CLOSE);
      ODBC.FreeHandle(SQL_HANDLE_STMT,fStatement);
    end;
  finally
    if fColTmp<>nil then
      FreeMem(fColTmp);
    inherited Destroy;
  end;
end;

procedure TODBCStatement.ExecutePrepared;
const
  ODBC_IOTYPE_TO_PARAM: array[TSQLDBParamInOutType] of ShortInt = (
    SQL_PARAM_INPUT, SQL_PARAM_OUTPUT, SQL_PARAM_INPUT_OUTPUT);
var p: integer;
    InputOutputType, ValueType: SqlSmallint;
    ColumnSize: SqlULen;
    ParameterValue: SqlPointer;
    StrLen_or_Ind: SqlLen;
begin
  if fStatement=nil then
    raise EODBCException.Create('ExecutePrepared called without previous Prepare');
  if (fSQL<>'') and (sllSQL in SynDBLog.Family.Level) then
    SynDBLog.Add.Log(sllSQL,SQLWithInlinedParams,self);
  try
    // 1. bind parameters
    if fParamCount>0 then
      for p := 0 to fParamCount-1 do
      with fParams[p] do begin
        StrLen_or_Ind := SQL_NTS;
        ParameterValue := nil;
        ValueType := ODBC_TYPE_TO[VType];
        InputOutputType := ODBC_IOTYPE_TO_PARAM[VInOut];
        case VType of
        ftNull:
          StrLen_or_Ind := SQL_NULL_DATA;
        ftInt64:
          if VInOut=paramIn then
            VData := Int64ToUTF8(VInt64) else begin
            ValueType := SQL_C_SBIGINT;
            ParameterValue := pointer(@VInt64);
          end;
        ftDouble: begin
          ValueType := SQL_C_DOUBLE;
          ParameterValue := pointer(@VInt64);
        end;
        ftCurrency:
          if VInOut=paramIn then
            VData := Curr64ToStr(VInt64) else begin
            ValueType := SQL_C_DOUBLE;
            PDouble(@VInt64)^ := PCurrency(@VInt64)^;
            ParameterValue := pointer(@VInt64);
          end;
        ftDate: begin
          SetLength(VData,sizeof(SQL_TIMESTAMP_STRUCT));
          ValueType := PSQL_TIMESTAMP_STRUCT(VData)^.From(PDateTime(@VInt64)^);
        end;
        ftUTF8:
          VData := Utf8DecodeToRawUnicodeUI(VData);
        ftBlob:
          StrLen_or_Ind := length(VData);
        else
          raise EODBCException.CreateFmt('Invalid bound parameter #%d',[p+1]);
        end;
        if ParameterValue=nil then begin
          ParameterValue := pointer(VData);
          ColumnSize := length(VData);
          if (ValueType=SQL_C_CHAR) or (ValueType=SQL_C_WCHAR) then
            inc(ColumnSize);
        end else
          ColumnSize := SizeOf(Int64);
        ODBC.Check(ODBC.BindParameter(fStatement, p+1, InputOutputType,
          ValueType, ValueType, ColumnSize, 0, ParameterValue, ColumnSize,
          StrLen_or_Ind), SQL_HANDLE_STMT,fStatement);
      end;
    // 2. execute prepared statement
    ODBC.Check(ODBC.Execute(fStatement),SQL_HANDLE_STMT,fStatement);
  finally
    // 3. release and/or retrieve OUT bound parameters
    for p := 0 to fParamCount-1 do
    with fParams[p] do
    case VType of
      ftCurrency:
        if VInOut<>paramIn then
          PCurrency(@VInt64)^ := PDouble(@VInt64)^;
      ftDate:
        if VInOut<>paramIn then
          PDateTime(@VInt64)^ := PSQL_TIMESTAMP_STRUCT(VData)^.ToDateTime;
      ftUTF8:
        VData := RawUnicodeToUtf8(pointer(VData),StrLenW(pointer(VData)));
    end;
  end;
end;

function TODBCStatement.GetUpdateCount: integer;
begin
  if (fStatement<>nil) and not fExpectResults then
    ODBC.Check(ODBC.RowCount(fStatement,result),SQL_HANDLE_STMT,fStatement);
end;

procedure TODBCStatement.Prepare(const aSQL: RawUTF8; ExpectResults: Boolean);
var Log: ISynLog;
begin
  Log := SynDBLog.Enter(self);
  if (fStatement<>nil) or (fColumnCount>0) then
    raise EODBCException.CreateFmt('%s.Prepare should be called only once',[ClassName]);
  // 1. process SQL
  inherited Prepare(aSQL,ExpectResults); // set fSQL + Connect if necessary
  fSQLW := Utf8DecodeToRawUnicode(fSQL);
  // 2. prepare statement and bind result columns (if any)
  AllocStatement;
  try
    ODBC.Check(ODBC.PrepareW(fStatement,pointer(fSQLW),length(fSQLW) shr 1),
      SQL_HANDLE_STMT,fStatement);
    if fExpectResults then
      BindColumns;
  except
    on E: Exception do begin
      Log.Log(sllError,E);
      ODBC.FreeHandle(SQL_HANDLE_STMT,fStatement);
      fStatement := nil;
      raise;
    end;
  end;
end;

function TODBCStatement.Step(SeekFirst: boolean): boolean;
const CMD: array[boolean] of smallint = (SQL_FETCH_NEXT,SQL_FETCH_FIRST);
var status: SqlReturn;
    i, sav: integer;
begin
  result := false;
  sav := fCurrentRow;
  fCurrentRow := 0;
  if not Assigned(fStatement) or (fColumnCount=0) then
    exit; // no row available at all (e.g. for SQL UPDATE) -> return false
  for i := 0 to fColumnCount-1 do
    fColumns[i].ColumnValueState := colNone;
  with ODBC do begin
    status := FetchScroll(fStatement,CMD[SeekFirst],0);
    case status of
    SQL_NO_DATA:
      exit; // no more data
    SQL_SUCCESS, SQL_SUCCESS_WITH_INFO: begin // ignore WITH_INFO messages
      fCurrentRow := sav+1;
      inc(fTotalRowsRetrieved);
      result := true; // mark data available for Column*() methods
    end;
    else HandleError(status,SQL_HANDLE_STMT,fStatement,false,sllNone);
    end;
  end;
end;


{ TODBCLib }

procedure TODBCLib.Check(Status: SqlReturn; HandleType: SqlSmallint;
  Handle: SqlHandle; InfoRaiseException: Boolean=false; LogLevelNoRaise: TSynLogInfo=sllNone);
begin
  if Status<>SQL_SUCCESS then
    HandleError(Status,HandleType,Handle,InfoRaiseException,LogLevelNoRaise);
end;

constructor TODBCLib.Create;
var P: PPointer;
    i: integer;
begin
  fHandle := SafeLoadLibrary('odbc32.dll');
  if fHandle=0 then
    raise EODBCException.Create('Unable to find ODBC Client Interface (odbc32.dll)');
  P := @@AllocEnv;
  for i := 0 to High(ODBC_ENTRIES) do begin
    P^ := GetProcAddress(fHandle,ODBC_ENTRIES[i]);
    if P^=nil then begin
      FreeLibrary(fHandle);
      fHandle := 0;
      raise EODBCException.CreateFmt('Invalid odbc32.dll: missing %s',[ODBC_ENTRIES[i]]);
    end;
    inc(P);
  end;
end;

procedure TODBCLib.HandleError(Status: SqlReturn; HandleType: SqlSmallint;
  Handle: SqlHandle; InfoRaiseException: Boolean; LogLevelNoRaise: TSynLogInfo);
var Sqlstate: array[0..6] of WideChar;
    MessageText: array[0..1023] of WideChar;
    RecNum, NativeError: SqlInteger;
    TextLength: SqlSmallint;
    msg: RawUTF8;
begin
  if (Handle=nil) or (Status=SQL_INVALID_HANDLE) then
    msg := 'Invalid handle' else begin
    RecNum := 1;
    while ODBC.GetDiagRecW(HandleType,Handle,RecNum,
       Sqlstate,NativeError,MessageText,1024,TextLength) and (not 1)=0 do begin
      while (textlength>0) and (MessageText[textlength-1]<' ') do begin
        dec(textlength);
        MessageText[textlength] := #0; // trim #13/#10 right of MessageText
      end;
      msg := FormatUTF8('%[%] % (%)'#13#10,[msg,Sqlstate,MessageText,NativeError]);
      inc(RecNum);
    end;
    if msg='' then
      msg := 'Unspecified error';
    if (Status=SQL_SUCCESS_WITH_INFO) and not InfoRaiseException then
      LogLevelNoRaise := sllInfo;
  end;
  if LogLevelNoRaise<>sllNone then
    SynDBLog.Add.Log(LogLevelNoRaise,msg) else
    raise EODBCException.Create(string(msg));
end;


{ TODBCConnectionProperties }

constructor TODBCConnectionProperties.Create(const aServerName,
  aDatabaseName, aUserID, aPassWord: RawUTF8);
begin
  inherited;
  if ODBC=nil then begin
    ODBC := TODBCLib.Create;
    GarbageCollector.Add(ODBC);
  end;
end;

function TODBCConnectionProperties.NewConnection: TSQLDBConnection;
begin
  result := TODBCConnection.Create(self);
end;

function TODBCConnectionProperties.SQLCreate(const aTableName: RawUTF8;
  const aFields: TSQLDBColumnPropertyDynArray): RawUTF8;
begin
  with MainConnection as TODBCConnection do begin
    if not IsConnected then
      Connect; // retrieve DBMS property
    fSQLCreateField := DB_FIELDS[DBMS];
    fSQLGetServerTimeStamp := DB_SERVERTIME[DBMS];
  end;
  result := inherited SQLCreate(aTableName,aFields);
end;

procedure TODBCConnectionProperties.GetFields(const aTableName: RawUTF8;
  var Fields: TSQLDBColumnDefineDynArray);
var Schema, Table: RawUTF8;
    F: TSQLDBColumnDefine;
    n: integer;
    status: SqlReturn;
    FA: TDynArray;
begin
  inherited; // first try from SQL, if any (faster)
  if Fields<>nil then
    exit; // already retrieved directly from engine
  Split(aTableName,'.',Schema,Table);
  if Table='' then begin
    Table := Schema;
    Schema := '%';
  end;
  Table := UpperCase(Table);
  Schema := UpperCase(Schema);
  try
    with TODBCStatement.Create(MainConnection) do
    try
      AllocStatement;
      status := ODBC.ColumnsA(fStatement,nil,0,pointer(Schema),SQL_NTS,
        pointer(Table),SQL_NTS,nil,0);
      if status<>SQL_SUCCESS then // e.g. driver does not support schema
        status := ODBC.ColumnsA(fStatement,nil,0,nil,0,pointer(Table),SQL_NTS,nil,0);
      ODBC.Check(status,SQL_HANDLE_STMT,fStatement);
      BindColumns;
      FA.Init(TypeInfo(TSQLDBColumnDefineDynArray),Fields,@n);
      while Step do begin
        F.ColumnName := ColumnUTF8(3);
        F.ColumnLength := ColumnInt(6);
        F.ColumnPrecision := ColumnInt(9);
        F.ColumnScale := ColumnInt(8);
        F.ColumnTypeNative := ColumnUTF8(5);
        F.ColumnType:= ODBCColumnToFieldType(ColumnInt(4),
          F.ColumnPrecision,F.ColumnScale);
        FA.Add(F);
      end;
      SetLength(Fields,n);
    finally
      Free; // TODBCStatement release
    end;
  except
    on Exception do
      SetLength(Fields,0);
  end;
end;

procedure TODBCConnectionProperties.GetTableNames(var Tables: TRawUTF8DynArray);
var Stmt: TODBCStatement;
    n: integer;
    schema, tablename: RawUTF8;
begin
  inherited; // first try from SQL, if any (faster)
  if Tables<>nil then
    exit; // already retrieved directly from engine
  try
    Stmt := TODBCStatement.Create(MainConnection);
    with ODBC do
    try
      Stmt.AllocStatement;
      Check(TablesA(Stmt.fStatement,nil,0,nil,0,nil,0,'TABLE',SQL_NTS),SQL_HANDLE_STMT,Stmt.fStatement);
      Stmt.BindColumns;
      n := 0;
      with Stmt do
      while Step do begin
        schema := ColumnUTF8(1);
        tablename := ColumnUTF8(2);
        if schema<>'' then
          tablename := schema+'.'+tablename;
        AddSortedRawUTF8(Tables,n,tablename);
      end;
      SetLength(Tables,n);
    finally
      Stmt.Free;
    end;
  except
    on Exception do
      SetLength(Tables,0);
  end;
end;


{ SQL_TIMESTAMP_STRUCT }

function SQL_TIMESTAMP_STRUCT.From(DateTime: TDateTime): SqlSmallint;
var Y,MS: word;
begin
  DecodeDateTime(DateTime,Y,Month,Day,Hour,Minute,Second,MS);
  Year := Y;
  Fraction := 0;
  if PInt64(@Hour)^=0 then
    result := SQL_C_TYPE_DATE else
    result := SQL_C_TYPE_TIMESTAMP;
end;

function SQL_TIMESTAMP_STRUCT.ToDateTime(DataType: SqlSmallint=SQL_TYPE_TIMESTAMP): TDateTime;
var time: TDateTime;
begin
  if DataType=SQL_TYPE_TIME then
    result := 0 else
    result := EncodeDate(Year,Month,Day);
  if (DataType<>SQL_TYPE_DATE) and (PInt64(@Hour)^<>0) and
     TryEncodeTime(Hour,Minute,Second,0,time) then
    result := result+time;
end;

function SQL_TIMESTAMP_STRUCT.ToIso8601(Dest: PUTF8Char; DataType: SqlSmallint): integer;
begin
  Dest^ := '"';
  inc(Dest);
  if DataType<>SQL_TYPE_TIME then begin
    DateToIso8601PChar(Dest,true,Year,Month,Day);
    inc(Dest,10);
  end;
  if (DataType<>SQL_TYPE_DATE) and (PInt64(@Hour)^<>0) and (Hour<HoursPerDay) and
     (Minute<MinsPerHour) and (Second<SecsPerMin) then begin
    TimeToIso8601PChar(Dest,true,Hour,Minute,Second,'T');
    inc(Dest,9);
    result := 21; // we use 'T' as TTextWriter.AddDateTime
  end else
    result := 12; // only date
  Dest^ := '"';
end;

end.

  - added TSQLDBOracleStatement.ColumnBlobBytes method to retrieve TBytes BLOBs
  - fixed BLOB memory leak in TSQLDBOracleStatement.FreeHandles
  - fixed issue in TSQLDBOracleStatement.ColumnToVarData when retrieving date
    time fields from Oracle as external virtual tables
  - fixed issue when NLS_DATE_FORMAT is not ISO-8601: since mORMot's ORM will
    send date/time as ISO-8601 text, we now force proper NLS_DATE_FORMAT
  - new TOracleDate.From/ToIso8601 methods for direct SQLT_DAT handling

  
}

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

interface

................................................................................
    fEnv: pointer;
    fError: pointer;
    fServer: pointer;
    fContext: pointer;
    fSession: pointer;
    fTrans: pointer;
    fOCICharSet: integer;
    function IsConnected: boolean; override;
    function DateTimeToDescriptor(aDateTime: TDateTime): pointer;
    procedure STRToUTF8(P: PAnsiChar; var result: RawUTF8;
      ColumnDBCharSet,ColumnDBForm: integer);
    {$ifndef UNICODE}
    procedure STRToAnsiString(P: PAnsiChar; var result: AnsiString;
      ColumnDBCharSet,ColumnDBForm: integer);
    {$endif}
................................................................................
    // will be used instead, to avoid any truncation during data retrieval
    // - BlobPrefetchSize and StatementCacheSize fiel values of the associated
    // properties will be used to tune the opened connection
    procedure Connect; override;
    /// stop connection to the specified Oracle database server
    // - should raise an Exception on error
    procedure Disconnect; override;


    /// initialize a new SQL query statement for the given connection
    // - the caller should free the instance after use
    function NewStatement: TSQLDBStatement; override;
    /// begin a Transaction for this connection
    // - current implementation do not support nested transaction with those
    // methods: exception will be raised in such case
    // - by default, TSQLDBOracleStatement works in AutoCommit mode, unless
................................................................................
  end;
end;

procedure TSQLDBOracleLib.HandleError(Status: Integer; ErrorHandle: POCIError;
  InfoRaiseException: Boolean; LogLevelNoRaise: TSynLogInfo);
var msg: array[byte] of AnsiChar;
    L, ErrNum: integer;

begin
  msg[0] := #0;
  case Status of
    OCI_ERROR, OCI_SUCCESS_WITH_INFO: begin
      ErrorGet(ErrorHandle,1,nil,ErrNum,msg,sizeof(msg),OCI_HTYPE_ERROR);
      L := StrLen(msg)-1;
      if (L>=0) and (msg[L]<' ') then
        msg[L] := #0; // trim right #10
      if (Status=OCI_SUCCESS_WITH_INFO) and not InfoRaiseException then
        LogLevelNoRaise := sllError;
    end;
    OCI_NEED_DATA:
      msg := 'OCI_NEED_DATA';
    OCI_NO_DATA:
      msg := 'OCI_NO_DATA';
    OCI_INVALID_HANDLE:
      msg := 'OCI_INVALID_HANDLE';
    OCI_STILL_EXECUTING:
      msg := 'OCI_STILL_EXECUTING';
    OCI_CONTINUE:
      msg := 'OCI_CONTINUE';
  end;
  if LogLevelNoRaise<>sllNone then
    {$ifdef DELPHI5OROLDER}
    SynDBLog.Add.Log(LogLevelNoRaise,RawUTF8(msg)) else
    {$else}
    SynDBLog.Add.Log(LogLevelNoRaise,PWinAnsiChar(@msg),'') else
    {$endif}
    raise ESQLDBOracle.Create(string(msg));
end;

procedure TSQLDBOracleLib.Check(Status: Integer; ErrorHandle: POCIError;
  InfoRaiseException: Boolean; LogLevelNoRaise: TSynLogInfo);
begin
  if Status<>OCI_SUCCESS then
................................................................................
  end;
  if aCodePage=0 then
    aCodePage := EnvVariableToCodePage;
  fCodePage := aCodePage;
  fBlobPrefetchSize := 4096;
  fStatementCacheSize := 30; // default is 20
  fInternalBufferSize := 128*1024; // 128 KB
  fSQLCreateField := ORA_FIELDS;
  fSQLCreateFieldMax := 1333; // =4000/3 since WideChar is up to 3 bytes in UTF-8
  fSQLGetServerTimeStamp := ORA_SERVERTIME;
  fBatchSendingAbilities := [cCreate,cUpdate,cDelete]; // array DML feature
  fBatchMaxSentAtOnce := 10000;  // iters <= 32767 for better performance
end;

constructor TSQLDBOracleConnectionProperties.Create(const aServerName,
  aDatabaseName, aUserID, aPassWord: RawUTF8);
begin
................................................................................
end;

function TSQLDBOracleConnectionProperties.SQLIso8601ToDate(
  const Iso8601: RawUTF8): RawUTF8;
begin
  result := OracleSQLIso8601ToDate(Iso8601);
end;


{ TSQLDBOracleConnection }

procedure TSQLDBOracleConnection.Commit;
begin
  inherited;
  if fTrans=nil then
................................................................................
end;

procedure TSQLDBOracleConnection.Connect;
var Log: ISynLog;
    Props: TSQLDBOracleConnectionProperties;
begin
  Log := SynDBLog.Enter(self);
  if self=nil then
    raise ESQLDBOracle.Create('Invalid Connect call');
  Disconnect; // force fTrans=fError=fServer=fContext=nil
  with OCI do
  try
    if fEnv=nil then
      // will use UTF-8 encoding by default, in a mono-thread basis
      EnvNlsCreate(fEnv,OCI_DEFAULT,nil,nil,nil,nil,0,nil,OCI_UTF8,OCI_UTF8);
    Props := Properties as TSQLDBOracleConnectionProperties;
................................................................................
  inherited Destroy;
  if (OCI<>nil) and (fEnv<>nil) then
    OCI.HandleFree(fEnv,OCI_HTYPE_ENV);
end;

procedure TSQLDBOracleConnection.Disconnect;
begin
  if (self<>nil) and (fError<>nil) and (OCI<>nil) then
  with OCI do begin
    SynDBLog.Enter(self);
    if fTrans<>nil then begin
      // close any opened session
      HandleFree(fTrans,OCI_HTYPE_TRANS);
      fTrans := nil;
      Check(SessionEnd(fContext,fError,fSession,OCI_DEFAULT),fError,false,sllError);
................................................................................
    fServer := nil;
    fError := nil;
  end;
end;

function TSQLDBOracleConnection.IsConnected: boolean;
begin
  result := (self<>nil) and (fTrans<>nil);
end;

function TSQLDBOracleConnection.NewStatement: TSQLDBStatement;
begin
  result := TSQLDBOracleStatement.Create(self);
end;

................................................................................
  OCI.Check(OCI.TransRollback(fContext,fError,OCI_DEFAULT),fError);
end;

procedure TSQLDBOracleConnection.StartTransaction;
begin
  if TransactionCount>0 then
    raise ESQLDBOracle.Create('Oracle do not provide nested transactions');
  inherited;
  if fTrans=nil then
    raise ESQLDBOracle.Create('Invalid StartTransaction call');
  // Oracle creates implicit transactions, and we'll handle AutoCommit in
  // TSQLDBOracleStatement.ExecutePrepared if TransactionCount=0
  OCI.Check(OCI.TransStart(fContext,fError,0,OCI_DEFAULT),fError);
end;

................................................................................
      case ColumnType of
       ftInt64:
         if ColumnValueDBType=SQLT_INT then
           WR.Add(PInt64(V)^) else
           WR.AddNoJSONEscape(V); // already as SQLT_STR
       ftDouble:
         WR.Add(PDouble(V)^);
       ftCurrency: begin
         if PWord(V)^=ord('-')+ord('.')shl 8 then begin
           WR.Add('-','0'); // '-.3' -> '-0.3'
           Inc(PtrUInt(V));
         end else
         if PAnsiChar(V)^='.' then
           WR.Add('0'); // '.5' -> '0.5'
         WR.AddNoJSONEscape(V); // already as SQLT_STR
       end;
       ftDate:
         WR.AddNoJSONEscape(@tmp,POracleDate(V)^.ToIso8601(tmp));
       ftUTF8: begin
         WR.Add('"');
         with TSQLDBOracleConnection(Connection) do
           if ColumnValueInlined then
             STRToUTF8(V,U,ColumnValueDBCharSet,ColumnValueDBForm) else
................................................................................
    aIndicator: array of sb2;
    oOCIDateTime: POCIDateTime;
    Status, L: integer;
    mode: cardinal;
    Int32: set of 0..127;
label txt;
begin
  if (Self=nil) or (fStatement=nil) then
    raise ESQLDBOracle.Create('ExecutePrepared called without previous Prepare');
  if sllSQL in SynDBLog.Family.Level then
    SynDBLog.Add.Log(sllSQL,SQLWithInlinedParams,self);
  try
    fRowFetchedEnded := false;
    // 1. bind parameters
    if fPreparedParamsCount<>fParamCount then
................................................................................
  end;
end;

procedure TSQLDBOracleStatement.FreeHandles;
var i,j: integer;
    PLOB: PPointer;
begin
  if self=nil then exit;

  if fRowBuffer<>nil then
  for i := 0 to fColumnCount-1 do
    with fColumns[i] do
      if not ColumnValueInlined then begin
        PLOB := @fRowBuffer[ColumnAttr]; // first POCILobLocator item
        for j := 1 to fRowCount do begin
          if PLOB^<>nil then begin
................................................................................
    else LogTruncatedColumn(Column^);
  end;
end;

function TSQLDBOracleStatement.GetUpdateCount: integer;
begin
  result := 0;
  if (self<>nil) and (fStatement<>nil) then
    OCI.AttrGet(fStatement,OCI_HTYPE_STMT,@result,nil,OCI_ATTR_ROW_COUNT,fError);
end;

const
  CHARSET_UTF8: integer = OCI_UTF8;
  CHARSET_WIN1252: integer = OCI_WE8MSWIN1252;

  - added TSQLDBOracleStatement.ColumnBlobBytes method to retrieve TBytes BLOBs
  - fixed BLOB memory leak in TSQLDBOracleStatement.FreeHandles
  - fixed issue in TSQLDBOracleStatement.ColumnToVarData when retrieving date
    time fields from Oracle as external virtual tables
  - fixed issue when NLS_DATE_FORMAT is not ISO-8601: since mORMot's ORM will
    send date/time as ISO-8601 text, we now force proper NLS_DATE_FORMAT
  - new TOracleDate.From/ToIso8601 methods for direct SQLT_DAT handling
  - code refactoring, especially about error handling and ODBC integration
  
}

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

interface

................................................................................
    fEnv: pointer;
    fError: pointer;
    fServer: pointer;
    fContext: pointer;
    fSession: pointer;
    fTrans: pointer;
    fOCICharSet: integer;

    function DateTimeToDescriptor(aDateTime: TDateTime): pointer;
    procedure STRToUTF8(P: PAnsiChar; var result: RawUTF8;
      ColumnDBCharSet,ColumnDBForm: integer);
    {$ifndef UNICODE}
    procedure STRToAnsiString(P: PAnsiChar; var result: AnsiString;
      ColumnDBCharSet,ColumnDBForm: integer);
    {$endif}
................................................................................
    // will be used instead, to avoid any truncation during data retrieval
    // - BlobPrefetchSize and StatementCacheSize fiel values of the associated
    // properties will be used to tune the opened connection
    procedure Connect; override;
    /// stop connection to the specified Oracle database server
    // - should raise an Exception on error
    procedure Disconnect; override;
    /// return TRUE if Connect has been already successfully called
    function IsConnected: boolean; override;
    /// initialize a new SQL query statement for the given connection
    // - the caller should free the instance after use
    function NewStatement: TSQLDBStatement; override;
    /// begin a Transaction for this connection
    // - current implementation do not support nested transaction with those
    // methods: exception will be raised in such case
    // - by default, TSQLDBOracleStatement works in AutoCommit mode, unless
................................................................................
  end;
end;

procedure TSQLDBOracleLib.HandleError(Status: Integer; ErrorHandle: POCIError;
  InfoRaiseException: Boolean; LogLevelNoRaise: TSynLogInfo);
var msg: array[byte] of AnsiChar;
    L, ErrNum: integer;
    Error: RawUTF8;
begin
  msg[0] := #0;
  case Status of
    OCI_ERROR, OCI_SUCCESS_WITH_INFO: begin
      ErrorGet(ErrorHandle,1,nil,ErrNum,msg,sizeof(msg),OCI_HTYPE_ERROR);
      L := StrLen(msg)-1;
      if (L>=0) and (msg[L]<' ') then
        msg[L] := #0; // trim right #10
      if (Status=OCI_SUCCESS_WITH_INFO) and not InfoRaiseException then
        LogLevelNoRaise := sllInfo;
    end;
    OCI_NEED_DATA:
      msg := 'OCI_NEED_DATA';
    OCI_NO_DATA:
      msg := 'OCI_NO_DATA';
    OCI_INVALID_HANDLE:
      msg := 'OCI_INVALID_HANDLE';
    OCI_STILL_EXECUTING:
      msg := 'OCI_STILL_EXECUTING';
    OCI_CONTINUE:
      msg := 'OCI_CONTINUE';
  end;
  if LogLevelNoRaise<>sllNone then begin
    AnsiCharToUTF8(msg,StrLen(msg),Error,GetACP);
    SynDBLog.Add.Log(LogLevelNoRaise,Error);
  end else


    raise ESQLDBOracle.Create(string(msg));
end;

procedure TSQLDBOracleLib.Check(Status: Integer; ErrorHandle: POCIError;
  InfoRaiseException: Boolean; LogLevelNoRaise: TSynLogInfo);
begin
  if Status<>OCI_SUCCESS then
................................................................................
  end;
  if aCodePage=0 then
    aCodePage := EnvVariableToCodePage;
  fCodePage := aCodePage;
  fBlobPrefetchSize := 4096;
  fStatementCacheSize := 30; // default is 20
  fInternalBufferSize := 128*1024; // 128 KB
  fSQLCreateField := DB_FIELDS[dOracle];
  fSQLCreateFieldMax := 1333; // =4000/3 since WideChar is up to 3 bytes in UTF-8
  fSQLGetServerTimeStamp := DB_SERVERTIME[dOracle];
  fBatchSendingAbilities := [cCreate,cUpdate,cDelete]; // array DML feature
  fBatchMaxSentAtOnce := 10000;  // iters <= 32767 for better performance
end;

constructor TSQLDBOracleConnectionProperties.Create(const aServerName,
  aDatabaseName, aUserID, aPassWord: RawUTF8);
begin
................................................................................
end;

function TSQLDBOracleConnectionProperties.SQLIso8601ToDate(
  const Iso8601: RawUTF8): RawUTF8;
begin
  result := OracleSQLIso8601ToDate(Iso8601);
end;


{ TSQLDBOracleConnection }

procedure TSQLDBOracleConnection.Commit;
begin
  inherited;
  if fTrans=nil then
................................................................................
end;

procedure TSQLDBOracleConnection.Connect;
var Log: ISynLog;
    Props: TSQLDBOracleConnectionProperties;
begin
  Log := SynDBLog.Enter(self);


  Disconnect; // force fTrans=fError=fServer=fContext=nil
  with OCI do
  try
    if fEnv=nil then
      // will use UTF-8 encoding by default, in a mono-thread basis
      EnvNlsCreate(fEnv,OCI_DEFAULT,nil,nil,nil,nil,0,nil,OCI_UTF8,OCI_UTF8);
    Props := Properties as TSQLDBOracleConnectionProperties;
................................................................................
  inherited Destroy;
  if (OCI<>nil) and (fEnv<>nil) then
    OCI.HandleFree(fEnv,OCI_HTYPE_ENV);
end;

procedure TSQLDBOracleConnection.Disconnect;
begin
  if (fError<>nil) and (OCI<>nil) then
  with OCI do begin
    SynDBLog.Enter(self);
    if fTrans<>nil then begin
      // close any opened session
      HandleFree(fTrans,OCI_HTYPE_TRANS);
      fTrans := nil;
      Check(SessionEnd(fContext,fError,fSession,OCI_DEFAULT),fError,false,sllError);
................................................................................
    fServer := nil;
    fError := nil;
  end;
end;

function TSQLDBOracleConnection.IsConnected: boolean;
begin
  result := fTrans<>nil;
end;

function TSQLDBOracleConnection.NewStatement: TSQLDBStatement;
begin
  result := TSQLDBOracleStatement.Create(self);
end;

................................................................................
  OCI.Check(OCI.TransRollback(fContext,fError,OCI_DEFAULT),fError);
end;

procedure TSQLDBOracleConnection.StartTransaction;
begin
  if TransactionCount>0 then
    raise ESQLDBOracle.Create('Oracle do not provide nested transactions');
  inherited StartTransaction;               
  if fTrans=nil then
    raise ESQLDBOracle.Create('Invalid StartTransaction call');
  // Oracle creates implicit transactions, and we'll handle AutoCommit in
  // TSQLDBOracleStatement.ExecutePrepared if TransactionCount=0
  OCI.Check(OCI.TransStart(fContext,fError,0,OCI_DEFAULT),fError);
end;

................................................................................
      case ColumnType of
       ftInt64:
         if ColumnValueDBType=SQLT_INT then
           WR.Add(PInt64(V)^) else
           WR.AddNoJSONEscape(V); // already as SQLT_STR
       ftDouble:
         WR.Add(PDouble(V)^);
       ftCurrency:






         WR.AddFloatStr(V); // already as SQLT_STR

       ftDate:
         WR.AddNoJSONEscape(@tmp,POracleDate(V)^.ToIso8601(tmp));
       ftUTF8: begin
         WR.Add('"');
         with TSQLDBOracleConnection(Connection) do
           if ColumnValueInlined then
             STRToUTF8(V,U,ColumnValueDBCharSet,ColumnValueDBForm) else
................................................................................
    aIndicator: array of sb2;
    oOCIDateTime: POCIDateTime;
    Status, L: integer;
    mode: cardinal;
    Int32: set of 0..127;
label txt;
begin
  if (fStatement=nil) then
    raise ESQLDBOracle.Create('ExecutePrepared called without previous Prepare');
  if sllSQL in SynDBLog.Family.Level then
    SynDBLog.Add.Log(sllSQL,SQLWithInlinedParams,self);
  try
    fRowFetchedEnded := false;
    // 1. bind parameters
    if fPreparedParamsCount<>fParamCount then
................................................................................
  end;
end;

procedure TSQLDBOracleStatement.FreeHandles;
var i,j: integer;
    PLOB: PPointer;
begin
  if self=nil then
    exit; // avoid GPF
  if fRowBuffer<>nil then
  for i := 0 to fColumnCount-1 do
    with fColumns[i] do
      if not ColumnValueInlined then begin
        PLOB := @fRowBuffer[ColumnAttr]; // first POCILobLocator item
        for j := 1 to fRowCount do begin
          if PLOB^<>nil then begin
................................................................................
    else LogTruncatedColumn(Column^);
  end;
end;

function TSQLDBOracleStatement.GetUpdateCount: integer;
begin
  result := 0;
  if fStatement<>nil then
    OCI.AttrGet(fStatement,OCI_HTYPE_STMT,@result,nil,OCI_ATTR_ROW_COUNT,fError);
end;

const
  CHARSET_UTF8: integer = OCI_UTF8;
  CHARSET_WIN1252: integer = OCI_WE8MSWIN1252;

    allow SQL table creation statement with or without the mORMot collations

  Version 1.17
  - now TSQLDBSQLite3Statement.BindDateTime() will store '' when value is 0,
    or a pure date or a pure time if the value is defined as such - by the
    way, it will match SQlite3 expectations of internal date/time functions, as
    defined at http://www.sqlite.org/lang_datefunc.html


  - added TSQLDBSQLite3Connection.Synchronous property


}

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

interface

................................................................................
  TSQLDBSQLite3Connection = class(TSQLDBConnection)
  private
    function GetSynchronous: TSQLSynchronousMode;
    procedure SetSynchronous(Value: TSQLSynchronousMode);
  protected
    fDB: TSQLDataBase;
    fCache: TSQLStatementCached;
    function IsConnected: boolean; override;
  public
    /// release internal memory, handles and statement cache
    destructor Destroy; override;
    /// connect to the SQLite3 engine, i.e. create the DB instance
    // - should raise an Exception on error
    procedure Connect; override;
    /// stop connection to the SQLite3 engine, i.e. release the DB instance
    // - should raise an Exception on error
    procedure Disconnect; override;


    /// initialize a new SQL query statement for the given connection
    // - the caller should free the instance after use
    function NewStatement: TSQLDBStatement; override;
    /// initialize a new SQL query statement for the given connection
    // - this default implementation will call the NewStatement method
    // - but children may override this method to handle statement caching
    // - this method should return nil in case of error, or a prepared statement
................................................................................
    ftDouble,ftDouble,ftDouble, ftCurrency,ftCurrency, ftNull,
    ftBlob,ftBlob,ftBlob,ftBlob,ftBlob);
begin
  result := TYPES[IdemPCharArray(pointer(aNativeType),PCHARS)];
end;

procedure TSQLDBSQLite3ConnectionProperties.SetUseMormotCollations(const Value: boolean);
const
  SQLITE3_FIELDS: array[boolean] of TSQLDBFieldTypeDefinition = (
  (' TEXT',' INTEGER',' FLOAT',' FLOAT',' TEXT',' TEXT',' BLOB'),
  (' TEXT COLLATE SYSTEMNOCASE',' INTEGER',' FLOAT',' FLOAT',
   ' TEXT COLLATE ISO8601',' TEXT COLLATE SYSTEMNOCASE',' BLOB'));
    // ftNull, ftInt64, ftDouble, ftCurrency, ftDate, ftUTF8, ftBlob
begin
  fUseMormotCollations := Value;
  fSQLCreateField := SQLITE3_FIELDS[Value];
end;

constructor TSQLDBSQLite3ConnectionProperties.Create(const aServerName,
  aDatabaseName, aUserID, aPassWord: RawUTF8);
................................................................................
begin
  fStatement.Reset;
  fStatement.BindReset;
end;

function TSQLDBSQLite3Statement.Step(SeekFirst: boolean): boolean;
begin
  if SeekFirst then

    fStatement.Reset;

  result := fStatement.Step=SQLITE_ROW;





end;

end.

    allow SQL table creation statement with or without the mORMot collations

  Version 1.17
  - now TSQLDBSQLite3Statement.BindDateTime() will store '' when value is 0,
    or a pure date or a pure time if the value is defined as such - by the
    way, it will match SQlite3 expectations of internal date/time functions, as
    defined at http://www.sqlite.org/lang_datefunc.html
  - fixed TSQLDBSQLite3Statement.Step to update CurrentRow and
    TotalRowsRetrieved properties as expected
  - added TSQLDBSQLite3Connection.Synchronous property
  - code refactoring, especially about error handling and ODBC integration

}

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

interface

................................................................................
  TSQLDBSQLite3Connection = class(TSQLDBConnection)
  private
    function GetSynchronous: TSQLSynchronousMode;
    procedure SetSynchronous(Value: TSQLSynchronousMode);
  protected
    fDB: TSQLDataBase;
    fCache: TSQLStatementCached;

  public
    /// release internal memory, handles and statement cache
    destructor Destroy; override;
    /// connect to the SQLite3 engine, i.e. create the DB instance
    // - should raise an Exception on error
    procedure Connect; override;
    /// stop connection to the SQLite3 engine, i.e. release the DB instance
    // - should raise an Exception on error
    procedure Disconnect; override;
    /// return TRUE if Connect has been already successfully called
    function IsConnected: boolean; override;
    /// initialize a new SQL query statement for the given connection
    // - the caller should free the instance after use
    function NewStatement: TSQLDBStatement; override;
    /// initialize a new SQL query statement for the given connection
    // - this default implementation will call the NewStatement method
    // - but children may override this method to handle statement caching
    // - this method should return nil in case of error, or a prepared statement
................................................................................
    ftDouble,ftDouble,ftDouble, ftCurrency,ftCurrency, ftNull,
    ftBlob,ftBlob,ftBlob,ftBlob,ftBlob);
begin
  result := TYPES[IdemPCharArray(pointer(aNativeType),PCHARS)];
end;

procedure TSQLDBSQLite3ConnectionProperties.SetUseMormotCollations(const Value: boolean);

const SQLITE3_FIELDS: array[boolean] of TSQLDBFieldTypeDefinition = (
  (' TEXT',' INTEGER',' FLOAT',' FLOAT',' TEXT',' TEXT',' BLOB'),
  (' TEXT COLLATE SYSTEMNOCASE',' INTEGER',' FLOAT',' FLOAT',
   ' TEXT COLLATE ISO8601',' TEXT COLLATE SYSTEMNOCASE',' BLOB'));

begin
  fUseMormotCollations := Value;
  fSQLCreateField := SQLITE3_FIELDS[Value];
end;

constructor TSQLDBSQLite3ConnectionProperties.Create(const aServerName,
  aDatabaseName, aUserID, aPassWord: RawUTF8);
................................................................................
begin
  fStatement.Reset;
  fStatement.BindReset;
end;

function TSQLDBSQLite3Statement.Step(SeekFirst: boolean): boolean;
begin
  if SeekFirst then begin
    fCurrentRow := 0;
    fStatement.Reset;
  end;
  result := fStatement.Step=SQLITE_ROW;
  if result then begin
    inc(fTotalRowsRetrieved);
    inc(fCurrentRow);
  end else
    fCurrentRow := 0;
end;

end.

    (e.g. Jet/MSAccess database)
  - added TOleDBJetConnectionProperties kind of connection to direct
    access of Microsoft Jet databases (.mdb files)
  - added FieldSize optional parameter to TOleDBStatement.ColumnType()
    method (used e.g. by SynDBVCL to provide the expected field size on TDataSet)
  - added TOleDBConnectionProperties.CreateDatabase able to create a database
    from the supplied connection string (used e.g. to initialize .mdb files)


}

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

interface

................................................................................
  TOleDBConnection = class(TSQLDBConnectionThreadSafe)
  protected
    fMalloc: IMalloc;
    fDBInitialize: IDBInitialize;
    fTransaction: ITransactionLocal;
    fSession: IUnknown;
    fOleDBProperties: TOleDBConnectionProperties;
    function IsConnected: boolean; override;
    /// Error handler for OleDB COM objects
    // - will update ErrorMessage and InfoMessage
    procedure OleDBCheck(aResult: HRESULT; const aStatus: TCardinalDynArray=nil); virtual;
    /// called just after fDBInitialize.Initialized: could add parameters
    procedure OnDBInitialized; virtual;
  public
    /// connect to a specified OleDB database
................................................................................
    function NewStatement: TSQLDBStatement; override;
    /// connect to the specified database
    // - should raise an EOleDBException on error
    procedure Connect; override;
    /// stop connection to the specified database
    // - should raise an EOleDBException on error
    procedure Disconnect; override;


    /// begin a Transaction for this connection
    // - be aware that not all OleDB provider support nested transactions
    // see http://msdn.microsoft.com/en-us/library/ms716985(v=vs.85).aspx
    procedure StartTransaction; override;
    /// commit changes of a Transaction for this connection
    // - StartTransaction method must have been called before
    procedure Commit; override;
................................................................................
  // source Data for the OleDB parameters
  TOleDBStatementParamDynArray = array of TOleDBStatementParam;

  /// implements an OleDB SQL query statement
  // - this statement won't retrieve all rows of data, but will allow direct
  // per-row access using the Step() and Column*() methods
  TOleDBStatement = class(TSQLDBStatement)
  private
    fCurrentRow: Integer;
  protected
    fParams: TOleDBStatementParamDynArray;
    fColumns: TSQLDBColumnPropertyDynArray;
    fParam: TDynArray;
    fColumn: TDynArrayHashed;
    fCommand: ICommandText;
    fRowSet: IRowSet;
................................................................................
    // - it's recommended by official OleDB documentation for faster process
    // - is enabled by default, and should not be modified in most cases
    property AlignDataInternalBuffer: boolean read fAlignBuffer write fAlignBuffer;
    /// size in bytes of the internal OleDB buffer used to fetch rows
    // - several rows are retrieved at once into the internal buffer
    // - default value is 16384 bytes, minimal allowed size is 8192
    property RowBufferSize: integer read fRowBufferSize write SetRowBufferSize;
    /// the current row after Execute call, corresponding to Column*() methods
    // - contains 0 in case of no (more) available data, or a number >=1
    property CurrentRow: Integer read fCurrentRow;
  end;


implementation

{ TOleDBStatement }

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

procedure TOleDBConnectionProperties.GetTableNames(var Tables: TRawUTF8DynArray);
var Rows: IRowset;
    count, schemaCol, nameCol: integer;
    schema, tablename: RawUTF8;
begin
  inherited; // first try from SQL, if any (faster)
  if Tables=nil then

  try
    // see http://msdn.microsoft.com/en-us/library/ms716980(v=VS.85).aspx
    // Restriction columns: TABLE_CATALOG, TABLE_SCHEMA, TABLE_NAME, TABLE_TYPE
    if GetSchema(DBSCHEMA_TABLES,['','','','TABLE'],Rows) then
    with TOleDBStatement.Create(MainConnection) do
    try
      FromRowSet(Rows);
................................................................................
    n, i: integer;
    F: TSQLDBColumnDefine;
    FA: TDynArray;
const DBTYPE_DISPLAY: array[TSQLDBFieldType] of RawUTF8 = (
  '???','null','int','double','currency','date','nvarchar','blob');
begin
  inherited; // first try from SQL, if any (faster)



  Split(aTableName,'.',Owner,Table);
  if Table='' then begin
    Table := Owner;
    Owner := '';
  end;
  if Fields=nil then
  try
    // see http://msdn.microsoft.com/en-us/library/ms723052(v=VS.85).aspx
    if GetSchema(DBSCHEMA_COLUMNS,['',Owner,Table,''],Rows) then
      // Restriction columns: TABLE_CATALOG,TABLE_SCHEMA,TABLE_NAME,COLUMN_NAME
      with TOleDBStatement.Create(MainConnection) do
      try
        FromRowSet(Rows);
        FA.Init(TypeInfo(TSQLDBColumnDefineDynArray),Fields,@n);
................................................................................
    result := inherited ColumnTypeNativeToDB(aNativeType,aScale);
end;

procedure TOleDBOracleConnectionProperties.SetInternalProperties;
begin
  if fProviderName='' then
    fProviderName := 'OraOLEDB.Oracle.1';
  fSQLCreateField := ORA_FIELDS;
  fSQLCreateFieldMax := 1333; // =4000/3 since WideChar is up to 3 bytes in UTF-8
  fSQLGetServerTimeStamp := ORA_SERVERTIME;
  inherited SetInternalProperties;
end;

function TOleDBOracleConnectionProperties.SQLGetField(const aTableName: RawUTF8): RawUTF8;
begin
  result := OracleSQLGetField(aTableName,fUserID);
end;
................................................................................
    result := true;
  finally
    SQLServerErrorInfo := nil;
  end;
end;

procedure TOleDBMSSQLConnectionProperties.SetInternalProperties;
const MSSQL_FIELDS: TSQLDBFieldTypeDefinition = (
  '  nvarchar(%)',' bigint',' float',' money',' datetime',' nvarchar(max)',' varbinary(max)');
  // ftNull, ftInt64, ftDouble, ftCurrency, ftDate, ftUTF8, ftBlob
begin
  fSQLCreateField := MSSQL_FIELDS;
  fSQLCreateFieldMax := 4000;
  fSQLGetServerTimeStamp := 'select GETDATE()';
  OnCustomError := MSOnCustomError;
  fProviderName := 'SQLOLEDB';
  inherited SetInternalProperties;
  if fUserID='' then
    fConnectionString := fConnectionString+
      'Integrated Security=SSPI;Persist Security Info=False;';
end;
................................................................................
  if fDriver<>'' then
    fConnectionString := UTF8ToSynUnicode('Driver='+fDriver+';')+fConnectionString;
end;

{ TOleDBMySQLConnectionProperties }

procedure TOleDBMySQLConnectionProperties.SetInternalProperties;
const MYSQL_FIELDS: TSQLDBFieldTypeDefinition = (
  ' varchar(%) character set UTF8',' bigint',' double',' decimal(19,4)',' datetime',
  ' text character set UTF8',' blob');
  // ftNull, ftInt64, ftDouble, ftCurrency, ftDate, ftUTF8, ftBlob
begin
  fSQLCreateField := MYSQL_FIELDS;
  fSQLCreateFieldMax := 4000;
  fSQLGetServerTimeStamp := 'SELECT NOW()';
  fProviderName := 'MYSQLPROV';
  inherited;
end;

{ TOleDBAS400ConnectionProperties }

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

{ TOleDBJetConnectionProperties }

procedure TOleDBJetConnectionProperties.SetInternalProperties;
const JETSQL_FIELDS: TSQLDBFieldTypeDefinition = (
  ' VarChar(%)',' Decimal(19,0)',' Double',' Currency',' DateTime',
  ' LongText',' LongBinary');
  // ftNull, ftInt64, ftDouble, ftCurrency, ftDate, ftUTF8, ftBlob
begin
  fSQLCreateField := JETSQL_FIELDS;
  fSQLCreateFieldMax := 255;
  fProviderName := 'Microsoft.Jet.OLEDB.4.0';
  inherited SetInternalProperties;
  if not FileExists(UTF8ToString(ServerName)) then
    CreateDatabase;
end;

    (e.g. Jet/MSAccess database)
  - added TOleDBJetConnectionProperties kind of connection to direct
    access of Microsoft Jet databases (.mdb files)
  - added FieldSize optional parameter to TOleDBStatement.ColumnType()
    method (used e.g. by SynDBVCL to provide the expected field size on TDataSet)
  - added TOleDBConnectionProperties.CreateDatabase able to create a database
    from the supplied connection string (used e.g. to initialize .mdb files)
  - code refactoring, especially about error handling and ODBC integration

}

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

interface

................................................................................
  TOleDBConnection = class(TSQLDBConnectionThreadSafe)
  protected
    fMalloc: IMalloc;
    fDBInitialize: IDBInitialize;
    fTransaction: ITransactionLocal;
    fSession: IUnknown;
    fOleDBProperties: TOleDBConnectionProperties;

    /// Error handler for OleDB COM objects
    // - will update ErrorMessage and InfoMessage
    procedure OleDBCheck(aResult: HRESULT; const aStatus: TCardinalDynArray=nil); virtual;
    /// called just after fDBInitialize.Initialized: could add parameters
    procedure OnDBInitialized; virtual;
  public
    /// connect to a specified OleDB database
................................................................................
    function NewStatement: TSQLDBStatement; override;
    /// connect to the specified database
    // - should raise an EOleDBException on error
    procedure Connect; override;
    /// stop connection to the specified database
    // - should raise an EOleDBException on error
    procedure Disconnect; override;
    /// return TRUE if Connect has been already successfully called
    function IsConnected: boolean; override;
    /// begin a Transaction for this connection
    // - be aware that not all OleDB provider support nested transactions
    // see http://msdn.microsoft.com/en-us/library/ms716985(v=vs.85).aspx
    procedure StartTransaction; override;
    /// commit changes of a Transaction for this connection
    // - StartTransaction method must have been called before
    procedure Commit; override;
................................................................................
  // source Data for the OleDB parameters
  TOleDBStatementParamDynArray = array of TOleDBStatementParam;

  /// implements an OleDB SQL query statement
  // - this statement won't retrieve all rows of data, but will allow direct
  // per-row access using the Step() and Column*() methods
  TOleDBStatement = class(TSQLDBStatement)


  protected
    fParams: TOleDBStatementParamDynArray;
    fColumns: TSQLDBColumnPropertyDynArray;
    fParam: TDynArray;
    fColumn: TDynArrayHashed;
    fCommand: ICommandText;
    fRowSet: IRowSet;
................................................................................
    // - it's recommended by official OleDB documentation for faster process
    // - is enabled by default, and should not be modified in most cases
    property AlignDataInternalBuffer: boolean read fAlignBuffer write fAlignBuffer;
    /// size in bytes of the internal OleDB buffer used to fetch rows
    // - several rows are retrieved at once into the internal buffer
    // - default value is 16384 bytes, minimal allowed size is 8192
    property RowBufferSize: integer read fRowBufferSize write SetRowBufferSize;



  end;


implementation

{ TOleDBStatement }

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

procedure TOleDBConnectionProperties.GetTableNames(var Tables: TRawUTF8DynArray);
var Rows: IRowset;
    count, schemaCol, nameCol: integer;
    schema, tablename: RawUTF8;
begin
  inherited; // first try from SQL, if any (faster)
  if Tables<>nil then
    exit; // already retrieved directly from engine
  try
    // see http://msdn.microsoft.com/en-us/library/ms716980(v=VS.85).aspx
    // Restriction columns: TABLE_CATALOG, TABLE_SCHEMA, TABLE_NAME, TABLE_TYPE
    if GetSchema(DBSCHEMA_TABLES,['','','','TABLE'],Rows) then
    with TOleDBStatement.Create(MainConnection) do
    try
      FromRowSet(Rows);
................................................................................
    n, i: integer;
    F: TSQLDBColumnDefine;
    FA: TDynArray;
const DBTYPE_DISPLAY: array[TSQLDBFieldType] of RawUTF8 = (
  '???','null','int','double','currency','date','nvarchar','blob');
begin
  inherited; // first try from SQL, if any (faster)
  if Fields<>nil then
    exit; // already retrieved directly from engine
  try
    Split(aTableName,'.',Owner,Table);
    if Table='' then begin
      Table := Owner;
      Owner := '';
    end;


    // see http://msdn.microsoft.com/en-us/library/ms723052(v=VS.85).aspx
    if GetSchema(DBSCHEMA_COLUMNS,['',Owner,Table,''],Rows) then
      // Restriction columns: TABLE_CATALOG,TABLE_SCHEMA,TABLE_NAME,COLUMN_NAME
      with TOleDBStatement.Create(MainConnection) do
      try
        FromRowSet(Rows);
        FA.Init(TypeInfo(TSQLDBColumnDefineDynArray),Fields,@n);
................................................................................
    result := inherited ColumnTypeNativeToDB(aNativeType,aScale);
end;

procedure TOleDBOracleConnectionProperties.SetInternalProperties;
begin
  if fProviderName='' then
    fProviderName := 'OraOLEDB.Oracle.1';
  fSQLCreateField := DB_FIELDS[dOracle];
  fSQLCreateFieldMax := 1333; // =4000/3 since WideChar is up to 3 bytes in UTF-8
  fSQLGetServerTimeStamp := DB_SERVERTIME[dOracle];
  inherited SetInternalProperties;
end;

function TOleDBOracleConnectionProperties.SQLGetField(const aTableName: RawUTF8): RawUTF8;
begin
  result := OracleSQLGetField(aTableName,fUserID);
end;
................................................................................
    result := true;
  finally
    SQLServerErrorInfo := nil;
  end;
end;

procedure TOleDBMSSQLConnectionProperties.SetInternalProperties;



begin
  fSQLCreateField := DB_FIELDS[dMSSQL];
  fSQLCreateFieldMax := 4000;
  fSQLGetServerTimeStamp := DB_SERVERTIME[dMSSQL];
  OnCustomError := MSOnCustomError;
  fProviderName := 'SQLOLEDB';
  inherited SetInternalProperties;
  if fUserID='' then
    fConnectionString := fConnectionString+
      'Integrated Security=SSPI;Persist Security Info=False;';
end;
................................................................................
  if fDriver<>'' then
    fConnectionString := UTF8ToSynUnicode('Driver='+fDriver+';')+fConnectionString;
end;

{ TOleDBMySQLConnectionProperties }

procedure TOleDBMySQLConnectionProperties.SetInternalProperties;




begin
  fSQLCreateField := DB_FIELDS[dMySQL];
  fSQLCreateFieldMax := 4000;
  fSQLGetServerTimeStamp := DB_SERVERTIME[dMySQL];
  fProviderName := 'MYSQLPROV';
  inherited;
end;

{ TOleDBAS400ConnectionProperties }

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

{ TOleDBJetConnectionProperties }

procedure TOleDBJetConnectionProperties.SetInternalProperties;




begin
  fSQLCreateField := DB_FIELDS[dJet];
  fSQLCreateFieldMax := 255;
  fProviderName := 'Microsoft.Jet.OLEDB.4.0';
  inherited SetInternalProperties;
  if not FileExists(UTF8ToString(ServerName)) then
    CreateDatabase;
end;