ViewVC Help

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

root/public/ibx/branches/udr/client/FBEvents.pas

Comparing:
ibx/branches/journaling/fbintf/client/FBEvents.pas (file contents), Revision 362 by tony, Tue Dec 7 13:27:39 2021 UTC vs.
ibx/branches/udr/client/FBEvents.pas (file contents), Revision 381 by tony, Sat Jan 15 00:06:22 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	+	{calculate length of event parameter block, setting initial length to include version
225	+	and counts for each argument}
226	+
227	+	if FEventBuffer <> nil then FreeAndNil(FEventBuffer);
228	+	if FResultBuffer <> nil then FreeAndNil(FResultBuffer);
229	+
230	+	FEventBufferLen := 1;
231	+	for i := 0 to FEvents.Count - 1 do
232	+	begin
233	+	s := FEvents[i];
234	+	FEventBufferLen := FEventBufferLen + length(s) + 1 + sizeof(Long);
235	+	end;
236	+
237		with FFirebirdClientAPI do
238		begin
239	<	if FEventBuffer <> nil then
240	<	isc_free( FEventBuffer);
241	<	FEventBuffer := nil;
242	<	if FResultBuffer <> nil then
243	<	isc_free( FResultBuffer);
244	<	FResultBuffer := nil;
239	>	IBAlloc(FEventBuffer,0,FEventBufferLen);
240	>	if FEventBuffer = nil then Exit;
241	>	FillChar(FEventBuffer^,FEventBufferLen,0);
242	>	IBAlloc(FResultBuffer,0,FEventBufferLen);
243	>	if FResultBuffer = nil then
244	>	begin
245	>	FreeAndNil(FEventBuffer);
246	>	Exit;
247	>	end;
248	>	FillChar(FResultBuffer^,FEventBufferLen,0);
249
250	<	setlength(EventNames,MaxEvents);
251	<	try
252	<	for i := 0 to FEvents.Count-1 do
253	<	begin
142	<	EventName := FEvents[i];
143	<	EventNames[i] := PAnsiChar(EventName);
144	<	end;
250	>	P := FEventBuffer;
251	>	P^ := EPB_version1;
252	>	Inc(P);
253	>	SetLength(FEventCounts,FEvents.Count);
254
255	<	FEventBufferlen := isc_event_block(@FEventBuffer,@FResultBuffer,
256	<	FEvents.Count,
257	<	EventNames[0],EventNames[1],EventNames[2],
258	<	EventNames[3],EventNames[4],EventNames[5],
259	<	EventNames[6],EventNames[7],EventNames[8],
260	<	EventNames[9],EventNames[10],EventNames[11],
261	<	EventNames[12],EventNames[13],EventNames[14]
262	<	);
154	<	finally
155	<	SetLength(EventNames,0)
255	>	for i := 0 to FEvents.Count - 1 do
256	>	begin
257	>	s := FEvents[i];
258	>	P^ := Length(s);
259	>	Inc(P);
260	>	Move(s[1],P^,Length(s));
261	>	Inc(P,Length(s)+sizeof(Long));
262	>	FEventCounts[i].EventName := s;
263		end;
264		end;
265	+
266	+	{  for i := 0 to FEventBufferLen - 1 do
267	+	write(Format('%x ', [FEventBuffer[i]]));
268	+	writeln; }
269		end;
270
271		procedure TFBEvents.CancelEvents(Force: boolean);
#	Line 169 | Line 280 | begin
280		FCriticalSection.Enter;
281		try
282		if not FInWaitState then Exit;
283	<	FInWaitState := false;
173	<	ProcessEventCounts;
174	<	if assigned(FEventHandler)  then
283	>	if ProcessEventCounts and assigned(FEventHandler)  then
284		begin
285		Handler := FEventHandler;
286		FEventHandler := nil;
287	+	FInWaitState := false;
288		end;
289		finally
290		FCriticalSection.Leave;
#	Line 183 | Line 293 | begin
293		Handler(GetIEvents);
294		end;
295
296	<	procedure TFBEvents.ProcessEventCounts;
297	<	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);
296	>	(*
297	>	Original Firebird 'C' code for isc_event_counts
298
299	+	void API_ROUTINE isc_event_counts(ULONG* result_vector,
300	+	SSHORT buffer_length,
301	+	UCHAR* event_buffer,
302	+	const UCHAR* result_buffer)
303	+	{
304	+	/**************************************
305	+	*
306	+	*      g d s _ $ e v e n t _ c o u n t s
307	+	*
308	+	**************************************
309	+	*
310	+	* Functional description
311	+	*      Get the delta between two events in an event
312	+	*      parameter block.  Used to update gds_events
313	+	*      for GPRE support of events.
314	+	*
315	+	**************************************/
316	+	ULONG* vec = result_vector;
317	+	const UCHAR* p = event_buffer;
318	+	const UCHAR* q = result_buffer;
319	+	USHORT length = buffer_length;
320	+	const UCHAR* const end = p + length;
321	+
322	+	// analyze the event blocks, getting the delta for each event
323	+
324	+	p++;
325	+	q++;
326	+	while (p < end)
327	+	{
328	+	// skip over the event name
329	+
330	+	const USHORT i = (USHORT)* p++;
331	+	p += i;
332	+	q += i + 1;
333	+
334	+	// get the change in count
335	+
336	+	const ULONG initial_count = gds__vax_integer(p, sizeof(SLONG));
337	+	p += sizeof(SLONG);
338	+	const ULONG new_count = gds__vax_integer(q, sizeof(SLONG));
339	+	q += sizeof(SLONG);
340	+	*vec++ = new_count - initial_count;
341	+	}
342	+
343	+	// copy over the result to the initial block to prepare
344	+	// for the next call to gds__event_wait
345	+
346	+	memcpy(event_buffer, result_buffer, length);
347	+	}
348	+	*)
349	+
350	+	{ProcessEventCounts effectively replaces isc_event_counts}
351	+
352	+	function TFBEvents.ProcessEventCounts: boolean;
353	+
354	+	var i: integer;
355	+	P, Q: PByte;
356	+	initial_count: Long;
357	+	new_count: Long;
358	+	len: byte;
359	+	begin
360	+	Result := false;
361	+	P := FEventBuffer;
362	+	Q := FResultBuffer;
363	+	Inc(P); {skip past version byte}
364	+	Inc(Q);
365	+	for i := 0 to Length(FEventCounts) - 1 do
366		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
367		begin
368	<	if EventCountList[i] <> 0 then
369	<	begin
370	<	Inc(j);
371	<	SetLength(FEventCounts,j);
372	<	FEventCounts[j-1].EventName := FEvents[i];
373	<	FEventCounts[j-1].Count := P^;
374	<	Inc(P);
375	<	//      writeln('Event: ',FEventCounts[j-1].EventName,' Count = ',FEventCounts[j-1].Count);
376	<	end;
368	>	{skip over the event name}
369	>	len := P^;
370	>	P := P + len + 1;
371	>	Q := Q + len + 1; {event name length in P^}
372	>	initial_count := DecodeInteger(P,sizeof(Long));
373	>	Inc(P,sizeof(Long));
374	>	new_count := DecodeInteger(Q,sizeof(Long));
375	>	Inc(Q,sizeof(Long));
376	>	FEventCounts[i].Count := new_count - initial_count;
377	>	if FEventCounts[i].Count > 0 then
378	>	Result := true;
379	>	//  writeln('Event Count[',i,'] = ',FEventCounts[i].Count);
380		end;
381	+	Move(FResultBuffer^,FEventBuffer^,FEventBufferLen);
382		end;
383
384		constructor TFBEvents.Create(DBAttachment: IAttachment;
#	Line 234 | Line 403 | begin
403		with FFirebirdClientAPI do
404		begin
405		if FEventBuffer <> nil then
406	<	isc_free( FEventBuffer);
406	>	FreeMem( FEventBuffer);
407		if FResultBuffer <> nil then
408	<	isc_free( FResultBuffer);
408	>	FreeMem( FResultBuffer);
409		end;
410		inherited Destroy;
411		end;
#	Line 247 | Line 416 | begin
416		end;
417
418		procedure TFBEvents.SetEvents(EventNames: TStrings);
419	+	var i: integer;
420		begin
421		{$ifdef Unix}
422		if (EventNames.Count > 0) and not IsMultiThread then
#	Line 255 | Line 425 | begin
425		if EventNames.Text <> FEvents.Text then
426		begin
427		Cancel;
428	<	FEvents.Assign(EventNames);
428	>	for i := 0 to EventNames.Count - 1 do
429	>	FEvents[i] := Trim(EventNames[i]);
430		CreateEventBlock;
431		end;
432		end;
433
434	<	procedure TFBEvents.SetEvents(Event: AnsiString);
434	>	procedure TFBEvents.SetEvents(Event: string);
435		var S: TStringList;
436		begin
437		S := TStringList.Create;

Comparing:
ibx/branches/journaling/fbintf/client/FBEvents.pas (property svn:eol-style), Revision 362 by tony, Tue Dec 7 13:27:39 2021 UTC vs.
ibx/branches/udr/client/FBEvents.pas (property svn:eol-style), Revision 381 by tony, Sat Jan 15 00:06:22 2022 UTC

#	Line 0 | Line 1
1	+	native

Diff Legend

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