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/branches/udr/client/FBEvents.pas (file contents):
Revision 370 by tony, Wed Jan 5 14:59:15 2022 UTC vs.
Revision 375 by tony, Sun Jan 9 23:42:58 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;
# Line 97 | 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 120 | 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;
126 <  EventNames: array of PAnsiChar;
127 <  EventName: AnsiString;
219 > var i: integer;
220 >    P: PByte;
221   begin
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 >    FillChar(FEventBuffer^,FEventBufferLen,0);
234 >    IBAlloc(FResultBuffer,0,FEventBufferLen);
235 >    if FResultBuffer = nil then
236 >    begin
237 >      FreeMem(FEventBuffer);
238 >      Exit;
239 >    end;
240 >    FillChar(FResultBuffer^,FEventBufferLen,0);
241  
242 <    setlength(EventNames,MaxEvents);
243 <    try
244 <      for i := 0 to FEvents.Count-1 do
245 <      begin
142 <        EventName := FEvents[i];
143 <        EventNames[i] := PAnsiChar(EventName);
144 <      end;
242 >    P := FEventBuffer;
243 >    P^ := EPB_version1;
244 >    Inc(P);
245 >    SetLength(FEventCounts,FEvents.Count);
246  
247 <      FEventBufferlen := isc_event_block(@FEventBuffer,@FResultBuffer,
248 <                          FEvents.Count,
249 <                          EventNames[0],EventNames[1],EventNames[2],
250 <                          EventNames[3],EventNames[4],EventNames[5],
251 <                          EventNames[6],EventNames[7],EventNames[8],
252 <                          EventNames[9],EventNames[10],EventNames[11],
253 <                          EventNames[12],EventNames[13],EventNames[14]
153 <                          );
154 <    finally
155 <      SetLength(EventNames,0)
247 >    for i := 0 to FEvents.Count - 1 do
248 >    begin
249 >      P^ := Length(FEvents[i]);
250 >      Inc(P);
251 >      Move(FEvents[i][1],P^,Length(FEvents[i]));
252 >      Inc(P,Length(FEvents[i])+sizeof(Long));
253 >      FEventCounts[i].EventName := FEvents[i];
254      end;
255    end;
256 +
257 + {  for i := 0 to FEventBufferLen - 1 do
258 +  write(Format('%x ', [FEventBuffer[i]]));
259 +   writeln;}
260   end;
261  
262   procedure TFBEvents.CancelEvents(Force: boolean);
# Line 183 | Line 285 | begin
285      Handler(GetIEvents);
286   end;
287  
288 < procedure TFBEvents.ProcessEventCounts;
289 < var P: PISC_LONG;
290 <    EventCountList: array[0..19] of ISC_LONG;
291 <    i: integer;
292 <    j: integer;
293 < begin
294 <  SetLength(FEventCounts,0);
295 <  if FResultBuffer = nil then Exit;
288 > (*
289 >  Original Firebird 'C' code for isc_event_counts
290 >
291 > void API_ROUTINE isc_event_counts(ULONG* result_vector,
292 >                                                                  SSHORT buffer_length,
293 >                                                                  UCHAR* event_buffer,
294 >                                                                  const UCHAR* result_buffer)
295 > {
296 > /**************************************
297 > *
298 > *      g d s _ $ e v e n t _ c o u n t s
299 > *
300 > **************************************
301 > *
302 > * Functional description
303 > *      Get the delta between two events in an event
304 > *      parameter block.  Used to update gds_events
305 > *      for GPRE support of events.
306 > *
307 > **************************************/
308 >        ULONG* vec = result_vector;
309 >        const UCHAR* p = event_buffer;
310 >        const UCHAR* q = result_buffer;
311 >        USHORT length = buffer_length;
312 >        const UCHAR* const end = p + length;
313 >
314 >        // analyze the event blocks, getting the delta for each event
315 >
316 >        p++;
317 >        q++;
318 >        while (p < end)
319 >        {
320 >                // skip over the event name
321 >
322 >                const USHORT i = (USHORT)* p++;
323 >                p += i;
324 >                q += i + 1;
325 >
326 >                // get the change in count
327 >
328 >                const ULONG initial_count = gds__vax_integer(p, sizeof(SLONG));
329 >                p += sizeof(SLONG);
330 >                const ULONG new_count = gds__vax_integer(q, sizeof(SLONG));
331 >                q += sizeof(SLONG);
332 >                *vec++ = new_count - initial_count;
333 >        }
334 >
335 >        // copy over the result to the initial block to prepare
336 >        // for the next call to gds__event_wait
337 >
338 >        memcpy(event_buffer, result_buffer, length);
339 > }
340 > *)
341  
342 <  FillChar(EventCountList,sizeof(EventCountList),0);
342 > {ProcessEventCounts effectively replaces isc_event_counts}
343  
344 + procedure TFBEvents.ProcessEventCounts;
345 +
346 + var i: integer;
347 +    P, Q: PByte;
348 +    initial_count: Long;
349 +    new_count: Long;
350 +    len: byte;
351 + begin
352 +  P := FEventBuffer;
353 +  Q := FResultBuffer;
354 +  Inc(P); {skip past version byte}
355 +  Inc(Q);
356 +  for i := 0 to Length(FEventCounts) - 1 do
357    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
358    begin
359 <    if EventCountList[i] <> 0 then
360 <    begin
361 <      Inc(j);
362 <      SetLength(FEventCounts,j);
363 <      FEventCounts[j-1].EventName := FEvents[i];
364 <      FEventCounts[j-1].Count := P^;
365 <      Inc(P);
366 < //      writeln('Event: ',FEventCounts[j-1].EventName,' Count = ',FEventCounts[j-1].Count);
367 <    end;
359 >    {skip over the event name}
360 >    len := P^;
361 >    P := P + len + 1;
362 >    Q := Q + len + 1; {event name length in P^}
363 >    initial_count := DecodeInteger(P,sizeof(Long));
364 >    Inc(P,sizeof(Long));
365 >    new_count := DecodeInteger(Q,sizeof(Long));
366 >    Inc(Q,sizeof(Long));
367 >    FEventCounts[i].Count := new_count - initial_count;
368    end;
369 +  Move(FResultBuffer^,FEventBuffer^,FEventBufferLen);
370   end;
371  
372   constructor TFBEvents.Create(DBAttachment: IAttachment;
# Line 234 | Line 391 | begin
391    with FFirebirdClientAPI do
392    begin
393      if FEventBuffer <> nil then
394 <      isc_free( FEventBuffer);
394 >      FreeMem( FEventBuffer);
395      if FResultBuffer <> nil then
396 <      isc_free( FResultBuffer);
396 >      FreeMem( FResultBuffer);
397    end;
398    inherited Destroy;
399   end;
# Line 247 | Line 404 | begin
404   end;
405  
406   procedure TFBEvents.SetEvents(EventNames: TStrings);
407 + var i: integer;
408   begin
409    {$ifdef Unix}
410    if (EventNames.Count > 0) and not IsMultiThread then
# Line 255 | Line 413 | begin
413    if EventNames.Text <> FEvents.Text then
414    begin
415      Cancel;
416 <    FEvents.Assign(EventNames);
416 >    for i := 0 to EventNames.Count - 1 do
417 >      FEvents[i] := Trim(EventNames[i]);
418      CreateEventBlock;
419    end;
420   end;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines