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 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 37 by tony, Mon Feb 15 14:44:25 2016 UTC

# Line 24 | Line 24
24   {       Corporation. All Rights Reserved.                                }
25   {    Contributor(s): Jeff Overcash                                       }
26   {                                                                        }
27 + {    IBX For Lazarus (Firebird Express)                                  }
28 + {    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29 + {    Portions created by MWA Software are copyright McCallum Whyman      }
30 + {    Associates Ltd 2011                                                 }
31 + {                                                                        }
32   {************************************************************************}
33  
34   unit IBDatabase;
# Line 33 | Line 38 | unit IBDatabase;
38   interface
39  
40   uses
41 < {$IFDEF LINUX }
37 <  unix,
38 < {$ELSE}
39 < {$DEFINE HAS_SQLMONITOR}
41 > {$IFDEF WINDOWS }
42    Windows,
43 + {$ELSE}
44 +  unix,
45   {$ENDIF}
46 <  Dialogs, Controls, StdCtrls, SysUtils, Classes, Forms, ExtCtrls, IBHeader, IBExternals, DB,
47 <  IB, DBLoginDlg;
46 >  SysUtils, Classes, FPTimer, IBHeader, IBExternals, DB,
47 >  IB, CustApp;
48  
49   const
50    DPBPrefix = 'isc_dpb_';
# Line 151 | Line 155 | type
155    { TIBDatabase }
156    TIBDataBase = class(TCustomConnection)
157    private
158 +    FAllowStreamedConnected: boolean;
159      FHiddenPassword: string;
160      FIBLoaded: Boolean;
161      FOnLogin: TIBDatabaseLoginEvent;
162 +    FSQLHourGlass: Boolean;
163      FTraceFlags: TTraceFlags;
164      FDBSQLDialect: Integer;
165      FSQLDialect: Integer;
# Line 172 | Line 178 | type
178      FDefaultTransaction: TIBTransaction;
179      FInternalTransaction: TIBTransaction;
180      FStreamedConnected: Boolean;
181 <    FTimer: TTimer;
181 >    FTimer: TFPTimer;
182      FUserNames: TStringList;
183      FDataSets: TList;
184 +    FLoginCalled: boolean;
185 +    FCharSetSizes: array of integer;
186 +    FCharSetNames: array of string;
187      procedure EnsureInactive;
188      function GetDBSQLDialect: Integer;
189      function GetSQLDialect: Integer;
# Line 189 | Line 198 | type
198      function GetTransaction(Index: Integer): TIBTransaction;
199      function GetTransactionCount: Integer;
200      function Login: Boolean;
201 +    procedure LoadCharSetInfo;
202      procedure SetDatabaseName(const Value: TIBFileName);
203      procedure SetDBParamByDPB(const Idx: Integer; Value: String);
204      procedure SetDBParams(Value: TStrings);
# Line 205 | Line 215 | type
215      procedure DoConnect; override;
216      procedure DoDisconnect; override;
217      function GetConnected: Boolean; override;
218 <    procedure Loaded; override;
218 >    procedure CheckStreamConnect;
219 >    procedure HandleException(Sender: TObject);
220      procedure Notification( AComponent: TComponent; Operation: TOperation); override;
221      function GetDataset(Index : longint) : TDataset; override;
222      function GetDataSetCount : Longint; override;
223 <
223 >    procedure ReadState(Reader: TReader); override;
224 >    procedure SetConnected (Value : boolean); override;
225    public
226      constructor Create(AOwner: TComponent); override;
227      destructor Destroy; override;
# Line 246 | Line 258 | type
258  
259    published
260      property Connected;
261 <    property StreamedConnected;
261 >    property AllowStreamedConnected: boolean read FAllowStreamedConnected
262 >             write FAllowStreamedConnected;
263      property DatabaseName: TIBFileName read FDBName write SetDatabaseName;
264      property Params: TStrings read FDBParams write SetDBParams;
265      property LoginPrompt default True;
# Line 254 | Line 267 | type
267                                                   write SetDefaultTransaction;
268      property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
269      property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
270 +    property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
271      property DBSQLDialect : Integer read FDBSQLDialect;
272      property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
273      property AfterConnect;
# Line 271 | Line 285 | type
285  
286    TIBTransaction = class(TComponent)
287    private
288 +    FAfterDelete: TNotifyEvent;
289 +    FAfterEdit: TNotifyEvent;
290 +    FAfterExecQuery: TNotifyEvent;
291 +    FAfterInsert: TNotifyEvent;
292 +    FAfterPost: TNotifyEvent;
293 +    FAfterTransactionEnd: TNotifyEvent;
294 +    FBeforeTransactionEnd: TNotifyEvent;
295      FIBLoaded: Boolean;
296      FCanTimeout         : Boolean;
297      FDatabases          : TList;
298 +    FOnStartTransaction: TNotifyEvent;
299      FSQLObjects         : TList;
300      FDefaultDatabase    : TIBDatabase;
301      FHandle             : TISC_TR_HANDLE;
# Line 282 | Line 304 | type
304      FStreamedActive     : Boolean;
305      FTPB                : PChar;
306      FTPBLength          : Short;
307 <    FTimer              : TTimer;
307 >    FTimer              : TFPTimer;
308      FDefaultAction      : TTransactionAction;
309      FTRParams           : TStrings;
310      FTRParamsChanged    : Boolean;
311 +    FInEndTransaction   : boolean;
312 +    FEndAction          : TTransactionAction;
313 +    procedure DoBeforeTransactionEnd;
314 +    procedure DoAfterTransactionEnd;
315 +    procedure DoOnStartTransaction;
316 +    procedure DoAfterExecQuery(Sender: TObject);
317 +    procedure DoAfterEdit(Sender: TObject);
318 +    procedure DoAfterDelete(Sender: TObject);
319 +    procedure DoAfterInsert(Sender: TObject);
320 +    procedure DoAfterPost(Sender: TObject);
321      procedure EnsureNotInTransaction;
322      procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
323      function GetDatabase(Index: Integer): TIBDatabase;
# Line 327 | Line 359 | type
359      function AddDatabase(db: TIBDatabase): Integer;
360      function FindDatabase(db: TIBDatabase): Integer;
361      function FindDefaultDatabase: TIBDatabase;
362 +    function GetEndAction: TTransactionAction;
363      procedure RemoveDatabase(Idx: Integer);
364      procedure RemoveDatabases;
365      procedure CheckDatabasesInList;
# Line 348 | Line 381 | type
381      property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
382      property Params: TStrings read FTRParams write SetTRParams;
383      property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
384 <  end;
384 >    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
385 >                                             write FBeforeTransactionEnd;
386 >    property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
387 >                                            write FAfterTransactionEnd;
388 >    property OnStartTransaction: TNotifyEvent read FOnStartTransaction
389 >                                              write FOnStartTransaction;
390 >    property AfterExecQuery: TNotifyEvent read FAfterExecQuery
391 >                                              write FAfterExecQuery;
392 >    property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit;
393 >    property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
394 >    property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert;
395 >    property AfterPost: TNotifyEvent read FAfterPost write FAfterPost;
396 >  end;
397 >
398 >  TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object;
399 >  TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings;
400 >                              var DBName: string) of object;
401  
402    { TIBBase }
403  
# Line 357 | Line 406 | type
406      connections. }
407    TIBBase = class(TObject)
408    protected
409 +    FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent;
410      FDatabase: TIBDatabase;
411      FIndexInDatabase: Integer;
412      FTransaction: TIBTransaction;
# Line 364 | Line 414 | type
414      FOwner: TObject;
415      FBeforeDatabaseDisconnect: TNotifyEvent;
416      FAfterDatabaseDisconnect: TNotifyEvent;
417 +    FAfterDatabaseConnect: TNotifyEvent;
418      FOnDatabaseFree: TNotifyEvent;
419 <    FBeforeTransactionEnd: TNotifyEvent;
419 >    FBeforeTransactionEnd: TTransactionEndEvent;
420      FAfterTransactionEnd: TNotifyEvent;
421      FOnTransactionFree: TNotifyEvent;
422  
423 +    procedure DoBeforeDatabaseConnect(DBParams: TStrings;
424 +                              var DBName: string); virtual;
425 +    procedure DoAfterDatabaseConnect; virtual;
426      procedure DoBeforeDatabaseDisconnect; virtual;
427      procedure DoAfterDatabaseDisconnect; virtual;
428      procedure DoDatabaseFree; virtual;
429 <    procedure DoBeforeTransactionEnd; virtual;
429 >    procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
430      procedure DoAfterTransactionEnd; virtual;
431      procedure DoTransactionFree; virtual;
432      function GetDBHandle: PISC_DB_HANDLE; virtual;
# Line 384 | Line 438 | type
438      destructor Destroy; override;
439      procedure CheckDatabase; virtual;
440      procedure CheckTransaction; virtual;
441 +    procedure DoAfterExecQuery(Sender: TObject); virtual;
442 +    procedure DoAfterEdit(Sender: TObject); virtual;
443 +    procedure DoAfterDelete(Sender: TObject); virtual;
444 +    procedure DoAfterInsert(Sender: TObject); virtual;
445 +    procedure DoAfterPost(Sender: TObject); virtual;
446 +    function GetCharSetSize(CharSetID: integer): integer;
447 +    function GetDefaultCharSetSize: integer;
448 +    function GetCharSetName(CharSetID: integer): string;
449 +    function GetDefaultCharSetName: string;
450 +    procedure HandleException(Sender: TObject);
451 +    procedure SetCursor;
452 +    procedure RestoreCursor;
453    public
454 +    property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect
455 +                                                 write FBeforeDatabaseConnect;
456 +    property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
457 +                                                write FAfterDatabaseConnect;
458      property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
459                                                     write FBeforeDatabaseDisconnect;
460      property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
461                                                    write FAfterDatabaseDisconnect;
462      property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
463 <    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
463 >    property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
464      property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
465      property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
466      property Database: TIBDatabase read FDatabase
# Line 408 | Line 478 | procedure GenerateTPB(sl: TStrings; var
478  
479   implementation
480  
481 < uses IBIntf,{$IFDEF HAS_SQLMONITOR}IBSQLMonitor,{$ENDIF} IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, typInfo;
481 > uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
482 >     typInfo;
483  
484   { TIBDatabase }
485  
486 < constructor TIBDatabase.Create(AOwner: TComponent);
486 > constructor TIBDataBase.Create(AOwner: TComponent);
487 > {$ifdef WINDOWS}
488 > var acp: uint;
489 > {$endif}
490   begin
491    inherited Create(AOwner);
492    FIBLoaded := False;
# Line 423 | Line 497 | begin
497    FTransactions := TList.Create;
498    FDBName := '';
499    FDBParams := TStringList.Create;
500 +  FSQLHourGlass := true;
501 +  if (AOwner <> nil) and
502 +     (AOwner is TCustomApplication) and
503 +     TCustomApplication(AOWner).ConsoleApplication then
504 +    LoginPrompt := false;
505 +  {$ifdef UNIX}
506 +  if csDesigning in ComponentState then
507 +    FDBParams.Add('lc_ctype=UTF8');
508 +  {$else}
509 +  {$ifdef WINDOWS}
510 +  if csDesigning in ComponentState then
511 +  begin
512 +    acp := GetACP;
513 +    if (acp >= 1250) and (acp <= 1254) then
514 +      FDBParams.Values['lc_ctype'] := Format('WIN%d',[acp]);
515 +  end;
516 +  {$endif}
517 +  {$endif}
518    FDBParamsChanged := True;
519    TStringList(FDBParams).OnChange := DBParamsChange;
520    TStringList(FDBParams).OnChanging := DBParamsChanging;
# Line 431 | Line 523 | begin
523    FUserNames := nil;
524    FInternalTransaction := TIBTransaction.Create(self);
525    FInternalTransaction.DefaultDatabase := Self;
526 <  FTimer := TTimer.Create(Self);
526 >  FTimer := TFPTimer.Create(Self);
527    FTimer.Enabled := False;
528    FTimer.Interval := 0;
529    FTimer.OnTimer := TimeoutConnection;
# Line 439 | Line 531 | begin
531    FSQLDialect := 3;
532    FTraceFlags := [];
533    FDataSets := TList.Create;
534 +  CheckStreamConnect;
535   end;
536  
537 < destructor TIBDatabase.Destroy;
537 > destructor TIBDataBase.Destroy;
538   var
539    i: Integer;
540   begin
# Line 467 | Line 560 | begin
560    inherited Destroy;
561   end;
562  
563 < function TIBDatabase.Call(ErrCode: ISC_STATUS;
564 <  RaiseError: Boolean): ISC_STATUS;
563 > function TIBDataBase.Call(ErrCode: ISC_STATUS; RaiseError: Boolean
564 >   ): ISC_STATUS;
565   begin
566    result := ErrCode;
567    FCanTimeout := False;
# Line 476 | Line 569 | begin
569      IBDataBaseError;
570   end;
571  
572 < procedure TIBDatabase.CheckActive;
572 > procedure TIBDataBase.CheckActive;
573   begin
574    if StreamedConnected and (not Connected) then
575      Loaded;
# Line 484 | Line 577 | begin
577      IBError(ibxeDatabaseClosed, [nil]);
578   end;
579  
580 < procedure TIBDatabase.EnsureInactive;
580 > procedure TIBDataBase.EnsureInactive;
581   begin
582    if csDesigning in ComponentState then
583    begin
# Line 493 | Line 586 | begin
586    end
587   end;
588  
589 < procedure TIBDatabase.CheckInactive;
589 > procedure TIBDataBase.CheckInactive;
590   begin
591    if FHandle <> nil then
592      IBError(ibxeDatabaseOpen, [nil]);
593   end;
594  
595 < procedure TIBDatabase.CheckDatabaseName;
595 > procedure TIBDataBase.CheckDatabaseName;
596   begin
597 <  if (FDBName = '') then
597 >  if (Trim(FDBName) = '') then
598      IBError(ibxeDatabaseNameMissing, [nil]);
599   end;
600  
601 < function TIBDatabase.AddSQLObject(ds: TIBBase): Integer;
601 > function TIBDataBase.AddSQLObject(ds: TIBBase): Integer;
602   begin
603    result := 0;
604    if (ds.Owner is TIBCustomDataSet) then
605 <  {$IFDEF LINUX}
513 <      FDataSets.Add(TDataSet(ds.Owner));
514 <  {$ELSE}
515 <      RegisterClient(TDataSet(ds.Owner));
516 <  {$ENDIF}
605 >    FDataSets.Add(ds.Owner);
606    while (result < FSQLObjects.Count) and (FSQLObjects[result] <> nil) do
607      Inc(result);
608    if (result = FSQLObjects.Count) then
# Line 522 | Line 611 | begin
611      FSQLObjects[result] := ds;
612   end;
613  
614 < function TIBDatabase.AddTransaction(TR: TIBTransaction): Integer;
614 > function TIBDataBase.AddTransaction(TR: TIBTransaction): Integer;
615   begin
616    result := FindTransaction(TR);
617    if result <> -1 then
# Line 539 | Line 628 | begin
628      FTransactions[result] := TR;
629   end;
630  
631 < procedure TIBDatabase.DoDisconnect;
631 > procedure TIBDataBase.DoDisconnect;
632   begin
633    if Connected then
634      InternalClose(False);
635    FDBSQLDialect := 1;
636 +  SetLength(FCharSetSizes,0);
637 +  SetLength(FCharSetNames,0);
638   end;
639  
640 < procedure TIBDatabase.CreateDatabase;
640 > procedure TIBDataBase.CreateDatabase;
641   var
642    tr_handle: TISC_TR_HANDLE;
643   begin
# Line 559 | Line 650 | begin
650      True);
651   end;
652  
653 < procedure TIBDatabase.DropDatabase;
653 > procedure TIBDataBase.DropDatabase;
654   begin
655    CheckActive;
656    Call(isc_drop_database(StatusVector, @FHandle), True);
657   end;
658  
659 < procedure TIBDatabase.DBParamsChange(Sender: TObject);
659 > procedure TIBDataBase.DBParamsChange(Sender: TObject);
660   begin
661    FDBParamsChanged := True;
662   end;
663  
664 < procedure TIBDatabase.DBParamsChanging(Sender: TObject);
664 > procedure TIBDataBase.DBParamsChanging(Sender: TObject);
665   begin
666    EnsureInactive;
667    CheckInactive;
668   end;
669  
670 < function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer;
670 > function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer;
671   var
672    i: Integer;
673   begin
# Line 589 | Line 680 | begin
680      end;
681   end;
682  
683 < function TIBDatabase.FindDefaultTransaction(): TIBTransaction;
683 > function TIBDataBase.FindDefaultTransaction: TIBTransaction;
684   var
685    i: Integer;
686   begin
# Line 607 | Line 698 | begin
698    end;
699   end;
700  
701 < procedure TIBDatabase.ForceClose;
701 > procedure TIBDataBase.ForceClose;
702   begin
703    if Connected then
704      InternalClose(True);
705   end;
706  
707 < function TIBDatabase.GetConnected: Boolean;
707 > function TIBDataBase.GetConnected: Boolean;
708   begin
709    result := FHandle <> nil;
710   end;
711  
712 < function TIBDatabase.GetSQLObject(Index: Integer): TIBBase;
712 > function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
713   begin
714    result := FSQLObjects[Index];
715   end;
716  
717 < function TIBDatabase.GetSQLObjectCount: Integer;
717 > function TIBDataBase.GetSQLObjectCount: Integer;
718   var
719    i: Integer;
720   begin
# Line 632 | Line 723 | begin
723      Inc(result);
724   end;
725  
726 < function TIBDatabase.GetDBParamByDPB(const Idx: Integer): String;
726 > function TIBDataBase.GetDBParamByDPB( const Idx: Integer): String;
727   var
728    ConstIdx, EqualsIdx: Integer;
729   begin
# Line 655 | Line 746 | begin
746      result := '';
747   end;
748  
749 < function TIBDatabase.GetIdleTimer: Integer;
749 > function TIBDataBase.GetIdleTimer: Integer;
750   begin
751    result := FTimer.Interval;
752   end;
753  
754 < function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction;
754 > function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction;
755   begin
756    result := FTransactions[Index];
757   end;
758  
759 < function TIBDatabase.GetTransactionCount: Integer;
759 > function TIBDataBase.GetTransactionCount: Integer;
760   var
761    i: Integer;
762   begin
# Line 675 | Line 766 | begin
766        Inc(result);
767   end;
768  
769 < function TIBDatabase.IndexOfDBConst(st: String): Integer;
769 > function TIBDataBase.IndexOfDBConst(st: String): Integer;
770   var
771    i, pos_of_str: Integer;
772   begin
# Line 691 | Line 782 | begin
782    end;
783   end;
784  
785 < procedure TIBDatabase.InternalClose(Force: Boolean);
785 > procedure TIBDataBase.InternalClose(Force: Boolean);
786   var
787    i: Integer;
788   begin
# Line 730 | Line 821 | begin
821      FHandleIsShared := False;
822    end;
823  
733  {$IFDEF HAS_SQLMONITOR}
824    if not (csDesigning in ComponentState) then
825      MonitorHook.DBDisconnect(Self);
736  {$ENDIF}
826  
827    for i := 0 to FSQLObjects.Count - 1 do
828      if FSQLObjects[i] <> nil then
829        SQLObjects[i].DoAfterDatabaseDisconnect;
830   end;
831  
832 < procedure TIBDatabase.Loaded;
832 > procedure TIBDataBase.LoadCharSetInfo;
833 > var Query: TIBSQL;
834 >    i: integer;
835 > begin
836 >  if not FInternalTransaction.Active then
837 >    FInternalTransaction.StartTransaction;
838 >  Query := TIBSQL.Create(self);
839 >  try
840 >    Query.Database := Self;
841 >    Query.Transaction := FInternalTransaction;
842 >    Query.SQL.Text := 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER, RDB$CHARACTER_SET_NAME ' +
843 >                      'From RDB$CHARACTER_SETS Order by 1 DESC'; {do not localize}
844 >    Query.Prepare;
845 >    Query.ExecQuery;
846 >    if not Query.EOF then
847 >    begin
848 >      SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
849 >      SetLength(FCharSetNames,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
850 >      for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
851 >      repeat
852 >        FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
853 >                 Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
854 >        FCharSetNames[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
855 >                 Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString;
856 >        Query.Next;
857 >      until Query.EOF;
858 >    end;
859 >  finally
860 >    Query.free;
861 >    FInternalTransaction.Commit;
862 >  end;
863 > end;
864 >
865 > procedure TIBDataBase.CheckStreamConnect;
866   var
867    i: integer;
868   begin
869    try
870 <    if StreamedConnected and (not Connected) then
870 >    if not (csDesigning in ComponentState) and StreamedConnected and (not Connected) then
871      begin
750      inherited Loaded;
872        for i := 0 to FTransactions.Count - 1 do
873          if  FTransactions[i] <> nil then
874          begin
# Line 767 | Line 888 | begin
888      end;
889    except
890      if csDesigning in ComponentState then
891 <      Application.HandleException(Self)
891 >      HandleException(Self)
892      else
893        raise;
894    end;
895   end;
896  
897 < procedure TIBDatabase.Notification( AComponent: TComponent;
898 <                                        Operation: TOperation);
897 > procedure TIBDataBase.HandleException(Sender: TObject);
898 > var aParent: TComponent;
899 > begin
900 >  aParent := Owner;
901 >  while aParent <> nil do
902 >  begin
903 >    if aParent is TCustomApplication then
904 >    begin
905 >      TCustomApplication(aParent).HandleException(Sender);
906 >      Exit;
907 >    end;
908 >    aParent := aParent.Owner;
909 >  end;
910 >  SysUtils.ShowException(ExceptObject,ExceptAddr);
911 > end;
912 >
913 > procedure TIBDataBase.Notification(AComponent: TComponent;
914 >   Operation: TOperation);
915   var
916    i: Integer;
917   begin
# Line 788 | Line 925 | begin
925    end;
926   end;
927  
928 < function TIBDatabase.Login: Boolean;
928 > function TIBDataBase.Login: Boolean;
929   var
930    IndexOfUser, IndexOfPassword: Integer;
931    Username, Password, OldPassword: String;
# Line 812 | Line 949 | var
949    end;
950  
951   begin
952 <  if Assigned(FOnLogin) then
952 >  Result := false;
953 >  if FLoginCalled then Exit;
954 >  FLoginCalled := true;
955 >  try
956 >  if Assigned(FOnLogin) and not (csDesigning in ComponentState) then
957    begin
958      result := True;
959      LoginParams := TStringList.Create;
# Line 826 | Line 967 | begin
967      end;
968    end
969    else
970 +  if assigned(IBGUIInterface) then
971    begin
972      IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]);
973      if IndexOfUser <> -1 then
# Line 840 | Line 982 | begin
982                                           Length(Params[IndexOfPassword]));
983        OldPassword := password;
984      end;
985 <    result := LoginDialogEx(DatabaseName, Username, Password, False);
985 >    result := IBGUIInterface.LoginDialogEx(DatabaseName, Username, Password, False);
986      if result then
987      begin
988        if IndexOfUser = -1 then
# Line 857 | Line 999 | begin
999            HidePassword;
1000        end;
1001      end;
1002 +  end
1003 +  else
1004 +  if LoginPrompt then
1005 +     IBError(ibxeNoLoginDialog,[]);
1006 +  finally
1007 +    FLoginCalled := false
1008    end;
1009   end;
1010  
1011 < procedure TIBDatabase.DoConnect;
1011 > procedure TIBDataBase.DoConnect;
1012   var
1013    DPB: String;
1014    TempDBParams: TStrings;
1015 +  I: integer;
1016 +  aDBName: string;
1017  
1018 +  {Call error analysis}
1019 +  sqlcode: Long;
1020 +  IBErrorCode: Long;
1021 +  status_vector: PISC_STATUS;
1022   begin
1023    CheckInactive;
1024    CheckDatabaseName;
# Line 874 | Line 1028 | begin
1028      FDBParamsChanged := True;
1029    end;
1030    { Use builtin login prompt if requested }
1031 <  if LoginPrompt and not Login then
1031 >  if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
1032      IBError(ibxeOperationCancelled, [nil]);
1033 <  { Generate a new DPB if necessary }
1034 <  if (FDBParamsChanged) then
1035 <  begin
1036 <    FDBParamsChanged := False;
1037 <    if (not LoginPrompt) or (FHiddenPassword = '') then
1038 <      GenerateDPB(FDBParams, DPB, FDPBLength)
1039 <    else
1033 >
1034 >  TempDBParams := TStringList.Create;
1035 >  try
1036 >   TempDBParams.Assign(FDBParams);
1037 >   aDBName := FDBName;
1038 >   {Opportunity to override defaults}
1039 >   for i := 0 to FSQLObjects.Count - 1 do
1040 >   begin
1041 >       if FSQLObjects[i] <> nil then
1042 >         SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
1043 >   end;
1044 >
1045 >   { Generate a new DPB if necessary }
1046 >   if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
1047 >   begin
1048 >     FDBParamsChanged := False;
1049 >     if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
1050 >       GenerateDPB(TempDBParams, DPB, FDPBLength)
1051 >     else
1052 >     begin
1053 >        TempDBParams.Add('password=' + FHiddenPassword);
1054 >        GenerateDPB(TempDBParams, DPB, FDPBLength);
1055 >     end;
1056 >     IBAlloc(FDPB, 0, FDPBLength);
1057 >     Move(DPB[1], FDPB[0], FDPBLength);
1058 >   end;
1059 >  finally
1060 >   TempDBParams.Free;
1061 >  end;
1062 >  repeat
1063 >    if Call(isc_attach_database(StatusVector, Length(aDBName),
1064 >                         PChar(aDBName), @FHandle,
1065 >                         FDPBLength, FDPB), False) > 0 then
1066      begin
1067 <      TempDBParams := TStringList.Create;
1068 <      try
1069 <       TempDBParams.Assign(FDBParams);
1070 <       TempDBParams.Add('password=' + FHiddenPassword);
1071 <       GenerateDPB(TempDBParams, DPB, FDPBLength);
1072 <      finally
1073 <       TempDBParams.Free;
1067 >      {$IFDEF UNIX}
1068 >      if IsEmbeddedServer and (Pos(':',aDBName) = 0) then
1069 >      begin
1070 >        status_vector := StatusVector;
1071 >        IBErrorCode := StatusVectorArray[1];
1072 >        sqlcode := isc_sqlcode(StatusVector);
1073 >
1074 >        if ((sqlcode = -901) and (IBErrorCode = 335544382)) {Access permissions on firebird temp}
1075 >           or
1076 >           ((sqlcode = -902) and (IBErrorCode = 335544373)) {Security DB Problem}
1077 >           then
1078 >           begin
1079 >             aDBName := 'localhost:' + aDBName;
1080 >             Continue;
1081 >           end;
1082        end;
1083 +      {$ENDIF}
1084 +      FHandle := nil;
1085 +      IBDataBaseError;
1086      end;
1087 <    IBAlloc(FDPB, 0, FDPBLength);
1088 <    Move(DPB[1], FDPB[0], FDPBLength);
1089 <  end;
899 <  if Call(isc_attach_database(StatusVector, Length(FDBName),
900 <                         PChar(FDBName), @FHandle,
901 <                         FDPBLength, FDPB), False) > 0 then
902 <  begin
903 <    FHandle := nil;
904 <    IBDataBaseError;
905 <  end;
1087 >  until FHandle <> nil;
1088 >  if not (csDesigning in ComponentState) then
1089 >    FDBName := aDBName; {Synchronise at run time}
1090    FDBSQLDialect := GetDBSQLDialect;
1091    ValidateClientSQLDialect;
1092 <  {$IFDEF HAS_SQLMONITOR}
1092 >  for i := 0 to FSQLObjects.Count - 1 do
1093 >  begin
1094 >      if FSQLObjects[i] <> nil then
1095 >        SQLObjects[i].DoAfterDatabaseConnect;
1096 >  end;
1097    if not (csDesigning in ComponentState) then
1098      MonitorHook.DBConnect(Self);
1099 <  {$ENDIF}
1099 >  LoadCharSetInfo;
1100   end;
1101  
1102 < procedure TIBDatabase.RemoveSQLObject(Idx: Integer);
1102 > procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
1103   var
1104    ds: TIBBase;
1105   begin
# Line 921 | Line 1109 | begin
1109      FSQLObjects[Idx] := nil;
1110      ds.Database := nil;
1111      if (ds.owner is TDataSet) then
924    {$IFDEF LINUX}
1112        FDataSets.Remove(TDataSet(ds.Owner));
926    {$ELSE}
927      UnregisterClient(TDataSet(ds.Owner));
928    {$ENDIF}
1113    end;
1114   end;
1115  
1116 < procedure TIBDatabase.RemoveSQLObjects;
1116 > procedure TIBDataBase.RemoveSQLObjects;
1117   var
1118    i: Integer;
1119   begin
# Line 937 | Line 1121 | begin
1121    begin
1122      RemoveSQLObject(i);
1123      if (TIBBase(FSQLObjects[i]).owner is TDataSet) then
940    {$IFDEF LINUX}
1124        FDataSets.Remove(TDataSet(TIBBase(FSQLObjects[i]).owner));
942    {$ELSE}
943      UnregisterClient(TDataSet(TIBBase(FSQLObjects[i]).owner));
944    {$ENDIF}
1125    end;
1126   end;
1127  
1128 < procedure TIBDatabase.RemoveTransaction(Idx: Integer);
1128 > procedure TIBDataBase.RemoveTransaction(Idx: Integer);
1129   var
1130    TR: TIBTransaction;
1131   begin
# Line 959 | Line 1139 | begin
1139    end;
1140   end;
1141  
1142 < procedure TIBDatabase.RemoveTransactions;
1142 > procedure TIBDataBase.RemoveTransactions;
1143   var
1144    i: Integer;
1145   begin
# Line 967 | Line 1147 | begin
1147      RemoveTransaction(i);
1148   end;
1149  
1150 < procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName);
1150 > procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName);
1151   begin
1152    if FDBName <> Value then
1153    begin
# Line 977 | Line 1157 | begin
1157    end;
1158   end;
1159  
1160 < procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String);
1160 > procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String);
1161   var
1162    ConstIdx: Integer;
1163   begin
# Line 996 | Line 1176 | begin
1176    end;
1177   end;
1178  
1179 < procedure TIBDatabase.SetDBParams(Value: TStrings);
1179 > procedure TIBDataBase.SetDBParams(Value: TStrings);
1180   begin
1181    FDBParams.Assign(Value);
1182   end;
1183  
1184 < procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction);
1184 > procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction);
1185   var
1186    i: Integer;
1187   begin
# Line 1019 | Line 1199 | begin
1199    FDefaultTransaction := Value;
1200   end;
1201  
1202 < procedure TIBDatabase.SetHandle(Value: TISC_DB_HANDLE);
1202 > procedure TIBDataBase.SetHandle(Value: TISC_DB_HANDLE);
1203   begin
1204    if HandleIsShared then
1205      Close
# Line 1029 | Line 1209 | begin
1209    FHandleIsShared := (Value <> nil);
1210   end;
1211  
1212 < procedure TIBDatabase.SetIdleTimer(Value: Integer);
1212 > procedure TIBDataBase.SetIdleTimer(Value: Integer);
1213   begin
1214    if Value < 0 then
1215      IBError(ibxeTimeoutNegative, [nil])
# Line 1048 | Line 1228 | begin
1228        end;
1229   end;
1230  
1231 < function TIBDatabase.TestConnected: Boolean;
1231 > function TIBDataBase.TestConnected: Boolean;
1232   var
1233    DatabaseInfo: TIBDatabaseInfo;
1234   begin
# Line 1069 | Line 1249 | begin
1249    end;
1250   end;
1251  
1252 < procedure TIBDatabase.TimeoutConnection(Sender: TObject);
1252 > procedure TIBDataBase.TimeoutConnection(Sender: TObject);
1253   begin
1254    if Connected then
1255    begin
# Line 1084 | Line 1264 | begin
1264    end;
1265   end;
1266  
1267 < function TIBDatabase.GetIsReadOnly: Boolean;
1267 > function TIBDataBase.GetIsReadOnly: Boolean;
1268   var
1269    DatabaseInfo: TIBDatabaseInfo;
1270   begin
# Line 1102 | Line 1282 | begin
1282    DatabaseInfo.Free;
1283   end;
1284  
1285 < function TIBDatabase.GetSQLDialect: Integer;
1285 > function TIBDataBase.GetSQLDialect: Integer;
1286   begin
1287    Result := FSQLDialect;
1288   end;
1289  
1290 < procedure TIBDatabase.SetSQLDialect(const Value: Integer);
1290 >
1291 > procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1292   begin
1293    if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1294    if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
# Line 1116 | Line 1297 | begin
1297      IBError(ibxeSQLDialectInvalid, [nil]);
1298   end;
1299  
1300 < function TIBDatabase.GetDBSQLDialect: Integer;
1300 > function TIBDataBase.GetDBSQLDialect: Integer;
1301   var
1302    DatabaseInfo: TIBDatabaseInfo;
1303   begin
# Line 1126 | Line 1307 | begin
1307    DatabaseInfo.Free;
1308   end;
1309  
1310 < procedure TIBDatabase.ValidateClientSQLDialect;
1310 > procedure TIBDataBase.ValidateClientSQLDialect;
1311   begin
1312    if (FDBSQLDialect < FSQLDialect) then
1313    begin
# Line 1136 | Line 1317 | begin
1317    end;
1318   end;
1319  
1320 < procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet);
1320 > procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet);
1321   var
1322    I: Integer;
1323    DS: TIBCustomDataSet;
# Line 1162 | Line 1343 | begin
1343    TR.CommitRetaining;
1344   end;
1345  
1346 < procedure TIBDatabase.CloseDataSets;
1346 > procedure TIBDataBase.CloseDataSets;
1347   var
1348    i: Integer;
1349   begin
# Line 1171 | Line 1352 | begin
1352        DataSets[i].close;
1353   end;
1354  
1355 < function TIBDatabase.GetDataset(Index : longint) : TDataset;
1355 > function TIBDataBase.GetDataset(Index: longint): TDataset;
1356   begin
1357    if (Index >= 0) and (Index < FDataSets.Count) then
1358      Result := TDataSet(FDataSets[Index])
# Line 1179 | Line 1360 | begin
1360      raise Exception.Create('Invalid Index to DataSets');
1361   end;
1362  
1363 < function TIBDatabase.GetDataSetCount : Longint;
1363 > function TIBDataBase.GetDataSetCount: Longint;
1364   begin
1365    Result := FDataSets.Count;
1366   end;
1367  
1368 < procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings);
1368 > procedure TIBDataBase.ReadState(Reader: TReader);
1369 > begin
1370 >  FDBParams.Clear;
1371 >  inherited ReadState(Reader);
1372 > end;
1373 >
1374 > procedure TIBDataBase.SetConnected(Value: boolean);
1375 > begin
1376 >  if StreamedConnected and not AllowStreamedConnected then
1377 >  begin
1378 >    StreamedConnected := false;
1379 >    Value := false
1380 >  end;
1381 >  inherited SetConnected(Value);
1382 > end;
1383 >
1384 > procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings);
1385   var
1386    Query: TIBSQL;
1387   begin
# Line 1225 | Line 1422 | begin
1422    end;
1423   end;
1424  
1425 < procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean);
1425 > procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean);
1426   var
1427    Query : TIBSQL;
1428   begin
# Line 1284 | Line 1481 | begin
1481    FTRParamsChanged := True;
1482    TStringList(FTRParams).OnChange := TRParamsChange;
1483    TStringList(FTRParams).OnChanging := TRParamsChanging;
1484 <  FTimer := TTimer.Create(Self);
1484 >  FTimer := TFPTimer.Create(Self);
1485    FTimer.Enabled := False;
1486    FTimer.Interval := 0;
1487    FTimer.OnTimer := TimeoutTransaction;
# Line 1340 | Line 1537 | begin
1537      IBError(ibxeNotInTransaction, [nil]);
1538   end;
1539  
1540 + procedure TIBTransaction.DoBeforeTransactionEnd;
1541 + begin
1542 +  if Assigned(FBeforeTransactionEnd) then
1543 +    FBeforeTransactionEnd(self);
1544 + end;
1545 +
1546 + procedure TIBTransaction.DoAfterTransactionEnd;
1547 + begin
1548 +  if Assigned(FAfterTransactionEnd) then
1549 +    FAfterTransactionEnd(self);
1550 + end;
1551 +
1552 + procedure TIBTransaction.DoOnStartTransaction;
1553 + begin
1554 +  if assigned(FOnStartTransaction) then
1555 +    OnStartTransaction(self);
1556 + end;
1557 +
1558 + procedure TIBTransaction.DoAfterExecQuery(Sender: TObject);
1559 + begin
1560 +  if assigned(FAfterExecQuery) then
1561 +    AfterExecQuery(Sender);
1562 + end;
1563 +
1564 + procedure TIBTransaction.DoAfterEdit(Sender: TObject);
1565 + begin
1566 +  if assigned(FAfterEdit) then
1567 +    AfterEdit(Sender);
1568 + end;
1569 +
1570 + procedure TIBTransaction.DoAfterDelete(Sender: TObject);
1571 + begin
1572 +  if assigned(FAfterDelete) then
1573 +    AfterDelete(Sender);
1574 + end;
1575 +
1576 + procedure TIBTransaction.DoAfterInsert(Sender: TObject);
1577 + begin
1578 +  if assigned(FAfterInsert) then
1579 +    AfterInsert(Sender);
1580 + end;
1581 +
1582 + procedure TIBTransaction.DoAfterPost(Sender: TObject);
1583 + begin
1584 +  if assigned(FAfterPost) then
1585 +    AfterPost(Sender);
1586 + end;
1587 +
1588   procedure TIBTransaction.EnsureNotInTransaction;
1589   begin
1590    if csDesigning in ComponentState then
# Line 1414 | Line 1659 | var
1659    i: Integer;
1660   begin
1661    CheckInTransaction;
1662 +  if FInEndTransaction then Exit;
1663 +  FInEndTransaction := true;
1664 +  FEndAction := Action;
1665 +  try
1666    case Action of
1667      TARollback, TACommit:
1668      begin
# Line 1421 | Line 1670 | begin
1670           (Action <> FDefaultAction) and
1671           (not Force) then
1672          IBError(ibxeCantEndSharedTransaction, [nil]);
1673 +      DoBeforeTransactionEnd;
1674        for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1675 <        SQLObjects[i].DoBeforeTransactionEnd;
1675 >        SQLObjects[i].DoBeforeTransactionEnd(Action);
1676        if InTransaction then
1677        begin
1678          if HandleIsShared then
# Line 1445 | Line 1695 | begin
1695              IBDataBaseError;
1696          for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1697            SQLObjects[i].DoAfterTransactionEnd;
1698 +        DoAfterTransactionEnd;
1699        end;
1700      end;
1701      TACommitRetaining:
# Line 1452 | Line 1703 | begin
1703      TARollbackRetaining:
1704        Call(isc_rollback_retaining(StatusVector, @FHandle), True);
1705    end;
1455  {$IFDEF HAS_SQLMONITOR}
1706    if not (csDesigning in ComponentState) then
1707    begin
1708      case Action of
# Line 1466 | Line 1716 | begin
1716          MonitorHook.TRRollbackRetaining(Self);
1717      end;
1718    end;
1719 <  {$ENDIF}
1719 >  finally
1720 >    FInEndTransaction := false
1721 >  end;
1722   end;
1723  
1724   function TIBTransaction.GetDatabase(Index: Integer): TIBDatabase;
# Line 1534 | Line 1786 | begin
1786    end;
1787   end;
1788  
1789 + function TIBTransaction.GetEndAction: TTransactionAction;
1790 + begin
1791 +  if FInEndTransaction then
1792 +     Result := FEndAction
1793 +  else
1794 +     IBError(ibxeIB60feature, [nil])
1795 + end;
1796 +
1797  
1798   function TIBTransaction.GetIdleTimer: Integer;
1799   begin
# Line 1639 | Line 1899 | begin
1899      for i := 0 to FSQLObjects.Count - 1 do
1900        if (FSQLObjects[i] <> nil) and
1901           (TIBBase(FSQLObjects[i]).Database = nil) then
1902 <        SetOrdProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Integer(Value));
1902 >         SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value);
1903    end;
1904    FDefaultDatabase := Value;
1905   end;
# Line 1740 | Line 2000 | begin
2000        FHandle := nil;
2001        IBDataBaseError;
2002      end;
1743  {$IFDEF HAS_SQLMONITOR}
2003      if not (csDesigning in ComponentState) then
2004        MonitorHook.TRStart(Self);
1746  {$ENDIF}
2005    finally
2006      FreeMem(pteb);
2007    end;
2008 +  DoOnStartTransaction;
2009   end;
2010  
2011   procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
# Line 1788 | Line 2047 | begin
2047    inherited Destroy;
2048   end;
2049  
2050 + function TIBBase.GetCharSetSize(CharSetID: integer): integer;
2051 + begin
2052 +  if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetSizes)) then
2053 +    Result := Database.FCharSetSizes[CharSetID]
2054 +  else
2055 +    Result := 1; {Unknown character set}
2056 + end;
2057 +
2058 + function TIBBase.GetDefaultCharSetSize: integer;
2059 + var DefaultCharSetName: string;
2060 +    i: integer;
2061 + begin
2062 +  DefaultCharSetName := GetDefaultCharSetName;
2063 +  Result := 4; {worse case}
2064 +  for i := 0 to Length(Database.FCharSetSizes) - 1 do
2065 +    if Database.FCharSetNames[i] = DefaultCharSetName then
2066 +    begin
2067 +      Result := Database.FCharSetSizes[i];
2068 +      break;
2069 +    end;
2070 + end;
2071 +
2072 + function TIBBase.GetCharSetName(CharSetID: integer): string;
2073 + begin
2074 +  if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetNames)) then
2075 +    Result := Database.FCharSetNames[CharSetID]
2076 +  else
2077 +    Result := ''; {Unknown character set}
2078 + end;
2079 +
2080 + function TIBBase.GetDefaultCharSetName: string;
2081 + begin
2082 +  Result := AnsiUpperCase(Database.Params.Values['lc_ctype']);
2083 + end;
2084 +
2085 + procedure TIBBase.HandleException(Sender: TObject);
2086 + begin
2087 +  if assigned(Database) then
2088 +     Database.HandleException(Sender)
2089 +  else
2090 +     SysUtils.ShowException(ExceptObject,ExceptAddr);
2091 + end;
2092 +
2093 + procedure TIBBase.SetCursor;
2094 + begin
2095 +  if Assigned(Database) and not Database.SQLHourGlass then
2096 +     Exit;
2097 +  if assigned(IBGUIInterface) then
2098 +     IBGUIInterface.SetCursor;
2099 + end;
2100 +
2101 + procedure TIBBase.RestoreCursor;
2102 + begin
2103 +  if Assigned(Database) and not Database.SQLHourGlass then
2104 +     Exit;
2105 +  if assigned(IBGUIInterface) then
2106 +     IBGUIInterface.RestoreCursor;
2107 + end;
2108 +
2109   procedure TIBBase.CheckDatabase;
2110   begin
2111    if (FDatabase = nil) then
# Line 1814 | Line 2132 | begin
2132    result := @FTransaction.Handle;
2133   end;
2134  
2135 + procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
2136 +  );
2137 + begin
2138 +  if assigned(FBeforeDatabaseConnect) then
2139 +    BeforeDatabaseConnect(self,DBParams,DBName);
2140 + end;
2141 +
2142 + procedure TIBBase.DoAfterDatabaseConnect;
2143 + begin
2144 +  if assigned(FAfterDatabaseConnect) then
2145 +    AfterDatabaseConnect(self);
2146 + end;
2147 +
2148   procedure TIBBase.DoBeforeDatabaseDisconnect;
2149   begin
2150    if Assigned(BeforeDatabaseDisconnect) then
# Line 1834 | Line 2165 | begin
2165    SetTransaction(nil);
2166   end;
2167  
2168 < procedure TIBBase.DoBeforeTransactionEnd;
2168 > procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction);
2169   begin
2170    if Assigned(BeforeTransactionEnd) then
2171 <    BeforeTransactionEnd(Self);
2171 >    BeforeTransactionEnd(Self,Action);
2172   end;
2173  
2174   procedure TIBBase.DoAfterTransactionEnd;
# Line 1853 | Line 2184 | begin
2184    FTransaction := nil;
2185   end;
2186  
2187 + procedure TIBBase.DoAfterExecQuery(Sender: TObject);
2188 + begin
2189 +  if FTransaction <> nil then
2190 +    FTransaction.DoAfterExecQuery(Sender);
2191 + end;
2192 +
2193 + procedure TIBBase.DoAfterEdit(Sender: TObject);
2194 + begin
2195 +  if FTransaction <> nil then
2196 +    FTransaction.DoAfterEdit(Sender);
2197 + end;
2198 +
2199 + procedure TIBBase.DoAfterDelete(Sender: TObject);
2200 + begin
2201 +  if FTransaction <> nil then
2202 +    FTransaction.DoAfterDelete(Sender);
2203 + end;
2204 +
2205 + procedure TIBBase.DoAfterInsert(Sender: TObject);
2206 + begin
2207 +  if FTransaction <> nil then
2208 +    FTransaction.DoAfterInsert(Sender);
2209 + end;
2210 +
2211 + procedure TIBBase.DoAfterPost(Sender: TObject);
2212 + begin
2213 +  if FTransaction <> nil then
2214 +    FTransaction.DoAfterPost(Sender);
2215 + end;
2216 +
2217   procedure TIBBase.SetDatabase(Value: TIBDatabase);
2218   begin
2219    if (FDatabase <> nil) then

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines