ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/FBEvents.pas
(Generate patch)

Comparing:
ibx/trunk/fbintf/client/FBEvents.pas (file contents), Revision 56 by tony, Mon Mar 6 10:20:02 2017 UTC vs.
ibx/branches/udr/client/FBEvents.pas (file contents), Revision 371 by tony, Wed Jan 5 15:21:22 2022 UTC

# 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;
97      FAttachment: IAttachment;
98      FEventCounts: TEventCounts;
99 +    FFirebirdClientAPI: TFBClientAPI;
100    protected
101      FEventBuffer: PByte;
102      FEventBufferLen: integer;
# Line 96 | Line 110 | type
110      function GetIEvents: IEvents; virtual; abstract;
111      procedure ProcessEventCounts;
112    public
113 +    const EPB_version1 = 1;
114 +  public
115      constructor Create(DBAttachment: IAttachment; aMonitor: IActivityMonitor; Events: TStrings);
116      destructor Destroy; override;
117  
# Line 119 | Line 135 | const
135  
136   { TFBEvents }
137  
138 + (* Original Firebird 'C' code
139 +
140 + SLONG API_ROUTINE_VARARG isc_event_block(UCHAR** event_buffer,
141 +  UCHAR** result_buffer,
142 +  USHORT count, ...)
143 + {
144 + /**************************************
145 + *
146 + *      i s c _ e v e n t _ b l o c k
147 + *
148 + **************************************
149 + *
150 + * Functional description
151 + *      Create an initialized event parameter block from a
152 + *      variable number of input arguments.
153 + *      Return the size of the block.
154 + *
155 + *      Return 0 if any error occurs.
156 + *
157 + **************************************/
158 +        va_list ptr;
159 +
160 +        va_start(ptr, count);
161 +
162 +        // calculate length of event parameter block, setting initial length to include version
163 +        // and counts for each argument
164 +
165 +        SLONG length = 1;
166 +        USHORT i = count;
167 +        while (i--)
168 +        {
169 +                const char* q = va_arg(ptr, SCHAR * );
170 +                length += static_cast<SLONG>(strlen(q)) + 5;
171 +        }
172 +        va_end(ptr);
173 +
174 +        UCHAR* p = *event_buffer = (UCHAR * ) gds__alloc((SLONG) length);
175 +        // FREE: apparently never freed
176 +        if (!*event_buffer)                     // NOMEM:
177 +                return 0;
178 +        if ((*result_buffer = (UCHAR * ) gds__alloc((SLONG) length)) == NULL)
179 +        {
180 +                // NOMEM:
181 +                // FREE: apparently never freed
182 +                gds__free(*event_buffer);
183 +                *event_buffer = NULL;
184 +                return 0;
185 +        }
186 +
187 +        // initialize the block with event names and counts
188 +
189 +        *p++ = EPB_version1;
190 +
191 +        va_start(ptr, count);
192 +
193 +        i = count;
194 +        while (i--)
195 +        {
196 +                const char* q = va_arg(ptr, SCHAR * );
197 +
198 +                // Strip the blanks from the ends
199 +                const char* end = q + strlen(q);
200 +                while (--end >= q && *end == ' ')
201 +                        ;
202 +                *p++ = end - q + 1;
203 +                while (q <= end)
204 +                        *p++ = *q++;
205 +                *p++ = 0;
206 +                *p++ = 0;
207 +                *p++ = 0;
208 +                *p++ = 0;
209 +        }
210 +        va_end(ptr);
211 +
212 +        return static_cast<SLONG>(p - *event_buffer);
213 + }
214 + *)
215 +
216 + {CreateEventBlock effectively replaces isc_event_block}
217 +
218   procedure TFBEvents.CreateEventBlock;
219 < var
220 <  i: integer;
125 <  EventNames: array of PAnsiChar;
126 <  EventName: AnsiString;
219 > var i: integer;
220 >    P: PByte;
221   begin
222 <  with FirebirdClientAPI do
222 >  {calculate length of event parameter block, setting initial length to include version
223 >   and counts for each argument}
224 >
225 >  FEventBufferLen := 1;
226 >  for i := 0 to FEvents.Count - 1 do
227 >    FEventBufferLen := FEventBufferLen + length(FEvents[i]) + 1 + sizeof(Long);
228 >
229 >  with FFirebirdClientAPI do
230    begin
231 <    if FEventBuffer <> nil then
232 <      isc_free( FEventBuffer);
233 <    FEventBuffer := nil;
234 <    if FResultBuffer <> nil then
235 <      isc_free( FResultBuffer);
236 <    FResultBuffer := nil;
231 >    IBAlloc(FEventBuffer,0,FEventBufferLen);
232 >    if FEventBuffer = nil then Exit;
233 >    {$if declared(FillByte)}
234 >    FillByte(FEventBuffer^,FEventBufferLen,0);
235 >    {$else}
236 >    FillChar(FEventBuffer^,FEventBufferLen,0);
237 >    {$ifend}
238 >    IBAlloc(FResultBuffer,0,FEventBufferLen);
239 >    if FResultBuffer = nil then
240 >    begin
241 >      FreeMem(FEventBuffer);
242 >      Exit;
243 >    end;
244  
245 <    setlength(EventNames,MaxEvents);
246 <    try
247 <      for i := 0 to FEvents.Count-1 do
248 <      begin
141 <        EventName := FEvents[i];
142 <        EventNames[i] := PAnsiChar(EventName);
143 <      end;
245 >    P := FEventBuffer;
246 >    P^ := EPB_version1;
247 >    Inc(P);
248 >    SetLength(FEventCounts,FEvents.Count);
249  
250 <      FEventBufferlen := isc_event_block(@FEventBuffer,@FResultBuffer,
251 <                          FEvents.Count,
252 <                          EventNames[0],EventNames[1],EventNames[2],
253 <                          EventNames[3],EventNames[4],EventNames[5],
254 <                          EventNames[6],EventNames[7],EventNames[8],
255 <                          EventNames[9],EventNames[10],EventNames[11],
256 <                          EventNames[12],EventNames[13],EventNames[14]
152 <                          );
153 <    finally
154 <      SetLength(EventNames,0)
250 >    for i := 0 to FEvents.Count - 1 do
251 >    begin
252 >      P^ := Length(FEvents[i]);
253 >      Inc(P);
254 >      Move(FEvents[i][1],P^,Length(FEvents[i]));
255 >      Inc(P,Length(FEvents[i])+sizeof(Long));
256 >      FEventCounts[i].EventName := FEvents[i];
257      end;
258    end;
259 +
260 + {  for i := 0 to FEventBufferLen - 1 do
261 +  write(Format('%x ', [FEventBuffer[i]]));
262 +   writeln;}
263   end;
264  
265   procedure TFBEvents.CancelEvents(Force: boolean);
# Line 182 | Line 288 | begin
288      Handler(GetIEvents);
289   end;
290  
291 + (*
292 +  Original Firebird 'C' code for isc_event_counts
293 +
294 + void API_ROUTINE isc_event_counts(ULONG* result_vector,
295 +                                                                  SSHORT buffer_length,
296 +                                                                  UCHAR* event_buffer,
297 +                                                                  const UCHAR* result_buffer)
298 + {
299 + /**************************************
300 + *
301 + *      g d s _ $ e v e n t _ c o u n t s
302 + *
303 + **************************************
304 + *
305 + * Functional description
306 + *      Get the delta between two events in an event
307 + *      parameter block.  Used to update gds_events
308 + *      for GPRE support of events.
309 + *
310 + **************************************/
311 +        ULONG* vec = result_vector;
312 +        const UCHAR* p = event_buffer;
313 +        const UCHAR* q = result_buffer;
314 +        USHORT length = buffer_length;
315 +        const UCHAR* const end = p + length;
316 +
317 +        // analyze the event blocks, getting the delta for each event
318 +
319 +        p++;
320 +        q++;
321 +        while (p < end)
322 +        {
323 +                // skip over the event name
324 +
325 +                const USHORT i = (USHORT)* p++;
326 +                p += i;
327 +                q += i + 1;
328 +
329 +                // get the change in count
330 +
331 +                const ULONG initial_count = gds__vax_integer(p, sizeof(SLONG));
332 +                p += sizeof(SLONG);
333 +                const ULONG new_count = gds__vax_integer(q, sizeof(SLONG));
334 +                q += sizeof(SLONG);
335 +                *vec++ = new_count - initial_count;
336 +        }
337 +
338 +        // copy over the result to the initial block to prepare
339 +        // for the next call to gds__event_wait
340 +
341 +        memcpy(event_buffer, result_buffer, length);
342 + }
343 + *)
344 +
345 + {ProcessEventCounts effectively replaces isc_event_counts}
346 +
347   procedure TFBEvents.ProcessEventCounts;
348 < var P: PISC_LONG;
349 <    EventCountList: array[0..19] of ISC_LONG;
350 <    i: integer;
351 <    j: integer;
352 < begin
353 <  SetLength(FEventCounts,0);
354 <  if FResultBuffer = nil then Exit;
355 <
356 <  FillChar(EventCountList,sizeof(EventCountList),0);
357 <
358 <  with FirebirdClientAPI do
359 <     isc_event_counts( @EventCountList, FEventBufferLen, FEventBuffer, FResultBuffer);
360 <  j := 0;
199 <  P := @EventCountList;
200 <  for i := 0 to FEvents.Count - 1 do
348 >
349 > var i: integer;
350 >    P, Q: PByte;
351 >    initial_count: Long;
352 >    new_count: Long;
353 >    len: byte;
354 > begin
355 >  P := FEventBuffer;
356 >  Q := FResultBuffer;
357 >  Inc(P); {skip past version byte}
358 >  Inc(Q);
359 >  for i := 0 to Length(FEventCounts) - 1 do
360 >  with FFirebirdClientAPI do
361    begin
362 <    if EventCountList[i] <> 0 then
363 <    begin
364 <      Inc(j);
365 <      SetLength(FEventCounts,j);
366 <      FEventCounts[j-1].EventName := FEvents[i];
367 <      FEventCounts[j-1].Count := P^;
368 <      Inc(P);
369 < //      writeln('Event: ',FEventCounts[j-1].EventName,' Count = ',FEventCounts[j-1].Count);
370 <    end;
362 >    {skip over the event name}
363 >    len := P^;
364 >    P := P + len + 1;
365 >    Q := Q + len + 1; {event name length in P^}
366 >    initial_count := DecodeInteger(P,sizeof(Long));
367 >    Inc(P,sizeof(Long));
368 >    new_count := DecodeInteger(Q,sizeof(Long));
369 >    Inc(Q,sizeof(Long));
370 >    FEventCounts[i].Count := new_count - initial_count;
371    end;
372 +  Move(FResultBuffer^,FEventBuffer^,FEventBufferLen);
373   end;
374  
375   constructor TFBEvents.Create(DBAttachment: IAttachment;
# Line 216 | Line 377 | constructor TFBEvents.Create(DBAttachmen
377   begin
378    inherited Create(aMonitor);
379    FAttachment := DBAttachment;
380 +  FFirebirdClientAPI := DBAttachment.getFirebirdAPI as TFBClientAPI;
381    if Events.Count > MaxEvents then
382      IBError(ibxeMaximumEvents, [nil]);
383  
# Line 229 | Line 391 | destructor TFBEvents.Destroy;
391   begin
392    if assigned(FCriticalSection) then FCriticalSection.Free;
393    if assigned(FEvents) then FEvents.Free;
394 <  with FirebirdClientAPI do
394 >  with FFirebirdClientAPI do
395    begin
396      if FEventBuffer <> nil then
397 <      isc_free( FEventBuffer);
397 >      FreeMem( FEventBuffer);
398      if FResultBuffer <> nil then
399 <      isc_free( FResultBuffer);
399 >      FreeMem( FResultBuffer);
400    end;
401    inherited Destroy;
402   end;
# Line 245 | Line 407 | begin
407   end;
408  
409   procedure TFBEvents.SetEvents(EventNames: TStrings);
410 + var i: integer;
411   begin
412 +  {$ifdef Unix}
413 +  if (EventNames.Count > 0) and not IsMultiThread then
414 +    IBError(ibxeMultiThreadRequired,['Firebird Events Handling']);
415 +  {$endif}
416    if EventNames.Text <> FEvents.Text then
417    begin
418      Cancel;
419 <    FEvents.Assign(EventNames);
419 >    for i := 0 to EventNames.Count - 1 do
420 >      FEvents[i] := Trim(EventNames[i]);
421      CreateEventBlock;
422    end;
423   end;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines