ViewVC Help

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

root/public/ibx/trunk/fbintf/client/FBParamBlock.pas

Comparing ibx/trunk/fbintf/client/FBParamBlock.pas (file contents):
Revision 55 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 56 by tony, Mon Mar 6 10:20:02 2017 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 64 | Line 67 | type
67		procedure MoveBy(Item: PParamBlockItemData; delta: integer);
68		procedure UpdateRequestItemSize(Item: TParamBlockItem; NewSize: integer);
69		protected
70	<	FBuffer: PChar;
70	>	FBuffer: PByte;
71		FDataLength: integer;
72		function Add(ParamType: byte): PParamBlockItemData;
73		function Find(ParamType: byte): PParamBlockItemData;
#	Line 72 | Line 75 | type
75		public
76		constructor Create;
77		destructor Destroy; override;
78	<	function getBuffer: PChar;
78	>	function getBuffer: PByte;
79		function getDataLength: integer;
80		function AvailableBufferSpace: integer;
81
#	Line 96 | Line 99 | type
99		public
100		function getAsInteger: integer;
101		function getParamType: byte;
102	<	function getAsString: string;
102	>	function getAsString: AnsiString;
103		function getAsByte: byte;
104		procedure addByte(aValue: byte);
105		procedure addShortInteger(aValue: integer);
#	Line 107 | Line 110 | type
110		procedure SetAsInteger2(aValue: integer);
111		procedure SetAsShortInteger(aValue: integer);
112		procedure SetAsTinyInteger(aValue: integer);
113	<	procedure SetAsString(aValue: string);
114	<	procedure SetAsString2(aValue: string);
115	<	procedure SetAsString0(aValue: string);
113	<	end;
114	<
115	<	{ TCustomParamBlock }
116	<
117	<	generic TCustomParamBlock<_TItem; _IItem> = class(TParamBlock)
118	<	public
119	<	function Add(ParamType: byte): _IItem;
120	<	function Find(ParamType: byte): _IItem;
121	<	function GetItems(index: integer): _IItem;
113	>	procedure SetAsString(aValue: AnsiString);
114	>	procedure SetAsString2(aValue: AnsiString);
115	>	procedure SetAsString0(aValue: AnsiString);
116		end;
117
118		{ TDPBItem }
119
120		TDPBItem = class(TParamBlockItem,IDPBItem);
121
128	–	{ TDPB }
129	–
130	–	TDPB = class (specialize TCustomParamBlock<TDPBItem,IDPBItem>, IDPB)
131	–	public
132	–	constructor Create;
133	–	end;
134	–
122		{ TTPBItem }
123
124		TTPBItem = class(TParamBlockItem,ITPBItem);
125
139	–	{ TTPB }
140	–
141	–	TTPB = class (specialize TCustomParamBlock<TTPBItem,ITPBItem>, ITPB)
142	–	public
143	–	constructor Create;
144	–	end;
145	–
126		{ TSPBItem }
127
128		TSPBItem = class(TParamBlockItem,ISPBItem);
129
150	–	{ TSPB }
151	–
152	–	TSPB = class (specialize TCustomParamBlock<TSPBItem,ISPBItem>, ISPB)
153	–	public
154	–	constructor Create;
155	–	end;
156	–
130		{ TSRBItem }
131
132		TSRBItem = class(TParamBlockItem,ISRBItem)
133		public
134	<	function ISRBItem.SetAsString = SetAsString2;
135	<	function ISRBItem.SetAsByte = SetAsByte2;
134	>	{$IFDEF FPC}
135	>	procedure ISRBItem.SetAsString = SetAsString2;
136	>	procedure ISRBItem.SetAsByte = SetAsByte2;
137	>	{$ELSE}
138	>	procedure SetAsString(aValue: AnsiString) ;
139	>	procedure SetAsByte(aValue: byte);
140	>	{$ENDIF}
141		end;
142
165	–	{ TSRB }
166	–
167	–	TSRB = class (specialize TCustomParamBlock<TSRBItem,ISRBItem>, ISRB);
168	–
143		{ TSQPBItem }
144
145		TSQPBItem = class(TParamBlockItem,ISQPBItem)
146		public
147		function CopyFrom(source: TStream; count: integer): integer;
148	+	{$IFDEF FPC}
149		procedure ISQPBItem.SetAsInteger = SetAsInteger2;
150		procedure ISQPBItem.SetAsString = SetAsString2;
151	+	{$ELSE}
152	+	procedure SetAsString(aValue: AnsiString) ;
153	+	procedure SetAsInteger(aValue: integer);
154	+	{$ENDIF}
155		end;
156
178	–	{ TSQPB }
179	–
180	–	TSQPB = class (specialize TCustomParamBlock<TSQPBItem,ISQPBItem>, ISQPB);
181	–
157		{ TBPBItem }
158
159		TBPBItem =  class(TParamBlockItem,IBPBItem)
160		public
161	+	{$IFDEF FPC}
162		procedure IBPBItem.SetAsInteger = SetAsInteger1;
163	+	{$ELSE}
164	+	procedure SetAsInteger(aValue: integer);
165	+	{$ENDIF}
166	+	end;
167	+
168	+	{ TCustomParamBlock }
169	+
170	+	{$IFDEF FPC}
171	+	TCustomParamBlock<_TItem, _IItem> = class(TParamBlock)
172	+	{$ELSE}
173	+	TParamBlockItemClass = class of TParamBlockItem;
174	+	TCustomParamBlock<_TItem: TParamBlockItem;  _IItem: IParameterBlockItem> = class(TParamBlock)
175	+	{$ENDIF}
176	+	public
177	+	function Add(ParamType: byte): _IItem;
178	+	function Find(ParamType: byte): _IItem;
179	+	function GetItems(index: integer): _IItem;
180	+	end;
181	+
182	+	{ TDPB }
183	+
184	+	TDPB = class (TCustomParamBlock<TDPBItem,IDPBItem>, IDPB)
185	+	public
186	+	constructor Create;
187		end;
188
189	+	{ TTPB }
190	+
191	+	TTPB = class (TCustomParamBlock<TTPBItem,ITPBItem>, ITPB)
192	+	public
193	+	constructor Create;
194	+	end;
195	+
196	+	{ TSPB }
197	+
198	+	TSPB = class (TCustomParamBlock<TSPBItem,ISPBItem>, ISPB)
199	+	public
200	+	constructor Create;
201	+	end;
202	+
203	+	{ TSRB }
204	+
205	+	TSRB = class (TCustomParamBlock<TSRBItem,ISRBItem>, ISRB);
206	+
207	+	{ TSQPB }
208	+
209	+	TSQPB = class (TCustomParamBlock<TSQPBItem,ISQPBItem>, ISQPB);
210	+
211		{ TBPB }
212
213	<	TBPB = class (specialize TCustomParamBlock<TBPBItem,IBPBItem>, IBPB)
213	>	TBPB = class (TCustomParamBlock<TBPBItem,IBPBItem>, IBPB)
214		public
215		constructor Create;
216		end;
217
218		implementation
219
220	<	uses FBMessages;
220	>	uses FBMessages {$IFNDEF FPC} , TypInfo {$ENDIF};
221
222		const
223		MaxBufferSize = 65535;
224
225	<	{ TCustomParamBlock }
226	<
227	<	function TCustomParamBlock.Add(ParamType: byte): _IItem;
206	<	var Item: PParamBlockItemData;
225	>	{ TBPBItem }
226	>	{$IFNDEF FPC}
227	>	procedure TBPBItem.SetAsInteger(aValue: integer);
228		begin
229	<	Item := inherited Add(ParamType);
209	<	Result := _TItem.Create(self,Item);
229	>	SetAsInteger1(aValue);
230		end;
231	+	{$ENDIF}
232
233	<	function TCustomParamBlock.Find(ParamType: byte): _IItem;
234	<	var Item: PParamBlockItemData;
233	>	{ TSRBItem }
234	>
235	>	{$IFNDEF FPC}
236	>	procedure TSRBItem.SetAsString(aValue: AnsiString);
237		begin
238	<	Result := nil;
216	<	Item := inherited Find(ParamType);
217	<	if Item <> nil then
218	<	Result := _TItem.Create(self,Item);
238	>	SetAsString2(aValue);
239		end;
240
241	<	function TCustomParamBlock.GetItems(index: integer): _IItem;
222	<	var Item: PParamBlockItemData;
241	>	procedure TSRBItem.SetAsByte(aValue: byte);
242		begin
243	<	Item := inherited getItems(index);
225	<	Result := _TItem.Create(self,Item);
243	>	SetAsByte2(aValue);
244		end;
245	+	{$ENDIF}
246
247		{ TSQPBItem }
248
#	Line 237 | Line 256 | begin
256		Result := source.Read((FBufPtr+3)^,count);
257		with FirebirdClientAPI do
258		EncodeInteger(Result,2,FBufPtr+1);
259	<	(FBufPtr+Result + 3)^ := chr(isc_info_end);
259	>	(FBufPtr+Result + 3)^ := isc_info_end;
260		if Result <> count then
261		FOwner.UpdateRequestItemSize(self,Result + 4);
262		FDataType := dtString2;
263		end;
264		end;
265
266	<	{ TBPB }
266	>	{$IFNDEF FPC}
267	>	procedure TSQPBItem.SetAsString(aValue: AnsiString);
268	>	begin
269	>	SetAsString2(aValue);
270	>	end;
271
272	<	constructor TBPB.Create;
272	>	procedure TSQPBItem.SetAsInteger(aValue: integer);
273		begin
274	<	inherited Create;
252	<	FDataLength := 1;
253	<	FBuffer^ := char(isc_bpb_version1);
274	>	SetAsInteger2(aValue);
275		end;
276	+	{$ENDIF}
277
278		{ TParamBlockItem }
279
#	Line 288 | Line 310 | begin
310		Result := byte(FParamData^.FBufPtr^);
311		end;
312
313	<	function TParamBlockItem.getAsString: string;
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
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);
341	>	Result := strpas(PAnsiChar(FBufPtr+1));
342		else
343		IBError(ibxeOutputBlockTypeError,[nil]);
344		end;
#	Line 336 | Line 358 | end;
358
359		procedure TParamBlockItem.addByte(aValue: byte);
360		var len: integer;
361	<	P: PChar;
361	>	P: PByte;
362		begin
363		with FParamData^ do
364		begin
365		P := FBufPtr + FBufLength;
366		len := FBufLength + 1;
367		FOwner.UpdateRequestItemSize(self,len);
368	<	P^ := char(aValue)
368	>	P^ := aValue;
369		end;
370		end;
371
372		procedure TParamBlockItem.addShortInteger(aValue: integer);
373		var len: integer;
374	<	P: PChar;
374	>	P: PByte;
375		begin
376		with FParamData^ do
377		begin
#	Line 368 | Line 390 | begin
390		if FBufLength <> 3 then
391		FOwner.UpdateRequestItemSize(self,3);
392		FDataType := dtByte;
393	<	(FBufPtr+1)^ := #1;
394	<	(FBufPtr+2)^ := chr(aValue);
393	>	(FBufPtr+1)^ := $1;
394	>	(FBufPtr+2)^ := aValue;
395		end;
396		end;
397
#	Line 380 | Line 402 | begin
402		if FBufLength <> 2 then
403		FOwner.UpdateRequestItemSize(self,2);
404		FDataType := dtByte2;
405	<	(FBufPtr+1)^ := chr(aValue);
405	>	(FBufPtr+1)^ := aValue;
406		end;
407		end;
408
#	Line 406 | Line 428 | begin
428		begin
429		if FBufLength <> 6 then
430		FOwner.UpdateRequestItemSize(self,6);
431	<	(FBufPtr+1)^ := chr(4);
431	>	(FBufPtr+1)^ := $4;
432		with FirebirdClientAPI do
433		EncodeInteger(aValue,4,FBufPtr+2);
434		FDataType := dtInteger1;
#	Line 456 | Line 478 | end;
478
479		{Short string encoding}
480
481	<	procedure TParamBlockItem.SetAsString(aValue: string);
481	>	procedure TParamBlockItem.SetAsString(aValue: AnsiString);
482		var len: integer;
483		begin
484		with FParamData^ do
#	Line 465 | Line 487 | begin
487		if len > 255 then
488		IBError(ibxStringTooLong,[aValue,255]);
489		FOwner.UpdateRequestItemSize(self,len+2);
490	<	(FBufPtr+1)^ := char(len);
490	>	(FBufPtr+1)^ := len;
491		if len > 0 then
492		Move(aValue[1],(FBufPtr+2)^,len);
493		FDataType := dtString;
#	Line 474 | Line 496 | end;
496
497		{Long string up to 65535 encoding}
498
499	<	procedure TParamBlockItem.SetAsString2(aValue: string);
499	>	procedure TParamBlockItem.SetAsString2(aValue: AnsiString);
500		var len: integer;
501		begin
502		with FParamData^ do
#	Line 493 | Line 515 | end;
515
516		{Zero byte terminated string encoding}
517
518	<	procedure TParamBlockItem.SetAsString0(aValue: string);
518	>	procedure TParamBlockItem.SetAsString0(aValue: AnsiString);
519		var len: integer;
520		begin
521		with FParamData^ do
#	Line 502 | Line 524 | begin
524		FOwner.UpdateRequestItemSize(self,len+2);
525		if len > 0 then
526		Move(aValue[1],(FBufPtr+1)^,len);
527	<	(FBufPtr+len+1)^ := #0;
527	>	(FBufPtr+len+1)^ := 0;
528		FDataType := dtString0;
529		end;
530		end;
#	Line 510 | Line 532 | end;
532		{ TParamBlock }
533
534		procedure TParamBlock.AdjustBuffer;
535	<	var P: PChar;
535	>	var P: PByte;
536		i: integer;
537		headerLen: integer;
538		begin
#	Line 532 | Line 554 | begin
554		end;
555
556		procedure TParamBlock.MoveBy(Item: PParamBlockItemData; delta: integer);
557	<	var src, dest: PChar;
557	>	var src, dest: PByte;
558		i: integer;
559		begin
560		with Item^ do
#	Line 549 | Line 571 | begin
571		for i := 0 to FBufLength - 1 do
572		(dest +i)^ := (src+i)^;
573		end;
574	<	FBufPtr += delta;
574	>	FBufPtr := FBufPtr + delta;
575		end;
576		end;
577
#	Line 563 | Line 585 | begin
585		begin
586		if FDataLength + delta > MaxBufferSize then
587		IBError(ibxeParamBufferOverflow,[nil]);
588	<	FDataLength += delta;
588	>	FDataLength := FDataLength + delta;
589		AdjustBuffer;
590		i := Length(FItems) - 1;
591		while i >= 0  do
#	Line 589 | Line 611 | begin
611		Moveby(FItems[i],delta);
612		Inc(i);
613		end;
614	<	FDataLength += delta;
614	>	FDataLength := FDataLength + delta;
615		end;
616		end;
617
#	Line 612 | Line 634 | begin
634		inherited Destroy;
635		end;
636
637	<	function TParamBlock.getBuffer: PChar;
637	>	function TParamBlock.getBuffer: PByte;
638		begin
639		if FDataLength = 0 then
640		Result := nil
#	Line 635 | Line 657 | begin
657		new(Result);
658		Result^.FBufPtr := FBuffer + FDataLength;
659		Result^.FBufLength := 1;
660	<	Result^.FBufPtr^ := char(ParamType);
660	>	Result^.FBufPtr^ := ParamType;
661		Result^.FDataType := dtnone; {default}
662		Inc(FDataLength,1);
663		AdjustBuffer;
#	Line 648 | Line 670 | var i: integer;
670		begin
671		Result := nil;
672		for i := 0 to getCount - 1 do
673	<	if FItems[i]^.FBufPtr^ = char(ParamType) then
673	>	if byte(FItems[i]^.FBufPtr^) = ParamType then
674		begin
675		Result := FItems[i];
676		Exit;
#	Line 674 | Line 696 | var P: PParamBlockItemData;
696		begin
697		P := nil;
698		for i := 0 to getCount - 1 do
699	<	if FItems[i]^.FBufPtr^ = char(ParamType) then
699	>	if byte(FItems[i]^.FBufPtr^) = ParamType then
700		begin
701		P := FItems[i];
702		for j := i + 1 to getCount - 1 do
#	Line 682 | Line 704 | begin
704		MoveBy(FItems[j],-P^.FBufLength);
705		FItems[j - 1] := FItems[j];
706		end;
707	<	FDataLength -= P^.FBufLength;
707	>	FDataLength := FDataLength - P^.FBufLength;
708		dispose(P);
709		SetLength(FItems,Length(FItems)-1);
710		Exit;
#	Line 698 | Line 720 | begin
720		writeln
721		end;
722
723	+	{ TCustomParamBlock }
724	+
725	+	{$IFDEF FPC}
726	+	function TCustomParamBlock<_TItem, _IItem>.Add(ParamType: byte): _IItem;
727	+	var Item: PParamBlockItemData;
728	+	begin
729	+	Item := inherited Add(ParamType);
730	+	Result := _TItem.Create(self,Item);
731	+	end;
732	+
733	+	function TCustomParamBlock<_TItem, _IItem>.Find(ParamType: byte): _IItem;
734	+	var Item: PParamBlockItemData;
735	+	begin
736	+	Result := nil;
737	+	Item := inherited Find(ParamType);
738	+	if Item <> nil then
739	+	Result := _TItem.Create(self,Item);
740	+	end;
741	+
742	+	function TCustomParamBlock<_TItem, _IItem>.GetItems(index: integer): _IItem;
743	+	var Item: PParamBlockItemData;
744	+	begin
745	+	Item := inherited getItems(index);
746	+	Result := _TItem.Create(self,Item);
747	+	end;
748	+	{$ELSE}
749	+	function TCustomParamBlock<_TItem, _IItem>.Add(ParamType: byte): _IItem;
750	+	var Item: PParamBlockItemData;
751	+	Obj: TParamBlockItem;
752	+	begin
753	+	Item := inherited Add(ParamType);
754	+	Obj := TParamBlockItemClass(_TItem).Create(self,Item);
755	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
756	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
757	+	end;
758	+
759	+	function TCustomParamBlock<_TItem, _IItem>.Find(ParamType: byte): _IItem;
760	+	var Item: PParamBlockItemData;
761	+	Obj: TParamBlockItem;
762	+	begin
763	+	FillChar(Result,sizeof(Result),0); {workaround for older versions of Delphi}
764	+	Item := inherited Find(ParamType);
765	+	if Item <> nil then
766	+	begin
767	+	Obj := TParamBlockItemClass(_TItem).Create(self,Item);
768	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
769	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
770	+	end;
771	+	end;
772	+
773	+	function TCustomParamBlock<_TItem, _IItem>.GetItems(index: integer): _IItem;
774	+	var Item: PParamBlockItemData;
775	+	Obj: TParamBlockItem;
776	+	begin
777	+	Item := inherited getItems(index);
778	+	Obj := TParamBlockItemClass(_TItem).Create(self,Item);
779	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
780	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
781	+	end;
782	+	{$ENDIF}
783	+
784		{ TDPB }
785
786		constructor TDPB.Create;
787		begin
788		inherited Create;
789		FDataLength := 1;
790	<	FBuffer^ := char(isc_dpb_version1);
790	>	FBuffer^ := isc_dpb_version1;
791		end;
792
793		{ TTPB }
#	Line 713 | Line 796 | constructor TTPB.Create;
796		begin
797		inherited Create;
798		FDataLength := 1;
799	<	FBuffer^ := char(isc_tpb_version3);
799	>	FBuffer^ := isc_tpb_version3;
800		end;
801
802		{ TSPB }
#	Line 722 | Line 805 | constructor TSPB.Create;
805		begin
806		inherited Create;
807		FDataLength := 2;
808	<	FBuffer^ := char(isc_spb_version);
809	<	(FBuffer+1)^ := char(isc_spb_current_version);
808	>	FBuffer^ := isc_spb_version;
809	>	(FBuffer+1)^ := isc_spb_current_version;
810	>	end;
811	>
812	>	{ TBPB }
813	>
814	>	constructor TBPB.Create;
815	>	begin
816	>	inherited Create;
817	>	FDataLength := 1;
818	>	FBuffer^ := isc_bpb_version1;
819		end;
820
821		end.

Diff Legend

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