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 |
+ |
{ |
35 |
+ |
This unit has been almost completely re-written as the original code was |
36 |
+ |
not that robust - and I am not even sure if it worked. The IBPP C++ implementation |
37 |
+ |
was used for guidance and inspiration. A permanent thread is used to receive |
38 |
+ |
events from the asynchronous event handler. This then uses "Synchronize" to |
39 |
+ |
process the event in the main thread. |
40 |
+ |
|
41 |
+ |
Note that an error will occur if the TIBEvent's Registered property is set to |
42 |
+ |
true before the Database has been opened. |
43 |
+ |
} |
44 |
+ |
|
45 |
|
unit IBEvents; |
46 |
|
|
47 |
+ |
{$Mode Delphi} |
48 |
+ |
|
49 |
|
interface |
50 |
|
|
51 |
|
uses |
52 |
< |
SysUtils, Windows, Messages, Classes, Graphics, Controls, |
53 |
< |
Forms, Dialogs, DB, IBHeader, IBExternals, IB, IBDatabase; |
52 |
> |
{$IFDEF WINDOWS } |
53 |
> |
Windows, |
54 |
> |
{$ELSE} |
55 |
> |
unix, |
56 |
> |
{$ENDIF} |
57 |
> |
Classes, Graphics, Controls, |
58 |
> |
Forms, Dialogs, IBHeader, IBExternals, IB, IBDatabase; |
59 |
|
|
60 |
|
const |
61 |
|
MaxEvents = 15; |
39 |
– |
EventLength = 64; |
62 |
|
|
63 |
|
type |
64 |
|
|
65 |
|
TEventAlert = procedure( Sender: TObject; EventName: string; EventCount: longint; |
66 |
|
var CancelAlerts: Boolean) of object; |
67 |
|
|
68 |
< |
TEventBuffer = array[ 0..MaxEvents-1, 0..EventLength-1] of char; |
68 |
> |
{ TIBEvents } |
69 |
|
|
70 |
|
TIBEvents = class(TComponent) |
71 |
|
private |
72 |
|
FIBLoaded: Boolean; |
73 |
+ |
FBase: TIBBase; |
74 |
|
FEvents: TStrings; |
75 |
|
FOnEventAlert: TEventAlert; |
76 |
< |
FQueued: Boolean; |
77 |
< |
FRegistered: Boolean; |
78 |
< |
Buffer: TEventBuffer; |
79 |
< |
Changing: Boolean; |
80 |
< |
CS: TRTLCriticalSection; |
81 |
< |
EventBuffer: PChar; |
59 |
< |
EventBufferLen: integer; |
60 |
< |
EventID: ISC_LONG; |
61 |
< |
ProcessingEvents: Boolean; |
62 |
< |
RegisteredState: Boolean; |
63 |
< |
ResultBuffer: PChar; |
64 |
< |
FDatabase: TIBDatabase; |
76 |
> |
FEventHandler: TObject; |
77 |
> |
FRegistered: boolean; |
78 |
> |
FDeferredRegister: boolean; |
79 |
> |
procedure EventChange(sender: TObject); |
80 |
> |
function GetDatabase: TIBDatabase; |
81 |
> |
function GetDatabaseHandle: TISC_DB_HANDLE; |
82 |
|
procedure SetDatabase( value: TIBDatabase); |
83 |
|
procedure ValidateDatabase( Database: TIBDatabase); |
84 |
< |
procedure DoQueueEvents; |
85 |
< |
procedure EventChange( sender: TObject); |
69 |
< |
procedure UpdateResultBuffer( length: short; updated: PChar); |
84 |
> |
procedure DoBeforeDatabaseDisconnect(Sender: TObject); |
85 |
> |
procedure DoAfterDatabaseConnect(Sender: TObject); |
86 |
|
protected |
71 |
– |
procedure HandleEvent; |
72 |
– |
procedure Loaded; override; |
87 |
|
procedure Notification( AComponent: TComponent; Operation: TOperation); override; |
88 |
|
procedure SetEvents( value: TStrings); |
89 |
|
procedure SetRegistered( value: boolean); |
76 |
– |
function GetNativeHandle: TISC_DB_HANDLE; |
90 |
|
|
91 |
|
public |
92 |
|
constructor Create( AOwner: TComponent); override; |
93 |
|
destructor Destroy; override; |
81 |
– |
procedure CancelEvents; |
82 |
– |
procedure QueueEvents; |
94 |
|
procedure RegisterEvents; |
95 |
|
procedure UnRegisterEvents; |
96 |
< |
property Queued: Boolean read FQueued; |
96 |
> |
property DatabaseHandle: TISC_DB_HANDLE read GetDatabaseHandle; |
97 |
> |
property DeferredRegister: boolean read FDeferredRegister write FDeferredRegister; |
98 |
|
published |
99 |
< |
property Database: TIBDatabase read FDatabase write SetDatabase; |
99 |
> |
property Database: TIBDatabase read GetDatabase write SetDatabase; |
100 |
|
property Events: TStrings read FEvents write SetEvents; |
101 |
|
property Registered: Boolean read FRegistered write SetRegistered; |
102 |
|
property OnEventAlert: TEventAlert read FOnEventAlert write FOnEventAlert; |
103 |
|
end; |
104 |
|
|
105 |
+ |
|
106 |
|
implementation |
107 |
|
|
108 |
|
uses |
109 |
< |
IBIntf; |
109 |
> |
IBIntf, syncobjs; |
110 |
> |
|
111 |
> |
type |
112 |
> |
|
113 |
> |
TEventHandlerStates = ( |
114 |
> |
stIdle, {Events not monitored} |
115 |
> |
stHasEvb, {Event Block Allocated but not queued} |
116 |
> |
stQueued, {Waiting for Event} |
117 |
> |
stSignalled {Event Callback signalled Event} |
118 |
> |
); |
119 |
> |
|
120 |
> |
{ TEventHandler } |
121 |
> |
|
122 |
> |
TEventHandler = class(TThread) |
123 |
> |
private |
124 |
> |
FOwner: TIBEvents; |
125 |
> |
FCriticalSection: TCriticalSection; {protects race conditions in stQueued state} |
126 |
> |
{$IFDEF WINDOWS} |
127 |
> |
{Make direct use of Windows API as TEventObject don't seem to work under |
128 |
> |
Windows!} |
129 |
> |
FEventHandler: THandle; |
130 |
> |
{$ELSE} |
131 |
> |
FEventWaiting: TEventObject; |
132 |
> |
{$ENDIF} |
133 |
> |
FState: TEventHandlerStates; |
134 |
> |
FEventBuffer: PChar; |
135 |
> |
FEventBufferLen: integer; |
136 |
> |
FEventID: ISC_LONG; |
137 |
> |
FRegisteredState: Boolean; |
138 |
> |
FResultBuffer: PChar; |
139 |
> |
FEvents: TStringList; |
140 |
> |
FSignalFired: boolean; |
141 |
> |
procedure QueueEvents; |
142 |
> |
procedure CancelEvents; |
143 |
> |
procedure HandleEventSignalled(length: short; updated: PChar); |
144 |
> |
procedure DoEventSignalled; |
145 |
> |
protected |
146 |
> |
procedure Execute; override; |
147 |
> |
public |
148 |
> |
constructor Create(Owner: TIBEvents); |
149 |
> |
destructor Destroy; override; |
150 |
> |
procedure Terminate; |
151 |
> |
procedure RegisterEvents(Events: TStrings); |
152 |
> |
procedure UnregisterEvents; |
153 |
> |
end; |
154 |
> |
|
155 |
> |
{This procedure is used for the event call back - note the cdecl } |
156 |
|
|
157 |
< |
function TIBEvents.GetNativeHandle: TISC_DB_HANDLE; |
157 |
> |
procedure IBEventCallback( ptr: pointer; length: short; updated: PChar); cdecl; |
158 |
|
begin |
159 |
< |
if assigned( FDatabase) and FDatabase.Connected then |
160 |
< |
Result := FDatabase.Handle |
161 |
< |
else result := nil; |
159 |
> |
if (ptr = nil) or (length = 0) or (updated = nil) then |
160 |
> |
Exit; |
161 |
> |
{ Handle events asynchronously in second thread } |
162 |
> |
TEventHandler(ptr).HandleEventSignalled(length,updated); |
163 |
|
end; |
164 |
|
|
165 |
< |
procedure TIBEvents.ValidateDatabase( Database: TIBDatabase); |
165 |
> |
|
166 |
> |
|
167 |
> |
{ TEventHandler } |
168 |
> |
|
169 |
> |
procedure TEventHandler.QueueEvents; |
170 |
> |
var |
171 |
> |
callback: pointer; |
172 |
> |
DBH: TISC_DB_HANDLE; |
173 |
|
begin |
174 |
< |
if not assigned( Database) then |
175 |
< |
IBError(ibxeDatabaseNameMissing, [nil]); |
176 |
< |
if not Database.Connected then |
177 |
< |
IBError(ibxeDatabaseClosed, [nil]); |
174 |
> |
if FState <> stHasEvb then |
175 |
> |
Exit; |
176 |
> |
FCriticalSection.Enter; |
177 |
> |
try |
178 |
> |
callback := @IBEventCallback; |
179 |
> |
DBH := FOwner.DatabaseHandle; |
180 |
> |
if (isc_que_events( StatusVector, @DBH, @FEventID, FEventBufferLen, |
181 |
> |
FEventBuffer, TISC_CALLBACK(callback), PVoid(Self)) <> 0) then |
182 |
> |
IBDatabaseError; |
183 |
> |
FState := stQueued |
184 |
> |
finally |
185 |
> |
FCriticalSection.Leave |
186 |
> |
end; |
187 |
|
end; |
188 |
|
|
189 |
< |
{ TIBEvents } |
189 |
> |
procedure TEventHandler.CancelEvents; |
190 |
> |
var |
191 |
> |
DBH: TISC_DB_HANDLE; |
192 |
> |
begin |
193 |
> |
if FState in [stQueued,stSignalled] then |
194 |
> |
begin |
195 |
> |
FCriticalSection.Enter; |
196 |
> |
try |
197 |
> |
DBH := FOwner.DatabaseHandle; |
198 |
> |
if (isc_Cancel_events( StatusVector, @DBH, @FEventID) <> 0) then |
199 |
> |
IBDatabaseError; |
200 |
> |
FState := stHasEvb; |
201 |
> |
finally |
202 |
> |
FCriticalSection.Leave |
203 |
> |
end; |
204 |
> |
end; |
205 |
|
|
206 |
< |
procedure HandleEvent( param: integer); stdcall; |
206 |
> |
if FState = stHasEvb then |
207 |
> |
begin |
208 |
> |
isc_free( FEventBuffer); |
209 |
> |
FEventBuffer := nil; |
210 |
> |
isc_free( FResultBuffer); |
211 |
> |
FResultBuffer := nil; |
212 |
> |
FState := stIdle |
213 |
> |
end; |
214 |
> |
FSignalFired := false |
215 |
> |
end; |
216 |
> |
|
217 |
> |
procedure TEventHandler.HandleEventSignalled(length: short; updated: PChar); |
218 |
|
begin |
219 |
< |
{ don't let exceptions propogate out of thread } |
219 |
> |
FCriticalSection.Enter; |
220 |
|
try |
221 |
< |
TIBEvents( param).HandleEvent; |
222 |
< |
except |
223 |
< |
Application.HandleException( nil); |
221 |
> |
if FState <> stQueued then |
222 |
> |
Exit; |
223 |
> |
Move(Updated[0], FResultBuffer[0], Length); |
224 |
> |
FState := stSignalled; |
225 |
> |
{$IFDEF WINDOWS} |
226 |
> |
SetEVent(FEventHandler); |
227 |
> |
{$ELSE} |
228 |
> |
FEventWaiting.SetEvent; |
229 |
> |
{$ENDIF} |
230 |
> |
finally |
231 |
> |
FCriticalSection.Leave |
232 |
|
end; |
233 |
|
end; |
234 |
|
|
235 |
< |
procedure IBEventCallback( ptr: pointer; length: short; updated: PChar); cdecl; |
235 |
> |
procedure TEventHandler.DoEventSignalled; |
236 |
|
var |
237 |
< |
ThreadID: DWORD; |
237 |
> |
i: integer; |
238 |
> |
CancelAlerts: boolean; |
239 |
> |
Status: array[0..19] of ISC_LONG; {Note in 64 implementation the ibase.h implementation |
240 |
> |
is different from Interbase 6.0 API documentatoin} |
241 |
> |
begin |
242 |
> |
if FState <> stSignalled then |
243 |
> |
Exit; |
244 |
> |
isc_event_counts( @Status, FEventBufferLen, FEventBuffer, FResultBuffer); |
245 |
> |
CancelAlerts := false; |
246 |
> |
if not FSignalFired then |
247 |
> |
FSignalFired := true {Ignore first time} |
248 |
> |
else |
249 |
> |
if assigned(FOwner.FOnEventAlert) then |
250 |
> |
begin |
251 |
> |
for i := 0 to FEvents.Count - 1 do |
252 |
> |
begin |
253 |
> |
try |
254 |
> |
if (Status[i] <> 0) and not CancelAlerts then |
255 |
> |
FOwner.FOnEventAlert( self, FEvents[i], Status[i], CancelAlerts); |
256 |
> |
except |
257 |
> |
Application.HandleException( nil); |
258 |
> |
end; |
259 |
> |
end; |
260 |
> |
end; |
261 |
> |
FState := stHasEvb; |
262 |
> |
if CancelAlerts then |
263 |
> |
CancelEvents |
264 |
> |
else |
265 |
> |
QueueEvents |
266 |
> |
end; |
267 |
> |
|
268 |
> |
procedure TEventHandler.Execute; |
269 |
|
begin |
270 |
< |
{ Handle events asynchronously in second thread } |
271 |
< |
EnterCriticalSection( TIBEvents( ptr).CS); |
272 |
< |
TIBEvents( ptr).UpdateResultBuffer( length, updated); |
273 |
< |
if TIBEvents( ptr).Queued then |
274 |
< |
CloseHandle( CreateThread( nil, 8192, @HandleEvent, ptr, 0, ThreadID)); |
275 |
< |
LeaveCriticalSection( TIBEvents( ptr).CS); |
270 |
> |
while not Terminated do |
271 |
> |
begin |
272 |
> |
{$IFDEF WINDOWS} |
273 |
> |
WaitForSingleObject(FEventHandler,INFINITE); |
274 |
> |
{$ELSE} |
275 |
> |
FEventWaiting.WaitFor(INFINITE); |
276 |
> |
{$ENDIF} |
277 |
> |
|
278 |
> |
if not Terminated and (FState = stSignalled) then |
279 |
> |
Synchronize(DoEventSignalled) |
280 |
> |
end; |
281 |
> |
end; |
282 |
> |
|
283 |
> |
|
284 |
> |
|
285 |
> |
constructor TEventHandler.Create(Owner: TIBEvents); |
286 |
> |
var |
287 |
> |
PSa : PSecurityAttributes; |
288 |
> |
{$IFDEF WINDOWS} |
289 |
> |
Sd : TSecurityDescriptor; |
290 |
> |
Sa : TSecurityAttributes; |
291 |
> |
begin |
292 |
> |
InitializeSecurityDescriptor(@Sd,SECURITY_DESCRIPTOR_REVISION); |
293 |
> |
SetSecurityDescriptorDacl(@Sd,true,nil,false); |
294 |
> |
Sa.nLength := SizeOf(Sa); |
295 |
> |
Sa.lpSecurityDescriptor := @Sd; |
296 |
> |
Sa.bInheritHandle := true; |
297 |
> |
PSa := @Sa; |
298 |
> |
{$ELSE} |
299 |
> |
begin |
300 |
> |
PSa:= nil; |
301 |
> |
{$ENDIF} |
302 |
> |
inherited Create(true); |
303 |
> |
FOwner := Owner; |
304 |
> |
FState := stIdle; |
305 |
> |
FCriticalSection := TCriticalSection.Create; |
306 |
> |
{$IFDEF WINDOWS} |
307 |
> |
FEventHandler := CreateEvent(PSa,false,true,nil); |
308 |
> |
{$ELSE} |
309 |
> |
FEventWaiting := TEventObject.Create(PSa,false,true,FOwner.Name+'.Events'); |
310 |
> |
{$ENDIF} |
311 |
> |
FEvents := TStringList.Create; |
312 |
> |
FreeOnTerminate := true; |
313 |
> |
Resume |
314 |
> |
end; |
315 |
> |
|
316 |
> |
destructor TEventHandler.Destroy; |
317 |
> |
begin |
318 |
> |
if assigned(FCriticalSection) then FCriticalSection.Free; |
319 |
> |
{$IFDEF WINDOWS} |
320 |
> |
CloseHandle(FEventHandler); |
321 |
> |
{$ELSE} |
322 |
> |
if assigned(FEventWaiting) then FEventWaiting.Free; |
323 |
> |
{$ENDIF} |
324 |
> |
if assigned(FEvents) then FEvents.Free; |
325 |
> |
inherited Destroy; |
326 |
> |
end; |
327 |
> |
|
328 |
> |
procedure TEventHandler.Terminate; |
329 |
> |
begin |
330 |
> |
inherited Terminate; |
331 |
> |
{$IFDEF WINDOWS} |
332 |
> |
SetEvent(FEventHandler); |
333 |
> |
{$ELSE} |
334 |
> |
FEventWaiting.SetEvent; |
335 |
> |
{$ENDIF} |
336 |
> |
CancelEvents; |
337 |
> |
end; |
338 |
> |
|
339 |
> |
procedure TEventHandler.RegisterEvents(Events: TStrings); |
340 |
> |
var |
341 |
> |
i: integer; |
342 |
> |
EventNames: array of PChar; |
343 |
> |
begin |
344 |
> |
UnregisterEvents; |
345 |
> |
|
346 |
> |
if Events.Count = 0 then |
347 |
> |
exit; |
348 |
> |
|
349 |
> |
setlength(EventNames,MaxEvents); |
350 |
> |
try |
351 |
> |
for i := 0 to Events.Count-1 do |
352 |
> |
EventNames[i] := PChar(Events[i]); |
353 |
> |
FEvents.Assign(Events); |
354 |
> |
FEventBufferlen := isc_event_block(@FEventBuffer,@FResultBuffer, |
355 |
> |
Events.Count, |
356 |
> |
EventNames[0],EventNames[1],EventNames[2], |
357 |
> |
EventNames[3],EventNames[4],EventNames[5], |
358 |
> |
EventNames[6],EventNames[7],EventNames[8], |
359 |
> |
EventNames[9],EventNames[10],EventNames[11], |
360 |
> |
EventNames[12],EventNames[13],EventNames[14] |
361 |
> |
); |
362 |
> |
FState := stHasEvb; |
363 |
> |
FRegisteredState := true; |
364 |
> |
QueueEvents |
365 |
> |
finally |
366 |
> |
SetLength(EventNames,0) |
367 |
> |
end; |
368 |
> |
end; |
369 |
> |
|
370 |
> |
procedure TEventHandler.UnregisterEvents; |
371 |
> |
begin |
372 |
> |
if FRegisteredState then |
373 |
> |
begin |
374 |
> |
CancelEvents; |
375 |
> |
FRegisteredState := false; |
376 |
> |
end; |
377 |
> |
end; |
378 |
> |
|
379 |
> |
{ TIBEvents } |
380 |
> |
|
381 |
> |
procedure TIBEvents.ValidateDatabase( Database: TIBDatabase); |
382 |
> |
begin |
383 |
> |
if not assigned( Database) then |
384 |
> |
IBError(ibxeDatabaseNameMissing, [nil]); |
385 |
> |
if not Database.Connected then |
386 |
> |
IBError(ibxeDatabaseClosed, [nil]); |
387 |
|
end; |
388 |
|
|
389 |
|
constructor TIBEvents.Create( AOwner: TComponent); |
392 |
|
FIBLoaded := False; |
393 |
|
CheckIBLoaded; |
394 |
|
FIBLoaded := True; |
395 |
< |
InitializeCriticalSection( CS); |
395 |
> |
FBase := TIBBase.Create(Self); |
396 |
> |
FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect; |
397 |
> |
FBase.AfterDatabaseConnect := DoAfterDatabaseConnect; |
398 |
|
FEvents := TStringList.Create; |
399 |
|
with TStringList( FEvents) do |
400 |
|
begin |
401 |
|
OnChange := EventChange; |
402 |
|
Duplicates := dupIgnore; |
403 |
|
end; |
404 |
+ |
FEventHandler := TEventHandler.Create(self) |
405 |
|
end; |
406 |
|
|
407 |
|
destructor TIBEvents.Destroy; |
409 |
|
if FIBLoaded then |
410 |
|
begin |
411 |
|
UnregisterEvents; |
412 |
< |
SetDatabase( nil); |
412 |
> |
SetDatabase(nil); |
413 |
|
TStringList(FEvents).OnChange := nil; |
414 |
+ |
FBase.Free; |
415 |
|
FEvents.Free; |
160 |
– |
DeleteCriticalSection( CS); |
416 |
|
end; |
417 |
+ |
if assigned(FEventHandler) then |
418 |
+ |
TEventHandler(FEventHandler).Terminate; |
419 |
+ |
FEventHandler := nil; |
420 |
|
inherited Destroy; |
421 |
|
end; |
422 |
|
|
165 |
– |
procedure TIBEvents.CancelEvents; |
166 |
– |
begin |
167 |
– |
if ProcessingEvents then |
168 |
– |
IBError(ibxeInvalidCancellation, [nil]); |
169 |
– |
if FQueued then |
170 |
– |
begin |
171 |
– |
try |
172 |
– |
{ wait for event handler to finish before cancelling events } |
173 |
– |
EnterCriticalSection( CS); |
174 |
– |
ValidateDatabase( Database); |
175 |
– |
FQueued := false; |
176 |
– |
Changing := true; |
177 |
– |
if (isc_Cancel_events( StatusVector, @FDatabase.Handle, @EventID) > 0) then |
178 |
– |
IBDatabaseError; |
179 |
– |
finally |
180 |
– |
LeaveCriticalSection( CS); |
181 |
– |
end; |
182 |
– |
end; |
183 |
– |
end; |
423 |
|
|
185 |
– |
procedure TIBEvents.DoQueueEvents; |
186 |
– |
var |
187 |
– |
callback: pointer; |
188 |
– |
begin |
189 |
– |
ValidateDatabase( DataBase); |
190 |
– |
callback := @IBEventCallback; |
191 |
– |
if (isc_que_events( StatusVector, @FDatabase.Handle, @EventID, EventBufferLen, |
192 |
– |
EventBuffer, TISC_CALLBACK(callback), PVoid(Self)) > 0) then |
193 |
– |
IBDatabaseError; |
194 |
– |
FQueued := true; |
195 |
– |
end; |
424 |
|
|
425 |
|
procedure TIBEvents.EventChange( sender: TObject); |
426 |
|
begin |
435 |
|
TStringList(Events).OnChange := EventChange; |
436 |
|
IBError(ibxeMaximumEvents, [nil]); |
437 |
|
end; |
438 |
< |
if Registered then RegisterEvents; |
439 |
< |
end; |
212 |
< |
|
213 |
< |
procedure TIBEvents.HandleEvent; |
214 |
< |
var |
215 |
< |
Status: PStatusVector; |
216 |
< |
CancelAlerts: Boolean; |
217 |
< |
i: integer; |
218 |
< |
begin |
219 |
< |
try |
220 |
< |
{ prevent modification of vital data structures while handling events } |
221 |
< |
EnterCriticalSection( CS); |
222 |
< |
ProcessingEvents := true; |
223 |
< |
isc_event_counts( StatusVector, EventBufferLen, EventBuffer, ResultBuffer); |
224 |
< |
CancelAlerts := false; |
225 |
< |
if assigned(FOnEventAlert) and not Changing then |
226 |
< |
begin |
227 |
< |
for i := 0 to Events.Count-1 do |
228 |
< |
begin |
229 |
< |
try |
230 |
< |
Status := StatusVectorArray; |
231 |
< |
if (Status[i] <> 0) and not CancelAlerts then |
232 |
< |
FOnEventAlert( self, Events[Events.Count-i-1], Status[i], CancelAlerts); |
233 |
< |
except |
234 |
< |
Application.HandleException( nil); |
235 |
< |
end; |
236 |
< |
end; |
237 |
< |
end; |
238 |
< |
Changing := false; |
239 |
< |
if not CancelAlerts and FQueued then DoQueueEvents; |
240 |
< |
finally |
241 |
< |
ProcessingEvents := false; |
242 |
< |
LeaveCriticalSection( CS); |
243 |
< |
end; |
244 |
< |
end; |
245 |
< |
|
246 |
< |
procedure TIBEvents.Loaded; |
247 |
< |
begin |
248 |
< |
inherited Loaded; |
249 |
< |
try |
250 |
< |
if RegisteredState then RegisterEvents; |
251 |
< |
except |
252 |
< |
if csDesigning in ComponentState then |
253 |
< |
Application.HandleException( self) |
254 |
< |
else raise; |
255 |
< |
end; |
438 |
> |
if Registered then |
439 |
> |
TEventHandler(FEventHandler).RegisterEvents(Events); |
440 |
|
end; |
441 |
|
|
442 |
|
procedure TIBEvents.Notification( AComponent: TComponent; |
443 |
|
Operation: TOperation); |
444 |
|
begin |
445 |
|
inherited Notification( AComponent, Operation); |
446 |
< |
if (Operation = opRemove) and (AComponent = FDatabase) then |
446 |
> |
if (Operation = opRemove) and (AComponent = FBase.Database) then |
447 |
|
begin |
448 |
|
UnregisterEvents; |
449 |
< |
FDatabase := nil; |
266 |
< |
end; |
267 |
< |
end; |
268 |
< |
|
269 |
< |
procedure TIBEvents.QueueEvents; |
270 |
< |
begin |
271 |
< |
if not FRegistered then |
272 |
< |
IBError(ibxeNoEventsRegistered, [nil]); |
273 |
< |
if ProcessingEvents then |
274 |
< |
IBError(ibxeInvalidQueueing, [nil]); |
275 |
< |
if not FQueued then |
276 |
< |
begin |
277 |
< |
try |
278 |
< |
{ wait until current event handler is finished before queuing events } |
279 |
< |
EnterCriticalSection( CS); |
280 |
< |
DoQueueEvents; |
281 |
< |
Changing := true; |
282 |
< |
finally |
283 |
< |
LeaveCriticalSection( CS); |
284 |
< |
end; |
449 |
> |
FBase.Database := nil; |
450 |
|
end; |
451 |
|
end; |
452 |
|
|
453 |
|
procedure TIBEvents.RegisterEvents; |
289 |
– |
var |
290 |
– |
i: integer; |
291 |
– |
bufptr: pointer; |
292 |
– |
eventbufptr: pointer; |
293 |
– |
resultbufptr: pointer; |
294 |
– |
buflen: integer; |
454 |
|
begin |
455 |
|
ValidateDatabase( Database); |
456 |
|
if csDesigning in ComponentState then FRegistered := true |
457 |
< |
else begin |
458 |
< |
UnregisterEvents; |
459 |
< |
if Events.Count = 0 then exit; |
460 |
< |
for i := 0 to Events.Count-1 do |
461 |
< |
StrPCopy( @Buffer[i][0], Events[i]); |
462 |
< |
i := Events.Count; |
463 |
< |
bufptr := @buffer[0]; |
464 |
< |
eventbufptr := @EventBuffer; |
306 |
< |
resultBufPtr := @ResultBuffer; |
307 |
< |
asm |
308 |
< |
mov ecx, dword ptr [i] |
309 |
< |
mov eax, dword ptr [bufptr] |
310 |
< |
@@1: |
311 |
< |
push eax |
312 |
< |
add eax, EventLength |
313 |
< |
loop @@1 |
314 |
< |
push dword ptr [i] |
315 |
< |
push dword ptr [resultBufPtr] |
316 |
< |
push dword ptr [eventBufPtr] |
317 |
< |
call [isc_event_block] |
318 |
< |
mov dword ptr [bufLen], eax |
319 |
< |
mov eax, dword ptr [i] |
320 |
< |
shl eax, 2 |
321 |
< |
add eax, 12 |
322 |
< |
add esp, eax |
457 |
> |
else |
458 |
> |
begin |
459 |
> |
if not FBase.Database.Connected then |
460 |
> |
FDeferredRegister := true |
461 |
> |
else |
462 |
> |
begin |
463 |
> |
TEventHandler(FEventHandler).RegisterEvents(Events); |
464 |
> |
FRegistered := true; |
465 |
|
end; |
324 |
– |
EventBufferlen := Buflen; |
325 |
– |
FRegistered := true; |
326 |
– |
QueueEvents; |
466 |
|
end; |
467 |
|
end; |
468 |
|
|
473 |
|
|
474 |
|
procedure TIBEvents.SetDatabase( value: TIBDatabase); |
475 |
|
begin |
476 |
< |
if value <> FDatabase then |
476 |
> |
if value <> FBase.Database then |
477 |
|
begin |
478 |
< |
UnregisterEvents; |
478 |
> |
if Registered then UnregisterEvents; |
479 |
|
if assigned( value) and value.Connected then ValidateDatabase( value); |
480 |
< |
FDatabase := value; |
480 |
> |
FBase.Database := value; |
481 |
> |
if (FBase.Database <> nil) and FBase.Database.Connected then |
482 |
> |
DoAfterDatabaseConnect(FBase.Database) |
483 |
|
end; |
484 |
|
end; |
485 |
|
|
486 |
+ |
function TIBEvents.GetDatabase: TIBDatabase; |
487 |
+ |
begin |
488 |
+ |
Result := FBase.Database |
489 |
+ |
end; |
490 |
+ |
|
491 |
|
procedure TIBEvents.SetRegistered( value: Boolean); |
492 |
|
begin |
493 |
< |
if (csReading in ComponentState) then |
494 |
< |
RegisteredState := value |
495 |
< |
else if FRegistered <> value then |
496 |
< |
if value then RegisterEvents else UnregisterEvents; |
493 |
> |
FDeferredRegister := false; |
494 |
> |
if not assigned(FBase) or (FBase.Database = nil) then |
495 |
> |
begin |
496 |
> |
FDeferredRegister := value; |
497 |
> |
Exit; |
498 |
> |
end; |
499 |
> |
|
500 |
> |
if value then RegisterEvents else UnregisterEvents; |
501 |
|
end; |
502 |
|
|
503 |
|
procedure TIBEvents.UnregisterEvents; |
504 |
|
begin |
505 |
< |
if ProcessingEvents then |
506 |
< |
IBError(ibxeInvalidRegistration, [nil]); |
505 |
> |
FDeferredRegister := false; |
506 |
> |
if not FRegistered then |
507 |
> |
Exit; |
508 |
|
if csDesigning in ComponentState then |
509 |
|
FRegistered := false |
510 |
< |
else if not (csLoading in ComponentState) then |
510 |
> |
else |
511 |
|
begin |
512 |
< |
CancelEvents; |
362 |
< |
if FRegistered then |
363 |
< |
begin |
364 |
< |
isc_free( EventBuffer); |
365 |
< |
EventBuffer := nil; |
366 |
< |
isc_free( ResultBuffer); |
367 |
< |
ResultBuffer := nil; |
368 |
< |
end; |
512 |
> |
TEventHandler(FEventHandler).UnRegisterEvents; |
513 |
|
FRegistered := false; |
514 |
|
end; |
515 |
|
end; |
516 |
|
|
517 |
< |
procedure TIBEvents.UpdateResultBuffer( length: short; updated: PChar); |
518 |
< |
var |
519 |
< |
i: integer; |
517 |
> |
procedure TIBEvents.DoBeforeDatabaseDisconnect(Sender: TObject); |
518 |
> |
begin |
519 |
> |
UnregisterEvents; |
520 |
> |
end; |
521 |
> |
|
522 |
> |
procedure TIBEvents.DoAfterDatabaseConnect(Sender: TObject); |
523 |
|
begin |
524 |
< |
for i := 0 to length-1 do |
525 |
< |
ResultBuffer[i] := updated[i]; |
524 |
> |
if FDeferredRegister then |
525 |
> |
Registered := true |
526 |
|
end; |
527 |
|
|
528 |
+ |
function TIBEvents.GetDatabaseHandle: TISC_DB_HANDLE; |
529 |
+ |
begin |
530 |
+ |
ValidateDatabase(FBase.Database); |
531 |
+ |
Result := FBase.Database.Handle; |
532 |
+ |
end; |
533 |
+ |
|
534 |
+ |
|
535 |
|
end. |