zeoslib  UNKNOWN
 All Files
ZDbcDbLib.pas
Go to the documentation of this file.
1 {*********************************************************}
2 { }
3 { Zeos Database Objects }
4 { DBLib Connectivity Classes }
5 { }
6 { Originally written by Janos Fegyverneki }
7 { }
8 {*********************************************************}
9 
10 {@********************************************************}
11 { Copyright (c) 1999-2012 Zeos Development Group }
12 { }
13 { License Agreement: }
14 { }
15 { This library is distributed in the hope that it will be }
16 { useful, but WITHOUT ANY WARRANTY; without even the }
17 { implied warranty of MERCHANTABILITY or FITNESS FOR }
18 { A PARTICULAR PURPOSE. See the GNU Lesser General }
19 { Public License for more details. }
20 { }
21 { The source code of the ZEOS Libraries and packages are }
22 { distributed under the Library GNU General Public }
23 { License (see the file COPYING / COPYING.ZEOS) }
24 { with the following modification: }
25 { As a special exception, the copyright holders of this }
26 { library give you permission to link this library with }
27 { independent modules to produce an executable, }
28 { regardless of the license terms of these independent }
29 { modules, and to copy and distribute the resulting }
30 { executable under terms of your choice, provided that }
31 { you also meet, for each linked independent module, }
32 { the terms and conditions of the license of that module. }
33 { An independent module is a module which is not derived }
34 { from or based on this library. If you modify this }
35 { library, you may extend this exception to your version }
36 { of the library, but you are not obligated to do so. }
37 { If you do not wish to do so, delete this exception }
38 { statement from your version. }
39 { }
40 { }
41 { The project web site is located on: }
42 { http://zeos.firmos.at (FORUM) }
43 { http://sourceforge.net/p/zeoslib/tickets/ (BUGTRACKER)}
44 { svn://svn.code.sf.net/p/zeoslib/code-0/trunk (SVN) }
45 { }
46 { http://www.sourceforge.net/projects/zeoslib. }
47 { }
48 { }
49 { Zeos Development Group. }
50 {********************************************************@}
51 
52 unit ZDbcDbLib;
53 
54 interface
55 
56 {$I ZDbc.inc}
57 
58 uses
59 {$IFDEF FPC}
60  {$IFDEF WIN32}
61  Comobj,
62  {$ENDIF}
63 {$ENDIF}
64  Types, Classes, {$IFDEF MSEgui}mclasses,{$ENDIF}
65  ZDbcConnection, ZDbcIntfs, ZCompatibility, ZDbcLogging, ZPlainDbLibDriver,
66  ZPlainDbLibConstants, ZTokenizer, ZGenericSqlAnalyser, ZURL, ZPlainDriver;
67 
68 type
69  TDBLibProvider = (dpMsSQL, dpSybase);
70 
71  {** Implements DBLib Database Driver. }
72  {$WARNINGS OFF}
73  TZDBLibDriver = class(TZAbstractDriver)
74  public
75  constructor Create; override;
76  function Connect(const Url: TZURL): IZConnection; override;
77  function GetMajorVersion: Integer; override;
78  function GetMinorVersion: Integer; override;
79 
80  function GetTokenizer: IZTokenizer; override;
81  function GetStatementAnalyser: IZStatementAnalyser; override;
82  end;
83  {$WARNINGS ON}
84 
85  {** Represents a DBLib specific connection interface. }
86  IZDBLibConnection = interface (IZConnection)
87  ['{6B0662A2-FF2A-4415-B6B0-AAC047EA0671}']
88 
89  function FreeTDS: Boolean;
90  function GetProvider: TDBLibProvider;
91  function GetPlainDriver: IZDBLibPlainDriver;
92  function GetConnectionHandle: PDBPROCESS;
93  procedure InternalExecuteStatement(const SQL: string);
94  procedure CheckDBLibError(LogCategory: TZLoggingCategory; const LogMessage: string);
95  end;
96 
97  {** Implements a generic DBLib Connection. }
98  TZDBLibConnection = class(TZAbstractConnection, IZDBLibConnection)
99  private
100  FProvider: TDBLibProvider;
101  FFreeTDS: Boolean;
102  function FreeTDS: Boolean;
103  function GetProvider: TDBLibProvider;
104  procedure ReStartTransactionSupport;
105  procedure InternalSetTransactionIsolation(Level: TZTransactIsolationLevel);
106  procedure DetermineMSDateFormat;
107  function DetermineMSServerCollation: String;
108  function DetermineMSServerCodePage(const Collation: String): Word;
109  protected
110  FHandle: PDBPROCESS;
111  procedure InternalCreate; override;
112  procedure InternalExecuteStatement(const SQL: string); virtual;
113  procedure InternalLogin; virtual;
114  function GetPlainDriver: IZDBLibPlainDriver;
115  function GetConnectionHandle: PDBPROCESS;
116  procedure CheckDBLibError(LogCategory: TZLoggingCategory; const LogMessage: string); virtual;
117  procedure StartTransaction; virtual;
118  public
119  function CreateRegularStatement(Info: TStrings): IZStatement; override;
120  function CreatePreparedStatement(const SQL: string; Info: TStrings):
121  IZPreparedStatement; override;
122  function CreateCallableStatement(const SQL: string; Info: TStrings):
123  IZCallableStatement; override;
124 
125  procedure SetAutoCommit(Value: Boolean); override;
126  procedure SetTransactionIsolation(Level: TZTransactIsolationLevel); override;
127 
128  procedure Commit; override;
129  procedure Rollback; override;
130 
131  procedure Open; override;
132  procedure Close; override;
133 
134  procedure SetReadOnly(ReadOnly: Boolean); override;
135 
136  procedure SetCatalog(const Catalog: string); override;
137  function GetCatalog: string; override;
138 
139  function GetWarnings: EZSQLWarning; override;
140  procedure ClearWarnings; override;
141  function GetBinaryEscapeString(const Value: TByteDynArray): String; overload; override;
142  function GetBinaryEscapeString(const Value: RawByteString): String; overload; override;
143  end;
144 
145 var
146  {** The common driver manager object. }
147  DBLibDriver: IZDriver;
148 
149 implementation
150 
151 uses
152  {$IFDEF WITH_UNITANSISTRINGS}AnsiStrings,{$ENDIF}
153  SysUtils, ZSysUtils, ZMessages, ZDbcUtils, ZDbcDbLibStatement, ZEncoding,
154  ZDbcDbLibMetadata, ZSybaseToken, ZSybaseAnalyser{$IFDEF FPC}, ZClasses{$ENDIF};
155 
156 { TZDBLibDriver }
157 
158 {**
159  Constructs this object with default properties.
160 }
161 constructor TZDBLibDriver.Create;
162 begin
163  inherited Create;
164  AddSupportedProtocol(AddPlainDriverToCache(TZDBLibMSSQL7PlainDriver.Create));
165  AddSupportedProtocol(AddPlainDriverToCache(TZDBLibSybaseASE125PlainDriver.Create));
166  AddSupportedProtocol(AddPlainDriverToCache(TZFreeTDS42MsSQLPlainDriver.Create));
167  AddSupportedProtocol(AddPlainDriverToCache(TZFreeTDS42SybasePlainDriver.Create));
168  AddSupportedProtocol(AddPlainDriverToCache(TZFreeTDS50PlainDriver.Create));
169  AddSupportedProtocol(AddPlainDriverToCache(TZFreeTDS70PlainDriver.Create));
170  AddSupportedProtocol(AddPlainDriverToCache(TZFreeTDS71PlainDriver.Create));
171  AddSupportedProtocol(AddPlainDriverToCache(TZFreeTDS72PlainDriver.Create));
172 end;
173 
174 {**
175  Attempts to make a database connection to the given URL.
176 }
177 {$WARNINGS OFF}
178 function TZDBLibDriver.Connect(const Url: TZURL): IZConnection;
179 begin
180  Result := TZDBLibConnection.Create(Url);
181 end;
182 {$WARNINGS ON}
183 
184 {**
185  Gets the driver's major version number. Initially this should be 1.
186  @return this driver's major version number
187 }
188 function TZDBLibDriver.GetMajorVersion: Integer;
189 begin
190  Result := 1;
191 end;
192 
193 {**
194  Gets the driver's minor version number. Initially this should be 0.
195  @return this driver's minor version number
196 }
197 function TZDBLibDriver.GetMinorVersion: Integer;
198 begin
199  Result := 0;
200 end;
201 
202 {**
203  Gets a SQL syntax tokenizer.
204  @returns a SQL syntax tokenizer object.
205 }
206 function TZDBLibDriver.GetTokenizer: IZTokenizer;
207 begin
208  Result := TZSybaseTokenizer.Create; { thread save! Allways return a new Tokenizer! }
209 end;
210 
211 {**
212  Creates a statement analyser object.
213  @returns a statement analyser object.
214 }
215 function TZDBLibDriver.GetStatementAnalyser: IZStatementAnalyser;
216 begin
217  Result := TZSybaseStatementAnalyser.Create; { thread save! Allways return a new Analyser! }
218 end;
219 
220 { TZDBLibConnection }
221 
222 {**
223  Constructs this object and assignes the main properties.
224 }
225 procedure TZDBLibConnection.InternalCreate;
226 begin
227  FDisposeCodePage := False;
228  if Pos('mssql', LowerCase(Url.Protocol)) > 0 then
229  begin
230  FMetadata := TZMsSqlDatabaseMetadata.Create(Self, Url);
231  FProvider := dpMsSQL;
232  end
233  else
234  if Pos('sybase', LowerCase(Url.Protocol)) > 0 then
235  begin
236  FMetadata := TZSybaseDatabaseMetadata.Create(Self, Url);
237  FProvider := dpSybase;
238  end
239  else
240  FMetadata := nil;
241  FFreeTDS := Pos('FreeTDS', Url.Protocol) > 0;
242 
243  FHandle := nil;
244 end;
245 
246 {**
247  Destroys this object and cleanups the memory.
248 }
249 function TZDBLibConnection.FreeTDS: Boolean;
250 begin
251  Result := FFreeTDS;
252 end;
253 
254 function TZDBLibConnection.GetProvider: TDBLibProvider;
255 begin
256  Result := FProvider;
257 end;
258 
259 {**
260  Executes simple statements internally.
261 }
262 procedure TZDBLibConnection.InternalExecuteStatement(const SQL: string);
263 var
264  LSQL: string;
265  ASQL: RawByteString;
266 begin
267  FHandle := GetConnectionHandle;
268  if GetPlainDriver.dbCancel(FHandle) <> DBSUCCEED then
269  CheckDBLibError(lcExecute, SQL);
270  if FProvider = dpMsSQL then
271  LSQL := StringReplace(Sql, '\'#13, '\\'#13, [rfReplaceAll])
272  else
273  LSQL := SQL;
274 
275  ASQL := AnsiString(LSQL);
276  if GetPlainDriver.dbcmd(FHandle, PAnsiChar(ASQL)) <> DBSUCCEED then
277  CheckDBLibError(lcExecute, LSQL);
278  if GetPlainDriver.dbsqlexec(FHandle) <> DBSUCCEED then
279  CheckDBLibError(lcExecute, LSQL);
280  repeat
281  GetPlainDriver.dbresults(FHandle);
282  GetPlainDriver.dbcanquery(FHandle);
283  until GetPlainDriver.dbmorecmds(FHandle) = DBFAIL;
284  CheckDBLibError(lcExecute, LSQL);
285  DriverManager.LogMessage(lcExecute, PlainDriver.GetProtocol, LSQL);
286 end;
287 
288 {**
289  Login procedure can be overriden for special settings.
290 }
291 procedure TZDBLibConnection.InternalLogin;
292 var
293  Loginrec: PLOGINREC;
294  LogMessage: string;
295  S: string;
296  lLogFile : String;
297 begin
298  LogMessage := Format('CONNECT TO "%s"', [HostName]);
299  LoginRec := GetPLainDriver.dbLogin;
300  try
301 //Common parameters
302  S := Info.Values['workstation'];
303  if S <> '' then
304  GetPlainDriver.dbSetLHost(LoginRec, PAnsiChar(AnsiString(S)));
305 
306  S := Info.Values['appname'];
307  if S <> '' then
308  GetPlainDriver.dbSetLApp(LoginRec, PAnsiChar(AnsiString(S)));
309 
310  S := Info.Values['language'];
311  if S <> '' then
312  GetPlainDriver.dbSetLNatLang(LoginRec, PAnsiChar(AnsiString(S)));
313 
314  S := Info.Values['timeout'];
315  if S <> '' then
316  GetPlainDriver.dbSetLoginTime(StrToIntDef(S, 60));
317 
318  if FFreeTDS then
319  begin
320  if StrToBoolEx(Info.Values['log']) or StrToBoolEx(Info.Values['logging']) or
321  StrToBoolEx(Info.Values['tds_dump']) then begin
322  lLogFile := Info.Values['logfile'];
323  if lLogFile = '' then
324  lLogFile := Info.Values['log_file'];
325  if lLogFile = '' then
326  lLogFile := Info.Values['tds_dump_file'];
327  if lLogFile = '' then
328  lLogFile := ChangeFileExt(ParamStr(0), '.tdslog');
329  (GetPlainDriver as IZFreeTDSPlainDriver).tdsDump_Open(lLogFile);
330  end;
331  end;
332 
333 
334  //mssql specific parameters
335  if ( FProvider = dpMsSQL ) then
336  begin
337  if ( StrToBoolEx(Info.Values['NTAuth']) or StrToBoolEx(Info.Values['trusted'])
338  or StrToBoolEx(Info.Values['secure']) ) and ( not FFreeTDS ) then
339  begin
340  GetPlainDriver.dbsetlsecure(LoginRec);
341  LogMessage := LogMessage + ' USING WINDOWS AUTHENTICATION';
342  end
343  else
344  begin
345  GetPlainDriver.dbsetluser(LoginRec, PAnsiChar(AnsiString(User)));
346  GetPlainDriver.dbsetlpwd(LoginRec, PAnsiChar(AnsiString(Password)));
347  LogMessage := LogMessage + Format(' AS USER "%s"', [User]);
348  end;
349  end;
350 
351  //sybase specific parameters
352  if FProvider = dpSybase then
353  begin
354  S := Info.Values['codepage'];
355  if S <> '' then
356  GetPlainDriver.dbSetLCharSet(LoginRec, PAnsiChar(ZPlainString(S)));
357  GetPlainDriver.dbsetluser(LoginRec, PAnsiChar(ZPlainString(User)));
358  GetPlainDriver.dbsetlpwd(LoginRec, PAnsiChar(ZPlainString(Password)));
359  LogMessage := LogMessage + Format(' AS USER "%s"', [User]);
360  end;
361 
362  CheckDBLibError(lcConnect, LogMessage);
363  FHandle := GetPlainDriver.dbOpen(LoginRec, PAnsiChar(AnsiString(HostName)));
364  CheckDBLibError(lcConnect, LogMessage);
365  DriverManager.LogMessage(lcConnect, PlainDriver.GetProtocol, LogMessage);
366  finally
367  GetPLainDriver.dbLoginFree(LoginRec);
368  end;
369 end;
370 
371 function TZDBLibConnection.GetPlainDriver: IZDBLibPlainDriver;
372 begin
373  Result := PlainDriver as IZDBLibPlainDriver;
374 end;
375 
376 function TZDBLibConnection.GetConnectionHandle: PDBPROCESS;
377 begin
378  if FProvider = dpMsSQL then
379  if GetPlainDriver.dbDead(FHandle) then
380  begin
381  Closed := True;
382  Open;
383  end;
384  Result := FHandle;
385 end;
386 
387 procedure TZDBLibConnection.CheckDBLibError(LogCategory: TZLoggingCategory; const LogMessage: string);
388 begin
389  try
390  GetPlainDriver.CheckError(FHandle);
391  except
392  on E: Exception do
393  begin
394  DriverManager.LogError(LogCategory, PlainDriver.GetProtocol, LogMessage, 0, E.Message);
395  raise;
396  end;
397  end;
398 end;
399 
400 {**
401  Starts a transaction support.
402 }
403 procedure TZDBLibConnection.ReStartTransactionSupport;
404 begin
405  if Closed then
406  Exit;
407 
408  if not (AutoCommit or (GetTransactionIsolation = tiNone)) then
409  StartTransaction;
410 end;
411 
412 {**
413  Opens a connection to database server with specified parameters.
414 }
415 procedure TZDBLibConnection.Open;
416 var
417  LogMessage: string;
418 begin
419  if not Closed then
420  Exit;
421 
422  InternalLogin;
423 
424  LogMessage := Format('USE %s', [Database]);
425  if FProvider = dpMsSQL then
426  begin
427  if GetPlainDriver.dbUse(FHandle, PAnsiChar(AnsiString(Database))) <> DBSUCCEED then
428  CheckDBLibError(lcConnect, LogMessage);
429  end
430  else
431  if GetPlainDriver.dbUse(FHandle, PAnsiChar(ZPlainString(Database))) <> DBSUCCEED then
432  CheckDBLibError(lcConnect, LogMessage);
433  DriverManager.LogMessage(lcConnect, PlainDriver.GetProtocol, LogMessage);
434 
435  LogMessage := 'set textlimit=2147483647';
436  if GetPlainDriver.dbsetopt(FHandle, GetPlainDriver.GetVariables.dboptions[Z_TEXTLIMIT] , '2147483647') <> DBSUCCEED then
437  CheckDBLibError(lcConnect, LogMessage);
438  DriverManager.LogMessage(lcConnect, PlainDriver.GetProtocol, LogMessage);
439 
440  InternalExecuteStatement('set textsize 2147483647 set quoted_identifier on');
441 
442  inherited Open;
443 
444  if FProvider = dpMsSQL then
445  begin
446  if FClientCodePage = '' then
447  begin
448  FDisposeCodePage := True;
449  ConSettings^.ClientCodePage := New(PZCodePage);
450  ConSettings^.ClientCodePage^.CP := ZDefaultSystemCodePage; //need a tempory CP for the SQL preparation
451  ConSettings^.ClientCodePage^.Encoding := ceAnsi;
452  ConSettings^.ClientCodePage^.Name := DetermineMSServerCollation;
453  ConSettings^.ClientCodePage^.IsStringFieldCPConsistent := True;
454  ConSettings^.ClientCodePage^.CP := DetermineMSServerCodePage(ConSettings^.ClientCodePage^.Name);
455  ConSettings^.AutoEncode := True; //Must be set because we can't determine a column-codepage! e.g NCHAR vs. CHAR Fields
456  SetConvertFunctions(ConSettings);
457  end;
458  DetermineMSDateFormat;
459  end
460  else
461  ConSettings.DateFormat := 'yyyy/mm/dd';
462 
463  InternalSetTransactionIsolation(GetTransactionIsolation);
464  ReStartTransactionSupport;
465 end;
466 
467 {**
468  Creates a <code>Statement</code> object for sending
469  SQL statements to the database.
470  SQL statements without parameters are normally
471  executed using Statement objects. If the same SQL statement
472  is executed many times, it is more efficient to use a
473  <code>PreparedStatement</code> object.
474  <P>
475  Result sets created using the returned <code>Statement</code>
476  object will by default have forward-only type and read-only concurrency.
477 
478  @return a new Statement object
479 }
480 function TZDBLibConnection.CreateRegularStatement(Info: TStrings):
481  IZStatement;
482 begin
483  if IsClosed then
484  Open;
485  Result := TZDBLibStatement.Create(Self, Info);
486 end;
487 
488 {**
489  Creates a <code>PreparedStatement</code> object for sending
490  parameterized SQL statements to the database.
491 
492  A SQL statement with or without IN parameters can be
493  pre-compiled and stored in a PreparedStatement object. This
494  object can then be used to efficiently execute this statement
495  multiple times.
496 
497  <P><B>Note:</B> This method is optimized for handling
498  parametric SQL statements that benefit from precompilation. If
499  the driver supports precompilation,
500  the method <code>prepareStatement</code> will send
501  the statement to the database for precompilation. Some drivers
502  may not support precompilation. In this case, the statement may
503  not be sent to the database until the <code>PreparedStatement</code> is
504  executed. This has no direct effect on users; however, it does
505  affect which method throws certain SQLExceptions.
506 
507  Result sets created using the returned PreparedStatement will have
508  forward-only type and read-only concurrency, by default.
509 
510  @param sql a SQL statement that may contain one or more '?' IN
511  parameter placeholders
512  @param Info a statement parameters.
513  @return a new PreparedStatement object containing the
514  pre-compiled statement
515 }
516 function TZDBLibConnection.CreatePreparedStatement(
517  const SQL: string; Info: TStrings): IZPreparedStatement;
518 begin
519  if IsClosed then
520  Open;
521  Result := TZDBLibPreparedStatementEmulated.Create(Self, SQL, Info);
522 end;
523 
524 {**
525  Creates a <code>CallableStatement</code> object for calling
526  database stored procedures.
527  The <code>CallableStatement</code> object provides
528  methods for setting up its IN and OUT parameters, and
529  methods for executing the call to a stored procedure.
530 
531  <P><B>Note:</B> This method is optimized for handling stored
532  procedure call statements. Some drivers may send the call
533  statement to the database when the method <code>prepareCall</code>
534  is done; others
535  may wait until the <code>CallableStatement</code> object
536  is executed. This has no
537  direct effect on users; however, it does affect which method
538  throws certain SQLExceptions.
539 
540  Result sets created using the returned CallableStatement will have
541  forward-only type and read-only concurrency, by default.
542 
543  @param sql a SQL statement that may contain one or more '?'
544  parameter placeholders. Typically this statement is a JDBC
545  function call escape string.
546  @param Info a statement parameters.
547  @return a new CallableStatement object containing the
548  pre-compiled SQL statement
549 }
550 function TZDBLibConnection.CreateCallableStatement(
551  const SQL: string; Info: TStrings): IZCallableStatement;
552 begin
553  if IsClosed then
554  Open;
555  Result := TZDBLibCallableStatement.Create(Self, SQL, Info);
556 end;
557 
558 {**
559  Sets this connection's auto-commit mode.
560  If a connection is in auto-commit mode, then all its SQL
561  statements will be executed and committed as individual
562  transactions. Otherwise, its SQL statements are grouped into
563  transactions that are terminated by a call to either
564  the method <code>commit</code> or the method <code>rollback</code>.
565  By default, new connections are in auto-commit mode.
566 
567  The commit occurs when the statement completes or the next
568  execute occurs, whichever comes first. In the case of
569  statements returning a ResultSet, the statement completes when
570  the last row of the ResultSet has been retrieved or the
571  ResultSet has been closed. In advanced cases, a single
572  statement may return multiple results as well as output
573  parameter values. In these cases the commit occurs when all results and
574  output parameter values have been retrieved.
575 
576  @param autoCommit true enables auto-commit; false disables auto-commit.
577 }
578 procedure TZDBLibConnection.SetAutoCommit(Value: Boolean);
579 begin
580  if AutoCommit = Value then Exit;
581  if not Closed and Value then InternalExecuteStatement('commit');
582  inherited;
583  ReStartTransactionSupport;
584 end;
585 
586 procedure TZDBLibConnection.InternalSetTransactionIsolation(Level: TZTransactIsolationLevel);
587 const
588  IL: array[TZTransactIsolationLevel, 0..1] of string = (('READ COMMITTED', '1'), ('READ UNCOMMITTED', '0'), ('READ COMMITTED', '1'), ('REPEATABLE READ', '2'), ('SERIALIZABLE', '3'));
589 var
590  Index: Integer;
591  S: string;
592 begin
593  Index := -1;
594  if FProvider = dpMsSQL then Index := 0;
595  if FProvider = dpSybase then Index := 1;
596 
597  S := 'SET TRANSACTION ISOLATION LEVEL ' + IL[GetTransactionIsolation, Index];
598  InternalExecuteStatement(S);
599  if not (AutoCommit) then
600  InternalExecuteStatement('BEGIN TRANSACTION');
601 end;
602 
603 procedure TZDBLibConnection.DetermineMSDateFormat;
604 var
605  Tmp: AnsiString;
606 begin
607  Tmp := 'SELECT dateformat FROM master.dbo.syslanguages WHERE name = @@LANGUAGE';
608  if (GetPlainDriver.dbcmd(FHandle, Pointer(Tmp)) <> DBSUCCEED) or
609  (GetPlainDriver.dbsqlexec(FHandle) <> DBSUCCEED) or
610  (GetPlainDriver.dbresults(FHandle) <> DBSUCCEED) or
611  (GetPlainDriver.dbcmdrow(FHandle) <> DBSUCCEED) or
612  (GetPlainDriver.dbnextrow(FHandle) <> REG_ROW) then
613  CheckDBLibError(lcOther, String(Tmp))
614  else
615  SetString(Tmp, PAnsiChar(GetPlainDriver.dbdata(FHandle, 1)),
616  GetPlainDriver.dbDatLen(FHandle, 1));
617  GetPlainDriver.dbCancel(FHandle);
618  ConSettings.DateFormat := String(Tmp);
619  if ConSettings.DateFormat = 'dmy' then
620  ConSettings.DateFormat := 'dd/mm/yyyy'
621  else if ConSettings.DateFormat = 'mdy' then
622  ConSettings.DateFormat := 'mm/dd/yyyy'
623  else
624  ConSettings.DateFormat := 'yyyy/mm/dd'
625 end;
626 
627 function TZDBLibConnection.DetermineMSServerCollation: String;
628 var
629  Tmp: AnsiString;
630 begin
631  Tmp := 'SELECT DATABASEPROPERTYEX('+
632  {$IFDEF WITH_UNITANSISTRINGS}AnsiStrings.{$ENDIF}AnsiQuotedStr(AnsiString(DataBase), #39)+
633  ', ''Collation'') as DatabaseCollation';
634  if (GetPlainDriver.dbcmd(FHandle, Pointer(Tmp)) <> DBSUCCEED) or
635  (GetPlainDriver.dbsqlexec(FHandle) <> DBSUCCEED) or
636  (GetPlainDriver.dbresults(FHandle) <> DBSUCCEED) or
637  (GetPlainDriver.dbcmdrow(FHandle) <> DBSUCCEED) or
638  (GetPlainDriver.dbnextrow(FHandle) <> REG_ROW) then
639  CheckDBLibError(lcOther, String(Tmp))
640  else
641  ZSetString(PAnsiChar(GetPlainDriver.dbdata(FHandle, 1)), GetPlainDriver.dbDatLen(FHandle, 1), Tmp);
642  GetPlainDriver.dbCancel(FHandle);
643  Result := String(Tmp);
644 end;
645 
646 function TZDBLibConnection.DetermineMSServerCodePage(const Collation: String): Word;
647 var
648  Tmp: AnsiString;
649 begin
650  Result := High(Word);
651  Tmp := 'SELECT COLLATIONPROPERTY('+
652  {$IFDEF WITH_UNITANSISTRINGS}AnsiStrings.{$ENDIF}AnsiQuotedStr(
653  AnsiString(Collation), #39)+
654  ', ''Codepage'') as Codepage';
655  if (GetPlainDriver.dbcmd(FHandle, Pointer(Tmp)) <> DBSUCCEED) or
656  (GetPlainDriver.dbsqlexec(FHandle) <> DBSUCCEED) or
657  (GetPlainDriver.dbresults(FHandle) <> DBSUCCEED) or
658  (GetPlainDriver.dbcmdrow(FHandle) <> DBSUCCEED) or
659  (GetPlainDriver.dbnextrow(FHandle) <> REG_ROW) then
660  CheckDBLibError(lcOther, String(Tmp))
661  else
662  begin
663  ZSetString(PAnsiChar(GetPlainDriver.dbdata(FHandle, 1)), GetPlainDriver.dbDatLen(FHandle, 1), Tmp);
664  Result := StrToInt(String(Tmp));
665  end;
666  GetPlainDriver.dbCancel(FHandle);
667 end;
668 
669 {**
670  Attempts to change the transaction isolation level to the one given.
671  The constants defined in the interface <code>Connection</code>
672  are the possible transaction isolation levels.
673 
674  <P><B>Note:</B> This method cannot be called while
675  in the middle of a transaction.
676 
677  @param level one of the TRANSACTION_* isolation values with the
678  exception of TRANSACTION_NONE; some databases may not support other values
679  @see DatabaseMetaData#supportsTransactionIsolationLevel
680 }
681 procedure TZDBLibConnection.SetTransactionIsolation(
682  Level: TZTransactIsolationLevel);
683 begin
684  if GetTransactionIsolation = Level then
685  Exit;
686 
687  if not Closed and not AutoCommit and (GetTransactionIsolation <> tiNone) then
688  InternalExecuteStatement('commit');
689 
690  inherited;
691 
692  if not Closed then
693  InternalSetTransactionIsolation(Level);
694 
695  RestartTransactionSupport;
696 end;
697 
698 {**
699  Starts a new transaction. Used internally.
700 }
701 procedure TZDBLibConnection.StartTransaction;
702 begin
703  InternalExecuteStatement('begin transaction');
704 end;
705 
706 {**
707  Makes all changes made since the previous
708  commit/rollback permanent and releases any database locks
709  currently held by the Connection. This method should be
710  used only when auto-commit mode has been disabled.
711  @see #setAutoCommit
712 }
713 procedure TZDBLibConnection.Commit;
714 begin
715  if AutoCommit then
716  raise Exception.Create(SCannotUseCommit);
717  InternalExecuteStatement('commit');
718  StartTransaction;
719 end;
720 
721 {**
722  Drops all changes made since the previous
723  commit/rollback and releases any database locks currently held
724  by this Connection. This method should be used only when auto-
725  commit has been disabled.
726  @see #setAutoCommit
727 }
728 procedure TZDBLibConnection.Rollback;
729 begin
730  if AutoCommit then
731  raise Exception.Create(SCannotUseRollBack);
732  InternalExecuteStatement('rollback');
733  StartTransaction;
734 end;
735 
736 {**
737  Releases a Connection's database and JDBC resources
738  immediately instead of waiting for
739  them to be automatically released.
740 
741  <P><B>Note:</B> A Connection is automatically closed when it is
742  garbage collected. Certain fatal errors also result in a closed
743  Connection.
744 }
745 procedure TZDBLibConnection.Close;
746 var
747  LogMessage: string;
748 begin
749  if Closed then
750  Exit;
751  if Assigned(PlainDriver) then
752  begin
753  if not GetPlainDriver.dbDead(FHandle) then
754  InternalExecuteStatement('if @@trancount > 0 rollback');
755 
756  LogMessage := Format('CLOSE CONNECTION TO "%s" DATABASE "%s"', [HostName, Database]);
757 
758  if GetPlainDriver.dbclose(FHandle) <> DBSUCCEED then
759  CheckDBLibError(lcDisConnect, LogMessage);
760  DriverManager.LogMessage(lcDisconnect, PlainDriver.GetProtocol, LogMessage);
761  end;
762  FHandle := nil;
763  inherited;
764 end;
765 
766 {**
767  Puts this connection in read-only mode as a hint to enable
768  database optimizations.
769 
770  <P><B>Note:</B> This method cannot be called while in the
771  middle of a transaction.
772 
773  @param readOnly true enables read-only mode; false disables
774  read-only mode.
775 }
776 procedure TZDBLibConnection.SetReadOnly(ReadOnly: Boolean);
777 begin
778 { TODO -ofjanos -cAPI : I think it is not supported in this way }
779  inherited;
780 end;
781 
782 {**
783  Sets a catalog name in order to select
784  a subspace of this Connection's database in which to work.
785  If the driver does not support catalogs, it will
786  silently ignore this request.
787 }
788 procedure TZDBLibConnection.SetCatalog(const Catalog: string);
789 var
790  LogMessage: string;
791 begin
792  if (Catalog <> '') and not Closed then
793  begin
794  LogMessage := Format('SET CATALOG %s', [Catalog]);
795  if FProvider = dpMsSQL then
796  begin
797  if GetPLainDriver.dbUse(FHandle, PAnsiChar(AnsiString(Catalog))) <> DBSUCCEED then
798  CheckDBLibError(lcOther, LogMessage);
799  end
800  else
801  if GetPLainDriver.dbUse(FHandle, PAnsiChar(ZPlainString(Catalog))) <> DBSUCCEED then
802  CheckDBLibError(lcOther, LogMessage);
803  DriverManager.LogMessage(lcOther, PLainDriver.GetProtocol, LogMessage);
804  end;
805 end;
806 
807 {**
808  Returns the Connection's current catalog name.
809  @return the current catalog name or null
810 }
811 function TZDBLibConnection.GetCatalog: string;
812 begin
813  Result := String(GetPlainDriver.dbName(FHandle));
814  CheckDBLibError(lcOther, 'GETCATALOG');
815 end;
816 
817 {**
818  Returns the first warning reported by calls on this Connection.
819  <P><B>Note:</B> Subsequent warnings will be chained to this
820  SQLWarning.
821  @return the first SQLWarning or null
822 }
823 function TZDBLibConnection.GetWarnings: EZSQLWarning;
824 begin
825  Result := nil;
826 end;
827 
828 {**
829  Clears all warnings reported for this <code>Connection</code> object.
830  After a call to this method, the method <code>getWarnings</code>
831  returns null until a new warning is reported for this Connection.
832 }
833 procedure TZDBLibConnection.ClearWarnings;
834 var
835  LogMessage: string;
836 begin
837  if Closed then
838  Exit;
839 
840  if not GetPlainDriver.dbDead(FHandle) then
841  InternalExecuteStatement('if @@trancount > 0 rollback');
842 
843  LogMessage := Format('CLOSE CONNECTION TO "%s" DATABASE "%s"', [HostName, Database]);
844  if GetPlainDriver.dbclose(FHandle) <> DBSUCCEED then
845  CheckDBLibError(lcDisConnect, LogMessage);
846  DriverManager.LogMessage(lcDisconnect, GetPlainDriver.GetProtocol, LogMessage);
847 
848  FHandle := nil;
849  inherited;
850 end;
851 
852 function TZDBLibConnection.GetBinaryEscapeString(const Value: TByteDynArray): String;
853 begin
854  Result := GetSQLHexString(PAnsiChar(Value), Length(Value), True);
855  if GetAutoEncodeStrings then
856  Result := GetDriver.GetTokenizer.GetEscapeString(Result)
857 end;
858 
859 function TZDBLibConnection.GetBinaryEscapeString(const Value: RawByteString): String;
860 begin
861  Result := GetSQLHexString(PAnsiChar(Value), Length(Value), True);
862  if GetAutoEncodeStrings then
863  Result := GetDriver.GetTokenizer.GetEscapeString(Result)
864 end;
865 
866 
867 initialization
868  DBLibDriver := TZDBLibDriver.Create;
869  DriverManager.RegisterDriver(DBLibDriver);
870 finalization
871  if Assigned(DriverManager) then
872  DriverManager.DeregisterDriver(DBLibDriver);
873  DBLibDriver := nil;
874 end.