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 ZDbcInterbase6;
00055
00056 interface
00057
00058 {$I ZDbc.inc}
00059
00060 uses
00061 {$IFNDEF VER130BELOW}
00062 Types,
00063 {$ENDIF}
00064 ZCompatibility, Classes, SysUtils, ZDbcUtils, ZDbcIntfs, ZDbcConnection,
00065 Contnrs, ZPlainInterbaseDriver, ZPlainFirebirdDriver,
00066 ZPlainFirebirdInterbaseConstants, ZSysUtils, ZDbcInterbase6Utils, ZDbcLogging,
00067 ZDbcGenericResolver, ZTokenizer, ZGenericSqlAnalyser;
00068
00069 type
00070
00071 {** Implements Interbase6 Database Driver. }
00072 TZInterbase6Driver = class(TZAbstractDriver)
00073 private
00074 FInterbase6PlainDriver: IZInterbase6PlainDriver;
00075 FInterbase5PlainDriver: IZInterbase5PlainDriver;
00076 FFirebird10PlainDriver: IZFirebird10PlainDriver;
00077 FFirebird15PlainDriver: IZFirebird15PlainDriver;
00078 FFirebird20PlainDriver: IZFirebird20PlainDriver;
00079 FFirebird21PlainDriver: IZFirebird21PlainDriver;
00080
00081 FFirebirdD15PlainDriver: IZFirebird15PlainDriver;
00082 FFirebirdD20PlainDriver: IZFirebird20PlainDriver;
00083 FFirebirdD21PlainDriver: IZFirebird21PlainDriver;
00084
00085 protected
00086 function GetPlainDriver(const Url: string): IZInterbasePlainDriver;
00087 public
00088 constructor Create;
00089 function Connect(const Url: string; Info: TStrings): IZConnection; override;
00090
00091 function GetSupportedProtocols: TStringDynArray; override;
00092 function GetMajorVersion: Integer; override;
00093 function GetMinorVersion: Integer; override;
00094
00095 function GetTokenizer: IZTokenizer; override;
00096 function GetStatementAnalyser: IZStatementAnalyser; override;
00097 end;
00098
00099 {** Represents a Interbase specific connection interface. }
00100 IZInterbase6Connection = interface (IZConnection)
00101 ['{E870E4FE-21EB-4725-B5D8-38B8A2B12D0B}']
00102 function GetDBHandle: PISC_DB_HANDLE;
00103 function GetTrHandle: PISC_TR_HANDLE;
00104 function GetDialect: Word;
00105 function GetPlainDriver: IZInterbasePlainDriver;
00106 procedure CreateNewDatabase(const SQL: String);
00107 end;
00108
00109 {** Implements Interbase6 Database Connection. }
00110
00111 { TZInterbase6Connection }
00112
00113 TZInterbase6Connection = class(TZAbstractConnection, IZInterbase6Connection)
00114 private
00115 FDialect: Word;
00116 FHandle: TISC_DB_HANDLE;
00117 FTrHandle: TISC_TR_HANDLE;
00118 FStatusVector: TARRAY_ISC_STATUS;
00119 FPlainDriver: IZInterbasePlainDriver;
00120 FHardCommit: boolean;
00121 private
00122 procedure StartTransaction; virtual;
00123 public
00124 constructor Create(Driver: IZDriver; const Url: string;
00125 PlainDriver: IZInterbasePlainDriver;
00126 const HostName: string; Port: Integer; const Database: string;
00127 const User: string; const Password: string; Info: TStrings);
00128 destructor Destroy; override;
00129
00130 function GetDBHandle: PISC_DB_HANDLE;
00131 function GetTrHandle: PISC_TR_HANDLE;
00132 function GetDialect: Word;
00133 function GetPlainDriver: IZInterbasePlainDriver;
00134 procedure CreateNewDatabase(const SQL: String);
00135
00136 function CreateRegularStatement(Info: TStrings): IZStatement; override;
00137 function CreatePreparedStatement(const SQL: string; Info: TStrings):
00138 IZPreparedStatement; override;
00139 function CreateCallableStatement(const SQL: string; Info: TStrings):
00140 IZCallableStatement; override;
00141
00142 function CreateSequence(const Sequence: string; BlockSize: Integer):
00143 IZSequence; override;
00144
00145 procedure Commit; override;
00146 procedure Rollback; override;
00147
00148 function PingServer: Integer; override;
00149
00150 procedure Open; override;
00151 procedure Close; override;
00152 end;
00153
00154 {** Implements a specialized cached resolver for Interbase/Firebird. }
00155 TZInterbase6CachedResolver = class(TZGenericCachedResolver)
00156 public
00157 function FormCalculateStatement(Columns: TObjectList): string; override;
00158 end;
00159
00160 {** Implements a Interbase 6 sequence. }
00161 TZInterbase6Sequence = class(TZAbstractSequence)
00162 public
00163 function GetCurrentValue: Int64; override;
00164 function GetNextValue: Int64; override;
00165 function GetCurrentValueSQL: string; override;
00166 function GetNextValueSQL: string; override;
00167 end;
00168
00169
00170 var
00171 {** The common driver manager object. }
00172 Interbase6Driver: IZDriver;
00173
00174 implementation
00175
00176 uses ZDbcInterbase6Statement, ZDbcInterbase6Metadata,
00177 ZInterbaseToken, ZInterbaseAnalyser;
00178
00179 { TZInterbase6Driver }
00180
00181 {**
00182 Attempts to make a database connection to the given URL.
00183 The driver should return "null" if it realizes it is the wrong kind
00184 of driver to connect to the given URL. This will be common, as when
00185 the JDBC driver manager is asked to connect to a given URL it passes
00186 the URL to each loaded driver in turn.
00187
00188 <P>The driver should raise a SQLException if it is the right
00189 driver to connect to the given URL, but has trouble connecting to
00190 the database.
00191
00192 <P>The java.util.Properties argument can be used to passed arbitrary
00193 string tag/value pairs as connection arguments.
00194 Normally at least "user" and "password" properties should be
00195 included in the Properties.
00196
00197 @param url the URL of the database to which to connect
00198 @param info a list of arbitrary string tag/value pairs as
00199 connection arguments. Normally at least a "user" and
00200 "password" property should be included.
00201 @return a <code>Connection</code> object that represents a
00202 connection to the URL
00203 }
00204 function TZInterbase6Driver.Connect(const Url: string;
00205 Info: TStrings): IZConnection;
00206 var
00207 TempInfo: TStrings;
00208 HostName, Database, UserName, Password: string;
00209 Port: Integer;
00210 PlainDriver: IZInterbasePlainDriver;
00211 begin
00212 TempInfo := TStringList.Create;
00213 try
00214 ResolveDatabaseUrl(Url, Info, HostName, Port, Database,
00215 UserName, Password, TempInfo);
00216 PlainDriver := GetPlainDriver(Url);
00217 Result := TZInterbase6Connection.Create(Self, Url, PlainDriver, HostName,
00218 Port, Database, UserName, Password, TempInfo);
00219 finally
00220 TempInfo.Free;
00221 end;
00222 end;
00223
00224 {**
00225 Constructs this object with default properties.
00226 }
00227 constructor TZInterbase6Driver.Create;
00228 begin
00229 FInterbase6PlainDriver := TZInterbase6PlainDriver.Create;
00230 FInterbase5PlainDriver := TZInterbase5PlainDriver.Create;
00231 FFirebird10PlainDriver := TZFirebird10PlainDriver.Create;
00232 FFirebird15PlainDriver := TZFirebird15PlainDriver.Create;
00233 FFirebird20PlainDriver := TZFirebird20PlainDriver.Create;
00234 FFirebird21PlainDriver := TZFirebird21PlainDriver.Create;
00235
00236 FFirebirdD15PlainDriver := TZFirebirdD15PlainDriver.Create;
00237 FFirebirdD20PlainDriver := TZFirebirdD20PlainDriver.Create;
00238 FFirebirdD21PlainDriver := TZFirebirdD21PlainDriver.Create;
00239
00240 end;
00241
00242 {**
00243 Gets the driver's major version number. Initially this should be 1.
00244 @return this driver's major version number
00245 }
00246 function TZInterbase6Driver.GetMajorVersion: Integer;
00247 begin
00248 Result := 1;
00249 end;
00250
00251 {**
00252 Gets the driver's minor version number. Initially this should be 0.
00253 @return this driver's minor version number
00254 }
00255 function TZInterbase6Driver.GetMinorVersion: Integer;
00256 begin
00257 Result := 0;
00258 end;
00259
00260 {**
00261 Gets a SQL syntax tokenizer.
00262 @returns a SQL syntax tokenizer object.
00263 }
00264 function TZInterbase6Driver.GetTokenizer: IZTokenizer;
00265 begin
00266 if Tokenizer = nil then
00267 Tokenizer := TZInterbaseTokenizer.Create;
00268 Result := Tokenizer;
00269 end;
00270
00271 {**
00272 Creates a statement analyser object.
00273 @returns a statement analyser object.
00274 }
00275 function TZInterbase6Driver.GetStatementAnalyser: IZStatementAnalyser;
00276 begin
00277 if Analyser = nil then
00278 Analyser := TZInterbaseStatementAnalyser.Create;
00279 Result := Analyser;
00280 end;
00281
00282 {**
00283 Gets plain driver for selected protocol.
00284 @param Url a database connection URL.
00285 @return a selected protocol.
00286 }
00287 function TZInterbase6Driver.GetPlainDriver(
00288 const Url: string): IZInterbasePlainDriver;
00289 var
00290 Protocol: string;
00291 begin
00292 Protocol := ResolveConnectionProtocol(Url, GetSupportedProtocols);
00293
00294 if Protocol = FInterbase5PlainDriver.GetProtocol then
00295 Result := FInterbase5PlainDriver
00296 else if Protocol = FInterbase6PlainDriver.GetProtocol then
00297 Result := FInterbase6PlainDriver
00298 else if Protocol = FFirebird10PlainDriver.GetProtocol then
00299 Result := FFirebird10PlainDriver
00300 else if Protocol = FFirebird15PlainDriver.GetProtocol then
00301 Result := FFirebird15PlainDriver
00302 else if Protocol = FFirebird20PlainDriver.GetProtocol then
00303 Result := FFirebird20PlainDriver
00304 else if Protocol = FFirebird21PlainDriver.GetProtocol then
00305 Result := FFirebird21PlainDriver
00306
00307 else if Protocol = FFirebirdD15PlainDriver.GetProtocol then
00308 Result := FFirebirdD15PlainDriver
00309 else if Protocol = FFirebirdD20PlainDriver.GetProtocol then
00310 Result := FFirebirdD20PlainDriver
00311 else if Protocol = FFirebirdD21PlainDriver.GetProtocol then
00312 Result := FFirebirdD21PlainDriver
00313
00314 else Result := FInterbase6PlainDriver;
00315 Result.Initialize;
00316 end;
00317
00318 {**
00319 Get a name of the supported subprotocol.
00320 For example: mysql, oracle8 or postgresql72
00321 }
00322 function TZInterbase6Driver.GetSupportedProtocols: TStringDynArray;
00323 begin
00324 SetLength(Result, 9);
00325 Result[0] := 'interbase-5';
00326 Result[1] := 'interbase-6';
00327 Result[2] := 'firebird-1.0';
00328 Result[3] := 'firebird-1.5';
00329 Result[4] := 'firebird-2.0';
00330 Result[5] := 'firebird-2.1';
00331
00332 Result[6] := 'firebirdd-1.5';
00333 Result[7] := 'firebirdd-2.0';
00334 Result[8] := 'firebirdd-2.1';
00335
00336 end;
00337
00338 { TZInterbase6Connection }
00339
00340 {**
00341 Releases a Connection's database and JDBC resources
00342 immediately instead of waiting for
00343 them to be automatically released.
00344
00345 <P><B>Note:</B> A Connection is automatically closed when it is
00346 garbage collected. Certain fatal errors also result in a closed
00347 Connection.
00348 }
00349 procedure TZInterbase6Connection.Close;
00350 begin
00351 if Closed then Exit;
00352
00353 if FTrHandle <> nil then
00354 begin
00355 if AutoCommit then
00356 begin
00357 FPlainDriver.isc_commit_transaction(@FStatusVector, @FTrHandle);
00358 DriverManager.LogMessage(lcTransaction, FPlainDriver.GetProtocol,
00359 Format('COMMITT TRANSACTION "%s"', [Database]));
00360 end else begin
00361 FPlainDriver.isc_rollback_transaction(@FStatusVector, @FTrHandle);
00362 DriverManager.LogMessage(lcTransaction, FPlainDriver.GetProtocol,
00363 Format('ROLLBACK TRANSACTION "%s"', [Database]));
00364 end;
00365 FTrHandle := nil;
00366 CheckInterbase6Error(FPlainDriver, FStatusVector, lcDisconnect);
00367 end;
00368
00369 if FHandle <> nil then
00370 begin
00371 FPlainDriver.isc_detach_database(@FStatusVector, @FHandle);
00372 FHandle := nil;
00373 CheckInterbase6Error(FPlainDriver, FStatusVector, lcDisconnect);
00374 end;
00375
00376 DriverManager.LogMessage(lcConnect, FPlainDriver.GetProtocol,
00377 Format('DISCONNECT FROM "%s"', [Database]));
00378
00379 inherited Close;
00380 end;
00381
00382 {**
00383 Commit current transaction
00384 }
00385 procedure TZInterbase6Connection.Commit;
00386 begin
00387 if Closed then Exit;
00388
00389 if FTrHandle <> nil then
00390 begin
00391 if FHardCommit then
00392 begin
00393 FPlainDriver.isc_commit_transaction(@FStatusVector, @FTrHandle);
00394 FTrHandle := nil;
00395 end else
00396 FPlainDriver.isc_commit_retaining(@FStatusVector, @FTrHandle);
00397
00398 CheckInterbase6Error(FPlainDriver, FStatusVector, lcTransaction);
00399 DriverManager.LogMessage(lcTransaction,
00400 FPlainDriver.GetProtocol, 'TRANSACTION COMMIT');
00401 end;
00402 end;
00403
00404 {**
00405 Constructs this object and assignes the main properties.
00406 @param Driver the parent ZDBC driver.
00407 @param HostName a name of the host.
00408 @param Port a port number (0 for default port).
00409 @param Database a name pof the database.
00410 @param User a user name.
00411 @param Password a user password.
00412 @param Info a string list with extra connection parameters.
00413 }
00414 constructor TZInterbase6Connection.Create(Driver: IZDriver; const Url: string;
00415 PlainDriver: IZInterbasePlainDriver; const HostName: string; Port: Integer;
00416 const Database: string; const User: string; const Password: string;
00417 Info: TStrings);
00418 var
00419 RoleName: string;
00420 ClientCodePage: string;
00421 UserSetDialect: string;
00422 begin
00423 inherited Create(Driver, Url, HostName, Port, Database, User, Password, Info,
00424 TZInterbase6DatabaseMetadata.Create(Self, Url, Info));
00425
00426 FHardCommit := StrToBoolEx(Info.Values['hard_commit']);
00427
00428 FPlainDriver := PlainDriver;
00429
00430 { Sets a default Interbase port }
00431 if Self.Port = 0 then
00432 Self.Port := 3050;
00433
00434 { set default sql dialect it can be overriden }
00435 if FPlainDriver.GetProtocol = 'interbase-5' then
00436 FDialect := 1
00437 else FDialect := 3;
00438
00439 UserSetDialect := Trim(Info.Values['dialect']);
00440 if UserSetDialect <> '' then
00441 FDialect := StrToIntDef(UserSetDialect, FDialect);
00442
00443 { Processes connection properties. }
00444 self.Info.Values['isc_dpb_username'] := User;
00445 self.Info.Values['isc_dpb_password'] := Password;
00446
00447 ClientCodePage := Trim(Info.Values['codepage']);
00448 if ClientCodePage <> '' then
00449 self.Info.Values['isc_dpb_lc_ctype'] := UpperCase(ClientCodePage);
00450
00451 RoleName := Trim(Info.Values['rolename']);
00452 if RoleName <> '' then
00453 self.Info.Values['isc_dpb_sql_role_name'] := UpperCase(RoleName);
00454 end;
00455
00456 {**
00457 Creates a <code>Statement</code> object for sending
00458 SQL statements to the database.
00459 SQL statements without parameters are normally
00460 executed using Statement objects. If the same SQL statement
00461 is executed many times, it is more efficient to use a
00462 <code>PreparedStatement</code> object.
00463 <P>
00464 Result sets created using the returned <code>Statement</code>
00465 object will by default have forward-only type and read-only concurrency.
00466
00467 @param Info a statement parameters.
00468 @return a new Statement object
00469 }
00470 function TZInterbase6Connection.CreateRegularStatement(Info: TStrings):
00471 IZStatement;
00472 begin
00473 if IsClosed then Open;
00474 Result := TZInterbase6Statement.Create(Self, Info);
00475 end;
00476
00477 {**
00478 Destroys this object and cleanups the memory.
00479 }
00480 destructor TZInterbase6Connection.Destroy;
00481 begin
00482 if not Closed then
00483 Close;
00484
00485 inherited Destroy;
00486 end;
00487
00488 {**
00489 Get database connection handle.
00490 @return database handle
00491 }
00492 function TZInterbase6Connection.GetDBHandle: PISC_DB_HANDLE;
00493 begin
00494 Result := @FHandle;
00495 end;
00496
00497 {**
00498 Return Interbase dialect number. Dialect a dialect Interbase SQL
00499 must be 1 or 2 or 3.
00500 @return dialect number
00501 }
00502 function TZInterbase6Connection.GetDialect: Word;
00503 begin
00504 Result := FDialect;
00505 end;
00506
00507 {**
00508 Return native interbase plain driver
00509 @return plain driver
00510 }
00511 function TZInterbase6Connection.GetPlainDriver: IZInterbasePlainDriver;
00512 begin
00513 Result := FPlainDriver;
00514 end;
00515
00516 {**
00517 Get Interbase transaction handle
00518 @return transaction handle
00519 }
00520 function TZInterbase6Connection.GetTrHandle: PISC_TR_HANDLE;
00521 begin
00522 if (FHardCommit and (FTrHandle = nil)) then
00523 StartTransaction;
00524 Result := @FTrHandle;
00525 end;
00526
00527 {**
00528 Opens a connection to database server with specified parameters.
00529 }
00530 procedure TZInterbase6Connection.Open;
00531 var
00532 DPB: PChar;
00533 FDPBLength: Word;
00534 DBName: array[0..512] of Char;
00535 begin
00536 if not Closed then Exit;
00537
00538 if TransactIsolationLevel = tiReadUncommitted then
00539 raise EZSQLException.Create('Isolation level do not capable');
00540
00541 DPB := GenerateDPB(Info, FDPBLength, FDialect);
00542
00543 if HostName <> '' then
00544 begin
00545 if Port <> 3050 then
00546 StrPCopy(DBName, HostName + '/' + IntToStr(Port) + ':' + Database)
00547 else
00548 StrPCopy(DBName, HostName + ':' + Database)
00549 end else
00550 StrPCopy(DBName, Database);
00551
00552 try
00553 { Create new db if needed }
00554 if Info.Values['createNewDatabase'] <> '' then
00555 begin
00556 CreateNewDatabase(Info.Values['createNewDatabase']);
00557 { Logging connection action }
00558 DriverManager.LogMessage(lcConnect, FPlainDriver.GetProtocol,
00559 Format('CREATE DATABASE "%s" AS USER "%s"', [Info.Values['createNewDatabase'], User]));
00560 end;
00561
00562 { Connect to Interbase6 database. }
00563 FHandle := nil;
00564 FPlainDriver.isc_attach_database(@FStatusVector, StrLen(DBName), DBName,
00565 @FHandle, FDPBLength, DPB);
00566
00567 { Check connection error }
00568 CheckInterbase6Error(FPlainDriver, FStatusVector, lcConnect);
00569
00570 { Logging connection action }
00571 DriverManager.LogMessage(lcConnect, FPlainDriver.GetProtocol,
00572 Format('CONNECT TO "%s" AS USER "%s"', [Database, User]));
00573
00574 { Start transaction }
00575 if not FHardCommit then
00576 StartTransaction;
00577
00578 inherited Open;
00579 finally
00580 StrDispose(DPB);
00581 end;
00582 end;
00583
00584 {**
00585 Creates a <code>PreparedStatement</code> object for sending
00586 parameterized SQL statements to the database.
00587
00588 A SQL statement with or without IN parameters can be
00589 pre-compiled and stored in a PreparedStatement object. This
00590 object can then be used to efficiently execute this statement
00591 multiple times.
00592
00593 <P><B>Note:</B> This method is optimized for handling
00594 parametric SQL statements that benefit from precompilation. If
00595 the driver supports precompilation,
00596 the method <code>prepareStatement</code> will send
00597 the statement to the database for precompilation. Some drivers
00598 may not support precompilation. In this case, the statement may
00599 not be sent to the database until the <code>PreparedStatement</code> is
00600 executed. This has no direct effect on users; however, it does
00601 affect which method throws certain SQLExceptions.
00602
00603 Result sets created using the returned PreparedStatement will have
00604 forward-only type and read-only concurrency, by default.
00605
00606 @param sql a SQL statement that may contain one or more '?' IN
00607 parameter placeholders
00608 @return a new PreparedStatement object containing the
00609 pre-compiled statement
00610 }
00611 function TZInterbase6Connection.CreatePreparedStatement(
00612 const SQL: string; Info: TStrings): IZPreparedStatement;
00613 begin
00614 if IsClosed then Open;
00615 Result := TZInterbase6PreparedStatement.Create(Self, SQL, Info);
00616 end;
00617
00618 {**
00619 Creates a <code>CallableStatement</code> object for calling
00620 database stored procedures.
00621 The <code>CallableStatement</code> object provides
00622 methods for setting up its IN and OUT parameters, and
00623 methods for executing the call to a stored procedure.
00624
00625 <P><B>Note:</B> This method is optimized for handling stored
00626 procedure call statements. Some drivers may send the call
00627 statement to the database when the method <code>prepareCall</code>
00628 is done; others
00629 may wait until the <code>CallableStatement</code> object
00630 is executed. This has no
00631 direct effect on users; however, it does affect which method
00632 throws certain SQLExceptions.
00633
00634 Result sets created using the returned CallableStatement will have
00635 forward-only type and read-only concurrency, by default.
00636
00637 @param sql a SQL statement that may contain one or more '?'
00638 parameter placeholders. Typically this statement is a JDBC
00639 function call escape string.
00640 @param Info a statement parameters.
00641 @return a new CallableStatement object containing the
00642 pre-compiled SQL statement
00643 }
00644 function TZInterbase6Connection.CreateCallableStatement(const SQL: string;
00645 Info: TStrings): IZCallableStatement;
00646 begin
00647 if IsClosed then Open;
00648 Result := TZInterbase6CallableStatement.Create(Self, SQL, Info);
00649 end;
00650
00651 {**
00652 Conver parameters list to Interbase6 parameter index and values
00653 and sore it in the list.
00654 <P><B>Note:</B>
00655 Parameter value sored in list as value.
00656 Interbase6 parameter index store as object link.
00657 @see #GenerateDPB
00658 @see #GenerateTPB
00659 @param the list of Interbase6 prepared parameters
00660 }
00661
00662 {**
00663 Drops all changes made since the previous
00664 commit/rollback and releases any database locks currently held
00665 by this Connection. This method should be used only when auto-
00666 commit has been disabled.
00667 @see #setAutoCommit
00668 }
00669 procedure TZInterbase6Connection.Rollback;
00670 begin
00671 if FTrHandle <> nil then
00672 begin
00673 if FHardCommit then
00674 begin
00675 FPlainDriver.isc_rollback_transaction(@FStatusVector, @FTrHandle);
00676 FTrHandle := nil;
00677 end else
00678 FPlainDriver.isc_rollback_retaining(@FStatusVector, @FTrHandle);
00679 CheckInterbase6Error(FPlainDriver, FStatusVector);
00680 DriverManager.LogMessage(lcTransaction,
00681 FPlainDriver.GetProtocol, 'TRANSACTION ROLLBACK');
00682 end;
00683 end;
00684
00685 {**
00686 Checks if a connection is still alive by doing a call to isc_database_info
00687 It does not matter what info we request, we are not looking at it, as long
00688 as it is something which should _always_ work if the connection is there.
00689 We check if the error returned is one of the net_* errors described in the
00690 firebird client documentation (335544721 .. 335544727).
00691 Returns 0 if the connection is OK
00692 Returns non zeor if the connection is not OK
00693 }
00694 function TZInterbase6Connection.PingServer: integer;
00695 var
00696 DatabaseInfoCommand: Char;
00697 Buffer: array[0..IBBigLocalBufferLength - 1] of AnsiChar;
00698 ErrorCode: ISC_STATUS;
00699 begin
00700 DatabaseInfoCommand := Char(isc_info_reads);
00701
00702 ErrorCode := FPlainDriver.isc_database_info(@FStatusVector, @FHandle, 1, @DatabaseInfoCommand,
00703 IBLocalBufferLength, Buffer);
00704
00705 if (ErrorCode >= 335544721) and (ErrorCode <= 335544727) then
00706 result := -1
00707 else
00708 result := 0;
00709 end;
00710
00711 {**
00712 Start Interbase transaction
00713 }
00714 procedure TZInterbase6Connection.StartTransaction;
00715 var
00716 Params: TStrings;
00717 PTEB: PISC_TEB;
00718 begin
00719 PTEB := nil;
00720 Params := TStringList.Create;
00721
00722 { Set transaction parameters by TransactIsolationLevel }
00723 Params.Add('isc_tpb_version3');
00724 case TransactIsolationLevel of
00725 tiReadCommitted:
00726 begin
00727 Params.Add('isc_tpb_read_committed');
00728 Params.Add('isc_tpb_rec_version');
00729 Params.Add('isc_tpb_nowait');
00730 end;
00731 tiRepeatableRead:
00732 begin
00733 Params.Add('isc_tpb_concurrency');
00734 Params.Add('isc_tpb_nowait');
00735 end;
00736 tiSerializable:
00737 begin
00738 Params.Add('isc_tpb_consistency');
00739 end;
00740 else
00741 begin
00742 { Add user defined parameters for traansaction }
00743 Params.Clear;
00744 Params.AddStrings(Info);
00745 end;
00746 end;
00747
00748 try
00749 { GenerateTPB return PTEB with null pointer tpb_address from defaul
00750 transaction }
00751 PTEB := GenerateTPB(Params, FHandle);
00752 FPlainDriver.isc_start_multiple(@FStatusVector, @FTrHandle, 1, PTEB);
00753 CheckInterbase6Error(FPlainDriver, FStatusVector, lcTransaction);
00754 DriverManager.LogMessage(lcTransaction, FPlainDriver.GetProtocol,
00755 'TRANSACTION STARTED.');
00756 finally
00757 Params.Free;
00758 StrDispose(PTEB.tpb_address);
00759 FreeMem(PTEB);
00760 end
00761 end;
00762
00763 {**
00764 Creates new database
00765 @param SQL a sql strinf for creation database
00766 }
00767 procedure TZInterbase6Connection.CreateNewDatabase(const SQL: String);
00768 var
00769 DbHandle: PISC_DB_HANDLE;
00770 TrHandle: PISC_TR_HANDLE;
00771 begin
00772 Close;
00773 DbHandle := nil;
00774 TrHandle := nil;
00775 FPlainDriver.isc_dsql_execute_immediate(@FStatusVector, @DbHandle, @TrHandle, 0, PChar(sql),
00776 FDialect, nil);
00777 CheckInterbase6Error(FPlainDriver, FStatusVector, lcExecute, SQL);
00778 FPlainDriver.isc_detach_database(@FStatusVector, @DbHandle);
00779 CheckInterbase6Error(FPlainDriver, FStatusVector, lcExecute, SQL);
00780 end;
00781
00782 {**
00783 Creates a sequence generator object.
00784 @param Sequence a name of the sequence generator.
00785 @param BlockSize a number of unique keys requested in one trip to SQL server.
00786 @returns a created sequence object.
00787 }
00788 function TZInterbase6Connection.CreateSequence(const Sequence: string;
00789 BlockSize: Integer): IZSequence;
00790 begin
00791 Result := TZInterbase6Sequence.Create(Self, Sequence, BlockSize);
00792 end;
00793
00794 { TZInterbase6CachedResolver }
00795
00796 {**
00797 Forms a where clause for SELECT statements to calculate default values.
00798 @param Columns a collection of key columns.
00799 @param OldRowAccessor an accessor object to old column values.
00800 }
00801 function TZInterbase6CachedResolver.FormCalculateStatement(
00802 Columns: TObjectList): string;
00803 // --> ms, 30/10/2005
00804 var iPos: Integer;
00805 begin
00806 Result := inherited FormCalculateStatement(Columns);
00807 if Result <> '' then begin
00808 iPos := pos('FROM', uppercase(Result));
00809 if iPos > 0 then begin
00810 Result := copy(Result, 1, iPos+3) + ' RDB$DATABASE';
00811 end
00812 else begin
00813 Result := Result + ' FROM RDB$DATABASE';
00814 end;
00815 end;
00816 // <-- ms
00817 end;
00818
00819 { TZInterbase6Sequence }
00820
00821 {**
00822 Gets the current unique key generated by this sequence.
00823 @param the next generated unique key.
00824 }
00825 function TZInterbase6Sequence.GetCurrentValue: Int64;
00826 var
00827 Statement: IZStatement;
00828 ResultSet: IZResultSet;
00829 begin
00830 Statement := Connection.CreateStatement;
00831 ResultSet := Statement.ExecuteQuery(Format(
00832 'SELECT GEN_ID("%s", 0) FROM rdb$generators ' +
00833 'WHERE rdb$generators.rdb$generator_name = ''%s''', [Name, Name]));
00834 if ResultSet.Next then
00835 Result := ResultSet.GetLong(1)
00836 else
00837 Result := inherited GetCurrentValue;
00838 ResultSet.Close;
00839 Statement.Close;
00840 end;
00841
00842 {**
00843 Gets the next unique key generated by this sequence.
00844 @param the next generated unique key.
00845 }
00846 function TZInterbase6Sequence.GetCurrentValueSQL: string;
00847 begin
00848 Result := Format(' GEN_ID("%s", 0) ', [Name]);
00849 end;
00850
00851 function TZInterbase6Sequence.GetNextValue: Int64;
00852 var
00853 Statement: IZStatement;
00854 ResultSet: IZResultSet;
00855 begin
00856 Statement := Connection.CreateStatement;
00857 ResultSet := Statement.ExecuteQuery(Format(
00858 'SELECT GEN_ID("%s", %d) FROM rdb$generators ' +
00859 'WHERE rdb$generators.rdb$generator_name = ''%s''', [Name, BlockSize, Name]));
00860 if ResultSet.Next then
00861 Result := ResultSet.GetLong(1)
00862 else
00863 Result := inherited GetNextValue;
00864 ResultSet.Close;
00865 Statement.Close;
00866 end;
00867
00868 function TZInterbase6Sequence.GetNextValueSQL: string;
00869 begin
00870 Result := Format(' GEN_ID("%s", %d) ', [Name, BlockSize]);
00871 end;
00872
00873 initialization
00874 Interbase6Driver := TZInterbase6Driver.Create;
00875 DriverManager.RegisterDriver(Interbase6Driver);
00876
00877 finalization
00878 if Assigned(DriverManager) then
00879 DriverManager.DeregisterDriver(Interbase6Driver);
00880 Interbase6Driver := nil;
00881 end.