forked from synopse/mORMot
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathSynDBZeos.pas
1351 lines (1266 loc) · 54 KB
/
SynDBZeos.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
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
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
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
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
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
/// ZEOS 7.x direct access classes for SynDB units (not DB.pas based)
// - this unit is a part of the freeware Synopse framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit SynDBZeos;
{
This file is part of Synopse framework.
Synopse framework. Copyright (C) 2020 Arnaud Bouchez
Synopse Informatique - https://synopse.info
*** BEGIN LICENSE BLOCK *****
Version: MPL 1.1/GPL 2.0/LGPL 2.1
The contents of this file are subject to the Mozilla Public License Version
1.1 (the "License"); you may not use this file except in compliance with
the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
for the specific language governing rights and limitations under the License.
The Original Code is Synopse mORMot framework.
The Initial Developer of the Original Code is Arnaud Bouchez.
Portions created by the Initial Developer are Copyright (C) 2020
the Initial Developer. All Rights Reserved.
Contributor(s):
- alexpirate
- Daniel Kuettner
- delphinium
- EgonHugeist (Michael)
- Joe (jokussoftware)
Alternatively, the contents of this file may be used under the terms of
either the GNU General Public License Version 2 or later (the "GPL"), or
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
in which case the provisions of the GPL or the LGPL are applicable instead
of those above. If you wish to allow use of your version of this file only
under the terms of either the GPL or the LGPL, and not to allow others to
use your version of this file under the terms of the MPL, indicate your
decision by deleting the provisions above and replace them with the notice
and other provisions required by the GPL or the LGPL. If you do not delete
the provisions above, a recipient may use your version of this file under
the terms of any one of the MPL, the GPL or the LGPL.
***** END LICENSE BLOCK *****
}
(*
Note:
- if you want to work as expected with SQlite3 backend (but how would need to
do it, since it will be MUCH slower compared to SynDBSQlite3), you need
to apply some patches for Zeos < 7.2 :
function TZSQLiteCAPIPreparedStatement.ExecuteQueryPrepared: IZResultSet;
begin
if Not Prepared then
Prepare;
try
if LastResultSet <> nil then
LastResultSet.Close; // reset stmt
LastResultSet := nil;
BindInParameters;
FErrorCode := FPlainDriver.Step(FStmtHandle);
CheckSQLiteError(FPlainDriver, FStmtHandle, FErrorCode, nil, lcOther,
ConSettings^.ConvFuncs.ZStringToRaw(SCanNotRetrieveResultsetData, ConSettings^.CTRL_CP, ConSettings^.ClientCodePage^.CP),
ConSettings);
if ( FErrorCode = SQLITE_ROW ) or ( FErrorCode = SQLITE_DONE) then
LastResultSet := CreateResultSet(FStmtHandle, FErrorCode);
Result := LastResultSet;
inherited ExecuteQueryPrepared;
except
raise;
end;
end;
procedure TZSQLiteResultSet.FreeHandle;
var
ErrorCode: Integer;
begin
if FFreeHandle then
begin
if Assigned(FStmtHandle) then
ErrorCode := FPlainDriver.Finalize(FStmtHandle)
else
ErrorCode := SQLITE_OK;
FStmtHandle := nil;
CheckSQLiteError(FPlainDriver, FStmtHandle, ErrorCode, nil,
lcOther, 'FINALIZE SQLite VM', ConSettings);
end
else
begin
if FStmtHandle <> nil then
begin
ErrorCode := FPlainDriver.reset(FStmtHandle);
CheckSQLiteError(FPlainDriver, FStmtHandle, ErrorCode, nil, lcBindPrepStmt, 'Reset Prepared Stmt', ConSettings);
FStmtHandle := nil;
end;
FErrorCode := SQLITE_DONE;
end;
end;
... but you should better upgrade to the latest Zeos 7.3 revision! :)
See https://synopse.info/forum/viewtopic.php?pid=9146#p9146
*)
{$ifdef NOSYNDBZEOS} // defined in mormot_base.lpk Lazarus package > Custom Options > Defines
interface
implementation
{$else}
{$I Zeos.inc} // define conditionals like ZEOS72UP and ENABLE_*
// for best performance: tune your project options or Zeos.inc
// to define USE_SYNCOMMONS and leverage best of mORMot and ZEOS !
{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER
interface
uses
{$ifdef MSWINDOWS}
Windows,
{$endif}
Types,
SysUtils,
{$ifndef DELPHI5OROLDER}
Variants,
{$endif}
Classes,
Contnrs,
// load physical providers as defined by ENABLE_* in Zeos.inc
// -> you can patch your local Zeos.inc and comment these defines to
// exclude database engines you don't need
// or (since 7.2) you simply add the ZEOS_DISABLE_XXX defines to your
// project options. The units are used but no line code will be compiled.
{$if defined(ENABLE_ADO) and not defined(ZEOS_DISABLE_ADO)}
ZDbcAdo,
{$ifend}
{$if defined(ENABLE_DBLIB) and not defined(ZEOS_DISABLE_DBLIB)}
ZDbcDbLib,
{$ifend}
{$if defined(ENABLE_MYSQL) and not defined(ZEOS_DISABLE_MYSQL)}
ZDbcMySql,
{$ifend}
{$if defined(ENABLE_POSTGRESQL) and not defined(ZEOS_DISABLE_POSTGRESQL)}
ZDbcPostgreSql,
{$ifend}
{$if defined(ENABLE_INTERBASE) and not defined(ZEOS_DISABLE_INTERBASE)}
ZDbcInterbase6,
{$ifend}
{$if defined(ENABLE_SQLITE) and not defined(ZEOS_DISABLE_SQLITE)}
ZDbcSqLite,
{$ifend}
{$if defined(ENABLE_ORACLE) and not defined(ZEOS_DISABLE_ORACLE)}
ZDbcOracle,
{$ifend}
{$if defined(ENABLE_ASA) and not defined(ZEOS_DISABLE_ASA)}
ZDbcASA,
{$ifend}
{$if defined(ENABLE_POOLED) and not defined(ZEOS_DISABLE_POOLED)}
ZDbcPooled,
{$ifend}
{$if defined(ENABLE_OLEDB) and not defined(ZEOS_DISABLE_OLEDB)}
ZDbcOleDB,
{$ifend}
{$if defined(ENABLE_ODBC) and not defined(ZEOS_DISABLE_ODBC)}
ZDbcODBCCon,
{$ifend}
// main ZDBC units
ZCompatibility,
ZVariant,
ZURL,
ZDbcIntfs,
ZDbcResultSet,
// mORMot units after ZDBC due to some name conflicts (e.g. UTF8ToString)
SynCommons,
SynTable,
SynLog,
SynDB;
{ -------------- ZEOS database components direct process }
type
/// Exception type associated to the ZEOS database components
ESQLDBZEOS = class(ESQLDBException);
/// implement properties shared by ZEOS connections
TSQLDBZEOSConnectionProperties = class(TSQLDBConnectionPropertiesThreadSafe)
protected
fURL: TZURL;
fStatementParams: TStrings;
fDBMSName: RawUTF8;
fSupportsArrayBindings: boolean;
/// initialize fForeignKeys content with all foreign keys of this DB
// - do nothing by now (ZEOS metadata may be used in the future)
procedure GetForeignKeys; override;
/// convert ZDBC field type into mORMot fieldtype
function TZSQLTypeToTSQLDBFieldType(aNativeType: TZSQLType): TSQLDBFieldType;
public
/// initialize the properties to connect to the ZEOS engine
// - aServerName shall contain the ZEOS URI, e.g:
// $ zdbc:firebird-2.0://127.0.0.1:3050/model?username=sysdba;password=masterkey
// $ zdbc:mysql://192.168.2.60:3306/world?username=root;password=dev
// $ sqlite
// i.e. '[zdbc:]PROTOCOL://HOST:PORT[/DATABASE][?paramname=value]'
// - you can define the TZConnection.LibraryLocation property by setting a
// '?LibLocation=...' parameter within the aServerName URL value
// - or simply use TSQLDBZEOSConnectionProperties.URI() class method
// - aDatabaseName, aUserID, aPassword are used if not already set as URI
// in aServerName value
// - you can use Protocols property to retrieve all available protocol names
// - note that when run from mORMot's ORM, this class will by default
// create one connection per thread, which makes some clients (e.g.
// PostgreSQL) unstable and consuming a lot of resources - you should better
// maintain one single connection, by setting after Create:
// ! aExternalDBProperties.ThreadingMode := tmMainConnection;
// or by adding 'syndb_singleconnection=true' as URI property
constructor Create(const aServerName, aDatabaseName, aUserID, aPassWord: RawUTF8); override;
/// initialize raw properties to connect to the ZEOS engine
// - using Zeos' TZURL detailed class - see: src\core\ZURL.pas
// - this gives all possibilities to add Properties before a connection is opened
// - you can define the protocol by hand eg. "odbc_w"/"OleDB" and define TSQLDBDefinition
// to describe the server syntax SynDB and the ORM use behind the abstract driver
constructor CreateWithZURL(const aURL: TZURL; aDBMS: TSQLDBDefinition; aOwnsURL: Boolean); virtual;
/// finalize properties internal structures
destructor Destroy; override;
/// create a new connection
// - caller is responsible of freeing this instance
// - this overridden method will create an TSQLDBZEOSConnection instance
function NewConnection: TSQLDBConnection; override;
/// retrieve the column/field layout of a specified table
// - this overridden method will use ZDBC metadata to retrieve the information
procedure GetFields(const aTableName: RawUTF8; out Fields: TSQLDBColumnDefineDynArray); override;
/// get all table names
// - this overridden method will use ZDBC metadata to retrieve the information
// - PostgreSQL note: it was reported that some table names expects to be
// quoted for this DB engine - and ZDBC won't do it for yourself - please
// ensure you specify the correct quoted table name e.g. when you register
// the external PostgreSQL table via function VirtualTableExternalRegister()
procedure GetTableNames(out Tables: TRawUTF8DynArray); override;
/// access to the database metadata, as retrieved by ZEOS
// - returns TRUE if metadata interface has been retrieved
function GetDatabaseMetadata(out meta: IZDatabaseMetadata): boolean;
/// compute the ZEOS URI for a given database engine
// - the optional server name can contain a port number, specified after ':'
// - you can set an optional full path to the client library name,
// to be completed on the left side with the executable path
// - possible use may be:
// ! PropsOracle := TSQLDBZEOSConnectionProperties.Create(
// ! TSQLDBZEOSConnectionProperties.URI(dOracle,'','oci64\oci.dll'),
// ! 'tnsname','user',pass');
// ! PropsFirebird := TSQLDBZEOSConnectionProperties.Create(
// ! TSQLDBZEOSConnectionProperties.URI(dFirebird,'','Firebird\fbembed.dll'),
// ! 'databasefilename','',');
// ! PropsFirebird := TSQLDBZEOSConnectionProperties.Create(
// ! TSQLDBZEOSConnectionProperties.URI(dFirebird,'192.168.1.10:3055',
// ! 'c:\Firebird_2_5\bin\fbclient.dll',false),
// ! '3camadas', 'sysdba', 'masterkey');
class function URI(aServer: TSQLDBDefinition;
const aServerName: RawUTF8; const aLibraryLocation: TFileName='';
aLibraryLocationAppendExePath: boolean=true): RawUTF8; overload;
/// compute the ZEOS URI for a given protocol
// - if a TSQSLDBDefinition may have several protocols (e.g. MSSQL), you
// can use this overloaded method to select the exact protocol to use if the
// default one fixed by TSQLDBDefinition does not match your needs
// - the protocol name should contain the trailing : character, e.g.
// 'firebird-2.0:' if the default 'firebird-2.5:' is not correct
class function URI(const aProtocol, aServerName: RawUTF8;
const aLibraryLocation: TFileName='';
aLibraryLocationAppendExePath: boolean=true): RawUTF8; overload;
published
/// the remote DBMS name, as retrieved from ServerName, i.e. ZEOS URL
property DBMSName: RawUTF8 read fDBMSName;
/// direct access to the internal TZURL connection parameters
property ZeosURL: TZURL read fURL;
/// direct access to the internal statement parameters
// - i.e. will be used by IZConnection.PrepareStatementWithParams()
// - default values (set in Create method) try to achieve best permormance
property ZeosStatementParams: TStrings read fStatementParams;
/// if the associated ZDBC provider supports parameters array binding
// - you should use the BindArray() methods only if this property is TRUE
property SupportsArrayBindings: boolean read fSupportsArrayBindings;
end;
/// implements a connection via the ZEOS access layer
TSQLDBZEOSConnection = class(TSQLDBConnectionThreadSafe)
protected
fDatabase: IZConnection;
public
/// prepare a connection to a specified ZEOS database server
constructor Create(aProperties: TSQLDBConnectionProperties); override;
/// connect to the specified ZEOS server
// - should raise an ESQLDBZEOS on error
procedure Connect; override;
/// stop connection to the specified ZEOS database server
// - should raise an ESQLDBZEOS on error
procedure Disconnect; override;
/// return TRUE if Connect has been already successfully called
function IsConnected: boolean; override;
/// create a new statement instance
function NewStatement: TSQLDBStatement; override;
/// begin a Transaction for this connection
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;
/// access to the associated ZEOS connection instance
property Database: IZConnection read fDatabase;
end;
/// implements a statement via a ZEOS database connection
TSQLDBZEOSStatement = class(TSQLDBStatementWithParamsAndColumns)
protected
fStatement: IZPreparedStatement;
fResultSet: IZResultSet;
fResultInfo: IZResultSetMetaData;
{$if defined(ZEOS73UP) and defined(USE_SYNCOMMONS)}
fJSONComposeOptions: TZJSONComposeOptions;
{$ifend}
public
{$if defined(ZEOS73UP) and defined(USE_SYNCOMMONS)}
procedure AfterConstruction; override;
{$ifend}
/// 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 ESQLDBZeos 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
// - this implementation will also handle bound array of values (if any),
// if IZDatabaseInfo.SupportsArrayBindings is true for this provider
// - this overridden method will log the SQL statement if sllSQL has been
// enabled in SynDBLog.Family.Level
// - raise an ESQLDBZeos on any error
procedure ExecutePrepared; override;
{$ifdef ZEOS72UP}
/// append all columns values of the current Row to a JSON stream
// - will use WR.Expand to guess the expected output format
// - this overriden implementation will call fReultSet methods to avoid
// creating most temporary variable
procedure ColumnsToJSON(WR: TJSONWriter); override;
{$endif}
/// gets a number of updates made by latest executed statement
function UpdateCount: integer; override;
/// Reset the previous prepared statement
// - this overridden implementation will reset all bindings and the cursor state
// - raise an ESQLDBZeos on any error
procedure Reset; 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 ESQLDBZeos on any error
function Step(SeekFirst: boolean = false): boolean; override;
/// free IZResultSet/IZResultSetMetaData when ISQLDBStatement is back in cache
procedure ReleaseRows; override;
/// return a Column integer value of the current Row, first Col is 0
function ColumnInt(Col: Integer): Int64; override;
/// returns TRUE if the column contains NULL
function ColumnNull(Col: Integer): boolean; override;
/// return a Column floating point value of the current Row, first Col is 0
function ColumnDouble(Col: Integer): double; override;
/// return a Column date and time 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
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
function ColumnBlob(Col: Integer): RawByteString; override;
{$if defined(ZEOS73UP) and defined(USE_SYNCOMMONS)}
public
/// the ColumnsToJSON options provided by ZDBC
// - jcoEndJSONObject:
// cancels last comma, adds the close object bracket '}' and add's the next comma.
// If not set you can continue writting some custom data into your
// object json but you also have to finalize each row-object then.
// - jcoMongoISODate:
// formats the date,time,datetime values as mongo
// ISODate("YYYY-MM-DDTHH:NN:ssZ"). Milliseconds are included.
// So the values are recognized as date type by mongodb.
// Otherwise mongo threads them as strings.
// This option might be usefull if you export sql rows using a
// json streamed file which will be used as an import-file with your mongodb
// If set the options jcoDATETIME_MAGIC and jcoMilliseconds are ignored
// - jcoDATETIME_MAGIC add the JSON_SQLDATE_MAGIC on top of data
// before adding the ISO date,time,datetime value quoted strings
// - jcoMilliseconds compose the time/datetime values with milliseconds
// - jcsSkipNulls ignore null columns. So neither fieldname nor the null
// value will be composed into your JSON. For real big JSON contents
// it saves loads of space. e.g. if you import a JSON into a mongo cluster
// you'll have a significant space difference if null's are simply ignored.
property JSONComposeOptions: TZJSONComposeOptions read fJSONComposeOptions write fJSONComposeOptions
default [jcoEndJSONObject];
{$ifend}
end;
var
/// list of all available ZEOS protocols
// - you have to call SetZEOSProtocols before using it, to update this
// global list with all initialized ZPlain*Driver units
// - to be used e.g. within ZEOS URI, as TSQLDBZEOSConnectionProperties.ServerName
ZEOSProtocols: TRawUTF8DynArray;
/// to be called in order to populate the global ZEOSProtocols list
procedure SetZEOSProtocols;
implementation
{$ifdef ZEOS72UP}
uses ZDbcMetadata {$IFDEF ZEOS73UP} , ZDbcProperties {$ENDIF};
{$else}
const
FirstDbcIndex = 1;
TableNameIndex = 3;
ColumnNameIndex = 4;
TableColColumnTypeIndex = 5;
TableColColumnTypeNameIndex = 6;
TableColColumnSizeIndex = 7;
TableColColumnDecimalDigitsIndex = 9;
IndexInfoColColumnNameIndex = 9;
{$endif}
{ TSQLDBZEOSConnectionProperties }
constructor TSQLDBZEOSConnectionProperties.Create(
const aServerName, aDatabaseName, aUserID, aPassWord: RawUTF8);
const
PCHARS: array[0..8] of PAnsiChar = (
'ORACLE','FREETDS_MSSQL','MSSQL','INTERBASE','FIREBIRD','MYSQL','SQLITE','POSTGRESQL','JET');
TYPES: array[-1..high(PCHARS)] of TSQLDBDefinition = (
dDefault,dOracle,dMSSQL,dMSSQL,dFirebird,dFirebird,dMySQL,dSQLite,dPostgreSQL,dJet{e.g. ADO[JET]});
// expecting Sybase + ASA support in TSQLDBDefinition
var BrakedPos: Integer;
begin // return e.g. mysql://192.168.2.60:3306/world?username=root;password=dev
// make syntax like "ADO[ORACLE]"/"ADO[MSSQL]:"/"ADO[JET]" etc... possible
BrakedPos := PosExChar('[', aServerName);
if (BrakedPos>0) and ((aServerName[Length(aServerName)]=']') or
(aServerName[Length(aServerName)-1]=']')) then begin
fServerName := Copy(aServerName,1,BrakedPos-1);
fDBMSName := Copy(aServerName,BrakedPos+1,PosExChar(']',aServerName)-1-BrakedPos);
end else
fServerName := aServerName;
if (fServerName<>'') and (PosExChar(':',fServerName)=0) then
fServerName := fServerName+':';
if not IdemPChar(Pointer(aServerName),'ZDBC:') then
fServerName := 'zdbc:'+fServerName;
fURL := TZURL.Create(UTF8ToString(fServerName));
if fURL.Database='' then
fURL.Database := UTF8ToString(aDatabaseName);
if fURL.UserName='' then
fURL.UserName := UTF8ToString(aUserID);
if fURL.Password='' then
fURL.Password := UTF8ToString(aPassWord);
if fDBMSName = '' then
StringToUTF8(fURL.Protocol,fDBMSName);
CreateWithZURL(fURL, TYPES[IdemPCharArray(pointer(fDBMSName),PCHARS)], true);
end;
procedure TSQLDBZEOSConnectionProperties.GetForeignKeys;
begin
{ TODO : get FOREIGN KEYS from ZEOS metadata ? }
end;
function TSQLDBZEOSConnectionProperties.NewConnection: TSQLDBConnection;
begin
result := TSQLDBZEOSConnection.Create(self);
end;
constructor TSQLDBZEOSConnectionProperties.CreateWithZURL(const aURL: TZURL;
aDBMS: TSQLDBDefinition; aOwnsURL: Boolean);
{$IFDEF ZEOS73UP}var protocol: RawUTF8;{$endif}
begin // return e.g. mysql://192.168.2.60:3306/world?username=root;password=dev
if aOwnsURL then
fURL := aURL else
fURL := TZURL.Create(aURL);
fDBMS := aDBMS;
{$ifndef UNICODE}
fURL.Properties.Values['controls_cp'] := 'CP_UTF8';
{$endif}
{ Implementation/Enhancements Notes About settings below (from Michael):
ConnectionProperties:
Since 7.3 you should look to ZDbcProperties.pas
All connection Properties including driver dependencies are listed in this file.
otherwise:
Make it possible to Assign Parameters on the fly e.g.:
FireBird:
- add custom TIL's by hand if tiNone was set. or some more custom settings:
see ZDbcInterbaseUtils.pas: TransactionParams and DatabaseParams
- "hard_commit=true" False by default
PostgreSQL:
- "oidasblob=true" - False by default
notify Zeos should use Oid fields as BLob's
- "CheckFieldVisibility=True/False"
notify Zeos should determine temporary tables field meta informations too
required for mORMot?
- "NoTableInfoCache=True/False" - False by default
notify Zeos it should use internal TableInfo-cache.
Set the value to true to save memory
ADO:
7.3up
- "internal_buffer_size=X" in bytes default are 128KB
this is the max size in bytes you allow Zeos to use for batch-ole array_bindings
This parameter is only used if "use_ole_update_params=True"
- "use_ole_update_params=True/False" default = False
bypassing slow MSADO15.DLL and direct use OleDB parameters for all kind
of updates including batch Note: current code is also able to handle Out/InOut
params except for out/inout lob's.
note: both internal_buffer_size and use_ole_update_params can be used as
statement parameters as well
Oracle:
- "row_prefetch_size=x! in bytes
this value will be send to OCI and indicates Oracle which
row_prefetch_size you allow to execute a query
}
{$IFDEF ZEOS73UP}
if fDBMS = dMSSQL then begin
protocol := LowerCase(StringToUTF8(FURL.Protocol));
//EH: switch off tds support in any kind -> deprecated and our 64bit lib isn't compiled with libiconv support
//users permanently run into the encoding issues which can't be resolved using the dblib tds-types:
//tdsNVarchar/tdsNText is defined but will never be used by DBLIB + SQLServer)
if {$IFDEF MSWINDOWS}(protocol <> 'ado') and (protocol <> 'oledb') and {$endif}
(protocol <> 'odbc_w') and (protocol <> 'odbc_a') then
{$IFDEF MSWINDOWS}
FURL.Protocol := 'OleDB';
{$else}
FURL.Protocol := 'odbc_w'
{$endif}
end;
{$endif}
inherited Create(StringToUTF8(FURL.HostName),StringToUTF8(FURL.Database),StringToUTF8(FURL.UserName),StringToUTF8(FURL.Password));
if StrToBoolDef(fURL.Properties.Values['syndb_singleconnection'],false) then
ThreadingMode := tmMainConnection;
fUseCache := {$ifdef ZEOS72UP}true{$else}false{$endif}; // caching disabled by default - enabled if stable enough
case fDBMS of
dSQLite: begin
{$ifndef ZEOS72UP}
fSQLCreateField[ftInt64] := ' BIGINT'; // SQLite3 INTEGER = 32bit for ZDBC!
{$endif}
end;
dFirebird: begin
if (fURL.HostName='') and // Firebird embedded
(fURL.Database<>'') then begin
ThreadingMode := tmMainConnection; // force SINGLE connection
if not FileExists(fURL.Database) then // create local DB file if needed
fURL.Properties.Add('createNewDatabase='+UTF8ToString(
SQLCreateDatabase(StringToUTF8(fURL.Database))));
end;
fURL.Properties.Add('codepage=UTF8');
fUseCache := true; // caching rocks with Firebird ZDBC provider :)
end;
dOracle, dPostgreSQL, dMySQL: begin
fURL.Properties.Add('codepage=UTF8');
fUseCache := true;
end;
end;
fStatementParams := TStringList.Create;
case fDBMS of
dOracle: begin
{$ifndef ZEOS72UP} // fixed since 7.2up
// sets OCI_ATTR_PREFETCH_ROWS on prepare a fetch
// default = 100 on 7.1down
// since 7.3 the option is ignored
fStatementParams.Add('prefetch_count=1000');
{$else}
//max mem in bytes which OCI(Server) can use for a result on Server-Side
//fStatementParams.Add('row_prefetch_size=131072');
//max mem in bytes which Zeos can for batch or resultset buffers
//fStatementParams.Add('internal_buffer_size=131072');
{$endif}
end;
dSQLite: begin
{$ifdef ZEOS72UP} // new since 7.2up
// Bind double values instead of ISO formated DateTime-strings
//fStatementParams.Add('BindDoubleDateTimeValues=True');
{$endif}
end;
dMySQL: begin
// use mysql real-prepared api instead of string based once
// actually it's not realy faster.. just a hint:
// http://dev.mysql.com/doc/refman/5.0/en/c-api-prepared-statement-problems.html
//fStatementParams.Add('preferprepared=True');
// https://mariadb.com/kb/en/library/bulk-insert-row-wise-binding/
// https://mariadb.com/kb/en/library/bulk-insert-column-wise-binding/
// if you run into some mysql known issues,
// since 7.3 you've to explicit unset real_prepared by
//fStatementParams.Add('emulate_prepares=True'); or
//fStatementParams.Add('MinExecCountBeforePrepare=-1');
end;
dPostgreSQL: begin
// see https://synopse.info/forum/viewtopic.php?pid=13260#p13260
fURL.Properties.Add('NoTableInfoCache=true');
{$IFDEF ZEOS73UP}
//fURL.Properties.Add(DSProps_BinaryWireResultMode+'=False');
{$ENDIF}
end;
dMSSQL: begin
fUseCache := true;
fStatementParams.Add('enhanced_column_info=false');
//fStatementParams.Add('use_ole_update_params=True'); //see 'ADO'
//fStatementParams.Add('internal_buffer_size=131072'); //see 'ADO'
// EH: hooking a syndb bug. Void strings are not accepted by SQLServer if:
// fixed-width columns are used and option ANSI_PADDING is set to !off!.
StoreVoidStringAsNull := False;
end;
end;
if fDBMS in [dOracle,dPostgreSQL,dMySQL,dMSSQL] then begin
// let's set 1024KB / chunk for synopse or more?
// retrieving/submitting lob's in chunks. Default is 4096Bytes / Chunk
// it's depending to your local network speed e.g. bad WLAN or so
// for Firebird we always using the blob-segment size
fStatementParams.Add('chunk_size=1048576');
end;
if fDBMS in [dPostgreSQL,dFireBird] then begin
{$ifdef ZEOS72UP} // new since 7.2up
// Always load the lobs? Or just on accessing them?
// if you allways copy the data by fetching the row than it doesn't make sense.
fStatementParams.Add('cachedlob=false'); //default = False
{$endif}
end;
end;
destructor TSQLDBZEOSConnectionProperties.Destroy;
begin
FreeAndNil(fURL);
FreeAndNil(fStatementParams);
inherited;
end;
procedure SetZEOSProtocols;
var List: TStringList;
i,j: integer;
Protocols: Types.TStringDynArray;
begin
List := TStringList.Create;
try
with DriverManager.GetDrivers do
for i := 0 to Count-1 do begin
Protocols := (Items[i] as IZDriver).GetSupportedProtocols;
for j := 0 to high(Protocols) do
List.Add(Protocols[j]);
end;
List.Sort;
StringListToRawUTF8DynArray(List,ZEOSProtocols);
finally
List.Free;
end;
end;
function TSQLDBZEOSConnectionProperties.GetDatabaseMetadata(out meta: IZDatabaseMetadata): boolean;
var conn: IZConnection;
begin
conn := (MainConnection as TSQLDBZEOSConnection).fDatabase;
result := conn.UseMetadata;
meta := conn.GetMetadata;
if result then
meta.ClearCache; // we need to retrieve the actual metadata
{$ifdef ZEOS72UP} // new since 7.2up
if Result and meta.GetDatabaseInfo.SupportsArrayBindings then begin
case GetDBMS of
dPostgreSQL:
fBatchSendingAbilities := [cCreate, cDelete] // EH: array logic isn't ready 4updates yet
else
fBatchSendingAbilities := [cCreate, cUpdate, cDelete];
end;
OnBatchInsert := nil;
fSupportsArrayBindings := True;
end;
{$endif}
end;
procedure TSQLDBZEOSConnectionProperties.GetTableNames(out Tables: TRawUTF8DynArray);
var meta: IZDatabaseMetadata;
res: IZResultSet;
TableTypes: Types.TStringDynArray;
n: integer;
begin
if GetDatabaseMetadata(meta) then begin
SetLength(TableTypes,1);
TableTypes[0] := 'TABLE';
res := meta.GetTables('','','',TableTypes);
n := 0;
while res.Next do
{$IFDEF ZEOS72UP}
AddSortedRawUTF8(Tables,n,res.GetUTF8String(TableNameIndex));
{$else}
AddSortedRawUTF8(Tables,n,SynUnicodeToUtf8(res.GetUnicodeString(TableNameIndex)));
{$endif}
SetLength(Tables,n);
end else
inherited;
end;
procedure TSQLDBZEOSConnectionProperties.GetFields(
const aTableName: RawUTF8; out Fields: TSQLDBColumnDefineDynArray);
var meta: IZDatabaseMetadata;
res: IZResultSet;
n, i: integer;
Schema, TableName: RawUTF8;
sSchema, sTableName: string;
F: TSQLDBColumnDefine;
FA: TDynArray;
begin
if GetDatabaseMetadata(meta) then begin
SQLSplitTableName(aTableName, Schema,TableName);
sSchema := UTF8ToString(Schema);
{ mormot does not create the Tables casesensitive but gives mixed cased strings as tablename
so we normalize the identifiers to database defaults : }
sTableName := meta.GetIdentifierConvertor.ExtractQuote(UTF8ToString(TableName));
sTableName := meta.AddEscapeCharToWildcards(sTableName); //do not use "like" search patterns ['_','%'] so they need to be escaped
res := meta.GetColumns('',sSchema,sTableName,'');
FA.InitSpecific(TypeInfo(TSQLDBColumnDefineDynArray),Fields,djRawUTF8,@n,true);
FillChar(F,sizeof(F),0);
while res.Next do begin
{$IFDEF ZEOS72UP}
F.ColumnName := res.GetUTF8String(ColumnNameIndex);
F.ColumnTypeNative := res.GetUTF8String(TableColColumnTypeNameIndex);
{$else}
F.ColumnName := SynUnicodeToUtf8(res.GetUnicodeString(ColumnNameIndex));
F.ColumnTypeNative := SynUnicodeToUtf8(res.GetUnicodeString(TableColColumnTypeNameIndex));
{$endif}
F.ColumnType := TZSQLTypeToTSQLDBFieldType(TZSQLType(res.GetInt(TableColColumnTypeIndex)));
F.ColumnLength := res.GetInt(TableColColumnSizeIndex); // for char or date types this is the maximum number of characters
F.ColumnPrecision := res.GetInt(TableColColumnSizeIndex); // for numeric or decimal types this is precision
F.ColumnScale := res.GetInt(TableColColumnDecimalDigitsIndex); // the number of fractional digits
FA.Add(F);
end;
if n>0 then begin
res := meta.GetIndexInfo('',sSchema,sTableName,false,true);
while res.Next do begin
{$IFDEF ZEOS72UP}
F.ColumnName := res.GetUTF8String(IndexInfoColColumnNameIndex);
{$else}
F.ColumnName := SynUnicodeToUtf8(res.GetUnicodeString(IndexInfoColColumnNameIndex));
{$endif}
i := FA.Find(F);
if i>=0 then
Fields[i].ColumnIndexed := true;
end;
SetLength(Fields,n);
end;
end;
end;
function TSQLDBZEOSConnectionProperties.TZSQLTypeToTSQLDBFieldType(aNativeType: TZSQLType): TSQLDBFieldType;
begin
case aNativeType of
stBoolean, stByte, stShort, stInteger, stLong
{$ifdef ZEOS72UP}, stSmall, stWord, stLongWord, stULong{$endif}:
result := ftInt64;
stFloat, stDouble:
result := ftDouble;
stBigDecimal{$ifdef ZEOS72UP}, stCurrency{$endif}:
result := ftCurrency;
stDate, stTime, stTimestamp:
result := ftDate;
stString, stUnicodeString, {$ifdef ZEOS72UP}stGUID, {$endif} stAsciiStream, stUnicodeStream:
result := ftUTF8;
stBytes, stBinaryStream:
result := ftBlob;
else raise ESQLDBZEOS.CreateUTF8('%: unexpected TZSQLType "%"',
[self,GetEnumName(Typeinfo(TZSQLType),ord(aNativeType))^]);
end;
end;
class function TSQLDBZEOSConnectionProperties.URI(aServer: TSQLDBDefinition;
const aServerName: RawUTF8; const aLibraryLocation: TFileName;
aLibraryLocationAppendExePath: boolean): RawUTF8;
const
/// ZDBC provider names corresponding to SynDB recognized SQL engines
ZEOS_PROVIDER: array[TSQLDBDefinition] of RawUTF8 = (
'','','oracle:','mssql:','','mysql:','sqlite:',
'firebird:','','postgresql:','','');
begin
result := URI(ZEOS_PROVIDER[aServer],aServerName,
aLibraryLocation,aLibraryLocationAppendExePath);
end;
class function TSQLDBZEOSConnectionProperties.URI(const aProtocol,aServerName: RawUTF8;
const aLibraryLocation: TFileName; aLibraryLocationAppendExePath: boolean): RawUTF8;
begin // return e.g. mysql://192.168.2.60:3306/world?username=root;password=dev
result := trim(aProtocol);
if result='' then
exit;
if aServerName<>'' then
result := result+'//'+aServerName;
if aLibraryLocation<>'' then begin
if (aServerName <> '') and (aServerName[1] = '?') then
result := result+';LibLocation=' else
result := result+'?LibLocation=';
if aLibraryLocationAppendExePath then
result := result+StringToUTF8(ExeVersion.ProgramFilePath);
result := result+StringToUTF8(aLibraryLocation);
end;
end;
{ TSQLDBZEOSConnection }
constructor TSQLDBZEOSConnection.Create(aProperties: TSQLDBConnectionProperties);
var url: TZURL;
begin
inherited Create(aProperties);
url := (fProperties as TSQLDBZEOSConnectionProperties).fURL;
fDatabase := DriverManager.GetConnectionWithParams(url.URL,url.Properties);
// EG: setup the connection transaction behavior now, not once Opened in Connect
//fDatabase.SetReadOnly(false); // is default
// about transactions, see https://synopse.info/forum/viewtopic.php?id=2209
//fDatabase.SetAutoCommit(true); // is default
fDatabase.SetTransactionIsolation(tiReadCommitted); // will be swapped to tiSerialiable for SQLite
end;
procedure TSQLDBZEOSConnection.Connect;
var log: ISynLog;
begin
if fDatabase=nil then
raise ESQLDBZEOS.CreateUTF8('%.Connect() on % failed: Database=nil',
[self,fProperties.ServerName]);
log := SynDBLog.Enter(self, 'Connect');
if log<>nil then
with (fProperties as TSQLDBZEOSConnectionProperties).fURL do
log.Log(sllTrace,'Connect to % % for % at %:%',[Protocol,Database,HostName,Port]);
try
fDatabase.Open;
if log<>nil then
log.log(sllDB,'Connected to % using % %',[fProperties.ServerName,
fProperties.DatabaseNameSafe,fDatabase.GetClientVersion]);
inherited Connect; // notify any re-connection
except
on E: Exception do begin
Disconnect; // clean up on fail
raise;
end;
end;
end;
procedure TSQLDBZEOSConnection.Disconnect;
begin
try
inherited Disconnect; // flush any cached statement
finally
if (fDatabase<>nil) and not fDatabase.IsClosed then
fDatabase.Close;
end;
end;
function TSQLDBZEOSConnection.IsConnected: boolean;
begin
result := Assigned(fDatabase) and not fDatabase.IsClosed;
end;
function TSQLDBZEOSConnection.NewStatement: TSQLDBStatement;
begin
if not IsConnected then
Connect;
result := TSQLDBZEOSStatement.Create(self);
end;
procedure TSQLDBZEOSConnection.StartTransaction;
var log: ISynLog;
begin
log := SynDBLog.Enter(self,'StartTransaction');
inherited StartTransaction;
{$IFDEF ZEOS73UP}
fDatabase.StartTransaction; //returns the txn level
{$ELSE}
fDatabase.SetAutoCommit(false);
{$ENDIF}
end;
procedure TSQLDBZEOSConnection.Commit;
begin
inherited Commit;
try
fDatabase.Commit;
except
inc(fTransactionCount); // the transaction is still active
raise;
end;
{$IFNDEF ZEOS73UP} //no longer required zdbc falls back to AC automatically
fDatabase.SetAutoCommit(true);
{$ENDIF}
end;
procedure TSQLDBZEOSConnection.Rollback;
begin
inherited Rollback;
fDatabase.Rollback;
{$IFNDEF ZEOS73UP} //no longer required zdbc falls back to AC automatically
fDatabase.SetAutoCommit(true);
{$ENDIF}
end;
{ TSQLDBZEOSStatement }
procedure TSQLDBZEOSStatement.Prepare(const aSQL: RawUTF8; ExpectResults: boolean);
begin
SQLLogBegin(sllDB);
if (fStatement<>nil) or (fResultSet<>nil) then
raise ESQLDBZEOS.CreateUTF8('%.Prepare() shall be called once',[self]);
inherited Prepare(aSQL,ExpectResults); // connect if necessary
fStatement := (fConnection as TSQLDBZEOSConnection).fDatabase.
PrepareStatementWithParams({$ifdef UNICODE}UTF8ToString(fSQL){$else}fSQL{$endif}, // see controls_cp=CP_UTF8
(fConnection.Properties as TSQLDBZEOSConnectionProperties).fStatementParams);
SQLLogEnd;
end;
{$ifdef ZEOS72UP}
type // see https://synopse.info/forum/viewtopic.php?pid=11946#p11946
TZeosArrayBinding = class
protected
// ZDBC uses pointer references to arrays -> allocated with the class
fNullArray: array of TBooleanDynArray;
fInt64Array: array of TInt64DynArray;
fDoubleArray: array of TDoubleDynArray;
fCurDynArray: array of TCurrencyDynArray;
fDateDynArray: array of TDateTimeDynArray;
fUTF8DynArray: array of TRawUTF8DynArray;
fBlobDynArray: array of TInterfaceDynArray;
fDynArraySize: array[ftInt64..ftBlob] of Integer;
public
constructor Create(aStatement: TSQLDBZEOSStatement);
end;
constructor TZeosArrayBinding.Create(aStatement: TSQLDBZEOSStatement);
var p,j,n: integer;
ndx: array[ftInt64..ftBlob] of integer;
kind: TSQLDBFieldType;
begin
with aStatement do begin
SetLength(fNullArray,fParamCount);
for p := 0 to fParamCount-1 do
if fParams[p].VType in [ftInt64..ftBlob] then
inc(fDynArraySize[fParams[p].VType]);
SetLength(fInt64Array,fDynArraySize[ftInt64]);
SetLength(fDoubleArray,fDynArraySize[ftDouble]);
SetLength(fCurDynArray,fDynArraySize[ftCurrency]);
SetLength(fDateDynArray,fDynArraySize[ftDate]);
SetLength(fUTF8DynArray,fDynArraySize[ftUTF8]);
SetLength(fBlobDynArray,fDynArraySize[ftBlob]);
fillchar(ndx,sizeof(ndx),0);
for p := 0 to fParamCount-1 do begin
if fParams[p].VInt64<>fParamsArrayCount then
raise ESQLDBZEOS.CreateUTF8(
'%.ExecutePrepared: #% parameter expected array count %, got %',
[aStatement,p,fParamsArrayCount,fParams[p].VInt64]);
SetLength(fNullArray[p],fParamsArrayCount);
with fParams[p] do begin
case VType of
ftUnknown:
raise ESQLDBZEOS.CreateUTF8(
'%.ExecutePrepared: Unknown type array parameter #%',[aStatement,p+FirstDbcIndex]);
ftNull: begin
// handle null column
for j := 0 to fParamsArrayCount -1 do
fNullArray[p][j] := True;
fStatement.SetDataArray(p+FirstDbcIndex,'',stString,vtUTF8String);
end;
else begin
// array binding of ftInt64..ftBlob values from fParams[p].VArray[]
for j := 0 to fParamsArrayCount -1 do
fNullArray[p][j] := VArray[j]='null';
n := ndx[VType];
case VType of
ftInt64: begin
SetLength(fInt64Array[n],fParamsArrayCount);
for j := 0 to fParamsArrayCount -1 do
if not fNullArray[p][j] then
SetInt64(pointer(VArray[j]),fInt64Array[n][j]);
fStatement.SetDataArray(p+FirstDbcIndex,fInt64Array[n],stLong);
end;
ftDouble: begin
SetLength(fDoubleArray[n],fParamsArrayCount);
for j := 0 to fParamsArrayCount -1 do
if not fNullArray[p][j] then
fDoubleArray[n][j] := GetExtended(pointer(VArray[j]));
fStatement.SetDataArray(p+FirstDbcIndex,fDoubleArray[n],stDouble);