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 17 by tony, Sat Dec 28 19:22:24 2013 UTC vs.
Revision 29 by tony, Sat May 9 11:37:49 2015 UTC

# Line 159 | Line 159 | type
159      FHiddenPassword: string;
160      FIBLoaded: Boolean;
161      FOnLogin: TIBDatabaseLoginEvent;
162 +    FSQLHourGlass: Boolean;
163      FTraceFlags: TTraceFlags;
164      FDBSQLDialect: Integer;
165      FSQLDialect: Integer;
# Line 181 | Line 182 | type
182      FUserNames: TStringList;
183      FDataSets: TList;
184      FLoginCalled: boolean;
185 +    FCharSetSizes: array of integer;
186      procedure EnsureInactive;
187      function GetDBSQLDialect: Integer;
188      function GetSQLDialect: Integer;
# Line 195 | Line 197 | type
197      function GetTransaction(Index: Integer): TIBTransaction;
198      function GetTransactionCount: Integer;
199      function Login: Boolean;
200 +    procedure LoadCharSetInfo;
201      procedure SetDatabaseName(const Value: TIBFileName);
202      procedure SetDBParamByDPB(const Idx: Integer; Value: String);
203      procedure SetDBParams(Value: TStrings);
# Line 262 | Line 265 | type
265                                                   write SetDefaultTransaction;
266      property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
267      property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
268 +    property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
269      property DBSQLDialect : Integer read FDBSQLDialect;
270      property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
271      property AfterConnect;
# Line 279 | Line 283 | type
283  
284    TIBTransaction = class(TComponent)
285    private
286 +    FAfterDelete: TNotifyEvent;
287 +    FAfterEdit: TNotifyEvent;
288 +    FAfterExecQuery: TNotifyEvent;
289 +    FAfterInsert: TNotifyEvent;
290 +    FAfterPost: TNotifyEvent;
291 +    FAfterTransactionEnd: TNotifyEvent;
292 +    FBeforeTransactionEnd: TNotifyEvent;
293      FIBLoaded: Boolean;
294      FCanTimeout         : Boolean;
295      FDatabases          : TList;
296 +    FOnStartTransaction: TNotifyEvent;
297      FSQLObjects         : TList;
298      FDefaultDatabase    : TIBDatabase;
299      FHandle             : TISC_TR_HANDLE;
# Line 295 | Line 307 | type
307      FTRParams           : TStrings;
308      FTRParamsChanged    : Boolean;
309      FInEndTransaction   : boolean;
310 +    FEndAction          : TTransactionAction;
311 +    procedure DoBeforeTransactionEnd;
312 +    procedure DoAfterTransactionEnd;
313 +    procedure DoOnStartTransaction;
314 +    procedure DoAfterExecQuery(Sender: TObject);
315 +    procedure DoAfterEdit(Sender: TObject);
316 +    procedure DoAfterDelete(Sender: TObject);
317 +    procedure DoAfterInsert(Sender: TObject);
318 +    procedure DoAfterPost(Sender: TObject);
319      procedure EnsureNotInTransaction;
320      procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
321      function GetDatabase(Index: Integer): TIBDatabase;
# Line 336 | Line 357 | type
357      function AddDatabase(db: TIBDatabase): Integer;
358      function FindDatabase(db: TIBDatabase): Integer;
359      function FindDefaultDatabase: TIBDatabase;
360 +    function GetEndAction: TTransactionAction;
361      procedure RemoveDatabase(Idx: Integer);
362      procedure RemoveDatabases;
363      procedure CheckDatabasesInList;
# Line 357 | Line 379 | type
379      property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
380      property Params: TStrings read FTRParams write SetTRParams;
381      property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
382 <  end;
382 >    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
383 >                                             write FBeforeTransactionEnd;
384 >    property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
385 >                                            write FAfterTransactionEnd;
386 >    property OnStartTransaction: TNotifyEvent read FOnStartTransaction
387 >                                              write FOnStartTransaction;
388 >    property AfterExecQuery: TNotifyEvent read FAfterExecQuery
389 >                                              write FAfterExecQuery;
390 >    property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit;
391 >    property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
392 >    property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert;
393 >    property AfterPost: TNotifyEvent read FAfterPost write FAfterPost;
394 >  end;
395 >
396 >  TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object;
397 >  TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings;
398 >                              var DBName: string) of object;
399  
400    { TIBBase }
401  
# Line 366 | Line 404 | type
404      connections. }
405    TIBBase = class(TObject)
406    protected
407 +    FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent;
408      FDatabase: TIBDatabase;
409      FIndexInDatabase: Integer;
410      FTransaction: TIBTransaction;
# Line 375 | Line 414 | type
414      FAfterDatabaseDisconnect: TNotifyEvent;
415      FAfterDatabaseConnect: TNotifyEvent;
416      FOnDatabaseFree: TNotifyEvent;
417 <    FBeforeTransactionEnd: TNotifyEvent;
417 >    FBeforeTransactionEnd: TTransactionEndEvent;
418      FAfterTransactionEnd: TNotifyEvent;
419      FOnTransactionFree: TNotifyEvent;
420  
421 +    procedure DoBeforeDatabaseConnect(DBParams: TStrings;
422 +                              var DBName: string); virtual;
423      procedure DoAfterDatabaseConnect; virtual;
424      procedure DoBeforeDatabaseDisconnect; virtual;
425      procedure DoAfterDatabaseDisconnect; virtual;
426      procedure DoDatabaseFree; virtual;
427 <    procedure DoBeforeTransactionEnd; virtual;
427 >    procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
428      procedure DoAfterTransactionEnd; virtual;
429      procedure DoTransactionFree; virtual;
430      function GetDBHandle: PISC_DB_HANDLE; virtual;
# Line 395 | Line 436 | type
436      destructor Destroy; override;
437      procedure CheckDatabase; virtual;
438      procedure CheckTransaction; virtual;
439 +    procedure DoAfterExecQuery(Sender: TObject); virtual;
440 +    procedure DoAfterEdit(Sender: TObject); virtual;
441 +    procedure DoAfterDelete(Sender: TObject); virtual;
442 +    procedure DoAfterInsert(Sender: TObject); virtual;
443 +    procedure DoAfterPost(Sender: TObject); virtual;
444 +    function GetCharSetSize(CharSetID: integer): integer;
445    public
446 +    property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect
447 +                                                 write FBeforeDatabaseConnect;
448      property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
449                                                  write FAfterDatabaseConnect;
450      property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
# Line 403 | Line 452 | type
452      property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
453                                                    write FAfterDatabaseDisconnect;
454      property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
455 <    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
455 >    property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
456      property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
457      property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
458      property Database: TIBDatabase read FDatabase
# Line 426 | Line 475 | uses IBIntf, IBSQLMonitor, IBCustomDataS
475  
476   { TIBDatabase }
477  
478 < constructor TIBDatabase.Create(AOwner: TComponent);
478 > constructor TIBDataBase.Create(AOwner: TComponent);
479   {$ifdef WINDOWS}
480   var acp: uint;
481   {$endif}
# Line 440 | Line 489 | begin
489    FTransactions := TList.Create;
490    FDBName := '';
491    FDBParams := TStringList.Create;
492 +  FSQLHourGlass := true;
493    {$ifdef UNIX}
494    if csDesigning in ComponentState then
495      FDBParams.Add('lc_ctype=UTF-8');
# Line 472 | Line 522 | begin
522    CheckStreamConnect;
523   end;
524  
525 < destructor TIBDatabase.Destroy;
525 > destructor TIBDataBase.Destroy;
526   var
527    i: Integer;
528   begin
# Line 498 | Line 548 | begin
548    inherited Destroy;
549   end;
550  
551 < function TIBDatabase.Call(ErrCode: ISC_STATUS;
552 <  RaiseError: Boolean): ISC_STATUS;
551 > function TIBDataBase.Call(ErrCode: ISC_STATUS; RaiseError: Boolean
552 >   ): ISC_STATUS;
553   begin
554    result := ErrCode;
555    FCanTimeout := False;
# Line 507 | Line 557 | begin
557      IBDataBaseError;
558   end;
559  
560 < procedure TIBDatabase.CheckActive;
560 > procedure TIBDataBase.CheckActive;
561   begin
562    if StreamedConnected and (not Connected) then
563      Loaded;
# Line 515 | Line 565 | begin
565      IBError(ibxeDatabaseClosed, [nil]);
566   end;
567  
568 < procedure TIBDatabase.EnsureInactive;
568 > procedure TIBDataBase.EnsureInactive;
569   begin
570    if csDesigning in ComponentState then
571    begin
# Line 524 | Line 574 | begin
574    end
575   end;
576  
577 < procedure TIBDatabase.CheckInactive;
577 > procedure TIBDataBase.CheckInactive;
578   begin
579    if FHandle <> nil then
580      IBError(ibxeDatabaseOpen, [nil]);
581   end;
582  
583 < procedure TIBDatabase.CheckDatabaseName;
583 > procedure TIBDataBase.CheckDatabaseName;
584   begin
585    if (FDBName = '') then
586      IBError(ibxeDatabaseNameMissing, [nil]);
587   end;
588  
589 < function TIBDatabase.AddSQLObject(ds: TIBBase): Integer;
589 > function TIBDataBase.AddSQLObject(ds: TIBBase): Integer;
590   begin
591    result := 0;
592    if (ds.Owner is TIBCustomDataSet) then
# Line 549 | Line 599 | begin
599      FSQLObjects[result] := ds;
600   end;
601  
602 < function TIBDatabase.AddTransaction(TR: TIBTransaction): Integer;
602 > function TIBDataBase.AddTransaction(TR: TIBTransaction): Integer;
603   begin
604    result := FindTransaction(TR);
605    if result <> -1 then
# Line 566 | Line 616 | begin
616      FTransactions[result] := TR;
617   end;
618  
619 < procedure TIBDatabase.DoDisconnect;
619 > procedure TIBDataBase.DoDisconnect;
620   begin
621    if Connected then
622      InternalClose(False);
623    FDBSQLDialect := 1;
624 +  SetLength(FCharSetSizes,0);
625   end;
626  
627 < procedure TIBDatabase.CreateDatabase;
627 > procedure TIBDataBase.CreateDatabase;
628   var
629    tr_handle: TISC_TR_HANDLE;
630   begin
# Line 586 | Line 637 | begin
637      True);
638   end;
639  
640 < procedure TIBDatabase.DropDatabase;
640 > procedure TIBDataBase.DropDatabase;
641   begin
642    CheckActive;
643    Call(isc_drop_database(StatusVector, @FHandle), True);
644   end;
645  
646 < procedure TIBDatabase.DBParamsChange(Sender: TObject);
646 > procedure TIBDataBase.DBParamsChange(Sender: TObject);
647   begin
648    FDBParamsChanged := True;
649   end;
650  
651 < procedure TIBDatabase.DBParamsChanging(Sender: TObject);
651 > procedure TIBDataBase.DBParamsChanging(Sender: TObject);
652   begin
653    EnsureInactive;
654    CheckInactive;
655   end;
656  
657 < function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer;
657 > function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer;
658   var
659    i: Integer;
660   begin
# Line 616 | Line 667 | begin
667      end;
668   end;
669  
670 < function TIBDatabase.FindDefaultTransaction(): TIBTransaction;
670 > function TIBDataBase.FindDefaultTransaction: TIBTransaction;
671   var
672    i: Integer;
673   begin
# Line 634 | Line 685 | begin
685    end;
686   end;
687  
688 < procedure TIBDatabase.ForceClose;
688 > procedure TIBDataBase.ForceClose;
689   begin
690    if Connected then
691      InternalClose(True);
692   end;
693  
694 < function TIBDatabase.GetConnected: Boolean;
694 > function TIBDataBase.GetConnected: Boolean;
695   begin
696    result := FHandle <> nil;
697   end;
698  
699 < function TIBDatabase.GetSQLObject(Index: Integer): TIBBase;
699 > function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
700   begin
701    result := FSQLObjects[Index];
702   end;
703  
704 < function TIBDatabase.GetSQLObjectCount: Integer;
704 > function TIBDataBase.GetSQLObjectCount: Integer;
705   var
706    i: Integer;
707   begin
# Line 659 | Line 710 | begin
710      Inc(result);
711   end;
712  
713 < function TIBDatabase.GetDBParamByDPB(const Idx: Integer): String;
713 > function TIBDataBase.GetDBParamByDPB( const Idx: Integer): String;
714   var
715    ConstIdx, EqualsIdx: Integer;
716   begin
# Line 682 | Line 733 | begin
733      result := '';
734   end;
735  
736 < function TIBDatabase.GetIdleTimer: Integer;
736 > function TIBDataBase.GetIdleTimer: Integer;
737   begin
738    result := FTimer.Interval;
739   end;
740  
741 < function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction;
741 > function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction;
742   begin
743    result := FTransactions[Index];
744   end;
745  
746 < function TIBDatabase.GetTransactionCount: Integer;
746 > function TIBDataBase.GetTransactionCount: Integer;
747   var
748    i: Integer;
749   begin
# Line 702 | Line 753 | begin
753        Inc(result);
754   end;
755  
756 < function TIBDatabase.IndexOfDBConst(st: String): Integer;
756 > function TIBDataBase.IndexOfDBConst(st: String): Integer;
757   var
758    i, pos_of_str: Integer;
759   begin
# Line 718 | Line 769 | begin
769    end;
770   end;
771  
772 < procedure TIBDatabase.InternalClose(Force: Boolean);
772 > procedure TIBDataBase.InternalClose(Force: Boolean);
773   var
774    i: Integer;
775   begin
# Line 765 | Line 816 | begin
816        SQLObjects[i].DoAfterDatabaseDisconnect;
817   end;
818  
819 + procedure TIBDataBase.LoadCharSetInfo;
820 + var Query: TIBSQL;
821 +    i: integer;
822 + begin
823 +  if not FInternalTransaction.Active then
824 +    FInternalTransaction.StartTransaction;
825 +  Query := TIBSQL.Create(self);
826 +  try
827 +    Query.Database := Self;
828 +    Query.Transaction := FInternalTransaction;
829 +    Query.SQL.Text := 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER ' +
830 +                      'From RDB$CHARACTER_SETS Order by 1 DESC'; {do not localize}
831 +    Query.Prepare;
832 +    Query.ExecQuery;
833 +    if not Query.EOF then
834 +    begin
835 +      SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
836 +      for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
837 +      repeat
838 +        FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
839 +                 Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
840 +        Query.Next;
841 +      until Query.EOF;
842 +    end;
843 +  finally
844 +    Query.free;
845 +    FInternalTransaction.Commit;
846 +  end;
847 + end;
848 +
849   procedure TIBDataBase.CheckStreamConnect;
850   var
851    i: integer;
# Line 797 | Line 878 | begin
878    end;
879   end;
880  
881 < procedure TIBDatabase.Notification( AComponent: TComponent;
882 <                                        Operation: TOperation);
881 > procedure TIBDataBase.Notification(AComponent: TComponent;
882 >   Operation: TOperation);
883   var
884    i: Integer;
885   begin
# Line 812 | Line 893 | begin
893    end;
894   end;
895  
896 < function TIBDatabase.Login: Boolean;
896 > function TIBDataBase.Login: Boolean;
897   var
898    IndexOfUser, IndexOfPassword: Integer;
899    Username, Password, OldPassword: String;
# Line 891 | Line 972 | begin
972    end;
973   end;
974  
975 < procedure TIBDatabase.DoConnect;
975 > procedure TIBDataBase.DoConnect;
976   var
977    DPB: String;
978    TempDBParams: TStrings;
979    I: integer;
980 <
980 >  aDBName: string;
981   begin
982    CheckInactive;
983    CheckDatabaseName;
# Line 908 | Line 989 | begin
989    { Use builtin login prompt if requested }
990    if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
991      IBError(ibxeOperationCancelled, [nil]);
992 <  { Generate a new DPB if necessary }
993 <  if (FDBParamsChanged) then
994 <  begin
995 <    FDBParamsChanged := False;
996 <    if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
997 <      GenerateDPB(FDBParams, DPB, FDPBLength)
998 <    else
999 <    begin
1000 <      TempDBParams := TStringList.Create;
1001 <      try
1002 <       TempDBParams.Assign(FDBParams);
1003 <       TempDBParams.Add('password=' + FHiddenPassword);
1004 <       GenerateDPB(TempDBParams, DPB, FDPBLength);
1005 <      finally
1006 <       TempDBParams.Free;
1007 <      end;
1008 <    end;
1009 <    IBAlloc(FDPB, 0, FDPBLength);
1010 <    Move(DPB[1], FDPB[0], FDPBLength);
992 >
993 >  TempDBParams := TStringList.Create;
994 >  try
995 >   TempDBParams.Assign(FDBParams);
996 >   aDBName := FDBName;
997 >   {Opportuning to override defaults}
998 >   for i := 0 to FSQLObjects.Count - 1 do
999 >   begin
1000 >       if FSQLObjects[i] <> nil then
1001 >         SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
1002 >   end;
1003 >
1004 >   { Generate a new DPB if necessary }
1005 >   if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
1006 >   begin
1007 >     FDBParamsChanged := False;
1008 >     if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
1009 >       GenerateDPB(TempDBParams, DPB, FDPBLength)
1010 >     else
1011 >     begin
1012 >        TempDBParams.Add('password=' + FHiddenPassword);
1013 >        GenerateDPB(TempDBParams, DPB, FDPBLength);
1014 >     end;
1015 >     IBAlloc(FDPB, 0, FDPBLength);
1016 >     Move(DPB[1], FDPB[0], FDPBLength);
1017 >   end;
1018 >  finally
1019 >   TempDBParams.Free;
1020    end;
1021 <  if Call(isc_attach_database(StatusVector, Length(FDBName),
1022 <                         PChar(FDBName), @FHandle,
1021 >  if Call(isc_attach_database(StatusVector, Length(aDBName),
1022 >                         PChar(aDBName), @FHandle,
1023                           FDPBLength, FDPB), False) > 0 then
1024    begin
1025      FHandle := nil;
1026      IBDataBaseError;
1027    end;
1028 +  if not (csDesigning in ComponentState) then
1029 +    FDBName := aDBName; {Synchronise at run time}
1030    FDBSQLDialect := GetDBSQLDialect;
1031    ValidateClientSQLDialect;
1032    for i := 0 to FSQLObjects.Count - 1 do
# Line 944 | Line 1036 | begin
1036    end;
1037    if not (csDesigning in ComponentState) then
1038      MonitorHook.DBConnect(Self);
1039 +  LoadCharSetInfo;
1040   end;
1041  
1042 < procedure TIBDatabase.RemoveSQLObject(Idx: Integer);
1042 > procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
1043   var
1044    ds: TIBBase;
1045   begin
# Line 960 | Line 1053 | begin
1053    end;
1054   end;
1055  
1056 < procedure TIBDatabase.RemoveSQLObjects;
1056 > procedure TIBDataBase.RemoveSQLObjects;
1057   var
1058    i: Integer;
1059   begin
# Line 972 | Line 1065 | begin
1065    end;
1066   end;
1067  
1068 < procedure TIBDatabase.RemoveTransaction(Idx: Integer);
1068 > procedure TIBDataBase.RemoveTransaction(Idx: Integer);
1069   var
1070    TR: TIBTransaction;
1071   begin
# Line 986 | Line 1079 | begin
1079    end;
1080   end;
1081  
1082 < procedure TIBDatabase.RemoveTransactions;
1082 > procedure TIBDataBase.RemoveTransactions;
1083   var
1084    i: Integer;
1085   begin
# Line 994 | Line 1087 | begin
1087      RemoveTransaction(i);
1088   end;
1089  
1090 < procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName);
1090 > procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName);
1091   begin
1092    if FDBName <> Value then
1093    begin
# Line 1004 | Line 1097 | begin
1097    end;
1098   end;
1099  
1100 < procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String);
1100 > procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String);
1101   var
1102    ConstIdx: Integer;
1103   begin
# Line 1023 | Line 1116 | begin
1116    end;
1117   end;
1118  
1119 < procedure TIBDatabase.SetDBParams(Value: TStrings);
1119 > procedure TIBDataBase.SetDBParams(Value: TStrings);
1120   begin
1121    FDBParams.Assign(Value);
1122   end;
1123  
1124 < procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction);
1124 > procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction);
1125   var
1126    i: Integer;
1127   begin
# Line 1046 | Line 1139 | begin
1139    FDefaultTransaction := Value;
1140   end;
1141  
1142 < procedure TIBDatabase.SetHandle(Value: TISC_DB_HANDLE);
1142 > procedure TIBDataBase.SetHandle(Value: TISC_DB_HANDLE);
1143   begin
1144    if HandleIsShared then
1145      Close
# Line 1056 | Line 1149 | begin
1149    FHandleIsShared := (Value <> nil);
1150   end;
1151  
1152 < procedure TIBDatabase.SetIdleTimer(Value: Integer);
1152 > procedure TIBDataBase.SetIdleTimer(Value: Integer);
1153   begin
1154    if Value < 0 then
1155      IBError(ibxeTimeoutNegative, [nil])
# Line 1075 | Line 1168 | begin
1168        end;
1169   end;
1170  
1171 < function TIBDatabase.TestConnected: Boolean;
1171 > function TIBDataBase.TestConnected: Boolean;
1172   var
1173    DatabaseInfo: TIBDatabaseInfo;
1174   begin
# Line 1096 | Line 1189 | begin
1189    end;
1190   end;
1191  
1192 < procedure TIBDatabase.TimeoutConnection(Sender: TObject);
1192 > procedure TIBDataBase.TimeoutConnection(Sender: TObject);
1193   begin
1194    if Connected then
1195    begin
# Line 1111 | Line 1204 | begin
1204    end;
1205   end;
1206  
1207 < function TIBDatabase.GetIsReadOnly: Boolean;
1207 > function TIBDataBase.GetIsReadOnly: Boolean;
1208   var
1209    DatabaseInfo: TIBDatabaseInfo;
1210   begin
# Line 1129 | Line 1222 | begin
1222    DatabaseInfo.Free;
1223   end;
1224  
1225 < function TIBDatabase.GetSQLDialect: Integer;
1225 > function TIBDataBase.GetSQLDialect: Integer;
1226   begin
1227    Result := FSQLDialect;
1228   end;
1229  
1230  
1231 < procedure TIBDatabase.SetSQLDialect(const Value: Integer);
1231 > procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1232   begin
1233    if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1234    if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
# Line 1144 | Line 1237 | begin
1237      IBError(ibxeSQLDialectInvalid, [nil]);
1238   end;
1239  
1240 < function TIBDatabase.GetDBSQLDialect: Integer;
1240 > function TIBDataBase.GetDBSQLDialect: Integer;
1241   var
1242    DatabaseInfo: TIBDatabaseInfo;
1243   begin
# Line 1154 | Line 1247 | begin
1247    DatabaseInfo.Free;
1248   end;
1249  
1250 < procedure TIBDatabase.ValidateClientSQLDialect;
1250 > procedure TIBDataBase.ValidateClientSQLDialect;
1251   begin
1252    if (FDBSQLDialect < FSQLDialect) then
1253    begin
# Line 1164 | Line 1257 | begin
1257    end;
1258   end;
1259  
1260 < procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet);
1260 > procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet);
1261   var
1262    I: Integer;
1263    DS: TIBCustomDataSet;
# Line 1190 | Line 1283 | begin
1283    TR.CommitRetaining;
1284   end;
1285  
1286 < procedure TIBDatabase.CloseDataSets;
1286 > procedure TIBDataBase.CloseDataSets;
1287   var
1288    i: Integer;
1289   begin
# Line 1199 | Line 1292 | begin
1292        DataSets[i].close;
1293   end;
1294  
1295 < function TIBDatabase.GetDataset(Index : longint) : TDataset;
1295 > function TIBDataBase.GetDataset(Index: longint): TDataset;
1296   begin
1297    if (Index >= 0) and (Index < FDataSets.Count) then
1298      Result := TDataSet(FDataSets[Index])
# Line 1207 | Line 1300 | begin
1300      raise Exception.Create('Invalid Index to DataSets');
1301   end;
1302  
1303 < function TIBDatabase.GetDataSetCount : Longint;
1303 > function TIBDataBase.GetDataSetCount: Longint;
1304   begin
1305    Result := FDataSets.Count;
1306   end;
# Line 1228 | Line 1321 | begin
1321    inherited SetConnected(Value);
1322   end;
1323  
1324 < procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings);
1324 > procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings);
1325   var
1326    Query: TIBSQL;
1327   begin
# Line 1269 | Line 1362 | begin
1362    end;
1363   end;
1364  
1365 < procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean);
1365 > procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean);
1366   var
1367    Query : TIBSQL;
1368   begin
# Line 1384 | Line 1477 | begin
1477      IBError(ibxeNotInTransaction, [nil]);
1478   end;
1479  
1480 + procedure TIBTransaction.DoBeforeTransactionEnd;
1481 + begin
1482 +  if Assigned(FBeforeTransactionEnd) then
1483 +    FBeforeTransactionEnd(self);
1484 + end;
1485 +
1486 + procedure TIBTransaction.DoAfterTransactionEnd;
1487 + begin
1488 +  if Assigned(FAfterTransactionEnd) then
1489 +    FAfterTransactionEnd(self);
1490 + end;
1491 +
1492 + procedure TIBTransaction.DoOnStartTransaction;
1493 + begin
1494 +  if assigned(FOnStartTransaction) then
1495 +    OnStartTransaction(self);
1496 + end;
1497 +
1498 + procedure TIBTransaction.DoAfterExecQuery(Sender: TObject);
1499 + begin
1500 +  if assigned(FAfterExecQuery) then
1501 +    AfterExecQuery(Sender);
1502 + end;
1503 +
1504 + procedure TIBTransaction.DoAfterEdit(Sender: TObject);
1505 + begin
1506 +  if assigned(FAfterEdit) then
1507 +    AfterEdit(Sender);
1508 + end;
1509 +
1510 + procedure TIBTransaction.DoAfterDelete(Sender: TObject);
1511 + begin
1512 +  if assigned(FAfterDelete) then
1513 +    AfterDelete(Sender);
1514 + end;
1515 +
1516 + procedure TIBTransaction.DoAfterInsert(Sender: TObject);
1517 + begin
1518 +  if assigned(FAfterInsert) then
1519 +    AfterInsert(Sender);
1520 + end;
1521 +
1522 + procedure TIBTransaction.DoAfterPost(Sender: TObject);
1523 + begin
1524 +  if assigned(FAfterPost) then
1525 +    AfterPost(Sender);
1526 + end;
1527 +
1528   procedure TIBTransaction.EnsureNotInTransaction;
1529   begin
1530    if csDesigning in ComponentState then
# Line 1460 | Line 1601 | begin
1601    CheckInTransaction;
1602    if FInEndTransaction then Exit;
1603    FInEndTransaction := true;
1604 +  FEndAction := Action;
1605    try
1606    case Action of
1607      TARollback, TACommit:
# Line 1468 | Line 1610 | begin
1610           (Action <> FDefaultAction) and
1611           (not Force) then
1612          IBError(ibxeCantEndSharedTransaction, [nil]);
1613 +      DoBeforeTransactionEnd;
1614        for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1615 <        SQLObjects[i].DoBeforeTransactionEnd;
1615 >        SQLObjects[i].DoBeforeTransactionEnd(Action);
1616        if InTransaction then
1617        begin
1618          if HandleIsShared then
# Line 1492 | Line 1635 | begin
1635              IBDataBaseError;
1636          for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1637            SQLObjects[i].DoAfterTransactionEnd;
1638 +        DoAfterTransactionEnd;
1639        end;
1640      end;
1641      TACommitRetaining:
# Line 1582 | Line 1726 | begin
1726    end;
1727   end;
1728  
1729 + function TIBTransaction.GetEndAction: TTransactionAction;
1730 + begin
1731 +  if FInEndTransaction then
1732 +     Result := FEndAction
1733 +  else
1734 +     IBError(ibxeIB60feature, [nil])
1735 + end;
1736 +
1737  
1738   function TIBTransaction.GetIdleTimer: Integer;
1739   begin
# Line 1687 | Line 1839 | begin
1839      for i := 0 to FSQLObjects.Count - 1 do
1840        if (FSQLObjects[i] <> nil) and
1841           (TIBBase(FSQLObjects[i]).Database = nil) then
1842 <        SetOrdProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Integer(Value));
1842 >         SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value);
1843    end;
1844    FDefaultDatabase := Value;
1845   end;
# Line 1793 | Line 1945 | begin
1945    finally
1946      FreeMem(pteb);
1947    end;
1948 +  DoOnStartTransaction;
1949   end;
1950  
1951   procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
# Line 1834 | Line 1987 | begin
1987    inherited Destroy;
1988   end;
1989  
1990 + function TIBBase.GetCharSetSize(CharSetID: integer): integer;
1991 + begin
1992 +  if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetSizes)) then
1993 +    Result := Database.FCharSetSizes[CharSetID]
1994 +  else
1995 +    Result := 1; {Unknown character set}
1996 + end;
1997 +
1998   procedure TIBBase.CheckDatabase;
1999   begin
2000    if (FDatabase = nil) then
# Line 1860 | Line 2021 | begin
2021    result := @FTransaction.Handle;
2022   end;
2023  
2024 + procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
2025 +  );
2026 + begin
2027 +  if assigned(FBeforeDatabaseConnect) then
2028 +    BeforeDatabaseConnect(self,DBParams,DBName);
2029 + end;
2030 +
2031   procedure TIBBase.DoAfterDatabaseConnect;
2032   begin
2033    if assigned(FAfterDatabaseConnect) then
# Line 1886 | Line 2054 | begin
2054    SetTransaction(nil);
2055   end;
2056  
2057 < procedure TIBBase.DoBeforeTransactionEnd;
2057 > procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction);
2058   begin
2059    if Assigned(BeforeTransactionEnd) then
2060 <    BeforeTransactionEnd(Self);
2060 >    BeforeTransactionEnd(Self,Action);
2061   end;
2062  
2063   procedure TIBBase.DoAfterTransactionEnd;
# Line 1905 | Line 2073 | begin
2073    FTransaction := nil;
2074   end;
2075  
2076 + procedure TIBBase.DoAfterExecQuery(Sender: TObject);
2077 + begin
2078 +  if FTransaction <> nil then
2079 +    FTransaction.DoAfterExecQuery(Sender);
2080 + end;
2081 +
2082 + procedure TIBBase.DoAfterEdit(Sender: TObject);
2083 + begin
2084 +  if FTransaction <> nil then
2085 +    FTransaction.DoAfterEdit(Sender);
2086 + end;
2087 +
2088 + procedure TIBBase.DoAfterDelete(Sender: TObject);
2089 + begin
2090 +  if FTransaction <> nil then
2091 +    FTransaction.DoAfterDelete(Sender);
2092 + end;
2093 +
2094 + procedure TIBBase.DoAfterInsert(Sender: TObject);
2095 + begin
2096 +  if FTransaction <> nil then
2097 +    FTransaction.DoAfterInsert(Sender);
2098 + end;
2099 +
2100 + procedure TIBBase.DoAfterPost(Sender: TObject);
2101 + begin
2102 +  if FTransaction <> nil then
2103 +    FTransaction.DoAfterPost(Sender);
2104 + end;
2105 +
2106   procedure TIBBase.SetDatabase(Value: TIBDatabase);
2107   begin
2108    if (FDatabase <> nil) then

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines