- GetCol() will now retrieve all columns at once - mandatory for drivers not
    supporting SQL_GD_ANY_ORDER feature (like SQL Server Native Client 10.0)
  - TODBCConnectionProperties.Create will now handle full ODBC connection string
    in aDatabaseName instead of ODBC Data Source name in aServerName
  - now TODBCConnection.Connect() will recognize the DBMS from its driver name
  - added NexusDB, Firebird, SQlite3 and DB2 support
  - added Informix support - by EMartin





  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
................................................................................
  EODBCException = class(ESQLDBException);

  /// will implement properties shared by the ODBC library
  TODBCConnectionProperties = class(TSQLDBConnectionPropertiesThreadSafe)
  protected
    fDriverDoesNotHandleUnicode: Boolean;
    fSQLDriverConnectPrompt: Boolean;


    /// this overridden method will retrieve the kind of DBMS from the main connection
    function GetDBMS: TSQLDBDefinition; override;
  public
    /// initialize the connection properties
    // - will raise an exception if the ODBC library is not available
    // - SQLConnect() API will be used if aServerName is set: it should contain
    // the ODBC Data source name as defined in "ODBC Data Source Administrator"
................................................................................
    // - the caller is responsible of freeing this instance
    // - this overridden method will create an TODBCConnection instance
    function NewConnection: TSQLDBConnection; override;
    /// get all table names
    // - will retrieve the corresponding metadata from ODBC library if SQL
    // direct access was not defined
    procedure GetTableNames(out Tables: TRawUTF8DynArray); override;




    /// retrieve the column/field layout of a specified table
    // - will also check if the columns are indexed
    // - will retrieve the corresponding metadata from ODBC library if SQL
    // direct access was not defined (e.g. for dDB2)
    procedure GetFields(const aTableName: RawUTF8; out Fields: TSQLDBColumnDefineDynArray); override;
    /// initialize fForeignKeys content with all foreign keys of this DB
    // - used by GetForeignKey method
    procedure GetForeignKeys; override;


    /// retrieve procedure input/output parameter information


    procedure GetProcedureParameters(const aProcName: RawUTF8; out Parameters: TSQLDBProcColumnDefineDynArray); override;
    /// if full connection string may prompt the user for additional information
    // - property used only with SQLDriverConnect() API (i.e. when aServerName
    // is '' and aDatabaseName contains a full connection string)
    // - set to TRUE to allow UI prompt if needed
    property SQLDriverConnectPrompt: boolean read fSQLDriverConnectPrompt
      write fSQLDriverConnectPrompt;
................................................................................
    // - BLOB field value is saved as Base64, in the '"\uFFF0base64encodedbinary"
    // format and contains true BLOB data
    procedure ColumnsToJSON(WR: TJSONWriter); override;
    /// returns the number of rows updated by the execution of this statement
    function UpdateCount: integer; override;
  end;









implementation






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

const
  SQL_NULL_DATA = -1;
  SQL_DATA_AT_EXEC = -2;
  SQL_NO_TOTAL = -4;
................................................................................
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    SQLProcedureColumnsW: function(StatementHandle: SqlHStmt;
      CatalogName: PWideChar; NameLength1: SqlSmallint;
      SchemaName: PWideChar;  NameLength2: SqlSmallint;
      ProcName: PWideChar;   NameLength3: SqlSmallint;
      ColumnName: 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(Conn: TSQLDBConnection; Stmt: TSQLDBStatement; Status: SqlReturn;
      HandleType: SqlSmallint; Handle: SqlHandle; InfoRaiseException: Boolean=false;
................................................................................
    function GetDiagField(StatementHandle: SqlHStmt): RawUTF8;
    /// wrapper around GetInfo() API call
    procedure GetInfoString(ConnectionHandle: SqlHDbc; InfoType: SqlUSmallint;
      var Dest: RawUTF8);
  end;

const
  ODBC_ENTRIES: array[0..65] of PChar =
    ('SQLAllocEnv','SQLAllocHandle','SQLAllocStmt',
     'SQLBindCol','SQLBindParameter','SQLCancel','SQLCloseCursor',
     'SQLColAttribute','SQLColAttributeW','SQLColumns','SQLColumnsW',
     'SQLStatistics','SQLStatisticsW','SQLConnect','SQLConnectW',
     'SQLCopyDesc','SQLDataSources','SQLDataSourcesW',
     'SQLDescribeCol','SQLDescribeColW','SQLDisconnect','SQLEndTran',
     'SQLError','SQLErrorW','SQLExecDirect','SQLExecDirectW','SQLExecute',
................................................................................
     'SQLGetCursorName','SQLGetCursorNameW','SQLGetData',
     'SQLGetDescField','SQLGetDescFieldW','SQLGetDescRec','SQLGetDescRecW',
     'SQLGetDiagField','SQLGetDiagFieldW','SQLGetDiagRec','SQLGetDiagRecW',
     'SQLMoreResults','SQLPrepare','SQLPrepareW','SQLRowCount','SQLNumResultCols',
     'SQLGetInfo','SQLGetInfoW','SQLSetStmtAttr','SQLSetStmtAttrW','SQLSetEnvAttr',
     'SQLSetConnectAttr','SQLSetConnectAttrW','SQLTables','SQLTablesW',
     'SQLForeignKeys','SQLForeignKeysW','SQLDriverConnect','SQLDriverConnectW',
     'SQLProcedureColumnsA','SQLProcedureColumnsW');

var
  ODBC: TODBCLib = nil;








































































{ TODBCConnection }

procedure TODBCConnection.Connect;
const
  DBMS_NAMES: array[0..8] of PAnsiChar = (
................................................................................
  hDbc := (fConnection as TODBCConnection).fDbc;
  with ODBC do
    Check(nil,self,AllocHandle(SQL_HANDLE_STMT,hDBC,fStatement),SQL_HANDLE_DBC,hDBC);
end;

procedure TODBCStatement.DeallocStatement;
begin
  if fStatement<>nil then begin



    ODBC.Check(nil,self,ODBC.FreeHandle(SQL_HANDLE_STMT,fStatement),SQL_HANDLE_DBC,
      (fConnection as TODBCConnection).fDbc);



    fStatement := Nil;
  end;
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;
................................................................................
      Free; // TODBCStatement release
    end;
  except
    on Exception do
      SetLength(Tables,0);
  end;
end;
































procedure TODBCConnectionProperties.GetForeignKeys;
begin
  try
    with TODBCStatement.Create(MainConnection) do
    try
      AllocStatement;
................................................................................
    finally
      Free; // TODBCStatement release
    end;
  except
    on Exception do ; // just ignore errors here
  end;
end;


































procedure TODBCConnectionProperties.GetProcedureParameters(const aProcName: RawUTF8;
  out Parameters: TSQLDBProcColumnDefineDynArray);
var Schema, Package, Proc: RawUTF8;
    P: TSQLDBProcColumnDefine;
    PA: TDynArray;
    n,DataType: integer;
................................................................................
      Stmt.Free; // TODBCStatement release
    end;
  except
    on Exception do
      Parameters := nil;
  end;
end;









function TODBCConnectionProperties.GetDBMS: TSQLDBDefinition;
begin
  if fDBMS=dUnknown then
    with MainConnection as TODBCConnection do begin
      if not IsConnected then
        Connect; // retrieve DBMS property

  - GetCol() will now retrieve all columns at once - mandatory for drivers not
    supporting SQL_GD_ANY_ORDER feature (like SQL Server Native Client 10.0)
  - TODBCConnectionProperties.Create will now handle full ODBC connection string
    in aDatabaseName instead of ODBC Data Source name in aServerName
  - now TODBCConnection.Connect() will recognize the DBMS from its driver name
  - added NexusDB, Firebird, SQlite3 and DB2 support
  - added Informix support - by EMartin
  - added GetProcedureNames for listing stored procedure names from current connection
  - addes GetViewNames and SQLGetViewNames for listing view names from current connection
  - added ODBCInstalledDriversList for listing installed ODBC drivers (Windows only)
  - overrided GetDatabaseNameSafe over ODBC connection string

  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
................................................................................
  EODBCException = class(ESQLDBException);

  /// will implement properties shared by the ODBC library
  TODBCConnectionProperties = class(TSQLDBConnectionPropertiesThreadSafe)
  protected
    fDriverDoesNotHandleUnicode: Boolean;
    fSQLDriverConnectPrompt: Boolean;
    /// this overridden method will hide de DATABASE/PWD fields in ODBC connection string
    function GetDatabaseNameSafe: RawUTF8; override;
    /// this overridden method will retrieve the kind of DBMS from the main connection
    function GetDBMS: TSQLDBDefinition; override;
  public
    /// initialize the connection properties
    // - will raise an exception if the ODBC library is not available
    // - SQLConnect() API will be used if aServerName is set: it should contain
    // the ODBC Data source name as defined in "ODBC Data Source Administrator"
................................................................................
    // - the caller is responsible of freeing this instance
    // - this overridden method will create an TODBCConnection instance
    function NewConnection: TSQLDBConnection; override;
    /// get all table names
    // - will retrieve the corresponding metadata from ODBC library if SQL
    // direct access was not defined
    procedure GetTableNames(out Tables: TRawUTF8DynArray); override;
    /// get all view names
    // - will retrieve the corresponding metadata from ODBC library if SQL
    // direct access was not defined
    procedure GetViewNames(out Views: TRawUTF8DynArray); override;
    /// retrieve the column/field layout of a specified table
    // - will also check if the columns are indexed
    // - will retrieve the corresponding metadata from ODBC library if SQL
    // direct access was not defined (e.g. for dDB2)
    procedure GetFields(const aTableName: RawUTF8; out Fields: TSQLDBColumnDefineDynArray); override;
    /// initialize fForeignKeys content with all foreign keys of this DB
    // - used by GetForeignKey method
    procedure GetForeignKeys; override;
    /// retrieve a list of stored procedure names from current connection
    procedure GetProcedureNames(out Procedures: TRawUTF8DynArray); override;
    /// retrieve procedure input/output parameter information
    // - aProcName: stored procedure name to retrieve parameter infomation.
    // - Parameters: parameter list info (name, datatype, direction, default)
    procedure GetProcedureParameters(const aProcName: RawUTF8; out Parameters: TSQLDBProcColumnDefineDynArray); override;
    /// if full connection string may prompt the user for additional information
    // - property used only with SQLDriverConnect() API (i.e. when aServerName
    // is '' and aDatabaseName contains a full connection string)
    // - set to TRUE to allow UI prompt if needed
    property SQLDriverConnectPrompt: boolean read fSQLDriverConnectPrompt
      write fSQLDriverConnectPrompt;
................................................................................
    // - BLOB field value is saved as Base64, in the '"\uFFF0base64encodedbinary"
    // format and contains true BLOB data
    procedure ColumnsToJSON(WR: TJSONWriter); override;
    /// returns the number of rows updated by the execution of this statement
    function UpdateCount: integer; override;
  end;

{$ifdef MSWINDOWS}
/// List all ODBC drivers installed
// - aIncludeVersion: include the DLL driver version, if true the function is slower
// - aDrivers: driver list container, if aIncludeVersion is true then the list
// will be <driver name>=<dll version>
function ODBCInstalledDriversList(const aIncludeVersion: Boolean; out aDrivers: TStrings): boolean;
{$endif MSWINDOWS}

implementation

{$ifdef MSWINDOWS}
uses
  Registry;
{$endif MSWINDOWS}

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

const
  SQL_NULL_DATA = -1;
  SQL_DATA_AT_EXEC = -2;
  SQL_NO_TOTAL = -4;
................................................................................
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    SQLProcedureColumnsW: function(StatementHandle: SqlHStmt;
      CatalogName: PWideChar; NameLength1: SqlSmallint;
      SchemaName: PWideChar;  NameLength2: SqlSmallint;
      ProcName: PWideChar;   NameLength3: SqlSmallint;
      ColumnName: PWideChar;  NameLength4: SqlSmallint): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    SQLProcedures: function(StatementHandle: SqlHStmt;
      CatalogName: PWideChar; NameLength1: SqlSmallint;
      SchemaName: PWideChar;  NameLength2: SqlSmallint;
      ProcName: PWideChar;   NameLength3: 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(Conn: TSQLDBConnection; Stmt: TSQLDBStatement; Status: SqlReturn;
      HandleType: SqlSmallint; Handle: SqlHandle; InfoRaiseException: Boolean=false;
................................................................................
    function GetDiagField(StatementHandle: SqlHStmt): RawUTF8;
    /// wrapper around GetInfo() API call
    procedure GetInfoString(ConnectionHandle: SqlHDbc; InfoType: SqlUSmallint;
      var Dest: RawUTF8);
  end;

const
  ODBC_ENTRIES: array[0..66] of PChar =
    ('SQLAllocEnv','SQLAllocHandle','SQLAllocStmt',
     'SQLBindCol','SQLBindParameter','SQLCancel','SQLCloseCursor',
     'SQLColAttribute','SQLColAttributeW','SQLColumns','SQLColumnsW',
     'SQLStatistics','SQLStatisticsW','SQLConnect','SQLConnectW',
     'SQLCopyDesc','SQLDataSources','SQLDataSourcesW',
     'SQLDescribeCol','SQLDescribeColW','SQLDisconnect','SQLEndTran',
     'SQLError','SQLErrorW','SQLExecDirect','SQLExecDirectW','SQLExecute',
................................................................................
     'SQLGetCursorName','SQLGetCursorNameW','SQLGetData',
     'SQLGetDescField','SQLGetDescFieldW','SQLGetDescRec','SQLGetDescRecW',
     'SQLGetDiagField','SQLGetDiagFieldW','SQLGetDiagRec','SQLGetDiagRecW',
     'SQLMoreResults','SQLPrepare','SQLPrepareW','SQLRowCount','SQLNumResultCols',
     'SQLGetInfo','SQLGetInfoW','SQLSetStmtAttr','SQLSetStmtAttrW','SQLSetEnvAttr',
     'SQLSetConnectAttr','SQLSetConnectAttrW','SQLTables','SQLTablesW',
     'SQLForeignKeys','SQLForeignKeysW','SQLDriverConnect','SQLDriverConnectW',
     'SQLProcedureColumnsA','SQLProcedureColumnsW','SQLProcedures');

var
  ODBC: TODBCLib = nil;    

{$ifdef MSWINDOWS}
function ODBCInstalledDriversList(const aIncludeVersion: Boolean; out aDrivers: TStrings): Boolean;

  // expand environment variables, i.e %windir%
  // adapted from http://delphidabbler.com/articles?article=6
  function ExpandEnvVars(const aStr: string): string;
  var
    BufSize: Integer; // size of expanded string
  begin
    // Get required buffer size
    BufSize := ExpandEnvironmentStrings(pointer(aStr),nil,0);
    if BufSize>0 then begin
      // Read expanded string into result string
      SetLength(result, BufSize-1);
      ExpandEnvironmentStrings(pointer(aStr),pointer(result),BufSize);
    end else
      result := aStr; // return the original file name
  end;

  function GetFullFileVersion(const aFileName: TFileName): string;
  begin
    with TFileVersion.Create(aFileName,0,0,0) do
    try // five digits by section for easy version number comparison as string
      result := Format('%0.5d.%0.5d.%0.5d.%0.5d',[Major,Minor,Release,Build]);
    finally
      Free;
    end;
  end;

var
  I: Integer;
  lDriver: string;
begin
  with TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    {$ifdef CPU64}
    result := OpenKey('Software\WOW6432Node\ODBC\ODBCINST.INI\ODBC Drivers', false) or
              OpenKey('Software\WOW6432Node\ODBC\ODBCINST.INI', false);
    {$else}
    result := OpenKey('Software\ODBC\ODBCINST.INI\ODBC Drivers', false) or
              OpenKey('Software\ODBC\ODBCINST.INI', false);
    {$endif}
    if result then begin
      if not Assigned(aDrivers) then
        aDrivers := TStringList.Create;
      GetValueNames(aDrivers);
      if aIncludeVersion then
      for I := 0 to aDrivers.Count-1 do begin
        CloseKey;
        {$ifdef CPU64}
        result := OpenKey('Software\WOW6432Node\ODBC\ODBCINST.INI\' + aDrivers[I], false);
        {$else}
        result := OpenKey('Software\ODBC\ODBCINST.INI\' + aDrivers[I], false);
        {$endif}
        if result then begin
          // expand environment variable, i.e %windir%
          lDriver := ExpandEnvVars(ReadString('Driver'));
          aDrivers[I] := aDrivers[I] + '=' + GetFullFileVersion(lDriver);
        end;
      end;
    end;
  finally
    Free;
  end;
end;
{$else}
// TODO: ODBCInstalledDriversList for Linux
{$endif MSWINDOWS}


{ TODBCConnection }

procedure TODBCConnection.Connect;
const
  DBMS_NAMES: array[0..8] of PAnsiChar = (
................................................................................
  hDbc := (fConnection as TODBCConnection).fDbc;
  with ODBC do
    Check(nil,self,AllocHandle(SQL_HANDLE_STMT,hDBC,fStatement),SQL_HANDLE_DBC,hDBC);
end;

procedure TODBCStatement.DeallocStatement;
begin
  if fStatement<>nil then
    // avoid Informix exception and log exception race condition
    try
      try
        ODBC.Check(nil,self,ODBC.FreeHandle(SQL_HANDLE_STMT,fStatement),SQL_HANDLE_DBC,
          (fConnection as TODBCConnection).fDbc);
      except
      end;
    finally
      fStatement := Nil;
    end;
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;
................................................................................
      Free; // TODBCStatement release
    end;
  except
    on Exception do
      SetLength(Tables,0);
  end;
end;

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

procedure TODBCConnectionProperties.GetForeignKeys;
begin
  try
    with TODBCStatement.Create(MainConnection) do
    try
      AllocStatement;
................................................................................
    finally
      Free; // TODBCStatement release
    end;
  except
    on Exception do ; // just ignore errors here
  end;
end;

procedure TODBCConnectionProperties.GetProcedureNames(out Procedures: TRawUTF8DynArray);
var Schema: RawUTF8;
    n: integer;
    status: SqlReturn;
    Stmt: TODBCStatement;
begin
  inherited; // first try from SQL, if any (faster)
  if Procedures<>nil then
    exit; // already retrieved directly from engine
  SetSchemaNameToOwner(Schema);
  Schema := SynCommons.UpperCase(Schema);
  try
    // get procedure list
    Stmt := TODBCStatement.Create(MainConnection);
    try
      Stmt.AllocStatement;
      status := ODBC.SQLProcedures(Stmt.fStatement,nil,0,pointer(Schema),SQL_NTS,nil,0);
      ODBC.Check(Stmt.Connection,nil,status,SQL_HANDLE_STMT,Stmt.fStatement);
      Stmt.BindColumns;
      n := 0;
      while Stmt.Step do begin
        AddSortedRawUTF8(Procedures,n,Trim(Stmt.ColumnUTF8(2))); // PROCEDURE_NAME column
      end;
      SetLength(Procedures,n);
    finally
      Stmt.Free; // TODBCStatement release
    end;
  except
    on Exception do
      Procedures := nil;
  end;
end;

procedure TODBCConnectionProperties.GetProcedureParameters(const aProcName: RawUTF8;
  out Parameters: TSQLDBProcColumnDefineDynArray);
var Schema, Package, Proc: RawUTF8;
    P: TSQLDBProcColumnDefine;
    PA: TDynArray;
    n,DataType: integer;
................................................................................
      Stmt.Free; // TODBCStatement release
    end;
  except
    on Exception do
      Parameters := nil;
  end;
end;

function TODBCConnectionProperties.GetDatabaseNameSafe: RawUTF8;
var
  lPWD: RawUTF8;
begin
  lPWD := FindIniNameValue(pointer(StringReplaceAll(fDatabaseName,';',sLineBreak)), 'PWD=');
  result := StringReplaceAll(fDatabaseName,lPWD,'***');
end;

function TODBCConnectionProperties.GetDBMS: TSQLDBDefinition;
begin
  if fDBMS=dUnknown then
    with MainConnection as TODBCConnection do begin
      if not IsConnected then
        Connect; // retrieve DBMS property

'1.18.2302'

'1.18.2303'