zeoslib  UNKNOWN
 All Files
ZAbstractConnection.pas
Go to the documentation of this file.
1 {*********************************************************}
2 { }
3 { Zeos Database Objects }
4 { Database Connection Component }
5 { }
6 { Originally written by Sergey Seroukhov }
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 ZAbstractConnection;
53 
54 interface
55 
56 {$I ZComponent.inc}
57 
58 uses
59  Types,
60 {$IFNDEF UNIX}
61 {$IFDEF ENABLE_ADO}
62  ZDbcAdo,
63 {$ENDIF}
64 {$ENDIF}
65 {$IFDEF ENABLE_DBLIB}
66  ZDbcDbLib,
67 {$ENDIF}
68 {$IFDEF ENABLE_MYSQL}
69  ZDbcMySql,
70 {$ENDIF}
71 {$IFDEF ENABLE_POSTGRESQL}
72  ZDbcPostgreSql,
73 {$ENDIF}
74 {$IFDEF ENABLE_INTERBASE}
75  ZDbcInterbase6,
76 {$ENDIF}
77 {$IFDEF ENABLE_SQLITE}
78  ZDbcSqLite,
79 {$ENDIF}
80 {$IFDEF ENABLE_ORACLE}
81  ZDbcOracle,
82 {$ENDIF}
83 {$IFDEF ENABLE_ASA}
84  ZDbcASA,
85 {$ENDIF}
86 {$IFDEF ENABLE_POOLED}
87  ZDbcPooled,
88 {$ENDIF}
89 
90  SysUtils, Classes, {$IFDEF MSEgui}mclasses, mdb{$ELSE}DB{$ENDIF},
91  ZDbcIntfs, ZCompatibility, ZURL;
92 
93 
94 type
95  //HA 090811 New Type TZLoginEvent to make Username and Password persistent
96  TZLoginEvent = procedure(Sender: TObject; var Username:string ; var Password: string) of object;
97 
98  {** Represents a component which wraps a connection to database. }
99 
100  { TZAbstractConnection }
101 
102  TZAbstractConnection = class(TComponent)
103  private
104  FUseMetaData: Boolean;
105  {$IFNDEF UNICODE}FAutoEncode: Boolean;{$ENDIF}
106  FControlsCodePage: TZControlsCodePage;
107  {$IFDEF ZEOS_TEST_ONLY}
108  FTestMode: Byte;
109  {$ENDIF}
110  function GetVersion: string;
111  procedure SetUseMetadata(AValue: Boolean);
112  procedure SetVersion(const Value: string);
113  procedure SetControlsCodePage(const Value: TZControlsCodePage);
114  protected
115  FURL: TZURL;
116  FCatalog: string;
117  FAutoCommit: Boolean;
118  FReadOnly: Boolean;
119  FTransactIsolationLevel: TZTransactIsolationLevel;
120  FConnection: IZConnection;
121  FDatasets: TList;
122  // Modified by cipto 8/1/2007 1:44:22 PM
123  FSequences: TList;
124 
125  FLoginPrompt: Boolean;
126  FStreamedConnected: Boolean;
127  FExplicitTransactionCounter: Integer;
128  FSQLHourGlass: Boolean;
129  FDesignConnection: Boolean;
130 
131  FBeforeConnect: TNotifyEvent;
132  FBeforeDisconnect: TNotifyEvent;
133  FAfterDisconnect: TNotifyEvent;
134  FAfterConnect: TNotifyEvent;
135  FBeforeReconnect: TNotifyEvent;
136  FAfterReconnect: TNotifyEvent;
137  FOnCommit: TNotifyEvent;
138  FOnRollback: TNotifyEvent;
139  FOnStartTransaction: TNotifyEvent;
140  //HA 090811 Change Type of FOnLogin to new TZLoginEvent
141  //FOnLogin: TLoginEvent;
142  FOnLogin: TZLoginEvent;
143  FClientCodepage: String;
144 
145  function GetAutoEncode: Boolean;
146  procedure SetAutoEncode(Value: Boolean);
147  function GetHostName: string;
148  procedure SetHostName(const Value: String);
149  function GetConnPort: Integer;
150  procedure SetConnPort(const Value: Integer);
151  function GetDatabase: string;
152  procedure SetDatabase(const Value: String);
153  function GetUser: string;
154  procedure SetUser(const Value: String);
155  function GetPassword: string;
156  procedure SetPassword(const Value: String);
157  function GetLibLocation: String;
158  procedure SetLibLocation(const Value: String);
159  function GetProtocol: String;
160  procedure SetProtocol(const Value: String);
161  function GetProperties: TStrings;
162  function GetConnected: Boolean;
163  procedure SetConnected(Value: Boolean);
164  procedure SetProperties(Value: TStrings);
165  procedure SetTransactIsolationLevel(Value: TZTransactIsolationLevel);
166  procedure SetAutoCommit(Value: Boolean);
167  function GetDbcDriver: IZDriver;
168  function GetInTransaction: Boolean;
169  function GetClientVersion: Integer;
170  function GetServerVersion: Integer;
171  function GetClientVersionStr: String;
172  function GetServerVersionStr: String;
173  procedure DoBeforeConnect;
174  procedure DoAfterConnect;
175  procedure DoBeforeDisconnect;
176  procedure DoAfterDisconnect;
177  procedure DoBeforeReconnect;
178  procedure DoAfterReconnect;
179  procedure DoCommit;
180  procedure DoRollback;
181  procedure DoStartTransaction;
182 
183  procedure CheckConnected;
184  procedure CheckAutoCommitMode;
185  procedure CheckNonAutoCommitMode;
186 
187  function ConstructURL(const UserName, Password: string): string;
188 
189  procedure CloseAllDataSets;
190  procedure UnregisterAllDataSets;
191 
192  // Modified by cipto 8/1/2007 1:48:17 PM
193  procedure CloseAllSequences;
194  ////////////////////////////////////////
195 
196  procedure Notification(AComponent: TComponent;
197  Operation: TOperation); override;
198  procedure Loaded; override;
199 
200  property StreamedConnected: Boolean read FStreamedConnected write FStreamedConnected;
201 
202  procedure SetClientCodePage(Const Value: String); //Egonhugeist
203  public
204  constructor Create(AOwner: TComponent); override;
205  destructor Destroy; override;
206 
207  procedure Connect; virtual;
208  procedure Disconnect; virtual;
209  procedure Reconnect;
210  function Ping: Boolean; virtual;
211 
212  procedure StartTransaction; virtual;
213  procedure Commit; virtual;
214  procedure Rollback; virtual;
215 
216  procedure PrepareTransaction(const transactionid: string); virtual;
217  procedure CommitPrepared(const transactionid: string); virtual;
218  procedure RollbackPrepared(const transactionid: string); virtual;
219  function PingServer: Boolean; virtual;
220 
221  procedure RegisterDataSet(DataSet: TDataset);
222  procedure UnregisterDataSet(DataSet: TDataset);
223  function ExecuteDirect(SQL:string):boolean;overload;
224  function ExecuteDirect(SQL:string; var RowsAffected:integer):boolean;overload;
225  // Modified by cipto 8/2/2007 10:16:50 AM
226  procedure RegisterSequence(Sequence: TComponent);
227  procedure UnregisterSequence(Sequence: TComponent);
228  ///////////////////////////////////////////////////
229 
230  procedure GetProtocolNames(List: TStrings);
231  procedure GetCatalogNames(List: TStrings);
232  procedure GetSchemaNames(List: TStrings);
233  procedure GetTableNames(const Pattern: string; List: TStrings);overload;
234  procedure GetTableNames(const schemaPattern, tablePattern: string; List: TStrings);overload;
235  procedure GetTableNames(const schemaPattern, tablePattern: string; Types: TStringDynArray; List: TStrings);overload;
236  procedure GetColumnNames(const TablePattern, ColumnPattern: string; List: TStrings);
237 
238  procedure GetStoredProcNames(const Pattern: string; List: TStrings);
239  procedure GetTriggerNames(const TablePattern, SchemaPattern: string; List: TStrings);
240 
241  //EgonHugeist
242  function GetBinaryEscapeStringFromString(const BinaryString: AnsiString): String; overload;
243  function GetBinaryEscapeStringFromStream(const Stream: TStream): String; overload;
244  function GetBinaryEscapeStringFromFile(const FileName: String): String; overload;
245  function GetAnsiEscapeString(const Ansi: AnsiString): String;
246  function GetURL: String;
247 
248  property InTransaction: Boolean read GetInTransaction;
249 
250  property HostName: string read GetHostName write SetHostName;
251  property Port: Integer read GetConnPort write SetConnPort;
252  property Database: string read GetDatabase write SetDatabase;
253  property User: string read GetUser write SetUser;
254  property Password: string read GetPassword write SetPassword;
255  property Protocol: string read GetProtocol write SetProtocol;
256  property LibLocation: string read GetLibLocation write SetLibLocation;
257 
258  property DbcDriver: IZDriver read GetDbcDriver;
259  property DbcConnection: IZConnection read FConnection;
260  property ClientVersion: Integer read GetClientVersion;
261  property ServerVersion: Integer read GetServerVersion;
262  property ClientVersionStr: String read GetClientVersionStr;
263  property ServerVersionStr: String read GetServerVersionStr;
264  procedure ShowSQLHourGlass;
265  procedure HideSQLHourGlass;
266  published
267  property ControlsCodePage: TZControlsCodePage read FControlsCodePage write SetControlsCodePage;
268  property AutoEncodeStrings: Boolean read GetAutoEncode write SetAutoEncode default True;
269  property ClientCodepage: String read FClientCodepage write SetClientCodePage; //EgonHugeist
270  property Catalog: string read FCatalog write FCatalog;
271  property Properties: TStrings read GetProperties write SetProperties;
272  property AutoCommit: Boolean read FAutoCommit write SetAutoCommit
273  default True;
274  property ReadOnly: Boolean read FReadOnly write FReadOnly
275  default False;
276  property UseMetadata: Boolean read FUseMetaData write SetUseMetadata default true;
277  property TransactIsolationLevel: TZTransactIsolationLevel
278  read FTransactIsolationLevel write SetTransactIsolationLevel
279  default tiNone;
280  property Connected: Boolean read GetConnected write SetConnected
281  default False;
282  property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt
283  default False;
284  property Version: string read GetVersion write SetVersion stored False;
285  property DesignConnection: Boolean read FDesignConnection
286  write FDesignConnection default False;
287 
288  property BeforeConnect: TNotifyEvent
289  read FBeforeConnect write FBeforeConnect;
290  property AfterConnect: TNotifyEvent
291  read FAfterConnect write FAfterConnect;
292  property BeforeDisconnect: TNotifyEvent
293  read FBeforeDisconnect write FBeforeDisconnect;
294  property AfterDisconnect: TNotifyEvent
295  read FAfterDisconnect write FAfterDisconnect;
296  property BeforeReconnect: TNotifyEvent
297  read FBeforeReconnect write FBeforeReconnect;
298  property AfterReconnect: TNotifyEvent
299  read FAfterReconnect write FAfterReconnect;
300  property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass
301  default False;
302  property OnCommit: TNotifyEvent read FOnCommit write FOnCommit;
303  property OnRollback: TNotifyEvent read FOnRollback write FOnRollback;
304  //HA 090811 Change Type of FOnLogin to new TZLoginEvent
305  //property OnLogin: TLoginEvent read FOnLogin write FOnLogin;
306  property OnLogin: TZLoginEvent read FOnLogin write FOnLogin;
307  property OnStartTransaction: TNotifyEvent
308  read FOnStartTransaction write FOnStartTransaction;
309  {$IFDEF ZEOS_TEST_ONLY}
310  property TestMode : Byte read FTestMode write FTestMode;
311  {$ENDIF}
312  end;
313 
314 implementation
315 
316 uses ZMessages, ZClasses, ZAbstractRODataset, ZSysUtils,
317  // Modified by cipto 8/2/2007 10:00:22 AM
318  ZSequence, ZAbstractDataset, ZEncoding;
319 
320 var
321  SqlHourGlassLock: Integer;
322  CursorBackup: TDBScreenCursor;
323 
324 { TZAbstractConnection }
325 
326 {**
327  Constructs this component and assignes the main properties.
328  @param AOwner an owner component.
329 }
330 constructor TZAbstractConnection.Create(AOwner: TComponent);
331 begin
332  {$IFDEF UNICODE}
333  FControlsCodePage := cCP_UTF16;
334  {$ELSE}
335  {$IFDEF FPC}
336  FControlsCodePage := cCP_UTF8;
337  {$ELSE}
338  FControlsCodePage := cGET_ACP;
339  {$ENDIF}
340  {$ENDIF}
341  FURL := TZURL.Create;
342  inherited Create(AOwner);
343  FAutoCommit := True;
344  FReadOnly := False;
345  FTransactIsolationLevel := tiNone;
346  FConnection := nil;
347  FUseMetadata := True;
348  FDatasets := TList.Create;
349  // Modified by cipto 8/1/2007 1:45:56 PM
350  FSequences:= TList.Create;
351  FLoginPrompt := False;
352  FDesignConnection := False;
353 end;
354 
355 {**
356  Destroys this component and cleanups the memory.
357 }
358 destructor TZAbstractConnection.Destroy;
359 begin
360  Disconnect;
361  UnregisterAllDataSets;
362  FDatasets.Free;
363  FURL.Free;
364  // Modified by cipto 8/1/2007 1:47:37 PM
365  FSequences.Clear;
366  FSequences.Free;
367  ////////////////////////////////////////
368  inherited Destroy;
369 end;
370 
371 function TZAbstractConnection.GetHostName: string;
372 begin
373  Result := FURL.HostName;
374 end;
375 
376 procedure TZAbstractConnection.SetHostName(const Value: String);
377 begin
378  FURL.HostName := Value;
379 end;
380 
381 function TZAbstractConnection.GetConnPort: Integer;
382 begin
383  Result := FURL.Port;
384 end;
385 
386 procedure TZAbstractConnection.SetConnPort(const Value: Integer);
387 begin
388  FURL.Port := Value;
389 end;
390 
391 function TZAbstractConnection.GetDatabase: string;
392 begin
393  Result := FURL.Database;
394 end;
395 
396 procedure TZAbstractConnection.SetDatabase(const Value: String);
397 begin
398  FURL.Database := Value;
399 end;
400 
401 function TZAbstractConnection.GetUser: string;
402 begin
403  Result := FURL.UserName;
404 end;
405 
406 procedure TZAbstractConnection.SetUser(const Value: String);
407 begin
408  FURL.UserName := Value;
409 end;
410 
411 function TZAbstractConnection.GetPassword: string;
412 begin
413  Result := FURL.Password;
414 end;
415 
416 procedure TZAbstractConnection.SetPassword(const Value: String);
417 begin
418  FURL.Password := Value;
419 end;
420 
421 function TZAbstractConnection.GetLibLocation: String;
422 begin
423  Result := FURL.LibLocation;
424 end;
425 
426 procedure TZAbstractConnection.SetLibLocation(const Value: String);
427 begin
428  FURL.LibLocation := Value;
429 end;
430 
431 function TZAbstractConnection.GetProtocol: String;
432 begin
433  Result := FURL.Protocol;
434 end;
435 
436 procedure TZAbstractConnection.SetProtocol(const Value: String);
437 begin
438  FURL.Protocol := Value;
439 end;
440 
441 function TZAbstractConnection.GetProperties: TStrings;
442 begin
443  Result := FURL.Properties;
444 end;
445 
446 {**
447  This methode is required to support proper component initialization.
448  Without it, the connection can start connecting before every property is loaded!
449 }
450 procedure TZAbstractConnection.Loaded;
451 begin
452  inherited Loaded;
453  try
454  if FStreamedConnected then
455  if (csDesigning in ComponentState) or not FDesignConnection then
456  SetConnected(True);
457  except
458  if csDesigning in ComponentState then
459  if Assigned(Classes.ApplicationHandleException) then
460  Classes.ApplicationHandleException(ExceptObject)
461  else
462  ShowException(ExceptObject, ExceptAddr)
463  else
464  raise;
465  end;
466 end;
467 
468 {**
469  EgonHugeist:
470  Sets the ClientCode-Page-Property and adds or corrects it in the
471  Info(Properties)-Strings
472  @param <code>string</code> the ClientCharacterSet
473 }
474 procedure TZAbstractConnection.SetClientCodePage(Const Value: String);
475 begin
476  if ( Value = 'Not Connected!' ) or ( Value = 'Not implementet!' ) then
477  //possible! -> result of PropertyEditor if not complete yet
478  //Later we should remove this if the MeataData/Plaindriver-Informations
479  //where complete
480  FClientCodepage := Trim(FURL.Properties.Values['codepage'])
481  else
482  Self.FClientCodepage := Value;
483  if ( Trim(FURL.Properties.Values['codepage']) <> FClientCodepage ) then
484  FURL.Properties.Values['codepage'] := FClientCodepage;
485 end;
486 
487 {**
488  Gets an open connection flag.
489  @return <code>True</code> if the connection is open
490  or <code>False</code> otherwise.
491 }
492 function TZAbstractConnection.GetConnected: Boolean;
493 begin
494  Result := (FConnection <> nil) and not FConnection.IsClosed;
495 end;
496 
497 {**
498  Sets a new open connection flag.
499  @param Value <code>True</code> to open the connection
500  and <code>False</code> to close it.
501 }
502 procedure TZAbstractConnection.SetConnected(Value: Boolean);
503 begin
504  if (csReading in ComponentState) and Value then
505  FStreamedConnected := True
506  else
507  begin
508  if Value <> GetConnected then
509  begin
510  if Value then
511  Connect
512  else
513  Disconnect;
514  end;
515  end;
516 end;
517 
518 {**
519  Sets a new connection properties.
520  @param Value a list with new connection properties.
521 }
522 procedure TZAbstractConnection.SetProperties(Value: TStrings);
523 begin
524  if Value <> nil then
525  begin
526  if ( Trim(Value.Values['codepage']) <> '' ) then
527  FClientCodepage := Trim(Value.Values['codepage'])
528  else
529  Value.Values['codepage'] := FClientCodepage;
530 
531  { check autoencodestrings }
532  {$IF (defined(MSWINDOWS) or defined(WITH_LCONVENCODING) or defined(FPC_HAS_BUILTIN_WIDESTR_MANAGER)) and not defined(UNICODE)}
533  if Connected then
534  DbcConnection.AutoEncodeStrings := Value.Values['AutoEncodeStrings'] = 'ON';
535  FAutoEncode := Value.Values['AutoEncodeStrings'] = 'ON';
536  {$ELSE}
537  {$IFDEF UNICODE}
538  Value.Values['AutoEncodeStrings'] := 'ON';
539  {$ELSE}
540  Value.Values['AutoEncodeStrings'] := '';
541  {$ENDIF}
542  {$IFEND}
543 
544  if Value.IndexOf('controls_cp') = -1 then
545  {$IFDEF UNICODE}
546  if ControlsCodePage = cCP_UTF16 then
547  Value.values['controls_cp'] := 'CP_UTF16'
548  else
549  Value.values['controls_cp'] := 'GET_ACP'
550  {$ELSE}
551  case ControlsCodePage of //automated check..
552  cCP_UTF16: Value.values['controls_cp'] := 'CP_UTF16';
553  cCP_UTF8: Value.values['controls_cp'] := 'CP_UTF8';
554  cGET_ACP: Value.values['controls_cp'] := 'GET_ACP';
555  end
556  {$ENDIF}
557  else
558  {$IFDEF UNICODE}
559  if Value.values['controls_cp'] = 'CP_UTF8' then
560  begin
561  Value.values['controls_cp'] := 'CP_UTF16';
562  FControlsCodePage := cCP_UTF16;
563  end;
564  {$ELSE}
565  {$IFNDEF WITH_WIDEFIELDS} //old FPC and D7
566  if Value.values['controls_cp'] = 'CP_UTF16' then
567  begin
568  FControlsCodePage := cGET_ACP;
569  Value.values['controls_cp'] := {$IFDEF DLEPHI}'GET_ACP'{$ELSE}'CP_UTF8'{$ENDIF};
570  end;
571  {$ELSE}
572  if Value.values['controls_cp'] = 'GET_ACP' then
573  FControlsCodePage := cGET_ACP
574  else
575  if Value.values['controls_cp'] = 'CP_UTF8' then
576  FControlsCodePage := cCP_UTF8
577  else
578  if Value.values['controls_cp'] = 'CP_UTF16' then
579  FControlsCodePage := cCP_UTF16
580  else
581  case ControlsCodePage of //automated check..
582  cCP_UTF16: Value.values['controls_cp'] := 'CP_UTF16';
583  cCP_UTF8: Value.values['controls_cp'] := 'CP_UTF8';
584  cGET_ACP: Value.values['controls_cp'] := 'GET_ACP';
585  end;
586  {$ENDIF}
587  {$ENDIF}
588  FURL.Properties.Text := Value.Text;
589  end
590  else
591  FURL.Properties.Clear;
592 end;
593 
594 {**
595  Sets autocommit flag.
596  @param Value <code>True</code> to turn autocommit on.
597 }
598 procedure TZAbstractConnection.SetAutoCommit(Value: Boolean);
599 begin
600  if FAutoCommit <> Value then
601  begin
602  if FExplicitTransactionCounter > 0 then
603  raise Exception.Create(SInvalidOperationInTrans);
604  FAutoCommit := Value;
605  ShowSQLHourGlass;
606  try
607  if FConnection <> nil then
608  FConnection.SetAutoCommit(Value);
609  finally
610  HideSqlHourGlass
611  end;
612  end;
613 end;
614 
615 {**
616  Sets transact isolation level.
617  @param Value a transact isolation level.
618 }
619 procedure TZAbstractConnection.SetTransactIsolationLevel(
620  Value: TZTransactIsolationLevel);
621 begin
622  if FTransactIsolationLevel <> Value then
623  begin
624  FTransactIsolationLevel := Value;
625  ShowSqlhourGlass;
626  try
627  if FConnection <> nil then
628  FConnection.SetTransactionIsolation(Value);
629  finally
630  HideSqlHourGlass
631  end;
632  end;
633 end;
634 
635 {**
636  Gets a ZDBC driver for the specified protocol.
637  @returns a ZDBC driver interface.
638 }
639 function TZAbstractConnection.GetDbcDriver: IZDriver;
640 begin
641  if FConnection <> nil then
642  Result := FConnection.GetDriver
643  else
644  Result := DriverManager.GetDriver(ConstructURL('', ''));
645 end;
646 
647 {**
648  Checks is the connection started a transaction.
649  @returns <code>True</code> if connection in manual transaction mode
650  and transaction is started.
651 }
652 function TZAbstractConnection.GetInTransaction: Boolean;
653 begin
654  CheckConnected;
655  Result := not FAutoCommit or (FExplicitTransactionCounter > 0);
656 end;
657 
658 {**
659  Gets client's full version number.
660  The format of the version resturned must be XYYYZZZ where
661  X = Major version
662  YYY = Minor version
663  ZZZ = Sub version
664  @return this clients's full version number
665 }
666 function TZAbstractConnection.GetClientVersion: Integer;
667 begin
668  if FConnection <> nil then
669  Result := DbcConnection.GetClientVersion
670  else
671  Result := DriverManager.GetClientVersion(ConstructURL('', ''));
672 end;
673 
674 {**
675  Gets server's full version number.
676  The format of the version resturned must be XYYYZZZ where
677  X = Major version
678  YYY = Minor version
679  ZZZ = Sub version
680  @return this clients's full version number
681 }
682 function TZAbstractConnection.GetServerVersion: Integer;
683 begin
684  CheckConnected;
685  Result := DbcConnection.GetHostVersion;
686 end;
687 
688 {**
689  Gets client's full version number.
690  The format of the version resturned must be XYYYZZZ where
691  X = Major version
692  YYY = Minor version
693  ZZZ = Sub version
694  @return this clients's full version number
695 }
696 function TZAbstractConnection.GetClientVersionStr: String;
697 begin
698  Result := FormatSQLVersion(GetClientVersion);
699 end;
700 
701 {**
702  Gets server's full version number.
703  The format of the version resturned must be XYYYZZZ where
704  X = Major version
705  YYY = Minor version
706  ZZZ = Sub version
707  @return this clients's full version number
708 }
709 function TZAbstractConnection.GetServerVersionStr: String;
710 begin
711  Result := FormatSQLVersion(GetServerVersion);
712 end;
713 
714 {**
715  Constructs ZDBC connection URL string.
716  @param UserName a name of the user.
717  @param Password a user password.
718  @returns a constructed connection URL.
719 }
720 function TZAbstractConnection.ConstructURL(const UserName, Password: string): string;
721 begin
722  Result := DriverManager.ConstructURL(FURL.Protocol, FURL.HostName, FURL.Database, UserName,
723  Password, FURL.Port, FURL.Properties, FURL.LibLocation);
724 end;
725 
726 {**
727  Fires an event before connection open
728 }
729 procedure TZAbstractConnection.DoBeforeConnect;
730 begin
731  if Assigned(FBeforeConnect) then
732  FBeforeConnect(Self);
733 end;
734 
735 {**
736  Fires an event after connection open
737 }
738 procedure TZAbstractConnection.DoAfterConnect;
739 begin
740  if Assigned(FAfterConnect) then
741  FAfterConnect(Self);
742 end;
743 
744 {**
745  Fires an event before connection close
746 }
747 procedure TZAbstractConnection.DoBeforeDisconnect;
748 begin
749  if Assigned(FBeforeDisconnect) then
750  FBeforeDisconnect(Self);
751 end;
752 
753 {**
754  Fires an event after connection close
755 }
756 procedure TZAbstractConnection.DoAfterDisconnect;
757 begin
758  if Assigned(FAfterDisconnect) then
759  FAfterDisconnect(Self);
760 end;
761 
762 {**
763  Fires an event before reconnect
764 }
765 procedure TZAbstractConnection.DoBeforeReconnect;
766 begin
767  if Assigned(FBeforeReconnect) then
768  FBeforeReconnect(Self);
769 end;
770 
771 {**
772  Fires an event after reconnect
773 }
774 procedure TZAbstractConnection.DoAfterReconnect;
775 begin
776  if Assigned(FAfterReconnect) then
777  FAfterReconnect(Self);
778 end;
779 
780 {**
781  Fires an event after transaction commit
782 }
783 procedure TZAbstractConnection.DoCommit;
784 begin
785  if Assigned(FOnCommit) then
786  FOnCommit(Self);
787 end;
788 
789 {**
790  Fires an event after transaction rollback
791 }
792 procedure TZAbstractConnection.DoRollback;
793 begin
794  if Assigned(FOnRollback) then
795  FOnRollback(Self);
796 end;
797 
798 {**
799  Fires an event after transaction start
800 }
801 procedure TZAbstractConnection.DoStartTransaction;
802 begin
803  if Assigned(FOnStartTransaction) then
804  FOnStartTransaction(Self);
805 end;
806 
807 {**
808  Establish a connection with database.
809 }
810 procedure TZAbstractConnection.Connect;
811 var
812 //Local variables declared in order to preserve the original property value
813 //and to avoid the storage of password
814  Username, Password: string;
815 begin
816  if FConnection = nil then
817  begin
818 // Fixes Zeos Bug 00056
819 // try
820  DoBeforeConnect;
821 // except
822 //This is here to support aborting the Connection in BeforeConnect event without fatal errors
823 // on E: EAbort do
824 // Exit;
825 // end;
826 
827  UserName := FURL.UserName;
828  Password := FURL.Password;
829 
830  if FLoginPrompt then
831  begin
832 
833  if Assigned(FOnLogin) then
834  FOnLogin(Self, UserName, Password)
835  else
836  begin
837  if Assigned(LoginDialogProc) then
838  begin
839  if not LoginDialogProc(FURL.Database, UserName, Password) then
840  Exit;
841  end
842  else
843  raise Exception.Create(SLoginPromptFailure);
844  end;
845  end;
846 
847  ShowSqlHourGlass;
848  try
849  FConnection := DriverManager.GetConnectionWithParams(
850  ConstructURL(UserName, Password), FURL.Properties);
851  try
852  with FConnection do
853  begin
854  SetAutoCommit(FAutoCommit);
855  SetReadOnly(FReadOnly);
856  SetCatalog(FCatalog);
857  SetTransactionIsolation(FTransactIsolationLevel);
858  SetUseMetadata(FUseMetadata);
859  Open;
860  {$IFDEF ZEOS_TEST_ONLY}
861  SetTestMode(FTestMode);
862  {$ENDIF}
863  end;
864  except
865  FConnection := nil;
866  raise;
867  end;
868  finally
869  HideSqlHourGlass;
870  end;
871 
872  if not FConnection.IsClosed then
873  DoAfterConnect;
874  end;
875 end;
876 
877 {**
878  Closes and removes the connection with database
879 }
880 procedure TZAbstractConnection.Disconnect;
881 begin
882  if FConnection <> nil then
883  begin
884  DoBeforeDisconnect;
885 
886  ShowSqlHourGlass;
887  try
888  CloseAllDataSets;
889  // Modified by cipto 8/2/2007 10:11:02 AM
890  CloseAllSequences;
891  FConnection.Close;
892  finally
893  FConnection := nil;
894  HideSqlHourGlass;
895  end;
896 
897  DoAfterDisconnect;
898  end;
899 end;
900 
901 
902 {**
903  Sends a ping to the server.
904 }
905 function TZAbstractConnection.Ping: Boolean;
906 begin
907  Result := (FConnection <> nil) and (FConnection.PingServer=0);
908 end;
909 
910 {**
911  Reconnect, doesn't destroy DataSets if successful.
912 }
913 procedure TZAbstractConnection.Reconnect;
914 begin
915  if FConnection <> nil then
916  begin
917  DoBeforeReconnect;
918 
919  ShowSqlHourGlass;
920  try
921  try
922  FConnection.Close;
923  FConnection.Open;
924  except
925  CloseAllDataSets;
926  raise;
927  end;
928  finally
929  HideSqlHourGlass;
930  end;
931 
932  DoAfterReconnect;
933  end;
934 end;
935 
936 {** Checks if this connection is active.
937 }
938 procedure TZAbstractConnection.CheckConnected;
939 begin
940  if FConnection = nil then
941  raise EZDatabaseError.Create(SConnectionIsNotOpened);
942 end;
943 
944 {**
945  Checks if this connection is in auto-commit mode.
946 }
947 procedure TZAbstractConnection.CheckNonAutoCommitMode;
948 begin
949  if FAutoCommit then
950  raise EZDatabaseError.Create(SInvalidOpInAutoCommit);
951 end;
952 
953 {**
954  Checks if this connection is in auto-commit mode.
955 }
956 procedure TZAbstractConnection.CheckAutoCommitMode;
957 begin
958  if not FAutoCommit and (FExplicitTransactionCounter = 0) then
959  raise EZDatabaseError.Create(SInvalidOpInNonAutoCommit);
960 end;
961 
962 {**
963  Commits the current transaction.
964 }
965 procedure TZAbstractConnection.StartTransaction;
966 begin
967  CheckAutoCommitMode;
968 
969  if FExplicitTransactionCounter = 0 then
970  AutoCommit := False;
971  DoStartTransaction;
972  Inc(FExplicitTransactionCounter);
973 end;
974 
975 {**
976  Commits the current transaction.
977 }
978 type //To get protected methodes
979  THack_ZAbstractDataset = Class(TZAbstractDataset);
980 procedure TZAbstractConnection.Commit;
981 var
982  ExplicitTran: Boolean;
983  i: Integer;
984 begin
985  CheckConnected;
986  CheckNonAutoCommitMode;
987 
988  ExplicitTran := FExplicitTransactionCounter > 0;
989  if FExplicitTransactionCounter < 2 then
990  //when 0 then AutoCommit was turned off, when 1 StartTransaction was used
991  begin
992  ShowSQLHourGlass;
993  try
994  try
995  for i := 0 to FDatasets.Count -1 do
996  if Assigned(FDatasets[i]) then
997  if TObject(FDatasets[i]) is TZAbstractDataset then
998  THack_ZAbstractDataset(FDatasets[i]).DisposeCachedUpdates;
999  FConnection.Commit;
1000  finally
1001  FExplicitTransactionCounter := 0;
1002  if ExplicitTran then
1003  AutoCommit := True;
1004  end;
1005  finally
1006  HideSQLHourGlass;
1007  end;
1008  DoCommit;
1009  end
1010  else
1011  Dec(FExplicitTransactionCounter);
1012 end;
1013 
1014 procedure TZAbstractConnection.CommitPrepared(const transactionid: string);
1015 var
1016  oldlev: TZTransactIsolationLevel;
1017 begin
1018  CheckAutoCommitMode;
1019  oldlev := TransactIsolationLevel;
1020  TransactIsolationLevel := tiNone;
1021  FConnection.CommitPrepared(transactionid);
1022  TransactIsolationLevel := oldLev;
1023 end;
1024 
1025 {**
1026  Rollbacks the current transaction.
1027 }
1028 procedure TZAbstractConnection.Rollback;
1029 var
1030  ExplicitTran: Boolean;
1031 begin
1032  CheckConnected;
1033  CheckNonAutoCommitMode;
1034 
1035  ExplicitTran := FExplicitTransactionCounter > 0;
1036  if FExplicitTransactionCounter < 2 then
1037  //when 0 then AutoCommit was turned off, when 1 StartTransaction was used
1038  begin
1039  ShowSQLHourGlass;
1040  try
1041  try
1042  FConnection.RollBack;
1043  finally
1044  FExplicitTransactionCounter := 0;
1045  if ExplicitTran then
1046  AutoCommit := True;
1047  end;
1048  finally
1049  HideSQLHourGlass;
1050  end;
1051  DoRollback;
1052  end
1053  else
1054  Dec(FExplicitTransactionCounter);
1055 end;
1056 
1057 procedure TZAbstractConnection.RollbackPrepared(const transactionid: string);
1058 var
1059  oldlev: TZTransactIsolationLevel;
1060 begin
1061  CheckAutoCommitMode;
1062  oldlev := TransactIsolationLevel;
1063  TransactIsolationLevel := tiNone;
1064  FConnection.RollbackPrepared(transactionid);
1065  TransactIsolationLevel := oldLev;
1066 end;
1067 
1068 {**
1069  Processes component notifications.
1070  @param AComponent a changed component object.
1071  @param Operation a component operation code.
1072 }
1073 procedure TZAbstractConnection.Notification(AComponent: TComponent;
1074  Operation: TOperation);
1075 begin
1076  inherited Notification(AComponent, Operation);
1077 
1078  if (Operation = opRemove) then
1079  begin
1080  if (AComponent is TDataset) then
1081  UnregisterDataSet(TDataset(AComponent));
1082  if (AComponent is TZSequence) then
1083  UnregisterSequence(TZSequence(AComponent));
1084  end;
1085 end;
1086 
1087 Function TZAbstractConnection.PingServer: Boolean;
1088 var
1089  LastState : boolean;
1090 begin
1091  Result := false;
1092  // Check connection status
1093  LastState := GetConnected;
1094  If FConnection <> Nil Then
1095  Begin
1096  Result := (FConnection.PingServer=0);
1097  // Connection now is false but was true
1098  If (Not Result) And (LastState) Then
1099  // Generate OnDisconnect event
1100  SetConnected(Result);
1101  End
1102  Else
1103  // Connection now is false but was true
1104  If LastState Then
1105  SetConnected(false);
1106 end;
1107 
1108 procedure TZAbstractConnection.PrepareTransaction(const transactionid: string);
1109 {var
1110  ExplicitTran: Boolean;}
1111 begin
1112  CheckConnected;
1113  CheckNonAutoCommitMode;
1114  if FExplicitTransactionCounter <> 1 then
1115  begin
1116  raise EZDatabaseError.Create(SInvalidOpPrepare);
1117  end;
1118  ShowSQLHourGlass;
1119  try
1120  try
1121  FConnection.PrepareTransaction(transactionid);
1122  finally
1123  FExplicitTransactionCounter := 0;
1124  AutoCommit := True;
1125  end;
1126  finally
1127  HideSQLHourGlass;
1128  end;
1129 end;
1130 
1131 
1132 {**
1133  Closes all registered datasets.
1134 }
1135 procedure TZAbstractConnection.CloseAllDataSets;
1136 var
1137  I: Integer;
1138  Current: TZAbstractRODataset;
1139 begin
1140  for I := 0 to FDatasets.Count - 1 do
1141  begin
1142  Current := TZAbstractRODataset(FDatasets[I]);
1143  try
1144  Current.UnPrepare;
1145  Current.Close;
1146  except
1147  // Ignore.
1148  end;
1149  end;
1150 end;
1151 
1152 {**
1153  Registers a new dataset object.
1154  @param DataSet a new dataset to be registered.
1155 }
1156 procedure TZAbstractConnection.RegisterDataSet(DataSet: TDataset);
1157 begin
1158  FDatasets.Add(DataSet);
1159 end;
1160 
1161 {**
1162  Unregisters a new dataset object.
1163  @param DataSet a new dataset to be unregistered.
1164 }
1165 procedure TZAbstractConnection.UnregisterDataSet(DataSet: TDataset);
1166 begin
1167  FDatasets.Remove(DataSet);
1168 end;
1169 
1170 {**
1171  Unregisters all dataset objects.
1172 }
1173 procedure TZAbstractConnection.UnregisterAllDataSets;
1174 var
1175  I: Integer;
1176  Current: TZAbstractRODataset;
1177 begin
1178  for I := FDatasets.Count - 1 downto 0 do
1179  begin
1180  Current := TZAbstractRODataset(FDatasets[I]);
1181  FDatasets.Remove(Current);
1182  try
1183  Current.Connection := nil;
1184  except
1185  // Ignore.
1186  end;
1187  end;
1188 end;
1189 
1190 {**
1191  Turn on sql hourglass cursor
1192 }
1193 procedure TZAbstractConnection.ShowSQLHourGlass;
1194 begin
1195  if not FSqlHourGlass then
1196  Exit;
1197 
1198  if SqlHourGlassLock = 0 then
1199  begin
1200  if Assigned(DBScreen) then
1201  begin
1202  CursorBackup := DBScreen.Cursor;
1203  if CursorBackup <> dcrOther then
1204  DBScreen.Cursor := dcrSQLWait;
1205  end;
1206  end;
1207  Inc(SqlHourGlassLock);
1208 end;
1209 
1210 {**
1211  Turn off sql hourglass cursor
1212 }
1213 procedure TZAbstractConnection.HideSQLHourGlass;
1214 begin
1215  if not FSqlHourGlass then
1216  Exit;
1217 
1218  if SqlHourGlassLock > 0 then
1219  Dec(SqlHourGlassLock);
1220  if SqlHourGlassLock = 0 then
1221  begin
1222  if CursorBackup <> dcrOther then
1223  if Assigned(DBScreen) then
1224  DBScreen.Cursor := CursorBackup;
1225  end;
1226 end;
1227 
1228 {**
1229  Fills string list with registered protocol names.
1230  @param List a string list to fill out.
1231 }
1232 procedure TZAbstractConnection.GetProtocolNames(List: TStrings);
1233 var
1234  I, J: Integer;
1235  Drivers: IZCollection;
1236  Driver: IZDriver;
1237  Protocols: TStringDynArray;
1238 begin
1239  List.Clear;
1240  Protocols := nil; // Makes compiler happy
1241  Drivers := DriverManager.GetDrivers;
1242  for I := 0 to Drivers.Count - 1 do
1243  begin
1244  Driver := Drivers[I] as IZDriver;
1245  Protocols := Driver.GetSupportedProtocols;
1246  for J := Low(Protocols) to High(Protocols) do
1247  List.Add(Protocols[J]);
1248  end;
1249 end;
1250 
1251 {**
1252  Fills string list with catalog names.
1253  @param List a string list to fill out.
1254 }
1255 procedure TZAbstractConnection.GetCatalogNames(List: TStrings);
1256 var
1257  Metadata: IZDatabaseMetadata;
1258  ResultSet: IZResultSet;
1259 begin
1260  CheckConnected;
1261 
1262  List.Clear;
1263  Metadata := DbcConnection.GetMetadata;
1264  ResultSet := Metadata.GetCatalogs;
1265  while ResultSet.Next do
1266  List.Add(ResultSet.GetStringByName('TABLE_CAT'));
1267 end;
1268 
1269 {**
1270  Fills string list with schema names.
1271  @param List a string list to fill out.
1272 }
1273 procedure TZAbstractConnection.GetSchemaNames(List: TStrings);
1274 var
1275  Metadata: IZDatabaseMetadata;
1276  ResultSet: IZResultSet;
1277 begin
1278  CheckConnected;
1279 
1280  List.Clear;
1281  Metadata := DbcConnection.GetMetadata;
1282  ResultSet := Metadata.GetSchemas;
1283  while ResultSet.Next do
1284  List.Add(ResultSet.GetStringByName('TABLE_SCHEM'));
1285 end;
1286 
1287 {**
1288  Fills string list with table names.
1289  @param Pattern a pattern for table names.
1290  @param List a string list to fill out.
1291 }
1292 procedure TZAbstractConnection.GetTableNames(const Pattern: string; List: TStrings);
1293 begin
1294  GetTableNames('', Pattern, nil, List);
1295 end;
1296 
1297 {**
1298  Fills string list with table names.
1299  @param tablePattern a pattern for table names.
1300  @param schemaPattern a pattern for schema names.
1301  @param List a string list to fill out.
1302 }
1303 procedure TZAbstractConnection.GetTableNames(const schemaPattern, tablePattern: string; List: TStrings);
1304 begin
1305  GetTableNames(schemaPattern, tablePattern, nil,List);
1306 end;
1307 
1308 {**
1309  Fills string list with table names.
1310  @param tablePattern a pattern for table names.
1311  @param schemaPattern a pattern for schema names.
1312  @param types a TStringDynArray specifying the table types to look for.
1313  possible values can be found by reading
1314  TZAbstractConnection.DbcConnection.GetMetadata.GetTableTypes
1315  eg. for PostGreSQL this includes :'TABLE', 'VIEW', 'INDEX', 'SEQUENCE',
1316  'SYSTEM TABLE', 'SYSTEM TOAST TABLE',
1317  'SYSTEM TOAST INDEX', 'SYSTEM VIEW',
1318  'SYSTEM INDEX', 'TEMPORARY TABLE',
1319  'TEMPORARY INDEX'
1320  @param List a string list to fill out.
1321 }
1322 procedure TZAbstractConnection.GetTableNames(const schemaPattern, tablePattern: string; Types: TStringDynArray; List: TStrings);
1323 var
1324  Metadata: IZDatabaseMetadata;
1325  ResultSet: IZResultSet;
1326 begin
1327  CheckConnected;
1328 
1329  List.Clear;
1330  Metadata := DbcConnection.GetMetadata;
1331  ResultSet := Metadata.GetTables('', schemaPattern, tablePattern, types);
1332  while ResultSet.Next do
1333  List.Add(ResultSet.GetStringByName('TABLE_NAME'));
1334 end;
1335 
1336 {**
1337  Fills string list with column names.
1338  @param TablePattern a pattern for table names.
1339  @param ColumnPattern a pattern for column names.
1340  @param List a string list to fill out.
1341 }
1342 procedure TZAbstractConnection.GetColumnNames(const TablePattern, ColumnPattern: string; List: TStrings);
1343 var
1344  Metadata: IZDatabaseMetadata;
1345  ResultSet: IZResultSet;
1346 begin
1347  CheckConnected;
1348  List.Clear;
1349  Metadata := DbcConnection.GetMetadata;
1350  ResultSet := Metadata.GetColumns('', '', TablePattern, ColumnPattern);
1351  while ResultSet.Next do
1352  List.Add(ResultSet.GetStringByName('COLUMN_NAME'));
1353 end;
1354 
1355 {**
1356  Fills string list with stored procedure names.
1357  @param Pattern a pattern for table names.
1358  @param List a string list to fill out.
1359 }
1360 procedure TZAbstractConnection.GetStoredProcNames(const Pattern: string;
1361  List: TStrings);
1362 var
1363  Metadata: IZDatabaseMetadata;
1364  ResultSet: IZResultSet;
1365 begin
1366  CheckConnected;
1367 
1368  List.Clear;
1369  Metadata := DbcConnection.GetMetadata;
1370  ResultSet := Metadata.GetProcedures('', '', Pattern);
1371  while ResultSet.Next do
1372  List.Add(ResultSet.GetStringByName('PROCEDURE_NAME'));
1373 end;
1374 
1375 {**
1376  EgonHugeist Returns Database-Triggers
1377  @Param TablePattern is a "like"-pattern to get Triggers of specified Table
1378  @SchemaPattern is Pattern to filter Schema-Trigger
1379  @List the Result-Trigger-List
1380 }
1381 procedure TZAbstractConnection.GetTriggerNames(const TablePattern,
1382  SchemaPattern: string; List: TStrings);
1383 begin
1384  CheckConnected;
1385 
1386  List.Clear;
1387  with DbcConnection.GetMetadata.GetTriggers('', SchemaPattern, TablePattern, '') do
1388  begin
1389  while Next do
1390  List.Add(GetStringByName('TRIGGER_NAME'));
1391  Close;
1392  end;
1393 end;
1394 
1395 {**
1396  EgonHugeist: Returns a EscapeState detectable String to inform the Tokenizer
1397  to do no UTF8Encoding if neccessary
1398  @param BinaryString Represents the BinaryString wich has to prepered
1399  @Result: A Prepared String like '~<|1023|<~''Binary-data-string(1023 Bytes)''~<|1023|<~
1400 }
1401 function TZAbstractConnection.GetBinaryEscapeStringFromString(const BinaryString: AnsiString): String;
1402 begin
1403  CheckConnected;
1404 
1405  if Assigned(FConnection) then
1406  Result := FConnection.GetBinaryEscapeString(BinaryString);
1407 end;
1408 
1409 {**
1410  EgonHugeist: Returns a BinaryState detectable String to inform the Tokenizer
1411  to do no UTF8Encoding if neccessary
1412  @param Strem Represents the Stream wich has to prepered
1413  @Result: A Prepared String like '~<|1023|<~''Binary-data-string(1023 Char's)''~<|1023|<~
1414 }
1415 function TZAbstractConnection.GetBinaryEscapeStringFromStream(const Stream: TStream): String;
1416 var
1417  FBlobSize: Integer;
1418  FBlobData: Pointer;
1419  TempAnsi: AnsiString;
1420 begin
1421  CheckConnected;
1422 
1423  if Assigned(FConnection) then
1424  begin
1425  if Assigned(Stream) then
1426  begin
1427  FBlobSize := Stream.Size;
1428  if FBlobSize > 0 then
1429  begin
1430  GetMem(FBlobData, FBlobSize);
1431  Stream.Position := 0;
1432  Stream.ReadBuffer(FBlobData^, FBlobSize);
1433  end
1434  else
1435  FBlobData := nil;
1436  end
1437  else
1438  begin
1439  FBlobSize := -1;
1440  FBlobData := nil;
1441  end;
1442  if (FBlobSize > 0) and Assigned(FBlobData) then
1443  System.SetString(TempAnsi, PAnsiChar(FBlobData), FBlobSize)
1444  else
1445  TempAnsi := '';
1446  if Assigned(FBlobData) then
1447  FreeMem(FBlobData);
1448 
1449  Result := FConnection.GetBinaryEscapeString(TempAnsi);
1450  end;
1451 end;
1452 
1453 {**
1454  EgonHugeist: Returns a BinaryState detectable String to inform the Tokenizer
1455  to do no UTF8Encoding if neccessary
1456  @param FileNaem Represents the File wich has to prepered
1457  @Result: A Prepared String like '~<|1023|<~''Binary-data-string(1023 Char's)''~<|1023|<~
1458 }
1459 function TZAbstractConnection.GetBinaryEscapeStringFromFile(const FileName: String): String;
1460 var
1461  FStream: TFileStream;
1462 begin
1463  CheckConnected;
1464 
1465  if FileExists(FileName) then
1466  begin
1467  FStream := TFileStream.Create(FileName, fmOpenRead);
1468  Result := GetBinaryEscapeStringFromStream(FStream);
1469  FreeAndNil(FStream);
1470  end;
1471 end;
1472 
1473 {**
1474  EgonHugeist: Returns a detectable String to inform the Tokenizer
1475  to do no UTF8Encoding if neccessary
1476  @param Ansi Represents the AnsiString wich has to prepered
1477  @Result: A Prepared String like '~<|1023|<~''Binary-data-string(1023 Char's)''~<|1023|<~
1478 }
1479 function TZAbstractConnection.GetAnsiEscapeString(const Ansi: AnsiString): String;
1480 begin
1481  Result := DbcConnection.GetDriver.GetTokenizer.GetEscapeString(String(Ansi));
1482 end;
1483 
1484 function TZAbstractConnection.GetURL: String;
1485 begin
1486  Result := ConstructURL(FURL.UserName, FURL.Password);
1487 end;
1488 
1489 function TZAbstractConnection.GetAutoEncode: Boolean;
1490 begin
1491  {$IFDEF UNICODE}
1492  Result := True;
1493  {$ELSE}
1494  {$IF defined(MSWINDOWS) or defined(WITH_LCONVENCODING) or defined(FPC_HAS_BUILTIN_WIDESTR_MANAGER)}
1495  if Connected then
1496  begin
1497  Result := DbcConnection.GetConSettings.AutoEncode;
1498  FAutoEncode := Result;
1499  end
1500  else
1501  Result := FAutoEncode;
1502  {$ELSE}
1503  Result := False;
1504  {$IFEND}
1505  {$ENDIF}
1506 end;
1507 
1508 procedure TZAbstractConnection.SetAutoEncode(Value: Boolean);
1509 begin
1510  {$IFNDEF UNICODE}
1511  {$IF defined(MSWINDOWS) or defined(WITH_LCONVENCODING) or defined(FPC_HAS_BUILTIN_WIDESTR_MANAGER)}
1512  if Value then
1513  FURL.Properties.Values['AutoEncodeStrings'] := 'ON'
1514  else
1515  FURL.Properties.Values['AutoEncodeStrings'] := '';
1516 
1517  if Value <> FAutoEncode then
1518  begin
1519  FAutoEncode := Value;
1520  if Self.Connected then
1521  begin
1522  Connected := False;
1523  Connected := True;
1524  end;
1525  end;
1526  {$ELSE}
1527  FURL.Properties.Values['AutoEncodeStrings'] := '';
1528  {$IFEND}
1529  {$ENDIF}
1530 end;
1531 
1532 {**
1533  Returns the current version of zeosdbo.
1534 }
1535 function TZAbstractConnection.GetVersion: string;
1536 begin
1537  Result := ZEOS_VERSION;
1538 end;
1539 
1540 procedure TZAbstractConnection.SetUseMetadata(AValue: Boolean);
1541 begin
1542  if FUseMetaData=AValue then Exit;
1543  FUseMetaData:=AValue;
1544  if FConnection <> nil then
1545  FConnection.SetUseMetadata(FUseMetadata);
1546 end;
1547 
1548 procedure TZAbstractConnection.SetControlsCodePage(const Value: TZControlsCodePage);
1549  procedure SetValue;
1550  begin
1551  {$IFDEF UNICODE}
1552  case Value of
1553  cCP_UTF16:
1554  begin
1555  Properties.values['controls_cp'] := 'CP_UTF16';
1556  FControlsCodePage := Value;
1557  end;
1558  cCP_UTF8:
1559  begin
1560  Properties.values['controls_cp'] := 'CP_UTF16';
1561  FControlsCodePage := cCP_UTF16;
1562  end;
1563  cGET_ACP:
1564  begin
1565  Properties.values['controls_cp'] := 'GET_ACP';
1566  FControlsCodePage := Value;
1567  end;
1568  end;
1569  {$ELSE}
1570  {$IFDEF WITH_WIDEFIELDS}
1571  case Value of
1572  cCP_UTF16:
1573  begin
1574  Properties.values['controls_cp'] := 'CP_UTF16';
1575  FControlsCodePage := Value;
1576  end;
1577  cCP_UTF8:
1578  begin
1579  Properties.values['controls_cp'] := 'CP_UTF8';
1580  FControlsCodePage := Value;
1581  end;
1582  cGET_ACP:
1583  if ZDefaultSystemCodePage = zCP_UTF8 then
1584  begin
1585  Properties.values['controls_cp'] := 'CP_UTF8';
1586  FControlsCodePage := cCP_UTF8;
1587  end
1588  else
1589  begin
1590  Properties.values['controls_cp'] := 'GET_ACP';
1591  FControlsCodePage := Value;
1592  end;
1593  end;
1594  {$ELSE} //D7 or old FPC
1595  case Value of
1596  cCP_UTF16:
1597  begin
1598  Properties.values['controls_cp'] := 'CP_UTF8';
1599  FControlsCodePage := cCP_UTF8;
1600  end;
1601  cCP_UTF8:
1602  begin
1603  Properties.values['controls_cp'] := 'CP_UTF8';
1604  FControlsCodePage := Value;
1605  end;
1606  cGET_ACP:
1607  if ZDefaultSystemCodePage = zCP_UTF8 then
1608  begin
1609  Properties.values['controls_cp'] := 'CP_UTF8';
1610  FControlsCodePage := cCP_UTF8;
1611  end
1612  else
1613  begin
1614  Properties.values['controls_cp'] := 'GET_ACP';
1615  FControlsCodePage := Value;
1616  end;
1617  end;
1618  {$ENDIF}
1619  {$ENDIF}
1620  end;
1621 begin
1622  if Value <> FControlsCodePage then
1623  if Connected then
1624  begin
1625  Connected := False;
1626  SetValue;
1627  Connected := True;
1628  end
1629  else
1630  SetValue;
1631 end;
1632 
1633 procedure TZAbstractConnection.SetVersion(const Value: string);
1634 begin
1635 end;
1636 
1637 procedure TZAbstractConnection.CloseAllSequences;
1638 var
1639  I: Integer;
1640  Current: TZSequence;
1641 begin
1642  for I := 0 to FSequences.Count - 1 do
1643  begin
1644  Current := TZSequence(FSequences[I]);
1645  try
1646  Current.CloseSequence;
1647  except
1648  // Ignore.
1649  end;
1650  end;
1651 end;
1652 
1653 procedure TZAbstractConnection.RegisterSequence(Sequence: TComponent);
1654 begin
1655  FSequences.Add(TZSequence(Sequence));
1656 end;
1657 
1658 procedure TZAbstractConnection.UnregisterSequence(Sequence: TComponent);
1659 begin
1660  if Assigned(FSequences) then
1661  FSequences.Remove(TZSequence(Sequence));
1662 end;
1663 
1664 {**
1665  Executes the SQL statement immediately without the need of a TZQuery component
1666  @param SQL the statement to be executed.
1667  Returns an indication if execution was succesfull.
1668 }
1669 function TZAbstractConnection.ExecuteDirect(SQL : String) : boolean;
1670 var
1671  dummy : Integer;
1672 begin
1673  result:= ExecuteDirect(SQL,dummy);
1674 end;
1675 
1676 {**
1677  Executes the SQL statement immediately without the need of a TZQuery component
1678  @param SQL the statement to be executed.
1679  @param RowsAffected the number of rows that were affected by the statement.
1680  Returns an indication if execution was succesfull.
1681 }
1682 function TZAbstractConnection.ExecuteDirect(SQL: string;
1683  var RowsAffected: integer):boolean;
1684 var
1685  stmt : IZStatement;
1686 begin
1687  try
1688  try
1689  CheckConnected;
1690  stmt := DbcConnection.CreateStatement;
1691  RowsAffected:= stmt.ExecuteUpdate(SQL);
1692  result := (RowsAffected <> -1);
1693  except
1694  RowsAffected := -1;
1695  result := False;
1696  raise; {------ added by Henk 09-10-2012 --------}
1697  end;
1698  finally
1699  stmt:=nil;
1700  end;
1701 end;
1702 
1703 initialization
1704  SqlHourGlassLock := 0;
1705 end.
1706