ViewVC Help

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

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

Comparing:
ibx/trunk/fbintf/client/FBParamBlock.pas (file contents), Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
ibx/branches/udr/client/FBParamBlock.pas (file contents), Revision 379 by tony, Mon Jan 10 10:08:03 2022 UTC

#	Line 25 | Line 25
25		*
26		*)
27		unit FBParamBlock;
28	+	{$IFDEF MSWINDOWS}
29	+	{$DEFINE WINDOWS}
30	+	{$ENDIF}
31
32		{$IFDEF FPC}
33	<	{$mode objfpc}{$H+}
33	>	{$mode delphi}
34		{$interfaces COM}
35		{$ENDIF}
36
#	Line 47 | Line 50 | type
50		{Describes a Clumplet in the buffer. FBufPtr always points to the clumplet id
51		the rest of the clumplet up to the FBufLength is data. The data format is
52		given by FDataType}
53	<	FBufPtr: PChar;
53	>	FBufPtr: PByte;
54		FBuflength: integer;
55		FDataType: TParamDataType;
56		end;
#	Line 60 | Line 63 | type
63		private
64		FItems: array of PParamBlockItemData;
65		FBufferSize: integer;
66	+	FFirebirdClientAPI: TFBClientAPI;
67		procedure AdjustBuffer;
68		procedure MoveBy(Item: PParamBlockItemData; delta: integer);
69		procedure UpdateRequestItemSize(Item: TParamBlockItem; NewSize: integer);
70		protected
71	<	FBuffer: PChar;
71	>	FBuffer: PByte;
72		FDataLength: integer;
73		function Add(ParamType: byte): PParamBlockItemData;
74		function Find(ParamType: byte): PParamBlockItemData;
75		function GetItems(index: integer): PParamBlockItemData;
76	+	function LookupItemType(ParamTypeName: AnsiString): byte; virtual;
77		public
78	<	constructor Create;
78	>	constructor Create(api: TFBClientAPI);
79		destructor Destroy; override;
80	<	function getBuffer: PChar;
80	>	function getBuffer: PByte;
81		function getDataLength: integer;
82		function AvailableBufferSpace: integer;
83
#	Line 89 | Line 94 | type
94		FOwner: TParamBlock;
95		FOwnerIntf: IUnknown;
96		FParamData: PParamBlockItemData;
97	+	FFirebirdClientAPI: TFBClientAPI;
98		protected
99		property ParamData: PParamBlockItemData read FParamData;
100		public
#	Line 96 | Line 102 | type
102		public
103		function getAsInteger: integer;
104		function getParamType: byte;
105	<	function getAsString: string;
105	>	function getParamTypeName: AnsiString; virtual;
106	>	function getAsString: AnsiString;
107		function getAsByte: byte;
108		procedure addByte(aValue: byte);
109	+	procedure addShortInt(aValue: ShortInt);
110		procedure addShortInteger(aValue: integer);
111		procedure setAsByte(aValue: byte);
112		procedure setAsByte2(aValue: byte);
#	Line 107 | Line 115 | type
115		procedure SetAsInteger2(aValue: integer);
116		procedure SetAsShortInteger(aValue: integer);
117		procedure SetAsTinyInteger(aValue: integer);
118	<	procedure SetAsString(aValue: string);
119	<	procedure SetAsString2(aValue: string);
120	<	procedure SetAsString0(aValue: string);
118	>	procedure SetAsString(aValue: AnsiString);
119	>	procedure SetAsString2(aValue: AnsiString);
120	>	procedure SetAsString0(aValue: AnsiString);
121		end;
122
123	<	{ TCustomParamBlock }
123	>	{ TSRBItem }
124
125	<	generic TCustomParamBlock<_TItem; _IItem> = class(TParamBlock)
125	>	TSRBItem = class(TParamBlockItem,ISRBItem)
126		public
127	<	function Add(ParamType: byte): _IItem;
128	<	function Find(ParamType: byte): _IItem;
129	<	function GetItems(index: integer): _IItem;
127	>	{$IFDEF FPC}
128	>	procedure ISRBItem.SetAsString = SetAsString2;
129	>	procedure ISRBItem.SetAsByte = SetAsByte2;
130	>	{$ELSE}
131	>	procedure SetAsString(aValue: AnsiString) ;
132	>	procedure SetAsByte(aValue: byte);
133	>	{$ENDIF}
134		end;
135
136	<	{ TDPBItem }
125	<
126	<	TDPBItem = class(TParamBlockItem,IDPBItem);
127	<
128	<	{ TDPB }
136	>	{ TSQPBItem }
137
138	<	TDPB = class (specialize TCustomParamBlock<TDPBItem,IDPBItem>, IDPB)
138	>	TSQPBItem = class(TParamBlockItem,ISQPBItem)
139		public
140	<	constructor Create;
140	>	function CopyFrom(source: TStream; count: integer): integer;
141	>	{$IFDEF FPC}
142	>	procedure ISQPBItem.SetAsInteger = SetAsInteger2;
143	>	procedure ISQPBItem.SetAsString = SetAsString2;
144	>	{$ELSE}
145	>	procedure SetAsString(aValue: AnsiString) ;
146	>	procedure SetAsInteger(aValue: integer);
147	>	{$ENDIF}
148		end;
149
150	<	{ TTPBItem }
136	<
137	<	TTPBItem = class(TParamBlockItem,ITPBItem);
138	<
139	<	{ TTPB }
150	>	{ TBPBItem }
151
152	<	TTPB = class (specialize TCustomParamBlock<TTPBItem,ITPBItem>, ITPB)
152	>	TBPBItem =  class(TParamBlockItem,IBPBItem)
153		public
154	<	constructor Create;
154	>	{$IFDEF FPC}
155	>	procedure IBPBItem.SetAsInteger = SetAsInteger1;
156	>	{$ELSE}
157	>	procedure SetAsInteger(aValue: integer);
158	>	{$ENDIF}
159		end;
160
161	<	{ TSPBItem }
147	<
148	<	TSPBItem = class(TParamBlockItem,ISPBItem);
149	<
150	<	{ TSPB }
161	>	{ TDIRBItem }
162
163	<	TSPB = class (specialize TCustomParamBlock<TSPBItem,ISPBItem>, ISPB)
163	>	TDIRBItem = class(TParamBlockItem,IDIRBItem)
164		public
165	<	constructor Create;
165	>	{$IFDEF FPC}
166	>	procedure IDIRBItem.SetAsInteger = SetAsInteger2;
167	>	{$ELSE}
168	>	procedure SetAsInteger(aValue: integer);
169	>	{$ENDIF}
170		end;
171
172	<	{ TSRBItem }
172	>	{ TCustomParamBlock }
173
174	<	TSRBItem = class(TParamBlockItem,ISRBItem)
174	>	{$IFDEF FPC}
175	>	TCustomParamBlock<_TItem, _IItem> = class(TParamBlock)
176	>	{$ELSE}
177	>	TParamBlockItemClass = class of TParamBlockItem;
178	>	TCustomParamBlock<_TItem: TParamBlockItem;  _IItem: IParameterBlockItem> = class(TParamBlock)
179	>	{$ENDIF}
180		public
181	<	function ISRBItem.SetAsString = SetAsString2;
182	<	function ISRBItem.SetAsByte = SetAsByte2;
181	>	function Add(ParamType: byte): _IItem;
182	>	function AddByTypeName(ParamTypeName: AnsiString): _IItem;
183	>	function Find(ParamType: byte): _IItem;
184	>	function GetItems(index: integer): _IItem;
185		end;
186
187		{ TSRB }
188
189	<	TSRB = class (specialize TCustomParamBlock<TSRBItem,ISRBItem>, ISRB);
168	<
169	<	{ TSQPBItem }
170	<
171	<	TSQPBItem = class(TParamBlockItem,ISQPBItem)
172	<	public
173	<	function CopyFrom(source: TStream; count: integer): integer;
174	<	procedure ISQPBItem.SetAsInteger = SetAsInteger2;
175	<	procedure ISQPBItem.SetAsString = SetAsString2;
176	<	end;
189	>	TSRB = class (TCustomParamBlock<TSRBItem,ISRBItem>, ISRB);
190
191		{ TSQPB }
192
193	<	TSQPB = class (specialize TCustomParamBlock<TSQPBItem,ISQPBItem>, ISQPB);
181	<
182	<	{ TBPBItem }
183	<
184	<	TBPBItem =  class(TParamBlockItem,IBPBItem)
185	<	public
186	<	procedure IBPBItem.SetAsInteger = SetAsInteger1;
187	<	end;
193	>	TSQPB = class (TCustomParamBlock<TSQPBItem,ISQPBItem>, ISQPB);
194
195		{ TBPB }
196
197	<	TBPB = class (specialize TCustomParamBlock<TBPBItem,IBPBItem>, IBPB)
197	>	TBPB = class (TCustomParamBlock<TBPBItem,IBPBItem>, IBPB)
198		public
199	<	constructor Create;
199	>	constructor Create(api: TFBClientAPI);
200		end;
201
202	+	TDIRB = class (TCustomParamBlock<TDIRBItem,IDIRBItem>, IDIRB);
203	+
204		implementation
205
206	<	uses FBMessages;
206	>	uses FBMessages {$IFNDEF FPC} , TypInfo {$ENDIF};
207
208		const
209		MaxBufferSize = 65535;
210
211	<	{ TCustomParamBlock }
211	>	{ TDIRBItem }
212	>	{$IFNDEF FPC}
213	>	procedure TDIRBItem.SetAsInteger(aValue: integer);
214	>	begin
215	>	SetAsInteger2(aValue);
216	>	end;
217	>	{$ENDIF}
218
219	<	function TCustomParamBlock.Add(ParamType: byte): _IItem;
220	<	var Item: PParamBlockItemData;
219	>	{ TBPBItem }
220	>	{$IFNDEF FPC}
221	>	procedure TBPBItem.SetAsInteger(aValue: integer);
222		begin
223	<	Item := inherited Add(ParamType);
209	<	Result := _TItem.Create(self,Item);
223	>	SetAsInteger1(aValue);
224		end;
225	+	{$ENDIF}
226
227	<	function TCustomParamBlock.Find(ParamType: byte): _IItem;
228	<	var Item: PParamBlockItemData;
227	>	{ TSRBItem }
228	>
229	>	{$IFNDEF FPC}
230	>	procedure TSRBItem.SetAsString(aValue: AnsiString);
231		begin
232	<	Result := nil;
216	<	Item := inherited Find(ParamType);
217	<	if Item <> nil then
218	<	Result := _TItem.Create(self,Item);
232	>	SetAsString2(aValue);
233		end;
234
235	<	function TCustomParamBlock.GetItems(index: integer): _IItem;
222	<	var Item: PParamBlockItemData;
235	>	procedure TSRBItem.SetAsByte(aValue: byte);
236		begin
237	<	Item := inherited getItems(index);
225	<	Result := _TItem.Create(self,Item);
237	>	SetAsByte2(aValue);
238		end;
239	+	{$ENDIF}
240
241		{ TSQPBItem }
242
#	Line 235 | Line 248 | begin
248		begin
249		FOwner.UpdateRequestItemSize(self,count + 4);
250		Result := source.Read((FBufPtr+3)^,count);
251	<	with FirebirdClientAPI do
251	>	with FFirebirdClientAPI do
252		EncodeInteger(Result,2,FBufPtr+1);
253	<	(FBufPtr+Result + 3)^ := chr(isc_info_end);
253	>	(FBufPtr+Result + 3)^ := isc_info_end;
254		if Result <> count then
255		FOwner.UpdateRequestItemSize(self,Result + 4);
256		FDataType := dtString2;
257		end;
258		end;
259
260	<	{ TBPB }
260	>	{$IFNDEF FPC}
261	>	procedure TSQPBItem.SetAsString(aValue: AnsiString);
262	>	begin
263	>	SetAsString2(aValue);
264	>	end;
265
266	<	constructor TBPB.Create;
266	>	procedure TSQPBItem.SetAsInteger(aValue: integer);
267		begin
268	<	inherited Create;
252	<	FDataLength := 1;
253	<	FBuffer^ := char(isc_bpb_version1);
268	>	SetAsInteger2(aValue);
269		end;
270	+	{$ENDIF}
271
272		{ TParamBlockItem }
273
#	Line 260 | Line 276 | constructor TParamBlockItem.Create(AOwne
276		begin
277		inherited Create;
278		FOwner := AOwner;
279	+	FFirebirdClientAPI := AOwner.FFirebirdClientAPI;
280		FOwnerIntf := AOwner;
281		FParamData := Data;
282		end;
283
284		function TParamBlockItem.getAsInteger: integer;
285		begin
286	<	with FirebirdClientAPI, FParamData^ do
286	>	with FFirebirdClientAPI, FParamData^ do
287		case FDataType of
288		dtInteger:
289		Result := DecodeInteger(FBufPtr+1,4);
#	Line 288 | Line 305 | begin
305		Result := byte(FParamData^.FBufPtr^);
306		end;
307
308	<	function TParamBlockItem.getAsString: string;
308	>	function TParamBlockItem.getParamTypeName: AnsiString;
309	>	begin
310	>	Result := '';
311	>	end;
312	>
313	>	function TParamBlockItem.getAsString: AnsiString;
314		var len: byte;
315		begin
316		Result := '';
#	Line 306 | Line 328 | begin
328		Result := IntToStr(getAsByte);
329		dtString:
330		begin
331	<	len := byte((FBufPtr+1)^);
332	<	SetString(Result,FBufPtr+2,len);
331	>	len := (FBufPtr+1)^;
332	>	SetString(Result,PAnsiChar(FBufPtr+2),len);
333		end;
334		dtString2:
335		begin
336	<	with FirebirdClientAPI do
336	>	with FFirebirdClientAPI do
337		len := DecodeInteger(FBufPtr+1,2);
338	<	SetString(Result,FBufPtr+3,len);
338	>	SetString(Result,PAnsiChar(FBufPtr+3),len);
339		end;
340		dtString0:
341	<	Result := strpas(FBufPtr+1);
342	<	else
343	<	IBError(ibxeOutputBlockTypeError,[nil]);
341	>	Result := strpas(PAnsiChar(FBufPtr+1));
342	>	dtNone:
343	>	Result := '';
344	>	else
345	>	IBError(ibxeOutputBlockTypeError,[nil]);
346		end;
347		end;
348
#	Line 336 | Line 360 | end;
360
361		procedure TParamBlockItem.addByte(aValue: byte);
362		var len: integer;
363	<	P: PChar;
363	>	P: PByte;
364		begin
365		with FParamData^ do
366		begin
367		P := FBufPtr + FBufLength;
368		len := FBufLength + 1;
369		FOwner.UpdateRequestItemSize(self,len);
370	<	P^ := char(aValue)
370	>	P^ := aValue;
371	>	end;
372	>	end;
373	>
374	>	procedure TParamBlockItem.addShortInt(aValue: ShortInt);
375	>	var len: integer;
376	>	P: PByte;
377	>	begin
378	>	with FParamData^ do
379	>	begin
380	>	P := FBufPtr + FBufLength;
381	>	len := FBufLength + 1;
382	>	FOwner.UpdateRequestItemSize(self,len);
383	>	PShortInt(P)^ := aValue;
384		end;
385		end;
386
387		procedure TParamBlockItem.addShortInteger(aValue: integer);
388		var len: integer;
389	<	P: PChar;
389	>	P: PByte;
390		begin
391		with FParamData^ do
392		begin
393		P := FBufPtr + FBufLength;
394		len := FBufLength + 2;
395		FOwner.UpdateRequestItemSize(self,len);
396	<	with FirebirdClientAPI do
396	>	with FFirebirdClientAPI do
397		EncodeInteger(aValue,2,P);
398		end;
399		end;
#	Line 368 | Line 405 | begin
405		if FBufLength <> 3 then
406		FOwner.UpdateRequestItemSize(self,3);
407		FDataType := dtByte;
408	<	(FBufPtr+1)^ := #1;
409	<	(FBufPtr+2)^ := chr(aValue);
408	>	(FBufPtr+1)^ := $1;
409	>	(FBufPtr+2)^ := aValue;
410		end;
411		end;
412
#	Line 380 | Line 417 | begin
417		if FBufLength <> 2 then
418		FOwner.UpdateRequestItemSize(self,2);
419		FDataType := dtByte2;
420	<	(FBufPtr+1)^ := chr(aValue);
420	>	(FBufPtr+1)^ := aValue;
421		end;
422		end;
423
#	Line 392 | Line 429 | begin
429		begin
430		if FBufLength <> 5 then
431		FOwner.UpdateRequestItemSize(self,5);
432	<	with FirebirdClientAPI do
432	>	with FFirebirdClientAPI do
433		EncodeInteger(aValue,4,FBufPtr+1);
434		FDataType := dtInteger;
435		end;
#	Line 406 | Line 443 | begin
443		begin
444		if FBufLength <> 6 then
445		FOwner.UpdateRequestItemSize(self,6);
446	<	(FBufPtr+1)^ := chr(4);
447	<	with FirebirdClientAPI do
446	>	(FBufPtr+1)^ := $4;
447	>	with FFirebirdClientAPI do
448		EncodeInteger(aValue,4,FBufPtr+2);
449		FDataType := dtInteger1;
450		end;
#	Line 421 | Line 458 | begin
458		begin
459		if FBufLength <> 7 then
460		FOwner.UpdateRequestItemSize(self,7);
461	<	with FirebirdClientAPI do
461	>	with FFirebirdClientAPI do
462		begin
463		EncodeInteger(4,2,FBufPtr+1); {Encode length as two bytes}
464		EncodeInteger(aValue,4,FBufPtr+3);
#	Line 436 | Line 473 | begin
473		begin
474		if FBufLength <> 3 then
475		FOwner.UpdateRequestItemSize(self,3);
476	<	with FirebirdClientAPI do
476	>	with FFirebirdClientAPI do
477		EncodeInteger(aValue,2,FBufPtr+1);
478		FDataType := dtShortInteger;
479		end;
#	Line 448 | Line 485 | begin
485		begin
486		if FBufLength <> 2 then
487		FOwner.UpdateRequestItemSize(self,2);
488	<	with FirebirdClientAPI do
488	>	with FFirebirdClientAPI do
489		EncodeInteger(aValue,1,FBufPtr+1);
490		FDataType := dtTinyInteger;
491		end;
#	Line 456 | Line 493 | end;
493
494		{Short string encoding}
495
496	<	procedure TParamBlockItem.SetAsString(aValue: string);
496	>	procedure TParamBlockItem.SetAsString(aValue: AnsiString);
497		var len: integer;
498		begin
499		with FParamData^ do
#	Line 465 | Line 502 | begin
502		if len > 255 then
503		IBError(ibxStringTooLong,[aValue,255]);
504		FOwner.UpdateRequestItemSize(self,len+2);
505	<	(FBufPtr+1)^ := char(len);
505	>	(FBufPtr+1)^ := len;
506		if len > 0 then
507		Move(aValue[1],(FBufPtr+2)^,len);
508		FDataType := dtString;
#	Line 474 | Line 511 | end;
511
512		{Long string up to 65535 encoding}
513
514	<	procedure TParamBlockItem.SetAsString2(aValue: string);
514	>	procedure TParamBlockItem.SetAsString2(aValue: AnsiString);
515		var len: integer;
516		begin
517		with FParamData^ do
#	Line 483 | Line 520 | begin
520		if len > 65535 then
521		IBError(ibxStringTooLong,[aValue,65535]);
522		FOwner.UpdateRequestItemSize(self,len + 3);
523	<	with FirebirdClientAPI do
523	>	with FFirebirdClientAPI do
524		EncodeInteger(len,2,FBufPtr+1);
525		if len > 0 then
526		Move(aValue[1],(FBufPtr+3)^,len);
#	Line 493 | Line 530 | end;
530
531		{Zero byte terminated string encoding}
532
533	<	procedure TParamBlockItem.SetAsString0(aValue: string);
533	>	procedure TParamBlockItem.SetAsString0(aValue: AnsiString);
534		var len: integer;
535		begin
536		with FParamData^ do
#	Line 502 | Line 539 | begin
539		FOwner.UpdateRequestItemSize(self,len+2);
540		if len > 0 then
541		Move(aValue[1],(FBufPtr+1)^,len);
542	<	(FBufPtr+len+1)^ := #0;
542	>	(FBufPtr+len+1)^ := 0;
543		FDataType := dtString0;
544		end;
545		end;
#	Line 510 | Line 547 | end;
547		{ TParamBlock }
548
549		procedure TParamBlock.AdjustBuffer;
550	<	var P: PChar;
550	>	var P: PByte;
551		i: integer;
552		headerLen: integer;
553		begin
#	Line 532 | Line 569 | begin
569		end;
570
571		procedure TParamBlock.MoveBy(Item: PParamBlockItemData; delta: integer);
572	<	var src, dest: PChar;
572	>	var src, dest: PByte;
573		i: integer;
574		begin
575		with Item^ do
#	Line 549 | Line 586 | begin
586		for i := 0 to FBufLength - 1 do
587		(dest +i)^ := (src+i)^;
588		end;
589	<	FBufPtr += delta;
589	>	FBufPtr := FBufPtr + delta;
590		end;
591		end;
592
#	Line 563 | Line 600 | begin
600		begin
601		if FDataLength + delta > MaxBufferSize then
602		IBError(ibxeParamBufferOverflow,[nil]);
603	<	FDataLength += delta;
603	>	FDataLength := FDataLength + delta;
604		AdjustBuffer;
605		i := Length(FItems) - 1;
606		while i >= 0  do
#	Line 589 | Line 626 | begin
626		Moveby(FItems[i],delta);
627		Inc(i);
628		end;
629	<	FDataLength += delta;
629	>	FDataLength := FDataLength + delta;
630		end;
631		end;
632
633	<	constructor TParamBlock.Create;
633	>	constructor TParamBlock.Create(api: TFBClientAPI);
634		begin
635		inherited Create;
636	+	FFirebirdClientAPI := api;
637		GetMem(FBuffer,128);
638		if FBuffer = nil then
639		OutOfMemoryError;
#	Line 612 | Line 650 | begin
650		inherited Destroy;
651		end;
652
653	<	function TParamBlock.getBuffer: PChar;
653	>	function TParamBlock.getBuffer: PByte;
654		begin
655		if FDataLength = 0 then
656		Result := nil
#	Line 622 | Line 660 | end;
660
661		function TParamBlock.getDataLength: integer;
662		begin
663	<	Result :=  FDataLength
663	>	Result :=  FDataLength;
664		end;
665
666		function TParamBlock.AvailableBufferSpace: integer;
#	Line 635 | Line 673 | begin
673		new(Result);
674		Result^.FBufPtr := FBuffer + FDataLength;
675		Result^.FBufLength := 1;
676	<	Result^.FBufPtr^ := char(ParamType);
676	>	Result^.FBufPtr^ := ParamType;
677		Result^.FDataType := dtnone; {default}
678		Inc(FDataLength,1);
679		AdjustBuffer;
#	Line 648 | Line 686 | var i: integer;
686		begin
687		Result := nil;
688		for i := 0 to getCount - 1 do
689	<	if FItems[i]^.FBufPtr^ = char(ParamType) then
689	>	if byte(FItems[i]^.FBufPtr^) = ParamType then
690		begin
691		Result := FItems[i];
692		Exit;
#	Line 663 | Line 701 | begin
701		IBError(ibxePBIndexError,[index]);
702		end;
703
704	+	function TParamBlock.LookupItemType(ParamTypeName: AnsiString): byte;
705	+	begin
706	+	IBError(ibxeNotSupported,[]);
707	+	end;
708	+
709		function TParamBlock.getCount: integer;
710		begin
711		Result := Length(FItems);
#	Line 674 | Line 717 | var P: PParamBlockItemData;
717		begin
718		P := nil;
719		for i := 0 to getCount - 1 do
720	<	if FItems[i]^.FBufPtr^ = char(ParamType) then
720	>	if byte(FItems[i]^.FBufPtr^) = ParamType then
721		begin
722		P := FItems[i];
723		for j := i + 1 to getCount - 1 do
#	Line 682 | Line 725 | begin
725		MoveBy(FItems[j],-P^.FBufLength);
726		FItems[j - 1] := FItems[j];
727		end;
728	<	FDataLength -= P^.FBufLength;
728	>	FDataLength := FDataLength - P^.FBufLength;
729		dispose(P);
730		SetLength(FItems,Length(FItems)-1);
731		Exit;
#	Line 692 | Line 735 | end;
735		procedure TParamBlock.PrintBuf;
736		var i: integer;
737		begin
738	<	write(ClassName,': ');
738	>	write(ClassName,': (',getDataLength,') ');
739		for i := 0 to getDataLength - 1 do
740		write(Format('%x ',[byte(FBuffer[i])]));
741		writeln
742		end;
743
744	<	{ TDPB }
744	>	{ TCustomParamBlock }
745	>
746	>	function TCustomParamBlock<_TItem, _IItem>.AddByTypeName(ParamTypeName: AnsiString
747	>	): _IItem;
748	>	var ParamType: byte;
749	>	begin
750	>	ParamType := LookupItemType(ParamTypeName);
751	>	if ParamType = 0 then
752	>	IBError(ibxeUnknownParamTypeName,[ClassName,ParamTypeName]);
753	>	Result := Add(ParamType);
754	>	end;
755
756	<	constructor TDPB.Create;
756	>	{$IFDEF FPC}
757	>	function TCustomParamBlock<_TItem, _IItem>.Add(ParamType: byte): _IItem;
758	>	var Item: PParamBlockItemData;
759		begin
760	<	inherited Create;
761	<	FDataLength := 1;
762	<	FBuffer^ := char(isc_dpb_version1);
760	>	Item := inherited Add(ParamType);
761	>	Result := _TItem.Create(self,Item);
762	>	end;
763	>
764	>	function TCustomParamBlock<_TItem, _IItem>.Find(ParamType: byte): _IItem;
765	>	var Item: PParamBlockItemData;
766	>	begin
767	>	Result := nil;
768	>	Item := inherited Find(ParamType);
769	>	if Item <> nil then
770	>	Result := _TItem.Create(self,Item);
771		end;
772
773	<	{ TTPB }
773	>	function TCustomParamBlock<_TItem, _IItem>.GetItems(index: integer): _IItem;
774	>	var Item: PParamBlockItemData;
775	>	begin
776	>	Item := inherited getItems(index);
777	>	Result := _TItem.Create(self,Item);
778	>	end;
779
780	<	constructor TTPB.Create;
780	>	{$ELSE}
781	>	function TCustomParamBlock<_TItem, _IItem>.Add(ParamType: byte): _IItem;
782	>	var Item: PParamBlockItemData;
783	>	Obj: TParamBlockItem;
784		begin
785	<	inherited Create;
786	<	FDataLength := 1;
787	<	FBuffer^ := char(isc_tpb_version3);
785	>	Item := inherited Add(ParamType);
786	>	Obj := TParamBlockItemClass(_TItem).Create(self,Item);
787	>	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
788	>	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
789		end;
790
791	<	{ TSPB }
791	>	function TCustomParamBlock<_TItem, _IItem>.Find(ParamType: byte): _IItem;
792	>	var Item: PParamBlockItemData;
793	>	Obj: TParamBlockItem;
794	>	begin
795	>	FillChar(Result,sizeof(Result),0); {workaround for older versions of Delphi}
796	>	Item := inherited Find(ParamType);
797	>	if Item <> nil then
798	>	begin
799	>	Obj := TParamBlockItemClass(_TItem).Create(self,Item);
800	>	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
801	>	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
802	>	end;
803	>	end;
804
805	<	constructor TSPB.Create;
805	>	function TCustomParamBlock<_TItem, _IItem>.GetItems(index: integer): _IItem;
806	>	var Item: PParamBlockItemData;
807	>	Obj: TParamBlockItem;
808		begin
809	<	inherited Create;
810	<	FDataLength := 2;
811	<	FBuffer^ := char(isc_spb_version);
812	<	(FBuffer+1)^ := char(isc_spb_current_version);
809	>	Item := inherited getItems(index);
810	>	Obj := TParamBlockItemClass(_TItem).Create(self,Item);
811	>	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
812	>	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
813	>	end;
814	>	{$ENDIF}
815	>
816	>	{ TBPB }
817	>
818	>	constructor TBPB.Create(api: TFBClientAPI);
819	>	begin
820	>	inherited Create(api);
821	>	FDataLength := 1;
822	>	FBuffer^ := isc_bpb_version1;
823		end;
824
825		end.

Comparing:
ibx/trunk/fbintf/client/FBParamBlock.pas (property svn:eol-style), Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
ibx/branches/udr/client/FBParamBlock.pas (property svn:eol-style), Revision 379 by tony, Mon Jan 10 10:08:03 2022 UTC

#	Line 0 | Line 1
1	+	native

Diff Legend

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