00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { Database Connection Component }
00005 { }
00006 { Originally written by Sergey Seroukhov }
00007 { }
00008 {*********************************************************}
00009
00010 {@********************************************************}
00011 { Copyright (c) 1999-2006 Zeos Development Group }
00012 { }
00013 { License Agreement: }
00014 { }
00015 { This library is distributed in the hope that it will be }
00016 { useful, but WITHOUT ANY WARRANTY; without even the }
00017 { implied warranty of MERCHANTABILITY or FITNESS FOR }
00018 { A PARTICULAR PURPOSE. See the GNU Lesser General }
00019 { Public License for more details. }
00020 { }
00021 { The source code of the ZEOS Libraries and packages are }
00022 { distributed under the Library GNU General Public }
00023 { License (see the file COPYING / COPYING.ZEOS) }
00024 { with the following modification: }
00025 { As a special exception, the copyright holders of this }
00026 { library give you permission to link this library with }
00027 { independent modules to produce an executable, }
00028 { regardless of the license terms of these independent }
00029 { modules, and to copy and distribute the resulting }
00030 { executable under terms of your choice, provided that }
00031 { you also meet, for each linked independent module, }
00032 { the terms and conditions of the license of that module. }
00033 { An independent module is a module which is not derived }
00034 { from or based on this library. If you modify this }
00035 { library, you may extend this exception to your version }
00036 { of the library, but you are not obligated to do so. }
00037 { If you do not wish to do so, delete this exception }
00038 { statement from your version. }
00039 { }
00040 { }
00041 { The project web site is located on: }
00042 { http:
00043 { http:
00044 { svn:
00045 { }
00046 { http:
00047 { http:
00048 { }
00049 { }
00050 { }
00051 { Zeos Development Group. }
00052 {********************************************************@}
00053
00054 unit ZConnection;
00055
00056 interface
00057
00058 {$I ZComponent.inc}
00059
00060 uses
00061 {$IFNDEF VER130BELOW}
00062 Types,
00063 {$ENDIF}
00064 {$IFNDEF UNIX}
00065 {$IFDEF ENABLE_ADO}
00066 ZDbcAdo,
00067 {$ENDIF}
00068 {$ENDIF}
00069 {$IFDEF ENABLE_DBLIB}
00070 ZDbcDbLib,
00071 {$ENDIF}
00072 {$IFDEF ENABLE_MYSQL}
00073 ZDbcMySql,
00074 {$ENDIF}
00075 {$IFDEF ENABLE_POSTGRESQL}
00076 ZDbcPostgreSql,
00077 {$ENDIF}
00078 {$IFDEF ENABLE_INTERBASE}
00079 ZDbcInterbase6,
00080 {$ENDIF}
00081 {$IFDEF ENABLE_SQLITE}
00082 ZDbcSqLite,
00083 {$ENDIF}
00084 {$IFDEF ENABLE_ORACLE}
00085 ZDbcOracle,
00086 {$ENDIF}
00087 {$IFDEF ENABLE_ASA}
00088 ZDbcASA,
00089 {$ENDIF}
00090 {$IFDEF FPC}
00091 SysUtils, Classes, ZDbcIntfs, DB,ZCompatibility;
00092 {$ELSE}
00093 {$IFNDEF VER180}
00094 SysUtils, Classes, ZDbcIntfs, DB,ZCompatibility;
00095 {$ELSE}
00096 SysUtils, Classes, ZDbcIntfs, DB,ZCompatibility,dbcommontypes;
00097 {$ENDIF}
00098 {$ENDIF}
00099
00100
00101 type
00102
00103 TZLoginEvent = procedure(Sender: TObject; var Username:string ; var Password: string) of object;
00104
00105 {** Represents a component which wraps a connection to database. }
00106 TZConnection = class(TComponent)
00107 private
00108 function GetVersion: string;
00109 procedure SetVersion(const Value: string);
00110 protected
00111 FProtocol: string;
00112 FHostName: string;
00113 FPort: Integer;
00114 FDatabase: string;
00115 FUser: string;
00116 FPassword: string;
00117 FCatalog: string;
00118 FProperties: TStrings;
00119 FAutoCommit: Boolean;
00120 FReadOnly: Boolean;
00121 FTransactIsolationLevel: TZTransactIsolationLevel;
00122 FConnection: IZConnection;
00123 FDatasets: TList;
00124
00125 FSequences: TList;
00126
00127 FLoginPrompt: Boolean;
00128 FStreamedConnected: Boolean;
00129 FExplicitTransactionCounter: Integer;
00130 FSQLHourGlass: Boolean;
00131 FDesignConnection: Boolean;
00132
00133 FBeforeConnect: TNotifyEvent;
00134 FBeforeDisconnect: TNotifyEvent;
00135 FAfterDisconnect: TNotifyEvent;
00136 FAfterConnect: TNotifyEvent;
00137 FBeforeReconnect: TNotifyEvent;
00138 FAfterReconnect: TNotifyEvent;
00139 FOnCommit: TNotifyEvent;
00140 FOnRollback: TNotifyEvent;
00141 FOnStartTransaction: TNotifyEvent;
00142
00143
00144 FOnLogin: TZLoginEvent;
00145
00146 function GetConnected: Boolean;
00147 procedure SetConnected(Value: Boolean);
00148 procedure SetProperties(Value: TStrings);
00149 procedure SetTransactIsolationLevel(Value: TZTransactIsolationLevel);
00150 procedure SetAutoCommit(Value: Boolean);
00151 function GetDbcDriver: IZDriver;
00152 function GetInTransaction: Boolean;
00153 function GetClientVersion: Integer;
00154 function GetServerVersion: Integer;
00155 function GetClientVersionStr: String;
00156 function GetServerVersionStr: String;
00157 procedure DoBeforeConnect;
00158 procedure DoAfterConnect;
00159 procedure DoBeforeDisconnect;
00160 procedure DoAfterDisconnect;
00161 procedure DoBeforeReconnect;
00162 procedure DoAfterReconnect;
00163 procedure DoCommit;
00164 procedure DoRollback;
00165 procedure DoStartTransaction;
00166
00167 procedure CheckConnected;
00168 procedure CheckAutoCommitMode;
00169 procedure CheckNonAutoCommitMode;
00170
00171 function ConstructURL(const UserName, Password: string): string;
00172
00173 procedure CloseAllDataSets;
00174 procedure UnregisterAllDataSets;
00175
00176
00177 procedure CloseAllSequences;
00178
00179
00180 procedure Notification(AComponent: TComponent;
00181 Operation: TOperation); override;
00182 procedure Loaded; override;
00183
00184 property StreamedConnected: Boolean read FStreamedConnected write FStreamedConnected;
00185
00186 public
00187 constructor Create(AOwner: TComponent); override;
00188 destructor Destroy; override;
00189
00190 procedure Connect; virtual;
00191 procedure Disconnect; virtual;
00192 procedure Reconnect;
00193 function Ping: Boolean; virtual;
00194
00195 procedure StartTransaction; virtual;
00196 procedure Commit; virtual;
00197 procedure Rollback; virtual;
00198
00199 procedure PrepareTransaction(const transactionid: string); virtual;
00200 procedure CommitPrepared(const transactionid: string); virtual;
00201 procedure RollbackPrepared(const transactionid: string); virtual;
00202 function PingServer: Boolean; virtual;
00203
00204 procedure RegisterDataSet(DataSet: TDataset);
00205 procedure UnregisterDataSet(DataSet: TDataset);
00206 function ExecuteDirect(SQL:string):boolean;overload;
00207 function ExecuteDirect(SQL:string; var RowsAffected:integer):boolean;overload;
00208
00209 procedure RegisterSequence(Sequence: TComponent);
00210 procedure UnregisterSequence(Sequence: TComponent);
00211
00212
00213 procedure GetProtocolNames(List: TStrings);
00214 procedure GetCatalogNames(List: TStrings);
00215 procedure GetSchemaNames(List: TStrings);
00216 procedure GetTableNames(const Pattern: string; List: TStrings);overload;
00217 procedure GetTableNames(const tablePattern,schemaPattern: string; List: TStrings);overload;
00218 procedure GetColumnNames(const TablePattern, ColumnPattern: string; List: TStrings);
00219
00220 procedure GetStoredProcNames(const Pattern: string; List: TStrings);
00221
00222 property InTransaction: Boolean read GetInTransaction;
00223
00224 property DbcDriver: IZDriver read GetDbcDriver;
00225 property DbcConnection: IZConnection read FConnection;
00226 property ClientVersion: Integer read GetClientVersion;
00227 property ServerVersion: Integer read GetServerVersion;
00228 property ClientVersionStr: String read GetClientVersionStr;
00229 property ServerVersionStr: String read GetServerVersionStr;
00230 procedure ShowSQLHourGlass;
00231 procedure HideSQLHourGlass;
00232
00233 published
00234 property Protocol: string read FProtocol write FProtocol;
00235 property HostName: string read FHostName write FHostName;
00236 property Port: Integer read FPort write FPort default 0;
00237 property Database: string read FDatabase write FDatabase;
00238 property User: string read FUser write FUser;
00239 property Password: string read FPassword write FPassword;
00240 property Catalog: string read FCatalog write FCatalog;
00241 property Properties: TStrings read FProperties write SetProperties;
00242 property AutoCommit: Boolean read FAutoCommit write SetAutoCommit
00243 default True;
00244 property ReadOnly: Boolean read FReadOnly write FReadOnly
00245 default False;
00246 property TransactIsolationLevel: TZTransactIsolationLevel
00247 read FTransactIsolationLevel write SetTransactIsolationLevel
00248 default tiNone;
00249 property Connected: Boolean read GetConnected write SetConnected
00250 default False;
00251 property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt
00252 default False;
00253 property Version: string read GetVersion write SetVersion stored False;
00254 property DesignConnection: Boolean read FDesignConnection
00255 write FDesignConnection default False;
00256
00257 property BeforeConnect: TNotifyEvent
00258 read FBeforeConnect write FBeforeConnect;
00259 property AfterConnect: TNotifyEvent
00260 read FAfterConnect write FAfterConnect;
00261 property BeforeDisconnect: TNotifyEvent
00262 read FBeforeDisconnect write FBeforeDisconnect;
00263 property AfterDisconnect: TNotifyEvent
00264 read FAfterDisconnect write FAfterDisconnect;
00265 property BeforeReconnect: TNotifyEvent
00266 read FBeforeReconnect write FBeforeReconnect;
00267 property AfterReconnect: TNotifyEvent
00268 read FAfterReconnect write FAfterReconnect;
00269 property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass
00270 default False;
00271 property OnCommit: TNotifyEvent read FOnCommit write FOnCommit;
00272 property OnRollback: TNotifyEvent read FOnRollback write FOnRollback;
00273
00274
00275 property OnLogin: TZLoginEvent read FOnLogin write FOnLogin;
00276 property OnStartTransaction: TNotifyEvent
00277 read FOnStartTransaction write FOnStartTransaction;
00278 end;
00279
00280 implementation
00281
00282 uses ZMessages, ZClasses, ZAbstractRODataset, ZSysUtils,
00283
00284 ZSequence;
00285
00286 var
00287 SqlHourGlassLock: Integer;
00288 CursorBackup: TDBScreenCursor;
00289
00290 { TZConnection }
00291
00292 {**
00293 Constructs this component and assignes the main properties.
00294 @param AOwner an owner component.
00295 }
00296 constructor TZConnection.Create(AOwner: TComponent);
00297 begin
00298 inherited Create(AOwner);
00299 FAutoCommit := True;
00300 FReadOnly := False;
00301 FTransactIsolationLevel := tiNone;
00302 FConnection := nil;
00303 FProperties := TStringList.Create;
00304 FDatasets := TList.Create;
00305
00306 FSequences:= TList.Create;
00307 FLoginPrompt := False;
00308 FDesignConnection := False;
00309 end;
00310
00311 {**
00312 Destroys this component and cleanups the memory.
00313 }
00314 destructor TZConnection.Destroy;
00315 begin
00316 Disconnect;
00317 UnregisterAllDataSets;
00318 FProperties.Free;
00319 FDatasets.Free;
00320
00321 FSequences.Clear;
00322 FSequences.Free;
00323
00324 inherited Destroy;
00325 end;
00326
00327 {**
00328 This methode is required to support proper component initialization.
00329 Without it, the connection can start connecting before every property is loaded!
00330 }
00331 procedure TZConnection.Loaded;
00332 begin
00333 inherited Loaded;
00334 try
00335 if FStreamedConnected then
00336 if (csDesigning in ComponentState) or not FDesignConnection then
00337 SetConnected(True);
00338 except
00339 if csDesigning in ComponentState then
00340 {$IFNDEF VER130BELOW}
00341 if Assigned(Classes.ApplicationHandleException) then
00342 Classes.ApplicationHandleException(ExceptObject)
00343 else
00344 {$ENDIF}
00345 ShowException(ExceptObject, ExceptAddr)
00346 else
00347 raise;
00348 end;
00349 end;
00350
00351 {**
00352 Gets an open connection flag.
00353 @return <code>True</code> if the connection is open
00354 or <code>False</code> otherwise.
00355 }
00356 function TZConnection.GetConnected: Boolean;
00357 begin
00358 Result := (FConnection <> nil) and not FConnection.IsClosed;
00359 end;
00360
00361 {**
00362 Sets a new open connection flag.
00363 @param Value <code>True</code> to open the connection
00364 and <code>False</code> to close it.
00365 }
00366 procedure TZConnection.SetConnected(Value: Boolean);
00367 begin
00368 if (csReading in ComponentState) and Value then
00369 FStreamedConnected := True
00370 else
00371 begin
00372 if Value <> GetConnected then
00373 begin
00374 if Value then Connect
00375 else Disconnect;
00376 end;
00377 end;
00378 end;
00379
00380 {**
00381 Sets a new connection properties.
00382 @param Value a list with new connection properties.
00383 }
00384 procedure TZConnection.SetProperties(Value: TStrings);
00385 begin
00386 if Value <> nil then
00387 FProperties.Text := Value.Text
00388 else FProperties.Clear;
00389 end;
00390
00391 {**
00392 Sets autocommit flag.
00393 @param Value <code>True</code> to turn autocommit on.
00394 }
00395 procedure TZConnection.SetAutoCommit(Value: Boolean);
00396 begin
00397 if FAutoCommit <> Value then
00398 begin
00399 if FExplicitTransactionCounter > 0 then
00400 raise Exception.Create(SInvalidOperationInTrans);
00401 FAutoCommit := Value;
00402 ShowSQLHourGlass;
00403 try
00404 if FConnection <> nil then
00405 FConnection.SetAutoCommit(Value);
00406 finally
00407 HideSqlHourGlass
00408 end;
00409 end;
00410 end;
00411
00412 {**
00413 Sets transact isolation level.
00414 @param Value a transact isolation level.
00415 }
00416 procedure TZConnection.SetTransactIsolationLevel(
00417 Value: TZTransactIsolationLevel);
00418 begin
00419 if FTransactIsolationLevel <> Value then
00420 begin
00421 FTransactIsolationLevel := Value;
00422 ShowSqlhourGlass;
00423 try
00424 if FConnection <> nil then
00425 FConnection.SetTransactionIsolation(Value);
00426 finally
00427 HideSqlHourGlass
00428 end;
00429 end;
00430 end;
00431
00432 {**
00433 Gets a ZDBC driver for the specified protocol.
00434 @returns a ZDBC driver interface.
00435 }
00436 function TZConnection.GetDbcDriver: IZDriver;
00437 begin
00438 if FConnection <> nil then
00439 Result := FConnection.GetDriver
00440 else Result := DriverManager.GetDriver(ConstructURL('', ''));
00441 end;
00442
00443 {**
00444 Checks is the connection started a transaction.
00445 @returns <code>True</code> if connection in manual transaction mode
00446 and transaction is started.
00447 }
00448 function TZConnection.GetInTransaction: Boolean;
00449 begin
00450 CheckConnected;
00451 Result := not FAutoCommit or (FExplicitTransactionCounter > 0);
00452 end;
00453
00454 {**
00455 Gets client's full version number.
00456 The format of the version resturned must be XYYYZZZ where
00457 X = Major version
00458 YYY = Minor version
00459 ZZZ = Sub version
00460 @return this clients's full version number
00461 }
00462 function TZConnection.GetClientVersion: Integer;
00463 begin
00464 if FConnection <> nil then
00465 Result := DbcConnection.GetClientVersion
00466 else
00467 Result := DriverManager.GetClientVersion(ConstructURL('', ''));
00468 end;
00469
00470 {**
00471 Gets server's full version number.
00472 The format of the version resturned must be XYYYZZZ where
00473 X = Major version
00474 YYY = Minor version
00475 ZZZ = Sub version
00476 @return this clients's full version number
00477 }
00478 function TZConnection.GetServerVersion: Integer;
00479 begin
00480 CheckConnected;
00481 Result := DbcConnection.GetHostVersion;
00482 end;
00483
00484 {**
00485 Gets client's full version number.
00486 The format of the version resturned must be XYYYZZZ where
00487 X = Major version
00488 YYY = Minor version
00489 ZZZ = Sub version
00490 @return this clients's full version number
00491 }
00492 function TZConnection.GetClientVersionStr: String;
00493 begin
00494 Result := FormatSQLVersion(GetClientVersion);
00495 end;
00496
00497 {**
00498 Gets server's full version number.
00499 The format of the version resturned must be XYYYZZZ where
00500 X = Major version
00501 YYY = Minor version
00502 ZZZ = Sub version
00503 @return this clients's full version number
00504 }
00505 function TZConnection.GetServerVersionStr: String;
00506 begin
00507 Result := FormatSQLVersion(GetServerVersion);
00508 end;
00509
00510 {**
00511 Constructs ZDBC connection URL string.
00512 @param UserName a name of the user.
00513 @param Password a user password.
00514 @returns a constructed connection URL.
00515 }
00516 function TZConnection.ConstructURL(const UserName, Password: string): string;
00517 begin
00518 if Port <> 0 then
00519 begin
00520 Result := Format('zdbc:%s://%s:%d/%s?UID=%s;PWD=%s', [FProtocol, FHostName,
00521 FPort, FDatabase, UserName, Password]);
00522 end
00523 else
00524 begin
00525 Result := Format('zdbc:%s://%s/%s?UID=%s;PWD=%s', [FProtocol, FHostName,
00526 FDatabase, UserName, Password]);
00527 end;
00528 end;
00529
00530 {**
00531 Fires an event before connection open
00532 }
00533 procedure TZConnection.DoBeforeConnect;
00534 begin
00535 if Assigned(FBeforeConnect) then
00536 FBeforeConnect(Self);
00537 end;
00538
00539 {**
00540 Fires an event after connection open
00541 }
00542 procedure TZConnection.DoAfterConnect;
00543 begin
00544 if Assigned(FAfterConnect) then
00545 FAfterConnect(Self);
00546 end;
00547
00548 {**
00549 Fires an event before connection close
00550 }
00551 procedure TZConnection.DoBeforeDisconnect;
00552 begin
00553 if Assigned(FBeforeDisconnect) then
00554 FBeforeDisconnect(Self);
00555 end;
00556
00557 {**
00558 Fires an event after connection close
00559 }
00560 procedure TZConnection.DoAfterDisconnect;
00561 begin
00562 if Assigned(FAfterDisconnect) then
00563 FAfterDisconnect(Self);
00564 end;
00565
00566 {**
00567 Fires an event before reconnect
00568 }
00569 procedure TZConnection.DoBeforeReconnect;
00570 begin
00571 if Assigned(FBeforeReconnect) then
00572 FBeforeReconnect(Self);
00573 end;
00574
00575 {**
00576 Fires an event after reconnect
00577 }
00578 procedure TZConnection.DoAfterReconnect;
00579 begin
00580 if Assigned(FAfterReconnect) then
00581 FAfterReconnect(Self);
00582 end;
00583
00584 {**
00585 Fires an event after transaction commit
00586 }
00587 procedure TZConnection.DoCommit;
00588 begin
00589 if Assigned(FOnCommit) then
00590 FOnCommit(Self);
00591 end;
00592
00593 {**
00594 Fires an event after transaction rollback
00595 }
00596 procedure TZConnection.DoRollback;
00597 begin
00598 if Assigned(FOnRollback) then
00599 FOnRollback(Self);
00600 end;
00601
00602 {**
00603 Fires an event after transaction start
00604 }
00605 procedure TZConnection.DoStartTransaction;
00606 begin
00607 if Assigned(FOnStartTransaction) then
00608 FOnStartTransaction(Self);
00609 end;
00610
00611 {**
00612 Establish a connection with database.
00613 }
00614 procedure TZConnection.Connect;
00615 var
00616
00617
00618 Username, Password: string;
00619 begin
00620 if FConnection = nil then
00621 begin
00622
00623
00624 DoBeforeConnect;
00625
00626
00627
00628
00629
00630
00631 UserName := FUser;
00632 Password := FPassword;
00633
00634 if FLoginPrompt then
00635 begin
00636 { Defines user name }
00637 if UserName = '' then
00638 UserName := FProperties.Values['UID'];
00639 if UserName = '' then
00640 UserName := FProperties.Values['username'];
00641
00642 { Defines user password }
00643 if Password = '' then
00644 Password := FProperties.Values['PWD'];
00645 if Password = '' then
00646 Password := FProperties.Values['password'];
00647
00648 if Assigned(FOnLogin) then
00649 FOnLogin(Self, UserName, Password)
00650 else
00651 begin
00652 if Assigned(LoginDialogProc) then
00653 begin
00654 if not LoginDialogProc(FDatabase, UserName, Password) then
00655 Exit;
00656 end
00657 else
00658 raise Exception.Create(SLoginPromptFailure);
00659 end;
00660 end;
00661
00662 ShowSqlHourGlass;
00663 try
00664 FConnection := DriverManager.GetConnectionWithParams(
00665 ConstructURL(UserName, Password), FProperties);
00666 try
00667 with FConnection do
00668 begin
00669 SetAutoCommit(FAutoCommit);
00670 SetReadOnly(FReadOnly);
00671 SetCatalog(FCatalog);
00672 SetTransactionIsolation(FTransactIsolationLevel);
00673 Open;
00674 end;
00675 except
00676 FConnection := nil;
00677 raise;
00678 end;
00679 finally
00680 HideSqlHourGlass;
00681 end;
00682
00683 if not FConnection.IsClosed then
00684 DoAfterConnect;
00685 end;
00686 end;
00687
00688 {**
00689 Closes and removes the connection with database
00690 }
00691 procedure TZConnection.Disconnect;
00692 begin
00693 if FConnection <> nil then
00694 begin
00695 DoBeforeDisconnect;
00696
00697 ShowSqlHourGlass;
00698 try
00699 CloseAllDataSets;
00700
00701 CloseAllSequences;
00702 FConnection.Close;
00703 finally
00704 FConnection := nil;
00705 HideSqlHourGlass;
00706 end;
00707
00708 DoAfterDisconnect;
00709 end;
00710 end;
00711
00712
00713 {**
00714 Sends a ping to the server.
00715 }
00716 function TZConnection.Ping: Boolean;
00717 begin
00718 Result := (FConnection <> nil) and (FConnection.PingServer=0);
00719 end;
00720
00721 {**
00722 Reconnect, doesn't destroy DataSets if successful.
00723 }
00724 procedure TZConnection.Reconnect;
00725 begin
00726 if FConnection <> nil then
00727 begin
00728 DoBeforeReconnect;
00729
00730 ShowSqlHourGlass;
00731 try
00732 try
00733 FConnection.Close;
00734 FConnection.Open;
00735 except
00736 CloseAllDataSets;
00737 raise;
00738 end;
00739 finally
00740 HideSqlHourGlass;
00741 end;
00742
00743 DoAfterReconnect;
00744 end;
00745 end;
00746
00747 {** Checks if this connection is active.
00748 }
00749 procedure TZConnection.CheckConnected;
00750 begin
00751 if FConnection = nil then
00752 raise EZDatabaseError.Create(SConnectionIsNotOpened);
00753 end;
00754
00755 {**
00756 Checks if this connection is in auto-commit mode.
00757 }
00758 procedure TZConnection.CheckNonAutoCommitMode;
00759 begin
00760 if FAutoCommit then
00761 raise EZDatabaseError.Create(SInvalidOpInAutoCommit);
00762 end;
00763
00764 {**
00765 Checks if this connection is in auto-commit mode.
00766 }
00767 procedure TZConnection.CheckAutoCommitMode;
00768 begin
00769 if not FAutoCommit and (FExplicitTransactionCounter = 0) then
00770 raise EZDatabaseError.Create(SInvalidOpInNonAutoCommit);
00771 end;
00772
00773 {**
00774 Commits the current transaction.
00775 }
00776 procedure TZConnection.StartTransaction;
00777 begin
00778 CheckAutoCommitMode;
00779
00780 if FExplicitTransactionCounter = 0 then
00781 AutoCommit := False;
00782 DoStartTransaction;
00783 Inc(FExplicitTransactionCounter);
00784 end;
00785
00786 {**
00787 Commits the current transaction.
00788 }
00789 procedure TZConnection.Commit;
00790 var
00791 ExplicitTran: Boolean;
00792 begin
00793 CheckConnected;
00794 CheckNonAutoCommitMode;
00795
00796 ExplicitTran := FExplicitTransactionCounter > 0;
00797 if FExplicitTransactionCounter < 2 then
00798 //when 0 then AutoCommit was turned off, when 1 StartTransaction was used
00799 begin
00800 ShowSQLHourGlass;
00801 try
00802 try
00803 FConnection.Commit;
00804 finally
00805 FExplicitTransactionCounter := 0;
00806 if ExplicitTran then
00807 AutoCommit := True;
00808 end;
00809 finally
00810 HideSQLHourGlass;
00811 end;
00812 DoCommit;
00813 end
00814 else
00815 Dec(FExplicitTransactionCounter);
00816 end;
00817
00818 procedure TZConnection.CommitPrepared(const transactionid: string);
00819 var
00820 oldlev: TZTransactIsolationLevel;
00821 begin
00822 CheckAutoCommitMode;
00823 oldlev := TransactIsolationLevel;
00824 TransactIsolationLevel := tiNone;
00825 FConnection.CommitPrepared(transactionid);
00826 TransactIsolationLevel := oldLev;
00827 end;
00828
00829 {**
00830 Rollbacks the current transaction.
00831 }
00832 procedure TZConnection.Rollback;
00833 var
00834 ExplicitTran: Boolean;
00835 begin
00836 CheckConnected;
00837 CheckNonAutoCommitMode;
00838
00839 ExplicitTran := FExplicitTransactionCounter > 0;
00840 if FExplicitTransactionCounter < 2 then
00841 //when 0 then AutoCommit was turned off, when 1 StartTransaction was used
00842 begin
00843 ShowSQLHourGlass;
00844 try
00845 try
00846 FConnection.RollBack;
00847 finally
00848 FExplicitTransactionCounter := 0;
00849 if ExplicitTran then
00850 AutoCommit := True;
00851 end;
00852 finally
00853 HideSQLHourGlass;
00854 end;
00855 DoRollback;
00856 end
00857 else
00858 Dec(FExplicitTransactionCounter);
00859 end;
00860
00861 procedure TZConnection.RollbackPrepared(const transactionid: string);
00862 var
00863 oldlev: TZTransactIsolationLevel;
00864 begin
00865 CheckAutoCommitMode;
00866 oldlev := TransactIsolationLevel;
00867 TransactIsolationLevel := tiNone;
00868 FConnection.RollbackPrepared(transactionid);
00869 TransactIsolationLevel := oldLev;
00870 end;
00871
00872 {procedure TZConnection.RollbackPrepared(transactionid: string);
00873 begin
00874
00875 end;
00876
00877 **
00878 Processes component notifications.
00879 @param AComponent a changed component object.
00880 @param Operation a component operation code.
00881 }
00882 procedure TZConnection.Notification(AComponent: TComponent;
00883 Operation: TOperation);
00884 begin
00885 inherited Notification(AComponent, Operation);
00886
00887 if (Operation = opRemove) then
00888 begin
00889 if (AComponent is TDataset) then
00890 UnregisterDataSet(TDataset(AComponent));
00891 if (AComponent is TZSequence) then
00892 UnregisterSequence(TZSequence(AComponent));
00893 end;
00894 end;
00895
00896 Function TZConnection.PingServer: Boolean;
00897 var
00898 LastState : boolean;
00899 begin
00900 Result := false;
00901 // Check connection status
00902 LastState := GetConnected;
00903 If FConnection <> Nil Then
00904 Begin
00905 Result := (FConnection.PingServer=0);
00906 // Connection now is false but was true
00907 If (Not Result) And (LastState) Then
00908 // Generate OnDisconnect event
00909 SetConnected(Result);
00910 End
00911 Else
00912 // Connection now is false but was true
00913 If LastState Then
00914 SetConnected(false);
00915 end;
00916
00917 procedure TZConnection.PrepareTransaction(const transactionid: string);
00918 {var
00919 ExplicitTran: Boolean;}
00920 begin
00921 CheckConnected;
00922 CheckNonAutoCommitMode;
00923 if FExplicitTransactionCounter<>1 then begin
00924 raise EZDatabaseError.Create(SInvalidOpPrepare);
00925 end;
00926 ShowSQLHourGlass;
00927 try
00928 try
00929 FConnection.PrepareTransaction(transactionid);
00930 finally
00931 FExplicitTransactionCounter := 0;
00932 AutoCommit := True;
00933 end;
00934 finally
00935 HideSQLHourGlass;
00936 end;
00937 end;
00938
00939
00940 {procedure TZConnection.PrepareTransaction(const transactionid: string);
00941 begin
00942
00943 end;
00944
00945 *procedure TZConnection.PrepareTransaction(const transactionid: string);
00946 begin
00947
00948 end;
00949
00950 *
00951 Closes all registered datasets.
00952 }
00953 procedure TZConnection.CloseAllDataSets;
00954 var
00955 I: Integer;
00956 Current: TDataset;
00957 begin
00958 for I := 0 to FDatasets.Count - 1 do
00959 begin
00960 Current := TDataset(FDatasets[I]);
00961 try
00962 Current.Close;
00963 except
00964 // Ignore.
00965 end;
00966 end;
00967 end;
00968
00969 {**
00970 Registers a new dataset object.
00971 @param DataSet a new dataset to be registered.
00972 }
00973 procedure TZConnection.RegisterDataSet(DataSet: TDataset);
00974 begin
00975 FDatasets.Add(DataSet);
00976 end;
00977
00978 {**
00979 Unregisters a new dataset object.
00980 @param DataSet a new dataset to be unregistered.
00981 }
00982 procedure TZConnection.UnregisterDataSet(DataSet: TDataset);
00983 begin
00984 FDatasets.Remove(DataSet);
00985 end;
00986
00987 {**
00988 Unregisters a new dataset object.
00989 @param DataSet a new dataset to be unregistered.
00990 }
00991 procedure TZConnection.UnregisterAllDataSets;
00992 var
00993 I: Integer;
00994 Current: TZAbstractRODataset;
00995 begin
00996 for I := FDatasets.Count - 1 downto 0 do
00997 begin
00998 Current := TZAbstractRODataset(FDatasets[I]);
00999 FDatasets.Remove(Current);
01000 try
01001 Current.Connection := nil;
01002 except
01003 // Ignore.
01004 end;
01005 end;
01006 end;
01007
01008 {**
01009 Turn on sql hourglass cursor
01010 }
01011 procedure TZConnection.ShowSQLHourGlass;
01012 begin
01013 if not FSqlHourGlass then
01014 Exit;
01015
01016 if SqlHourGlassLock = 0 then
01017 begin
01018 if Assigned(DBScreen) then
01019 begin
01020 CursorBackup := DBScreen.Cursor;
01021 if CursorBackup <> dcrOther then
01022 DBScreen.Cursor := dcrSQLWait;
01023 end;
01024 end;
01025 Inc(SqlHourGlassLock);
01026 end;
01027
01028 {**
01029 Turn off sql hourglass cursor
01030 }
01031 procedure TZConnection.HideSQLHourGlass;
01032 begin
01033 if not FSqlHourGlass then
01034 Exit;
01035
01036 if SqlHourGlassLock > 0 then
01037 Dec(SqlHourGlassLock);
01038 if SqlHourGlassLock = 0 then
01039 begin
01040 if CursorBackup <> dcrOther then
01041 if Assigned(DBScreen) then
01042 DBScreen.Cursor := CursorBackup;
01043 end;
01044 end;
01045
01046 {**
01047 Fills string list with registered protocol names.
01048 @param List a string list to fill out.
01049 }
01050 procedure TZConnection.GetProtocolNames(List: TStrings);
01051 var
01052 I, J: Integer;
01053 Drivers: IZCollection;
01054 Driver: IZDriver;
01055 Protocols: TStringDynArray;
01056 begin
01057 List.Clear;
01058 Protocols := nil; // Makes compiler happy
01059 Drivers := DriverManager.GetDrivers;
01060 for I := 0 to Drivers.Count - 1 do
01061 begin
01062 Driver := Drivers[I] as IZDriver;
01063 Protocols := Driver.GetSupportedProtocols;
01064 for J := Low(Protocols) to High(Protocols) do
01065 List.Add(Protocols[J]);
01066 end;
01067 end;
01068
01069 {**
01070 Fills string list with catalog names.
01071 @param List a string list to fill out.
01072 }
01073 procedure TZConnection.GetCatalogNames(List: TStrings);
01074 var
01075 Metadata: IZDatabaseMetadata;
01076 ResultSet: IZResultSet;
01077 begin
01078 CheckConnected;
01079
01080 List.Clear;
01081 Metadata := DbcConnection.GetMetadata;
01082 ResultSet := Metadata.GetCatalogs;
01083 while ResultSet.Next do
01084 List.Add(ResultSet.GetStringByName('TABLE_CAT'));
01085 end;
01086
01087 {**
01088 Fills string list with schema names.
01089 @param List a string list to fill out.
01090 }
01091 procedure TZConnection.GetSchemaNames(List: TStrings);
01092 var
01093 Metadata: IZDatabaseMetadata;
01094 ResultSet: IZResultSet;
01095 begin
01096 CheckConnected;
01097
01098 List.Clear;
01099 Metadata := DbcConnection.GetMetadata;
01100 ResultSet := Metadata.GetSchemas;
01101 while ResultSet.Next do
01102 List.Add(ResultSet.GetStringByName('TABLE_SCHEM'));
01103 end;
01104
01105 {**
01106 Fills string list with table names.
01107 @param Pattern a pattern for table names.
01108 @param List a string list to fill out.
01109 }
01110 procedure TZConnection.GetTableNames(const Pattern: string; List: TStrings);
01111 var
01112 Metadata: IZDatabaseMetadata;
01113 ResultSet: IZResultSet;
01114 begin
01115 CheckConnected;
01116
01117 List.Clear;
01118 Metadata := DbcConnection.GetMetadata;
01119 ResultSet := Metadata.GetTables('', '', Pattern, nil);
01120 while ResultSet.Next do
01121 List.Add(ResultSet.GetStringByName('TABLE_NAME'));
01122 end;
01123
01124 {**
01125 Fills string list with table names.
01126 @param tablePattern a pattern for table names.
01127 @param schemaPattern a pattern for schema names.
01128 @param List a string list to fill out.
01129 }
01130 procedure TZConnection.GetTableNames(const tablePattern,schemaPattern: string; List: TStrings);
01131 var
01132 Metadata: IZDatabaseMetadata;
01133 ResultSet: IZResultSet;
01134 begin
01135 CheckConnected;
01136
01137 List.Clear;
01138 Metadata := DbcConnection.GetMetadata;
01139 ResultSet := Metadata.GetTables('', schemaPattern, tablePattern, nil);
01140 while ResultSet.Next do
01141 List.Add(ResultSet.GetStringByName('TABLE_NAME'));
01142 end;
01143
01144 {**
01145 Fills string list with column names.
01146 @param TablePattern a pattern for table names.
01147 @param ColumnPattern a pattern for column names.
01148 @param List a string list to fill out.
01149 }
01150 procedure TZConnection.GetColumnNames(const TablePattern, ColumnPattern: string; List: TStrings);
01151 var
01152 Metadata: IZDatabaseMetadata;
01153 ResultSet: IZResultSet;
01154 begin
01155 CheckConnected;
01156 List.Clear;
01157 Metadata := DbcConnection.GetMetadata;
01158 ResultSet := Metadata.GetColumns('', '', TablePattern, ColumnPattern);
01159 while ResultSet.Next do
01160 List.Add(ResultSet.GetStringByName('COLUMN_NAME'));
01161 end;
01162
01163 {**
01164 Fills string list with stored procedure names.
01165 @param Pattern a pattern for table names.
01166 @param List a string list to fill out.
01167 }
01168 procedure TZConnection.GetStoredProcNames(const Pattern: string;
01169 List: TStrings);
01170 var
01171 Metadata: IZDatabaseMetadata;
01172 ResultSet: IZResultSet;
01173 begin
01174 CheckConnected;
01175
01176 List.Clear;
01177 Metadata := DbcConnection.GetMetadata;
01178 ResultSet := Metadata.GetProcedures('', '', Pattern);
01179 while ResultSet.Next do
01180 List.Add(ResultSet.GetStringByName('PROCEDURE_NAME'));
01181 end;
01182
01183 {**
01184 Returns the current version of zeosdbo.
01185 }
01186 function TZConnection.GetVersion: string;
01187 begin
01188 Result := ZEOS_VERSION;
01189 end;
01190
01191 procedure TZConnection.SetVersion(const Value: string);
01192 begin
01193 end;
01194
01195 procedure TZConnection.CloseAllSequences;
01196 var
01197 I: Integer;
01198 Current: TZSequence;
01199 begin
01200 for I := 0 to FSequences.Count - 1 do
01201 begin
01202 Current := TZSequence(FSequences[I]);
01203 try
01204 Current.CloseSequence;
01205 except
01206 // Ignore.
01207 end;
01208 end;
01209 end;
01210
01211 procedure TZConnection.RegisterSequence(Sequence: TComponent);
01212 begin
01213 FSequences.Add(TZSequence(Sequence));
01214 end;
01215
01216 procedure TZConnection.UnregisterSequence(Sequence: TComponent);
01217 begin
01218 if Assigned(FSequences) then
01219 FSequences.Remove(TZSequence(Sequence));
01220 end;
01221
01222 {**
01223 Executes the SQL statement immediately without the need of a TZQuery component
01224 @param SQL the statement to be executed.
01225 Returns an indication if execution was succesfull.
01226 }
01227 function TZConnection.ExecuteDirect(SQL : String) : boolean;
01228 var
01229 dummy : Integer;
01230 begin
01231 result:= ExecuteDirect(SQL,dummy);
01232 end;
01233
01234 {**
01235 Executes the SQL statement immediately without the need of a TZQuery component
01236 @param SQL the statement to be executed.
01237 @param RowsAffected the number of rows that were affected by the statement.
01238 Returns an indication if execution was succesfull.
01239 }
01240 function TZConnection.ExecuteDirect(SQL:string; var RowsAffected:integer):boolean;
01241 var
01242 stmt : IZStatement;
01243 begin
01244 try
01245 try
01246 CheckConnected;
01247 stmt := DbcConnection.CreateStatement;
01248 RowsAffected:= stmt.ExecuteUpdate(SQL);
01249 result := (RowsAffected <> -1);
01250 except
01251 RowsAffected := -1;
01252 result := False;
01253 end;
01254 finally
01255 stmt:=nil;
01256 end;
01257 end;
01258
01259 initialization
01260 SqlHourGlassLock := 0;
01261 end.