ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBDatabase.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBDatabase.pas (file contents):
Revision 13 by tony, Thu Nov 22 22:53:40 2012 UTC vs.
Revision 47 by tony, Mon Jan 9 15:31:51 2017 UTC

# Line 35 | Line 35 | unit IBDatabase;
35  
36   {$Mode Delphi}
37  
38 + {$codepage UTF8}
39 +
40   interface
41  
42   uses
# Line 43 | Line 45 | uses
45   {$ELSE}
46    unix,
47   {$ENDIF}
48 <  Dialogs, Controls, StdCtrls, SysUtils, Classes, Forms, ExtCtrls, IBHeader, IBExternals, DB,
47 <  IB, DBLoginDlg;
48 >  SysUtils, Classes, FPTimer, IBExternals, DB, IB, CustApp, IBTypes;
49  
50   const
51    DPBPrefix = 'isc_dpb_';
# Line 115 | Line 116 | const
116      'set_db_readonly',
117      'set_db_sql_dialect',
118      'gfix_attach',
119 <    'gstat_attach'
119 >    'gstat_attach',
120 >    'set_db_charset',
121 >    'gsec_attach',
122 >    'address_path' ,
123 >    'process_id',
124 >    'no_db_triggers',
125 >    'trusted_auth',
126 >    'process_name',
127 >    'trusted_role',
128 >    'org_filename',
129 >    'utf8_ilename',
130 >    'ext_call_depth'
131    );
132  
133    TPBPrefix = 'isc_tpb_';
# Line 139 | Line 151 | const
151      'rec_version',
152      'no_rec_version',
153      'restart_requests',
154 <    'no_auto_undo'
154 >    'no_auto_undo',
155 >    'lock_timeout'
156    );
157  
158   type
# Line 155 | Line 168 | type
168    { TIBDatabase }
169    TIBDataBase = class(TCustomConnection)
170    private
171 +    FAttachment: IAttachment;
172 +    FCreateDatabase: boolean;
173 +    FCreateIfNotExists: boolean;
174 +    FDefaultCharSetID: integer;
175 +    FDefaultCharSetName: RawByteString;
176 +    FDefaultCodePage: TSystemCodePage;
177 +    FDPB: IDPB;
178      FAllowStreamedConnected: boolean;
179      FHiddenPassword: string;
180 <    FIBLoaded: Boolean;
180 >    FOnCreateDatabase: TNotifyEvent;
181      FOnLogin: TIBDatabaseLoginEvent;
182 +    FSQLHourGlass: Boolean;
183      FTraceFlags: TTraceFlags;
184      FDBSQLDialect: Integer;
185      FSQLDialect: Integer;
186      FOnDialectDowngradeWarning: TNotifyEvent;
166    FCanTimeout: Boolean;
187      FSQLObjects: TList;
188      FTransactions: TList;
189      FDBName: TIBFileName;
190      FDBParams: TStrings;
191      FDBParamsChanged: Boolean;
172    FDPB: PChar;
173    FDPBLength: Short;
174    FHandle: TISC_DB_HANDLE;
175    FHandleIsShared: Boolean;
192      FOnIdleTimer: TNotifyEvent;
193      FDefaultTransaction: TIBTransaction;
194      FInternalTransaction: TIBTransaction;
195 <    FStreamedConnected: Boolean;
180 <    FTimer: TTimer;
195 >    FTimer: TFPTimer;
196      FUserNames: TStringList;
197      FDataSets: TList;
198      FLoginCalled: boolean;
199 +    FUseDefaultSystemCodePage: boolean;
200      procedure EnsureInactive;
201      function GetDBSQLDialect: Integer;
202      function GetSQLDialect: Integer;
# Line 190 | Line 206 | type
206      procedure DBParamsChanging(Sender: TObject);
207      function GetSQLObject(Index: Integer): TIBBase;
208      function GetSQLObjectCount: Integer;
193    function GetDBParamByDPB(const Idx: Integer): String;
209      function GetIdleTimer: Integer;
210      function GetTransaction(Index: Integer): TIBTransaction;
211      function GetTransactionCount: Integer;
212 <    function Login: Boolean;
212 >    function Login(var aDatabaseName: string): Boolean;
213      procedure SetDatabaseName(const Value: TIBFileName);
214      procedure SetDBParamByDPB(const Idx: Integer; Value: String);
215      procedure SetDBParams(Value: TStrings);
# Line 212 | Line 227 | type
227      procedure DoDisconnect; override;
228      function GetConnected: Boolean; override;
229      procedure CheckStreamConnect;
230 +    procedure HandleException(Sender: TObject);
231      procedure Notification( AComponent: TComponent; Operation: TOperation); override;
232      function GetDataset(Index : longint) : TDataset; override;
233      function GetDataSetCount : Longint; override;
# Line 224 | Line 240 | type
240      procedure CloseDataSets;
241      procedure CheckActive;
242      procedure CheckInactive;
243 <    procedure CreateDatabase;
243 >    procedure CreateDatabase; overload;
244 >    procedure CreateDatabase(createDatabaseSQL: string); overload;
245      procedure DropDatabase;
246      procedure ForceClose;
247      procedure GetFieldNames(const TableName: string; List: TStrings);
# Line 232 | Line 249 | type
249      function IndexOfDBConst(st: String): Integer;
250      function TestConnected: Boolean;
251      procedure CheckDatabaseName;
235    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
252      function AddTransaction(TR: TIBTransaction): Integer;
253      function FindTransaction(TR: TIBTransaction): Integer;
254      function FindDefaultTransaction(): TIBTransaction;
255      procedure RemoveTransaction(Idx: Integer);
256      procedure RemoveTransactions;
241    procedure SetHandle(Value: TISC_DB_HANDLE);
257  
258 <    property Handle: TISC_DB_HANDLE read FHandle;
258 >    property Attachment: IAttachment read FAttachment;
259 >    property DBSQLDialect : Integer read FDBSQLDialect;
260      property IsReadOnly: Boolean read GetIsReadOnly;
245    property DBParamByDPB[const Idx: Integer]: String read GetDBParamByDPB
246                                                      write SetDBParamByDPB;
261      property SQLObjectCount: Integer read GetSQLObjectCount;
262      property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
249    property HandleIsShared: Boolean read FHandleIsShared;
263      property TransactionCount: Integer read GetTransactionCount;
264      property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
265      property InternalTransaction: TIBTransaction read FInternalTransaction;
266 +    property DefaultCharSetName: RawByteString read FDefaultCharSetName;
267 +    property DefaultCharSetID: integer read FDefaultCharSetID;
268 +    property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
269  
270    published
271      property Connected;
272 +    property CreateIfNotExists: boolean read FCreateIfNotExists write FCreateIfNotExists;
273      property AllowStreamedConnected: boolean read FAllowStreamedConnected
274               write FAllowStreamedConnected;
275      property DatabaseName: TIBFileName read FDBName write SetDatabaseName;
# Line 262 | Line 279 | type
279                                                   write SetDefaultTransaction;
280      property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
281      property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
282 <    property DBSQLDialect : Integer read FDBSQLDialect;
282 >    property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
283      property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
284 +    property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
285 +                                               write FUseDefaultSystemCodePage;
286      property AfterConnect;
287      property AfterDisconnect;
288      property BeforeConnect;
289      property BeforeDisconnect;
290 +    property OnCreateDatabase: TNotifyEvent read FOnCreateDatabase write FOnCreateDatabase;
291      property OnLogin: TIBDatabaseLoginEvent read FOnLogin write FOnLogin;
292      property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
293      property OnDialectDowngradeWarning: TNotifyEvent read FOnDialectDowngradeWarning write FOnDialectDowngradeWarning;
294    end;
295  
296 <  { TIBTransaction }
296 >  TDefaultEndAction = TARollback..TACommit;
297  
298 <  TTransactionAction         = (TARollback, TACommit, TARollbackRetaining, TACommitRetaining);
298 >  { TIBTransaction }
299  
300    TIBTransaction = class(TComponent)
301    private
302 <    FIBLoaded: Boolean;
303 <    FCanTimeout         : Boolean;
302 >    FTransactionIntf: ITransaction;
303 >    FAfterDelete: TNotifyEvent;
304 >    FAfterEdit: TNotifyEvent;
305 >    FAfterExecQuery: TNotifyEvent;
306 >    FAfterInsert: TNotifyEvent;
307 >    FAfterPost: TNotifyEvent;
308 >    FAfterTransactionEnd: TNotifyEvent;
309 >    FBeforeTransactionEnd: TNotifyEvent;
310      FDatabases          : TList;
311 +    FOnStartTransaction: TNotifyEvent;
312      FSQLObjects         : TList;
313      FDefaultDatabase    : TIBDatabase;
287    FHandle             : TISC_TR_HANDLE;
288    FHandleIsShared     : Boolean;
314      FOnIdleTimer          : TNotifyEvent;
315      FStreamedActive     : Boolean;
316 <    FTPB                : PChar;
317 <    FTPBLength          : Short;
318 <    FTimer              : TTimer;
294 <    FDefaultAction      : TTransactionAction;
316 >    FTPB                : ITPB;
317 >    FTimer              : TFPTimer;
318 >    FDefaultAction      : TDefaultEndAction;
319      FTRParams           : TStrings;
320      FTRParamsChanged    : Boolean;
321      FInEndTransaction   : boolean;
322 +    FEndAction          : TTransactionAction;
323 +    procedure DoBeforeTransactionEnd;
324 +    procedure DoAfterTransactionEnd;
325 +    procedure DoOnStartTransaction;
326 +    procedure DoAfterExecQuery(Sender: TObject);
327 +    procedure DoAfterEdit(Sender: TObject);
328 +    procedure DoAfterDelete(Sender: TObject);
329 +    procedure DoAfterInsert(Sender: TObject);
330 +    procedure DoAfterPost(Sender: TObject);
331      procedure EnsureNotInTransaction;
332      procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
333      function GetDatabase(Index: Integer): TIBDatabase;
# Line 305 | Line 338 | type
338      function GetIdleTimer: Integer;
339      procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
340      procedure SetActive(Value: Boolean);
308    procedure SetDefaultAction(Value: TTransactionAction);
341      procedure SetDefaultDatabase(Value: TIBDatabase);
342      procedure SetIdleTimer(Value: Integer);
343      procedure SetTRParams(Value: TStrings);
# Line 318 | Line 350 | type
350  
351    protected
352      procedure Loaded; override;
321    procedure SetHandle(Value: TISC_TR_HANDLE);
353      procedure Notification( AComponent: TComponent; Operation: TOperation); override;
354  
355    public
356      constructor Create(AOwner: TComponent); override;
357      destructor Destroy; override;
327    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
358      procedure Commit;
359      procedure CommitRetaining;
360      procedure Rollback;
# Line 336 | Line 366 | type
366      function AddDatabase(db: TIBDatabase): Integer;
367      function FindDatabase(db: TIBDatabase): Integer;
368      function FindDefaultDatabase: TIBDatabase;
369 +    function GetEndAction: TTransactionAction;
370      procedure RemoveDatabase(Idx: Integer);
371      procedure RemoveDatabases;
372      procedure CheckDatabasesInList;
# Line 344 | Line 375 | type
375      property Databases[Index: Integer]: TIBDatabase read GetDatabase;
376      property SQLObjectCount: Integer read GetSQLObjectCount;
377      property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
347    property Handle: TISC_TR_HANDLE read FHandle;
348    property HandleIsShared: Boolean read FHandleIsShared;
378      property InTransaction: Boolean read GetInTransaction;
379 <    property TPB: PChar read FTPB;
380 <    property TPBLength: Short read FTPBLength;
379 >    property TransactionIntf: ITransaction read FTransactionIntf;
380 >    property TPB: ITPB read FTPB;
381    published
382      property Active: Boolean read GetInTransaction write SetActive;
383      property DefaultDatabase: TIBDatabase read FDefaultDatabase
384                                             write SetDefaultDatabase;
385      property IdleTimer: Integer read GetIdleTimer write SetIdleTimer default 0;
386 <    property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
386 >    property DefaultAction: TDefaultEndAction read FDefaultAction write FDefaultAction default taCommit;
387      property Params: TStrings read FTRParams write SetTRParams;
388      property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
389 <  end;
389 >    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
390 >                                             write FBeforeTransactionEnd;
391 >    property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
392 >                                            write FAfterTransactionEnd;
393 >    property OnStartTransaction: TNotifyEvent read FOnStartTransaction
394 >                                              write FOnStartTransaction;
395 >    property AfterExecQuery: TNotifyEvent read FAfterExecQuery
396 >                                              write FAfterExecQuery;
397 >    property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit;
398 >    property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
399 >    property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert;
400 >    property AfterPost: TNotifyEvent read FAfterPost write FAfterPost;
401 >  end;
402 >
403 >  TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object;
404 >  TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings;
405 >                              var DBName: string) of object;
406  
407    { TIBBase }
408  
# Line 366 | Line 411 | type
411      connections. }
412    TIBBase = class(TObject)
413    protected
414 +    FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent;
415      FDatabase: TIBDatabase;
416      FIndexInDatabase: Integer;
417      FTransaction: TIBTransaction;
# Line 375 | Line 421 | type
421      FAfterDatabaseDisconnect: TNotifyEvent;
422      FAfterDatabaseConnect: TNotifyEvent;
423      FOnDatabaseFree: TNotifyEvent;
424 <    FBeforeTransactionEnd: TNotifyEvent;
424 >    FBeforeTransactionEnd: TTransactionEndEvent;
425      FAfterTransactionEnd: TNotifyEvent;
426      FOnTransactionFree: TNotifyEvent;
427  
428 +    procedure DoBeforeDatabaseConnect(DBParams: TStrings;
429 +                              var DBName: string); virtual;
430      procedure DoAfterDatabaseConnect; virtual;
431      procedure DoBeforeDatabaseDisconnect; virtual;
432      procedure DoAfterDatabaseDisconnect; virtual;
433      procedure DoDatabaseFree; virtual;
434 <    procedure DoBeforeTransactionEnd; virtual;
434 >    procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
435      procedure DoAfterTransactionEnd; virtual;
436      procedure DoTransactionFree; virtual;
389    function GetDBHandle: PISC_DB_HANDLE; virtual;
390    function GetTRHandle: PISC_TR_HANDLE; virtual;
437      procedure SetDatabase(Value: TIBDatabase); virtual;
438      procedure SetTransaction(Value: TIBTransaction); virtual;
439    public
# Line 395 | Line 441 | type
441      destructor Destroy; override;
442      procedure CheckDatabase; virtual;
443      procedure CheckTransaction; virtual;
444 +    procedure DoAfterExecQuery(Sender: TObject); virtual;
445 +    procedure DoAfterEdit(Sender: TObject); virtual;
446 +    procedure DoAfterDelete(Sender: TObject); virtual;
447 +    procedure DoAfterInsert(Sender: TObject); virtual;
448 +    procedure DoAfterPost(Sender: TObject); virtual;
449 +    procedure HandleException(Sender: TObject);
450 +    procedure SetCursor;
451 +    procedure RestoreCursor;
452    public
453 +    property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect
454 +                                                 write FBeforeDatabaseConnect;
455      property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
456                                                  write FAfterDatabaseConnect;
457      property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
# Line 403 | Line 459 | type
459      property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
460                                                    write FAfterDatabaseDisconnect;
461      property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
462 <    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
462 >    property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
463      property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
464      property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
465      property Database: TIBDatabase read FDatabase
466                                      write SetDatabase;
411    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
467      property Owner: TObject read FOwner;
413    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
468      property Transaction: TIBTransaction read FTransaction
469                                            write SetTransaction;
470    end;
471  
472 < procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
473 < procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
472 > function GenerateDPB(sl: TStrings): IDPB;
473 > function GenerateTPB(sl: TStrings): ITPB;
474  
475  
476   implementation
477  
478 < uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
479 <     typInfo;
478 > uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
479 >     typInfo, FBMessages, IBErrorCodes;
480  
481   { TIBDatabase }
482  
483 < constructor TIBDatabase.Create(AOwner: TComponent);
430 < {$ifdef WINDOWS}
431 < var acp: uint;
432 < {$endif}
483 > constructor TIBDataBase.Create(AOwner: TComponent);
484   begin
485    inherited Create(AOwner);
435  FIBLoaded := False;
436  CheckIBLoaded;
437  FIBLoaded := True;
486    LoginPrompt := True;
487    FSQLObjects := TList.Create;
488    FTransactions := TList.Create;
489    FDBName := '';
490    FDBParams := TStringList.Create;
491 <  {$ifdef UNIX}
492 <  if csDesigning in ComponentState then
493 <    FDBParams.Add('lc_ctype=UTF-8');
494 <  {$else}
495 <  {$ifdef WINDOWS}
448 <  if csDesigning in ComponentState then
449 <  begin
450 <    acp := GetACP;
451 <    if (acp >= 1250) and (acp <= 1254) then
452 <      FDBParams.Values['lc_ctype'] := Format('WIN%d',[acp]);
453 <  end;
454 <  {$endif}
455 <  {$endif}
491 >  FSQLHourGlass := true;
492 >  if (AOwner <> nil) and
493 >     (AOwner is TCustomApplication) and
494 >     TCustomApplication(AOWner).ConsoleApplication then
495 >    LoginPrompt := false;
496    FDBParamsChanged := True;
497    TStringList(FDBParams).OnChange := DBParamsChange;
498    TStringList(FDBParams).OnChanging := DBParamsChanging;
499    FDPB := nil;
460  FHandle := nil;
500    FUserNames := nil;
501    FInternalTransaction := TIBTransaction.Create(self);
502    FInternalTransaction.DefaultDatabase := Self;
503 <  FTimer := TTimer.Create(Self);
503 >  FTimer := TFPTimer.Create(Self);
504    FTimer.Enabled := False;
505    FTimer.Interval := 0;
506    FTimer.OnTimer := TimeoutConnection;
# Line 472 | Line 511 | begin
511    CheckStreamConnect;
512   end;
513  
514 < destructor TIBDatabase.Destroy;
514 > destructor TIBDataBase.Destroy;
515   var
516    i: Integer;
517   begin
518 <  if FIBLoaded then
519 <  begin
520 <    IdleTimer := 0;
521 <    if FHandle <> nil then
522 <      ForceClose;
523 <    for i := 0 to FSQLObjects.Count - 1 do
524 <      if FSQLObjects[i] <> nil then
525 <        SQLObjects[i].DoDatabaseFree;
526 <    RemoveSQLObjects;
527 <    RemoveTransactions;
528 <    FInternalTransaction.Free;
529 <    FreeMem(FDPB);
530 <    FDPB := nil;
531 <    FDBParams.Free;
493 <    FSQLObjects.Free;
494 <    FUserNames.Free;
495 <    FTransactions.Free;
496 <  end;
518 >  IdleTimer := 0;
519 >  if FAttachment <> nil then
520 >    ForceClose;
521 >  for i := 0 to FSQLObjects.Count - 1 do
522 >    if FSQLObjects[i] <> nil then
523 >      SQLObjects[i].DoDatabaseFree;
524 >  RemoveSQLObjects;
525 >  RemoveTransactions;
526 >  FInternalTransaction.Free;
527 >  FDPB := nil;
528 >  FDBParams.Free;
529 >  FSQLObjects.Free;
530 >  FUserNames.Free;
531 >  FTransactions.Free;
532    FDataSets.Free;
533    inherited Destroy;
534   end;
535  
536 < function TIBDatabase.Call(ErrCode: ISC_STATUS;
502 <  RaiseError: Boolean): ISC_STATUS;
503 < begin
504 <  result := ErrCode;
505 <  FCanTimeout := False;
506 <  if RaiseError and (ErrCode > 0) then
507 <    IBDataBaseError;
508 < end;
509 <
510 < procedure TIBDatabase.CheckActive;
536 > procedure TIBDataBase.CheckActive;
537   begin
538    if StreamedConnected and (not Connected) then
539      Loaded;
540 <  if FHandle = nil then
540 >  if FAttachment = nil then
541      IBError(ibxeDatabaseClosed, [nil]);
542   end;
543  
544 < procedure TIBDatabase.EnsureInactive;
544 > procedure TIBDataBase.EnsureInactive;
545   begin
546    if csDesigning in ComponentState then
547    begin
548 <    if FHandle <> nil then
548 >    if FAttachment <> nil then
549        Close;
550    end
551   end;
552  
553 < procedure TIBDatabase.CheckInactive;
553 > procedure TIBDataBase.CheckInactive;
554   begin
555 <  if FHandle <> nil then
555 >  if FAttachment <> nil then
556      IBError(ibxeDatabaseOpen, [nil]);
557   end;
558  
559 < procedure TIBDatabase.CheckDatabaseName;
559 > procedure TIBDataBase.CheckDatabaseName;
560   begin
561 <  if (FDBName = '') then
561 >  if (Trim(FDBName) = '') then
562      IBError(ibxeDatabaseNameMissing, [nil]);
563   end;
564  
565 < function TIBDatabase.AddSQLObject(ds: TIBBase): Integer;
565 > function TIBDataBase.AddSQLObject(ds: TIBBase): Integer;
566   begin
567    result := 0;
568    if (ds.Owner is TIBCustomDataSet) then
# Line 549 | Line 575 | begin
575      FSQLObjects[result] := ds;
576   end;
577  
578 < function TIBDatabase.AddTransaction(TR: TIBTransaction): Integer;
578 > function TIBDataBase.AddTransaction(TR: TIBTransaction): Integer;
579   begin
580    result := FindTransaction(TR);
581    if result <> -1 then
# Line 566 | Line 592 | begin
592      FTransactions[result] := TR;
593   end;
594  
595 < procedure TIBDatabase.DoDisconnect;
595 > procedure TIBDataBase.DoDisconnect;
596   begin
597    if Connected then
598      InternalClose(False);
599    FDBSQLDialect := 1;
600 +  FDefaultCharSetName := '';
601 +  FDefaultCharSetID := 0;
602 +  FDefaultCodePage := CP_NONE;
603   end;
604  
605 < procedure TIBDatabase.CreateDatabase;
577 < var
578 <  tr_handle: TISC_TR_HANDLE;
605 >  procedure TIBDataBase.CreateDatabase;
606   begin
607    CheckInactive;
608 <  tr_handle := nil;
609 <  Call(
610 <    isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0,
584 <                               PChar('CREATE DATABASE ''' + FDBName + ''' ' + {do not localize}
585 <                               Params.Text), SQLDialect, nil),
586 <    True);
608 >  CheckDatabaseName;
609 >  FCreateDatabase := true;
610 >  Connected := true;
611   end;
612  
613 < procedure TIBDatabase.DropDatabase;
613 > procedure TIBDataBase.CreateDatabase(createDatabaseSQL: string);
614 > var info: IDBInformation;
615 >    ConnectionType: integer;
616 >    SiteName: string;
617 > begin
618 >  CheckInactive;
619 >  FAttachment := FirebirdAPI.CreateDatabase(createDatabaseSQL,FSQLDialect);
620 >  info := FAttachment.GetDBInformation(isc_info_db_id);
621 >  info[0].DecodeIDCluster(ConnectionType,FDBName,SiteName);
622 >  if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
623 >    OnCreateDatabase(self);
624 > end;
625 >
626 > procedure TIBDataBase.DropDatabase;
627   begin
628    CheckActive;
629 <  Call(isc_drop_database(StatusVector, @FHandle), True);
629 >  FAttachment.DropDatabase;
630 >  FAttachment := nil;
631   end;
632  
633 < procedure TIBDatabase.DBParamsChange(Sender: TObject);
633 > procedure TIBDataBase.DBParamsChange(Sender: TObject);
634   begin
635    FDBParamsChanged := True;
636   end;
637  
638 < procedure TIBDatabase.DBParamsChanging(Sender: TObject);
638 > procedure TIBDataBase.DBParamsChanging(Sender: TObject);
639   begin
640    EnsureInactive;
641    CheckInactive;
642   end;
643  
644 < function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer;
644 > function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer;
645   var
646    i: Integer;
647   begin
# Line 616 | Line 654 | begin
654      end;
655   end;
656  
657 < function TIBDatabase.FindDefaultTransaction(): TIBTransaction;
657 > function TIBDataBase.FindDefaultTransaction: TIBTransaction;
658   var
659    i: Integer;
660   begin
# Line 634 | Line 672 | begin
672    end;
673   end;
674  
675 < procedure TIBDatabase.ForceClose;
675 > procedure TIBDataBase.ForceClose;
676   begin
677    if Connected then
678      InternalClose(True);
679   end;
680  
681 < function TIBDatabase.GetConnected: Boolean;
681 > function TIBDataBase.GetConnected: Boolean;
682   begin
683 <  result := FHandle <> nil;
683 >  result := (FAttachment <> nil) and FAttachment.IsConnected;
684   end;
685  
686 < function TIBDatabase.GetSQLObject(Index: Integer): TIBBase;
686 > function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
687   begin
688    result := FSQLObjects[Index];
689   end;
690  
691 < function TIBDatabase.GetSQLObjectCount: Integer;
691 > function TIBDataBase.GetSQLObjectCount: Integer;
692   var
693    i: Integer;
694   begin
# Line 659 | Line 697 | begin
697      Inc(result);
698   end;
699  
700 < function TIBDatabase.GetDBParamByDPB(const Idx: Integer): String;
663 < var
664 <  ConstIdx, EqualsIdx: Integer;
665 < begin
666 <  if (Idx > 0) and (Idx <= isc_dpb_last_dpb_constant) then
667 <  begin
668 <    ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
669 <    if ConstIdx = -1 then
670 <      result := ''
671 <    else
672 <    begin
673 <      result := Params[ConstIdx];
674 <      EqualsIdx := Pos('=', result); {mbcs ok}
675 <      if EqualsIdx = 0 then
676 <        result := ''
677 <      else
678 <        result := Copy(result, EqualsIdx + 1, Length(result));
679 <    end;
680 <  end
681 <  else
682 <    result := '';
683 < end;
684 <
685 < function TIBDatabase.GetIdleTimer: Integer;
700 > function TIBDataBase.GetIdleTimer: Integer;
701   begin
702    result := FTimer.Interval;
703   end;
704  
705 < function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction;
705 > function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction;
706   begin
707    result := FTransactions[Index];
708   end;
709  
710 < function TIBDatabase.GetTransactionCount: Integer;
710 > function TIBDataBase.GetTransactionCount: Integer;
711   var
712    i: Integer;
713   begin
# Line 702 | Line 717 | begin
717        Inc(result);
718   end;
719  
720 < function TIBDatabase.IndexOfDBConst(st: String): Integer;
720 > function TIBDataBase.IndexOfDBConst(st: String): Integer;
721   var
722    i, pos_of_str: Integer;
723   begin
# Line 718 | Line 733 | begin
733    end;
734   end;
735  
736 < procedure TIBDatabase.InternalClose(Force: Boolean);
736 > procedure TIBDataBase.InternalClose(Force: Boolean);
737   var
738    i: Integer;
739   begin
# Line 747 | Line 762 | begin
762      end;
763    end;
764  
765 <  if (not HandleIsShared) and
766 <     (Call(isc_detach_database(StatusVector, @FHandle), False) > 0) and
752 <     (not Force) then
753 <    IBDataBaseError
754 <  else
755 <  begin
756 <    FHandle := nil;
757 <    FHandleIsShared := False;
758 <  end;
765 >  FAttachment.Disconnect(Force);
766 >  FAttachment := nil;
767  
768    if not (csDesigning in ComponentState) then
769      MonitorHook.DBDisconnect(Self);
# Line 787 | Line 795 | begin
795           (FDefaultTransaction.FStreamedActive) and
796           (not FDefaultTransaction.InTransaction) then
797          FDefaultTransaction.StartTransaction;
798 <      FStreamedConnected := False;
798 >      StreamedConnected := False;
799      end;
800    except
801      if csDesigning in ComponentState then
802 <      Application.HandleException(Self)
802 >      HandleException(Self)
803      else
804        raise;
805    end;
806   end;
807  
808 < procedure TIBDatabase.Notification( AComponent: TComponent;
809 <                                        Operation: TOperation);
808 > procedure TIBDataBase.HandleException(Sender: TObject);
809 > var aParent: TComponent;
810 > begin
811 >  aParent := Owner;
812 >  while aParent <> nil do
813 >  begin
814 >    if aParent is TCustomApplication then
815 >    begin
816 >      TCustomApplication(aParent).HandleException(Sender);
817 >      Exit;
818 >    end;
819 >    aParent := aParent.Owner;
820 >  end;
821 >  SysUtils.ShowException(ExceptObject,ExceptAddr);
822 > end;
823 >
824 > procedure TIBDataBase.Notification(AComponent: TComponent;
825 >   Operation: TOperation);
826   var
827    i: Integer;
828   begin
# Line 812 | Line 836 | begin
836    end;
837   end;
838  
839 < function TIBDatabase.Login: Boolean;
839 > function TIBDataBase.Login(var aDatabaseName: string): Boolean;
840   var
841    IndexOfUser, IndexOfPassword: Integer;
842    Username, Password, OldPassword: String;
# Line 848 | Line 872 | begin
872        LoginParams.Assign(Params);
873        FOnLogin(Self, LoginParams);
874        Params.Assign (LoginParams);
875 +      aDatabaseName := FDBName;
876        HidePassword;
877      finally
878        LoginParams.Free;
879      end;
880    end
881    else
882 +  if assigned(IBGUIInterface) then
883    begin
884      IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]);
885      if IndexOfUser <> -1 then
# Line 868 | Line 894 | begin
894                                           Length(Params[IndexOfPassword]));
895        OldPassword := password;
896      end;
897 <    result := LoginDialogEx(DatabaseName, Username, Password, False);
897 >
898 >    result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
899      if result then
900      begin
901 <      if IndexOfUser = -1 then
902 <        Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
903 <      else
904 <        Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
901 >      if Username <> '' then
902 >      begin
903 >        if IndexOfUser = -1 then
904 >          Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
905 >        else
906 >          Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
907                                   '=' + Username;
908 +      end
909 +      else
910 +      if IndexOfUser <> -1 then
911 +        Params.Delete(IndexOfUser);
912        if (Password = OldPassword) then
913          FHiddenPassword := ''
914        else
# Line 885 | Line 918 | begin
918            HidePassword;
919        end;
920      end;
921 <  end;
921 >  end
922 >  else
923 >  if LoginPrompt then
924 >     IBError(ibxeNoLoginDialog,[]);
925    finally
926      FLoginCalled := false
927    end;
928   end;
929  
930 < procedure TIBDatabase.DoConnect;
930 > procedure TIBDataBase.DoConnect;
931   var
896  DPB: String;
932    TempDBParams: TStrings;
933    I: integer;
934 <
934 >  aDBName: string;
935 >  Status: IStatus;
936 >  CharSetID: integer;
937   begin
938    CheckInactive;
939    CheckDatabaseName;
# Line 906 | Line 943 | begin
943      FDBParamsChanged := True;
944    end;
945    { Use builtin login prompt if requested }
946 <  if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
946 >  aDBName := FDBName;
947 >  if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
948      IBError(ibxeOperationCancelled, [nil]);
949 <  { Generate a new DPB if necessary }
950 <  if (FDBParamsChanged) then
951 <  begin
952 <    FDBParamsChanged := False;
953 <    if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
954 <      GenerateDPB(FDBParams, DPB, FDPBLength)
949 >
950 >  TempDBParams := TStringList.Create;
951 >  try
952 >   TempDBParams.Assign(FDBParams);
953 >   if UseDefaultSystemCodePage then
954 >   begin
955 >     {$ifdef WINDOWS}
956 >     if FirebirdAPI.CodePage2CharSetID(GetACP,CharSetID) then
957 >       TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
958 >     {$else}
959 >     if FirebirdAPI.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
960 >       TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
961 >     {$endif}
962 >     else
963 >       TempDBParams.Values['lc_ctype'] :='UTF8';
964 >   end;
965 >   {Opportunity to override defaults}
966 >   for i := 0 to FSQLObjects.Count - 1 do
967 >   begin
968 >       if FSQLObjects[i] <> nil then
969 >         SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
970 >   end;
971 >
972 >   FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
973 >   if FDefaultCharSetName <> '' then
974 >     FirebirdAPI.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
975 >   FirebirdAPI.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
976 >   { Generate a new DPB if necessary }
977 >   if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
978 >   begin
979 >     FDBParamsChanged := False;
980 >     if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
981 >       FDPB := GenerateDPB(TempDBParams)
982 >     else
983 >     begin
984 >        TempDBParams.Add('password=' + FHiddenPassword);
985 >        FDPB := GenerateDPB(TempDBParams);
986 >     end;
987 >   end;
988 >  finally
989 >   TempDBParams.Free;
990 >  end;
991 >
992 >  repeat
993 >    if FCreateDatabase then
994 >    begin
995 >      FCreateDatabase := false;
996 >      FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
997 >      if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
998 >        OnCreateDatabase(self);
999 >    end
1000      else
1001 +      FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
1002 +    if FAttachment = nil then
1003      begin
1004 <      TempDBParams := TStringList.Create;
1005 <      try
1006 <       TempDBParams.Assign(FDBParams);
1007 <       TempDBParams.Add('password=' + FHiddenPassword);
1008 <       GenerateDPB(TempDBParams, DPB, FDPBLength);
1009 <      finally
1010 <       TempDBParams.Free;
1004 >      Status := FirebirdAPI.GetStatus;
1005 >      {$IFDEF UNIX}
1006 >      if Pos(':',aDBName) = 0 then
1007 >      begin
1008 >          if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
1009 >             or
1010 >             ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
1011 >             or
1012 >             ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
1013 >             or
1014 >             ((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
1015 >             then
1016 >             begin
1017 >               aDBName := 'localhost:' + aDBName;
1018 >               Continue;
1019 >            end
1020        end;
1021 +      {$ENDIF}
1022 +      if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1023 +                       and CreateIfNotExists and not (csDesigning in ComponentState) then
1024 +        FCreateDatabase := true
1025 +      else
1026 +        raise EIBInterBaseError.Create(Status);
1027      end;
1028 <    IBAlloc(FDPB, 0, FDPBLength);
1029 <    Move(DPB[1], FDPB[0], FDPBLength);
1030 <  end;
931 <  if Call(isc_attach_database(StatusVector, Length(FDBName),
932 <                         PChar(FDBName), @FHandle,
933 <                         FDPBLength, FDPB), False) > 0 then
934 <  begin
935 <    FHandle := nil;
936 <    IBDataBaseError;
937 <  end;
1028 >  until FAttachment <> nil;
1029 >  if not (csDesigning in ComponentState) then
1030 >    FDBName := aDBName; {Synchronise at run time}
1031    FDBSQLDialect := GetDBSQLDialect;
1032    ValidateClientSQLDialect;
1033    for i := 0 to FSQLObjects.Count - 1 do
# Line 946 | Line 1039 | begin
1039      MonitorHook.DBConnect(Self);
1040   end;
1041  
1042 < procedure TIBDatabase.RemoveSQLObject(Idx: Integer);
1042 > procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
1043   var
1044    ds: TIBBase;
1045   begin
# Line 960 | Line 1053 | begin
1053    end;
1054   end;
1055  
1056 < procedure TIBDatabase.RemoveSQLObjects;
1056 > procedure TIBDataBase.RemoveSQLObjects;
1057   var
1058    i: Integer;
1059   begin
# Line 972 | Line 1065 | begin
1065    end;
1066   end;
1067  
1068 < procedure TIBDatabase.RemoveTransaction(Idx: Integer);
1068 > procedure TIBDataBase.RemoveTransaction(Idx: Integer);
1069   var
1070    TR: TIBTransaction;
1071   begin
# Line 986 | Line 1079 | begin
1079    end;
1080   end;
1081  
1082 < procedure TIBDatabase.RemoveTransactions;
1082 > procedure TIBDataBase.RemoveTransactions;
1083   var
1084    i: Integer;
1085   begin
# Line 994 | Line 1087 | begin
1087      RemoveTransaction(i);
1088   end;
1089  
1090 < procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName);
1090 > procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName);
1091   begin
1092    if FDBName <> Value then
1093    begin
# Line 1004 | Line 1097 | begin
1097    end;
1098   end;
1099  
1100 < procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String);
1100 > procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String);
1101   var
1102    ConstIdx: Integer;
1103   begin
# Line 1023 | Line 1116 | begin
1116    end;
1117   end;
1118  
1119 < procedure TIBDatabase.SetDBParams(Value: TStrings);
1119 > procedure TIBDataBase.SetDBParams(Value: TStrings);
1120   begin
1121    FDBParams.Assign(Value);
1122   end;
1123  
1124 < procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction);
1124 > procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction);
1125   var
1126    i: Integer;
1127   begin
# Line 1046 | Line 1139 | begin
1139    FDefaultTransaction := Value;
1140   end;
1141  
1142 < procedure TIBDatabase.SetHandle(Value: TISC_DB_HANDLE);
1050 < begin
1051 <  if HandleIsShared then
1052 <    Close
1053 <  else
1054 <    CheckInactive;
1055 <  FHandle := Value;
1056 <  FHandleIsShared := (Value <> nil);
1057 < end;
1058 <
1059 < procedure TIBDatabase.SetIdleTimer(Value: Integer);
1142 > procedure TIBDataBase.SetIdleTimer(Value: Integer);
1143   begin
1144    if Value < 0 then
1145      IBError(ibxeTimeoutNegative, [nil])
# Line 1075 | Line 1158 | begin
1158        end;
1159   end;
1160  
1161 < function TIBDatabase.TestConnected: Boolean;
1161 > function TIBDataBase.TestConnected: Boolean;
1162   var
1163    DatabaseInfo: TIBDatabaseInfo;
1164   begin
# Line 1096 | Line 1179 | begin
1179    end;
1180   end;
1181  
1182 < procedure TIBDatabase.TimeoutConnection(Sender: TObject);
1182 > procedure TIBDataBase.TimeoutConnection(Sender: TObject);
1183   begin
1184    if Connected then
1185    begin
1186 <    if FCanTimeout then
1186 >    if not FAttachment.HasActivity then
1187      begin
1188        ForceClose;
1189        if Assigned(FOnIdleTimer) then
1190          FOnIdleTimer(Self);
1191      end
1109    else
1110      FCanTimeout := True;
1192    end;
1193   end;
1194  
1195 < function TIBDatabase.GetIsReadOnly: Boolean;
1195 > function TIBDataBase.GetIsReadOnly: Boolean;
1196   var
1197    DatabaseInfo: TIBDatabaseInfo;
1198   begin
# Line 1129 | Line 1210 | begin
1210    DatabaseInfo.Free;
1211   end;
1212  
1213 < function TIBDatabase.GetSQLDialect: Integer;
1213 > function TIBDataBase.GetSQLDialect: Integer;
1214   begin
1215    Result := FSQLDialect;
1216   end;
1217  
1218  
1219 < procedure TIBDatabase.SetSQLDialect(const Value: Integer);
1219 > procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1220   begin
1221    if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1222 <  if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
1222 >  if ((FAttachment = nil) or (Value <= FDBSQLDialect))  then
1223      FSQLDialect := Value
1224    else
1225      IBError(ibxeSQLDialectInvalid, [nil]);
1226   end;
1227  
1228 < function TIBDatabase.GetDBSQLDialect: Integer;
1228 > function TIBDataBase.GetDBSQLDialect: Integer;
1229   var
1230    DatabaseInfo: TIBDatabaseInfo;
1231   begin
# Line 1154 | Line 1235 | begin
1235    DatabaseInfo.Free;
1236   end;
1237  
1238 < procedure TIBDatabase.ValidateClientSQLDialect;
1238 > procedure TIBDataBase.ValidateClientSQLDialect;
1239   begin
1240    if (FDBSQLDialect < FSQLDialect) then
1241    begin
# Line 1164 | Line 1245 | begin
1245    end;
1246   end;
1247  
1248 < procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet);
1248 > procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet);
1249   var
1250    I: Integer;
1251    DS: TIBCustomDataSet;
# Line 1190 | Line 1271 | begin
1271    TR.CommitRetaining;
1272   end;
1273  
1274 < procedure TIBDatabase.CloseDataSets;
1274 > procedure TIBDataBase.CloseDataSets;
1275   var
1276    i: Integer;
1277   begin
# Line 1199 | Line 1280 | begin
1280        DataSets[i].close;
1281   end;
1282  
1283 < function TIBDatabase.GetDataset(Index : longint) : TDataset;
1283 > function TIBDataBase.GetDataset(Index: longint): TDataset;
1284   begin
1285    if (Index >= 0) and (Index < FDataSets.Count) then
1286      Result := TDataSet(FDataSets[Index])
# Line 1207 | Line 1288 | begin
1288      raise Exception.Create('Invalid Index to DataSets');
1289   end;
1290  
1291 < function TIBDatabase.GetDataSetCount : Longint;
1291 > function TIBDataBase.GetDataSetCount: Longint;
1292   begin
1293    Result := FDataSets.Count;
1294   end;
# Line 1228 | Line 1309 | begin
1309    inherited SetConnected(Value);
1310   end;
1311  
1312 < procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings);
1312 > procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings);
1313   var
1314    Query: TIBSQL;
1315   begin
# Line 1257 | Line 1338 | begin
1338        BeginUpdate;
1339        try
1340          Clear;
1341 <        while (not Query.EOF) and (Query.Next <> nil) do
1342 <          List.Add(TrimRight(Query.Current.ByName('RDB$FIELD_NAME').AsString)); {do not localize}
1341 >        while (not Query.EOF) and Query.Next  do
1342 >          List.Add(TrimRight(Query.FieldByName('RDB$FIELD_NAME').AsString)); {do not localize}
1343        finally
1344          EndUpdate;
1345        end;
# Line 1269 | Line 1350 | begin
1350    end;
1351   end;
1352  
1353 < procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean);
1353 > procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean);
1354   var
1355    Query : TIBSQL;
1356   begin
# Line 1297 | Line 1378 | begin
1378          BeginUpdate;
1379          try
1380            Clear;
1381 <          while (not Query.EOF) and (Query.Next <> nil) do
1382 <            List.Add(TrimRight(Query.Current[0].AsString));
1381 >          while (not Query.EOF) and Query.Next  do
1382 >            List.Add(TrimRight(Query.Fields[0].AsString));
1383          finally
1384            EndUpdate;
1385          end;
# Line 1315 | Line 1396 | end;
1396   constructor TIBTransaction.Create(AOwner: TComponent);
1397   begin
1398    inherited Create(AOwner);
1318  FIBLoaded := False;
1319  CheckIBLoaded;
1320  FIBLoaded := True;
1321  CheckIBLoaded;
1399    FDatabases := TList.Create;
1400    FSQLObjects := TList.Create;
1324  FHandle := nil;
1401    FTPB := nil;
1326  FTPBLength := 0;
1402    FTRParams := TStringList.Create;
1403    FTRParamsChanged := True;
1404    TStringList(FTRParams).OnChange := TRParamsChange;
1405    TStringList(FTRParams).OnChanging := TRParamsChanging;
1406 <  FTimer := TTimer.Create(Self);
1406 >  FTimer := TFPTimer.Create(Self);
1407    FTimer.Enabled := False;
1408    FTimer.Interval := 0;
1409    FTimer.OnTimer := TimeoutTransaction;
# Line 1339 | Line 1414 | destructor TIBTransaction.Destroy;
1414   var
1415    i: Integer;
1416   begin
1417 <  if FIBLoaded then
1418 <  begin
1419 <    if InTransaction then
1420 <      EndTransaction(FDefaultAction, True);
1421 <    for i := 0 to FSQLObjects.Count - 1 do
1422 <      if FSQLObjects[i] <> nil then
1423 <        SQLObjects[i].DoTransactionFree;
1424 <    RemoveSQLObjects;
1425 <    RemoveDatabases;
1426 <    FreeMem(FTPB);
1427 <    FTPB := nil;
1353 <    FTRParams.Free;
1354 <    FSQLObjects.Free;
1355 <    FDatabases.Free;
1356 <  end;
1417 >  if InTransaction then
1418 >    EndTransaction(FDefaultAction, True);
1419 >  for i := 0 to FSQLObjects.Count - 1 do
1420 >    if FSQLObjects[i] <> nil then
1421 >      SQLObjects[i].DoTransactionFree;
1422 >  RemoveSQLObjects;
1423 >  RemoveDatabases;
1424 >  FTPB := nil;
1425 >  FTRParams.Free;
1426 >  FSQLObjects.Free;
1427 >  FDatabases.Free;
1428    inherited Destroy;
1429   end;
1430  
1360 function TIBTransaction.Call(ErrCode: ISC_STATUS;
1361  RaiseError: Boolean): ISC_STATUS;
1362 var
1363  i: Integer;
1364 begin
1365  result := ErrCode;
1366  for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1367    Databases[i].FCanTimeout := False;
1368  FCanTimeout := False;
1369  if RaiseError and (result > 0) then
1370    IBDataBaseError;
1371 end;
1372
1431   procedure TIBTransaction.CheckDatabasesInList;
1432   begin
1433    if GetDatabaseCount = 0 then
# Line 1380 | Line 1438 | procedure TIBTransaction.CheckInTransact
1438   begin
1439    if FStreamedActive and (not InTransaction) then
1440      Loaded;
1441 <  if (FHandle = nil) then
1441 >  if (TransactionIntf = nil) then
1442      IBError(ibxeNotInTransaction, [nil]);
1443   end;
1444  
1445 + procedure TIBTransaction.DoBeforeTransactionEnd;
1446 + begin
1447 +  if Assigned(FBeforeTransactionEnd) then
1448 +    FBeforeTransactionEnd(self);
1449 + end;
1450 +
1451 + procedure TIBTransaction.DoAfterTransactionEnd;
1452 + begin
1453 +  if Assigned(FAfterTransactionEnd) then
1454 +    FAfterTransactionEnd(self);
1455 + end;
1456 +
1457 + procedure TIBTransaction.DoOnStartTransaction;
1458 + begin
1459 +  if assigned(FOnStartTransaction) then
1460 +    OnStartTransaction(self);
1461 + end;
1462 +
1463 + procedure TIBTransaction.DoAfterExecQuery(Sender: TObject);
1464 + begin
1465 +  if assigned(FAfterExecQuery) then
1466 +    AfterExecQuery(Sender);
1467 + end;
1468 +
1469 + procedure TIBTransaction.DoAfterEdit(Sender: TObject);
1470 + begin
1471 +  if assigned(FAfterEdit) then
1472 +    AfterEdit(Sender);
1473 + end;
1474 +
1475 + procedure TIBTransaction.DoAfterDelete(Sender: TObject);
1476 + begin
1477 +  if assigned(FAfterDelete) then
1478 +    AfterDelete(Sender);
1479 + end;
1480 +
1481 + procedure TIBTransaction.DoAfterInsert(Sender: TObject);
1482 + begin
1483 +  if assigned(FAfterInsert) then
1484 +    AfterInsert(Sender);
1485 + end;
1486 +
1487 + procedure TIBTransaction.DoAfterPost(Sender: TObject);
1488 + begin
1489 +  if assigned(FAfterPost) then
1490 +    AfterPost(Sender);
1491 + end;
1492 +
1493   procedure TIBTransaction.EnsureNotInTransaction;
1494   begin
1495    if csDesigning in ComponentState then
1496    begin
1497 <    if FHandle <> nil then
1497 >    if TransactionIntf <> nil then
1498        Rollback;
1499    end;
1500   end;
1501  
1502   procedure TIBTransaction.CheckNotInTransaction;
1503   begin
1504 <  if (FHandle <> nil) then
1504 >  if (TransactionIntf <> nil) and  TransactionIntf.InTransaction then
1505      IBError(ibxeInTransaction, [nil]);
1506   end;
1507  
# Line 1404 | Line 1510 | var
1510    i: Integer;
1511    NilFound: Boolean;
1512   begin
1513 +  EnsureNotInTransaction;
1514 +  CheckNotInTransaction;
1515 +  FTransactionIntf := nil;
1516 +
1517    i := FindDatabase(db);
1518    if i <> -1 then
1519    begin
# Line 1454 | Line 1564 | end;
1564   procedure TIBTransaction.EndTransaction(Action: TTransactionAction;
1565    Force: Boolean);
1566   var
1457  status: ISC_STATUS;
1567    i: Integer;
1568   begin
1569    CheckInTransaction;
1570    if FInEndTransaction then Exit;
1571    FInEndTransaction := true;
1572 +  FEndAction := Action;
1573    try
1574    case Action of
1575      TARollback, TACommit:
1576      begin
1577 <      if (HandleIsShared) and
1468 <         (Action <> FDefaultAction) and
1469 <         (not Force) then
1470 <        IBError(ibxeCantEndSharedTransaction, [nil]);
1577 >      DoBeforeTransactionEnd;
1578        for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1579 <        SQLObjects[i].DoBeforeTransactionEnd;
1579 >        SQLObjects[i].DoBeforeTransactionEnd(Action);
1580        if InTransaction then
1581        begin
1582 <        if HandleIsShared then
1583 <        begin
1477 <          FHandle := nil;
1478 <          FHandleIsShared := False;
1479 <          status := 0;
1480 <        end
1481 <        else
1482 <          if (Action = TARollback) then
1483 <            status := Call(isc_rollback_transaction(StatusVector, @FHandle), False)
1484 <          else
1485 <            status := Call(isc_commit_transaction(StatusVector, @FHandle), False);
1486 <        if ((Force) and (status > 0)) then
1487 <          status := Call(isc_rollback_transaction(StatusVector, @FHandle), False);
1488 <        if Force then
1489 <          FHandle := nil
1582 >        if (Action = TARollback) then
1583 >            FTransactionIntf.Rollback(Force)
1584          else
1585 <          if (status > 0) then
1586 <            IBDataBaseError;
1585 >        try
1586 >          FTransactionIntf.Commit;
1587 >        except on E: EIBInterBaseError do
1588 >          begin
1589 >            if Force then
1590 >              FTransactionIntf.Rollback(Force)
1591 >            else
1592 >              raise;
1593 >          end;
1594 >        end;
1595 >
1596          for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1597            SQLObjects[i].DoAfterTransactionEnd;
1598 +        DoAfterTransactionEnd;
1599        end;
1600      end;
1601      TACommitRetaining:
1602 <      Call(isc_commit_retaining(StatusVector, @FHandle), True);
1602 >      FTransactionIntf.CommitRetaining;
1603 >
1604      TARollbackRetaining:
1605 <      Call(isc_rollback_retaining(StatusVector, @FHandle), True);
1605 >      FTransactionIntf.RollbackRetaining;
1606    end;
1607    if not (csDesigning in ComponentState) then
1608    begin
# Line 1549 | Line 1654 | end;
1654  
1655   function TIBTransaction.GetInTransaction: Boolean;
1656   begin
1657 <  result := (FHandle <> nil);
1657 >  result := (TransactionIntf <> nil) and TransactionIntf.InTransaction;
1658   end;
1659  
1660   function TIBTransaction.FindDatabase(db: TIBDatabase): Integer;
# Line 1582 | Line 1687 | begin
1687    end;
1688   end;
1689  
1690 + function TIBTransaction.GetEndAction: TTransactionAction;
1691 + begin
1692 +  if FInEndTransaction then
1693 +     Result := FEndAction
1694 +  else
1695 +     IBError(ibxeIB60feature, [nil])
1696 + end;
1697 +
1698  
1699   function TIBTransaction.GetIdleTimer: Integer;
1700   begin
# Line 1597 | Line 1710 | procedure TIBTransaction.BeforeDatabaseD
1710   begin
1711    if InTransaction then
1712      EndTransaction(FDefaultAction, True);
1713 +  FTransactionIntf := nil;
1714   end;
1715  
1716   procedure TIBTransaction.RemoveDatabase(Idx: Integer);
# Line 1605 | Line 1719 | var
1719   begin
1720    if ((Idx >= 0) and (FDatabases[Idx] <> nil)) then
1721    begin
1722 +    EnsureNotInTransaction;
1723 +    CheckNotInTransaction;
1724 +    FTransactionIntf := nil;
1725 +
1726      DB := Databases[Idx];
1727      FDatabases[Idx] := nil;
1728      DB.RemoveTransaction(DB.FindTransaction(Self));
# Line 1617 | Line 1735 | procedure TIBTransaction.RemoveDatabases
1735   var
1736    i: Integer;
1737   begin
1738 +  EnsureNotInTransaction;
1739 +  CheckNotInTransaction;
1740 +  FTransactionIntf := nil;
1741 +
1742    for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1743      RemoveDatabase(i);
1744   end;
# Line 1663 | Line 1785 | begin
1785          Rollback;
1786   end;
1787  
1666 procedure TIBTransaction.SetDefaultAction(Value: TTransactionAction);
1667 begin
1668 (*  if (Value = taRollbackRetaining) and (GetIBClientVersion < 6) then
1669    IBError(ibxeIB60feature, [nil]);*)
1670  FDefaultAction := Value;
1671 end;
1672
1788   procedure TIBTransaction.SetDefaultDatabase(Value: TIBDatabase);
1789   var
1790    i: integer;
# Line 1687 | Line 1802 | begin
1802      for i := 0 to FSQLObjects.Count - 1 do
1803        if (FSQLObjects[i] <> nil) and
1804           (TIBBase(FSQLObjects[i]).Database = nil) then
1805 <        SetOrdProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Integer(Value));
1805 >         SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value);
1806    end;
1807    FDefaultDatabase := Value;
1808   end;
1809  
1695 procedure TIBTransaction.SetHandle(Value: TISC_TR_HANDLE);
1696 begin
1697  if (HandleIsShared) then
1698    EndTransaction(DefaultAction, True)
1699  else
1700    CheckNotInTransaction;
1701  FHandle := Value;
1702  FHandleIsShared := (Value <> nil);
1703 end;
1704
1810   procedure TIBTransaction.Notification( AComponent: TComponent;
1811                                          Operation: TOperation);
1812   var
# Line 1743 | Line 1848 | end;
1848  
1849   procedure TIBTransaction.StartTransaction;
1850   var
1746  pteb: PISC_TEB_ARRAY;
1747  TPB: String;
1851    i: Integer;
1852 +  Attachments: array of IAttachment;
1853 +  ValidDatabaseCount: integer;
1854   begin
1855    CheckNotInTransaction;
1856    CheckDatabasesInList;
1857 +  if TransactionIntf <> nil then
1858 +  begin
1859 +    TransactionIntf.Start(DefaultAction);
1860 +    Exit;
1861 +  end;
1862 +
1863    for i := 0 to FDatabases.Count - 1 do
1864     if  FDatabases[i] <> nil then
1865     begin
1866       with TIBDatabase(FDatabases[i]) do
1867       if not Connected then
1868 <       if FStreamedConnected then
1868 >       if StreamedConnected then
1869         begin
1870           Open;
1871 <         FStreamedConnected := False;
1871 >         StreamedConnected := False;
1872         end
1873         else
1874           IBError(ibxeDatabaseClosed, [nil]);
# Line 1765 | Line 1876 | begin
1876    if FTRParamsChanged then
1877    begin
1878      FTRParamsChanged := False;
1879 <    GenerateTPB(FTRParams, TPB, FTPBLength);
1769 <    if FTPBLength > 0 then
1770 <    begin
1771 <      IBAlloc(FTPB, 0, FTPBLength);
1772 <      Move(TPB[1], FTPB[0], FTPBLength);
1773 <    end;
1879 >    FTPB :=  GenerateTPB(FTRParams);
1880    end;
1881  
1882 <  pteb := nil;
1883 <  IBAlloc(pteb, 0, DatabaseCount * SizeOf(TISC_TEB));
1884 <  try
1885 <    for i := 0 to DatabaseCount - 1 do if Databases[i] <> nil then
1886 <    begin
1887 <      pteb^[i].db_handle := @(Databases[i].Handle);
1888 <      pteb^[i].tpb_length := FTPBLength;
1889 <      pteb^[i].tpb_address := FTPB;
1890 <    end;
1891 <    if Call(isc_start_multiple(StatusVector, @FHandle,
1892 <                               DatabaseCount, PISC_TEB(pteb)), False) > 0 then
1893 <    begin
1894 <      FHandle := nil;
1895 <      IBDataBaseError;
1790 <    end;
1791 <    if not (csDesigning in ComponentState) then
1792 <      MonitorHook.TRStart(Self);
1793 <  finally
1794 <    FreeMem(pteb);
1882 >  ValidDatabaseCount := 0;
1883 >  for i := 0 to DatabaseCount - 1 do
1884 >    if Databases[i] <> nil then Inc(ValidDatabaseCount);
1885 >
1886 >  if ValidDatabaseCount = 1 then
1887 >    FTransactionIntf := Databases[0].Attachment.StartTransaction(FTPB,DefaultAction)
1888 >  else
1889 >  begin
1890 >    SetLength(Attachments,ValidDatabaseCount);
1891 >    for i := 0 to DatabaseCount - 1 do
1892 >      if Databases[i] <> nil then
1893 >        Attachments[i] := Databases[i].Attachment;
1894 >
1895 >    FTransactionIntf := FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction);
1896    end;
1897 +
1898 +  if not (csDesigning in ComponentState) then
1899 +      MonitorHook.TRStart(Self);
1900 +  DoOnStartTransaction;
1901   end;
1902  
1903   procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
1904   begin
1905    if InTransaction then
1906    begin
1907 <    if FCanTimeout then
1907 >    if not TransactionIntf.HasActivity then
1908      begin
1909        EndTransaction(FDefaultAction, True);
1910        if Assigned(FOnIdleTimer) then
1911          FOnIdleTimer(Self);
1912      end
1808    else
1809      FCanTimeout := True;
1913    end;
1914   end;
1915  
# Line 1819 | Line 1922 | procedure TIBTransaction.TRParamsChangin
1922   begin
1923    EnsureNotInTransaction;
1924    CheckNotInTransaction;
1925 +  FTransactionIntf := nil;
1926   end;
1927  
1928   { TIBBase }
# Line 1834 | Line 1938 | begin
1938    inherited Destroy;
1939   end;
1940  
1941 + procedure TIBBase.HandleException(Sender: TObject);
1942 + begin
1943 +  if assigned(Database) then
1944 +     Database.HandleException(Sender)
1945 +  else
1946 +     SysUtils.ShowException(ExceptObject,ExceptAddr);
1947 + end;
1948 +
1949 + procedure TIBBase.SetCursor;
1950 + begin
1951 +  if Assigned(Database) and not Database.SQLHourGlass then
1952 +     Exit;
1953 +  if assigned(IBGUIInterface) then
1954 +     IBGUIInterface.SetCursor;
1955 + end;
1956 +
1957 + procedure TIBBase.RestoreCursor;
1958 + begin
1959 +  if Assigned(Database) and not Database.SQLHourGlass then
1960 +     Exit;
1961 +  if assigned(IBGUIInterface) then
1962 +     IBGUIInterface.RestoreCursor;
1963 + end;
1964 +
1965   procedure TIBBase.CheckDatabase;
1966   begin
1967    if (FDatabase = nil) then
# Line 1848 | Line 1976 | begin
1976    FTransaction.CheckInTransaction;
1977   end;
1978  
1979 < function TIBBase.GetDBHandle: PISC_DB_HANDLE;
1980 < begin
1853 <  CheckDatabase;
1854 <  result := @FDatabase.Handle;
1855 < end;
1856 <
1857 < function TIBBase.GetTRHandle: PISC_TR_HANDLE;
1979 > procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
1980 >  );
1981   begin
1982 <  CheckTransaction;
1983 <  result := @FTransaction.Handle;
1982 >  if assigned(FBeforeDatabaseConnect) then
1983 >    BeforeDatabaseConnect(self,DBParams,DBName);
1984   end;
1985  
1986   procedure TIBBase.DoAfterDatabaseConnect;
# Line 1886 | Line 2009 | begin
2009    SetTransaction(nil);
2010   end;
2011  
2012 < procedure TIBBase.DoBeforeTransactionEnd;
2012 > procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction);
2013   begin
2014    if Assigned(BeforeTransactionEnd) then
2015 <    BeforeTransactionEnd(Self);
2015 >    BeforeTransactionEnd(Self,Action);
2016   end;
2017  
2018   procedure TIBBase.DoAfterTransactionEnd;
# Line 1905 | Line 2028 | begin
2028    FTransaction := nil;
2029   end;
2030  
2031 + procedure TIBBase.DoAfterExecQuery(Sender: TObject);
2032 + begin
2033 +  if FTransaction <> nil then
2034 +    FTransaction.DoAfterExecQuery(Sender);
2035 + end;
2036 +
2037 + procedure TIBBase.DoAfterEdit(Sender: TObject);
2038 + begin
2039 +  if FTransaction <> nil then
2040 +    FTransaction.DoAfterEdit(Sender);
2041 + end;
2042 +
2043 + procedure TIBBase.DoAfterDelete(Sender: TObject);
2044 + begin
2045 +  if FTransaction <> nil then
2046 +    FTransaction.DoAfterDelete(Sender);
2047 + end;
2048 +
2049 + procedure TIBBase.DoAfterInsert(Sender: TObject);
2050 + begin
2051 +  if FTransaction <> nil then
2052 +    FTransaction.DoAfterInsert(Sender);
2053 + end;
2054 +
2055 + procedure TIBBase.DoAfterPost(Sender: TObject);
2056 + begin
2057 +  if FTransaction <> nil then
2058 +    FTransaction.DoAfterPost(Sender);
2059 + end;
2060 +
2061   procedure TIBBase.SetDatabase(Value: TIBDatabase);
2062   begin
2063    if (FDatabase <> nil) then
# Line 1937 | Line 2090 | end;
2090    parameter buffer, and return it and its length
2091    in DPB and DPBLength, respectively. }
2092  
2093 < procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
2093 > function GenerateDPB(sl: TStrings): IDPB;
2094   var
2095 <  i, j, pval: Integer;
2095 >  i, j: Integer;
2096    DPBVal: UShort;
2097    ParamName, ParamValue: string;
2098   begin
2099 <  { The DPB is initially empty, with the exception that
1947 <    the DPB version must be the first byte of the string. }
1948 <  DPBLength := 1;
1949 <  DPB := Char(isc_dpb_version1);
2099 >  Result := FirebirdAPI.AllocateDPB;
2100  
2101    {Iterate through the textual database parameters, constructing
2102     a DPB on-the-fly }
# Line 1985 | Line 2135 | begin
2135        begin
2136          if DPBVal = isc_dpb_sql_dialect then
2137            ParamValue[1] := Char(Ord(ParamValue[1]) - 48);
2138 <        DPB := DPB +
1989 <               Char(DPBVal) +
1990 <               Char(Length(ParamValue)) +
1991 <               ParamValue;
1992 <        Inc(DPBLength, 2 + Length(ParamValue));
2138 >        Result.Add(DPBVal).SetAsString(ParamValue);
2139        end;
2140 +
2141        isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write,
2142        isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify:
2143 <      begin
2144 <        DPB := DPB +
1998 <               Char(DPBVal) +
1999 <               #1 +
2000 <               Char(StrToInt(ParamValue));
2001 <        Inc(DPBLength, 3);
2002 <      end;
2143 >        Result.Add(DPBVal).SetAsByte(byte(ParamValue[1]));
2144 >
2145        isc_dpb_sweep:
2146 <      begin
2147 <        DPB := DPB +
2006 <               Char(DPBVal) +
2007 <               #1 +
2008 <               Char(isc_dpb_records);
2009 <        Inc(DPBLength, 3);
2010 <      end;
2146 >        Result.Add(DPBVal).SetAsByte(isc_dpb_records);
2147 >
2148        isc_dpb_sweep_interval:
2149 <      begin
2150 <        pval := StrToInt(ParamValue);
2014 <        DPB := DPB +
2015 <               Char(DPBVal) +
2016 <               #4 +
2017 <               PChar(@pval)[0] +
2018 <               PChar(@pval)[1] +
2019 <               PChar(@pval)[2] +
2020 <               PChar(@pval)[3];
2021 <        Inc(DPBLength, 6);
2022 <      end;
2149 >        Result.Add(DPBVal).SetAsInteger(StrToInt(ParamValue));
2150 >
2151        isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
2152        isc_dpb_quit_log:
2153 <      begin
2026 <        DPB := DPB +
2027 <               Char(DPBVal) +
2028 <               #1 + #0;
2029 <        Inc(DPBLength, 3);
2030 <      end;
2153 >        Result.Add(DPBVal).SetAsByte(0);
2154        else
2155        begin
2156          if (DPBVal > 0) and
# Line 2045 | Line 2168 | end;
2168    of the transaction parameters, generate a transaction
2169    parameter buffer, and return it and its length in
2170    TPB and TPBLength, respectively. }
2171 < procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
2171 > function GenerateTPB(sl: TStrings): ITPB;
2172   var
2173 <  i, j, TPBVal, ParamLength: Integer;
2173 >  i, j, TPBVal: Integer;
2174    ParamName, ParamValue: string;
2175   begin
2176 <  TPB := '';
2054 <  if (sl.Count = 0) then
2055 <    TPBLength := 0
2056 <  else
2057 <  begin
2058 <    TPBLength := sl.Count + 1;
2059 <    TPB := TPB + Char(isc_tpb_version3);
2060 <  end;
2176 >  Result := FirebirdAPI.AllocateTPB;
2177    for i := 0 to sl.Count - 1 do
2178    begin
2179      if (Trim(sl[i]) =  '') then
2064    begin
2065      Dec(TPBLength);
2180        Continue;
2181 <    end;
2181 >
2182      if (Pos('=', sl[i]) = 0) then {mbcs ok}
2183        ParamName := LowerCase(sl[i]) {mbcs ok}
2184      else
# Line 2088 | Line 2202 | begin
2202        isc_tpb_concurrency, isc_tpb_shared, isc_tpb_wait, isc_tpb_nowait,
2203        isc_tpb_read, isc_tpb_write, isc_tpb_ignore_limbo,
2204        isc_tpb_read_committed, isc_tpb_rec_version, isc_tpb_no_rec_version:
2205 <        TPB := TPB + Char(TPBVal);
2205 >        Result.Add(TPBVal);
2206 >
2207        isc_tpb_lock_read, isc_tpb_lock_write:
2208 <      begin
2209 <        TPB := TPB + Char(TPBVal);
2095 <        { Now set the string parameter }
2096 <        ParamLength := Length(ParamValue);
2097 <        Inc(TPBLength, ParamLength + 1);
2098 <        TPB := TPB + Char(ParamLength) + ParamValue;
2099 <      end;
2208 >        Result.Add(TPBVal).SetAsString(ParamValue);
2209 >
2210        else
2211        begin
2212          if (TPBVal > 0) and

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines