ViewVC Help

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

root/public/ibx/branches/udr/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 143 by tony, Fri Feb 23 12:11:21 2018 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 43 | Line 46 | uses
46
47		const
48		DefaultBufferSize = 32000;
49	<	DBInfoDefaultBufferSize = 512;
49	>	DBInfoDefaultBufferSize = DefaultBufferSize; {allow for database page}
50
51		type
52		TItemDataType = (dtString, dtString2, dtByte, dtBytes, dtInteger, dtIntegerFixed, dtnone,
53	<	dtList,dtSpecial);
53	>	dtList,dtSpecial, dtDateTime, dtOctetString);
54
55		POutputBlockItemData = ^TOutputBlockItemData;
56		TOutputBlockItemData = record
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	>	function AddDateTimeItem(BufPtr: PByte): POutputBlockItemData;
97	>	function AddOctetString(BufPtr: PByte): POutputBlockItemData;
98		public
99		constructor Create(aSize: integer = DefaultBufferSize);
100		destructor Destroy; override;
101	<	function Buffer: PChar;
101	>	function Buffer: PByte;
102		function getBufSize: integer;
103
104		public
#	Line 114 | Line 119 | type
119		protected
120		function GetItem(index: integer): POutputBlockItemData;
121		function Find(ItemType: byte): POutputBlockItemData;
122	<	procedure SetString(out S: AnsiString; Buf: PAnsiChar; Len: SizeInt;
122	>	procedure SetString(out S: AnsiString; Buf: PByte; Len: integer;
123		CodePage: TSystemCodePage);
124		property ItemData: POutputBlockItemData read FItemData;
125		property Owner: TOutputBlock read FOwner;
#	Line 127 | Line 132 | type
132		procedure getRawBytes(var Buffer);
133		function getAsInteger: integer;
134		function getParamType: byte;
135	<	function getAsString: string;
135	>	function getAsString: AnsiString;
136		function getAsByte: byte;
137		function getAsBytes: TByteArray;
138	+	function getAsDateTime: TDateTime;
139		function CopyTo(stream: TStream; count: integer): integer;
140		end;
141
142	+	TServiceQueryResultSubItem = class(TOutputBlockItem,IServiceQueryResultSubItem);
143	+
144		{ TCustomOutputBlock }
145
146	<	generic TCustomOutputBlock<_TItem,_IItem> = class(TOutputBlock)
146	>	{$IFDEF FPC}
147	>	TCustomOutputBlock<_TItem,_IItem> = class(TOutputBlock)
148	>	{$ELSE}
149	>	TOutputBlockItemClass = class of TOutputBlockItem;
150	>	TCustomOutputBlock<_TItem: TOutputBlockItem;_IItem: IUnknown> = class(TOutputBlock)
151	>	{$ENDIF}
152		public
153		function getItem(index: integer): _IItem;
154		function find(ItemType: byte): _IItem;
#	Line 144 | Line 157 | type
157
158		{ TOutputBlockItemGroup }
159
160	<	generic TOutputBlockItemGroup<_TItem;_IItem> = class(TOutputBlockItem)
160	>	{$IFDEF FPC}
161	>	TOutputBlockItemGroup<_TItem,_IItem> = class(TOutputBlockItem)
162	>	{$ELSE}
163	>	TOutputBlockItemGroup<_TItem: TOutputBlockItem; _IItem: IUnknown> = class(TOutputBlockItem)
164	>	{$ENDIF}
165		public
166		function GetItem(index: integer): _IItem;
167		function Find(ItemType: byte): _IItem;
168		property Items[index: integer]: _IItem read getItem; default;
169		end;
170
154	–	TDBInfoItem = class;
155	–
171		{ TDBInfoItem }
172
173	<	TDBInfoItem = class(specialize TOutputBlockItemGroup<TDBInfoItem,IDBInfoItem>,IDBInfoItem)
173	>	{$IFDEF FPC}
174	>	TDBInfoItem = class;
175	>
176	>	TDBInfoItem = class(TOutputBlockItemGroup<TDBInfoItem,IDBInfoItem>,IDBInfoItem)
177	>	{$ELSE}
178	>	TDBInfoItem = class(TOutputBlockItemGroup<TOutputBlockItem,IDBInfoItem>,IDBInfoItem)
179	>	{$ENDIF}
180		public
181	<	procedure DecodeIDCluster(var ConnectionType: integer; var DBFileName, DBSiteName: string);
182	<	procedure DecodeVersionString(var Version: byte; var VersionString: string);
181	>	procedure DecodeIDCluster(var ConnectionType: integer; var DBFileName, DBSiteName: AnsiString);
182	>	procedure DecodeVersionString(var Version: byte; var VersionString: AnsiString);
183		procedure DecodeUserNames(UserNames: TStrings);
184		function getOperationCounts: TDBOperationCounts;
185	<	end;
185	>	end;
186
187		{ TDBInformation }
188
189	<	TDBInformation = class(specialize TCustomOutputBlock<TDBInfoItem,IDBInfoItem>, IDBInformation)
189	>	TDBInformation = class(TCustomOutputBlock<TDBInfoItem,IDBInfoItem>, IDBInformation)
190		protected
191	<	function AddSpecialItem(BufPtr: PChar): POutputBlockItemData; override;
191	>	function AddSpecialItem(BufPtr: PByte): POutputBlockItemData; override;
192		procedure DoParseBuffer; override;
193		public
194		constructor Create(aSize: integer=DBInfoDefaultBufferSize);
195	+	{$IFNDEF FPC}
196	+	function Find(ItemType: byte): IDBInfoItem;
197	+	{$ENDIF}
198		end;
199
176	–	TServiceQueryResultSubItem = class(TOutputBlockItem,IServiceQueryResultSubItem);
177	–
200		{ TServiceQueryResultItem }
201
202	<	TServiceQueryResultItem = class(specialize TOutputBlockItemGroup<TServiceQueryResultSubItem,IServiceQueryResultSubItem>,
202	>	TServiceQueryResultItem = class(TOutputBlockItemGroup<TServiceQueryResultSubItem,IServiceQueryResultSubItem>,
203		IServiceQueryResultItem);
204
205		{ TServiceQueryResults }
206
207	<	TServiceQueryResults = class(specialize TCustomOutputBlock<TServiceQueryResultItem,IServiceQueryResultItem>, IServiceQueryResults)
207	>	TServiceQueryResults = class(TCustomOutputBlock<TServiceQueryResultItem,IServiceQueryResultItem>, IServiceQueryResults)
208		protected
209	<	function AddListItem(BufPtr: PChar): POutputBlockItemData; override;
210	<	function AddSpecialItem(BufPtr: PChar): POutputBlockItemData; override;
209	>	function AddListItem(BufPtr: PByte): POutputBlockItemData; override;
210	>	function AddSpecialItem(BufPtr: PByte): POutputBlockItemData; override;
211		procedure DoParseBuffer; override;
212	+	{$IFNDEF FPC}
213	+	public
214	+	function Find(ItemType: byte): IServiceQueryResultItem;
215	+	{$ENDIF}
216		end;
217
218	+
219		{ ISQLInfoItem }
220
221	<	ISQLInfoItem = interface
221	>	ISQLInfoSubItem = interface
222	>	['{39852ee4-4851-44df-8dc0-26b991250098}']
223		function getItemType: byte;
224		function getSize: integer;
225	<	function getAsString: string;
225	>	function getAsString: AnsiString;
226		function getAsInteger: integer;
227	+	end;
228	+
229	+	ISQLInfoItem = interface(ISQLInfoSubItem)
230	+	['{34e3c39d-fe4f-4211-a7e3-0266495a359d}']
231		function GetCount: integer;
232	<	function GetItem(index: integer): ISQLInfoItem;
233	<	function Find(ItemType: byte): ISQLInfoItem;
232	>	function GetItem(index: integer): ISQLInfoSubItem;
233	>	function Find(ItemType: byte): ISQLInfoSubItem;
234		property Count: integer read GetCount;
235	<	property Items[index: integer]: ISQLInfoItem read getItem; default;
235	>	property Items[index: integer]: ISQLInfoSubItem read getItem; default;
236		end;
237
238		{ISQLInfoResults}
239
240		ISQLInfoResults = interface
241	+	['{0b3fbe20-6f80-44e7-85ef-e708bc1f2043}']
242		function GetCount: integer;
243		function GetItem(index: integer): ISQLInfoItem;
244		function Find(ItemType: byte): ISQLInfoItem;
#	Line 213 | Line 246 | type
246		property Items[index: integer]: ISQLInfoItem read getItem; default;
247		end;
248
249	<	TSQLInfoResultsItem = class;
249	>	TSQLInfoResultsSubItem = class(TOutputBlockItem,ISQLInfoSubItem);
250
251		{ TSQLInfoResultsItem }
252
253	<	TSQLInfoResultsItem = class(specialize TOutputBlockItemGroup<TSQLInfoResultsItem,ISQLInfoItem>,ISQLInfoItem);
253	>	TSQLInfoResultsItem = class(TOutputBlockItemGroup<TSQLInfoResultsSubItem,ISQLInfoSubItem>,ISQLInfoItem);
254
255		{ TSQLInfoResultsBuffer }
256
257	<	TSQLInfoResultsBuffer = class(specialize TCustomOutputBlock<TSQLInfoResultsItem,ISQLInfoItem>, ISQLInfoResults)
257	>	TSQLInfoResultsBuffer = class(TCustomOutputBlock<TSQLInfoResultsItem,ISQLInfoItem>, ISQLInfoResults)
258		protected
259	<	function AddListItem(BufPtr: PChar): POutputBlockItemData; override;
259	>	function AddListItem(BufPtr: PByte): POutputBlockItemData; override;
260		procedure DoParseBuffer; override;
261		public
262		constructor Create(aSize: integer = 1024);
263		end;
264
265	+	IBlobInfoItem = interface
266	+	['{3a55e558-b97f-4cf3-af95-53b84f4d9a65}']
267	+	function getItemType: byte;
268	+	function getSize: integer;
269	+	function getAsString: AnsiString;
270	+	function getAsInteger: integer;
271	+	end;
272	+
273	+	IBlobInfo = interface
274	+	['{8a340109-f600-4d26-ab1d-e0be2c759f1c}']
275	+	function GetCount: integer;
276	+	function GetItem(index: integer): IBlobInfoItem;
277	+	function Find(ItemType: byte): IBlobInfoItem;
278	+	property Count: integer read GetCount;
279	+	property Items[index: integer]: IBlobInfoItem read getItem; default;
280	+	end;
281	+
282	+	{$IFDEF FPC}
283	+	TBlobInfoItem = class;
284	+
285	+	TBlobInfoItem = class(TOutputBlockItemGroup<TBlobInfoItem,IBlobInfoItem>,IBlobInfoItem)
286	+	{$ELSE}
287	+	TBlobInfoItem = class(TOutputBlockItemGroup<TOutputBlockItem,IBlobInfoItem>,IBlobInfoItem)
288	+	{$ENDIF}
289	+
290	+	end;
291	+
292	+	{ TBlobInfo }
293	+
294	+	TBlobInfo = class(TCustomOutputBlock<TBlobInfoItem,IBlobInfoItem>, IBlobInfo)
295	+	protected
296	+	procedure DoParseBuffer; override;
297	+	public
298	+	constructor Create(aSize: integer=DBInfoDefaultBufferSize);
299	+	end;
300	+
301		implementation
302
303	<	uses FBMessages;
303	>	uses FBMessages {$IFNDEF FPC}, TypInfo {$ENDIF};
304
305	+	{$IFDEF FPC}
306		{ TOutputBlockItemGroup }
307
308	<	function TOutputBlockItemGroup.GetItem(index: integer): _IItem;
308	>	function TOutputBlockItemGroup<_TItem,_IItem>.GetItem(index: integer): _IItem;
309		var P: POutputBlockItemData;
310		begin
311		P := inherited getItem(index);
312		Result := _TItem.Create(self.Owner,P);
313		end;
314
315	<	function TOutputBlockItemGroup.Find(ItemType: byte): _IItem;
315	>	function TOutputBlockItemGroup<_TItem,_IItem>.Find(ItemType: byte): _IItem;
316		var P: POutputBlockItemData;
317		begin
318		P := inherited Find(ItemType);
#	Line 251 | Line 321 | end;
321
322		{ TCustomOutputBlock }
323
324	<	function TCustomOutputBlock.getItem(index: integer): _IItem;
324	>	function TCustomOutputBlock<_TItem,_IItem>.getItem(index: integer): _IItem;
325		var P: POutputBlockItemData;
326		begin
327		P := inherited getItem(index);
328		Result := _TItem.Create(self,P)
329		end;
330
331	<	function TCustomOutputBlock.find(ItemType: byte): _IItem;
331	>	function TCustomOutputBlock<_TItem,_IItem>.find(ItemType: byte): _IItem;
332		var P: POutputBlockItemData;
333		begin
334		P := inherited Find(ItemType);
335	<	Result := _TItem.Create(self,P)
335	>	if P = nil then
336	>	Result := nil
337	>	else
338	>	Result := _TItem.Create(self,P)
339		end;
340
341	+	{$ELSE}
342	+
343		{ TOutputBlockItemGroup }
344
345	+	function TOutputBlockItemGroup<_TItem,_IItem>.GetItem(index: integer): _IItem;
346	+	var P: POutputBlockItemData;
347	+	Obj: TOutputBlockItem;
348	+	begin
349	+	P := inherited getItem(index);
350	+	Obj := TOutputBlockItemClass(_TItem).Create(self.Owner,P);
351	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
352	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
353	+	end;
354	+
355	+	function TOutputBlockItemGroup<_TItem,_IItem>.Find(ItemType: byte): _IItem;
356	+	var P: POutputBlockItemData;
357	+	Obj: TOutputBlockItem;
358	+	begin
359	+	P := inherited Find(ItemType);
360	+	if P = nil then
361	+	Result := Default(_IITEM)
362	+	else
363	+	begin
364	+	Obj := TOutputBlockItemClass(_TItem).Create(self.Owner,P);
365	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
366	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
367	+	end;
368	+	end;
369	+
370	+	{ TCustomOutputBlock }
371	+
372	+	function TCustomOutputBlock<_TItem,_IItem>.getItem(index: integer): _IItem;
373	+	var P: POutputBlockItemData;
374	+	Obj: TOutputBlockItem;
375	+	begin
376	+	P := inherited getItem(index);
377	+	Obj := TOutputBlockItemClass(_TItem).Create(self,P);
378	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
379	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
380	+	end;
381	+
382	+	function TCustomOutputBlock<_TItem,_IItem>.find(ItemType: byte): _IItem;
383	+	var P: POutputBlockItemData;
384	+	Obj: TOutputBlockItem;
385	+	begin
386	+	P := inherited Find(ItemType);
387	+	Obj := TOutputBlockItemClass(_TItem).Create(self,P);
388	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
389	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
390	+	end;
391	+
392	+	{$ENDIF}
393	+
394	+	{ TOutputBlockItem }
395	+
396		function TOutputBlockItem.GetCount: integer;
397		begin
398		Result := Length(FItemData^.FSubItems);
#	Line 286 | Line 412 | var i: integer;
412		begin
413		Result := nil;
414		for i := 0 to GetCount - 1 do
415	<	if FItemData^.FSubItems[i]^.FBufPtr^ = char(ItemType) then
415	>	if byte(FItemData^.FSubItems[i]^.FBufPtr^) = ItemType then
416		begin
417		Result := FItemData^.FSubItems[i];
418		Exit;
#	Line 295 | Line 421 | end;
421
422		{ TOutputBlockItem }
423
424	<	procedure TOutputBlockItem.SetString(out S: AnsiString; Buf: PAnsiChar;
425	<	Len: SizeInt; CodePage: TSystemCodePage);
424	>	procedure TOutputBlockItem.SetString(out S: AnsiString; Buf: PByte;
425	>	Len: integer; CodePage: TSystemCodePage);
426		var rs: RawByteString;
427		begin
428	<	system.SetString(rs,Buf,len);
428	>	system.SetString(rs,PAnsiChar(Buf),len);
429		SetCodePage(rs,CodePage,false);
430		S := rs;
431		end;
#	Line 320 | Line 446 | end;
446
447		function TOutputBlockItem.getSize: integer;
448		begin
449	<	Result := FItemData^.FDataLength;
449	>	if FItemData = nil then
450	>	Result := 0
451	>	else
452	>	Result := FItemData^.FDataLength;
453		end;
454
455		procedure TOutputBlockItem.getRawBytes(var Buffer);
#	Line 355 | Line 484 | begin
484		Result := byte(FItemData^.FBufPtr^)
485		end;
486
487	<	function TOutputBlockItem.getAsString: string;
487	>	function TOutputBlockItem.getAsString: AnsiString;
488		var len: integer;
489		begin
490		Result := '';
#	Line 376 | Line 505 | begin
505		len := DecodeInteger(FBufPtr+1,2);
506		SetString(Result,FBufPtr+3,len,CP_ACP);
507		end;
508	+	dtOctetString:
509	+	begin
510	+	with FirebirdClientAPI do
511	+	len := DecodeInteger(FBufPtr+1,2);
512	+	SetString(Result,FBufPtr+3,len,CP_NONE);
513	+	end;
514		else
515		IBError(ibxeOutputBlockTypeError,[nil]);
516		end;
#	Line 392 | Line 527 | end;
527
528		function TOutputBlockItem.getAsBytes: TByteArray;
529		var i: integer;
530	<	P: PChar;
530	>	P: PByte;
531		begin
532		with FItemData^ do
533		if FDataType = dtBytes then
#	Line 409 | Line 544 | begin
544		IBError(ibxeOutputBlockTypeError,[nil]);
545		end;
546
547	+	function TOutputBlockItem.getAsDateTime: TDateTime;
548	+	var aDate: integer;
549	+	aTime: integer;
550	+	begin
551	+	with FItemData^, FirebirdClientAPI do
552	+	if FDataType = dtDateTime then
553	+	begin
554	+	aDate := DecodeInteger(FBufPtr+3,4);
555	+	aTime := DecodeInteger(FBufPtr+7,4);
556	+	Result := SQLDecodeDate(@aDate) + SQLDecodeTime(@aTime)
557	+	end
558	+	else
559	+	IBError(ibxeOutputBlockTypeError,[nil]);
560	+	end;
561	+
562	+
563		function TOutputBlockItem.CopyTo(stream: TStream; count: integer): integer;
564		var len: integer;
565		begin
#	Line 454 | Line 605 | begin
605		FBufferParsed := true;
606		end;
607
608	<	function TOutputBlock.AddItem(BufPtr: PChar): POutputBlockItemData;
608	>	function TOutputBlock.AddItem(BufPtr: PByte): POutputBlockItemData;
609		begin
610		new(Result);
611		with Result^ do
#	Line 467 | Line 618 | begin
618		end;
619		end;
620
621	<	function TOutputBlock.AddIntegerItem(BufPtr: PChar): POutputBlockItemData;
621	>	function TOutputBlock.AddIntegerItem(BufPtr: PByte): POutputBlockItemData;
622		begin
623		new(Result);
624		with Result^ do
#	Line 489 | Line 640 | begin
640		end;
641		end;
642
643	<	function TOutputBlock.AddStringItem(BufPtr: PChar): POutputBlockItemData;
643	>	function TOutputBlock.AddStringItem(BufPtr: PByte): POutputBlockItemData;
644		begin
645		new(Result);
646		with Result^ do
#	Line 503 | Line 654 | begin
654		end;
655		end;
656
657	<	function TOutputBlock.AddShortStringItem(BufPtr: PChar): POutputBlockItemData;
657	>	function TOutputBlock.AddShortStringItem(BufPtr: PByte): POutputBlockItemData;
658		begin
659		new(Result);
660		with Result^ do
#	Line 516 | Line 667 | begin
667		end;
668		end;
669
670	<	function TOutputBlock.AddByteItem(BufPtr: PChar): POutputBlockItemData;
670	>	function TOutputBlock.AddByteItem(BufPtr: PByte): POutputBlockItemData;
671		begin
672		new(Result);
673		with Result^ do
#	Line 529 | Line 680 | begin
680		end;
681		end;
682
683	<	function TOutputBlock.AddBytesItem(BufPtr: PChar): POutputBlockItemData;
683	>	function TOutputBlock.AddBytesItem(BufPtr: PByte): POutputBlockItemData;
684		begin
685		new(Result);
686		with Result^ do
#	Line 543 | Line 694 | begin
694		end;
695		end;
696
697	<	function TOutputBlock.AddListItem(BufPtr: PChar): POutputBlockItemData;
697	>	function TOutputBlock.AddListItem(BufPtr: PByte): POutputBlockItemData;
698		begin
699		new(Result);
700		with Result^ do
#	Line 556 | Line 707 | begin
707		end;
708		end;
709
710	<	function TOutputBlock.AddSpecialItem(BufPtr: PChar): POutputBlockItemData;
710	>	function TOutputBlock.AddSpecialItem(BufPtr: PByte): POutputBlockItemData;
711		begin
712		new(Result);
713		with Result^ do
#	Line 569 | Line 720 | begin
720		end;
721		end;
722
723	+	function TOutputBlock.AddDateTimeItem(BufPtr: PByte): POutputBlockItemData;
724	+	begin
725	+	new(Result);
726	+	with Result^ do
727	+	begin
728	+	FDataType := dtDateTime;
729	+	FBufPtr := BufPtr;
730	+	with FirebirdClientAPI do
731	+	FDataLength := DecodeInteger(FBufPtr+1, 2);
732	+	FSize := FDataLength + 3;
733	+	SetLength(FSubItems,0);
734	+	end;
735	+	end;
736	+
737	+	function TOutputBlock.AddOctetString(BufPtr: PByte): POutputBlockItemData;
738	+	begin
739	+	new(Result);
740	+	with Result^ do
741	+	begin
742	+	FDataType := dtOctetString;
743	+	FBufPtr := BufPtr;
744	+	with FirebirdClientAPI do
745	+	FDataLength := DecodeInteger(FBufPtr+1, 2);
746	+	FSize := FDataLength + 3;
747	+	SetLength(FSubItems,0);
748	+	end;
749	+	end;
750	+
751		constructor TOutputBlock.Create(aSize: integer);
752		begin
753		inherited Create;
#	Line 594 | Line 773 | begin
773		inherited Destroy;
774		end;
775
776	<	function TOutputBlock.Buffer: PChar;
776	>	function TOutputBlock.Buffer: PByte;
777		begin
778		Result := FBuffer;
779		end;
#	Line 624 | Line 803 | var i: integer;
803		begin
804		Result := nil;
805		for i := 0 to getCount - 1 do
806	<	if FItems[i]^.FBufPtr^ = char(ItemType) then
806	>	if byte(FItems[i]^.FBufPtr^) = ItemType then
807		begin
808		Result := FItems[i];
809		Exit;
#	Line 633 | Line 812 | end;
812
813		{$IFDEF DEBUGOUTPUTBLOCK}
814		procedure TOutputBlock.FormattedPrint(
815	<	const aItems: array of POutputBlockItemData; Indent: string);
815	>	const aItems: array of POutputBlockItemData; Indent: AnsiString);
816
817		var i: integer;
818		item: TOutputBlockItem;
#	Line 686 | Line 865 | end;
865		{ TDBInfoItem }
866
867		procedure TDBInfoItem.DecodeIDCluster(var ConnectionType: integer;
868	<	var DBFileName, DBSiteName: string);
869	<	var  P: PChar;
868	>	var DBFileName, DBSiteName: AnsiString);
869	>	var  P: PByte;
870		begin
871		with ItemData^ do
872	<	if FBufPtr^ = char(isc_info_db_id) then
872	>	if FBufPtr^ = isc_info_db_id then
873		begin
874		P := FBufPtr + 3;
875		if FDataLength > 0 then
876		ConnectionType := integer(P^);
877		Inc(P);
878		SetString(DBFileName,P+1,byte(P^),CP_ACP);
879	<	P += Length(DBFileName) + 1;
879	>	P := P + Length(DBFileName) + 1;
880		SetString(DBSiteName,P+1,byte(P^),CP_ACP);
881		end
882		else
#	Line 705 | Line 884 | begin
884		end;
885
886		procedure TDBInfoItem.DecodeVersionString(var Version: byte;
887	<	var VersionString: string);
888	<	var  P: PChar;
887	>	var VersionString: AnsiString);
888	>	var  P: PByte;
889		begin
890		with ItemData^ do
891	<	if FBufPtr^ = char(isc_info_version) then
891	>	if FBufPtr^ = isc_info_version then
892		begin
893		P := FBufPtr+3;
894		VersionString := '';
#	Line 722 | Line 901 | begin
901		end;
902
903		procedure TDBInfoItem.DecodeUserNames(UserNames: TStrings);
904	<	var P: PChar;
905	<	s: string;
904	>	var P: PByte;
905	>	s: AnsiString;
906		begin
907		with ItemData^ do
908	<	if FBufPtr^ = char(isc_info_user_names) then
908	>	if FBufPtr^ = isc_info_user_names then
909		begin
910		P := FBufPtr+3;
911		while (P < FBufPtr + FSize) do
912		begin
913		SetString(s,P+1,byte(P^),CP_ACP);
914		UserNames.Add(s);
915	<	P += Length(s) + 1;
915	>	P := P + Length(s) + 1;
916		end;
917		end
918		else
#	Line 742 | Line 921 | end;
921
922		function TDBInfoItem.getOperationCounts: TDBOperationCounts;
923		var tableCounts: integer;
924	<	P: PChar;
924	>	P: PByte;
925		i: integer;
926		begin
927		with ItemData^ do
#	Line 768 | Line 947 | end;
947
948		{ TDBInformation }
949
950	<	function TDBInformation.AddSpecialItem(BufPtr: PChar): POutputBlockItemData;
950	>	function TDBInformation.AddSpecialItem(BufPtr: PByte): POutputBlockItemData;
951		begin
952		Result := inherited AddSpecialItem(BufPtr);
953		with Result^ do
#	Line 780 | Line 959 | begin
959		end;
960
961		procedure TDBInformation.DoParseBuffer;
962	<	var P: PChar;
962	>	var P: PByte;
963		index: integer;
964		begin
965		P := Buffer;
966		index := 0;
967		SetLength(FItems,0);
968	<	while (P^ <> char(isc_info_end)) and (P < Buffer + getBufSize) do
968	>	while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
969		begin
970		SetLength(FItems,index+1);
971		case byte(P^) of
972	+	isc_info_db_read_only,
973		isc_info_no_reserve,
974		isc_info_allocation,
975		isc_info_ods_minor_version,
#	Line 804 | Line 984 | begin
984		isc_info_fetches,
985		isc_info_marks,
986		isc_info_reads,
987	<	isc_info_writes:
987	>	isc_info_writes,
988	>	isc_info_active_tran_count,
989	>	fb_info_pages_used,
990	>	fb_info_pages_free,
991	>	fb_info_conn_flags:
992		FItems[index] := AddIntegerItem(P);
993
994		isc_info_implementation,
995		isc_info_base_level:
996		FItems[index] := AddBytesItem(P);
997
998	+	isc_info_creation_date:
999	+	FItems[index] := AddDateTimeItem(P);
1000	+
1001	+	fb_info_page_contents:
1002	+	FItems[index] := AddOctetString(P);
1003	+
1004	+	fb_info_crypt_key:
1005	+	FItems[index] := AddStringItem(P);
1006	+
1007		isc_info_db_id,
1008		isc_info_version,
1009		isc_info_backout_count,
#	Line 827 | Line 1020 | begin
1020		else
1021		FItems[index] := AddSpecialItem(P);
1022		end;
1023	<	P += FItems[index]^.FSize;
1023	>	P := P + FItems[index]^.FSize;
1024		Inc(index);
1025		end;
1026		end;
1027
1028	+	{$IFNDEF FPC}
1029	+	function TDBInformation.Find(ItemType: byte): IDBInfoItem;
1030	+	begin
1031	+	Result := inherited Find(ItemType);
1032	+	if Result.GetSize = 0 then
1033	+	Result := nil;
1034	+	end;
1035	+	{$ENDIF}
1036	+
1037		constructor TDBInformation.Create(aSize: integer);
1038		begin
1039		inherited Create(aSize);
#	Line 840 | Line 1042 | end;
1042
1043		{ TServiceQueryResults }
1044
1045	<	function TServiceQueryResults.AddListItem(BufPtr: PChar): POutputBlockItemData;
1046	<	var P: PChar;
1045	>	function TServiceQueryResults.AddListItem(BufPtr: PByte): POutputBlockItemData;
1046	>	var P: PByte;
1047		i: integer;
1048		group: byte;
1049		begin
#	Line 857 | Line 1059 | begin
1059		end;
1060		with Result^ do
1061		begin
1062	<	while (P < FBufPtr + FSize) and (P^ <> char(isc_info_flag_end)) do
1062	>	while (P < FBufPtr + FSize) and (P^ <> isc_info_flag_end) do
1063		begin
1064		SetLength(FSubItems,i+1);
1065		case group of
#	Line 904 | Line 1106 | begin
1106
1107		isc_info_svc_get_users:
1108		case integer(P^) of
1109	+	isc_spb_sec_admin,
1110		isc_spb_sec_userid,
1111		isc_spb_sec_groupid:
1112		FSubItems[i] := AddIntegerItem(P);
#	Line 920 | Line 1123 | begin
1123		end;
1124
1125		end;
1126	<	P +=  FSubItems[i]^.FSize;
1126	>	P := P + FSubItems[i]^.FSize;
1127		Inc(i);
1128		end;
1129		FDataLength := 0;
1130		for i := 0 to Length(FSubItems) - 1 do
1131	<	FDataLength += FSubItems[i]^.FSize;
1131	>	FDataLength := FDataLength + FSubItems[i]^.FSize;
1132		if group in [isc_info_svc_get_users,isc_info_svc_limbo_trans] then
1133		Exit;
1134
1135	<	if (P < FBufPtr + FSize) and (P^ = char(isc_info_flag_end)) then
1135	>	if (P < FBufPtr + FSize) and (P^ = isc_info_flag_end) then
1136		FSize := FDataLength + 2 {include start and end flag}
1137		else
1138		FSize := FDataLength + 1; {start flag only}
1139		end;
1140		end;
1141
1142	<	function TServiceQueryResults.AddSpecialItem(BufPtr: PChar
1142	>	function TServiceQueryResults.AddSpecialItem(BufPtr: PByte
1143		): POutputBlockItemData;
1144	<	var P: PChar;
1144	>	var P: PByte;
1145		i: integer;
1146		begin
1147		Result := inherited AddSpecialItem(BufPtr);
#	Line 952 | Line 1155 | begin
1155		while P < FBufPtr + FDataLength do
1156		begin
1157		FSubItems[i] := AddIntegerItem(P);
1158	<	P +=  FSubItems[i]^.FSize;
1158	>	P := P + FSubItems[i]^.FSize;
1159		Inc(i);
1160		end;
1161		end;
1162		end;
1163
1164		procedure TServiceQueryResults.DoParseBuffer;
1165	<	var P: PChar;
1165	>	var P: PByte;
1166		i: integer;
1167		begin
1168		P := Buffer;
1169		i := 0;
1170	<	while  (P < Buffer + getBufSize) and (P^ <> char(isc_info_end)) do
1170	>	while  (P < Buffer + getBufSize) and (P^ <> isc_info_end) do
1171		begin
1172		SetLength(FItems,i+1);
1173		case integer(P^) of
#	Line 1003 | Line 1206 | begin
1206		else
1207		IBError(ibxeOutputParsingError, [integer(P^)]);
1208		end;
1209	<	P += FItems[i]^.FSize;
1209	>	P := P + FItems[i]^.FSize;
1210		Inc(i);
1211		end;
1212		end;
1213
1214	+	{$IFNDEF FPC}
1215	+	function TServiceQueryResults.Find(ItemType: byte): IServiceQueryResultItem;
1216	+	begin
1217	+	Result := inherited Find(ItemType);
1218	+	if Result.GetSize = 0 then
1219	+	Result := nil;
1220	+	end;
1221	+	{$ENDIF}
1222	+
1223		{ TSQLInfoResultsBuffer }
1224
1225	<	function TSQLInfoResultsBuffer.AddListItem(BufPtr: PChar): POutputBlockItemData;
1226	<	var P: PChar;
1225	>	function TSQLInfoResultsBuffer.AddListItem(BufPtr: PByte): POutputBlockItemData;
1226	>	var P: PByte;
1227		i: integer;
1228		begin
1229		Result := inherited AddListItem(BufPtr);
#	Line 1049 | Line 1261 | begin
1261		else
1262		FSubItems[i] := AddSpecialItem(P);
1263		end;
1264	<	P +=  FSubItems[i]^.FSize;
1264	>	P := P + FSubItems[i]^.FSize;
1265		Inc(i);
1266		end;
1267		end;
#	Line 1057 | Line 1269 | begin
1269		end;
1270
1271		procedure TSQLInfoResultsBuffer.DoParseBuffer;
1272	<	var P: PChar;
1272	>	var P: PByte;
1273		index: integer;
1274		begin
1275		P := Buffer;
1276		index := 0;
1277		SetLength(FItems,0);
1278	<	while (P^ <> char(isc_info_end)) and (P < Buffer + getBufSize) do
1278	>	while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
1279		begin
1280		SetLength(FItems,index+1);
1281		case byte(P^) of
#	Line 1091 | Line 1303 | begin
1303		else
1304		FItems[index] := AddSpecialItem(P);
1305		end;
1306	<	P += FItems[index]^.FSize;
1306	>	P := P + FItems[index]^.FSize;
1307		Inc(index);
1308		end;
1309		end;
#	Line 1100 | Line 1312 | constructor TSQLInfoResultsBuffer.Create
1312		begin
1313		inherited Create(aSize);
1314		FIntegerType := dtInteger;
1315	+	end;
1316	+
1317	+	{ TBlobInfo }
1318	+
1319	+	procedure TBlobInfo.DoParseBuffer;
1320	+	var P: PByte;
1321	+	index: integer;
1322	+	begin
1323	+	P := Buffer;
1324	+	index := 0;
1325	+	SetLength(FItems,0);
1326	+	while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
1327	+	begin
1328	+	SetLength(FItems,index+1);
1329	+	case byte(P^) of
1330	+	isc_info_blob_num_segments,
1331	+	isc_info_blob_max_segment,
1332	+	isc_info_blob_total_length,
1333	+	isc_info_blob_type:
1334	+	FItems[index] := AddIntegerItem(P);
1335	+	else
1336	+	FItems[index] := AddSpecialItem(P);
1337	+	end;
1338	+	P := P + FItems[index]^.FSize;
1339	+	Inc(index);
1340	+	end;
1341	+	end;
1342	+
1343	+	constructor TBlobInfo.Create(aSize: integer);
1344	+	begin
1345	+	inherited Create(aSize);
1346	+	FIntegerType := dtInteger;
1347		end;
1348
1349		end.

Diff Legend

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