00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { Interbase Database Connectivity Classes }
00005 { }
00006 { Originally written by Sergey Merkuriev }
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 ZDbcASA;
00055
00056 interface
00057
00058 {$I ZDbc.inc}
00059
00060 uses
00061 ZCompatibility, {$IFNDEF VER130BELOW}Types,{$ENDIF}
00062 Classes, Contnrs, SysUtils, ZDbcIntfs,
00063 ZDbcConnection, ZPlainASADriver, ZSysUtils, ZTokenizer,
00064 ZDbcGenericResolver, ZGenericSqlAnalyser;
00065
00066 type
00067 {** Implements a ASA Database Driver. }
00068 TZASADriver = class(TZAbstractDriver)
00069 private
00070 FASA7PlainDriver: IZASA7PlainDriver;
00071 FASA8PlainDriver: IZASA8PlainDriver;
00072 FASA9PlainDriver: IZASA9PlainDriver;
00073 protected
00074 function GetPlainDriver(const Url: string): IZASAPlainDriver;
00075 public
00076 constructor Create;
00077 function Connect(const Url: string; Info: TStrings): IZConnection; override;
00078
00079 function GetSupportedProtocols: TStringDynArray; override;
00080 function GetMajorVersion: Integer; override;
00081 function GetMinorVersion: Integer; override;
00082 function GetTokenizer: IZTokenizer; override;
00083 function GetStatementAnalyser: IZStatementAnalyser; override;
00084 end;
00085
00086 {** Represents a ASA specific connection interface. }
00087 IZASAConnection = interface (IZConnection)
00088 ['{FAAAFCE0-F550-4098-96C6-580145813EBF}']
00089 function GetDBHandle: PZASASQLCA;
00090 function GetPlainDriver: IZASAPlainDriver;
00091
00092 end;
00093
00094 {** Implements ASA Database Connection. }
00095 TZASAConnection = class(TZAbstractConnection, IZASAConnection)
00096 private
00097 FSQLCA: TZASASQLCA;
00098 FHandle: PZASASQLCA;
00099 FPlainDriver: IZASAPlainDriver;
00100 private
00101 procedure StartTransaction; virtual;
00102 public
00103 constructor Create(Driver: IZDriver; const Url: string;
00104 PlainDriver: IZASAPlainDriver;
00105 const HostName: string; Port: Integer; const Database: string;
00106 const User: string; const Password: string; Info: TStrings);
00107 destructor Destroy; override;
00108
00109 function GetDBHandle: PZASASQLCA;
00110 function GetPlainDriver: IZASAPlainDriver;
00111
00112
00113 function CreateRegularStatement(Info: TStrings): IZStatement; override;
00114 function CreatePreparedStatement(const SQL: string; Info: TStrings):
00115 IZPreparedStatement; override;
00116 function CreateCallableStatement(const SQL: string; Info: TStrings):
00117 IZCallableStatement; override;
00118
00119 procedure Commit; override;
00120 procedure Rollback; override;
00121 procedure SetOption(Temporary: Integer; User: PChar; const Option: string;
00122 const Value: string);
00123
00124 procedure Open; override;
00125 procedure Close; override;
00126 end;
00127
00128 {** Implements a specialized cached resolver for ASA. }
00129 TZASACachedResolver = class(TZGenericCachedResolver)
00130 public
00131 function FormCalculateStatement(Columns: TObjectList): string; override;
00132 end;
00133
00134
00135 var
00136 {** The common driver manager object. }
00137 ASADriver: IZDriver;
00138
00139 implementation
00140
00141 uses
00142 ZDbcASAMetadata, ZDbcASAStatement, ZDbcASAUtils, ZSybaseToken,
00143 ZSybaseAnalyser, ZDbcUtils, ZDbcLogging;
00144
00145 { TZASADriver }
00146
00147 {**
00148 Attempts to make a database connection to the given URL.
00149 The driver should return "null" if it realizes it is the wrong kind
00150 of driver to connect to the given URL. This will be common, as when
00151 the JDBC driver manager is asked to connect to a given URL it passes
00152 the URL to each loaded driver in turn.
00153
00154 <P>The driver should raise a SQLException if it is the right
00155 driver to connect to the given URL, but has trouble connecting to
00156 the database.
00157
00158 <P>The java.util.Properties argument can be used to passed arbitrary
00159 string tag/value pairs as connection arguments.
00160 Normally at least "user" and "password" properties should be
00161 included in the Properties.
00162
00163 @param url the URL of the database to which to connect
00164 @param info a list of arbitrary string tag/value pairs as
00165 connection arguments. Normally at least a "user" and
00166 "password" property should be included.
00167 @return a <code>Connection</code> object that represents a
00168 connection to the URL
00169 }
00170 function TZASADriver.Connect(const Url: string; Info: TStrings): IZConnection;
00171 var
00172 TempInfo: TStrings;
00173 HostName, Database, UserName, Password: string;
00174 Port: Integer;
00175 PlainDriver: IZASAPlainDriver;
00176 begin
00177 TempInfo := TStringList.Create;
00178 try
00179 ResolveDatabaseUrl(Url, Info, HostName, Port, Database,
00180 UserName, Password, TempInfo);
00181 PlainDriver := GetPlainDriver(Url);
00182 Result := TZASAConnection.Create(Self, Url, PlainDriver, HostName, Port,
00183 Database, UserName, Password, TempInfo);
00184 finally
00185 TempInfo.Free;
00186 end;
00187 end;
00188
00189 {**
00190 Constructs this object with default properties.
00191 }
00192 constructor TZASADriver.Create;
00193 begin
00194 FASA7PlainDriver := TZASA7PlainDriver.Create;
00195 FASA8PlainDriver := TZASA8PlainDriver.Create;
00196 FASA9PlainDriver := TZASA9PlainDriver.Create;
00197 end;
00198
00199 {**
00200 Gets the driver's major version number. Initially this should be 1.
00201 @return this driver's major version number
00202 }
00203 function TZASADriver.GetMajorVersion: Integer;
00204 begin
00205 Result := 1;
00206 end;
00207
00208 {**
00209 Gets the driver's minor version number. Initially this should be 0.
00210 @return this driver's minor version number
00211 }
00212 function TZASADriver.GetMinorVersion: Integer;
00213 begin
00214 Result := 0;
00215 end;
00216
00217 {**
00218 Gets a SQL syntax tokenizer.
00219 @returns a SQL syntax tokenizer object.
00220 }
00221 function TZASADriver.GetTokenizer: IZTokenizer;
00222 begin
00223 if Tokenizer = nil then
00224 Tokenizer := TZSybaseTokenizer.Create;
00225 Result := Tokenizer;
00226 end;
00227
00228 {**
00229 Creates a statement analyser object.
00230 @returns a statement analyser object.
00231 }
00232 function TZASADriver.GetStatementAnalyser: IZStatementAnalyser;
00233 begin
00234 if Analyser = nil then
00235 Analyser := TZSybaseStatementAnalyser.Create;
00236 Result := Analyser;
00237 end;
00238
00239 {**
00240 Gets plain driver for selected protocol.
00241 @param Url a database connection URL.
00242 @return a selected protocol.
00243 }
00244 function TZASADriver.GetPlainDriver(const Url: string): IZASAPlainDriver;
00245 var
00246 Protocol: string;
00247 begin
00248 Protocol := ResolveConnectionProtocol(Url, GetSupportedProtocols);
00249
00250 if Protocol = FASA7PlainDriver.GetProtocol then
00251 Result := FASA7PlainDriver
00252 else if Protocol = FASA8PlainDriver.GetProtocol then
00253 Result := FASA8PlainDriver
00254 else if Protocol = FASA9PlainDriver.GetProtocol then
00255 Result := FASA9PlainDriver;
00256 Result.Initialize;
00257 end;
00258
00259 {**
00260 Get a name of the supported subprotocol.
00261 For example: mysql, oracle8 or postgresql72
00262 }
00263 function TZASADriver.GetSupportedProtocols: TStringDynArray;
00264 begin
00265 SetLength(Result, 3);
00266 Result[0] := FASA7PlainDriver.GetProtocol;
00267 Result[1] := FASA8PlainDriver.GetProtocol;
00268 Result[2] := FASA9PlainDriver.GetProtocol;
00269 end;
00270
00271
00272 { TZASAConnection }
00273
00274 {**
00275 Releases a Connection's database and JDBC resources
00276 immediately instead of waiting for
00277 them to be automatically released.
00278
00279 <P><B>Note:</B> A Connection is automatically closed when it is
00280 garbage collected. Certain fatal errors also result in a closed
00281 Connection.
00282 }
00283 procedure TZASAConnection.Close;
00284 begin
00285 if Closed then Exit;
00286
00287 if AutoCommit then
00288 Commit
00289 else
00290 Rollback;
00291
00292 FPlainDriver.db_string_disconnect( FHandle, nil);
00293 CheckASAError( FPlainDriver, FHandle, lcDisconnect);
00294
00295 FHandle := nil;
00296 if FPlainDriver.db_fini( @FSQLCA) = 0 then
00297 begin
00298 DriverManager.LogError( lcConnect, FPlainDriver.GetProtocol, 'Inititalizing SQLCA',
00299 0, 'Error closing SQLCA');
00300 raise EZSQLException.CreateWithCode( 0,
00301 'Error closing SQLCA');
00302 end;
00303
00304 DriverManager.LogMessage(lcDisconnect, FPlainDriver.GetProtocol,
00305 Format('DISCONNECT FROM "%s"', [Database]));
00306
00307 inherited Close;
00308 end;
00309
00310 {**
00311 Commit current transaction
00312 }
00313 procedure TZASAConnection.Commit;
00314 begin
00315 if Closed or AutoCommit then Exit;
00316
00317 if FHandle <> nil then
00318 begin
00319 FPlainDriver.db_commit( FHandle, 0);
00320 CheckASAError( FPlainDriver, FHandle, lcTransaction);
00321 DriverManager.LogMessage(lcTransaction,
00322 FPlainDriver.GetProtocol, 'TRANSACTION COMMIT');
00323 end;
00324 end;
00325
00326 {**
00327 Constructs this object and assignes the main properties.
00328 @param Driver the parent ZDBC driver.
00329 @param HostName a name of the host.
00330 @param Port a port number (0 for default port).
00331 @param Database a name pof the database.
00332 @param User a user name.
00333 @param Password a user password.
00334 @param Info a string list with extra connection parameters.
00335 }
00336 constructor TZASAConnection.Create(Driver: IZDriver; const Url: string;
00337 PlainDriver: IZASAPlainDriver; const HostName: string; Port: Integer;
00338 const Database, User, Password: string; Info: TStrings);
00339 begin
00340 inherited Create(Driver, Url, HostName, Port, Database, User, Password, Info,
00341 TZASADatabaseMetadata.Create(Self, Url, Info));
00342
00343 FPlainDriver := PlainDriver;
00344 end;
00345
00346 {**
00347 Creates a <code>CallableStatement</code> object for calling
00348 database stored procedures.
00349 The <code>CallableStatement</code> object provides
00350 methods for setting up its IN and OUT parameters, and
00351 methods for executing the call to a stored procedure.
00352
00353 <P><B>Note:</B> This method is optimized for handling stored
00354 procedure call statements. Some drivers may send the call
00355 statement to the database when the method <code>prepareCall</code>
00356 is done; others
00357 may wait until the <code>CallableStatement</code> object
00358 is executed. This has no
00359 direct effect on users; however, it does affect which method
00360 throws certain SQLExceptions.
00361
00362 Result sets created using the returned CallableStatement will have
00363 forward-only type and read-only concurrency, by default.
00364
00365 @param sql a SQL statement that may contain one or more '?'
00366 parameter placeholders. Typically this statement is a JDBC
00367 function call escape string.
00368 @param Info a statement parameters.
00369 @return a new CallableStatement object containing the
00370 pre-compiled SQL statement
00371 }
00372 function TZASAConnection.CreateCallableStatement(const SQL: string;
00373 Info: TStrings): IZCallableStatement;
00374 begin
00375 if IsClosed then Open;
00376 Result := TZASACallableStatement.Create(Self, SQL, Info);
00377 end;
00378
00379 {**
00380 Creates a <code>PreparedStatement</code> object for sending
00381 parameterized SQL statements to the database.
00382
00383 A SQL statement with or without IN parameters can be
00384 pre-compiled and stored in a PreparedStatement object. This
00385 object can then be used to efficiently execute this statement
00386 multiple times.
00387
00388 <P><B>Note:</B> This method is optimized for handling
00389 parametric SQL statements that benefit from precompilation. If
00390 the driver supports precompilation,
00391 the method <code>prepareStatement</code> will send
00392 the statement to the database for precompilation. Some drivers
00393 may not support precompilation. In this case, the statement may
00394 not be sent to the database until the <code>PreparedStatement</code> is
00395 executed. This has no direct effect on users; however, it does
00396 affect which method throws certain SQLExceptions.
00397
00398 Result sets created using the returned PreparedStatement will have
00399 forward-only type and read-only concurrency, by default.
00400
00401 @param sql a SQL statement that may contain one or more '?' IN
00402 parameter placeholders
00403 @return a new PreparedStatement object containing the
00404 pre-compiled statement
00405 }
00406 function TZASAConnection.CreatePreparedStatement(const SQL: string;
00407 Info: TStrings): IZPreparedStatement;
00408 begin
00409 if IsClosed then Open;
00410 Result := TZASAPreparedStatement.Create(Self, SQL, Info);
00411 end;
00412
00413 {**
00414 Creates a <code>Statement</code> object for sending
00415 SQL statements to the database.
00416 SQL statements without parameters are normally
00417 executed using Statement objects. If the same SQL statement
00418 is executed many times, it is more efficient to use a
00419 <code>PreparedStatement</code> object.
00420 <P>
00421 Result sets created using the returned <code>Statement</code>
00422 object will by default have forward-only type and read-only concurrency.
00423
00424 @param Info a statement parameters.
00425 @return a new Statement object
00426 }
00427 function TZASAConnection.CreateRegularStatement(
00428 Info: TStrings): IZStatement;
00429 begin
00430 if IsClosed then Open;
00431 Result := TZASAStatement.Create(Self, Info);
00432 end;
00433
00434 {**
00435 Destroys this object and cleanups the memory.
00436 }
00437 destructor TZASAConnection.Destroy;
00438 begin
00439 if not Closed then
00440 Close;
00441
00442 inherited;
00443 end;
00444
00445 {**
00446 Get database connection handle.
00447 @return database handle
00448 }
00449 function TZASAConnection.GetDBHandle: PZASASQLCA;
00450 begin
00451 Result := FHandle;
00452 end;
00453
00454 {**
00455 Return native interbase plain driver
00456 @return plain driver
00457 }
00458 function TZASAConnection.GetPlainDriver: IZASAPlainDriver;
00459 begin
00460 Result := FPlainDriver;
00461 end;
00462
00463 {**
00464 Opens a connection to database server with specified parameters.
00465 }
00466 procedure TZASAConnection.Open;
00467 var
00468 ConnectionString, Links: string;
00469 begin
00470 if not Closed then Exit;
00471
00472 FHandle := nil;
00473 ConnectionString := '';
00474 try
00475 if FPlainDriver.db_init( @FSQLCA) = 0 then
00476 begin
00477 DriverManager.LogError( lcConnect, FPlainDriver.GetProtocol, 'Inititalizing SQLCA',
00478 0, 'Error initializing SQLCA');
00479 raise EZSQLException.CreateWithCode( 0,
00480 'Error initializing SQLCA');
00481 end;
00482 FHandle := @FSQLCA;
00483
00484 { Create new db if needed }
00485 { if Info.Values['createNewDatabase'] <> '' then
00486 begin
00487 CreateNewDatabase(Info.Values['createNewDatabase']);
00488 DriverManager.LogMessage(lcConnect, FPlainDriver.GetProtocol,
00489 Format('CREATE DATABASE "%s"', [Info.Values['createNewDatabase']]));
00490 end;}
00491
00492 { for i := 0 to Info.Count-1 do
00493 ConnectionString := ConnectionString + Info[i] + '; ';}
00494
00495 if HostName <> '' then
00496 ConnectionString := ConnectionString + 'ENG="' + HostName + '"; ';
00497 if User <> '' then
00498 ConnectionString := ConnectionString + 'UID="' + User + '"; ';
00499 if Password <> '' then
00500 ConnectionString := ConnectionString + 'PWD="' + Password + '"; ';
00501 if Database <> '' then
00502 begin
00503 if CompareText( ExtractFileExt( Database), '.db') = 0 then
00504 ConnectionString := ConnectionString + 'DBF="' + Database + '"; '
00505 else
00506 ConnectionString := ConnectionString + 'DBN="' + Database + '"; ';
00507 end;
00508
00509 Links := '';
00510 if Info.Values['CommLinks'] <> ''
00511 then Links := 'CommLinks=' + Info.Values['CommLinks'];
00512 if Info.Values['LINKS'] <> ''
00513 then Links := 'LINKS=' + Info.Values['LINKS'];
00514 if (Links = '') and (Port <> 0)
00515 then Links := 'LINKS=tcpip(PORT=' + IntToStr(Port) + ')';
00516 if Links <> ''
00517 then ConnectionString := ConnectionString + Links + '; ';
00518
00519 FPlainDriver.db_string_connect( FHandle, PChar( ConnectionString));
00520 CheckASAError( FPlainDriver, FHandle, lcConnect);
00521
00522 DriverManager.LogMessage(lcConnect, FPlainDriver.GetProtocol,
00523 Format('CONNECT TO "%s" AS USER "%s"', [Database, User]));
00524
00525 StartTransaction;
00526
00527 //SetConnOptions RowCount;
00528
00529 except
00530 on E: Exception do begin
00531 if Assigned( FHandle) then
00532 FPlainDriver.db_fini( FHandle);
00533 FHandle := nil;
00534 raise;
00535 end;
00536 end;
00537
00538 inherited Open;
00539 end;
00540
00541 {**
00542 Drops all changes made since the previous
00543 commit/rollback and releases any database locks currently held
00544 by this Connection. This method should be used only when auto-
00545 commit has been disabled.
00546 @see #setAutoCommit
00547 }
00548 procedure TZASAConnection.Rollback;
00549 begin
00550 if Closed or AutoCommit then Exit;
00551
00552 if Assigned( FHandle) then
00553 begin
00554 FPlainDriver.db_rollback( FHandle, 0);
00555 CheckASAError( FPlainDriver, FHandle, lcTransaction);
00556 DriverManager.LogMessage(lcTransaction,
00557 FPlainDriver.GetProtocol, 'TRANSACTION ROLLBACK');
00558 end;
00559 end;
00560
00561 procedure TZASAConnection.SetOption(Temporary: Integer; User: PChar;
00562 const Option: string; const Value: string);
00563 var
00564 SQLDA: PASASQLDA;
00565 Sz: Integer;
00566 S: string;
00567 begin
00568 if Assigned( FHandle) then
00569 begin
00570 Sz := SizeOf( TASASQLDA) - 32767 * SizeOf( TZASASQLVAR);
00571 SQLDA := AllocMem( Sz);
00572 try
00573 StrPLCopy( SQLDA.sqldaid, 'SQLDA ', 8);
00574 SQLDA.sqldabc := Sz;
00575 SQLDA.sqln := 1;
00576 SQLDA.sqld := 1;
00577 SQLDA.sqlVar[0].sqlType := DT_STRING;
00578 SQLDA.sqlVar[0].sqlLen := Length( Value)+1;
00579 SQLDA.sqlVar[0].sqlData := PChar( Value);
00580 FPlainDriver.db_setoption( FHandle, Temporary, User, PChar( Option),
00581 SQLDA);
00582
00583 CheckASAError( FPlainDriver, FHandle, lcOther);
00584 S := User;
00585 DriverManager.LogMessage( lcOther, FPlainDriver.GetProtocol,
00586 Format( 'SET OPTION %s.%s = %s', [ S, Option, Value]));
00587 finally
00588 FreeMem( SQLDA);
00589 end;
00590 end;
00591 end;
00592
00593 {**
00594 Start transaction
00595 }
00596 procedure TZASAConnection.StartTransaction;
00597 var
00598 ASATL: integer;
00599 begin
00600 if AutoCommit then
00601 SetOption( 1, nil, 'CHAINED', 'OFF')
00602 else begin
00603 SetOption( 1, nil, 'CHAINED', 'ON');
00604
00605 end;
00606 ASATL := Ord( TransactIsolationLevel);
00607 if ASATL > 1 then
00608 ASATL := ASATL - 1;
00609 SetOption( 1, nil, 'ISOLATION_LEVEL', IntToStr( ASATL));
00610 end;
00611
00612 { TZASACachedResolver }
00613
00614 {**
00615 Forms a where clause for SELECT statements to calculate default values.
00616 @param Columns a collection of key columns.
00617 @param OldRowAccessor an accessor object to old column values.
00618 }
00619 function TZASACachedResolver.FormCalculateStatement(
00620 Columns: TObjectList): string;
00621 var
00622 I: Integer;
00623 Current: TZResolverParameter;
00624 begin
00625 Result := '';
00626 if Columns.Count = 0 then Exit;
00627
00628 for I := 0 to Columns.Count - 1 do
00629 begin
00630 Current := TZResolverParameter(Columns[I]);
00631 if Result <> '' then
00632 Result := Result + ',';
00633 if Current.DefaultValue <> '' then
00634 Result := Result + Current.DefaultValue
00635 else Result := Result + 'NULL';
00636 end;
00637 Result := 'SELECT ' + Result;
00638 end;
00639
00640 initialization
00641 ASADriver := TZASADriver.Create;
00642 DriverManager.RegisterDriver(ASADriver);
00643
00644 finalization
00645 if Assigned(DriverManager) then
00646 DriverManager.DeregisterDriver(ASADriver);
00647 ASADriver := nil;
00648 end.