25 |
|
* |
26 |
|
*) |
27 |
|
unit FBActivityMonitor; |
28 |
+ |
{$IFDEF MSWINDOWS} |
29 |
+ |
{$DEFINE WINDOWS} |
30 |
+ |
{$ENDIF} |
31 |
|
|
32 |
|
{$IFDEF FPC} |
33 |
< |
{$mode objfpc}{$H+} |
33 |
> |
{$mode delphi} |
34 |
|
{$interfaces COM} |
35 |
|
{$ENDIF} |
36 |
|
|
37 |
|
interface |
38 |
|
|
39 |
|
uses |
40 |
< |
Classes, SysUtils, IBExternals; |
40 |
> |
Classes, SysUtils, IBExternals, IB; |
41 |
|
|
42 |
|
{ $DEFINE DEBUGINTERFACES} {Define this to check that all interfaces are |
43 |
|
being destroyed.} |
50 |
|
|
51 |
|
{$IFDEF DEBUGINTERFACES} |
52 |
|
TMonitoredObject = class(TInterfacedObject) |
50 |
– |
private |
51 |
– |
FObjectCount: integer; static; |
53 |
|
public |
54 |
|
constructor Create; |
55 |
|
destructor Destroy; override; |
107 |
|
interface, implemented through the helper object TTransactionMonitor. |
108 |
|
} |
109 |
|
|
110 |
+ |
TOnDatabaseError = procedure of object; |
111 |
+ |
|
112 |
|
TActivityReporter = class(TInterfaceOwner) |
113 |
|
private |
114 |
|
FHasActivity: boolean; |
115 |
|
FMonitors: array of IActivityMonitor; |
116 |
+ |
FOnDatabaseError: TOnDatabaseError; |
117 |
|
function FindMonitor(aMonitor: IActivityMonitor): integer; |
118 |
|
protected |
119 |
|
function Call(ErrCode: ISC_STATUS; RaiseError: Boolean = true): ISC_STATUS; |
124 |
|
destructor Destroy; override; |
125 |
|
function HasActivity: boolean; |
126 |
|
procedure SignalActivity; |
127 |
+ |
property OnDatabaseError: TOnDatabaseError read FOnDatabaseError write FOnDatabaseError; |
128 |
|
end; |
129 |
|
|
130 |
|
{ TActivityHandler is a base class for classes that receive activity reports.} |
139 |
|
|
140 |
|
implementation |
141 |
|
|
142 |
< |
uses FB25ClientAPI; |
142 |
> |
uses FBClientAPI; |
143 |
|
|
144 |
|
{ TActivityHandler } |
145 |
|
|
157 |
|
{ TMonitoredObject } |
158 |
|
|
159 |
|
{$IFDEF DEBUGINTERFACES} |
160 |
+ |
var |
161 |
+ |
FObjectCount: integer; |
162 |
+ |
|
163 |
|
constructor TMonitoredObject.Create; |
164 |
|
begin |
165 |
|
inherited Create; |
193 |
|
begin |
194 |
|
result := ErrCode; |
195 |
|
SignalActivity; |
196 |
< |
if RaiseError and (ErrCode > 0) then |
197 |
< |
Firebird25ClientAPI.IBDataBaseError; |
196 |
> |
if RaiseError and (ErrCode > 0) and assigned(FOnDatabaseError) then |
197 |
> |
OnDatabaseError; |
198 |
|
end; |
199 |
|
|
200 |
|
procedure TActivityReporter.AddMonitor(aMonitor: IActivityMonitor); |
312 |
|
|
313 |
|
function TInterfaceOwner.HasInterface(index: integer): boolean; |
314 |
|
begin |
315 |
< |
Result := FInterfaces[index] <> nil; |
315 |
> |
Result := (Length(FInterfaces) > 0) and (FInterfaces[index] <> nil); |
316 |
|
end; |
317 |
|
|
318 |
|
procedure TInterfaceOwner.Remove(intf: TInterfacedObject); |
344 |
|
var i: integer; |
345 |
|
begin |
346 |
|
for i := 0 to Length(FInterfaces) - 1 do |
347 |
+ |
begin |
348 |
+ |
{$IFNDEF FPC} |
349 |
+ |
{With Delphi we need to explicitly null the object reference when it is |
350 |
+ |
going to be disposed of. This is because Delphi does not drop the reference |
351 |
+ |
count until after the containing object is released.} |
352 |
+ |
if (FInterfaces[i] <> nil) and (FInterfaces[i].RefCount <= 2) then |
353 |
+ |
FInterfaces[i] := nil; |
354 |
+ |
{$ENDIF} |
355 |
|
FInterfaceRefs[i] := nil; |
356 |
+ |
end; |
357 |
|
end; |
358 |
|
|
359 |
|
end. |