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; |
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; |
155 |
|
{ TIBDatabase } |
156 |
|
TIBDataBase = class(TCustomConnection) |
157 |
|
private |
158 |
+ |
FAllowStreamedConnected: boolean; |
159 |
|
FHiddenPassword: string; |
160 |
|
FIBLoaded: Boolean; |
161 |
|
FOnLogin: TIBDatabaseLoginEvent; |
180 |
|
FTimer: TTimer; |
181 |
|
FUserNames: TStringList; |
182 |
|
FDataSets: TList; |
183 |
+ |
FLoginCalled: boolean; |
184 |
|
procedure EnsureInactive; |
185 |
|
function GetDBSQLDialect: Integer; |
186 |
|
function GetSQLDialect: Integer; |
211 |
|
procedure DoConnect; override; |
212 |
|
procedure DoDisconnect; override; |
213 |
|
function GetConnected: Boolean; override; |
214 |
< |
procedure Loaded; override; |
214 |
> |
procedure CheckStreamConnect; |
215 |
|
procedure Notification( AComponent: TComponent; Operation: TOperation); override; |
216 |
|
function GetDataset(Index : longint) : TDataset; override; |
217 |
|
function GetDataSetCount : Longint; override; |
218 |
< |
|
218 |
> |
procedure SetConnected (Value : boolean); override; |
219 |
|
public |
220 |
|
constructor Create(AOwner: TComponent); override; |
221 |
|
destructor Destroy; override; |
252 |
|
|
253 |
|
published |
254 |
|
property Connected; |
255 |
< |
property StreamedConnected; |
255 |
> |
property AllowStreamedConnected: boolean read FAllowStreamedConnected |
256 |
> |
write FAllowStreamedConnected; |
257 |
|
property DatabaseName: TIBFileName read FDBName write SetDatabaseName; |
258 |
|
property Params: TStrings read FDBParams write SetDBParams; |
259 |
|
property LoginPrompt default True; |
293 |
|
FDefaultAction : TTransactionAction; |
294 |
|
FTRParams : TStrings; |
295 |
|
FTRParamsChanged : Boolean; |
296 |
+ |
FInEndTransaction : boolean; |
297 |
|
procedure EnsureNotInTransaction; |
298 |
|
procedure EndTransaction(Action: TTransactionAction; Force: Boolean); |
299 |
|
function GetDatabase(Index: Integer): TIBDatabase; |
372 |
|
FOwner: TObject; |
373 |
|
FBeforeDatabaseDisconnect: TNotifyEvent; |
374 |
|
FAfterDatabaseDisconnect: TNotifyEvent; |
375 |
+ |
FAfterDatabaseConnect: TNotifyEvent; |
376 |
|
FOnDatabaseFree: TNotifyEvent; |
377 |
|
FBeforeTransactionEnd: TNotifyEvent; |
378 |
|
FAfterTransactionEnd: TNotifyEvent; |
379 |
|
FOnTransactionFree: TNotifyEvent; |
380 |
|
|
381 |
+ |
procedure DoAfterDatabaseConnect; virtual; |
382 |
|
procedure DoBeforeDatabaseDisconnect; virtual; |
383 |
|
procedure DoAfterDatabaseDisconnect; virtual; |
384 |
|
procedure DoDatabaseFree; virtual; |
395 |
|
procedure CheckDatabase; virtual; |
396 |
|
procedure CheckTransaction; virtual; |
397 |
|
public |
398 |
+ |
property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect |
399 |
+ |
write FAfterDatabaseConnect; |
400 |
|
property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect |
401 |
|
write FBeforeDatabaseDisconnect; |
402 |
|
property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect |
420 |
|
|
421 |
|
implementation |
422 |
|
|
423 |
< |
uses IBIntf,{$IFDEF HAS_SQLMONITOR}IBSQLMonitor,{$ENDIF} IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, typInfo; |
423 |
> |
uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, typInfo; |
424 |
|
|
425 |
|
{ TIBDatabase } |
426 |
|
|
451 |
|
FSQLDialect := 3; |
452 |
|
FTraceFlags := []; |
453 |
|
FDataSets := TList.Create; |
454 |
+ |
CheckStreamConnect; |
455 |
|
end; |
456 |
|
|
457 |
|
destructor TIBDatabase.Destroy; |
522 |
|
begin |
523 |
|
result := 0; |
524 |
|
if (ds.Owner is TIBCustomDataSet) then |
525 |
< |
{$IFDEF LINUX} |
513 |
< |
FDataSets.Add(TDataSet(ds.Owner)); |
514 |
< |
{$ELSE} |
515 |
< |
RegisterClient(TDataSet(ds.Owner)); |
516 |
< |
{$ENDIF} |
525 |
> |
FDataSets.Add(ds.Owner); |
526 |
|
while (result < FSQLObjects.Count) and (FSQLObjects[result] <> nil) do |
527 |
|
Inc(result); |
528 |
|
if (result = FSQLObjects.Count) then |
739 |
|
FHandleIsShared := False; |
740 |
|
end; |
741 |
|
|
733 |
– |
{$IFDEF HAS_SQLMONITOR} |
742 |
|
if not (csDesigning in ComponentState) then |
743 |
|
MonitorHook.DBDisconnect(Self); |
736 |
– |
{$ENDIF} |
744 |
|
|
745 |
|
for i := 0 to FSQLObjects.Count - 1 do |
746 |
|
if FSQLObjects[i] <> nil then |
747 |
|
SQLObjects[i].DoAfterDatabaseDisconnect; |
748 |
|
end; |
749 |
|
|
750 |
< |
procedure TIBDatabase.Loaded; |
750 |
> |
procedure TIBDataBase.CheckStreamConnect; |
751 |
|
var |
752 |
|
i: integer; |
753 |
|
begin |
754 |
|
try |
755 |
< |
if StreamedConnected and (not Connected) then |
755 |
> |
if not (csDesigning in ComponentState) and StreamedConnected and (not Connected) then |
756 |
|
begin |
750 |
– |
inherited Loaded; |
757 |
|
for i := 0 to FTransactions.Count - 1 do |
758 |
|
if FTransactions[i] <> nil then |
759 |
|
begin |
818 |
|
end; |
819 |
|
|
820 |
|
begin |
821 |
< |
if Assigned(FOnLogin) then |
821 |
> |
Result := false; |
822 |
> |
if FLoginCalled then Exit; |
823 |
> |
FLoginCalled := true; |
824 |
> |
try |
825 |
> |
if Assigned(FOnLogin) and not (csDesigning in ComponentState) then |
826 |
|
begin |
827 |
|
result := True; |
828 |
|
LoginParams := TStringList.Create; |
868 |
|
end; |
869 |
|
end; |
870 |
|
end; |
871 |
+ |
finally |
872 |
+ |
FLoginCalled := false |
873 |
+ |
end; |
874 |
|
end; |
875 |
|
|
876 |
|
procedure TIBDatabase.DoConnect; |
877 |
|
var |
878 |
|
DPB: String; |
879 |
|
TempDBParams: TStrings; |
880 |
+ |
I: integer; |
881 |
|
|
882 |
|
begin |
883 |
|
CheckInactive; |
888 |
|
FDBParamsChanged := True; |
889 |
|
end; |
890 |
|
{ Use builtin login prompt if requested } |
891 |
< |
if LoginPrompt and not Login then |
891 |
> |
if (LoginPrompt or (csDesigning in ComponentState)) and not Login then |
892 |
|
IBError(ibxeOperationCancelled, [nil]); |
893 |
|
{ Generate a new DPB if necessary } |
894 |
|
if (FDBParamsChanged) then |
895 |
|
begin |
896 |
|
FDBParamsChanged := False; |
897 |
< |
if (not LoginPrompt) or (FHiddenPassword = '') then |
897 |
> |
if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then |
898 |
|
GenerateDPB(FDBParams, DPB, FDPBLength) |
899 |
|
else |
900 |
|
begin |
919 |
|
end; |
920 |
|
FDBSQLDialect := GetDBSQLDialect; |
921 |
|
ValidateClientSQLDialect; |
922 |
< |
{$IFDEF HAS_SQLMONITOR} |
922 |
> |
for i := 0 to FSQLObjects.Count - 1 do |
923 |
> |
begin |
924 |
> |
if FSQLObjects[i] <> nil then |
925 |
> |
SQLObjects[i].DoAfterDatabaseConnect; |
926 |
> |
end; |
927 |
|
if not (csDesigning in ComponentState) then |
928 |
|
MonitorHook.DBConnect(Self); |
911 |
– |
{$ENDIF} |
929 |
|
end; |
930 |
|
|
931 |
|
procedure TIBDatabase.RemoveSQLObject(Idx: Integer); |
938 |
|
FSQLObjects[Idx] := nil; |
939 |
|
ds.Database := nil; |
940 |
|
if (ds.owner is TDataSet) then |
924 |
– |
{$IFDEF LINUX} |
941 |
|
FDataSets.Remove(TDataSet(ds.Owner)); |
926 |
– |
{$ELSE} |
927 |
– |
UnregisterClient(TDataSet(ds.Owner)); |
928 |
– |
{$ENDIF} |
942 |
|
end; |
943 |
|
end; |
944 |
|
|
950 |
|
begin |
951 |
|
RemoveSQLObject(i); |
952 |
|
if (TIBBase(FSQLObjects[i]).owner is TDataSet) then |
940 |
– |
{$IFDEF LINUX} |
953 |
|
FDataSets.Remove(TDataSet(TIBBase(FSQLObjects[i]).owner)); |
942 |
– |
{$ELSE} |
943 |
– |
UnregisterClient(TDataSet(TIBBase(FSQLObjects[i]).owner)); |
944 |
– |
{$ENDIF} |
954 |
|
end; |
955 |
|
end; |
956 |
|
|
1116 |
|
Result := FSQLDialect; |
1117 |
|
end; |
1118 |
|
|
1119 |
+ |
|
1120 |
|
procedure TIBDatabase.SetSQLDialect(const Value: Integer); |
1121 |
|
begin |
1122 |
|
if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]); |
1194 |
|
Result := FDataSets.Count; |
1195 |
|
end; |
1196 |
|
|
1197 |
+ |
procedure TIBDataBase.SetConnected(Value: boolean); |
1198 |
+ |
begin |
1199 |
+ |
if StreamedConnected and not AllowStreamedConnected then |
1200 |
+ |
begin |
1201 |
+ |
StreamedConnected := false; |
1202 |
+ |
Value := false |
1203 |
+ |
end; |
1204 |
+ |
inherited SetConnected(Value); |
1205 |
+ |
end; |
1206 |
+ |
|
1207 |
|
procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings); |
1208 |
|
var |
1209 |
|
Query: TIBSQL; |
1434 |
|
i: Integer; |
1435 |
|
begin |
1436 |
|
CheckInTransaction; |
1437 |
+ |
if FInEndTransaction then Exit; |
1438 |
+ |
FInEndTransaction := true; |
1439 |
+ |
try |
1440 |
|
case Action of |
1441 |
|
TARollback, TACommit: |
1442 |
|
begin |
1475 |
|
TARollbackRetaining: |
1476 |
|
Call(isc_rollback_retaining(StatusVector, @FHandle), True); |
1477 |
|
end; |
1455 |
– |
{$IFDEF HAS_SQLMONITOR} |
1478 |
|
if not (csDesigning in ComponentState) then |
1479 |
|
begin |
1480 |
|
case Action of |
1488 |
|
MonitorHook.TRRollbackRetaining(Self); |
1489 |
|
end; |
1490 |
|
end; |
1491 |
< |
{$ENDIF} |
1491 |
> |
finally |
1492 |
> |
FInEndTransaction := false |
1493 |
> |
end; |
1494 |
|
end; |
1495 |
|
|
1496 |
|
function TIBTransaction.GetDatabase(Index: Integer): TIBDatabase; |
1764 |
|
FHandle := nil; |
1765 |
|
IBDataBaseError; |
1766 |
|
end; |
1743 |
– |
{$IFDEF HAS_SQLMONITOR} |
1767 |
|
if not (csDesigning in ComponentState) then |
1768 |
|
MonitorHook.TRStart(Self); |
1746 |
– |
{$ENDIF} |
1769 |
|
finally |
1770 |
|
FreeMem(pteb); |
1771 |
|
end; |
1836 |
|
result := @FTransaction.Handle; |
1837 |
|
end; |
1838 |
|
|
1839 |
+ |
procedure TIBBase.DoAfterDatabaseConnect; |
1840 |
+ |
begin |
1841 |
+ |
if assigned(FAfterDatabaseConnect) then |
1842 |
+ |
AfterDatabaseConnect(self); |
1843 |
+ |
end; |
1844 |
+ |
|
1845 |
|
procedure TIBBase.DoBeforeDatabaseDisconnect; |
1846 |
|
begin |
1847 |
|
if Assigned(BeforeDatabaseDisconnect) then |