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 43 by tony, Thu Sep 22 17:10:15 2016 UTC

# Line 35 | Line 35 | unit IBDatabase;
35  
36   {$Mode Delphi}
37  
38 + {$IF FPC_FULLVERSION >= 20700 }
39 + {$codepage UTF8}
40 + {$DEFINE HAS_ANSISTRING_CODEPAGE}
41 + {$ENDIF}
42 +
43   interface
44  
45   uses
# Line 43 | Line 48 | uses
48   {$ELSE}
49    unix,
50   {$ENDIF}
51 <  Dialogs, Controls, StdCtrls, SysUtils, Classes, Forms, ExtCtrls, IBHeader, IBExternals, DB,
52 <  IB, DBLoginDlg;
51 >  SysUtils, Classes, FPTimer, IBHeader, IBExternals, DB,
52 >  IB, CustApp;
53  
54   const
55    DPBPrefix = 'isc_dpb_';
# Line 159 | Line 164 | type
164      FHiddenPassword: string;
165      FIBLoaded: Boolean;
166      FOnLogin: TIBDatabaseLoginEvent;
167 +    FSQLHourGlass: Boolean;
168      FTraceFlags: TTraceFlags;
169      FDBSQLDialect: Integer;
170      FSQLDialect: Integer;
# Line 177 | Line 183 | type
183      FDefaultTransaction: TIBTransaction;
184      FInternalTransaction: TIBTransaction;
185      FStreamedConnected: Boolean;
186 <    FTimer: TTimer;
186 >    FTimer: TFPTimer;
187      FUserNames: TStringList;
188      FDataSets: TList;
189      FLoginCalled: boolean;
190 +    FDefaultCharSetName: RawByteString;
191 +    FDefaultCharSetID: integer;
192 +    {$IFDEF HAS_ANSISTRING_CODEPAGE}
193 +    FDefaultCodePage: TSystemCodePage;
194 +    {$ENDIF}
195 +    FUseDefaultSystemCodePage: boolean;
196      procedure EnsureInactive;
197      function GetDBSQLDialect: Integer;
198      function GetSQLDialect: Integer;
# Line 194 | Line 206 | type
206      function GetIdleTimer: Integer;
207      function GetTransaction(Index: Integer): TIBTransaction;
208      function GetTransactionCount: Integer;
209 <    function Login: Boolean;
209 >    function Login(var aDatabaseName: string): Boolean;
210      procedure SetDatabaseName(const Value: TIBFileName);
211      procedure SetDBParamByDPB(const Idx: Integer; Value: String);
212      procedure SetDBParams(Value: TStrings);
# Line 212 | Line 224 | type
224      procedure DoDisconnect; override;
225      function GetConnected: Boolean; override;
226      procedure CheckStreamConnect;
227 +    procedure HandleException(Sender: TObject);
228      procedure Notification( AComponent: TComponent; Operation: TOperation); override;
229      function GetDataset(Index : longint) : TDataset; override;
230      function GetDataSetCount : Longint; override;
231 +    procedure ReadState(Reader: TReader); override;
232      procedure SetConnected (Value : boolean); override;
233    public
234      constructor Create(AOwner: TComponent); override;
# Line 249 | Line 263 | type
263      property TransactionCount: Integer read GetTransactionCount;
264      property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
265      property InternalTransaction: TIBTransaction read FInternalTransaction;
266 +    property DefaultCharSetName: RawByteString read FDefaultCharSetName;
267 +    property DefaultCharSetID: integer read FDefaultCharSetID;
268 +    {$IFDEF HAS_ANSISTRING_CODEPAGE}
269 +    property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
270 +    {$ENDIF}
271  
272    published
273      property Connected;
# Line 261 | Line 280 | type
280                                                   write SetDefaultTransaction;
281      property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
282      property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
283 +    property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
284      property DBSQLDialect : Integer read FDBSQLDialect;
285      property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
286 +    property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
287 +                                               write FUseDefaultSystemCodePage;
288      property AfterConnect;
289      property AfterDisconnect;
290      property BeforeConnect;
# Line 278 | Line 300 | type
300  
301    TIBTransaction = class(TComponent)
302    private
303 +    FAfterDelete: TNotifyEvent;
304 +    FAfterEdit: TNotifyEvent;
305 +    FAfterExecQuery: TNotifyEvent;
306 +    FAfterInsert: TNotifyEvent;
307 +    FAfterPost: TNotifyEvent;
308 +    FAfterTransactionEnd: TNotifyEvent;
309 +    FBeforeTransactionEnd: TNotifyEvent;
310      FIBLoaded: Boolean;
311      FCanTimeout         : Boolean;
312      FDatabases          : TList;
313 +    FOnStartTransaction: TNotifyEvent;
314      FSQLObjects         : TList;
315      FDefaultDatabase    : TIBDatabase;
316      FHandle             : TISC_TR_HANDLE;
# Line 289 | Line 319 | type
319      FStreamedActive     : Boolean;
320      FTPB                : PChar;
321      FTPBLength          : Short;
322 <    FTimer              : TTimer;
322 >    FTimer              : TFPTimer;
323      FDefaultAction      : TTransactionAction;
324      FTRParams           : TStrings;
325      FTRParamsChanged    : Boolean;
326      FInEndTransaction   : boolean;
327 +    FEndAction          : TTransactionAction;
328 +    procedure DoBeforeTransactionEnd;
329 +    procedure DoAfterTransactionEnd;
330 +    procedure DoOnStartTransaction;
331 +    procedure DoAfterExecQuery(Sender: TObject);
332 +    procedure DoAfterEdit(Sender: TObject);
333 +    procedure DoAfterDelete(Sender: TObject);
334 +    procedure DoAfterInsert(Sender: TObject);
335 +    procedure DoAfterPost(Sender: TObject);
336      procedure EnsureNotInTransaction;
337      procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
338      function GetDatabase(Index: Integer): TIBDatabase;
# Line 335 | Line 374 | type
374      function AddDatabase(db: TIBDatabase): Integer;
375      function FindDatabase(db: TIBDatabase): Integer;
376      function FindDefaultDatabase: TIBDatabase;
377 +    function GetEndAction: TTransactionAction;
378      procedure RemoveDatabase(Idx: Integer);
379      procedure RemoveDatabases;
380      procedure CheckDatabasesInList;
# Line 356 | Line 396 | type
396      property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
397      property Params: TStrings read FTRParams write SetTRParams;
398      property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
399 <  end;
399 >    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
400 >                                             write FBeforeTransactionEnd;
401 >    property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
402 >                                            write FAfterTransactionEnd;
403 >    property OnStartTransaction: TNotifyEvent read FOnStartTransaction
404 >                                              write FOnStartTransaction;
405 >    property AfterExecQuery: TNotifyEvent read FAfterExecQuery
406 >                                              write FAfterExecQuery;
407 >    property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit;
408 >    property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
409 >    property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert;
410 >    property AfterPost: TNotifyEvent read FAfterPost write FAfterPost;
411 >  end;
412 >
413 >  TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object;
414 >  TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings;
415 >                              var DBName: string) of object;
416  
417    { TIBBase }
418  
# Line 365 | Line 421 | type
421      connections. }
422    TIBBase = class(TObject)
423    protected
424 +    FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent;
425      FDatabase: TIBDatabase;
426      FIndexInDatabase: Integer;
427      FTransaction: TIBTransaction;
# Line 374 | Line 431 | type
431      FAfterDatabaseDisconnect: TNotifyEvent;
432      FAfterDatabaseConnect: TNotifyEvent;
433      FOnDatabaseFree: TNotifyEvent;
434 <    FBeforeTransactionEnd: TNotifyEvent;
434 >    FBeforeTransactionEnd: TTransactionEndEvent;
435      FAfterTransactionEnd: TNotifyEvent;
436      FOnTransactionFree: TNotifyEvent;
437  
438 +    procedure DoBeforeDatabaseConnect(DBParams: TStrings;
439 +                              var DBName: string); virtual;
440      procedure DoAfterDatabaseConnect; virtual;
441      procedure DoBeforeDatabaseDisconnect; virtual;
442      procedure DoAfterDatabaseDisconnect; virtual;
443      procedure DoDatabaseFree; virtual;
444 <    procedure DoBeforeTransactionEnd; virtual;
444 >    procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
445      procedure DoAfterTransactionEnd; virtual;
446      procedure DoTransactionFree; virtual;
447      function GetDBHandle: PISC_DB_HANDLE; virtual;
# Line 394 | Line 453 | type
453      destructor Destroy; override;
454      procedure CheckDatabase; virtual;
455      procedure CheckTransaction; virtual;
456 +    procedure DoAfterExecQuery(Sender: TObject); virtual;
457 +    procedure DoAfterEdit(Sender: TObject); virtual;
458 +    procedure DoAfterDelete(Sender: TObject); virtual;
459 +    procedure DoAfterInsert(Sender: TObject); virtual;
460 +    procedure DoAfterPost(Sender: TObject); virtual;
461 +    function GetDefaultCharSetName: RawByteString;
462 +    function GetDefaultCharSetID: cardinal;
463 +    procedure HandleException(Sender: TObject);
464 +    procedure SetCursor;
465 +    procedure RestoreCursor;
466    public
467 +    property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect
468 +                                                 write FBeforeDatabaseConnect;
469      property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
470                                                  write FAfterDatabaseConnect;
471      property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
# Line 402 | Line 473 | type
473      property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
474                                                    write FAfterDatabaseDisconnect;
475      property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
476 <    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
476 >    property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
477      property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
478      property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
479      property Database: TIBDatabase read FDatabase
# Line 420 | Line 491 | procedure GenerateTPB(sl: TStrings; var
491  
492   implementation
493  
494 < uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, typInfo;
494 > uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
495 >     typInfo, IBCodePage;
496  
497   { TIBDatabase }
498  
499 < constructor TIBDatabase.Create(AOwner: TComponent);
499 > constructor TIBDataBase.Create(AOwner: TComponent);
500   begin
501    inherited Create(AOwner);
502    FIBLoaded := False;
# Line 435 | Line 507 | begin
507    FTransactions := TList.Create;
508    FDBName := '';
509    FDBParams := TStringList.Create;
510 +  FSQLHourGlass := true;
511 +  if (AOwner <> nil) and
512 +     (AOwner is TCustomApplication) and
513 +     TCustomApplication(AOWner).ConsoleApplication then
514 +    LoginPrompt := false;
515 +  {$IFDEF HAS_ANSISTRING_CODEPAGE}
516 +  FDefaultCodePage := CP_NONE;
517 +  {$ENDIF}
518    FDBParamsChanged := True;
519    TStringList(FDBParams).OnChange := DBParamsChange;
520    TStringList(FDBParams).OnChanging := DBParamsChanging;
# Line 443 | 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 454 | Line 534 | begin
534    CheckStreamConnect;
535   end;
536  
537 < destructor TIBDatabase.Destroy;
537 > destructor TIBDataBase.Destroy;
538   var
539    i: Integer;
540   begin
# Line 480 | 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 489 | 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 497 | 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 506 | 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
# Line 531 | 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 548 | 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 +  FDefaultCharSetName := '';
637 +  FDefaultCharSetID := 0;
638 +  {$IFDEF HAS_ANSISTRING_CODEPAGE}
639 +  FDefaultCodePage := CP_NONE;
640 +  {$ENDIF}
641   end;
642  
643 < procedure TIBDatabase.CreateDatabase;
643 > procedure TIBDataBase.CreateDatabase;
644   var
645    tr_handle: TISC_TR_HANDLE;
646   begin
# Line 568 | Line 653 | begin
653      True);
654   end;
655  
656 < procedure TIBDatabase.DropDatabase;
656 > procedure TIBDataBase.DropDatabase;
657   begin
658    CheckActive;
659    Call(isc_drop_database(StatusVector, @FHandle), True);
660   end;
661  
662 < procedure TIBDatabase.DBParamsChange(Sender: TObject);
662 > procedure TIBDataBase.DBParamsChange(Sender: TObject);
663   begin
664    FDBParamsChanged := True;
665   end;
666  
667 < procedure TIBDatabase.DBParamsChanging(Sender: TObject);
667 > procedure TIBDataBase.DBParamsChanging(Sender: TObject);
668   begin
669    EnsureInactive;
670    CheckInactive;
671   end;
672  
673 < function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer;
673 > function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer;
674   var
675    i: Integer;
676   begin
# Line 598 | Line 683 | begin
683      end;
684   end;
685  
686 < function TIBDatabase.FindDefaultTransaction(): TIBTransaction;
686 > function TIBDataBase.FindDefaultTransaction: TIBTransaction;
687   var
688    i: Integer;
689   begin
# Line 616 | Line 701 | begin
701    end;
702   end;
703  
704 < procedure TIBDatabase.ForceClose;
704 > procedure TIBDataBase.ForceClose;
705   begin
706    if Connected then
707      InternalClose(True);
708   end;
709  
710 < function TIBDatabase.GetConnected: Boolean;
710 > function TIBDataBase.GetConnected: Boolean;
711   begin
712    result := FHandle <> nil;
713   end;
714  
715 < function TIBDatabase.GetSQLObject(Index: Integer): TIBBase;
715 > function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
716   begin
717    result := FSQLObjects[Index];
718   end;
719  
720 < function TIBDatabase.GetSQLObjectCount: Integer;
720 > function TIBDataBase.GetSQLObjectCount: Integer;
721   var
722    i: Integer;
723   begin
# Line 641 | Line 726 | begin
726      Inc(result);
727   end;
728  
729 < function TIBDatabase.GetDBParamByDPB(const Idx: Integer): String;
729 > function TIBDataBase.GetDBParamByDPB( const Idx: Integer): String;
730   var
731    ConstIdx, EqualsIdx: Integer;
732   begin
# Line 664 | Line 749 | begin
749      result := '';
750   end;
751  
752 < function TIBDatabase.GetIdleTimer: Integer;
752 > function TIBDataBase.GetIdleTimer: Integer;
753   begin
754    result := FTimer.Interval;
755   end;
756  
757 < function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction;
757 > function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction;
758   begin
759    result := FTransactions[Index];
760   end;
761  
762 < function TIBDatabase.GetTransactionCount: Integer;
762 > function TIBDataBase.GetTransactionCount: Integer;
763   var
764    i: Integer;
765   begin
# Line 684 | Line 769 | begin
769        Inc(result);
770   end;
771  
772 < function TIBDatabase.IndexOfDBConst(st: String): Integer;
772 > function TIBDataBase.IndexOfDBConst(st: String): Integer;
773   var
774    i, pos_of_str: Integer;
775   begin
# Line 700 | Line 785 | begin
785    end;
786   end;
787  
788 < procedure TIBDatabase.InternalClose(Force: Boolean);
788 > procedure TIBDataBase.InternalClose(Force: Boolean);
789   var
790    i: Integer;
791   begin
# Line 773 | Line 858 | begin
858      end;
859    except
860      if csDesigning in ComponentState then
861 <      Application.HandleException(Self)
861 >      HandleException(Self)
862      else
863        raise;
864    end;
865   end;
866  
867 < procedure TIBDatabase.Notification( AComponent: TComponent;
868 <                                        Operation: TOperation);
867 > procedure TIBDataBase.HandleException(Sender: TObject);
868 > var aParent: TComponent;
869 > begin
870 >  aParent := Owner;
871 >  while aParent <> nil do
872 >  begin
873 >    if aParent is TCustomApplication then
874 >    begin
875 >      TCustomApplication(aParent).HandleException(Sender);
876 >      Exit;
877 >    end;
878 >    aParent := aParent.Owner;
879 >  end;
880 >  SysUtils.ShowException(ExceptObject,ExceptAddr);
881 > end;
882 >
883 > procedure TIBDataBase.Notification(AComponent: TComponent;
884 >   Operation: TOperation);
885   var
886    i: Integer;
887   begin
# Line 794 | Line 895 | begin
895    end;
896   end;
897  
898 < function TIBDatabase.Login: Boolean;
898 >  function TIBDataBase.Login(var aDatabaseName: string): Boolean;
899   var
900    IndexOfUser, IndexOfPassword: Integer;
901    Username, Password, OldPassword: String;
# Line 830 | Line 931 | begin
931        LoginParams.Assign(Params);
932        FOnLogin(Self, LoginParams);
933        Params.Assign (LoginParams);
934 +      aDatabaseName := FDBName;
935        HidePassword;
936      finally
937        LoginParams.Free;
938      end;
939    end
940    else
941 +  if assigned(IBGUIInterface) then
942    begin
943      IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]);
944      if IndexOfUser <> -1 then
# Line 850 | Line 953 | begin
953                                           Length(Params[IndexOfPassword]));
954        OldPassword := password;
955      end;
956 <    result := LoginDialogEx(DatabaseName, Username, Password, False);
956 >    result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
957      if result then
958      begin
959        if IndexOfUser = -1 then
# Line 867 | Line 970 | begin
970            HidePassword;
971        end;
972      end;
973 <  end;
973 >  end
974 >  else
975 >  if LoginPrompt then
976 >     IBError(ibxeNoLoginDialog,[]);
977    finally
978      FLoginCalled := false
979    end;
980   end;
981  
982 < procedure TIBDatabase.DoConnect;
982 > procedure TIBDataBase.DoConnect;
983   var
984    DPB: String;
985    TempDBParams: TStrings;
986    I: integer;
987 +  aDBName: string;
988  
989 +  {Call error analysis}
990 +  sqlcode: Long;
991 +  IBErrorCode: Long;
992 +  status_vector: PISC_STATUS;
993 +  CharSetID: integer;
994   begin
995    CheckInactive;
996    CheckDatabaseName;
# Line 888 | Line 1000 | begin
1000      FDBParamsChanged := True;
1001    end;
1002    { Use builtin login prompt if requested }
1003 <  if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
1003 >  aDBName := FDBName;
1004 >  if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
1005      IBError(ibxeOperationCancelled, [nil]);
1006 <  { Generate a new DPB if necessary }
1007 <  if (FDBParamsChanged) then
1008 <  begin
1009 <    FDBParamsChanged := False;
1010 <    if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
1011 <      GenerateDPB(FDBParams, DPB, FDPBLength)
1012 <    else
1006 >
1007 >  TempDBParams := TStringList.Create;
1008 >  try
1009 >   TempDBParams.Assign(FDBParams);
1010 >   if UseDefaultSystemCodePage then
1011 >   begin
1012 >     {$IFDEF HAS_ANSISTRING_CODEPAGE}
1013 >     {$ifdef WINDOWS}
1014 >     if TFirebirdCharacterSets.CodePage2CharSetID(GetACP,CharSetID) then
1015 >       TempDBParams.Values['lc_ctype'] := TFirebirdCharacterSets.GetCharsetName(CharSetID)
1016 >     else
1017 >     {$else}
1018 >     if TFirebirdCharacterSets.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
1019 >       TempDBParams.Values['lc_ctype'] := TFirebirdCharacterSets.GetCharsetName(CharSetID)
1020 >     else
1021 >     {$endif}
1022 >     {$ENDIF}
1023 >     TempDBParams.Values['lc_ctype'] :='UTF8';
1024 >   end;
1025 >   {Opportunity to override defaults}
1026 >   for i := 0 to FSQLObjects.Count - 1 do
1027 >   begin
1028 >       if FSQLObjects[i] <> nil then
1029 >         SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
1030 >   end;
1031 >   FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
1032 >   if FDefaultCharSetName <> '' then
1033 >     TFirebirdCharacterSets.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
1034 >   {$IFDEF HAS_ANSISTRING_CODEPAGE}
1035 >   TFirebirdCharacterSets.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
1036 >   {$ENDIF}
1037 >   { Generate a new DPB if necessary }
1038 >   if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
1039 >   begin
1040 >     FDBParamsChanged := False;
1041 >     if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
1042 >       GenerateDPB(TempDBParams, DPB, FDPBLength)
1043 >     else
1044 >     begin
1045 >        TempDBParams.Add('password=' + FHiddenPassword);
1046 >        GenerateDPB(TempDBParams, DPB, FDPBLength);
1047 >     end;
1048 >     IBAlloc(FDPB, 0, FDPBLength);
1049 >     Move(DPB[1], FDPB[0], FDPBLength);
1050 >   end;
1051 >  finally
1052 >   TempDBParams.Free;
1053 >  end;
1054 >  repeat
1055 >    if Call(isc_attach_database(StatusVector, Length(aDBName),
1056 >                         PChar(aDBName), @FHandle,
1057 >                         FDPBLength, FDPB), False) > 0 then
1058      begin
1059 <      TempDBParams := TStringList.Create;
1060 <      try
1061 <       TempDBParams.Assign(FDBParams);
1062 <       TempDBParams.Add('password=' + FHiddenPassword);
1063 <       GenerateDPB(TempDBParams, DPB, FDPBLength);
1064 <      finally
1065 <       TempDBParams.Free;
1059 >      {$IFDEF UNIX}
1060 >      if IsEmbeddedServer and (Pos(':',aDBName) = 0) then
1061 >      begin
1062 >        status_vector := StatusVector;
1063 >        IBErrorCode := StatusVectorArray[1];
1064 >        sqlcode := isc_sqlcode(StatusVector);
1065 >
1066 >        if ((sqlcode = -901) and (IBErrorCode = 335544382)) {Access permissions on firebird temp}
1067 >           or
1068 >           ((sqlcode = -902) and (IBErrorCode = 335544373)) {Security DB Problem}
1069 >           then
1070 >           begin
1071 >             aDBName := 'localhost:' + aDBName;
1072 >             Continue;
1073 >           end;
1074        end;
1075 +      {$ENDIF}
1076 +      FHandle := nil;
1077 +      IBDataBaseError;
1078      end;
1079 <    IBAlloc(FDPB, 0, FDPBLength);
1080 <    Move(DPB[1], FDPB[0], FDPBLength);
1081 <  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;
1079 >  until FHandle <> nil;
1080 >  if not (csDesigning in ComponentState) then
1081 >    FDBName := aDBName; {Synchronise at run time}
1082    FDBSQLDialect := GetDBSQLDialect;
1083    ValidateClientSQLDialect;
1084    for i := 0 to FSQLObjects.Count - 1 do
# Line 928 | Line 1090 | begin
1090      MonitorHook.DBConnect(Self);
1091   end;
1092  
1093 < procedure TIBDatabase.RemoveSQLObject(Idx: Integer);
1093 > procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
1094   var
1095    ds: TIBBase;
1096   begin
# Line 942 | Line 1104 | begin
1104    end;
1105   end;
1106  
1107 < procedure TIBDatabase.RemoveSQLObjects;
1107 > procedure TIBDataBase.RemoveSQLObjects;
1108   var
1109    i: Integer;
1110   begin
# Line 954 | Line 1116 | begin
1116    end;
1117   end;
1118  
1119 < procedure TIBDatabase.RemoveTransaction(Idx: Integer);
1119 > procedure TIBDataBase.RemoveTransaction(Idx: Integer);
1120   var
1121    TR: TIBTransaction;
1122   begin
# Line 968 | Line 1130 | begin
1130    end;
1131   end;
1132  
1133 < procedure TIBDatabase.RemoveTransactions;
1133 > procedure TIBDataBase.RemoveTransactions;
1134   var
1135    i: Integer;
1136   begin
# Line 976 | Line 1138 | begin
1138      RemoveTransaction(i);
1139   end;
1140  
1141 < procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName);
1141 > procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName);
1142   begin
1143    if FDBName <> Value then
1144    begin
# Line 986 | Line 1148 | begin
1148    end;
1149   end;
1150  
1151 < procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String);
1151 > procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String);
1152   var
1153    ConstIdx: Integer;
1154   begin
# Line 1005 | Line 1167 | begin
1167    end;
1168   end;
1169  
1170 < procedure TIBDatabase.SetDBParams(Value: TStrings);
1170 > procedure TIBDataBase.SetDBParams(Value: TStrings);
1171   begin
1172    FDBParams.Assign(Value);
1173   end;
1174  
1175 < procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction);
1175 > procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction);
1176   var
1177    i: Integer;
1178   begin
# Line 1028 | Line 1190 | begin
1190    FDefaultTransaction := Value;
1191   end;
1192  
1193 < procedure TIBDatabase.SetHandle(Value: TISC_DB_HANDLE);
1193 > procedure TIBDataBase.SetHandle(Value: TISC_DB_HANDLE);
1194   begin
1195    if HandleIsShared then
1196      Close
# Line 1038 | Line 1200 | begin
1200    FHandleIsShared := (Value <> nil);
1201   end;
1202  
1203 < procedure TIBDatabase.SetIdleTimer(Value: Integer);
1203 > procedure TIBDataBase.SetIdleTimer(Value: Integer);
1204   begin
1205    if Value < 0 then
1206      IBError(ibxeTimeoutNegative, [nil])
# Line 1057 | Line 1219 | begin
1219        end;
1220   end;
1221  
1222 < function TIBDatabase.TestConnected: Boolean;
1222 > function TIBDataBase.TestConnected: Boolean;
1223   var
1224    DatabaseInfo: TIBDatabaseInfo;
1225   begin
# Line 1078 | Line 1240 | begin
1240    end;
1241   end;
1242  
1243 < procedure TIBDatabase.TimeoutConnection(Sender: TObject);
1243 > procedure TIBDataBase.TimeoutConnection(Sender: TObject);
1244   begin
1245    if Connected then
1246    begin
# Line 1093 | Line 1255 | begin
1255    end;
1256   end;
1257  
1258 < function TIBDatabase.GetIsReadOnly: Boolean;
1258 > function TIBDataBase.GetIsReadOnly: Boolean;
1259   var
1260    DatabaseInfo: TIBDatabaseInfo;
1261   begin
# Line 1111 | Line 1273 | begin
1273    DatabaseInfo.Free;
1274   end;
1275  
1276 < function TIBDatabase.GetSQLDialect: Integer;
1276 > function TIBDataBase.GetSQLDialect: Integer;
1277   begin
1278    Result := FSQLDialect;
1279   end;
1280  
1281  
1282 < procedure TIBDatabase.SetSQLDialect(const Value: Integer);
1282 > procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1283   begin
1284    if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1285    if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
# Line 1126 | Line 1288 | begin
1288      IBError(ibxeSQLDialectInvalid, [nil]);
1289   end;
1290  
1291 < function TIBDatabase.GetDBSQLDialect: Integer;
1291 > function TIBDataBase.GetDBSQLDialect: Integer;
1292   var
1293    DatabaseInfo: TIBDatabaseInfo;
1294   begin
# Line 1136 | Line 1298 | begin
1298    DatabaseInfo.Free;
1299   end;
1300  
1301 < procedure TIBDatabase.ValidateClientSQLDialect;
1301 > procedure TIBDataBase.ValidateClientSQLDialect;
1302   begin
1303    if (FDBSQLDialect < FSQLDialect) then
1304    begin
# Line 1146 | Line 1308 | begin
1308    end;
1309   end;
1310  
1311 < procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet);
1311 > procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet);
1312   var
1313    I: Integer;
1314    DS: TIBCustomDataSet;
# Line 1172 | Line 1334 | begin
1334    TR.CommitRetaining;
1335   end;
1336  
1337 < procedure TIBDatabase.CloseDataSets;
1337 > procedure TIBDataBase.CloseDataSets;
1338   var
1339    i: Integer;
1340   begin
# Line 1181 | Line 1343 | begin
1343        DataSets[i].close;
1344   end;
1345  
1346 < function TIBDatabase.GetDataset(Index : longint) : TDataset;
1346 > function TIBDataBase.GetDataset(Index: longint): TDataset;
1347   begin
1348    if (Index >= 0) and (Index < FDataSets.Count) then
1349      Result := TDataSet(FDataSets[Index])
# Line 1189 | Line 1351 | begin
1351      raise Exception.Create('Invalid Index to DataSets');
1352   end;
1353  
1354 < function TIBDatabase.GetDataSetCount : Longint;
1354 > function TIBDataBase.GetDataSetCount: Longint;
1355   begin
1356    Result := FDataSets.Count;
1357   end;
1358  
1359 + procedure TIBDataBase.ReadState(Reader: TReader);
1360 + begin
1361 +  FDBParams.Clear;
1362 +  inherited ReadState(Reader);
1363 + end;
1364 +
1365   procedure TIBDataBase.SetConnected(Value: boolean);
1366   begin
1367    if StreamedConnected and not AllowStreamedConnected then
# Line 1204 | Line 1372 | begin
1372    inherited SetConnected(Value);
1373   end;
1374  
1375 < procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings);
1375 > procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings);
1376   var
1377    Query: TIBSQL;
1378   begin
# Line 1245 | Line 1413 | begin
1413    end;
1414   end;
1415  
1416 < procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean);
1416 > procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean);
1417   var
1418    Query : TIBSQL;
1419   begin
# Line 1304 | Line 1472 | begin
1472    FTRParamsChanged := True;
1473    TStringList(FTRParams).OnChange := TRParamsChange;
1474    TStringList(FTRParams).OnChanging := TRParamsChanging;
1475 <  FTimer := TTimer.Create(Self);
1475 >  FTimer := TFPTimer.Create(Self);
1476    FTimer.Enabled := False;
1477    FTimer.Interval := 0;
1478    FTimer.OnTimer := TimeoutTransaction;
# Line 1360 | Line 1528 | begin
1528      IBError(ibxeNotInTransaction, [nil]);
1529   end;
1530  
1531 + procedure TIBTransaction.DoBeforeTransactionEnd;
1532 + begin
1533 +  if Assigned(FBeforeTransactionEnd) then
1534 +    FBeforeTransactionEnd(self);
1535 + end;
1536 +
1537 + procedure TIBTransaction.DoAfterTransactionEnd;
1538 + begin
1539 +  if Assigned(FAfterTransactionEnd) then
1540 +    FAfterTransactionEnd(self);
1541 + end;
1542 +
1543 + procedure TIBTransaction.DoOnStartTransaction;
1544 + begin
1545 +  if assigned(FOnStartTransaction) then
1546 +    OnStartTransaction(self);
1547 + end;
1548 +
1549 + procedure TIBTransaction.DoAfterExecQuery(Sender: TObject);
1550 + begin
1551 +  if assigned(FAfterExecQuery) then
1552 +    AfterExecQuery(Sender);
1553 + end;
1554 +
1555 + procedure TIBTransaction.DoAfterEdit(Sender: TObject);
1556 + begin
1557 +  if assigned(FAfterEdit) then
1558 +    AfterEdit(Sender);
1559 + end;
1560 +
1561 + procedure TIBTransaction.DoAfterDelete(Sender: TObject);
1562 + begin
1563 +  if assigned(FAfterDelete) then
1564 +    AfterDelete(Sender);
1565 + end;
1566 +
1567 + procedure TIBTransaction.DoAfterInsert(Sender: TObject);
1568 + begin
1569 +  if assigned(FAfterInsert) then
1570 +    AfterInsert(Sender);
1571 + end;
1572 +
1573 + procedure TIBTransaction.DoAfterPost(Sender: TObject);
1574 + begin
1575 +  if assigned(FAfterPost) then
1576 +    AfterPost(Sender);
1577 + end;
1578 +
1579   procedure TIBTransaction.EnsureNotInTransaction;
1580   begin
1581    if csDesigning in ComponentState then
# Line 1436 | Line 1652 | begin
1652    CheckInTransaction;
1653    if FInEndTransaction then Exit;
1654    FInEndTransaction := true;
1655 +  FEndAction := Action;
1656    try
1657    case Action of
1658      TARollback, TACommit:
# Line 1444 | Line 1661 | begin
1661           (Action <> FDefaultAction) and
1662           (not Force) then
1663          IBError(ibxeCantEndSharedTransaction, [nil]);
1664 +      DoBeforeTransactionEnd;
1665        for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1666 <        SQLObjects[i].DoBeforeTransactionEnd;
1666 >        SQLObjects[i].DoBeforeTransactionEnd(Action);
1667        if InTransaction then
1668        begin
1669          if HandleIsShared then
# Line 1468 | Line 1686 | begin
1686              IBDataBaseError;
1687          for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1688            SQLObjects[i].DoAfterTransactionEnd;
1689 +        DoAfterTransactionEnd;
1690        end;
1691      end;
1692      TACommitRetaining:
# Line 1558 | Line 1777 | begin
1777    end;
1778   end;
1779  
1780 + function TIBTransaction.GetEndAction: TTransactionAction;
1781 + begin
1782 +  if FInEndTransaction then
1783 +     Result := FEndAction
1784 +  else
1785 +     IBError(ibxeIB60feature, [nil])
1786 + end;
1787 +
1788  
1789   function TIBTransaction.GetIdleTimer: Integer;
1790   begin
# Line 1663 | Line 1890 | begin
1890      for i := 0 to FSQLObjects.Count - 1 do
1891        if (FSQLObjects[i] <> nil) and
1892           (TIBBase(FSQLObjects[i]).Database = nil) then
1893 <        SetOrdProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Integer(Value));
1893 >         SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value);
1894    end;
1895    FDefaultDatabase := Value;
1896   end;
# Line 1769 | Line 1996 | begin
1996    finally
1997      FreeMem(pteb);
1998    end;
1999 +  DoOnStartTransaction;
2000   end;
2001  
2002   procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
# Line 1810 | Line 2038 | begin
2038    inherited Destroy;
2039   end;
2040  
2041 + function TIBBase.GetDefaultCharSetName: RawByteString;
2042 + begin
2043 +  Result := Database.FDefaultCharSetName;
2044 + end;
2045 +
2046 + function TIBBase.GetDefaultCharSetID: cardinal;
2047 + begin
2048 +  Result := Database.DefaultCharSetID;
2049 + end;
2050 +
2051 + procedure TIBBase.HandleException(Sender: TObject);
2052 + begin
2053 +  if assigned(Database) then
2054 +     Database.HandleException(Sender)
2055 +  else
2056 +     SysUtils.ShowException(ExceptObject,ExceptAddr);
2057 + end;
2058 +
2059 + procedure TIBBase.SetCursor;
2060 + begin
2061 +  if Assigned(Database) and not Database.SQLHourGlass then
2062 +     Exit;
2063 +  if assigned(IBGUIInterface) then
2064 +     IBGUIInterface.SetCursor;
2065 + end;
2066 +
2067 + procedure TIBBase.RestoreCursor;
2068 + begin
2069 +  if Assigned(Database) and not Database.SQLHourGlass then
2070 +     Exit;
2071 +  if assigned(IBGUIInterface) then
2072 +     IBGUIInterface.RestoreCursor;
2073 + end;
2074 +
2075   procedure TIBBase.CheckDatabase;
2076   begin
2077    if (FDatabase = nil) then
# Line 1836 | Line 2098 | begin
2098    result := @FTransaction.Handle;
2099   end;
2100  
2101 + procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
2102 +  );
2103 + begin
2104 +  if assigned(FBeforeDatabaseConnect) then
2105 +    BeforeDatabaseConnect(self,DBParams,DBName);
2106 + end;
2107 +
2108   procedure TIBBase.DoAfterDatabaseConnect;
2109   begin
2110    if assigned(FAfterDatabaseConnect) then
# Line 1862 | Line 2131 | begin
2131    SetTransaction(nil);
2132   end;
2133  
2134 < procedure TIBBase.DoBeforeTransactionEnd;
2134 > procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction);
2135   begin
2136    if Assigned(BeforeTransactionEnd) then
2137 <    BeforeTransactionEnd(Self);
2137 >    BeforeTransactionEnd(Self,Action);
2138   end;
2139  
2140   procedure TIBBase.DoAfterTransactionEnd;
# Line 1881 | Line 2150 | begin
2150    FTransaction := nil;
2151   end;
2152  
2153 + procedure TIBBase.DoAfterExecQuery(Sender: TObject);
2154 + begin
2155 +  if FTransaction <> nil then
2156 +    FTransaction.DoAfterExecQuery(Sender);
2157 + end;
2158 +
2159 + procedure TIBBase.DoAfterEdit(Sender: TObject);
2160 + begin
2161 +  if FTransaction <> nil then
2162 +    FTransaction.DoAfterEdit(Sender);
2163 + end;
2164 +
2165 + procedure TIBBase.DoAfterDelete(Sender: TObject);
2166 + begin
2167 +  if FTransaction <> nil then
2168 +    FTransaction.DoAfterDelete(Sender);
2169 + end;
2170 +
2171 + procedure TIBBase.DoAfterInsert(Sender: TObject);
2172 + begin
2173 +  if FTransaction <> nil then
2174 +    FTransaction.DoAfterInsert(Sender);
2175 + end;
2176 +
2177 + procedure TIBBase.DoAfterPost(Sender: TObject);
2178 + begin
2179 +  if FTransaction <> nil then
2180 +    FTransaction.DoAfterPost(Sender);
2181 + end;
2182 +
2183   procedure TIBBase.SetDatabase(Value: TIBDatabase);
2184   begin
2185    if (FDatabase <> nil) then

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines