ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/fbintf/client/FBEvents.pas

Comparing ibx/trunk/fbintf/client/FBEvents.pas (file contents):
Revision 401 by tony, Mon Jan 10 10:13:17 2022 UTC vs.
Revision 402 by tony, Mon Aug 1 10:07:24 2022 UTC

#	Line 60 | Line 60
60		{                                                                        }
61		{************************************************************************}
62		unit FBEvents;
63	<	{$IFDEF MSWINDOWS}
64	<	{$DEFINE WINDOWS}
63	>	{$IFDEF MSWINDOWS}
64	>	{$DEFINE WINDOWS}
65		{$ENDIF}
66
67		{$IFDEF FPC}
#	Line 78 | Line 78 | type
78
79		{ TFBEvents }
80
81	+	{Firebird Event and Result buffer syntax is:
82	+
83	+	record
84	+	version: byte;
85	+	event: array of packed record
86	+	strlen: byte;
87	+	strchars: array of AnsiChar; //no of chars given by strlen
88	+	EventCounts: long;
89	+	end;
90	+	end;
91	+
92	+	}
93	+
94		TFBEvents = class(TActivityReporter)
95		private
96		FEvents: TStringList;
#	Line 95 | Line 108 | type
108		procedure CancelEvents(Force: boolean = false); virtual;
109		procedure EventSignaled;
110		function GetIEvents: IEvents; virtual; abstract;
111	<	procedure ProcessEventCounts;
111	>	function ProcessEventCounts: boolean;
112	>	public
113	>	const EPB_version1 = 1;
114		public
115		constructor Create(DBAttachment: IAttachment; aMonitor: IActivityMonitor; Events: TStrings);
116		destructor Destroy; override;
#	Line 103 | Line 118 | type
118		{IEvents}
119		procedure GetEvents(EventNames: TStrings);
120		procedure SetEvents(EventNames: TStrings); overload;
121	<	procedure SetEvents(Event: AnsiString); overload;
121	>	procedure SetEvents(Event: string); overload;
122		procedure Cancel;
123		function ExtractEventCounts: TEventCounts;
124		function GetAttachment: IAttachment;
125		procedure AsyncWaitForEvent(EventHandler: TEventHandler); virtual; abstract;
126	+	procedure WaitForEvent; virtual; abstract;
127		end;
128
129
#	Line 120 | Line 136 | const
136
137		{ TFBEvents }
138
139	+	(* Original Firebird 'C' code
140	+
141	+	SLONG API_ROUTINE_VARARG isc_event_block(UCHAR** event_buffer,
142	+	UCHAR** result_buffer,
143	+	USHORT count, ...)
144	+	{
145	+	/**************************************
146	+	*
147	+	*      i s c _ e v e n t _ b l o c k
148	+	*
149	+	**************************************
150	+	*
151	+	* Functional description
152	+	*      Create an initialized event parameter block from a
153	+	*      variable number of input arguments.
154	+	*      Return the size of the block.
155	+	*
156	+	*      Return 0 if any error occurs.
157	+	*
158	+	**************************************/
159	+	va_list ptr;
160	+
161	+	va_start(ptr, count);
162	+
163	+	// calculate length of event parameter block, setting initial length to include version
164	+	// and counts for each argument
165	+
166	+	SLONG length = 1;
167	+	USHORT i = count;
168	+	while (i--)
169	+	{
170	+	const char* q = va_arg(ptr, SCHAR * );
171	+	length += static_cast<SLONG>(strlen(q)) + 5;
172	+	}
173	+	va_end(ptr);
174	+
175	+	UCHAR* p = *event_buffer = (UCHAR * ) gds__alloc((SLONG) length);
176	+	// FREE: apparently never freed
177	+	if (!*event_buffer)                     // NOMEM:
178	+	return 0;
179	+	if ((*result_buffer = (UCHAR * ) gds__alloc((SLONG) length)) == NULL)
180	+	{
181	+	// NOMEM:
182	+	// FREE: apparently never freed
183	+	gds__free(*event_buffer);
184	+	*event_buffer = NULL;
185	+	return 0;
186	+	}
187	+
188	+	// initialize the block with event names and counts
189	+
190	+	*p++ = EPB_version1;
191	+
192	+	va_start(ptr, count);
193	+
194	+	i = count;
195	+	while (i--)
196	+	{
197	+	const char* q = va_arg(ptr, SCHAR * );
198	+
199	+	// Strip the blanks from the ends
200	+	const char* end = q + strlen(q);
201	+	while (--end >= q && *end == ' ')
202	+	;
203	+	*p++ = end - q + 1;
204	+	while (q <= end)
205	+	*p++ = *q++;
206	+	*p++ = 0;
207	+	*p++ = 0;
208	+	*p++ = 0;
209	+	*p++ = 0;
210	+	}
211	+	va_end(ptr);
212	+
213	+	return static_cast<SLONG>(p - *event_buffer);
214	+	}
215	+	*)
216	+
217	+	{CreateEventBlock effectively replaces isc_event_block}
218	+
219		procedure TFBEvents.CreateEventBlock;
220	<	var
221	<	i: integer;
222	<	EventNames: array of PAnsiChar;
127	<	EventName: AnsiString;
220	>	var i: integer;
221	>	P: PByte;
222	>	var s: Ansistring;
223		begin
224	<	with FFirebirdClientAPI do
224	>	{calculate length of event parameter block, setting initial length to include version
225	>	and counts for each argument}
226	>
227	>	if FEventBuffer <> nil then
228		begin
229	<	if FEventBuffer <> nil then
132	<	isc_free( FEventBuffer);
229	>	FreeMem( FEventBuffer);
230		FEventBuffer := nil;
231	<	if FResultBuffer <> nil then
232	<	isc_free( FResultBuffer);
231	>	end;
232	>	if FResultBuffer <> nil then
233	>	begin
234	>	FreeMem( FResultBuffer);
235		FResultBuffer := nil;
236	+	end;
237
238	<	setlength(EventNames,MaxEvents);
239	<	try
240	<	for i := 0 to FEvents.Count-1 do
241	<	begin
242	<	EventName := FEvents[i];
243	<	EventNames[i] := PAnsiChar(EventName);
144	<	end;
238	>	FEventBufferLen := 1;
239	>	for i := 0 to FEvents.Count - 1 do
240	>	begin
241	>	s := FEvents[i];
242	>	FEventBufferLen := FEventBufferLen + length(s) + 1 + sizeof(Long);
243	>	end;
244
245	<	FEventBufferlen := isc_event_block(@FEventBuffer,@FResultBuffer,
246	<	FEvents.Count,
247	<	EventNames[0],EventNames[1],EventNames[2],
248	<	EventNames[3],EventNames[4],EventNames[5],
249	<	EventNames[6],EventNames[7],EventNames[8],
250	<	EventNames[9],EventNames[10],EventNames[11],
251	<	EventNames[12],EventNames[13],EventNames[14]
252	<	);
253	<	finally
254	<	SetLength(EventNames,0)
245	>	with FFirebirdClientAPI do
246	>	begin
247	>	IBAlloc(FEventBuffer,0,FEventBufferLen);
248	>	if FEventBuffer = nil then Exit;
249	>	FillChar(FEventBuffer^,FEventBufferLen,0);
250	>	IBAlloc(FResultBuffer,0,FEventBufferLen);
251	>	if FResultBuffer = nil then
252	>	begin
253	>	FreeMem(FEventBuffer);
254	>	FEventBuffer := nil;
255	>	Exit;
256	>	end;
257	>	FillChar(FResultBuffer^,FEventBufferLen,0);
258	>
259	>	P := FEventBuffer;
260	>	P^ := EPB_version1;
261	>	Inc(P);
262	>	SetLength(FEventCounts,FEvents.Count);
263	>
264	>	for i := 0 to FEvents.Count - 1 do
265	>	begin
266	>	s := FEvents[i];
267	>	P^ := Length(s);
268	>	Inc(P);
269	>	Move(s[1],P^,Length(s));
270	>	Inc(P,Length(s)+sizeof(Long));
271	>	FEventCounts[i].EventName := s;
272		end;
273		end;
274	+
275	+	{  for i := 0 to FEventBufferLen - 1 do
276	+	write(Format('%x ', [FEventBuffer[i]]));
277	+	writeln; }
278		end;
279
280		procedure TFBEvents.CancelEvents(Force: boolean);
#	Line 169 | Line 289 | begin
289		FCriticalSection.Enter;
290		try
291		if not FInWaitState then Exit;
292	<	FInWaitState := false;
173	<	ProcessEventCounts;
174	<	if assigned(FEventHandler)  then
292	>	if ProcessEventCounts and assigned(FEventHandler)  then
293		begin
294		Handler := FEventHandler;
295		FEventHandler := nil;
296	+	FInWaitState := false;
297		end;
298		finally
299		FCriticalSection.Leave;
#	Line 183 | Line 302 | begin
302		Handler(GetIEvents);
303		end;
304
305	<	procedure TFBEvents.ProcessEventCounts;
306	<	var P: PISC_LONG;
188	<	EventCountList: array[0..19] of ISC_LONG;
189	<	i: integer;
190	<	j: integer;
191	<	begin
192	<	SetLength(FEventCounts,0);
193	<	if FResultBuffer = nil then Exit;
194	<
195	<	FillChar(EventCountList,sizeof(EventCountList),0);
305	>	(*
306	>	Original Firebird 'C' code for isc_event_counts
307
308	+	void API_ROUTINE isc_event_counts(ULONG* result_vector,
309	+	SSHORT buffer_length,
310	+	UCHAR* event_buffer,
311	+	const UCHAR* result_buffer)
312	+	{
313	+	/**************************************
314	+	*
315	+	*      g d s _ $ e v e n t _ c o u n t s
316	+	*
317	+	**************************************
318	+	*
319	+	* Functional description
320	+	*      Get the delta between two events in an event
321	+	*      parameter block.  Used to update gds_events
322	+	*      for GPRE support of events.
323	+	*
324	+	**************************************/
325	+	ULONG* vec = result_vector;
326	+	const UCHAR* p = event_buffer;
327	+	const UCHAR* q = result_buffer;
328	+	USHORT length = buffer_length;
329	+	const UCHAR* const end = p + length;
330	+
331	+	// analyze the event blocks, getting the delta for each event
332	+
333	+	p++;
334	+	q++;
335	+	while (p < end)
336	+	{
337	+	// skip over the event name
338	+
339	+	const USHORT i = (USHORT)* p++;
340	+	p += i;
341	+	q += i + 1;
342	+
343	+	// get the change in count
344	+
345	+	const ULONG initial_count = gds__vax_integer(p, sizeof(SLONG));
346	+	p += sizeof(SLONG);
347	+	const ULONG new_count = gds__vax_integer(q, sizeof(SLONG));
348	+	q += sizeof(SLONG);
349	+	*vec++ = new_count - initial_count;
350	+	}
351	+
352	+	// copy over the result to the initial block to prepare
353	+	// for the next call to gds__event_wait
354	+
355	+	memcpy(event_buffer, result_buffer, length);
356	+	}
357	+	*)
358	+
359	+	{ProcessEventCounts effectively replaces isc_event_counts}
360	+
361	+	function TFBEvents.ProcessEventCounts: boolean;
362	+
363	+	var i: integer;
364	+	P, Q: PByte;
365	+	initial_count: Long;
366	+	new_count: Long;
367	+	len: byte;
368	+	begin
369	+	Result := false;
370	+	P := FEventBuffer;
371	+	Q := FResultBuffer;
372	+	Inc(P); {skip past version byte}
373	+	Inc(Q);
374	+	for i := 0 to Length(FEventCounts) - 1 do
375		with FFirebirdClientAPI do
198	–	isc_event_counts( @EventCountList, FEventBufferLen, FEventBuffer, FResultBuffer);
199	–	j := 0;
200	–	P := @EventCountList;
201	–	for i := 0 to FEvents.Count - 1 do
376		begin
377	<	if EventCountList[i] <> 0 then
378	<	begin
379	<	Inc(j);
380	<	SetLength(FEventCounts,j);
381	<	FEventCounts[j-1].EventName := FEvents[i];
382	<	FEventCounts[j-1].Count := P^;
383	<	Inc(P);
384	<	//      writeln('Event: ',FEventCounts[j-1].EventName,' Count = ',FEventCounts[j-1].Count);
385	<	end;
377	>	{skip over the event name}
378	>	len := P^;
379	>	P := P + len + 1;
380	>	Q := Q + len + 1; {event name length in P^}
381	>	initial_count := DecodeInteger(P,sizeof(Long));
382	>	Inc(P,sizeof(Long));
383	>	new_count := DecodeInteger(Q,sizeof(Long));
384	>	Inc(Q,sizeof(Long));
385	>	FEventCounts[i].Count := new_count - initial_count;
386	>	if FEventCounts[i].Count > 0 then
387	>	Result := true;
388	>	//  writeln('Event Count[',i,'] = ',FEventCounts[i].Count);
389		end;
390	+	Move(FResultBuffer^,FEventBuffer^,FEventBufferLen);
391		end;
392
393		constructor TFBEvents.Create(DBAttachment: IAttachment;
#	Line 234 | Line 412 | begin
412		with FFirebirdClientAPI do
413		begin
414		if FEventBuffer <> nil then
415	<	isc_free( FEventBuffer);
415	>	FreeMem( FEventBuffer);
416		if FResultBuffer <> nil then
417	<	isc_free( FResultBuffer);
417	>	FreeMem( FResultBuffer);
418		end;
419		inherited Destroy;
420		end;
#	Line 247 | Line 425 | begin
425		end;
426
427		procedure TFBEvents.SetEvents(EventNames: TStrings);
428	+	var i: integer;
429		begin
430		{$ifdef Unix}
431		if (EventNames.Count > 0) and not IsMultiThread then
#	Line 255 | Line 434 | begin
434		if EventNames.Text <> FEvents.Text then
435		begin
436		Cancel;
437	<	FEvents.Assign(EventNames);
437	>	for i := 0 to EventNames.Count - 1 do
438	>	FEvents[i] := Trim(EventNames[i]);
439		CreateEventBlock;
440		end;
441		end;
442
443	<	procedure TFBEvents.SetEvents(Event: AnsiString);
443	>	procedure TFBEvents.SetEvents(Event: string);
444		var S: TStringList;
445		begin
446		S := TStringList.Create;

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines