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_'; |
178 |
|
FDefaultTransaction: TIBTransaction; |
179 |
|
FInternalTransaction: TIBTransaction; |
180 |
|
FStreamedConnected: Boolean; |
181 |
< |
FTimer: TTimer; |
181 |
> |
FTimer: TFPTimer; |
182 |
|
FUserNames: TStringList; |
183 |
|
FDataSets: TList; |
184 |
|
FLoginCalled: boolean; |
215 |
|
procedure DoDisconnect; override; |
216 |
|
function GetConnected: Boolean; override; |
217 |
|
procedure CheckStreamConnect; |
218 |
+ |
procedure HandleException(Sender: TObject); |
219 |
|
procedure Notification( AComponent: TComponent; Operation: TOperation); override; |
220 |
|
function GetDataset(Index : longint) : TDataset; override; |
221 |
|
function GetDataSetCount : Longint; override; |
303 |
|
FStreamedActive : Boolean; |
304 |
|
FTPB : PChar; |
305 |
|
FTPBLength : Short; |
306 |
< |
FTimer : TTimer; |
306 |
> |
FTimer : TFPTimer; |
307 |
|
FDefaultAction : TTransactionAction; |
308 |
|
FTRParams : TStrings; |
309 |
|
FTRParamsChanged : Boolean; |
395 |
|
end; |
396 |
|
|
397 |
|
TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object; |
398 |
+ |
TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings; |
399 |
+ |
var DBName: string) of object; |
400 |
|
|
401 |
|
{ TIBBase } |
402 |
|
|
405 |
|
connections. } |
406 |
|
TIBBase = class(TObject) |
407 |
|
protected |
408 |
+ |
FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent; |
409 |
|
FDatabase: TIBDatabase; |
410 |
|
FIndexInDatabase: Integer; |
411 |
|
FTransaction: TIBTransaction; |
419 |
|
FAfterTransactionEnd: TNotifyEvent; |
420 |
|
FOnTransactionFree: TNotifyEvent; |
421 |
|
|
422 |
+ |
procedure DoBeforeDatabaseConnect(DBParams: TStrings; |
423 |
+ |
var DBName: string); virtual; |
424 |
|
procedure DoAfterDatabaseConnect; virtual; |
425 |
|
procedure DoBeforeDatabaseDisconnect; virtual; |
426 |
|
procedure DoAfterDatabaseDisconnect; virtual; |
443 |
|
procedure DoAfterInsert(Sender: TObject); virtual; |
444 |
|
procedure DoAfterPost(Sender: TObject); virtual; |
445 |
|
function GetCharSetSize(CharSetID: integer): integer; |
446 |
+ |
procedure HandleException(Sender: TObject); |
447 |
+ |
procedure SetCursor; |
448 |
+ |
procedure RestoreCursor; |
449 |
|
public |
450 |
+ |
property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect |
451 |
+ |
write FBeforeDatabaseConnect; |
452 |
|
property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect |
453 |
|
write FAfterDatabaseConnect; |
454 |
|
property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect |
494 |
|
FDBName := ''; |
495 |
|
FDBParams := TStringList.Create; |
496 |
|
FSQLHourGlass := true; |
497 |
+ |
if (AOwner <> nil) and |
498 |
+ |
(AOwner is TCustomApplication) and |
499 |
+ |
TCustomApplication(AOWner).ConsoleApplication then |
500 |
+ |
LoginPrompt := false; |
501 |
|
{$ifdef UNIX} |
502 |
|
if csDesigning in ComponentState then |
503 |
|
FDBParams.Add('lc_ctype=UTF-8'); |
519 |
|
FUserNames := nil; |
520 |
|
FInternalTransaction := TIBTransaction.Create(self); |
521 |
|
FInternalTransaction.DefaultDatabase := Self; |
522 |
< |
FTimer := TTimer.Create(Self); |
522 |
> |
FTimer := TFPTimer.Create(Self); |
523 |
|
FTimer.Enabled := False; |
524 |
|
FTimer.Interval := 0; |
525 |
|
FTimer.OnTimer := TimeoutConnection; |
880 |
|
end; |
881 |
|
except |
882 |
|
if csDesigning in ComponentState then |
883 |
< |
Application.HandleException(Self) |
883 |
> |
HandleException(Self) |
884 |
|
else |
885 |
|
raise; |
886 |
|
end; |
887 |
|
end; |
888 |
|
|
889 |
+ |
procedure TIBDataBase.HandleException(Sender: TObject); |
890 |
+ |
var aParent: TComponent; |
891 |
+ |
begin |
892 |
+ |
aParent := Owner; |
893 |
+ |
while aParent <> nil do |
894 |
+ |
begin |
895 |
+ |
if aParent is TCustomApplication then |
896 |
+ |
begin |
897 |
+ |
TCustomApplication(aParent).HandleException(Sender); |
898 |
+ |
Exit; |
899 |
+ |
end; |
900 |
+ |
aParent := aParent.Owner; |
901 |
+ |
end; |
902 |
+ |
SysUtils.ShowException(ExceptObject,ExceptAddr); |
903 |
+ |
end; |
904 |
+ |
|
905 |
|
procedure TIBDataBase.Notification(AComponent: TComponent; |
906 |
|
Operation: TOperation); |
907 |
|
var |
959 |
|
end; |
960 |
|
end |
961 |
|
else |
962 |
+ |
if assigned(IBGUIInterface) then |
963 |
|
begin |
964 |
|
IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]); |
965 |
|
if IndexOfUser <> -1 then |
974 |
|
Length(Params[IndexOfPassword])); |
975 |
|
OldPassword := password; |
976 |
|
end; |
977 |
< |
result := LoginDialogEx(DatabaseName, Username, Password, False); |
977 |
> |
result := IBGUIInterface.LoginDialogEx(DatabaseName, Username, Password, False); |
978 |
|
if result then |
979 |
|
begin |
980 |
|
if IndexOfUser = -1 then |
991 |
|
HidePassword; |
992 |
|
end; |
993 |
|
end; |
994 |
< |
end; |
994 |
> |
end |
995 |
> |
else |
996 |
> |
if LoginPrompt then |
997 |
> |
IBError(ibxeNoLoginDialog,[]); |
998 |
|
finally |
999 |
|
FLoginCalled := false |
1000 |
|
end; |
1005 |
|
DPB: String; |
1006 |
|
TempDBParams: TStrings; |
1007 |
|
I: integer; |
1008 |
< |
|
1008 |
> |
aDBName: string; |
1009 |
|
begin |
1010 |
|
CheckInactive; |
1011 |
|
CheckDatabaseName; |
1017 |
|
{ Use builtin login prompt if requested } |
1018 |
|
if (LoginPrompt or (csDesigning in ComponentState)) and not Login then |
1019 |
|
IBError(ibxeOperationCancelled, [nil]); |
1020 |
< |
{ Generate a new DPB if necessary } |
1021 |
< |
if (FDBParamsChanged) then |
1022 |
< |
begin |
1023 |
< |
FDBParamsChanged := False; |
1024 |
< |
if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then |
1025 |
< |
GenerateDPB(FDBParams, DPB, FDPBLength) |
1026 |
< |
else |
1027 |
< |
begin |
1028 |
< |
TempDBParams := TStringList.Create; |
1029 |
< |
try |
1030 |
< |
TempDBParams.Assign(FDBParams); |
1031 |
< |
TempDBParams.Add('password=' + FHiddenPassword); |
1032 |
< |
GenerateDPB(TempDBParams, DPB, FDPBLength); |
1033 |
< |
finally |
1034 |
< |
TempDBParams.Free; |
1035 |
< |
end; |
1036 |
< |
end; |
1037 |
< |
IBAlloc(FDPB, 0, FDPBLength); |
1038 |
< |
Move(DPB[1], FDPB[0], FDPBLength); |
1020 |
> |
|
1021 |
> |
TempDBParams := TStringList.Create; |
1022 |
> |
try |
1023 |
> |
TempDBParams.Assign(FDBParams); |
1024 |
> |
aDBName := FDBName; |
1025 |
> |
{Opportuning 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 |
> |
|
1032 |
> |
{ Generate a new DPB if necessary } |
1033 |
> |
if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then |
1034 |
> |
begin |
1035 |
> |
FDBParamsChanged := False; |
1036 |
> |
if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then |
1037 |
> |
GenerateDPB(TempDBParams, DPB, FDPBLength) |
1038 |
> |
else |
1039 |
> |
begin |
1040 |
> |
TempDBParams.Add('password=' + FHiddenPassword); |
1041 |
> |
GenerateDPB(TempDBParams, DPB, FDPBLength); |
1042 |
> |
end; |
1043 |
> |
IBAlloc(FDPB, 0, FDPBLength); |
1044 |
> |
Move(DPB[1], FDPB[0], FDPBLength); |
1045 |
> |
end; |
1046 |
> |
finally |
1047 |
> |
TempDBParams.Free; |
1048 |
|
end; |
1049 |
< |
if Call(isc_attach_database(StatusVector, Length(FDBName), |
1050 |
< |
PChar(FDBName), @FHandle, |
1049 |
> |
if Call(isc_attach_database(StatusVector, Length(aDBName), |
1050 |
> |
PChar(aDBName), @FHandle, |
1051 |
|
FDPBLength, FDPB), False) > 0 then |
1052 |
|
begin |
1053 |
|
FHandle := nil; |
1054 |
|
IBDataBaseError; |
1055 |
|
end; |
1056 |
+ |
if not (csDesigning in ComponentState) then |
1057 |
+ |
FDBName := aDBName; {Synchronise at run time} |
1058 |
|
FDBSQLDialect := GetDBSQLDialect; |
1059 |
|
ValidateClientSQLDialect; |
1060 |
|
for i := 0 to FSQLObjects.Count - 1 do |
1449 |
|
FTRParamsChanged := True; |
1450 |
|
TStringList(FTRParams).OnChange := TRParamsChange; |
1451 |
|
TStringList(FTRParams).OnChanging := TRParamsChanging; |
1452 |
< |
FTimer := TTimer.Create(Self); |
1452 |
> |
FTimer := TFPTimer.Create(Self); |
1453 |
|
FTimer.Enabled := False; |
1454 |
|
FTimer.Interval := 0; |
1455 |
|
FTimer.OnTimer := TimeoutTransaction; |
2023 |
|
Result := 1; {Unknown character set} |
2024 |
|
end; |
2025 |
|
|
2026 |
+ |
procedure TIBBase.HandleException(Sender: TObject); |
2027 |
+ |
begin |
2028 |
+ |
if assigned(Database) then |
2029 |
+ |
Database.HandleException(Sender) |
2030 |
+ |
else |
2031 |
+ |
SysUtils.ShowException(ExceptObject,ExceptAddr); |
2032 |
+ |
end; |
2033 |
+ |
|
2034 |
+ |
procedure TIBBase.SetCursor; |
2035 |
+ |
begin |
2036 |
+ |
if Assigned(Database) and not Database.SQLHourGlass then |
2037 |
+ |
Exit; |
2038 |
+ |
if assigned(IBGUIInterface) then |
2039 |
+ |
IBGUIInterface.SetCursor; |
2040 |
+ |
end; |
2041 |
+ |
|
2042 |
+ |
procedure TIBBase.RestoreCursor; |
2043 |
+ |
begin |
2044 |
+ |
if Assigned(Database) and not Database.SQLHourGlass then |
2045 |
+ |
Exit; |
2046 |
+ |
if assigned(IBGUIInterface) then |
2047 |
+ |
IBGUIInterface.RestoreCursor; |
2048 |
+ |
end; |
2049 |
+ |
|
2050 |
|
procedure TIBBase.CheckDatabase; |
2051 |
|
begin |
2052 |
|
if (FDatabase = nil) then |
2073 |
|
result := @FTransaction.Handle; |
2074 |
|
end; |
2075 |
|
|
2076 |
+ |
procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string |
2077 |
+ |
); |
2078 |
+ |
begin |
2079 |
+ |
if assigned(FBeforeDatabaseConnect) then |
2080 |
+ |
BeforeDatabaseConnect(self,DBParams,DBName); |
2081 |
+ |
end; |
2082 |
+ |
|
2083 |
|
procedure TIBBase.DoAfterDatabaseConnect; |
2084 |
|
begin |
2085 |
|
if assigned(FAfterDatabaseConnect) then |