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.
Revision 56 by tony, Mon Mar 6 10:20:02 2017 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    protected
87 <    FEventBuffer: PChar;
87 >    FEventBuffer: PByte;
88      FEventBufferLen: integer;
89 <    FResultBuffer: PChar;
89 >    FResultBuffer: PByte;
90      FEventHandler: TEventHandler;
91      FCriticalSection: TCriticalSection;
92      FInWaitState: boolean;
# Line 90 | Line 94 | type
94      procedure CancelEvents(Force: boolean = false); virtual;
95      procedure EventSignaled;
96      function GetIEvents: IEvents; virtual; abstract;
97 +    procedure ProcessEventCounts;
98    public
99      constructor Create(DBAttachment: IAttachment; aMonitor: IActivityMonitor; Events: TStrings);
100      destructor Destroy; override;
# Line 97 | Line 102 | type
102      {IEvents}
103      procedure GetEvents(EventNames: TStrings);
104      procedure SetEvents(EventNames: TStrings); overload;
105 <    procedure SetEvents(Event: string); overload;
105 >    procedure SetEvents(Event: AnsiString); overload;
106      procedure Cancel;
107      function ExtractEventCounts: TEventCounts;
108      function GetAttachment: IAttachment;
109 +    procedure AsyncWaitForEvent(EventHandler: TEventHandler); virtual; abstract;
110    end;
111  
112  
# Line 116 | Line 122 | const
122   procedure TFBEvents.CreateEventBlock;
123   var
124    i: integer;
125 <  EventNames: array of PChar;
125 >  EventNames: array of PAnsiChar;
126 >  EventName: AnsiString;
127   begin
128    with FirebirdClientAPI do
129    begin
# Line 130 | Line 137 | begin
137      setlength(EventNames,MaxEvents);
138      try
139        for i := 0 to FEvents.Count-1 do
140 <        EventNames[i] := PChar(FEvents[i]);
140 >      begin
141 >        EventName := FEvents[i];
142 >        EventNames[i] := PAnsiChar(EventName);
143 >      end;
144  
145        FEventBufferlen := isc_event_block(@FEventBuffer,@FResultBuffer,
146                            FEvents.Count,
# Line 154 | Line 164 | end;
164   procedure TFBEvents.EventSignaled;
165   var Handler: TEventHandler;
166   begin
167 +  Handler := nil;
168    FCriticalSection.Enter;
169    try
170      if not FInWaitState then Exit;
171      FInWaitState := false;
172 +    ProcessEventCounts;
173      if assigned(FEventHandler)  then
174      begin
175        Handler := FEventHandler;
176        FEventHandler := nil;
177      end;
178    finally
179 <    FCriticalSection.Leave
179 >    FCriticalSection.Leave;
180 >  end;
181 >  if assigned(Handler) then
182 >    Handler(GetIEvents);
183 > end;
184 >
185 > procedure TFBEvents.ProcessEventCounts;
186 > var P: PISC_LONG;
187 >    EventCountList: array[0..19] of ISC_LONG;
188 >    i: integer;
189 >    j: integer;
190 > begin
191 >  SetLength(FEventCounts,0);
192 >  if FResultBuffer = nil then Exit;
193 >
194 >  FillChar(EventCountList,sizeof(EventCountList),0);
195 >
196 >  with FirebirdClientAPI do
197 >     isc_event_counts( @EventCountList, FEventBufferLen, FEventBuffer, FResultBuffer);
198 >  j := 0;
199 >  P := @EventCountList;
200 >  for i := 0 to FEvents.Count - 1 do
201 >  begin
202 >    if EventCountList[i] <> 0 then
203 >    begin
204 >      Inc(j);
205 >      SetLength(FEventCounts,j);
206 >      FEventCounts[j-1].EventName := FEvents[i];
207 >      FEventCounts[j-1].Count := P^;
208 >      Inc(P);
209 > //      writeln('Event: ',FEventCounts[j-1].EventName,' Count = ',FEventCounts[j-1].Count);
210 >    end;
211    end;
169  Handler(GetIEvents);
212   end;
213  
214   constructor TFBEvents.Create(DBAttachment: IAttachment;
# Line 212 | Line 254 | begin
254    end;
255   end;
256  
257 < procedure TFBEvents.SetEvents(Event: string);
257 > procedure TFBEvents.SetEvents(Event: AnsiString);
258   var S: TStringList;
259   begin
260    S := TStringList.Create;
# Line 231 | Line 273 | begin
273   end;
274  
275   function TFBEvents.ExtractEventCounts: TEventCounts;
234 var EventCountList, P: PISC_LONG;
235    i: integer;
236    j: integer;
276   begin
277 <  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;
277 >  Result := FEventCounts;
278   end;
279  
280   function TFBEvents.GetAttachment: IAttachment;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines