ViewVC Help

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

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

Comparing ibx/trunk/fbintf/client/FBEvents.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 217 by tony, Fri Mar 16 10:27:26 2018 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 204 | Line 246 | end;
246
247		procedure TFBEvents.SetEvents(EventNames: TStrings);
248		begin
249	+	if (EventNames.Count > 0) and not IsMultiThread then
250	+	IBError(ibxMultiThreadRequired,['Firebird Events Handling']);
251		if EventNames.Text <> FEvents.Text then
252		begin
253		Cancel;
#	Line 212 | Line 256 | begin
256		end;
257		end;
258
259	<	procedure TFBEvents.SetEvents(Event: string);
259	>	procedure TFBEvents.SetEvents(Event: AnsiString);
260		var S: TStringList;
261		begin
262		S := TStringList.Create;
#	Line 231 | Line 275 | begin
275		end;
276
277		function TFBEvents.ExtractEventCounts: TEventCounts;
234	–	var EventCountList, P: PISC_LONG;
235	–	i: integer;
236	–	j: integer;
278		begin
279	<	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;
279	>	Result := FEventCounts;
280		end;
281
282		function TFBEvents.GetAttachment: IAttachment;

Diff Legend

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