mORMot and Open Source friends
Check-in [f324d469ee]
Not logged in
Home Documentation Forum Download Blog Donate Timeline Tickets Wiki Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:added ODBC support to SynDBExplorer (sounds to work fine, so far - but sower than direct OCI access)
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: f324d469ee1bbe4f0a1f952d83a886a1044123b9
User & Date: ab 2012-08-10 14:36:46
Context
2012-08-10
14:59
updated documentation about the new ODBC direct connection access (SynDBODBC.pas unit) check-in: 0980301f72 user: ab tags: trunk
14:36
added ODBC support to SynDBExplorer (sounds to work fine, so far - but sower than direct OCI access) check-in: f324d469ee user: ab tags: trunk
09:59
void TEXT column export fix check-in: 8044c5ea7c user: ab tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to SQLite3/Samples/12 - SynDB Explorer/SynDBExplorer.dpr. 

21
22
23
24
25
26
27

28
29
30
31
32
33
34

  - now direct-to-file fast export feature (into CSV, TXT, SQLite3,
    Synopse BigTable records or two JSON flavors)
  - now multi tables direct export into SQLite3 DB files (e.g. for support)
  - SQLite3 3.7.12.1 including (beta) private encryption methods

  Version 1.17
  - added Jet / MSAccess direct support (via OleDB provider)

  - added log history of SQL requests (in SynDBExplorer.history file)
  - SQLite3 engine updated to revision 3.7.13
  - changed .config file format from binary to JSON (with Base64+Zip if needed)

  first line of uses clause must be  {$I SynDprUses.inc}  to enable FastMM4
  conditional define should contain INCLUDE_FTS3 to handle FTS3/FTS4 in SQLite3 








>








21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

  - now direct-to-file fast export feature (into CSV, TXT, SQLite3,
    Synopse BigTable records or two JSON flavors)
  - now multi tables direct export into SQLite3 DB files (e.g. for support)
  - SQLite3 3.7.12.1 including (beta) private encryption methods

  Version 1.17
  - added Jet / MSAccess direct support (via OleDB provider)
  - added ODBC providers direct support
  - added log history of SQL requests (in SynDBExplorer.history file)
  - SQLite3 engine updated to revision 3.7.13
  - changed .config file format from binary to JSON (with Base64+Zip if needed)

  first line of uses clause must be  {$I SynDprUses.inc}  to enable FastMM4
  conditional define should contain INCLUDE_FTS3 to handle FTS3/FTS4 in SQLite3

Changes to SQLite3/Samples/12 - SynDB Explorer/SynDBExplorerClasses.pas. 

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

uses
  SysUtils, Classes,
  SynCommons, SQLite3Commons;

type
  TExpConnectionType = (
    ctOracleDirectOCI, ctOracleOLEDB, ctOracleMSOLEDB, ctMSSQL, ctGenericOLEDB,
    ctSqlite3, ctJet_mdbOLEDB);

  TSQLConnection = class(TSQLRecord)
  private
    fUserName: RawUTF8;
    fIdent: RawUTF8;
    fPassword: RawUTF8;
    fServer: RawUTF8;







|








5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

uses
  SysUtils, Classes,
  SynCommons, SQLite3Commons;

type
  TExpConnectionType = (
    ctOracleDirectOCI, ctOracleOLEDB, ctOracleMSOLEDB, ctMSSQL, ctGenericOLEDB,
    ctSqlite3, ctJet_mdbOLEDB, ctODBC);

  TSQLConnection = class(TSQLRecord)
  private
    fUserName: RawUTF8;
    fIdent: RawUTF8;
    fPassword: RawUTF8;
    fServer: RawUTF8;

Changes to SQLite3/Samples/12 - SynDB Explorer/SynDBExplorerMain.pas. 

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
..
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
..
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Grids, ExtCtrls, StdCtrls, Consts,
  SynCommons, SQLite3Commons, SynSQLite3, SynZip,
  SQLite3i18n, SQLite3UI, SQLite3UIEdit, SQLite3UILogin, SQLite3ToolBar,
  SynTaskDialog,  SynDB, SynDBOracle, SynOleDB, SynDBSQLite3,
  SynDBExplorerClasses, SynDBExplorerFrame, ComCtrls;

type
  TDbExplorerMain = class(TForm)
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
................................................................................
resourcestring
  sSelectAConnection = 'Select a connection';
  sNew = 'New connection';
  sNewOne = 'New';
  sConnectionHints = 'Display name|Database type|Server name '+
    '(for "Generic OLEDB", use ADO-like connection string, and ignore other fields; '+
    'for SQLite3 or Jet, specify the full file name)|'+
    'Database name (unneeded for Oracle/SQLite3/Jet)|User login|'+
    'User password (set ? for prompt)';
  sSelectOrCreateAConnection = 'Select a connection to be used, or\n'+
    'click on "New connection" to create one.';
  sPleaseWaitN = 'Connecting to %s...';
  sUpdateConnection = 'Update connection settings';
  sPassPromptN = 'Please enter password for %s@%s:';

................................................................................
procedure TDbExplorerMain.FormCreate(Sender: TObject);
var Conns: TSQLRestServerStaticInMemory;
function TryConnect(C: TSQLConnection; LoadTableNames: boolean): boolean;
const CONN_CLASSES: array[TExpConnectionType] of TSQLDBConnectionPropertiesClass =
  (TSQLDBOracleConnectionProperties,TOleDBOracleConnectionProperties,
   TOleDBMSOracleConnectionProperties,TOleDBMSSQLConnectionProperties,
   TOleDBConnectionProperties,TSQLDBSQLite3ConnectionProperties,
   TOleDBJetConnectionProperties);
var i: integer;
    Pass: RawUTF8;
begin
  result := false;
  try
    Pass := Crypt(C.Password);
    if Pass='?' then 







|







 







|







 







|








3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
..
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
..
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Grids, ExtCtrls, StdCtrls, Consts,
  SynCommons, SQLite3Commons, SynSQLite3, SynZip,
  SQLite3i18n, SQLite3UI, SQLite3UIEdit, SQLite3UILogin, SQLite3ToolBar,
  SynTaskDialog,  SynDB, SynDBOracle, SynOleDB, SynDBSQLite3, SynDBODBC,
  SynDBExplorerClasses, SynDBExplorerFrame, ComCtrls;

type
  TDbExplorerMain = class(TForm)
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
................................................................................
resourcestring
  sSelectAConnection = 'Select a connection';
  sNew = 'New connection';
  sNewOne = 'New';
  sConnectionHints = 'Display name|Database type|Server name '+
    '(for "Generic OLEDB", use ADO-like connection string, and ignore other fields; '+
    'for SQLite3 or Jet, specify the full file name)|'+
    'Database name (unneeded for Oracle/SQLite3/Jet/ODBC)|User login|'+
    'User password (set ? for prompt)';
  sSelectOrCreateAConnection = 'Select a connection to be used, or\n'+
    'click on "New connection" to create one.';
  sPleaseWaitN = 'Connecting to %s...';
  sUpdateConnection = 'Update connection settings';
  sPassPromptN = 'Please enter password for %s@%s:';

................................................................................
procedure TDbExplorerMain.FormCreate(Sender: TObject);
var Conns: TSQLRestServerStaticInMemory;
function TryConnect(C: TSQLConnection; LoadTableNames: boolean): boolean;
const CONN_CLASSES: array[TExpConnectionType] of TSQLDBConnectionPropertiesClass =
  (TSQLDBOracleConnectionProperties,TOleDBOracleConnectionProperties,
   TOleDBMSOracleConnectionProperties,TOleDBMSSQLConnectionProperties,
   TOleDBConnectionProperties,TSQLDBSQLite3ConnectionProperties,
   TOleDBJetConnectionProperties,TODBCConnectionProperties);
var i: integer;
    Pass: RawUTF8;
begin
  result := false;
  try
    Pass := Crypt(C.Password);
    if Pass='?' then

Changes to SynDBODBC.pas. 

102
103
104
105
106
107
108
109
110
111



112
113
114
115
116
117
118
...
279
280
281
282
283
284
285






286
287
288
289
290
291
292
...
665
666
667
668
669
670
671












672
673
674
675
676
677
678
...
822
823
824
825
826
827
828
















829
830
831
832
833
834
835
836
837
838
839
840
841
842
843

844
845
846
847
848
849
850
851
852
853
854

855
856
857
858
859
860
861
....
1035
1036
1037
1038
1039
1040
1041


1042
1043
1044
1045
1046
1047
1048
....
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
....
1514
1515
1516
1517
1518
1519
1520

1521
1522
1523
1524
1525
1526
1527
1528
1529
1530

1531
1532
1533
1534
1535
1536
1537
....
1538
1539
1540
1541
1542
1543
1544























1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583





















1584
1585
1586
1587
1588
1589
1590

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

  // 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;
................................................................................
      {$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;
................................................................................
      {$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 }

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







<
<

>
>
>







 







>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>











|



>
|









|
>







 







>
>







 







|







 







>










>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







<
|






|
<

|
|
|

<









|






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








102
103
104
105
106
107
108


109
110
111
112
113
114
115
116
117
118
119
...
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
...
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
...
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
....
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
....
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
....
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
....
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615

1616
1617
1618
1619
1620
1621
1622
1623

1624
1625
1626
1627
1628

1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672

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


    procedure GetFields(const aTableName: RawUTF8; var Fields: TSQLDBColumnDefineDynArray); override;
    /// initialize fForeignKeys content with all foreign keys of this DB
    // - used by GetForeignKey method
    procedure GetForeignKeys; override;
  end;

  /// implements a direct connection to the ODBC library
  TODBCConnection = class(TSQLDBConnectionThreadSafe)
  protected
    fODBCProperties: TODBCConnectionProperties;
    fEnv: pointer;
................................................................................

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

  // values for SQLStatistics()
  SQL_INDEX_UNIQUE = 0;
  SQL_INDEX_ALL = 1;
  SQL_QUICK = 0;
  SQL_ENSURE = 1;

  // connection attributes
  SQL_ACCESS_MODE = 101;
  SQL_AUTOCOMMIT = 102;
  SQL_LOGIN_TIMEOUT = 103;
  SQL_OPT_TRACE = 104;
  SQL_OPT_TRACEFILE = 105;
................................................................................
      {$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};
    StatisticsA: function(StatementHandle: SqlHStmt;
      CatalogName: PAnsiChar; NameLength1: SqlSmallint;
      SchemaName: PAnsiChar;  NameLength2: SqlSmallint;
      TableName: PAnsiChar;   NameLength3: SqlSmallint;
      Unique, Reserved: SqlUSmallint): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
    StatisticsW: function(StatementHandle: SqlHStmt;
      CatalogName: PWideChar; NameLength1: SqlSmallint;
      SchemaName: PWideChar;  NameLength2: SqlSmallint;
      TableName: PWideChar;   NameLength3: SqlSmallint;
      Unique, Reserved: SqlUSmallint): 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;
................................................................................
      {$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};
     ForeignKeysA: function(StatementHandle: SqlHStmt;
       PKCatalogName: PAnsiChar; NameLength1: SqlSmallint;
      PKSchemaName: PAnsiChar; NameLength2: SqlSmallint;
      PKTableName: PAnsiChar; NameLength3: SqlSmallint;
      FKCatalogName: PAnsiChar; NameLength4: SqlSmallint;
      FKSchemaName: PAnsiChar; NameLength5: SqlSmallint;
      FKTableName: PAnsiChar; NameLength6: SqlSmallint): SqlReturn;
      {$ifdef MSWINDOWS} stdcall {$else} cdecl {$endif};
     ForeignKeysW: function(StatementHandle: SqlHStmt;
       PKCatalogName: PWideChar; NameLength1: SqlSmallint;
      PKSchemaName: PWideChar; NameLength2: SqlSmallint;
      PKTableName: PWideChar; NameLength3: SqlSmallint;
      FKCatalogName: PWideChar; NameLength4: SqlSmallint;
      FKSchemaName: PWideChar; NameLength5: SqlSmallint;
      FKTableName: PWideChar; NameLength6: 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..60] 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',
     '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',
     'SQLForeignKeys','SQLForeignKeysW');

var
  ODBC: TODBCLib = nil;


{ TODBCConnection }

................................................................................
    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;
        if ColumnSize>65535 then
          ColumnSize := 0; // avoid out of memory error for BLOBs
        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
................................................................................
  result := inherited SQLCreate(aTableName,aFields);
end;

procedure TODBCConnectionProperties.GetFields(const aTableName: RawUTF8;
  var Fields: TSQLDBColumnDefineDynArray);
var Schema, Table: RawUTF8;
    F: TSQLDBColumnDefine;
    i,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
    // get column definitions
    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);
      fillchar(F,sizeof(F),0);
      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;
    // get indexes
    with TODBCStatement.Create(MainConnection) do
    try
      AllocStatement;
      ODBC.StatisticsA(fStatement,nil,0,pointer(Schema),SQL_NTS,
        pointer(Table),SQL_NTS,SQL_INDEX_ALL,SQL_QUICK);
      if status<>SQL_SUCCESS then // e.g. driver does not support schema
        ODBC.StatisticsA(fStatement,nil,0,nil,0,pointer(Table),SQL_NTS,SQL_INDEX_ALL,SQL_QUICK);
      ODBC.Check(status,SQL_HANDLE_STMT,fStatement);
      BindColumns;
      while Step do begin
        F.ColumnName := Trim(ColumnUTF8(8));
        if F.ColumnName<>'' then
        for i := 0 to n-1 do
          with Fields[i] do
          if IdemPropNameU(ColumnName,F.ColumnName) then begin
            ColumnIndexed := true;
            break;
          end;
      end;
    finally
      Free; // TODBCStatement release
    end;
  except
    on Exception do
      SetLength(Fields,0);
  end;
end;

procedure TODBCConnectionProperties.GetTableNames(var Tables: TRawUTF8DynArray);

var 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
    with TODBCStatement.Create(MainConnection) do

    try
      AllocStatement;
      ODBC.Check(ODBC.TablesA(fStatement,nil,0,nil,0,nil,0,'TABLE',SQL_NTS),SQL_HANDLE_STMT,fStatement);
      BindColumns;
      n := 0;

      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
      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;
      ODBC.Check(ODBC.ForeignKeysA(fStatement,nil,0,nil,0,nil,0,nil,0,nil,0,'%',SQL_NTS),
        SQL_HANDLE_STMT,fStatement);
      BindColumns;
      while Step do 
        fForeignKeys.Add(
          ColumnUTF8(5)+'.'+ColumnUTF8(6)+'.'+ColumnUTF8(7),
          ColumnUTF8(1)+'.'+ColumnUTF8(2)+'.'+ColumnUTF8(3));
    finally
      Free; // TODBCStatement release
    end;
  except
    on Exception do ; // just ignore errors here
  end;
end;


{ SQL_TIMESTAMP_STRUCT }

function SQL_TIMESTAMP_STRUCT.From(DateTime: TDateTime): SqlSmallint;
var Y,MS: word;
begin

©2010-2022 Synopse Informatique