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 7 by tony, Sun Aug 5 18:28:19 2012 UTC vs.
Revision 45 by tony, Tue Dec 6 10:33:46 2016 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;
234 +    procedure ReadState(Reader: TReader); override;
235      procedure SetConnected (Value : boolean); override;
236    public
237      constructor Create(AOwner: TComponent); override;
# Line 231 | Line 248 | type
248      function IndexOfDBConst(st: String): Integer;
249      function TestConnected: Boolean;
250      procedure CheckDatabaseName;
234    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
251      function AddTransaction(TR: TIBTransaction): Integer;
252      function FindTransaction(TR: TIBTransaction): Integer;
253      function FindDefaultTransaction(): TIBTransaction;
254      procedure RemoveTransaction(Idx: Integer);
255      procedure RemoveTransactions;
240    procedure SetHandle(Value: TISC_DB_HANDLE);
256  
257 <    property Handle: TISC_DB_HANDLE read FHandle;
257 >    property Attachment: IAttachment read FAttachment;
258 >    property DBSQLDialect : Integer read FDBSQLDialect;
259      property IsReadOnly: Boolean read GetIsReadOnly;
244    property DBParamByDPB[const Idx: Integer]: String read GetDBParamByDPB
245                                                      write SetDBParamByDPB;
260      property SQLObjectCount: Integer read GetSQLObjectCount;
261      property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
248    property HandleIsShared: Boolean read FHandleIsShared;
262      property TransactionCount: Integer read GetTransactionCount;
263      property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
264      property InternalTransaction: TIBTransaction read FInternalTransaction;
265 +    property DefaultCharSetName: RawByteString read FDefaultCharSetName;
266 +    property DefaultCharSetID: integer read FDefaultCharSetID;
267 +    property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
268  
269    published
270      property Connected;
271 +    property CreateIfNotExists: boolean read FCreateIfNotExists write FCreateIfNotExists;
272      property AllowStreamedConnected: boolean read FAllowStreamedConnected
273               write FAllowStreamedConnected;
274      property DatabaseName: TIBFileName read FDBName write SetDatabaseName;
# Line 261 | Line 278 | type
278                                                   write SetDefaultTransaction;
279      property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
280      property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
281 <    property DBSQLDialect : Integer read FDBSQLDialect;
281 >    property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
282      property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
283 +    property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
284 +                                               write FUseDefaultSystemCodePage;
285      property AfterConnect;
286      property AfterDisconnect;
287      property BeforeConnect;
288      property BeforeDisconnect;
289 +    property OnCreateDatabase: TNotifyEvent read FOnCreateDatabase write FOnCreateDatabase;
290      property OnLogin: TIBDatabaseLoginEvent read FOnLogin write FOnLogin;
291      property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
292      property OnDialectDowngradeWarning: TNotifyEvent read FOnDialectDowngradeWarning write FOnDialectDowngradeWarning;
293    end;
294  
295 <  { TIBTransaction }
295 >  TDefaultEndAction = TARollback..TACommit;
296  
297 <  TTransactionAction         = (TARollback, TACommit, TARollbackRetaining, TACommitRetaining);
297 >  { TIBTransaction }
298  
299    TIBTransaction = class(TComponent)
300    private
301 <    FIBLoaded: Boolean;
302 <    FCanTimeout         : Boolean;
301 >    FTransactionIntf: ITransaction;
302 >    FAfterDelete: TNotifyEvent;
303 >    FAfterEdit: TNotifyEvent;
304 >    FAfterExecQuery: TNotifyEvent;
305 >    FAfterInsert: TNotifyEvent;
306 >    FAfterPost: TNotifyEvent;
307 >    FAfterTransactionEnd: TNotifyEvent;
308 >    FBeforeTransactionEnd: TNotifyEvent;
309      FDatabases          : TList;
310 +    FOnStartTransaction: TNotifyEvent;
311      FSQLObjects         : TList;
312      FDefaultDatabase    : TIBDatabase;
286    FHandle             : TISC_TR_HANDLE;
287    FHandleIsShared     : Boolean;
313      FOnIdleTimer          : TNotifyEvent;
314      FStreamedActive     : Boolean;
315 <    FTPB                : PChar;
316 <    FTPBLength          : Short;
317 <    FTimer              : TTimer;
293 <    FDefaultAction      : TTransactionAction;
315 >    FTPB                : ITPB;
316 >    FTimer              : TFPTimer;
317 >    FDefaultAction      : TDefaultEndAction;
318      FTRParams           : TStrings;
319      FTRParamsChanged    : Boolean;
320      FInEndTransaction   : boolean;
321 +    FEndAction          : TTransactionAction;
322 +    procedure DoBeforeTransactionEnd;
323 +    procedure DoAfterTransactionEnd;
324 +    procedure DoOnStartTransaction;
325 +    procedure DoAfterExecQuery(Sender: TObject);
326 +    procedure DoAfterEdit(Sender: TObject);
327 +    procedure DoAfterDelete(Sender: TObject);
328 +    procedure DoAfterInsert(Sender: TObject);
329 +    procedure DoAfterPost(Sender: TObject);
330      procedure EnsureNotInTransaction;
331      procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
332      function GetDatabase(Index: Integer): TIBDatabase;
# Line 304 | Line 337 | type
337      function GetIdleTimer: Integer;
338      procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
339      procedure SetActive(Value: Boolean);
307    procedure SetDefaultAction(Value: TTransactionAction);
340      procedure SetDefaultDatabase(Value: TIBDatabase);
341      procedure SetIdleTimer(Value: Integer);
342      procedure SetTRParams(Value: TStrings);
# Line 317 | Line 349 | type
349  
350    protected
351      procedure Loaded; override;
320    procedure SetHandle(Value: TISC_TR_HANDLE);
352      procedure Notification( AComponent: TComponent; Operation: TOperation); override;
353  
354    public
355      constructor Create(AOwner: TComponent); override;
356      destructor Destroy; override;
326    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
357      procedure Commit;
358      procedure CommitRetaining;
359      procedure Rollback;
# Line 335 | Line 365 | type
365      function AddDatabase(db: TIBDatabase): Integer;
366      function FindDatabase(db: TIBDatabase): Integer;
367      function FindDefaultDatabase: TIBDatabase;
368 +    function GetEndAction: TTransactionAction;
369      procedure RemoveDatabase(Idx: Integer);
370      procedure RemoveDatabases;
371      procedure CheckDatabasesInList;
# Line 343 | Line 374 | type
374      property Databases[Index: Integer]: TIBDatabase read GetDatabase;
375      property SQLObjectCount: Integer read GetSQLObjectCount;
376      property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
346    property Handle: TISC_TR_HANDLE read FHandle;
347    property HandleIsShared: Boolean read FHandleIsShared;
377      property InTransaction: Boolean read GetInTransaction;
378 <    property TPB: PChar read FTPB;
379 <    property TPBLength: Short read FTPBLength;
378 >    property TransactionIntf: ITransaction read FTransactionIntf;
379 >    property TPB: ITPB read FTPB;
380    published
381      property Active: Boolean read GetInTransaction write SetActive;
382      property DefaultDatabase: TIBDatabase read FDefaultDatabase
383                                             write SetDefaultDatabase;
384      property IdleTimer: Integer read GetIdleTimer write SetIdleTimer default 0;
385 <    property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
385 >    property DefaultAction: TDefaultEndAction read FDefaultAction write FDefaultAction default taCommit;
386      property Params: TStrings read FTRParams write SetTRParams;
387      property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
388 <  end;
388 >    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
389 >                                             write FBeforeTransactionEnd;
390 >    property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
391 >                                            write FAfterTransactionEnd;
392 >    property OnStartTransaction: TNotifyEvent read FOnStartTransaction
393 >                                              write FOnStartTransaction;
394 >    property AfterExecQuery: TNotifyEvent read FAfterExecQuery
395 >                                              write FAfterExecQuery;
396 >    property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit;
397 >    property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
398 >    property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert;
399 >    property AfterPost: TNotifyEvent read FAfterPost write FAfterPost;
400 >  end;
401 >
402 >  TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object;
403 >  TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings;
404 >                              var DBName: string) of object;
405  
406    { TIBBase }
407  
# Line 365 | Line 410 | type
410      connections. }
411    TIBBase = class(TObject)
412    protected
413 +    FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent;
414      FDatabase: TIBDatabase;
415      FIndexInDatabase: Integer;
416      FTransaction: TIBTransaction;
# Line 374 | Line 420 | type
420      FAfterDatabaseDisconnect: TNotifyEvent;
421      FAfterDatabaseConnect: TNotifyEvent;
422      FOnDatabaseFree: TNotifyEvent;
423 <    FBeforeTransactionEnd: TNotifyEvent;
423 >    FBeforeTransactionEnd: TTransactionEndEvent;
424      FAfterTransactionEnd: TNotifyEvent;
425      FOnTransactionFree: TNotifyEvent;
426  
427 +    procedure DoBeforeDatabaseConnect(DBParams: TStrings;
428 +                              var DBName: string); virtual;
429      procedure DoAfterDatabaseConnect; virtual;
430      procedure DoBeforeDatabaseDisconnect; virtual;
431      procedure DoAfterDatabaseDisconnect; virtual;
432      procedure DoDatabaseFree; virtual;
433 <    procedure DoBeforeTransactionEnd; virtual;
433 >    procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
434      procedure DoAfterTransactionEnd; virtual;
435      procedure DoTransactionFree; virtual;
388    function GetDBHandle: PISC_DB_HANDLE; virtual;
389    function GetTRHandle: PISC_TR_HANDLE; virtual;
436      procedure SetDatabase(Value: TIBDatabase); virtual;
437      procedure SetTransaction(Value: TIBTransaction); virtual;
438    public
# Line 394 | Line 440 | type
440      destructor Destroy; override;
441      procedure CheckDatabase; virtual;
442      procedure CheckTransaction; virtual;
443 +    procedure DoAfterExecQuery(Sender: TObject); virtual;
444 +    procedure DoAfterEdit(Sender: TObject); virtual;
445 +    procedure DoAfterDelete(Sender: TObject); virtual;
446 +    procedure DoAfterInsert(Sender: TObject); virtual;
447 +    procedure DoAfterPost(Sender: TObject); virtual;
448 +    procedure HandleException(Sender: TObject);
449 +    procedure SetCursor;
450 +    procedure RestoreCursor;
451    public
452 +    property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect
453 +                                                 write FBeforeDatabaseConnect;
454      property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
455                                                  write FAfterDatabaseConnect;
456      property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
# Line 402 | Line 458 | type
458      property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
459                                                    write FAfterDatabaseDisconnect;
460      property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
461 <    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
461 >    property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
462      property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
463      property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
464      property Database: TIBDatabase read FDatabase
465                                      write SetDatabase;
410    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
466      property Owner: TObject read FOwner;
412    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
467      property Transaction: TIBTransaction read FTransaction
468                                            write SetTransaction;
469    end;
470  
471 < procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
472 < procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
471 > function GenerateDPB(sl: TStrings): IDPB;
472 > function GenerateTPB(sl: TStrings): ITPB;
473  
474  
475   implementation
476  
477 < uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, typInfo;
477 > uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
478 >     typInfo, FBMessages, IBErrorCodes;
479  
480   { TIBDatabase }
481  
482 < constructor TIBDatabase.Create(AOwner: TComponent);
482 > constructor TIBDataBase.Create(AOwner: TComponent);
483   begin
484    inherited Create(AOwner);
430  FIBLoaded := False;
431  CheckIBLoaded;
432  FIBLoaded := True;
485    LoginPrompt := True;
486    FSQLObjects := TList.Create;
487    FTransactions := TList.Create;
488    FDBName := '';
489    FDBParams := TStringList.Create;
490 +  FSQLHourGlass := true;
491 +  if (AOwner <> nil) and
492 +     (AOwner is TCustomApplication) and
493 +     TCustomApplication(AOWner).ConsoleApplication then
494 +    LoginPrompt := false;
495    FDBParamsChanged := True;
496    TStringList(FDBParams).OnChange := DBParamsChange;
497    TStringList(FDBParams).OnChanging := DBParamsChanging;
498    FDPB := nil;
442  FHandle := nil;
499    FUserNames := nil;
500    FInternalTransaction := TIBTransaction.Create(self);
501    FInternalTransaction.DefaultDatabase := Self;
502 <  FTimer := TTimer.Create(Self);
502 >  FTimer := TFPTimer.Create(Self);
503    FTimer.Enabled := False;
504    FTimer.Interval := 0;
505    FTimer.OnTimer := TimeoutConnection;
# Line 454 | Line 510 | begin
510    CheckStreamConnect;
511   end;
512  
513 < destructor TIBDatabase.Destroy;
513 > destructor TIBDataBase.Destroy;
514   var
515    i: Integer;
516   begin
517 <  if FIBLoaded then
518 <  begin
519 <    IdleTimer := 0;
520 <    if FHandle <> nil then
521 <      ForceClose;
522 <    for i := 0 to FSQLObjects.Count - 1 do
523 <      if FSQLObjects[i] <> nil then
524 <        SQLObjects[i].DoDatabaseFree;
525 <    RemoveSQLObjects;
526 <    RemoveTransactions;
527 <    FInternalTransaction.Free;
528 <    FreeMem(FDPB);
529 <    FDPB := nil;
530 <    FDBParams.Free;
475 <    FSQLObjects.Free;
476 <    FUserNames.Free;
477 <    FTransactions.Free;
478 <  end;
517 >  IdleTimer := 0;
518 >  if FAttachment <> nil then
519 >    ForceClose;
520 >  for i := 0 to FSQLObjects.Count - 1 do
521 >    if FSQLObjects[i] <> nil then
522 >      SQLObjects[i].DoDatabaseFree;
523 >  RemoveSQLObjects;
524 >  RemoveTransactions;
525 >  FInternalTransaction.Free;
526 >  FDPB := nil;
527 >  FDBParams.Free;
528 >  FSQLObjects.Free;
529 >  FUserNames.Free;
530 >  FTransactions.Free;
531    FDataSets.Free;
532    inherited Destroy;
533   end;
534  
535 < function TIBDatabase.Call(ErrCode: ISC_STATUS;
484 <  RaiseError: Boolean): ISC_STATUS;
485 < begin
486 <  result := ErrCode;
487 <  FCanTimeout := False;
488 <  if RaiseError and (ErrCode > 0) then
489 <    IBDataBaseError;
490 < end;
491 <
492 < procedure TIBDatabase.CheckActive;
535 > procedure TIBDataBase.CheckActive;
536   begin
537    if StreamedConnected and (not Connected) then
538      Loaded;
539 <  if FHandle = nil then
539 >  if FAttachment = nil then
540      IBError(ibxeDatabaseClosed, [nil]);
541   end;
542  
543 < procedure TIBDatabase.EnsureInactive;
543 > procedure TIBDataBase.EnsureInactive;
544   begin
545    if csDesigning in ComponentState then
546    begin
547 <    if FHandle <> nil then
547 >    if FAttachment <> nil then
548        Close;
549    end
550   end;
551  
552 < procedure TIBDatabase.CheckInactive;
552 > procedure TIBDataBase.CheckInactive;
553   begin
554 <  if FHandle <> nil then
554 >  if FAttachment <> nil then
555      IBError(ibxeDatabaseOpen, [nil]);
556   end;
557  
558 < procedure TIBDatabase.CheckDatabaseName;
558 > procedure TIBDataBase.CheckDatabaseName;
559   begin
560 <  if (FDBName = '') then
560 >  if (Trim(FDBName) = '') then
561      IBError(ibxeDatabaseNameMissing, [nil]);
562   end;
563  
564 < function TIBDatabase.AddSQLObject(ds: TIBBase): Integer;
564 > function TIBDataBase.AddSQLObject(ds: TIBBase): Integer;
565   begin
566    result := 0;
567    if (ds.Owner is TIBCustomDataSet) then
# Line 531 | Line 574 | begin
574      FSQLObjects[result] := ds;
575   end;
576  
577 < function TIBDatabase.AddTransaction(TR: TIBTransaction): Integer;
577 > function TIBDataBase.AddTransaction(TR: TIBTransaction): Integer;
578   begin
579    result := FindTransaction(TR);
580    if result <> -1 then
# Line 548 | Line 591 | begin
591      FTransactions[result] := TR;
592   end;
593  
594 < procedure TIBDatabase.DoDisconnect;
594 > procedure TIBDataBase.DoDisconnect;
595   begin
596    if Connected then
597      InternalClose(False);
598    FDBSQLDialect := 1;
599 +  FDefaultCharSetName := '';
600 +  FDefaultCharSetID := 0;
601 +  FDefaultCodePage := CP_NONE;
602   end;
603  
604 < procedure TIBDatabase.CreateDatabase;
559 < var
560 <  tr_handle: TISC_TR_HANDLE;
604 >  procedure TIBDataBase.CreateDatabase;
605   begin
606    CheckInactive;
607 <  tr_handle := nil;
608 <  Call(
609 <    isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0,
566 <                               PChar('CREATE DATABASE ''' + FDBName + ''' ' + {do not localize}
567 <                               Params.Text), SQLDialect, nil),
568 <    True);
607 >  CheckDatabaseName;
608 >  FCreateDatabase := true;
609 >  Connected := true;
610   end;
611  
612 < procedure TIBDatabase.DropDatabase;
612 > procedure TIBDataBase.DropDatabase;
613   begin
614    CheckActive;
615 <  Call(isc_drop_database(StatusVector, @FHandle), True);
615 >  FAttachment.DropDatabase;
616 >  FAttachment := nil;
617   end;
618  
619 < procedure TIBDatabase.DBParamsChange(Sender: TObject);
619 > procedure TIBDataBase.DBParamsChange(Sender: TObject);
620   begin
621    FDBParamsChanged := True;
622   end;
623  
624 < procedure TIBDatabase.DBParamsChanging(Sender: TObject);
624 > procedure TIBDataBase.DBParamsChanging(Sender: TObject);
625   begin
626    EnsureInactive;
627    CheckInactive;
628   end;
629  
630 < function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer;
630 > function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer;
631   var
632    i: Integer;
633   begin
# Line 598 | Line 640 | begin
640      end;
641   end;
642  
643 < function TIBDatabase.FindDefaultTransaction(): TIBTransaction;
643 > function TIBDataBase.FindDefaultTransaction: TIBTransaction;
644   var
645    i: Integer;
646   begin
# Line 616 | Line 658 | begin
658    end;
659   end;
660  
661 < procedure TIBDatabase.ForceClose;
661 > procedure TIBDataBase.ForceClose;
662   begin
663    if Connected then
664      InternalClose(True);
665   end;
666  
667 < function TIBDatabase.GetConnected: Boolean;
667 > function TIBDataBase.GetConnected: Boolean;
668   begin
669 <  result := FHandle <> nil;
669 >  result := (FAttachment <> nil) and FAttachment.IsConnected;
670   end;
671  
672 < function TIBDatabase.GetSQLObject(Index: Integer): TIBBase;
672 > function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
673   begin
674    result := FSQLObjects[Index];
675   end;
676  
677 < function TIBDatabase.GetSQLObjectCount: Integer;
677 > function TIBDataBase.GetSQLObjectCount: Integer;
678   var
679    i: Integer;
680   begin
# Line 641 | Line 683 | begin
683      Inc(result);
684   end;
685  
686 < function TIBDatabase.GetDBParamByDPB(const Idx: Integer): String;
645 < var
646 <  ConstIdx, EqualsIdx: Integer;
647 < begin
648 <  if (Idx > 0) and (Idx <= isc_dpb_last_dpb_constant) then
649 <  begin
650 <    ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
651 <    if ConstIdx = -1 then
652 <      result := ''
653 <    else
654 <    begin
655 <      result := Params[ConstIdx];
656 <      EqualsIdx := Pos('=', result); {mbcs ok}
657 <      if EqualsIdx = 0 then
658 <        result := ''
659 <      else
660 <        result := Copy(result, EqualsIdx + 1, Length(result));
661 <    end;
662 <  end
663 <  else
664 <    result := '';
665 < end;
666 <
667 < function TIBDatabase.GetIdleTimer: Integer;
686 > function TIBDataBase.GetIdleTimer: Integer;
687   begin
688    result := FTimer.Interval;
689   end;
690  
691 < function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction;
691 > function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction;
692   begin
693    result := FTransactions[Index];
694   end;
695  
696 < function TIBDatabase.GetTransactionCount: Integer;
696 > function TIBDataBase.GetTransactionCount: Integer;
697   var
698    i: Integer;
699   begin
# Line 684 | Line 703 | begin
703        Inc(result);
704   end;
705  
706 < function TIBDatabase.IndexOfDBConst(st: String): Integer;
706 > function TIBDataBase.IndexOfDBConst(st: String): Integer;
707   var
708    i, pos_of_str: Integer;
709   begin
# Line 700 | Line 719 | begin
719    end;
720   end;
721  
722 < procedure TIBDatabase.InternalClose(Force: Boolean);
722 > procedure TIBDataBase.InternalClose(Force: Boolean);
723   var
724    i: Integer;
725   begin
# Line 729 | Line 748 | begin
748      end;
749    end;
750  
751 <  if (not HandleIsShared) and
752 <     (Call(isc_detach_database(StatusVector, @FHandle), False) > 0) and
734 <     (not Force) then
735 <    IBDataBaseError
736 <  else
737 <  begin
738 <    FHandle := nil;
739 <    FHandleIsShared := False;
740 <  end;
751 >  FAttachment.Disconnect(Force);
752 >  FAttachment := nil;
753  
754    if not (csDesigning in ComponentState) then
755      MonitorHook.DBDisconnect(Self);
# Line 769 | Line 781 | begin
781           (FDefaultTransaction.FStreamedActive) and
782           (not FDefaultTransaction.InTransaction) then
783          FDefaultTransaction.StartTransaction;
784 <      FStreamedConnected := False;
784 >      StreamedConnected := False;
785      end;
786    except
787      if csDesigning in ComponentState then
788 <      Application.HandleException(Self)
788 >      HandleException(Self)
789      else
790        raise;
791    end;
792   end;
793  
794 < procedure TIBDatabase.Notification( AComponent: TComponent;
795 <                                        Operation: TOperation);
794 > procedure TIBDataBase.HandleException(Sender: TObject);
795 > var aParent: TComponent;
796 > begin
797 >  aParent := Owner;
798 >  while aParent <> nil do
799 >  begin
800 >    if aParent is TCustomApplication then
801 >    begin
802 >      TCustomApplication(aParent).HandleException(Sender);
803 >      Exit;
804 >    end;
805 >    aParent := aParent.Owner;
806 >  end;
807 >  SysUtils.ShowException(ExceptObject,ExceptAddr);
808 > end;
809 >
810 > procedure TIBDataBase.Notification(AComponent: TComponent;
811 >   Operation: TOperation);
812   var
813    i: Integer;
814   begin
# Line 794 | Line 822 | begin
822    end;
823   end;
824  
825 < function TIBDatabase.Login: Boolean;
825 > function TIBDataBase.Login(var aDatabaseName: string): Boolean;
826   var
827    IndexOfUser, IndexOfPassword: Integer;
828    Username, Password, OldPassword: String;
# Line 830 | Line 858 | begin
858        LoginParams.Assign(Params);
859        FOnLogin(Self, LoginParams);
860        Params.Assign (LoginParams);
861 +      aDatabaseName := FDBName;
862        HidePassword;
863      finally
864        LoginParams.Free;
865      end;
866    end
867    else
868 +  if assigned(IBGUIInterface) then
869    begin
870      IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]);
871      if IndexOfUser <> -1 then
# Line 850 | Line 880 | begin
880                                           Length(Params[IndexOfPassword]));
881        OldPassword := password;
882      end;
883 <    result := LoginDialogEx(DatabaseName, Username, Password, False);
883 >
884 >    result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
885      if result then
886      begin
887 <      if IndexOfUser = -1 then
888 <        Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
889 <      else
890 <        Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
887 >      if Username <> '' then
888 >      begin
889 >        if IndexOfUser = -1 then
890 >          Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
891 >        else
892 >          Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
893                                   '=' + Username;
894 +      end
895 +      else
896 +      if IndexOfUser <> -1 then
897 +        Params.Delete(IndexOfUser);
898        if (Password = OldPassword) then
899          FHiddenPassword := ''
900        else
# Line 867 | Line 904 | begin
904            HidePassword;
905        end;
906      end;
907 <  end;
907 >  end
908 >  else
909 >  if LoginPrompt then
910 >     IBError(ibxeNoLoginDialog,[]);
911    finally
912      FLoginCalled := false
913    end;
914   end;
915  
916 < procedure TIBDatabase.DoConnect;
916 > procedure TIBDataBase.DoConnect;
917   var
878  DPB: String;
918    TempDBParams: TStrings;
919    I: integer;
920 <
920 >  aDBName: string;
921 >  Status: IStatus;
922 >  CharSetID: integer;
923   begin
924    CheckInactive;
925    CheckDatabaseName;
# Line 888 | Line 929 | begin
929      FDBParamsChanged := True;
930    end;
931    { Use builtin login prompt if requested }
932 <  if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
932 >  aDBName := FDBName;
933 >  if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
934      IBError(ibxeOperationCancelled, [nil]);
935 <  { Generate a new DPB if necessary }
936 <  if (FDBParamsChanged) then
937 <  begin
938 <    FDBParamsChanged := False;
939 <    if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
940 <      GenerateDPB(FDBParams, DPB, FDPBLength)
935 >
936 >  TempDBParams := TStringList.Create;
937 >  try
938 >   TempDBParams.Assign(FDBParams);
939 >   if UseDefaultSystemCodePage then
940 >   begin
941 >     {$ifdef WINDOWS}
942 >     if FirebirdAPI.CodePage2CharSetID(GetACP,CharSetID) then
943 >       TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
944 >     {$else}
945 >     if FirebirdAPI.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
946 >       TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
947 >     {$endif}
948 >     else
949 >       TempDBParams.Values['lc_ctype'] :='UTF8';
950 >   end;
951 >   {Opportunity to override defaults}
952 >   for i := 0 to FSQLObjects.Count - 1 do
953 >   begin
954 >       if FSQLObjects[i] <> nil then
955 >         SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
956 >   end;
957 >
958 >   FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
959 >   if FDefaultCharSetName <> '' then
960 >     FirebirdAPI.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
961 >   FirebirdAPI.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
962 >   { Generate a new DPB if necessary }
963 >   if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
964 >   begin
965 >     FDBParamsChanged := False;
966 >     if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
967 >       FDPB := GenerateDPB(TempDBParams)
968 >     else
969 >     begin
970 >        TempDBParams.Add('password=' + FHiddenPassword);
971 >        FDPB := GenerateDPB(TempDBParams);
972 >     end;
973 >   end;
974 >  finally
975 >   TempDBParams.Free;
976 >  end;
977 >
978 >  repeat
979 >    if FCreateDatabase then
980 >    begin
981 >      FCreateDatabase := false;
982 >      FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
983 >      if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
984 >        OnCreateDatabase(self);
985 >    end
986      else
987 +      FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
988 +    if FAttachment = nil then
989      begin
990 <      TempDBParams := TStringList.Create;
991 <      try
992 <       TempDBParams.Assign(FDBParams);
993 <       TempDBParams.Add('password=' + FHiddenPassword);
994 <       GenerateDPB(TempDBParams, DPB, FDPBLength);
995 <      finally
996 <       TempDBParams.Free;
990 >      Status := FirebirdAPI.GetStatus;
991 >      {$IFDEF UNIX}
992 >      if Pos(':',aDBName) = 0 then
993 >      begin
994 >          if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
995 >             or
996 >             ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
997 >             or
998 >             ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
999 >             or
1000 >             ((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
1001 >             then
1002 >             begin
1003 >               aDBName := 'localhost:' + aDBName;
1004 >               Continue;
1005 >            end
1006        end;
1007 +      {$ENDIF}
1008 +      if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1009 +                       and CreateIfNotExists and not (csDesigning in ComponentState) then
1010 +        FCreateDatabase := true
1011 +      else
1012 +        raise EIBInterBaseError.Create(Status);
1013      end;
1014 <    IBAlloc(FDPB, 0, FDPBLength);
1015 <    Move(DPB[1], FDPB[0], FDPBLength);
1016 <  end;
913 <  if Call(isc_attach_database(StatusVector, Length(FDBName),
914 <                         PChar(FDBName), @FHandle,
915 <                         FDPBLength, FDPB), False) > 0 then
916 <  begin
917 <    FHandle := nil;
918 <    IBDataBaseError;
919 <  end;
1014 >  until FAttachment <> nil;
1015 >  if not (csDesigning in ComponentState) then
1016 >    FDBName := aDBName; {Synchronise at run time}
1017    FDBSQLDialect := GetDBSQLDialect;
1018    ValidateClientSQLDialect;
1019    for i := 0 to FSQLObjects.Count - 1 do
# Line 928 | Line 1025 | begin
1025      MonitorHook.DBConnect(Self);
1026   end;
1027  
1028 < procedure TIBDatabase.RemoveSQLObject(Idx: Integer);
1028 > procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
1029   var
1030    ds: TIBBase;
1031   begin
# Line 942 | Line 1039 | begin
1039    end;
1040   end;
1041  
1042 < procedure TIBDatabase.RemoveSQLObjects;
1042 > procedure TIBDataBase.RemoveSQLObjects;
1043   var
1044    i: Integer;
1045   begin
# Line 954 | Line 1051 | begin
1051    end;
1052   end;
1053  
1054 < procedure TIBDatabase.RemoveTransaction(Idx: Integer);
1054 > procedure TIBDataBase.RemoveTransaction(Idx: Integer);
1055   var
1056    TR: TIBTransaction;
1057   begin
# Line 968 | Line 1065 | begin
1065    end;
1066   end;
1067  
1068 < procedure TIBDatabase.RemoveTransactions;
1068 > procedure TIBDataBase.RemoveTransactions;
1069   var
1070    i: Integer;
1071   begin
# Line 976 | Line 1073 | begin
1073      RemoveTransaction(i);
1074   end;
1075  
1076 < procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName);
1076 > procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName);
1077   begin
1078    if FDBName <> Value then
1079    begin
# Line 986 | Line 1083 | begin
1083    end;
1084   end;
1085  
1086 < procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String);
1086 > procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String);
1087   var
1088    ConstIdx: Integer;
1089   begin
# Line 1005 | Line 1102 | begin
1102    end;
1103   end;
1104  
1105 < procedure TIBDatabase.SetDBParams(Value: TStrings);
1105 > procedure TIBDataBase.SetDBParams(Value: TStrings);
1106   begin
1107    FDBParams.Assign(Value);
1108   end;
1109  
1110 < procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction);
1110 > procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction);
1111   var
1112    i: Integer;
1113   begin
# Line 1028 | Line 1125 | begin
1125    FDefaultTransaction := Value;
1126   end;
1127  
1128 < procedure TIBDatabase.SetHandle(Value: TISC_DB_HANDLE);
1032 < begin
1033 <  if HandleIsShared then
1034 <    Close
1035 <  else
1036 <    CheckInactive;
1037 <  FHandle := Value;
1038 <  FHandleIsShared := (Value <> nil);
1039 < end;
1040 <
1041 < procedure TIBDatabase.SetIdleTimer(Value: Integer);
1128 > procedure TIBDataBase.SetIdleTimer(Value: Integer);
1129   begin
1130    if Value < 0 then
1131      IBError(ibxeTimeoutNegative, [nil])
# Line 1057 | Line 1144 | begin
1144        end;
1145   end;
1146  
1147 < function TIBDatabase.TestConnected: Boolean;
1147 > function TIBDataBase.TestConnected: Boolean;
1148   var
1149    DatabaseInfo: TIBDatabaseInfo;
1150   begin
# Line 1078 | Line 1165 | begin
1165    end;
1166   end;
1167  
1168 < procedure TIBDatabase.TimeoutConnection(Sender: TObject);
1168 > procedure TIBDataBase.TimeoutConnection(Sender: TObject);
1169   begin
1170    if Connected then
1171    begin
1172 <    if FCanTimeout then
1172 >    if not FAttachment.HasActivity then
1173      begin
1174        ForceClose;
1175        if Assigned(FOnIdleTimer) then
1176          FOnIdleTimer(Self);
1177      end
1091    else
1092      FCanTimeout := True;
1178    end;
1179   end;
1180  
1181 < function TIBDatabase.GetIsReadOnly: Boolean;
1181 > function TIBDataBase.GetIsReadOnly: Boolean;
1182   var
1183    DatabaseInfo: TIBDatabaseInfo;
1184   begin
# Line 1111 | Line 1196 | begin
1196    DatabaseInfo.Free;
1197   end;
1198  
1199 < function TIBDatabase.GetSQLDialect: Integer;
1199 > function TIBDataBase.GetSQLDialect: Integer;
1200   begin
1201    Result := FSQLDialect;
1202   end;
1203  
1204  
1205 < procedure TIBDatabase.SetSQLDialect(const Value: Integer);
1205 > procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1206   begin
1207    if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1208 <  if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
1208 >  if ((FAttachment = nil) or (Value <= FDBSQLDialect))  then
1209      FSQLDialect := Value
1210    else
1211      IBError(ibxeSQLDialectInvalid, [nil]);
1212   end;
1213  
1214 < function TIBDatabase.GetDBSQLDialect: Integer;
1214 > function TIBDataBase.GetDBSQLDialect: Integer;
1215   var
1216    DatabaseInfo: TIBDatabaseInfo;
1217   begin
# Line 1136 | Line 1221 | begin
1221    DatabaseInfo.Free;
1222   end;
1223  
1224 < procedure TIBDatabase.ValidateClientSQLDialect;
1224 > procedure TIBDataBase.ValidateClientSQLDialect;
1225   begin
1226    if (FDBSQLDialect < FSQLDialect) then
1227    begin
# Line 1146 | Line 1231 | begin
1231    end;
1232   end;
1233  
1234 < procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet);
1234 > procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet);
1235   var
1236    I: Integer;
1237    DS: TIBCustomDataSet;
# Line 1172 | Line 1257 | begin
1257    TR.CommitRetaining;
1258   end;
1259  
1260 < procedure TIBDatabase.CloseDataSets;
1260 > procedure TIBDataBase.CloseDataSets;
1261   var
1262    i: Integer;
1263   begin
# Line 1181 | Line 1266 | begin
1266        DataSets[i].close;
1267   end;
1268  
1269 < function TIBDatabase.GetDataset(Index : longint) : TDataset;
1269 > function TIBDataBase.GetDataset(Index: longint): TDataset;
1270   begin
1271    if (Index >= 0) and (Index < FDataSets.Count) then
1272      Result := TDataSet(FDataSets[Index])
# Line 1189 | Line 1274 | begin
1274      raise Exception.Create('Invalid Index to DataSets');
1275   end;
1276  
1277 < function TIBDatabase.GetDataSetCount : Longint;
1277 > function TIBDataBase.GetDataSetCount: Longint;
1278   begin
1279    Result := FDataSets.Count;
1280   end;
1281  
1282 + procedure TIBDataBase.ReadState(Reader: TReader);
1283 + begin
1284 +  FDBParams.Clear;
1285 +  inherited ReadState(Reader);
1286 + end;
1287 +
1288   procedure TIBDataBase.SetConnected(Value: boolean);
1289   begin
1290    if StreamedConnected and not AllowStreamedConnected then
# Line 1204 | Line 1295 | begin
1295    inherited SetConnected(Value);
1296   end;
1297  
1298 < procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings);
1298 > procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings);
1299   var
1300    Query: TIBSQL;
1301   begin
# Line 1233 | Line 1324 | begin
1324        BeginUpdate;
1325        try
1326          Clear;
1327 <        while (not Query.EOF) and (Query.Next <> nil) do
1328 <          List.Add(TrimRight(Query.Current.ByName('RDB$FIELD_NAME').AsString)); {do not localize}
1327 >        while (not Query.EOF) and Query.Next  do
1328 >          List.Add(TrimRight(Query.FieldByName('RDB$FIELD_NAME').AsString)); {do not localize}
1329        finally
1330          EndUpdate;
1331        end;
# Line 1245 | Line 1336 | begin
1336    end;
1337   end;
1338  
1339 < procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean);
1339 > procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean);
1340   var
1341    Query : TIBSQL;
1342   begin
# Line 1273 | Line 1364 | begin
1364          BeginUpdate;
1365          try
1366            Clear;
1367 <          while (not Query.EOF) and (Query.Next <> nil) do
1368 <            List.Add(TrimRight(Query.Current[0].AsString));
1367 >          while (not Query.EOF) and Query.Next  do
1368 >            List.Add(TrimRight(Query.Fields[0].AsString));
1369          finally
1370            EndUpdate;
1371          end;
# Line 1291 | Line 1382 | end;
1382   constructor TIBTransaction.Create(AOwner: TComponent);
1383   begin
1384    inherited Create(AOwner);
1294  FIBLoaded := False;
1295  CheckIBLoaded;
1296  FIBLoaded := True;
1297  CheckIBLoaded;
1385    FDatabases := TList.Create;
1386    FSQLObjects := TList.Create;
1300  FHandle := nil;
1387    FTPB := nil;
1302  FTPBLength := 0;
1388    FTRParams := TStringList.Create;
1389    FTRParamsChanged := True;
1390    TStringList(FTRParams).OnChange := TRParamsChange;
1391    TStringList(FTRParams).OnChanging := TRParamsChanging;
1392 <  FTimer := TTimer.Create(Self);
1392 >  FTimer := TFPTimer.Create(Self);
1393    FTimer.Enabled := False;
1394    FTimer.Interval := 0;
1395    FTimer.OnTimer := TimeoutTransaction;
# Line 1315 | Line 1400 | destructor TIBTransaction.Destroy;
1400   var
1401    i: Integer;
1402   begin
1403 <  if FIBLoaded then
1404 <  begin
1405 <    if InTransaction then
1406 <      EndTransaction(FDefaultAction, True);
1407 <    for i := 0 to FSQLObjects.Count - 1 do
1408 <      if FSQLObjects[i] <> nil then
1409 <        SQLObjects[i].DoTransactionFree;
1410 <    RemoveSQLObjects;
1411 <    RemoveDatabases;
1412 <    FreeMem(FTPB);
1413 <    FTPB := nil;
1329 <    FTRParams.Free;
1330 <    FSQLObjects.Free;
1331 <    FDatabases.Free;
1332 <  end;
1403 >  if InTransaction then
1404 >    EndTransaction(FDefaultAction, True);
1405 >  for i := 0 to FSQLObjects.Count - 1 do
1406 >    if FSQLObjects[i] <> nil then
1407 >      SQLObjects[i].DoTransactionFree;
1408 >  RemoveSQLObjects;
1409 >  RemoveDatabases;
1410 >  FTPB := nil;
1411 >  FTRParams.Free;
1412 >  FSQLObjects.Free;
1413 >  FDatabases.Free;
1414    inherited Destroy;
1415   end;
1416  
1336 function TIBTransaction.Call(ErrCode: ISC_STATUS;
1337  RaiseError: Boolean): ISC_STATUS;
1338 var
1339  i: Integer;
1340 begin
1341  result := ErrCode;
1342  for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1343    Databases[i].FCanTimeout := False;
1344  FCanTimeout := False;
1345  if RaiseError and (result > 0) then
1346    IBDataBaseError;
1347 end;
1348
1417   procedure TIBTransaction.CheckDatabasesInList;
1418   begin
1419    if GetDatabaseCount = 0 then
# Line 1356 | Line 1424 | procedure TIBTransaction.CheckInTransact
1424   begin
1425    if FStreamedActive and (not InTransaction) then
1426      Loaded;
1427 <  if (FHandle = nil) then
1427 >  if (TransactionIntf = nil) then
1428      IBError(ibxeNotInTransaction, [nil]);
1429   end;
1430  
1431 + procedure TIBTransaction.DoBeforeTransactionEnd;
1432 + begin
1433 +  if Assigned(FBeforeTransactionEnd) then
1434 +    FBeforeTransactionEnd(self);
1435 + end;
1436 +
1437 + procedure TIBTransaction.DoAfterTransactionEnd;
1438 + begin
1439 +  if Assigned(FAfterTransactionEnd) then
1440 +    FAfterTransactionEnd(self);
1441 + end;
1442 +
1443 + procedure TIBTransaction.DoOnStartTransaction;
1444 + begin
1445 +  if assigned(FOnStartTransaction) then
1446 +    OnStartTransaction(self);
1447 + end;
1448 +
1449 + procedure TIBTransaction.DoAfterExecQuery(Sender: TObject);
1450 + begin
1451 +  if assigned(FAfterExecQuery) then
1452 +    AfterExecQuery(Sender);
1453 + end;
1454 +
1455 + procedure TIBTransaction.DoAfterEdit(Sender: TObject);
1456 + begin
1457 +  if assigned(FAfterEdit) then
1458 +    AfterEdit(Sender);
1459 + end;
1460 +
1461 + procedure TIBTransaction.DoAfterDelete(Sender: TObject);
1462 + begin
1463 +  if assigned(FAfterDelete) then
1464 +    AfterDelete(Sender);
1465 + end;
1466 +
1467 + procedure TIBTransaction.DoAfterInsert(Sender: TObject);
1468 + begin
1469 +  if assigned(FAfterInsert) then
1470 +    AfterInsert(Sender);
1471 + end;
1472 +
1473 + procedure TIBTransaction.DoAfterPost(Sender: TObject);
1474 + begin
1475 +  if assigned(FAfterPost) then
1476 +    AfterPost(Sender);
1477 + end;
1478 +
1479   procedure TIBTransaction.EnsureNotInTransaction;
1480   begin
1481    if csDesigning in ComponentState then
1482    begin
1483 <    if FHandle <> nil then
1483 >    if TransactionIntf <> nil then
1484        Rollback;
1485    end;
1486   end;
1487  
1488   procedure TIBTransaction.CheckNotInTransaction;
1489   begin
1490 <  if (FHandle <> nil) then
1490 >  if (TransactionIntf <> nil) and  TransactionIntf.InTransaction then
1491      IBError(ibxeInTransaction, [nil]);
1492   end;
1493  
# Line 1380 | Line 1496 | var
1496    i: Integer;
1497    NilFound: Boolean;
1498   begin
1499 +  EnsureNotInTransaction;
1500 +  CheckNotInTransaction;
1501 +  FTransactionIntf := nil;
1502 +
1503    i := FindDatabase(db);
1504    if i <> -1 then
1505    begin
# Line 1430 | Line 1550 | end;
1550   procedure TIBTransaction.EndTransaction(Action: TTransactionAction;
1551    Force: Boolean);
1552   var
1433  status: ISC_STATUS;
1553    i: Integer;
1554   begin
1555    CheckInTransaction;
1556    if FInEndTransaction then Exit;
1557    FInEndTransaction := true;
1558 +  FEndAction := Action;
1559    try
1560    case Action of
1561      TARollback, TACommit:
1562      begin
1563 <      if (HandleIsShared) and
1444 <         (Action <> FDefaultAction) and
1445 <         (not Force) then
1446 <        IBError(ibxeCantEndSharedTransaction, [nil]);
1563 >      DoBeforeTransactionEnd;
1564        for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1565 <        SQLObjects[i].DoBeforeTransactionEnd;
1565 >        SQLObjects[i].DoBeforeTransactionEnd(Action);
1566        if InTransaction then
1567        begin
1568 <        if HandleIsShared then
1569 <        begin
1453 <          FHandle := nil;
1454 <          FHandleIsShared := False;
1455 <          status := 0;
1456 <        end
1568 >        if (Action = TARollback) then
1569 >            FTransactionIntf.Rollback(Force)
1570          else
1571 <          if (Action = TARollback) then
1572 <            status := Call(isc_rollback_transaction(StatusVector, @FHandle), False)
1573 <          else
1574 <            status := Call(isc_commit_transaction(StatusVector, @FHandle), False);
1575 <        if ((Force) and (status > 0)) then
1576 <          status := Call(isc_rollback_transaction(StatusVector, @FHandle), False);
1577 <        if Force then
1578 <          FHandle := nil
1579 <        else
1580 <          if (status > 0) then
1581 <            IBDataBaseError;
1571 >        try
1572 >          FTransactionIntf.Commit;
1573 >        except on E: EIBInterBaseError do
1574 >          begin
1575 >            if Force then
1576 >              FTransactionIntf.Rollback(Force)
1577 >            else
1578 >              raise;
1579 >          end;
1580 >        end;
1581 >
1582          for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1583            SQLObjects[i].DoAfterTransactionEnd;
1584 +        DoAfterTransactionEnd;
1585        end;
1586      end;
1587      TACommitRetaining:
1588 <      Call(isc_commit_retaining(StatusVector, @FHandle), True);
1588 >      FTransactionIntf.CommitRetaining;
1589 >
1590      TARollbackRetaining:
1591 <      Call(isc_rollback_retaining(StatusVector, @FHandle), True);
1591 >      FTransactionIntf.RollbackRetaining;
1592    end;
1593    if not (csDesigning in ComponentState) then
1594    begin
# Line 1525 | Line 1640 | end;
1640  
1641   function TIBTransaction.GetInTransaction: Boolean;
1642   begin
1643 <  result := (FHandle <> nil);
1643 >  result := (TransactionIntf <> nil) and TransactionIntf.InTransaction;
1644   end;
1645  
1646   function TIBTransaction.FindDatabase(db: TIBDatabase): Integer;
# Line 1558 | Line 1673 | begin
1673    end;
1674   end;
1675  
1676 + function TIBTransaction.GetEndAction: TTransactionAction;
1677 + begin
1678 +  if FInEndTransaction then
1679 +     Result := FEndAction
1680 +  else
1681 +     IBError(ibxeIB60feature, [nil])
1682 + end;
1683 +
1684  
1685   function TIBTransaction.GetIdleTimer: Integer;
1686   begin
# Line 1573 | Line 1696 | procedure TIBTransaction.BeforeDatabaseD
1696   begin
1697    if InTransaction then
1698      EndTransaction(FDefaultAction, True);
1699 +  FTransactionIntf := nil;
1700   end;
1701  
1702   procedure TIBTransaction.RemoveDatabase(Idx: Integer);
# Line 1581 | Line 1705 | var
1705   begin
1706    if ((Idx >= 0) and (FDatabases[Idx] <> nil)) then
1707    begin
1708 +    EnsureNotInTransaction;
1709 +    CheckNotInTransaction;
1710 +    FTransactionIntf := nil;
1711 +
1712      DB := Databases[Idx];
1713      FDatabases[Idx] := nil;
1714      DB.RemoveTransaction(DB.FindTransaction(Self));
# Line 1593 | Line 1721 | procedure TIBTransaction.RemoveDatabases
1721   var
1722    i: Integer;
1723   begin
1724 +  EnsureNotInTransaction;
1725 +  CheckNotInTransaction;
1726 +  FTransactionIntf := nil;
1727 +
1728    for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1729      RemoveDatabase(i);
1730   end;
# Line 1639 | Line 1771 | begin
1771          Rollback;
1772   end;
1773  
1642 procedure TIBTransaction.SetDefaultAction(Value: TTransactionAction);
1643 begin
1644 (*  if (Value = taRollbackRetaining) and (GetIBClientVersion < 6) then
1645    IBError(ibxeIB60feature, [nil]);*)
1646  FDefaultAction := Value;
1647 end;
1648
1774   procedure TIBTransaction.SetDefaultDatabase(Value: TIBDatabase);
1775   var
1776    i: integer;
# Line 1663 | Line 1788 | begin
1788      for i := 0 to FSQLObjects.Count - 1 do
1789        if (FSQLObjects[i] <> nil) and
1790           (TIBBase(FSQLObjects[i]).Database = nil) then
1791 <        SetOrdProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Integer(Value));
1791 >         SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value);
1792    end;
1793    FDefaultDatabase := Value;
1794   end;
1795  
1671 procedure TIBTransaction.SetHandle(Value: TISC_TR_HANDLE);
1672 begin
1673  if (HandleIsShared) then
1674    EndTransaction(DefaultAction, True)
1675  else
1676    CheckNotInTransaction;
1677  FHandle := Value;
1678  FHandleIsShared := (Value <> nil);
1679 end;
1680
1796   procedure TIBTransaction.Notification( AComponent: TComponent;
1797                                          Operation: TOperation);
1798   var
# Line 1719 | Line 1834 | end;
1834  
1835   procedure TIBTransaction.StartTransaction;
1836   var
1722  pteb: PISC_TEB_ARRAY;
1723  TPB: String;
1837    i: Integer;
1838 +  Attachments: array of IAttachment;
1839 +  ValidDatabaseCount: integer;
1840   begin
1841    CheckNotInTransaction;
1842    CheckDatabasesInList;
1843 +  if TransactionIntf <> nil then
1844 +  begin
1845 +    TransactionIntf.Start(DefaultAction);
1846 +    Exit;
1847 +  end;
1848 +
1849    for i := 0 to FDatabases.Count - 1 do
1850     if  FDatabases[i] <> nil then
1851     begin
1852       with TIBDatabase(FDatabases[i]) do
1853       if not Connected then
1854 <       if FStreamedConnected then
1854 >       if StreamedConnected then
1855         begin
1856           Open;
1857 <         FStreamedConnected := False;
1857 >         StreamedConnected := False;
1858         end
1859         else
1860           IBError(ibxeDatabaseClosed, [nil]);
# Line 1741 | Line 1862 | begin
1862    if FTRParamsChanged then
1863    begin
1864      FTRParamsChanged := False;
1865 <    GenerateTPB(FTRParams, TPB, FTPBLength);
1745 <    if FTPBLength > 0 then
1746 <    begin
1747 <      IBAlloc(FTPB, 0, FTPBLength);
1748 <      Move(TPB[1], FTPB[0], FTPBLength);
1749 <    end;
1865 >    FTPB :=  GenerateTPB(FTRParams);
1866    end;
1867  
1868 <  pteb := nil;
1869 <  IBAlloc(pteb, 0, DatabaseCount * SizeOf(TISC_TEB));
1870 <  try
1871 <    for i := 0 to DatabaseCount - 1 do if Databases[i] <> nil then
1872 <    begin
1873 <      pteb^[i].db_handle := @(Databases[i].Handle);
1874 <      pteb^[i].tpb_length := FTPBLength;
1875 <      pteb^[i].tpb_address := FTPB;
1876 <    end;
1877 <    if Call(isc_start_multiple(StatusVector, @FHandle,
1878 <                               DatabaseCount, PISC_TEB(pteb)), False) > 0 then
1879 <    begin
1880 <      FHandle := nil;
1881 <      IBDataBaseError;
1766 <    end;
1767 <    if not (csDesigning in ComponentState) then
1768 <      MonitorHook.TRStart(Self);
1769 <  finally
1770 <    FreeMem(pteb);
1868 >  ValidDatabaseCount := 0;
1869 >  for i := 0 to DatabaseCount - 1 do
1870 >    if Databases[i] <> nil then Inc(ValidDatabaseCount);
1871 >
1872 >  if ValidDatabaseCount = 1 then
1873 >    FTransactionIntf := Databases[0].Attachment.StartTransaction(FTPB,DefaultAction)
1874 >  else
1875 >  begin
1876 >    SetLength(Attachments,ValidDatabaseCount);
1877 >    for i := 0 to DatabaseCount - 1 do
1878 >      if Databases[i] <> nil then
1879 >        Attachments[i] := Databases[i].Attachment;
1880 >
1881 >    FTransactionIntf := FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction);
1882    end;
1883 +
1884 +  if not (csDesigning in ComponentState) then
1885 +      MonitorHook.TRStart(Self);
1886 +  DoOnStartTransaction;
1887   end;
1888  
1889   procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
1890   begin
1891    if InTransaction then
1892    begin
1893 <    if FCanTimeout then
1893 >    if not TransactionIntf.HasActivity then
1894      begin
1895        EndTransaction(FDefaultAction, True);
1896        if Assigned(FOnIdleTimer) then
1897          FOnIdleTimer(Self);
1898      end
1784    else
1785      FCanTimeout := True;
1899    end;
1900   end;
1901  
# Line 1795 | Line 1908 | procedure TIBTransaction.TRParamsChangin
1908   begin
1909    EnsureNotInTransaction;
1910    CheckNotInTransaction;
1911 +  FTransactionIntf := nil;
1912   end;
1913  
1914   { TIBBase }
# Line 1810 | Line 1924 | begin
1924    inherited Destroy;
1925   end;
1926  
1927 + procedure TIBBase.HandleException(Sender: TObject);
1928 + begin
1929 +  if assigned(Database) then
1930 +     Database.HandleException(Sender)
1931 +  else
1932 +     SysUtils.ShowException(ExceptObject,ExceptAddr);
1933 + end;
1934 +
1935 + procedure TIBBase.SetCursor;
1936 + begin
1937 +  if Assigned(Database) and not Database.SQLHourGlass then
1938 +     Exit;
1939 +  if assigned(IBGUIInterface) then
1940 +     IBGUIInterface.SetCursor;
1941 + end;
1942 +
1943 + procedure TIBBase.RestoreCursor;
1944 + begin
1945 +  if Assigned(Database) and not Database.SQLHourGlass then
1946 +     Exit;
1947 +  if assigned(IBGUIInterface) then
1948 +     IBGUIInterface.RestoreCursor;
1949 + end;
1950 +
1951   procedure TIBBase.CheckDatabase;
1952   begin
1953    if (FDatabase = nil) then
# Line 1824 | Line 1962 | begin
1962    FTransaction.CheckInTransaction;
1963   end;
1964  
1965 < function TIBBase.GetDBHandle: PISC_DB_HANDLE;
1966 < begin
1829 <  CheckDatabase;
1830 <  result := @FDatabase.Handle;
1831 < end;
1832 <
1833 < function TIBBase.GetTRHandle: PISC_TR_HANDLE;
1965 > procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
1966 >  );
1967   begin
1968 <  CheckTransaction;
1969 <  result := @FTransaction.Handle;
1968 >  if assigned(FBeforeDatabaseConnect) then
1969 >    BeforeDatabaseConnect(self,DBParams,DBName);
1970   end;
1971  
1972   procedure TIBBase.DoAfterDatabaseConnect;
# Line 1862 | Line 1995 | begin
1995    SetTransaction(nil);
1996   end;
1997  
1998 < procedure TIBBase.DoBeforeTransactionEnd;
1998 > procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction);
1999   begin
2000    if Assigned(BeforeTransactionEnd) then
2001 <    BeforeTransactionEnd(Self);
2001 >    BeforeTransactionEnd(Self,Action);
2002   end;
2003  
2004   procedure TIBBase.DoAfterTransactionEnd;
# Line 1881 | Line 2014 | begin
2014    FTransaction := nil;
2015   end;
2016  
2017 + procedure TIBBase.DoAfterExecQuery(Sender: TObject);
2018 + begin
2019 +  if FTransaction <> nil then
2020 +    FTransaction.DoAfterExecQuery(Sender);
2021 + end;
2022 +
2023 + procedure TIBBase.DoAfterEdit(Sender: TObject);
2024 + begin
2025 +  if FTransaction <> nil then
2026 +    FTransaction.DoAfterEdit(Sender);
2027 + end;
2028 +
2029 + procedure TIBBase.DoAfterDelete(Sender: TObject);
2030 + begin
2031 +  if FTransaction <> nil then
2032 +    FTransaction.DoAfterDelete(Sender);
2033 + end;
2034 +
2035 + procedure TIBBase.DoAfterInsert(Sender: TObject);
2036 + begin
2037 +  if FTransaction <> nil then
2038 +    FTransaction.DoAfterInsert(Sender);
2039 + end;
2040 +
2041 + procedure TIBBase.DoAfterPost(Sender: TObject);
2042 + begin
2043 +  if FTransaction <> nil then
2044 +    FTransaction.DoAfterPost(Sender);
2045 + end;
2046 +
2047   procedure TIBBase.SetDatabase(Value: TIBDatabase);
2048   begin
2049    if (FDatabase <> nil) then
# Line 1913 | Line 2076 | end;
2076    parameter buffer, and return it and its length
2077    in DPB and DPBLength, respectively. }
2078  
2079 < procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
2079 > function GenerateDPB(sl: TStrings): IDPB;
2080   var
2081 <  i, j, pval: Integer;
2081 >  i, j: Integer;
2082    DPBVal: UShort;
2083    ParamName, ParamValue: string;
2084   begin
2085 <  { The DPB is initially empty, with the exception that
1923 <    the DPB version must be the first byte of the string. }
1924 <  DPBLength := 1;
1925 <  DPB := Char(isc_dpb_version1);
2085 >  Result := FirebirdAPI.AllocateDPB;
2086  
2087    {Iterate through the textual database parameters, constructing
2088     a DPB on-the-fly }
# Line 1961 | Line 2121 | begin
2121        begin
2122          if DPBVal = isc_dpb_sql_dialect then
2123            ParamValue[1] := Char(Ord(ParamValue[1]) - 48);
2124 <        DPB := DPB +
1965 <               Char(DPBVal) +
1966 <               Char(Length(ParamValue)) +
1967 <               ParamValue;
1968 <        Inc(DPBLength, 2 + Length(ParamValue));
2124 >        Result.Add(DPBVal).SetAsString(ParamValue);
2125        end;
2126 +
2127        isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write,
2128        isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify:
2129 <      begin
2130 <        DPB := DPB +
1974 <               Char(DPBVal) +
1975 <               #1 +
1976 <               Char(StrToInt(ParamValue));
1977 <        Inc(DPBLength, 3);
1978 <      end;
2129 >        Result.Add(DPBVal).SetAsByte(byte(ParamValue[1]));
2130 >
2131        isc_dpb_sweep:
2132 <      begin
2133 <        DPB := DPB +
1982 <               Char(DPBVal) +
1983 <               #1 +
1984 <               Char(isc_dpb_records);
1985 <        Inc(DPBLength, 3);
1986 <      end;
2132 >        Result.Add(DPBVal).SetAsByte(isc_dpb_records);
2133 >
2134        isc_dpb_sweep_interval:
2135 <      begin
2136 <        pval := StrToInt(ParamValue);
1990 <        DPB := DPB +
1991 <               Char(DPBVal) +
1992 <               #4 +
1993 <               PChar(@pval)[0] +
1994 <               PChar(@pval)[1] +
1995 <               PChar(@pval)[2] +
1996 <               PChar(@pval)[3];
1997 <        Inc(DPBLength, 6);
1998 <      end;
2135 >        Result.Add(DPBVal).SetAsInteger(StrToInt(ParamValue));
2136 >
2137        isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
2138        isc_dpb_quit_log:
2139 <      begin
2002 <        DPB := DPB +
2003 <               Char(DPBVal) +
2004 <               #1 + #0;
2005 <        Inc(DPBLength, 3);
2006 <      end;
2139 >        Result.Add(DPBVal).SetAsByte(0);
2140        else
2141        begin
2142          if (DPBVal > 0) and
# Line 2021 | Line 2154 | end;
2154    of the transaction parameters, generate a transaction
2155    parameter buffer, and return it and its length in
2156    TPB and TPBLength, respectively. }
2157 < procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
2157 > function GenerateTPB(sl: TStrings): ITPB;
2158   var
2159 <  i, j, TPBVal, ParamLength: Integer;
2159 >  i, j, TPBVal: Integer;
2160    ParamName, ParamValue: string;
2161   begin
2162 <  TPB := '';
2030 <  if (sl.Count = 0) then
2031 <    TPBLength := 0
2032 <  else
2033 <  begin
2034 <    TPBLength := sl.Count + 1;
2035 <    TPB := TPB + Char(isc_tpb_version3);
2036 <  end;
2162 >  Result := FirebirdAPI.AllocateTPB;
2163    for i := 0 to sl.Count - 1 do
2164    begin
2165      if (Trim(sl[i]) =  '') then
2040    begin
2041      Dec(TPBLength);
2166        Continue;
2167 <    end;
2167 >
2168      if (Pos('=', sl[i]) = 0) then {mbcs ok}
2169        ParamName := LowerCase(sl[i]) {mbcs ok}
2170      else
# Line 2064 | Line 2188 | begin
2188        isc_tpb_concurrency, isc_tpb_shared, isc_tpb_wait, isc_tpb_nowait,
2189        isc_tpb_read, isc_tpb_write, isc_tpb_ignore_limbo,
2190        isc_tpb_read_committed, isc_tpb_rec_version, isc_tpb_no_rec_version:
2191 <        TPB := TPB + Char(TPBVal);
2191 >        Result.Add(TPBVal);
2192 >
2193        isc_tpb_lock_read, isc_tpb_lock_write:
2194 <      begin
2195 <        TPB := TPB + Char(TPBVal);
2071 <        { Now set the string parameter }
2072 <        ParamLength := Length(ParamValue);
2073 <        Inc(TPBLength, ParamLength + 1);
2074 <        TPB := TPB + Char(ParamLength) + ParamValue;
2075 <      end;
2194 >        Result.Add(TPBVal).SetAsString(ParamValue);
2195 >
2196        else
2197        begin
2198          if (TPBVal > 0) and

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines