60 |
|
{ } |
61 |
|
{************************************************************************} |
62 |
|
unit FBEvents; |
63 |
+ |
{$IFDEF MSWINDOWS} |
64 |
+ |
{$DEFINE WINDOWS} |
65 |
+ |
{$ENDIF} |
66 |
|
|
67 |
|
{$IFDEF FPC} |
68 |
< |
{$mode objfpc}{$H+} |
68 |
> |
{$mode delphi} |
69 |
|
{$interfaces COM} |
70 |
|
{$ENDIF} |
71 |
|
|
82 |
|
private |
83 |
|
FEvents: TStringList; |
84 |
|
FAttachment: IAttachment; |
85 |
+ |
FEventCounts: TEventCounts; |
86 |
|
protected |
87 |
< |
FEventBuffer: PChar; |
87 |
> |
FEventBuffer: PByte; |
88 |
|
FEventBufferLen: integer; |
89 |
< |
FResultBuffer: PChar; |
89 |
> |
FResultBuffer: PByte; |
90 |
|
FEventHandler: TEventHandler; |
91 |
|
FCriticalSection: TCriticalSection; |
92 |
|
FInWaitState: boolean; |
94 |
|
procedure CancelEvents(Force: boolean = false); virtual; |
95 |
|
procedure EventSignaled; |
96 |
|
function GetIEvents: IEvents; virtual; abstract; |
97 |
+ |
procedure ProcessEventCounts; |
98 |
|
public |
99 |
|
constructor Create(DBAttachment: IAttachment; aMonitor: IActivityMonitor; Events: TStrings); |
100 |
|
destructor Destroy; override; |
102 |
|
{IEvents} |
103 |
|
procedure GetEvents(EventNames: TStrings); |
104 |
|
procedure SetEvents(EventNames: TStrings); overload; |
105 |
< |
procedure SetEvents(Event: string); overload; |
105 |
> |
procedure SetEvents(Event: AnsiString); overload; |
106 |
|
procedure Cancel; |
107 |
|
function ExtractEventCounts: TEventCounts; |
108 |
|
function GetAttachment: IAttachment; |
109 |
+ |
procedure AsyncWaitForEvent(EventHandler: TEventHandler); virtual; abstract; |
110 |
|
end; |
111 |
|
|
112 |
|
|
122 |
|
procedure TFBEvents.CreateEventBlock; |
123 |
|
var |
124 |
|
i: integer; |
125 |
< |
EventNames: array of PChar; |
125 |
> |
EventNames: array of PAnsiChar; |
126 |
> |
EventName: AnsiString; |
127 |
|
begin |
128 |
|
with FirebirdClientAPI do |
129 |
|
begin |
137 |
|
setlength(EventNames,MaxEvents); |
138 |
|
try |
139 |
|
for i := 0 to FEvents.Count-1 do |
140 |
< |
EventNames[i] := PChar(FEvents[i]); |
140 |
> |
begin |
141 |
> |
EventName := FEvents[i]; |
142 |
> |
EventNames[i] := PAnsiChar(EventName); |
143 |
> |
end; |
144 |
|
|
145 |
|
FEventBufferlen := isc_event_block(@FEventBuffer,@FResultBuffer, |
146 |
|
FEvents.Count, |
164 |
|
procedure TFBEvents.EventSignaled; |
165 |
|
var Handler: TEventHandler; |
166 |
|
begin |
167 |
+ |
Handler := nil; |
168 |
|
FCriticalSection.Enter; |
169 |
|
try |
170 |
|
if not FInWaitState then Exit; |
171 |
|
FInWaitState := false; |
172 |
+ |
ProcessEventCounts; |
173 |
|
if assigned(FEventHandler) then |
174 |
|
begin |
175 |
|
Handler := FEventHandler; |
176 |
|
FEventHandler := nil; |
177 |
|
end; |
178 |
|
finally |
179 |
< |
FCriticalSection.Leave |
179 |
> |
FCriticalSection.Leave; |
180 |
> |
end; |
181 |
> |
if assigned(Handler) then |
182 |
> |
Handler(GetIEvents); |
183 |
> |
end; |
184 |
> |
|
185 |
> |
procedure TFBEvents.ProcessEventCounts; |
186 |
> |
var P: PISC_LONG; |
187 |
> |
EventCountList: array[0..19] of ISC_LONG; |
188 |
> |
i: integer; |
189 |
> |
j: integer; |
190 |
> |
begin |
191 |
> |
SetLength(FEventCounts,0); |
192 |
> |
if FResultBuffer = nil then Exit; |
193 |
> |
|
194 |
> |
FillChar(EventCountList,sizeof(EventCountList),0); |
195 |
> |
|
196 |
> |
with FirebirdClientAPI do |
197 |
> |
isc_event_counts( @EventCountList, FEventBufferLen, FEventBuffer, FResultBuffer); |
198 |
> |
j := 0; |
199 |
> |
P := @EventCountList; |
200 |
> |
for i := 0 to FEvents.Count - 1 do |
201 |
> |
begin |
202 |
> |
if EventCountList[i] <> 0 then |
203 |
> |
begin |
204 |
> |
Inc(j); |
205 |
> |
SetLength(FEventCounts,j); |
206 |
> |
FEventCounts[j-1].EventName := FEvents[i]; |
207 |
> |
FEventCounts[j-1].Count := P^; |
208 |
> |
Inc(P); |
209 |
> |
// writeln('Event: ',FEventCounts[j-1].EventName,' Count = ',FEventCounts[j-1].Count); |
210 |
> |
end; |
211 |
|
end; |
169 |
– |
Handler(GetIEvents); |
212 |
|
end; |
213 |
|
|
214 |
|
constructor TFBEvents.Create(DBAttachment: IAttachment; |
254 |
|
end; |
255 |
|
end; |
256 |
|
|
257 |
< |
procedure TFBEvents.SetEvents(Event: string); |
257 |
> |
procedure TFBEvents.SetEvents(Event: AnsiString); |
258 |
|
var S: TStringList; |
259 |
|
begin |
260 |
|
S := TStringList.Create; |
273 |
|
end; |
274 |
|
|
275 |
|
function TFBEvents.ExtractEventCounts: TEventCounts; |
234 |
– |
var EventCountList, P: PISC_LONG; |
235 |
– |
i: integer; |
236 |
– |
j: integer; |
276 |
|
begin |
277 |
< |
SetLength(Result,0); |
239 |
< |
if FResultBuffer = nil then Exit; |
240 |
< |
|
241 |
< |
GetMem(EventCountList,sizeof(ISC_LONG)*FEvents.Count); |
242 |
< |
try |
243 |
< |
with FirebirdClientAPI do |
244 |
< |
isc_event_counts( EventCountList, FEventBufferLen, FEventBuffer, FResultBuffer); |
245 |
< |
j := 0; |
246 |
< |
P := EventCountList; |
247 |
< |
for i := 0 to FEvents.Count - 1 do |
248 |
< |
begin |
249 |
< |
if EventCountList[i] > 0 then |
250 |
< |
begin |
251 |
< |
Inc(j); |
252 |
< |
SetLength(Result,j); |
253 |
< |
Result[j-1].EventName := FEvents[i]; |
254 |
< |
Result[j-1].Count := P^; |
255 |
< |
Inc(P); |
256 |
< |
end; |
257 |
< |
end; |
258 |
< |
finally |
259 |
< |
FreeMem(EventCountList); |
260 |
< |
end; |
277 |
> |
Result := FEventCounts; |
278 |
|
end; |
279 |
|
|
280 |
|
function TFBEvents.GetAttachment: IAttachment; |