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