1 {*********************************************************}
3 { Zeos Database Objects }
4 { Database Connection Component }
6 { Originally written by Sergey Seroukhov }
8 {*********************************************************}
10 {@********************************************************}
11 { Copyright (c) 1999-2012 Zeos Development Group }
13 { License Agreement: }
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. }
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. }
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) }
46 { http://www.sourceforge.net/projects/zeoslib. }
49 { Zeos Development Group. }
50 {********************************************************@}
52 unit ZAbstractConnection;
71 {$IFDEF ENABLE_POSTGRESQL}
74 {$IFDEF ENABLE_INTERBASE}
77 {$IFDEF ENABLE_SQLITE}
80 {$IFDEF ENABLE_ORACLE}
86 {$IFDEF ENABLE_POOLED}
90 SysUtils, Classes, {$IFDEF MSEgui}mclasses, mdb{$ELSE}DB{$ENDIF},
91 ZDbcIntfs, ZCompatibility, ZURL;
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;
98 {** Represents a component which wraps a connection to database. }
100 { TZAbstractConnection }
102 TZAbstractConnection = class(TComponent)
104 FUseMetaData: Boolean;
105 {$IFNDEF UNICODE}FAutoEncode: Boolean;{$ENDIF}
106 FControlsCodePage: TZControlsCodePage;
107 {$IFDEF ZEOS_TEST_ONLY}
110 function GetVersion: string;
111 procedure SetUseMetadata(AValue: Boolean);
112 procedure SetVersion(const Value: string);
113 procedure SetControlsCodePage(const Value: TZControlsCodePage);
117 FAutoCommit: Boolean;
119 FTransactIsolationLevel: TZTransactIsolationLevel;
120 FConnection: IZConnection;
122 // Modified by cipto 8/1/2007 1:44:22 PM
125 FLoginPrompt: Boolean;
126 FStreamedConnected: Boolean;
127 FExplicitTransactionCounter: Integer;
128 FSQLHourGlass: Boolean;
129 FDesignConnection: Boolean;
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;
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;
180 procedure DoRollback;
181 procedure DoStartTransaction;
183 procedure CheckConnected;
184 procedure CheckAutoCommitMode;
185 procedure CheckNonAutoCommitMode;
187 function ConstructURL(const UserName, Password: string): string;
189 procedure CloseAllDataSets;
190 procedure UnregisterAllDataSets;
192 // Modified by cipto 8/1/2007 1:48:17 PM
193 procedure CloseAllSequences;
194 ////////////////////////////////////////
196 procedure Notification(AComponent: TComponent;
197 Operation: TOperation); override;
198 procedure Loaded; override;
200 property StreamedConnected: Boolean read FStreamedConnected write FStreamedConnected;
202 procedure SetClientCodePage(Const Value: String); //Egonhugeist
204 constructor Create(AOwner: TComponent); override;
205 destructor Destroy; override;
207 procedure Connect; virtual;
208 procedure Disconnect; virtual;
210 function Ping: Boolean; virtual;
212 procedure StartTransaction; virtual;
213 procedure Commit; virtual;
214 procedure Rollback; virtual;
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;
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 ///////////////////////////////////////////////////
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);
238 procedure GetStoredProcNames(const Pattern: string; List: TStrings);
239 procedure GetTriggerNames(const TablePattern, SchemaPattern: string; List: TStrings);
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;
248 property InTransaction: Boolean read GetInTransaction;
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;
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;
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
274 property ReadOnly: Boolean read FReadOnly write FReadOnly
276 property UseMetadata: Boolean read FUseMetaData write SetUseMetadata default true;
277 property TransactIsolationLevel: TZTransactIsolationLevel
278 read FTransactIsolationLevel write SetTransactIsolationLevel
280 property Connected: Boolean read GetConnected write SetConnected
282 property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt
284 property Version: string read GetVersion write SetVersion stored False;
285 property DesignConnection: Boolean read FDesignConnection
286 write FDesignConnection default False;
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
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;
316 uses ZMessages, ZClasses, ZAbstractRODataset, ZSysUtils,
317 // Modified by cipto 8/2/2007 10:00:22 AM
318 ZSequence, ZAbstractDataset, ZEncoding;
321 SqlHourGlassLock: Integer;
322 CursorBackup: TDBScreenCursor;
324 { TZAbstractConnection }
327 Constructs this component and assignes the main properties.
328 @param AOwner an owner component.
330 constructor TZAbstractConnection.Create(AOwner: TComponent);
333 FControlsCodePage := cCP_UTF16;
336 FControlsCodePage := cCP_UTF8;
338 FControlsCodePage := cGET_ACP;
341 FURL := TZURL.Create;
342 inherited Create(AOwner);
345 FTransactIsolationLevel := tiNone;
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;
356 Destroys this component and cleanups the memory.
358 destructor TZAbstractConnection.Destroy;
361 UnregisterAllDataSets;
364 // Modified by cipto 8/1/2007 1:47:37 PM
367 ////////////////////////////////////////
371 function TZAbstractConnection.GetHostName: string;
373 Result := FURL.HostName;
376 procedure TZAbstractConnection.SetHostName(const Value: String);
378 FURL.HostName := Value;
381 function TZAbstractConnection.GetConnPort: Integer;
386 procedure TZAbstractConnection.SetConnPort(const Value: Integer);
391 function TZAbstractConnection.GetDatabase: string;
393 Result := FURL.Database;
396 procedure TZAbstractConnection.SetDatabase(const Value: String);
398 FURL.Database := Value;
401 function TZAbstractConnection.GetUser: string;
403 Result := FURL.UserName;
406 procedure TZAbstractConnection.SetUser(const Value: String);
408 FURL.UserName := Value;
411 function TZAbstractConnection.GetPassword: string;
413 Result := FURL.Password;
416 procedure TZAbstractConnection.SetPassword(const Value: String);
418 FURL.Password := Value;
421 function TZAbstractConnection.GetLibLocation: String;
423 Result := FURL.LibLocation;
426 procedure TZAbstractConnection.SetLibLocation(const Value: String);
428 FURL.LibLocation := Value;
431 function TZAbstractConnection.GetProtocol: String;
433 Result := FURL.Protocol;
436 procedure TZAbstractConnection.SetProtocol(const Value: String);
438 FURL.Protocol := Value;
441 function TZAbstractConnection.GetProperties: TStrings;
443 Result := FURL.Properties;
447 This methode is required to support proper component initialization.
448 Without it, the connection can start connecting before every property is loaded!
450 procedure TZAbstractConnection.Loaded;
454 if FStreamedConnected then
455 if (csDesigning in ComponentState) or not FDesignConnection then
458 if csDesigning in ComponentState then
459 if Assigned(Classes.ApplicationHandleException) then
460 Classes.ApplicationHandleException(ExceptObject)
462 ShowException(ExceptObject, ExceptAddr)
470 Sets the ClientCode-Page-Property and adds or corrects it in the
471 Info(Properties)-Strings
472 @param <code>string</code> the ClientCharacterSet
474 procedure TZAbstractConnection.SetClientCodePage(Const Value: String);
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
480 FClientCodepage := Trim(FURL.Properties.Values['codepage'])
482 Self.FClientCodepage := Value;
483 if ( Trim(FURL.Properties.Values['codepage']) <> FClientCodepage ) then
484 FURL.Properties.Values['codepage'] := FClientCodepage;
488 Gets an open connection flag.
489 @return <code>True</code> if the connection is open
490 or <code>False</code> otherwise.
492 function TZAbstractConnection.GetConnected: Boolean;
494 Result := (FConnection <> nil) and not FConnection.IsClosed;
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.
502 procedure TZAbstractConnection.SetConnected(Value: Boolean);
504 if (csReading in ComponentState) and Value then
505 FStreamedConnected := True
508 if Value <> GetConnected then
519 Sets a new connection properties.
520 @param Value a list with new connection properties.
522 procedure TZAbstractConnection.SetProperties(Value: TStrings);
526 if ( Trim(Value.Values['codepage']) <> '' ) then
527 FClientCodepage := Trim(Value.Values['codepage'])
529 Value.Values['codepage'] := FClientCodepage;
531 { check autoencodestrings }
532 {$IF (defined(MSWINDOWS) or defined(WITH_LCONVENCODING) or defined(FPC_HAS_BUILTIN_WIDESTR_MANAGER)) and not defined(UNICODE)}
534 DbcConnection.AutoEncodeStrings := Value.Values['AutoEncodeStrings'] = 'ON';
535 FAutoEncode := Value.Values['AutoEncodeStrings'] = 'ON';
538 Value.Values['AutoEncodeStrings'] := 'ON';
540 Value.Values['AutoEncodeStrings'] := '';
544 if Value.IndexOf('controls_cp') = -1 then
546 if ControlsCodePage = cCP_UTF16 then
547 Value.values['controls_cp'] := 'CP_UTF16'
549 Value.values['controls_cp'] := 'GET_ACP'
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';
559 if Value.values['controls_cp'] = 'CP_UTF8' then
561 Value.values['controls_cp'] := 'CP_UTF16';
562 FControlsCodePage := cCP_UTF16;
565 {$IFNDEF WITH_WIDEFIELDS} //old FPC and D7
566 if Value.values['controls_cp'] = 'CP_UTF16' then
568 FControlsCodePage := cGET_ACP;
569 Value.values['controls_cp'] := {$IFDEF DLEPHI}'GET_ACP'{$ELSE}'CP_UTF8'{$ENDIF};
572 if Value.values['controls_cp'] = 'GET_ACP' then
573 FControlsCodePage := cGET_ACP
575 if Value.values['controls_cp'] = 'CP_UTF8' then
576 FControlsCodePage := cCP_UTF8
578 if Value.values['controls_cp'] = 'CP_UTF16' then
579 FControlsCodePage := cCP_UTF16
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';
588 FURL.Properties.Text := Value.Text;
591 FURL.Properties.Clear;
595 Sets autocommit flag.
596 @param Value <code>True</code> to turn autocommit on.
598 procedure TZAbstractConnection.SetAutoCommit(Value: Boolean);
600 if FAutoCommit <> Value then
602 if FExplicitTransactionCounter > 0 then
603 raise Exception.Create(SInvalidOperationInTrans);
604 FAutoCommit := Value;
607 if FConnection <> nil then
608 FConnection.SetAutoCommit(Value);
616 Sets transact isolation level.
617 @param Value a transact isolation level.
619 procedure TZAbstractConnection.SetTransactIsolationLevel(
620 Value: TZTransactIsolationLevel);
622 if FTransactIsolationLevel <> Value then
624 FTransactIsolationLevel := Value;
627 if FConnection <> nil then
628 FConnection.SetTransactionIsolation(Value);
636 Gets a ZDBC driver for the specified protocol.
637 @returns a ZDBC driver interface.
639 function TZAbstractConnection.GetDbcDriver: IZDriver;
641 if FConnection <> nil then
642 Result := FConnection.GetDriver
644 Result := DriverManager.GetDriver(ConstructURL('', ''));
648 Checks is the connection started a transaction.
649 @returns <code>True</code> if connection in manual transaction mode
650 and transaction is started.
652 function TZAbstractConnection.GetInTransaction: Boolean;
655 Result := not FAutoCommit or (FExplicitTransactionCounter > 0);
659 Gets client's full version number.
660 The format of the version resturned must be XYYYZZZ where
664 @return this clients's full version number
666 function TZAbstractConnection.GetClientVersion: Integer;
668 if FConnection <> nil then
669 Result := DbcConnection.GetClientVersion
671 Result := DriverManager.GetClientVersion(ConstructURL('', ''));
675 Gets server's full version number.
676 The format of the version resturned must be XYYYZZZ where
680 @return this clients's full version number
682 function TZAbstractConnection.GetServerVersion: Integer;
685 Result := DbcConnection.GetHostVersion;
689 Gets client's full version number.
690 The format of the version resturned must be XYYYZZZ where
694 @return this clients's full version number
696 function TZAbstractConnection.GetClientVersionStr: String;
698 Result := FormatSQLVersion(GetClientVersion);
702 Gets server's full version number.
703 The format of the version resturned must be XYYYZZZ where
707 @return this clients's full version number
709 function TZAbstractConnection.GetServerVersionStr: String;
711 Result := FormatSQLVersion(GetServerVersion);
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.
720 function TZAbstractConnection.ConstructURL(const UserName, Password: string): string;
722 Result := DriverManager.ConstructURL(FURL.Protocol, FURL.HostName, FURL.Database, UserName,
723 Password, FURL.Port, FURL.Properties, FURL.LibLocation);
727 Fires an event before connection open
729 procedure TZAbstractConnection.DoBeforeConnect;
731 if Assigned(FBeforeConnect) then
732 FBeforeConnect(Self);
736 Fires an event after connection open
738 procedure TZAbstractConnection.DoAfterConnect;
740 if Assigned(FAfterConnect) then
745 Fires an event before connection close
747 procedure TZAbstractConnection.DoBeforeDisconnect;
749 if Assigned(FBeforeDisconnect) then
750 FBeforeDisconnect(Self);
754 Fires an event after connection close
756 procedure TZAbstractConnection.DoAfterDisconnect;
758 if Assigned(FAfterDisconnect) then
759 FAfterDisconnect(Self);
763 Fires an event before reconnect
765 procedure TZAbstractConnection.DoBeforeReconnect;
767 if Assigned(FBeforeReconnect) then
768 FBeforeReconnect(Self);
772 Fires an event after reconnect
774 procedure TZAbstractConnection.DoAfterReconnect;
776 if Assigned(FAfterReconnect) then
777 FAfterReconnect(Self);
781 Fires an event after transaction commit
783 procedure TZAbstractConnection.DoCommit;
785 if Assigned(FOnCommit) then
790 Fires an event after transaction rollback
792 procedure TZAbstractConnection.DoRollback;
794 if Assigned(FOnRollback) then
799 Fires an event after transaction start
801 procedure TZAbstractConnection.DoStartTransaction;
803 if Assigned(FOnStartTransaction) then
804 FOnStartTransaction(Self);
808 Establish a connection with database.
810 procedure TZAbstractConnection.Connect;
812 //Local variables declared in order to preserve the original property value
813 //and to avoid the storage of password
814 Username, Password: string;
816 if FConnection = nil then
818 // Fixes Zeos Bug 00056
822 //This is here to support aborting the Connection in BeforeConnect event without fatal errors
827 UserName := FURL.UserName;
828 Password := FURL.Password;
833 if Assigned(FOnLogin) then
834 FOnLogin(Self, UserName, Password)
837 if Assigned(LoginDialogProc) then
839 if not LoginDialogProc(FURL.Database, UserName, Password) then
843 raise Exception.Create(SLoginPromptFailure);
849 FConnection := DriverManager.GetConnectionWithParams(
850 ConstructURL(UserName, Password), FURL.Properties);
854 SetAutoCommit(FAutoCommit);
855 SetReadOnly(FReadOnly);
856 SetCatalog(FCatalog);
857 SetTransactionIsolation(FTransactIsolationLevel);
858 SetUseMetadata(FUseMetadata);
860 {$IFDEF ZEOS_TEST_ONLY}
861 SetTestMode(FTestMode);
872 if not FConnection.IsClosed then
878 Closes and removes the connection with database
880 procedure TZAbstractConnection.Disconnect;
882 if FConnection <> nil then
889 // Modified by cipto 8/2/2007 10:11:02 AM
903 Sends a ping to the server.
905 function TZAbstractConnection.Ping: Boolean;
907 Result := (FConnection <> nil) and (FConnection.PingServer=0);
911 Reconnect, doesn't destroy DataSets if successful.
913 procedure TZAbstractConnection.Reconnect;
915 if FConnection <> nil then
936 {** Checks if this connection is active.
938 procedure TZAbstractConnection.CheckConnected;
940 if FConnection = nil then
941 raise EZDatabaseError.Create(SConnectionIsNotOpened);
945 Checks if this connection is in auto-commit mode.
947 procedure TZAbstractConnection.CheckNonAutoCommitMode;
950 raise EZDatabaseError.Create(SInvalidOpInAutoCommit);
954 Checks if this connection is in auto-commit mode.
956 procedure TZAbstractConnection.CheckAutoCommitMode;
958 if not FAutoCommit and (FExplicitTransactionCounter = 0) then
959 raise EZDatabaseError.Create(SInvalidOpInNonAutoCommit);
963 Commits the current transaction.
965 procedure TZAbstractConnection.StartTransaction;
969 if FExplicitTransactionCounter = 0 then
972 Inc(FExplicitTransactionCounter);
976 Commits the current transaction.
978 type //To get protected methodes
979 THack_ZAbstractDataset = Class(TZAbstractDataset);
980 procedure TZAbstractConnection.Commit;
982 ExplicitTran: Boolean;
986 CheckNonAutoCommitMode;
988 ExplicitTran := FExplicitTransactionCounter > 0;
989 if FExplicitTransactionCounter < 2 then
990 //when 0 then AutoCommit was turned off, when 1 StartTransaction was used
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;
1001 FExplicitTransactionCounter := 0;
1002 if ExplicitTran then
1011 Dec(FExplicitTransactionCounter);
1014 procedure TZAbstractConnection.CommitPrepared(const transactionid: string);
1016 oldlev: TZTransactIsolationLevel;
1018 CheckAutoCommitMode;
1019 oldlev := TransactIsolationLevel;
1020 TransactIsolationLevel := tiNone;
1021 FConnection.CommitPrepared(transactionid);
1022 TransactIsolationLevel := oldLev;
1026 Rollbacks the current transaction.
1028 procedure TZAbstractConnection.Rollback;
1030 ExplicitTran: Boolean;
1033 CheckNonAutoCommitMode;
1035 ExplicitTran := FExplicitTransactionCounter > 0;
1036 if FExplicitTransactionCounter < 2 then
1037 //when 0 then AutoCommit was turned off, when 1 StartTransaction was used
1042 FConnection.RollBack;
1044 FExplicitTransactionCounter := 0;
1045 if ExplicitTran then
1054 Dec(FExplicitTransactionCounter);
1057 procedure TZAbstractConnection.RollbackPrepared(const transactionid: string);
1059 oldlev: TZTransactIsolationLevel;
1061 CheckAutoCommitMode;
1062 oldlev := TransactIsolationLevel;
1063 TransactIsolationLevel := tiNone;
1064 FConnection.RollbackPrepared(transactionid);
1065 TransactIsolationLevel := oldLev;
1069 Processes component notifications.
1070 @param AComponent a changed component object.
1071 @param Operation a component operation code.
1073 procedure TZAbstractConnection.Notification(AComponent: TComponent;
1074 Operation: TOperation);
1076 inherited Notification(AComponent, Operation);
1078 if (Operation = opRemove) then
1080 if (AComponent is TDataset) then
1081 UnregisterDataSet(TDataset(AComponent));
1082 if (AComponent is TZSequence) then
1083 UnregisterSequence(TZSequence(AComponent));
1087 Function TZAbstractConnection.PingServer: Boolean;
1089 LastState : boolean;
1092 // Check connection status
1093 LastState := GetConnected;
1094 If FConnection <> Nil Then
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);
1103 // Connection now is false but was true
1105 SetConnected(false);
1108 procedure TZAbstractConnection.PrepareTransaction(const transactionid: string);
1110 ExplicitTran: Boolean;}
1113 CheckNonAutoCommitMode;
1114 if FExplicitTransactionCounter <> 1 then
1116 raise EZDatabaseError.Create(SInvalidOpPrepare);
1121 FConnection.PrepareTransaction(transactionid);
1123 FExplicitTransactionCounter := 0;
1133 Closes all registered datasets.
1135 procedure TZAbstractConnection.CloseAllDataSets;
1138 Current: TZAbstractRODataset;
1140 for I := 0 to FDatasets.Count - 1 do
1142 Current := TZAbstractRODataset(FDatasets[I]);
1153 Registers a new dataset object.
1154 @param DataSet a new dataset to be registered.
1156 procedure TZAbstractConnection.RegisterDataSet(DataSet: TDataset);
1158 FDatasets.Add(DataSet);
1162 Unregisters a new dataset object.
1163 @param DataSet a new dataset to be unregistered.
1165 procedure TZAbstractConnection.UnregisterDataSet(DataSet: TDataset);
1167 FDatasets.Remove(DataSet);
1171 Unregisters all dataset objects.
1173 procedure TZAbstractConnection.UnregisterAllDataSets;
1176 Current: TZAbstractRODataset;
1178 for I := FDatasets.Count - 1 downto 0 do
1180 Current := TZAbstractRODataset(FDatasets[I]);
1181 FDatasets.Remove(Current);
1183 Current.Connection := nil;
1191 Turn on sql hourglass cursor
1193 procedure TZAbstractConnection.ShowSQLHourGlass;
1195 if not FSqlHourGlass then
1198 if SqlHourGlassLock = 0 then
1200 if Assigned(DBScreen) then
1202 CursorBackup := DBScreen.Cursor;
1203 if CursorBackup <> dcrOther then
1204 DBScreen.Cursor := dcrSQLWait;
1207 Inc(SqlHourGlassLock);
1211 Turn off sql hourglass cursor
1213 procedure TZAbstractConnection.HideSQLHourGlass;
1215 if not FSqlHourGlass then
1218 if SqlHourGlassLock > 0 then
1219 Dec(SqlHourGlassLock);
1220 if SqlHourGlassLock = 0 then
1222 if CursorBackup <> dcrOther then
1223 if Assigned(DBScreen) then
1224 DBScreen.Cursor := CursorBackup;
1229 Fills string list with registered protocol names.
1230 @param List a string list to fill out.
1232 procedure TZAbstractConnection.GetProtocolNames(List: TStrings);
1235 Drivers: IZCollection;
1237 Protocols: TStringDynArray;
1240 Protocols := nil; // Makes compiler happy
1241 Drivers := DriverManager.GetDrivers;
1242 for I := 0 to Drivers.Count - 1 do
1244 Driver := Drivers[I] as IZDriver;
1245 Protocols := Driver.GetSupportedProtocols;
1246 for J := Low(Protocols) to High(Protocols) do
1247 List.Add(Protocols[J]);
1252 Fills string list with catalog names.
1253 @param List a string list to fill out.
1255 procedure TZAbstractConnection.GetCatalogNames(List: TStrings);
1257 Metadata: IZDatabaseMetadata;
1258 ResultSet: IZResultSet;
1263 Metadata := DbcConnection.GetMetadata;
1264 ResultSet := Metadata.GetCatalogs;
1265 while ResultSet.Next do
1266 List.Add(ResultSet.GetStringByName('TABLE_CAT'));
1270 Fills string list with schema names.
1271 @param List a string list to fill out.
1273 procedure TZAbstractConnection.GetSchemaNames(List: TStrings);
1275 Metadata: IZDatabaseMetadata;
1276 ResultSet: IZResultSet;
1281 Metadata := DbcConnection.GetMetadata;
1282 ResultSet := Metadata.GetSchemas;
1283 while ResultSet.Next do
1284 List.Add(ResultSet.GetStringByName('TABLE_SCHEM'));
1288 Fills string list with table names.
1289 @param Pattern a pattern for table names.
1290 @param List a string list to fill out.
1292 procedure TZAbstractConnection.GetTableNames(const Pattern: string; List: TStrings);
1294 GetTableNames('', Pattern, nil, List);
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.
1303 procedure TZAbstractConnection.GetTableNames(const schemaPattern, tablePattern: string; List: TStrings);
1305 GetTableNames(schemaPattern, tablePattern, nil,List);
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',
1320 @param List a string list to fill out.
1322 procedure TZAbstractConnection.GetTableNames(const schemaPattern, tablePattern: string; Types: TStringDynArray; List: TStrings);
1324 Metadata: IZDatabaseMetadata;
1325 ResultSet: IZResultSet;
1330 Metadata := DbcConnection.GetMetadata;
1331 ResultSet := Metadata.GetTables('', schemaPattern, tablePattern, types);
1332 while ResultSet.Next do
1333 List.Add(ResultSet.GetStringByName('TABLE_NAME'));
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.
1342 procedure TZAbstractConnection.GetColumnNames(const TablePattern, ColumnPattern: string; List: TStrings);
1344 Metadata: IZDatabaseMetadata;
1345 ResultSet: IZResultSet;
1349 Metadata := DbcConnection.GetMetadata;
1350 ResultSet := Metadata.GetColumns('', '', TablePattern, ColumnPattern);
1351 while ResultSet.Next do
1352 List.Add(ResultSet.GetStringByName('COLUMN_NAME'));
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.
1360 procedure TZAbstractConnection.GetStoredProcNames(const Pattern: string;
1363 Metadata: IZDatabaseMetadata;
1364 ResultSet: IZResultSet;
1369 Metadata := DbcConnection.GetMetadata;
1370 ResultSet := Metadata.GetProcedures('', '', Pattern);
1371 while ResultSet.Next do
1372 List.Add(ResultSet.GetStringByName('PROCEDURE_NAME'));
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
1381 procedure TZAbstractConnection.GetTriggerNames(const TablePattern,
1382 SchemaPattern: string; List: TStrings);
1387 with DbcConnection.GetMetadata.GetTriggers('', SchemaPattern, TablePattern, '') do
1390 List.Add(GetStringByName('TRIGGER_NAME'));
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|<~
1401 function TZAbstractConnection.GetBinaryEscapeStringFromString(const BinaryString: AnsiString): String;
1405 if Assigned(FConnection) then
1406 Result := FConnection.GetBinaryEscapeString(BinaryString);
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|<~
1415 function TZAbstractConnection.GetBinaryEscapeStringFromStream(const Stream: TStream): String;
1419 TempAnsi: AnsiString;
1423 if Assigned(FConnection) then
1425 if Assigned(Stream) then
1427 FBlobSize := Stream.Size;
1428 if FBlobSize > 0 then
1430 GetMem(FBlobData, FBlobSize);
1431 Stream.Position := 0;
1432 Stream.ReadBuffer(FBlobData^, FBlobSize);
1442 if (FBlobSize > 0) and Assigned(FBlobData) then
1443 System.SetString(TempAnsi, PAnsiChar(FBlobData), FBlobSize)
1446 if Assigned(FBlobData) then
1449 Result := FConnection.GetBinaryEscapeString(TempAnsi);
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|<~
1459 function TZAbstractConnection.GetBinaryEscapeStringFromFile(const FileName: String): String;
1461 FStream: TFileStream;
1465 if FileExists(FileName) then
1467 FStream := TFileStream.Create(FileName, fmOpenRead);
1468 Result := GetBinaryEscapeStringFromStream(FStream);
1469 FreeAndNil(FStream);
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|<~
1479 function TZAbstractConnection.GetAnsiEscapeString(const Ansi: AnsiString): String;
1481 Result := DbcConnection.GetDriver.GetTokenizer.GetEscapeString(String(Ansi));
1484 function TZAbstractConnection.GetURL: String;
1486 Result := ConstructURL(FURL.UserName, FURL.Password);
1489 function TZAbstractConnection.GetAutoEncode: Boolean;
1494 {$IF defined(MSWINDOWS) or defined(WITH_LCONVENCODING) or defined(FPC_HAS_BUILTIN_WIDESTR_MANAGER)}
1497 Result := DbcConnection.GetConSettings.AutoEncode;
1498 FAutoEncode := Result;
1501 Result := FAutoEncode;
1508 procedure TZAbstractConnection.SetAutoEncode(Value: Boolean);
1511 {$IF defined(MSWINDOWS) or defined(WITH_LCONVENCODING) or defined(FPC_HAS_BUILTIN_WIDESTR_MANAGER)}
1513 FURL.Properties.Values['AutoEncodeStrings'] := 'ON'
1515 FURL.Properties.Values['AutoEncodeStrings'] := '';
1517 if Value <> FAutoEncode then
1519 FAutoEncode := Value;
1520 if Self.Connected then
1527 FURL.Properties.Values['AutoEncodeStrings'] := '';
1533 Returns the current version of zeosdbo.
1535 function TZAbstractConnection.GetVersion: string;
1537 Result := ZEOS_VERSION;
1540 procedure TZAbstractConnection.SetUseMetadata(AValue: Boolean);
1542 if FUseMetaData=AValue then Exit;
1543 FUseMetaData:=AValue;
1544 if FConnection <> nil then
1545 FConnection.SetUseMetadata(FUseMetadata);
1548 procedure TZAbstractConnection.SetControlsCodePage(const Value: TZControlsCodePage);
1555 Properties.values['controls_cp'] := 'CP_UTF16';
1556 FControlsCodePage := Value;
1560 Properties.values['controls_cp'] := 'CP_UTF16';
1561 FControlsCodePage := cCP_UTF16;
1565 Properties.values['controls_cp'] := 'GET_ACP';
1566 FControlsCodePage := Value;
1570 {$IFDEF WITH_WIDEFIELDS}
1574 Properties.values['controls_cp'] := 'CP_UTF16';
1575 FControlsCodePage := Value;
1579 Properties.values['controls_cp'] := 'CP_UTF8';
1580 FControlsCodePage := Value;
1583 if ZDefaultSystemCodePage = zCP_UTF8 then
1585 Properties.values['controls_cp'] := 'CP_UTF8';
1586 FControlsCodePage := cCP_UTF8;
1590 Properties.values['controls_cp'] := 'GET_ACP';
1591 FControlsCodePage := Value;
1594 {$ELSE} //D7 or old FPC
1598 Properties.values['controls_cp'] := 'CP_UTF8';
1599 FControlsCodePage := cCP_UTF8;
1603 Properties.values['controls_cp'] := 'CP_UTF8';
1604 FControlsCodePage := Value;
1607 if ZDefaultSystemCodePage = zCP_UTF8 then
1609 Properties.values['controls_cp'] := 'CP_UTF8';
1610 FControlsCodePage := cCP_UTF8;
1614 Properties.values['controls_cp'] := 'GET_ACP';
1615 FControlsCodePage := Value;
1622 if Value <> FControlsCodePage then
1633 procedure TZAbstractConnection.SetVersion(const Value: string);
1637 procedure TZAbstractConnection.CloseAllSequences;
1640 Current: TZSequence;
1642 for I := 0 to FSequences.Count - 1 do
1644 Current := TZSequence(FSequences[I]);
1646 Current.CloseSequence;
1653 procedure TZAbstractConnection.RegisterSequence(Sequence: TComponent);
1655 FSequences.Add(TZSequence(Sequence));
1658 procedure TZAbstractConnection.UnregisterSequence(Sequence: TComponent);
1660 if Assigned(FSequences) then
1661 FSequences.Remove(TZSequence(Sequence));
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.
1669 function TZAbstractConnection.ExecuteDirect(SQL : String) : boolean;
1673 result:= ExecuteDirect(SQL,dummy);
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.
1682 function TZAbstractConnection.ExecuteDirect(SQL: string;
1683 var RowsAffected: integer):boolean;
1690 stmt := DbcConnection.CreateStatement;
1691 RowsAffected:= stmt.ExecuteUpdate(SQL);
1692 result := (RowsAffected <> -1);
1696 raise; {------ added by Henk 09-10-2012 --------}
1704 SqlHourGlassLock := 0;