00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { ADO Connectivity Classes }
00005 { }
00006 { Originally written by Janos Fegyverneki }
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 ZDbcAdo;
00055
00056 interface
00057
00058 {$I ZDbc.inc}
00059
00060 uses
00061 {$IFNDEF UNIX}
00062 {$IFNDEF VER130BELOW}
00063 Types,
00064 {$ENDIF}
00065 {$ENDIF}
00066 Classes, ZDbcConnection, ZDbcIntfs, ZCompatibility, ZPlainDriver,
00067 ZPlainAdoDriver, ZPlainAdo;
00068
00069 type
00070 {** Implements Ado Database Driver. }
00071 TZAdoDriver = class(TZAbstractDriver)
00072 private
00073 FAdoPlainDriver: IZPlainDriver;
00074 public
00075 constructor Create;
00076 function Connect(const Url: string; Info: TStrings): IZConnection; override;
00077
00078 function GetSupportedProtocols: TStringDynArray; override;
00079 function GetMajorVersion: Integer; override;
00080 function GetMinorVersion: Integer; override;
00081 end;
00082
00083 {** Represents an Ado specific connection interface. }
00084 IZAdoConnection = interface (IZConnection)
00085 ['{50D1AF76-0174-41CD-B90B-4FB770EFB14F}']
00086 function GetAdoConnection: ZPlainAdo.Connection;
00087 procedure InternalExecuteStatement(const SQL: string);
00088 procedure CheckAdoError;
00089 end;
00090
00091 {** Implements a generic Ado Connection. }
00092 TZAdoConnection = class(TZAbstractConnection, IZAdoConnection)
00093 private
00094 procedure ReStartTransactionSupport;
00095 protected
00096 FAdoConnection: ZPlainAdo.Connection;
00097 FPlainDriver: IZPlainDriver;
00098 function GetAdoConnection: ZPlainAdo.Connection; virtual;
00099 procedure InternalExecuteStatement(const SQL: string); virtual;
00100 procedure CheckAdoError; virtual;
00101 procedure StartTransaction; virtual;
00102 public
00103 constructor Create(Driver: IZDriver; const Url: string;
00104 PlainDriver: IZPlainDriver; const HostName: string; Port: Integer;
00105 const Database: string; const User: string; const Password: string; Info: TStrings);
00106
00107 destructor Destroy; override;
00108
00109 function CreateRegularStatement(Info: TStrings): IZStatement; override;
00110 function CreatePreparedStatement(const SQL: string; Info: TStrings):
00111 IZPreparedStatement; override;
00112 function CreateCallableStatement(const SQL: string; Info: TStrings):
00113 IZCallableStatement; override;
00114
00115 function NativeSQL(const SQL: string): string; override;
00116
00117 procedure SetAutoCommit(AutoCommit: Boolean); override;
00118 procedure SetTransactionIsolation(Level: TZTransactIsolationLevel); override;
00119
00120 procedure Commit; override;
00121 procedure Rollback; override;
00122
00123 procedure Open; override;
00124 procedure Close; override;
00125
00126 procedure SetReadOnly(ReadOnly: Boolean); override;
00127
00128 procedure SetCatalog(const Catalog: string); override;
00129 function GetCatalog: string; override;
00130
00131 function GetWarnings: EZSQLWarning; override;
00132 procedure ClearWarnings; override;
00133 end;
00134
00135 var
00136 {** The common driver manager object. }
00137 AdoDriver: IZDriver;
00138
00139 implementation
00140
00141 uses
00142 {$IFNDEF VER130BELOW}
00143 Variants,
00144 {$ENDIF}
00145 SysUtils, ActiveX, ZDbcUtils, ZDbcLogging,
00146 ZDbcAdoStatement, ZDbcAdoMetaData;
00147
00148 const
00149 IL: array[TZTransactIsolationLevel] of TOleEnum = (adXactChaos, adXactReadUncommitted, adXactReadCommitted, adXactRepeatableRead, adXactSerializable);
00150
00151 { TZDBLibDriver }
00152
00153 {**
00154 Constructs this object with default properties.
00155 }
00156 constructor TZAdoDriver.Create;
00157 begin
00158 FAdoPlainDriver := TZAdoPlainDriver.Create;
00159 end;
00160
00161 {**
00162 Get a name of the supported subprotocol.
00163 }
00164 function TZAdoDriver.GetSupportedProtocols: TStringDynArray;
00165 begin
00166 SetLength(Result, 1);
00167 Result[0] := FAdoPlainDriver.GetProtocol;
00168 end;
00169
00170 {**
00171 Attempts to make a database connection to the given URL.
00172 }
00173 function TZAdoDriver.Connect(const Url: string; Info: TStrings): IZConnection;
00174 var
00175 TempInfo: TStrings;
00176 HostName, Database, UserName, Password: string;
00177 Port: Integer;
00178 Protocol: string;
00179 PlainDriver: IZPlainDriver;
00180 begin
00181 TempInfo := TStringList.Create;
00182 try
00183 ResolveDatabaseUrl(Url, Info, HostName, Port, Database,
00184 UserName, Password, TempInfo);
00185 Protocol := ResolveConnectionProtocol(Url, GetSupportedProtocols);
00186 if Protocol = FAdoPlainDriver.GetProtocol then
00187 PlainDriver := FAdoPlainDriver;
00188 PlainDriver.Initialize;
00189 Result := TZAdoConnection.Create(Self, Url, PlainDriver, HostName,
00190 Port, Database, UserName, Password, TempInfo);
00191 finally
00192 TempInfo.Free;
00193 end;
00194 end;
00195
00196 {**
00197 Gets the driver's major version number. Initially this should be 1.
00198 @return this driver's major version number
00199 }
00200 function TZAdoDriver.GetMajorVersion: Integer;
00201 begin
00202 Result := 1;
00203 end;
00204
00205 {**
00206 Gets the driver's minor version number. Initially this should be 0.
00207 @return this driver's minor version number
00208 }
00209 function TZAdoDriver.GetMinorVersion: Integer;
00210 begin
00211 Result := 0;
00212 end;
00213
00214 { TZAdoConnection }
00215
00216 {**
00217 Constructs this object and assignes the main properties.
00218 @param Driver the parent ZDBC driver.
00219 @param HostName a name of the host.
00220 @param Port a port number (0 for default port).
00221 @param Database a name pof the database.
00222 @param User a user name.
00223 @param Password a user password.
00224 @param Info a string list with extra connection parameters.
00225 }
00226 constructor TZAdoConnection.Create(Driver: IZDriver; const Url: string;
00227 PlainDriver: IZPlainDriver; const HostName: string; Port: Integer;
00228 const Database: string; const User: string; const Password: string; Info: TStrings);
00229 begin
00230 FAdoConnection := CoConnection.Create;
00231 FPLainDriver := PlainDriver;
00232 inherited Create(Driver, Url, HostName, Port, Database, User, Password, Info,
00233 TZAdoDatabaseMetadata.Create(Self, Url, Info));
00234 end;
00235
00236 {**
00237 Destroys this object and cleanups the memory.
00238 }
00239 destructor TZAdoConnection.Destroy;
00240 begin
00241 Close;
00242 FAdoConnection := nil;
00243 inherited Destroy;
00244 end;
00245
00246 {**
00247 Just return the Ado Connection
00248 }
00249 function TZAdoConnection.GetAdoConnection: ZPlainAdo.Connection;
00250 begin
00251 Result := FAdoConnection;
00252 end;
00253
00254 {**
00255 Executes simple statements internally.
00256 }
00257 procedure TZAdoConnection.InternalExecuteStatement(const SQL: string);
00258 var
00259 RowsAffected: OleVariant;
00260 begin
00261 try
00262 FAdoConnection.Execute(SQL, RowsAffected, adExecuteNoRecords);
00263 DriverManager.LogMessage(lcExecute, FPlainDriver.GetProtocol, SQL);
00264 except
00265 on E: Exception do
00266 begin
00267 DriverManager.LogError(lcExecute, FPlainDriver.GetProtocol, SQL, 0, E.Message);
00268 raise;
00269 end;
00270 end;
00271 end;
00272
00273 procedure TZAdoConnection.CheckAdoError;
00274 begin
00275 end;
00276
00277 {**
00278 Starts a transaction support.
00279 }
00280 procedure TZAdoConnection.ReStartTransactionSupport;
00281 begin
00282 if Closed then Exit;
00283
00284 if not (AutoCommit or (GetTransactionIsolation = tiNone)) then
00285 StartTransaction;
00286 end;
00287
00288 {**
00289 Opens a connection to database server with specified parameters.
00290 }
00291 procedure TZAdoConnection.Open;
00292 var
00293 LogMessage: string;
00294 begin
00295 if not Closed then Exit;
00296
00297 LogMessage := Format('CONNECT TO "%s" AS USER "%s"', [Database, User]);
00298 try
00299 if ReadOnly then
00300 FAdoConnection.Set_Mode(adModeRead)
00301 else
00302 FAdoConnection.Set_Mode(adModeUnknown);
00303 FAdoConnection.Open(Database, User, Password, -1{adConnectUnspecified});
00304 FAdoConnection.Set_CursorLocation(adUseClient);
00305 DriverManager.LogMessage(lcConnect, FPLainDriver.GetProtocol, LogMessage);
00306 except
00307 on E: Exception do
00308 begin
00309 DriverManager.LogError(lcConnect, FPlainDriver.GetProtocol, LogMessage, 0, E.Message);
00310 raise;
00311 end;
00312 end;
00313
00314 inherited Open;
00315
00316 FAdoConnection.IsolationLevel := IL[GetTransactionIsolation];
00317 ReStartTransactionSupport;
00318 end;
00319
00320 {**
00321 Creates a <code>Statement</code> object for sending
00322 SQL statements to the database.
00323 SQL statements without parameters are normally
00324 executed using Statement objects. If the same SQL statement
00325 is executed many times, it is more efficient to use a
00326 <code>PreparedStatement</code> object.
00327 <P>
00328 Result sets created using the returned <code>Statement</code>
00329 object will by default have forward-only type and read-only concurrency.
00330
00331 @param Info a statement parameters.
00332 @return a new Statement object
00333 }
00334 function TZAdoConnection.CreateRegularStatement(Info: TStrings): IZStatement;
00335 begin
00336 if IsClosed then Open;
00337 Result := TZAdoStatement.Create(FPlainDriver, Self, '', Info);
00338 end;
00339
00340 {**
00341 Creates a <code>PreparedStatement</code> object for sending
00342 parameterized SQL statements to the database.
00343
00344 A SQL statement with or without IN parameters can be
00345 pre-compiled and stored in a PreparedStatement object. This
00346 object can then be used to efficiently execute this statement
00347 multiple times.
00348
00349 <P><B>Note:</B> This method is optimized for handling
00350 parametric SQL statements that benefit from precompilation. If
00351 the driver supports precompilation,
00352 the method <code>prepareStatement</code> will send
00353 the statement to the database for precompilation. Some drivers
00354 may not support precompilation. In this case, the statement may
00355 not be sent to the database until the <code>PreparedStatement</code> is
00356 executed. This has no direct effect on users; however, it does
00357 affect which method throws certain SQLExceptions.
00358
00359 Result sets created using the returned PreparedStatement will have
00360 forward-only type and read-only concurrency, by default.
00361
00362 @param sql a SQL statement that may contain one or more '?' IN
00363 parameter placeholders
00364 @param Info a statement parameters.
00365 @return a new PreparedStatement object containing the
00366 pre-compiled statement
00367 }
00368 function TZAdoConnection.CreatePreparedStatement(
00369 const SQL: string; Info: TStrings): IZPreparedStatement;
00370 begin
00371 if IsClosed then Open;
00372 Result := TZAdoPreparedStatement.Create(FPLainDriver, Self, SQL, Info);
00373 end;
00374
00375 {**
00376 Creates a <code>CallableStatement</code> object for calling
00377 database stored procedures.
00378 The <code>CallableStatement</code> object provides
00379 methods for setting up its IN and OUT parameters, and
00380 methods for executing the call to a stored procedure.
00381
00382 <P><B>Note:</B> This method is optimized for handling stored
00383 procedure call statements. Some drivers may send the call
00384 statement to the database when the method <code>prepareCall</code>
00385 is done; others
00386 may wait until the <code>CallableStatement</code> object
00387 is executed. This has no
00388 direct effect on users; however, it does affect which method
00389 throws certain SQLExceptions.
00390
00391 Result sets created using the returned CallableStatement will have
00392 forward-only type and read-only concurrency, by default.
00393
00394 @param sql a SQL statement that may contain one or more '?'
00395 parameter placeholders. Typically this statement is a JDBC
00396 function call escape string.
00397 @param Info a statement parameters.
00398 @return a new CallableStatement object containing the
00399 pre-compiled SQL statement
00400 }
00401 function TZAdoConnection.CreateCallableStatement(const SQL: string; Info: TStrings):
00402 IZCallableStatement;
00403 begin
00404 if IsClosed then Open;
00405 Result := TZAdoCallableStatement.Create(FPlainDriver, Self, SQL, Info);
00406 end;
00407
00408 {**
00409 Converts the given SQL statement into the system's native SQL grammar.
00410 A driver may convert the JDBC sql grammar into its system's
00411 native SQL grammar prior to sending it; this method returns the
00412 native form of the statement that the driver would have sent.
00413
00414 @param sql a SQL statement that may contain one or more '?'
00415 parameter placeholders
00416 @return the native form of this statement
00417 }
00418 function TZAdoConnection.NativeSQL(const SQL: string): string;
00419 begin
00420 Result := SQL;
00421 end;
00422
00423 {**
00424 Sets this connection's auto-commit mode.
00425 If a connection is in auto-commit mode, then all its SQL
00426 statements will be executed and committed as individual
00427 transactions. Otherwise, its SQL statements are grouped into
00428 transactions that are terminated by a call to either
00429 the method <code>commit</code> or the method <code>rollback</code>.
00430 By default, new connections are in auto-commit mode.
00431
00432 The commit occurs when the statement completes or the next
00433 execute occurs, whichever comes first. In the case of
00434 statements returning a ResultSet, the statement completes when
00435 the last row of the ResultSet has been retrieved or the
00436 ResultSet has been closed. In advanced cases, a single
00437 statement may return multiple results as well as output
00438 parameter values. In these cases the commit occurs when all results and
00439 output parameter values have been retrieved.
00440
00441 @param autoCommit true enables auto-commit; false disables auto-commit.
00442 }
00443 procedure TZAdoConnection.SetAutoCommit(AutoCommit: Boolean);
00444 begin
00445 if GetAutoCommit = AutoCommit then Exit;
00446 if not Closed and AutoCommit then
00447 begin
00448 if (FAdoConnection.State = adStateOpen) and
00449 (GetTransactionIsolation <> tiNone) then
00450 begin
00451 FAdoConnection.CommitTrans;
00452 DriverManager.LogMessage(lcExecute, FPLainDriver.GetProtocol, 'COMMIT');
00453 end;
00454 end;
00455 inherited;
00456 ReStartTransactionSupport;
00457 end;
00458
00459 {**
00460 Attempts to change the transaction isolation level to the one given.
00461 The constants defined in the interface <code>Connection</code>
00462 are the possible transaction isolation levels.
00463
00464 <P><B>Note:</B> This method cannot be called while
00465 in the middle of a transaction.
00466
00467 @param level one of the TRANSACTION_* isolation values with the
00468 exception of TRANSACTION_NONE; some databases may not support other values
00469 @see DatabaseMetaData#supportsTransactionIsolationLevel
00470 }
00471 procedure TZAdoConnection.SetTransactionIsolation(
00472 Level: TZTransactIsolationLevel);
00473 begin
00474 if GetTransactionIsolation = Level then Exit;
00475
00476 if not Closed and not AutoCommit and (GetTransactionIsolation <> tiNone) then
00477 begin
00478 FAdoConnection.CommitTrans;
00479 DriverManager.LogMessage(lcExecute, FPLainDriver.GetProtocol, 'COMMIT');
00480 end;
00481
00482 inherited;
00483
00484 if not Closed then
00485 FAdoConnection.IsolationLevel := IL[Level];
00486
00487 RestartTransactionSupport;
00488 end;
00489
00490 {**
00491 Starts a new transaction. Used internally.
00492 }
00493 procedure TZAdoConnection.StartTransaction;
00494 var
00495 LogMessage: string;
00496 begin
00497 LogMessage := 'BEGIN TRANSACTION';
00498 try
00499 FAdoConnection.BeginTrans;
00500 DriverManager.LogMessage(lcExecute, FPLainDriver.GetProtocol, LogMessage);
00501 except
00502 on E: Exception do
00503 begin
00504 DriverManager.LogError(lcExecute, FPlainDriver.GetProtocol, LogMessage, 0, E.Message);
00505 raise;
00506 end;
00507 end;
00508 end;
00509
00510 {**
00511 Makes all changes made since the previous
00512 commit/rollback permanent and releases any database locks
00513 currently held by the Connection. This method should be
00514 used only when auto-commit mode has been disabled.
00515 @see #setAutoCommit
00516 }
00517 procedure TZAdoConnection.Commit;
00518 var
00519 LogMessage: string;
00520 begin
00521 LogMessage := 'COMMIT';
00522 try
00523 FAdoConnection.CommitTrans;
00524 DriverManager.LogMessage(lcExecute, FPLainDriver.GetProtocol, LogMessage);
00525 StartTransaction;
00526 except
00527 on E: Exception do
00528 begin
00529 DriverManager.LogError(lcExecute, FPlainDriver.GetProtocol, LogMessage, 0, E.Message);
00530 raise;
00531 end;
00532 end;
00533 end;
00534
00535 {**
00536 Drops all changes made since the previous
00537 commit/rollback and releases any database locks currently held
00538 by this Connection. This method should be used only when auto-
00539 commit has been disabled.
00540 @see #setAutoCommit
00541 }
00542 procedure TZAdoConnection.Rollback;
00543 var
00544 LogMessage: string;
00545 begin
00546 LogMessage := 'ROLLBACK';
00547 try
00548 FAdoConnection.RollbackTrans;
00549 DriverManager.LogMessage(lcExecute, FPLainDriver.GetProtocol, LogMessage);
00550 StartTransaction;
00551 except
00552 on E: Exception do
00553 begin
00554 DriverManager.LogError(lcExecute, FPlainDriver.GetProtocol, LogMessage, 0, E.Message);
00555 raise;
00556 end;
00557 end;
00558 end;
00559
00560 {**
00561 Releases a Connection's database and JDBC resources
00562 immediately instead of waiting for
00563 them to be automatically released.
00564
00565 <P><B>Note:</B> A Connection is automatically closed when it is
00566 garbage collected. Certain fatal errors also result in a closed
00567 Connection.
00568 }
00569 procedure TZAdoConnection.Close;
00570 var
00571 LogMessage: string;
00572 begin
00573 if Closed then Exit;
00574 SetAutoCommit(True);
00575
00576 LogMessage := Format('CLOSE CONNECTION TO "%s"', [Database]);
00577 try
00578 if FAdoConnection.State = adStateOpen then
00579 FAdoConnection.Close;
00580 DriverManager.LogMessage(lcExecute, FPLainDriver.GetProtocol, LogMessage);
00581 except
00582 on E: Exception do
00583 begin
00584 DriverManager.LogError(lcExecute, FPlainDriver.GetProtocol, LogMessage, 0, E.Message);
00585 raise;
00586 end;
00587 end;
00588
00589 inherited;
00590 end;
00591
00592 {**
00593 Puts this connection in read-only mode as a hint to enable
00594 database optimizations.
00595
00596 <P><B>Note:</B> This method cannot be called while in the
00597 middle of a transaction.
00598
00599 @param readOnly true enables read-only mode; false disables
00600 read-only mode.
00601 }
00602 procedure TZAdoConnection.SetReadOnly(ReadOnly: Boolean);
00603 begin
00604 inherited;
00605 end;
00606
00607 {**
00608 Sets a catalog name in order to select
00609 a subspace of this Connection's database in which to work.
00610 If the driver does not support catalogs, it will
00611 silently ignore this request.
00612 }
00613 procedure TZAdoConnection.SetCatalog(const Catalog: string);
00614 var
00615 LogMessage: string;
00616 begin
00617 if Closed then Exit;
00618
00619 LogMessage := Format('SET CATALOG %s', [Catalog]);
00620 try
00621 FAdoConnection.DefaultDatabase := Catalog;
00622 DriverManager.LogMessage(lcExecute, FPLainDriver.GetProtocol, LogMessage);
00623 except
00624 on E: Exception do
00625 begin
00626 DriverManager.LogError(lcExecute, FPlainDriver.GetProtocol, LogMessage, 0, E.Message);
00627 raise;
00628 end;
00629 end;
00630 end;
00631
00632 {**
00633 Returns the Connection's current catalog name.
00634 @return the current catalog name or null
00635 }
00636 function TZAdoConnection.GetCatalog: string;
00637 begin
00638 Result := FAdoConnection.DefaultDatabase;
00639 end;
00640
00641 {**
00642 Returns the first warning reported by calls on this Connection.
00643 <P><B>Note:</B> Subsequent warnings will be chained to this
00644 SQLWarning.
00645 @return the first SQLWarning or null
00646 }
00647 function TZAdoConnection.GetWarnings: EZSQLWarning;
00648 begin
00649 Result := nil;
00650 end;
00651
00652 {**
00653 Clears all warnings reported for this <code>Connection</code> object.
00654 After a call to this method, the method <code>getWarnings</code>
00655 returns null until a new warning is reported for this Connection.
00656 }
00657 procedure TZAdoConnection.ClearWarnings;
00658 begin
00659 end;
00660
00661 initialization
00662 AdoDriver := TZAdoDriver.Create;
00663 DriverManager.RegisterDriver(AdoDriver);
00664 finalization
00665 if Assigned(DriverManager) then
00666 DriverManager.DeregisterDriver(AdoDriver);
00667 AdoDriver := nil;
00668 end.