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 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
ibx/branches/udr/client/FBEvents.pas (file contents), Revision 370 by tony, Wed Jan 5 14:59:15 2022 UTC

# Line 60 | Line 60
60   {                                                                        }
61   {************************************************************************}
62   unit FBEvents;
63 + {$IFDEF MSWINDOWS}
64 + {$DEFINE WINDOWS}
65 + {$ENDIF}
66  
67   {$IFDEF FPC}
68 < {$mode objfpc}{$H+}
68 > {$mode delphi}
69   {$interfaces COM}
70   {$ENDIF}
71  
# Line 79 | Line 82 | type
82    private
83      FEvents: TStringList;
84      FAttachment: IAttachment;
85 +    FEventCounts: TEventCounts;
86 +    FFirebirdClientAPI: TFBClientAPI;
87    protected
88 <    FEventBuffer: PChar;
88 >    FEventBuffer: PByte;
89      FEventBufferLen: integer;
90 <    FResultBuffer: PChar;
90 >    FResultBuffer: PByte;
91      FEventHandler: TEventHandler;
92      FCriticalSection: TCriticalSection;
93      FInWaitState: boolean;
# Line 90 | Line 95 | type
95      procedure CancelEvents(Force: boolean = false); virtual;
96      procedure EventSignaled;
97      function GetIEvents: IEvents; virtual; abstract;
98 +    procedure ProcessEventCounts;
99    public
100      constructor Create(DBAttachment: IAttachment; aMonitor: IActivityMonitor; Events: TStrings);
101      destructor Destroy; override;
# Line 97 | Line 103 | type
103      {IEvents}
104      procedure GetEvents(EventNames: TStrings);
105      procedure SetEvents(EventNames: TStrings); overload;
106 <    procedure SetEvents(Event: string); overload;
106 >    procedure SetEvents(Event: AnsiString); overload;
107      procedure Cancel;
108      function ExtractEventCounts: TEventCounts;
109      function GetAttachment: IAttachment;
110 +    procedure AsyncWaitForEvent(EventHandler: TEventHandler); virtual; abstract;
111    end;
112  
113  
# Line 116 | Line 123 | const
123   procedure TFBEvents.CreateEventBlock;
124   var
125    i: integer;
126 <  EventNames: array of PChar;
126 >  EventNames: array of PAnsiChar;
127 >  EventName: AnsiString;
128   begin
129 <  with FirebirdClientAPI do
129 >  with FFirebirdClientAPI do
130    begin
131      if FEventBuffer <> nil then
132        isc_free( FEventBuffer);
# Line 130 | Line 138 | begin
138      setlength(EventNames,MaxEvents);
139      try
140        for i := 0 to FEvents.Count-1 do
141 <        EventNames[i] := PChar(FEvents[i]);
141 >      begin
142 >        EventName := FEvents[i];
143 >        EventNames[i] := PAnsiChar(EventName);
144 >      end;
145  
146        FEventBufferlen := isc_event_block(@FEventBuffer,@FResultBuffer,
147                            FEvents.Count,
# Line 154 | Line 165 | end;
165   procedure TFBEvents.EventSignaled;
166   var Handler: TEventHandler;
167   begin
168 +  Handler := nil;
169    FCriticalSection.Enter;
170    try
171      if not FInWaitState then Exit;
172      FInWaitState := false;
173 +    ProcessEventCounts;
174      if assigned(FEventHandler)  then
175      begin
176        Handler := FEventHandler;
177        FEventHandler := nil;
178      end;
179    finally
180 <    FCriticalSection.Leave
180 >    FCriticalSection.Leave;
181 >  end;
182 >  if assigned(Handler) then
183 >    Handler(GetIEvents);
184 > end;
185 >
186 > procedure TFBEvents.ProcessEventCounts;
187 > 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);
196 >
197 >  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
202 >  begin
203 >    if EventCountList[i] <> 0 then
204 >    begin
205 >      Inc(j);
206 >      SetLength(FEventCounts,j);
207 >      FEventCounts[j-1].EventName := FEvents[i];
208 >      FEventCounts[j-1].Count := P^;
209 >      Inc(P);
210 > //      writeln('Event: ',FEventCounts[j-1].EventName,' Count = ',FEventCounts[j-1].Count);
211 >    end;
212    end;
169 –  Handler(GetIEvents);
213   end;
214  
215   constructor TFBEvents.Create(DBAttachment: IAttachment;
# Line 174 | Line 217 | constructor TFBEvents.Create(DBAttachmen
217   begin
218    inherited Create(aMonitor);
219    FAttachment := DBAttachment;
220 +  FFirebirdClientAPI := DBAttachment.getFirebirdAPI as TFBClientAPI;
221    if Events.Count > MaxEvents then
222      IBError(ibxeMaximumEvents, [nil]);
223  
# Line 187 | Line 231 | destructor TFBEvents.Destroy;
231   begin
232    if assigned(FCriticalSection) then FCriticalSection.Free;
233    if assigned(FEvents) then FEvents.Free;
234 <  with FirebirdClientAPI do
234 >  with FFirebirdClientAPI do
235    begin
236      if FEventBuffer <> nil then
237        isc_free( FEventBuffer);
# Line 204 | Line 248 | end;
248  
249   procedure TFBEvents.SetEvents(EventNames: TStrings);
250   begin
251 +  {$ifdef Unix}
252 +  if (EventNames.Count > 0) and not IsMultiThread then
253 +    IBError(ibxeMultiThreadRequired,['Firebird Events Handling']);
254 +  {$endif}
255    if EventNames.Text <> FEvents.Text then
256    begin
257      Cancel;
# Line 212 | Line 260 | begin
260    end;
261   end;
262  
263 < procedure TFBEvents.SetEvents(Event: string);
263 > procedure TFBEvents.SetEvents(Event: AnsiString);
264   var S: TStringList;
265   begin
266    S := TStringList.Create;
# Line 231 | Line 279 | begin
279   end;
280  
281   function TFBEvents.ExtractEventCounts: TEventCounts;
234 – var EventCountList, P: PISC_LONG;
235 –    i: integer;
236 –    j: integer;
282   begin
283 <  SetLength(Result,0);
239 <  if FResultBuffer = nil then Exit;
240 <
241 <  GetMem(EventCountList,sizeof(ISC_LONG)*FEvents.Count);
242 <  try
243 <    with FirebirdClientAPI do
244 <       isc_event_counts( EventCountList, FEventBufferLen, FEventBuffer, FResultBuffer);
245 <    j := 0;
246 <    P := EventCountList;
247 <    for i := 0 to FEvents.Count - 1 do
248 <    begin
249 <      if EventCountList[i] > 0 then
250 <      begin
251 <        Inc(j);
252 <        SetLength(Result,j);
253 <        Result[j-1].EventName := FEvents[i];
254 <        Result[j-1].Count := P^;
255 <        Inc(P);
256 <      end;
257 <    end;
258 <  finally
259 <    FreeMem(EventCountList);
260 <  end;
283 >  Result := FEventCounts;
284   end;
285  
286   function TFBEvents.GetAttachment: IAttachment;

Diff Legend

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