ViewVC Help

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

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

Comparing ibx/trunk/fbintf/client/FBOutputBlock.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 61 by tony, Sun Apr 2 11:40:29 2017 UTC

#	Line 25 | Line 25
25		*
26		*)
27		unit FBOutputBlock;
28	+	{$IFDEF MSWINDOWS}
29	+	{$DEFINE WINDOWS}
30	+	{$ENDIF}
31
32		{$IFDEF FPC}
33	<	{$mode objfpc}{$H+}
33	>	{$mode delphi}
34		{$codepage UTF8}
35		{$interfaces COM}
36		{$ENDIF}
#	Line 54 | Line 57 | type
57		{Describes a Clumplet in the buffer. FBufPtr always points to the clumplet id
58		the rest of the clumplet up to the FSize is data. The data format is
59		given by FDataType, and the data length is given by FDataLength}
60	<	FBufPtr: PChar;
60	>	FBufPtr: PByte;
61		FDataLength: integer;
62		FSize: integer;
63		FDataType: TItemDataType;
#	Line 67 | Line 70 | type
70
71		TOutputBlock = class(TFBInterfacedObject)
72		private
73	<	FBuffer: PChar;
73	>	FBuffer: PByte;
74		FBufSize: integer;
75		FBufferParsed: boolean;
76		procedure ParseBuffer;
77		{$IFDEF DEBUGOUTPUTBLOCK}
78		procedure FormattedPrint(const aItems: array of POutputBlockItemData;
79	<	Indent: string);
79	>	Indent: AnsiString);
80		{$ENDIF}
81		procedure PrintBuf;
82		protected
#	Line 82 | Line 85 | type
85		FTruncated: boolean;
86		FItems: array of POutputBlockItemData;
87		procedure DoParseBuffer; virtual; abstract;
88	<	function AddItem(BufPtr: PChar): POutputBlockItemData;
89	<	function AddIntegerItem(BufPtr: PChar): POutputBlockItemData;
90	<	function AddStringItem(BufPtr: PChar): POutputBlockItemData;
91	<	function AddShortStringItem(BufPtr: PChar): POutputBlockItemData;
92	<	function AddByteItem(BufPtr: PChar): POutputBlockItemData;
93	<	function AddBytesItem(BufPtr: PChar): POutputBlockItemData;
94	<	function AddListItem(BufPtr: PChar): POutputBlockItemData; virtual;
95	<	function AddSpecialItem(BufPtr: PChar): POutputBlockItemData; virtual;
88	>	function AddItem(BufPtr: PByte): POutputBlockItemData;
89	>	function AddIntegerItem(BufPtr: PByte): POutputBlockItemData;
90	>	function AddStringItem(BufPtr: PByte): POutputBlockItemData;
91	>	function AddShortStringItem(BufPtr: PByte): POutputBlockItemData;
92	>	function AddByteItem(BufPtr: PByte): POutputBlockItemData;
93	>	function AddBytesItem(BufPtr: PByte): POutputBlockItemData;
94	>	function AddListItem(BufPtr: PByte): POutputBlockItemData; virtual;
95	>	function AddSpecialItem(BufPtr: PByte): POutputBlockItemData; virtual;
96		public
97		constructor Create(aSize: integer = DefaultBufferSize);
98		destructor Destroy; override;
99	<	function Buffer: PChar;
99	>	function Buffer: PByte;
100		function getBufSize: integer;
101
102		public
#	Line 114 | Line 117 | type
117		protected
118		function GetItem(index: integer): POutputBlockItemData;
119		function Find(ItemType: byte): POutputBlockItemData;
120	<	procedure SetString(out S: AnsiString; Buf: PAnsiChar; Len: SizeInt;
120	>	procedure SetString(out S: AnsiString; Buf: PByte; Len: integer;
121		CodePage: TSystemCodePage);
122		property ItemData: POutputBlockItemData read FItemData;
123		property Owner: TOutputBlock read FOwner;
#	Line 127 | Line 130 | type
130		procedure getRawBytes(var Buffer);
131		function getAsInteger: integer;
132		function getParamType: byte;
133	<	function getAsString: string;
133	>	function getAsString: AnsiString;
134		function getAsByte: byte;
135		function getAsBytes: TByteArray;
136		function CopyTo(stream: TStream; count: integer): integer;
137		end;
138
139	+	TServiceQueryResultSubItem = class(TOutputBlockItem,IServiceQueryResultSubItem);
140	+
141		{ TCustomOutputBlock }
142
143	<	generic TCustomOutputBlock<_TItem,_IItem> = class(TOutputBlock)
143	>	{$IFDEF FPC}
144	>	TCustomOutputBlock<_TItem,_IItem> = class(TOutputBlock)
145	>	{$ELSE}
146	>	TOutputBlockItemClass = class of TOutputBlockItem;
147	>	TCustomOutputBlock<_TItem: TOutputBlockItem;_IItem: IUnknown> = class(TOutputBlock)
148	>	{$ENDIF}
149		public
150		function getItem(index: integer): _IItem;
151		function find(ItemType: byte): _IItem;
#	Line 144 | Line 154 | type
154
155		{ TOutputBlockItemGroup }
156
157	<	generic TOutputBlockItemGroup<_TItem;_IItem> = class(TOutputBlockItem)
157	>	{$IFDEF FPC}
158	>	TOutputBlockItemGroup<_TItem,_IItem> = class(TOutputBlockItem)
159	>	{$ELSE}
160	>	TOutputBlockItemGroup<_TItem: TOutputBlockItem; _IItem: IUnknown> = class(TOutputBlockItem)
161	>	{$ENDIF}
162		public
163		function GetItem(index: integer): _IItem;
164		function Find(ItemType: byte): _IItem;
165		property Items[index: integer]: _IItem read getItem; default;
166		end;
167
154	–	TDBInfoItem = class;
155	–
168		{ TDBInfoItem }
169
170	<	TDBInfoItem = class(specialize TOutputBlockItemGroup<TDBInfoItem,IDBInfoItem>,IDBInfoItem)
170	>	{$IFDEF FPC}
171	>	TDBInfoItem = class;
172	>
173	>	TDBInfoItem = class(TOutputBlockItemGroup<TDBInfoItem,IDBInfoItem>,IDBInfoItem)
174	>	{$ELSE}
175	>	TDBInfoItem = class(TOutputBlockItemGroup<TOutputBlockItem,IDBInfoItem>,IDBInfoItem)
176	>	{$ENDIF}
177		public
178	<	procedure DecodeIDCluster(var ConnectionType: integer; var DBFileName, DBSiteName: string);
179	<	procedure DecodeVersionString(var Version: byte; var VersionString: string);
178	>	procedure DecodeIDCluster(var ConnectionType: integer; var DBFileName, DBSiteName: AnsiString);
179	>	procedure DecodeVersionString(var Version: byte; var VersionString: AnsiString);
180		procedure DecodeUserNames(UserNames: TStrings);
181		function getOperationCounts: TDBOperationCounts;
182		end;
183
184		{ TDBInformation }
185
186	<	TDBInformation = class(specialize TCustomOutputBlock<TDBInfoItem,IDBInfoItem>, IDBInformation)
186	>	TDBInformation = class(TCustomOutputBlock<TDBInfoItem,IDBInfoItem>, IDBInformation)
187		protected
188	<	function AddSpecialItem(BufPtr: PChar): POutputBlockItemData; override;
188	>	function AddSpecialItem(BufPtr: PByte): POutputBlockItemData; override;
189		procedure DoParseBuffer; override;
190		public
191		constructor Create(aSize: integer=DBInfoDefaultBufferSize);
192		end;
193
176	–	TServiceQueryResultSubItem = class(TOutputBlockItem,IServiceQueryResultSubItem);
177	–
194		{ TServiceQueryResultItem }
195
196	<	TServiceQueryResultItem = class(specialize TOutputBlockItemGroup<TServiceQueryResultSubItem,IServiceQueryResultSubItem>,
196	>	TServiceQueryResultItem = class(TOutputBlockItemGroup<TServiceQueryResultSubItem,IServiceQueryResultSubItem>,
197		IServiceQueryResultItem);
198
199		{ TServiceQueryResults }
200
201	<	TServiceQueryResults = class(specialize TCustomOutputBlock<TServiceQueryResultItem,IServiceQueryResultItem>, IServiceQueryResults)
201	>	TServiceQueryResults = class(TCustomOutputBlock<TServiceQueryResultItem,IServiceQueryResultItem>, IServiceQueryResults)
202		protected
203	<	function AddListItem(BufPtr: PChar): POutputBlockItemData; override;
204	<	function AddSpecialItem(BufPtr: PChar): POutputBlockItemData; override;
203	>	function AddListItem(BufPtr: PByte): POutputBlockItemData; override;
204	>	function AddSpecialItem(BufPtr: PByte): POutputBlockItemData; override;
205		procedure DoParseBuffer; override;
206		end;
207
208	+
209		{ ISQLInfoItem }
210
211	<	ISQLInfoItem = interface
211	>	ISQLInfoSubItem = interface
212	>	['{39852ee4-4851-44df-8dc0-26b991250098}']
213		function getItemType: byte;
214		function getSize: integer;
215	<	function getAsString: string;
215	>	function getAsString: AnsiString;
216		function getAsInteger: integer;
217	+	end;
218	+
219	+	ISQLInfoItem = interface(ISQLInfoSubItem)
220	+	['{34e3c39d-fe4f-4211-a7e3-0266495a359d}']
221		function GetCount: integer;
222	<	function GetItem(index: integer): ISQLInfoItem;
223	<	function Find(ItemType: byte): ISQLInfoItem;
222	>	function GetItem(index: integer): ISQLInfoSubItem;
223	>	function Find(ItemType: byte): ISQLInfoSubItem;
224		property Count: integer read GetCount;
225	<	property Items[index: integer]: ISQLInfoItem read getItem; default;
225	>	property Items[index: integer]: ISQLInfoSubItem read getItem; default;
226		end;
227
228		{ISQLInfoResults}
229
230		ISQLInfoResults = interface
231	+	['{0b3fbe20-6f80-44e7-85ef-e708bc1f2043}']
232		function GetCount: integer;
233		function GetItem(index: integer): ISQLInfoItem;
234		function Find(ItemType: byte): ISQLInfoItem;
#	Line 213 | Line 236 | type
236		property Items[index: integer]: ISQLInfoItem read getItem; default;
237		end;
238
239	<	TSQLInfoResultsItem = class;
239	>	TSQLInfoResultsSubItem = class(TOutputBlockItem,ISQLInfoSubItem);
240
241		{ TSQLInfoResultsItem }
242
243	<	TSQLInfoResultsItem = class(specialize TOutputBlockItemGroup<TSQLInfoResultsItem,ISQLInfoItem>,ISQLInfoItem);
243	>	TSQLInfoResultsItem = class(TOutputBlockItemGroup<TSQLInfoResultsSubItem,ISQLInfoSubItem>,ISQLInfoItem);
244
245		{ TSQLInfoResultsBuffer }
246
247	<	TSQLInfoResultsBuffer = class(specialize TCustomOutputBlock<TSQLInfoResultsItem,ISQLInfoItem>, ISQLInfoResults)
247	>	TSQLInfoResultsBuffer = class(TCustomOutputBlock<TSQLInfoResultsItem,ISQLInfoItem>, ISQLInfoResults)
248		protected
249	<	function AddListItem(BufPtr: PChar): POutputBlockItemData; override;
249	>	function AddListItem(BufPtr: PByte): POutputBlockItemData; override;
250		procedure DoParseBuffer; override;
251		public
252		constructor Create(aSize: integer = 1024);
253		end;
254
255	+	IBlobInfoItem = interface
256	+	['{3a55e558-b97f-4cf3-af95-53b84f4d9a65}']
257	+	function getItemType: byte;
258	+	function getSize: integer;
259	+	function getAsString: AnsiString;
260	+	function getAsInteger: integer;
261	+	end;
262	+
263	+	IBlobInfo = interface
264	+	['{8a340109-f600-4d26-ab1d-e0be2c759f1c}']
265	+	function GetCount: integer;
266	+	function GetItem(index: integer): IBlobInfoItem;
267	+	function Find(ItemType: byte): IBlobInfoItem;
268	+	property Count: integer read GetCount;
269	+	property Items[index: integer]: IBlobInfoItem read getItem; default;
270	+	end;
271	+
272	+	{$IFDEF FPC}
273	+	TBlobInfoItem = class;
274	+
275	+	TBlobInfoItem = class(TOutputBlockItemGroup<TBlobInfoItem,IBlobInfoItem>,IBlobInfoItem)
276	+	{$ELSE}
277	+	TBlobInfoItem = class(TOutputBlockItemGroup<TOutputBlockItem,IBlobInfoItem>,IBlobInfoItem)
278	+	{$ENDIF}
279	+
280	+	end;
281	+
282	+	{ TBlobInfo }
283	+
284	+	TBlobInfo = class(TCustomOutputBlock<TBlobInfoItem,IBlobInfoItem>, IBlobInfo)
285	+	protected
286	+	procedure DoParseBuffer; override;
287	+	public
288	+	constructor Create(aSize: integer=DBInfoDefaultBufferSize);
289	+	end;
290	+
291		implementation
292
293	<	uses FBMessages;
293	>	uses FBMessages {$IFNDEF FPC}, TypInfo {$ENDIF};
294
295	+	{$IFDEF FPC}
296		{ TOutputBlockItemGroup }
297
298	<	function TOutputBlockItemGroup.GetItem(index: integer): _IItem;
298	>	function TOutputBlockItemGroup<_TItem,_IItem>.GetItem(index: integer): _IItem;
299		var P: POutputBlockItemData;
300		begin
301		P := inherited getItem(index);
302		Result := _TItem.Create(self.Owner,P);
303		end;
304
305	<	function TOutputBlockItemGroup.Find(ItemType: byte): _IItem;
305	>	function TOutputBlockItemGroup<_TItem,_IItem>.Find(ItemType: byte): _IItem;
306		var P: POutputBlockItemData;
307		begin
308		P := inherited Find(ItemType);
#	Line 251 | Line 311 | end;
311
312		{ TCustomOutputBlock }
313
314	<	function TCustomOutputBlock.getItem(index: integer): _IItem;
314	>	function TCustomOutputBlock<_TItem,_IItem>.getItem(index: integer): _IItem;
315		var P: POutputBlockItemData;
316		begin
317		P := inherited getItem(index);
318		Result := _TItem.Create(self,P)
319		end;
320
321	<	function TCustomOutputBlock.find(ItemType: byte): _IItem;
321	>	function TCustomOutputBlock<_TItem,_IItem>.find(ItemType: byte): _IItem;
322		var P: POutputBlockItemData;
323		begin
324		P := inherited Find(ItemType);
325		Result := _TItem.Create(self,P)
326		end;
327
328	+	{$ELSE}
329	+
330		{ TOutputBlockItemGroup }
331
332	+	function TOutputBlockItemGroup<_TItem,_IItem>.GetItem(index: integer): _IItem;
333	+	var P: POutputBlockItemData;
334	+	Obj: TOutputBlockItem;
335	+	begin
336	+	P := inherited getItem(index);
337	+	Obj := TOutputBlockItemClass(_TItem).Create(self.Owner,P);
338	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
339	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
340	+	end;
341	+
342	+	function TOutputBlockItemGroup<_TItem,_IItem>.Find(ItemType: byte): _IItem;
343	+	var P: POutputBlockItemData;
344	+	Obj: TOutputBlockItem;
345	+	begin
346	+	P := inherited Find(ItemType);
347	+	Obj := TOutputBlockItemClass(_TItem).Create(self.Owner,P);
348	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
349	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
350	+	end;
351	+
352	+	{ TCustomOutputBlock }
353	+
354	+	function TCustomOutputBlock<_TItem,_IItem>.getItem(index: integer): _IItem;
355	+	var P: POutputBlockItemData;
356	+	Obj: TOutputBlockItem;
357	+	begin
358	+	P := inherited getItem(index);
359	+	Obj := TOutputBlockItemClass(_TItem).Create(self,P);
360	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
361	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
362	+	end;
363	+
364	+	function TCustomOutputBlock<_TItem,_IItem>.find(ItemType: byte): _IItem;
365	+	var P: POutputBlockItemData;
366	+	Obj: TOutputBlockItem;
367	+	begin
368	+	P := inherited Find(ItemType);
369	+	Obj := TOutputBlockItemClass(_TItem).Create(self,P);
370	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
371	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
372	+	end;
373	+
374	+	{$ENDIF}
375	+
376	+	{ TOutputBlockItem }
377	+
378		function TOutputBlockItem.GetCount: integer;
379		begin
380		Result := Length(FItemData^.FSubItems);
#	Line 286 | Line 394 | var i: integer;
394		begin
395		Result := nil;
396		for i := 0 to GetCount - 1 do
397	<	if FItemData^.FSubItems[i]^.FBufPtr^ = char(ItemType) then
397	>	if byte(FItemData^.FSubItems[i]^.FBufPtr^) = ItemType then
398		begin
399		Result := FItemData^.FSubItems[i];
400		Exit;
#	Line 295 | Line 403 | end;
403
404		{ TOutputBlockItem }
405
406	<	procedure TOutputBlockItem.SetString(out S: AnsiString; Buf: PAnsiChar;
407	<	Len: SizeInt; CodePage: TSystemCodePage);
406	>	procedure TOutputBlockItem.SetString(out S: AnsiString; Buf: PByte;
407	>	Len: integer; CodePage: TSystemCodePage);
408		var rs: RawByteString;
409		begin
410	<	system.SetString(rs,Buf,len);
410	>	system.SetString(rs,PAnsiChar(Buf),len);
411		SetCodePage(rs,CodePage,false);
412		S := rs;
413		end;
#	Line 355 | Line 463 | begin
463		Result := byte(FItemData^.FBufPtr^)
464		end;
465
466	<	function TOutputBlockItem.getAsString: string;
466	>	function TOutputBlockItem.getAsString: AnsiString;
467		var len: integer;
468		begin
469		Result := '';
#	Line 392 | Line 500 | end;
500
501		function TOutputBlockItem.getAsBytes: TByteArray;
502		var i: integer;
503	<	P: PChar;
503	>	P: PByte;
504		begin
505		with FItemData^ do
506		if FDataType = dtBytes then
#	Line 454 | Line 562 | begin
562		FBufferParsed := true;
563		end;
564
565	<	function TOutputBlock.AddItem(BufPtr: PChar): POutputBlockItemData;
565	>	function TOutputBlock.AddItem(BufPtr: PByte): POutputBlockItemData;
566		begin
567		new(Result);
568		with Result^ do
#	Line 467 | Line 575 | begin
575		end;
576		end;
577
578	<	function TOutputBlock.AddIntegerItem(BufPtr: PChar): POutputBlockItemData;
578	>	function TOutputBlock.AddIntegerItem(BufPtr: PByte): POutputBlockItemData;
579		begin
580		new(Result);
581		with Result^ do
#	Line 489 | Line 597 | begin
597		end;
598		end;
599
600	<	function TOutputBlock.AddStringItem(BufPtr: PChar): POutputBlockItemData;
600	>	function TOutputBlock.AddStringItem(BufPtr: PByte): POutputBlockItemData;
601		begin
602		new(Result);
603		with Result^ do
#	Line 503 | Line 611 | begin
611		end;
612		end;
613
614	<	function TOutputBlock.AddShortStringItem(BufPtr: PChar): POutputBlockItemData;
614	>	function TOutputBlock.AddShortStringItem(BufPtr: PByte): POutputBlockItemData;
615		begin
616		new(Result);
617		with Result^ do
#	Line 516 | Line 624 | begin
624		end;
625		end;
626
627	<	function TOutputBlock.AddByteItem(BufPtr: PChar): POutputBlockItemData;
627	>	function TOutputBlock.AddByteItem(BufPtr: PByte): POutputBlockItemData;
628		begin
629		new(Result);
630		with Result^ do
#	Line 529 | Line 637 | begin
637		end;
638		end;
639
640	<	function TOutputBlock.AddBytesItem(BufPtr: PChar): POutputBlockItemData;
640	>	function TOutputBlock.AddBytesItem(BufPtr: PByte): POutputBlockItemData;
641		begin
642		new(Result);
643		with Result^ do
#	Line 543 | Line 651 | begin
651		end;
652		end;
653
654	<	function TOutputBlock.AddListItem(BufPtr: PChar): POutputBlockItemData;
654	>	function TOutputBlock.AddListItem(BufPtr: PByte): POutputBlockItemData;
655		begin
656		new(Result);
657		with Result^ do
#	Line 556 | Line 664 | begin
664		end;
665		end;
666
667	<	function TOutputBlock.AddSpecialItem(BufPtr: PChar): POutputBlockItemData;
667	>	function TOutputBlock.AddSpecialItem(BufPtr: PByte): POutputBlockItemData;
668		begin
669		new(Result);
670		with Result^ do
#	Line 594 | Line 702 | begin
702		inherited Destroy;
703		end;
704
705	<	function TOutputBlock.Buffer: PChar;
705	>	function TOutputBlock.Buffer: PByte;
706		begin
707		Result := FBuffer;
708		end;
#	Line 624 | Line 732 | var i: integer;
732		begin
733		Result := nil;
734		for i := 0 to getCount - 1 do
735	<	if FItems[i]^.FBufPtr^ = char(ItemType) then
735	>	if byte(FItems[i]^.FBufPtr^) = ItemType then
736		begin
737		Result := FItems[i];
738		Exit;
#	Line 633 | Line 741 | end;
741
742		{$IFDEF DEBUGOUTPUTBLOCK}
743		procedure TOutputBlock.FormattedPrint(
744	<	const aItems: array of POutputBlockItemData; Indent: string);
744	>	const aItems: array of POutputBlockItemData; Indent: AnsiString);
745
746		var i: integer;
747		item: TOutputBlockItem;
#	Line 686 | Line 794 | end;
794		{ TDBInfoItem }
795
796		procedure TDBInfoItem.DecodeIDCluster(var ConnectionType: integer;
797	<	var DBFileName, DBSiteName: string);
798	<	var  P: PChar;
797	>	var DBFileName, DBSiteName: AnsiString);
798	>	var  P: PByte;
799		begin
800		with ItemData^ do
801	<	if FBufPtr^ = char(isc_info_db_id) then
801	>	if FBufPtr^ = isc_info_db_id then
802		begin
803		P := FBufPtr + 3;
804		if FDataLength > 0 then
805		ConnectionType := integer(P^);
806		Inc(P);
807		SetString(DBFileName,P+1,byte(P^),CP_ACP);
808	<	P += Length(DBFileName) + 1;
808	>	P := P + Length(DBFileName) + 1;
809		SetString(DBSiteName,P+1,byte(P^),CP_ACP);
810		end
811		else
#	Line 705 | Line 813 | begin
813		end;
814
815		procedure TDBInfoItem.DecodeVersionString(var Version: byte;
816	<	var VersionString: string);
817	<	var  P: PChar;
816	>	var VersionString: AnsiString);
817	>	var  P: PByte;
818		begin
819		with ItemData^ do
820	<	if FBufPtr^ = char(isc_info_version) then
820	>	if FBufPtr^ = isc_info_version then
821		begin
822		P := FBufPtr+3;
823		VersionString := '';
#	Line 722 | Line 830 | begin
830		end;
831
832		procedure TDBInfoItem.DecodeUserNames(UserNames: TStrings);
833	<	var P: PChar;
834	<	s: string;
833	>	var P: PByte;
834	>	s: AnsiString;
835		begin
836		with ItemData^ do
837	<	if FBufPtr^ = char(isc_info_user_names) then
837	>	if FBufPtr^ = isc_info_user_names then
838		begin
839		P := FBufPtr+3;
840		while (P < FBufPtr + FSize) do
841		begin
842		SetString(s,P+1,byte(P^),CP_ACP);
843		UserNames.Add(s);
844	<	P += Length(s) + 1;
844	>	P := P + Length(s) + 1;
845		end;
846		end
847		else
#	Line 742 | Line 850 | end;
850
851		function TDBInfoItem.getOperationCounts: TDBOperationCounts;
852		var tableCounts: integer;
853	<	P: PChar;
853	>	P: PByte;
854		i: integer;
855		begin
856		with ItemData^ do
#	Line 768 | Line 876 | end;
876
877		{ TDBInformation }
878
879	<	function TDBInformation.AddSpecialItem(BufPtr: PChar): POutputBlockItemData;
879	>	function TDBInformation.AddSpecialItem(BufPtr: PByte): POutputBlockItemData;
880		begin
881		Result := inherited AddSpecialItem(BufPtr);
882		with Result^ do
#	Line 780 | Line 888 | begin
888		end;
889
890		procedure TDBInformation.DoParseBuffer;
891	<	var P: PChar;
891	>	var P: PByte;
892		index: integer;
893		begin
894		P := Buffer;
895		index := 0;
896		SetLength(FItems,0);
897	<	while (P^ <> char(isc_info_end)) and (P < Buffer + getBufSize) do
897	>	while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
898		begin
899		SetLength(FItems,index+1);
900		case byte(P^) of
901	+	isc_info_db_read_only,
902		isc_info_no_reserve,
903		isc_info_allocation,
904		isc_info_ods_minor_version,
#	Line 827 | Line 936 | begin
936		else
937		FItems[index] := AddSpecialItem(P);
938		end;
939	<	P += FItems[index]^.FSize;
939	>	P := P + FItems[index]^.FSize;
940		Inc(index);
941		end;
942		end;
#	Line 840 | Line 949 | end;
949
950		{ TServiceQueryResults }
951
952	<	function TServiceQueryResults.AddListItem(BufPtr: PChar): POutputBlockItemData;
953	<	var P: PChar;
952	>	function TServiceQueryResults.AddListItem(BufPtr: PByte): POutputBlockItemData;
953	>	var P: PByte;
954		i: integer;
955		group: byte;
956		begin
#	Line 857 | Line 966 | begin
966		end;
967		with Result^ do
968		begin
969	<	while (P < FBufPtr + FSize) and (P^ <> char(isc_info_flag_end)) do
969	>	while (P < FBufPtr + FSize) and (P^ <> isc_info_flag_end) do
970		begin
971		SetLength(FSubItems,i+1);
972		case group of
#	Line 920 | Line 1029 | begin
1029		end;
1030
1031		end;
1032	<	P +=  FSubItems[i]^.FSize;
1032	>	P := P + FSubItems[i]^.FSize;
1033		Inc(i);
1034		end;
1035		FDataLength := 0;
1036		for i := 0 to Length(FSubItems) - 1 do
1037	<	FDataLength += FSubItems[i]^.FSize;
1037	>	FDataLength := FDataLength + FSubItems[i]^.FSize;
1038		if group in [isc_info_svc_get_users,isc_info_svc_limbo_trans] then
1039		Exit;
1040
1041	<	if (P < FBufPtr + FSize) and (P^ = char(isc_info_flag_end)) then
1041	>	if (P < FBufPtr + FSize) and (P^ = isc_info_flag_end) then
1042		FSize := FDataLength + 2 {include start and end flag}
1043		else
1044		FSize := FDataLength + 1; {start flag only}
1045		end;
1046		end;
1047
1048	<	function TServiceQueryResults.AddSpecialItem(BufPtr: PChar
1048	>	function TServiceQueryResults.AddSpecialItem(BufPtr: PByte
1049		): POutputBlockItemData;
1050	<	var P: PChar;
1050	>	var P: PByte;
1051		i: integer;
1052		begin
1053		Result := inherited AddSpecialItem(BufPtr);
#	Line 952 | Line 1061 | begin
1061		while P < FBufPtr + FDataLength do
1062		begin
1063		FSubItems[i] := AddIntegerItem(P);
1064	<	P +=  FSubItems[i]^.FSize;
1064	>	P := P + FSubItems[i]^.FSize;
1065		Inc(i);
1066		end;
1067		end;
1068		end;
1069
1070		procedure TServiceQueryResults.DoParseBuffer;
1071	<	var P: PChar;
1071	>	var P: PByte;
1072		i: integer;
1073		begin
1074		P := Buffer;
1075		i := 0;
1076	<	while  (P < Buffer + getBufSize) and (P^ <> char(isc_info_end)) do
1076	>	while  (P < Buffer + getBufSize) and (P^ <> isc_info_end) do
1077		begin
1078		SetLength(FItems,i+1);
1079		case integer(P^) of
#	Line 1003 | Line 1112 | begin
1112		else
1113		IBError(ibxeOutputParsingError, [integer(P^)]);
1114		end;
1115	<	P += FItems[i]^.FSize;
1115	>	P := P + FItems[i]^.FSize;
1116		Inc(i);
1117		end;
1118		end;
1119
1120		{ TSQLInfoResultsBuffer }
1121
1122	<	function TSQLInfoResultsBuffer.AddListItem(BufPtr: PChar): POutputBlockItemData;
1123	<	var P: PChar;
1122	>	function TSQLInfoResultsBuffer.AddListItem(BufPtr: PByte): POutputBlockItemData;
1123	>	var P: PByte;
1124		i: integer;
1125		begin
1126		Result := inherited AddListItem(BufPtr);
#	Line 1049 | Line 1158 | begin
1158		else
1159		FSubItems[i] := AddSpecialItem(P);
1160		end;
1161	<	P +=  FSubItems[i]^.FSize;
1161	>	P := P + FSubItems[i]^.FSize;
1162		Inc(i);
1163		end;
1164		end;
#	Line 1057 | Line 1166 | begin
1166		end;
1167
1168		procedure TSQLInfoResultsBuffer.DoParseBuffer;
1169	<	var P: PChar;
1169	>	var P: PByte;
1170		index: integer;
1171		begin
1172		P := Buffer;
1173		index := 0;
1174		SetLength(FItems,0);
1175	<	while (P^ <> char(isc_info_end)) and (P < Buffer + getBufSize) do
1175	>	while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
1176		begin
1177		SetLength(FItems,index+1);
1178		case byte(P^) of
#	Line 1091 | Line 1200 | begin
1200		else
1201		FItems[index] := AddSpecialItem(P);
1202		end;
1203	<	P += FItems[index]^.FSize;
1203	>	P := P + FItems[index]^.FSize;
1204		Inc(index);
1205		end;
1206		end;
#	Line 1100 | Line 1209 | constructor TSQLInfoResultsBuffer.Create
1209		begin
1210		inherited Create(aSize);
1211		FIntegerType := dtInteger;
1212	+	end;
1213	+
1214	+	{ TBlobInfo }
1215	+
1216	+	procedure TBlobInfo.DoParseBuffer;
1217	+	var P: PByte;
1218	+	index: integer;
1219	+	begin
1220	+	P := Buffer;
1221	+	index := 0;
1222	+	SetLength(FItems,0);
1223	+	while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
1224	+	begin
1225	+	SetLength(FItems,index+1);
1226	+	case byte(P^) of
1227	+	isc_info_blob_num_segments,
1228	+	isc_info_blob_max_segment,
1229	+	isc_info_blob_total_length,
1230	+	isc_info_blob_type:
1231	+	FItems[index] := AddIntegerItem(P);
1232	+	else
1233	+	FItems[index] := AddSpecialItem(P);
1234	+	end;
1235	+	P := P + FItems[index]^.FSize;
1236	+	Inc(index);
1237	+	end;
1238	+	end;
1239	+
1240	+	constructor TBlobInfo.Create(aSize: integer);
1241	+	begin
1242	+	inherited Create(aSize);
1243	+	FIntegerType := dtInteger;
1244		end;
1245
1246		end.

Diff Legend

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