ViewVC Help

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

root/public/ibx/trunk/fbintf/client/3.0/FB30ClientAPI.pas

Comparing ibx/trunk/fbintf/client/3.0/FB30ClientAPI.pas (file contents):
Revision 344 by tony, Thu Feb 25 12:05:40 2021 UTC vs.
Revision 345 by tony, Mon Aug 23 14:22:29 2021 UTC

#	Line 37 | Line 37 | unit FB30ClientAPI;
37		interface
38
39		uses
40	<	Classes, SysUtils, FBClientAPI, Firebird, IB, IBExternals, FmtBCD, FBClientLib;
40	>	Classes, SysUtils, FBClientAPI, Firebird, IB, IBExternals, FmtBCD, FBClientLib,
41	>	FBActivityMonitor;
42
43		type
44
45		{ TFB30Status }
46
47		TFB30Status = class(TFBStatus,IStatus)
48	<	private
48	>	protected
49		FStatus: Firebird.IStatus;
50	+	FDirty: boolean;
51		public
52	+	destructor Destroy; override;
53		procedure Init;
54	+	procedure FreeHandle;
55		function InErrorState: boolean;
56	+	function Warning: boolean;
57		function GetStatus: Firebird.IStatus;
58		function StatusVector: PStatusVector; override;
59	+	property Dirty: boolean read FDirty;
60		end;
61
62		{ TFB30StatusObject }
63
64		TFB30StatusObject = class(TFB30Status)
65		public
66	<	constructor Create(aOwner: TFBClientAPI; status: Firebird.IStatus);
66	>	constructor Create(aOwner: TFBClientAPI; status: Firebird.IStatus; prefix: Ansistring='');
67		end;
68
69		Tfb_get_master_interface = function: IMaster;
#	Line 77 | Line 83 | type
83		when this class is freed and last reference to IStatus
84		goes out of scope.}
85		procedure CheckPlugins;
80	–	function Firebird4orLater: boolean;
86		public
87		constructor Create(aFBLibrary: TFBLibrary);
88		destructor Destroy; override;
89
90		function StatusIntf: Firebird.IStatus;
91	<	procedure Check4DataBaseError;
91	>	procedure Check4DataBaseError; overload;
92	>	procedure Check4DataBaseError(st: Firebird.IStatus); overload;
93		function InErrorState: boolean;
94		function LoadInterface: boolean; override;
95		procedure FBShutdown; override;
96		function GetAPI: IFirebirdAPI; override;
97	+	function Firebird4orLater: boolean;
98		{$IFDEF UNIX}
99		function GetFirebirdLibList: string; override;
100		{$ENDIF}
#	Line 132 | Line 139 | type
139		function GetIMasterIntf: Firebird.IMaster;
140
141		{Encode/Decode}
135	–	function DecodeInteger(bufptr: PByte; len: short): integer; override;
142		procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); override;
143		function SQLDecodeDate(bufptr: PByte): TDateTime; override;
144		procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); override;
#	Line 140 | Line 146 | type
146		procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); override;
147		function SQLDecodeDateTime(bufptr: PByte): TDateTime; override;
148		function FormatStatus(Status: TFBStatus): AnsiString; override;
149	+	function FormatFBStatus(Status: Firebird.IStatus): AnsiString;
150
151		{Firebird 4 Extensions}
152		procedure SQLDecFloatEncode(aValue: tBCD; SQLType: cardinal; bufptr: PByte);
#	Line 155 | Line 162 | type
162
163		end;
164
165	+	{ TXPBParameterBlock }
166	+
167	+	TXPBParameterBlock = class(TFBInterfacedObject)
168	+	private
169	+	FBuilder: Firebird.IXpbBuilder;
170	+	FFirebird30ClientAPI: TFB30ClientAPI;
171	+	public
172	+	constructor Create(api: TFB30ClientAPI; kind: cardinal);
173	+	destructor Destroy; override;
174	+	function getBuffer: PByte;
175	+	function getDataLength: cardinal;
176	+	procedure insertInt(tag: Byte; value: Integer);
177	+	property Builder: Firebird.IXpbBuilder read FBuilder;
178	+	public
179	+	procedure PrintBuf;
180	+	end;
181	+
182		implementation
183
184		uses FB30Attachment, {$IFDEF FPC}dynlibs{$ELSE} windows{$ENDIF},
#	Line 165 | Line 189 | type
189		PISC_DATE = ^ISC_DATE;
190		PISC_TIME = ^ISC_TIME;
191
192	+	{ TXPBParameterBlock }
193	+
194	+	constructor TXPBParameterBlock.Create(api: TFB30ClientAPI; kind: cardinal);
195	+	begin
196	+	inherited Create;
197	+	FFirebird30ClientAPI := api;
198	+	with FFirebird30ClientAPI do
199	+	begin
200	+	FBuilder := UtilIntf.getXpbBuilder(StatusIntf,kind,nil,0);
201	+	Check4DataBaseError;
202	+	end;
203	+	end;
204	+
205	+	destructor TXPBParameterBlock.Destroy;
206	+	begin
207	+	if FBuilder <> nil then
208	+	begin
209	+	FBuilder.dispose;
210	+	FBuilder := nil;
211	+	end;
212	+	inherited Destroy;
213	+	end;
214	+
215	+	function TXPBParameterBlock.getBuffer: PByte;
216	+	begin
217	+	with FFirebird30ClientAPI do
218	+	begin
219	+	Result := PByte(FBuilder.getBuffer(StatusIntf));
220	+	Check4DataBaseError;
221	+	end;
222	+	end;
223	+
224	+	function TXPBParameterBlock.getDataLength: cardinal;
225	+	begin
226	+	with FFirebird30ClientAPI do
227	+	begin
228	+	Result := FBuilder.getBufferLength(StatusIntf);
229	+	Check4DataBaseError;
230	+	end;
231	+	end;
232	+
233	+	procedure TXPBParameterBlock.insertInt(tag: Byte; value: Integer);
234	+	begin
235	+	with FFirebird30ClientAPI do
236	+	begin
237	+	Builder.insertInt(StatusIntf,tag,value);
238	+	Check4DataBaseError;
239	+	end;
240	+	end;
241	+
242	+	procedure TXPBParameterBlock.PrintBuf;
243	+	var i: integer;
244	+	buffer: PByte;
245	+	begin
246	+	write(ClassName,': (',getDataLength,') ');
247	+	buffer := getBuffer;
248	+	for i := 0 to getDataLength - 1 do
249	+	begin
250	+	write(Format('%x ',[buffer^]));
251	+	Inc(buffer);
252	+	end;
253	+	writeln
254	+	end;
255	+
256		{ TFB30StatusObject }
257
258		constructor TFB30StatusObject.Create(aOwner: TFBClientAPI;
259	<	status: Firebird.IStatus);
259	>	status: Firebird.IStatus; prefix: Ansistring);
260		begin
261	<	inherited Create(aOwner);
261	>	inherited Create(aOwner,prefix);
262		FStatus := status;
263		end;
264
265		{ TFB30Status }
266
267	+	destructor TFB30Status.Destroy;
268	+	begin
269	+	FreeHandle;
270	+	inherited Destroy;
271	+	end;
272	+
273		procedure TFB30Status.Init;
274		begin
275	<	if assigned(FStatus) then
275	>	if assigned(FStatus) and Dirty then
276	>	begin
277		FStatus.Init;
278	+	FDirty := false;
279	+	end;
280	+	end;
281	+
282	+	procedure TFB30Status.FreeHandle;
283	+	begin
284	+	if FStatus <> nil then
285	+	begin
286	+	FStatus.dispose;
287	+	FStatus := nil;
288	+	end;
289		end;
290
291		function TFB30Status.InErrorState: boolean;
292		begin
293		with GetStatus do
294		Result := ((getState and STATE_ERRORS) <> 0);
295	+	if Result then
296	+	FDirty := true;
297	+	end;
298	+
299	+	function TFB30Status.Warning: boolean;
300	+	begin
301	+	with GetStatus do
302	+	Result := ((getState and STATE_WARNINGS) <> 0);
303	+	if Result then
304	+	FDirty := true;
305		end;
306
307		function TFB30Status.GetStatus: Firebird.IStatus;
308		begin
309		if FStatus = nil then
310	<	with FOwner do
311	<	FStatus := (FOwner as TFB30ClientAPI).MasterIntf.GetStatus;
310	>	with FOwner do
311	>	FStatus := (FOwner as TFB30ClientAPI).MasterIntf.GetStatus;
312		Result := FStatus;
313		end;
314
#	Line 229 | Line 345 | end;
345
346		function TFB30ClientAPI.Firebird4orLater: boolean;
347		begin
348	<	Result :=  (GetClientMajor >=4) and (UtilIntf.vtable.version >= 4)
348	>	Result :=  (GetClientMajor > 4) or (
349	>	(GetClientMajor = 4) and (UtilIntf.vtable.version >= 4)
350		and (UtilIntf.vtable.version <> 21) {ignore FB4 Beta1}
351	<	and (UtilIntf.vtable.version <> 24) {ignore FB4 Beta2}
351	>	and (UtilIntf.vtable.version <> 24)) {ignore FB4 Beta2}
352		end;
353
354		{$IFDEF UNIX}
#	Line 260 | Line 377 | end;
377
378		procedure TFB30ClientAPI.FBShutdown;
379		begin
380	<	if assigned(fb_shutdown) and assigned(FProvider) then
380	>	if assigned(fb_shutdown) then
381		begin
382	<	FProvider.release;
383	<	FProvider := nil;
382	>	FStatus.FreeHandle;
383	>	if assigned(FProvider) then
384	>	begin
385	>	FProvider.release;
386	>	FProvider := nil;
387	>	end;
388		end;
389		inherited;
390		end;
#	Line 282 | Line 403 | end;
403
404		destructor TFB30ClientAPI.Destroy;
405		begin
406	+	FStatus.FreeHandle;
407		if assigned(FProvider) then
408		FProvider.release;
409		inherited Destroy;
#	Line 299 | Line 421 | begin
421		IBDataBaseError;
422		end;
423
424	+	procedure TFB30ClientAPI.Check4DataBaseError(st: Firebird.IStatus);
425	+	begin
426	+	if ((st.getState and st.STATE_ERRORS) <> 0) then
427	+	raise EIBInterBaseError.Create(TFB30StatusObject.Create(self,st));
428	+	end;
429	+
430		function TFB30ClientAPI.InErrorState: boolean;
431		begin
432		Result := FStatus.InErrorState;
#	Line 412 | Line 540 | begin
540		Result := UtilIntf.GetClientVersion mod 256;
541		end;
542
415	–	function TFB30ClientAPI.DecodeInteger(bufptr: PByte; len: short): integer;
416	–	var P: PByte;
417	–	begin
418	–	Result := 0;
419	–	P := Bufptr + len - 1;
420	–	while P >= bufptr do
421	–	begin
422	–	Result := (Result shl 8 ) or P^;
423	–	Dec(P);
424	–	end;
425	–	end;
426	–
543		procedure TFB30ClientAPI.SQLEncodeDate(aDate: TDateTime; bufptr: PByte);
544		var
545		Yr, Mn, Dy: Word;
#	Line 484 | Line 600 | begin
600		end;
601
602		function TFB30ClientAPI.FormatStatus(Status: TFBStatus): AnsiString;
603	+	begin
604	+	Result := FormatFBStatus((Status as TFB30Status).GetStatus);
605	+	end;
606	+
607	+	function TFB30ClientAPI.FormatFBStatus(Status: Firebird.IStatus): AnsiString;
608		var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
609		begin
610		Result := '';
611	<	if UtilIntf.formatStatus(@local_buffer,sizeof(local_buffer),(Status as TFB30Status).GetStatus) > 0 then
611	>	if UtilIntf.formatStatus(@local_buffer,sizeof(local_buffer) - 1,Status) > 0 then
612		Result := strpas(local_buffer);
613		end;
614

Diff Legend

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