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 144 by tony, Sat Feb 24 23:15:51 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	+	function BufToStr(P: PByte; Len: integer):AnsiString;
306	+	begin
307	+	SetLength(Result,Len);
308	+	Move(P^,Result[1],Len);
309	+	end;
310	+
311	+	{$IFDEF FPC}
312		{ TOutputBlockItemGroup }
313
314	<	function TOutputBlockItemGroup.GetItem(index: integer): _IItem;
314	>	function TOutputBlockItemGroup<_TItem,_IItem>.GetItem(index: integer): _IItem;
315		var P: POutputBlockItemData;
316		begin
317		P := inherited getItem(index);
318		Result := _TItem.Create(self.Owner,P);
319		end;
320
321	<	function TOutputBlockItemGroup.Find(ItemType: byte): _IItem;
321	>	function TOutputBlockItemGroup<_TItem,_IItem>.Find(ItemType: byte): _IItem;
322		var P: POutputBlockItemData;
323		begin
324		P := inherited Find(ItemType);
#	Line 251 | Line 327 | end;
327
328		{ TCustomOutputBlock }
329
330	<	function TCustomOutputBlock.getItem(index: integer): _IItem;
330	>	function TCustomOutputBlock<_TItem,_IItem>.getItem(index: integer): _IItem;
331		var P: POutputBlockItemData;
332		begin
333		P := inherited getItem(index);
334		Result := _TItem.Create(self,P)
335		end;
336
337	<	function TCustomOutputBlock.find(ItemType: byte): _IItem;
337	>	function TCustomOutputBlock<_TItem,_IItem>.find(ItemType: byte): _IItem;
338		var P: POutputBlockItemData;
339		begin
340		P := inherited Find(ItemType);
341	<	Result := _TItem.Create(self,P)
341	>	if P = nil then
342	>	Result := nil
343	>	else
344	>	Result := _TItem.Create(self,P)
345		end;
346
347	+	{$ELSE}
348	+
349		{ TOutputBlockItemGroup }
350
351	+	function TOutputBlockItemGroup<_TItem,_IItem>.GetItem(index: integer): _IItem;
352	+	var P: POutputBlockItemData;
353	+	Obj: TOutputBlockItem;
354	+	begin
355	+	P := inherited getItem(index);
356	+	Obj := TOutputBlockItemClass(_TItem).Create(self.Owner,P);
357	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
358	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
359	+	end;
360	+
361	+	function TOutputBlockItemGroup<_TItem,_IItem>.Find(ItemType: byte): _IItem;
362	+	var P: POutputBlockItemData;
363	+	Obj: TOutputBlockItem;
364	+	begin
365	+	P := inherited Find(ItemType);
366	+	if P = nil then
367	+	Result := Default(_IITEM)
368	+	else
369	+	begin
370	+	Obj := TOutputBlockItemClass(_TItem).Create(self.Owner,P);
371	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
372	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
373	+	end;
374	+	end;
375	+
376	+	{ TCustomOutputBlock }
377	+
378	+	function TCustomOutputBlock<_TItem,_IItem>.getItem(index: integer): _IItem;
379	+	var P: POutputBlockItemData;
380	+	Obj: TOutputBlockItem;
381	+	begin
382	+	P := inherited getItem(index);
383	+	Obj := TOutputBlockItemClass(_TItem).Create(self,P);
384	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
385	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
386	+	end;
387	+
388	+	function TCustomOutputBlock<_TItem,_IItem>.find(ItemType: byte): _IItem;
389	+	var P: POutputBlockItemData;
390	+	Obj: TOutputBlockItem;
391	+	begin
392	+	P := inherited Find(ItemType);
393	+	Obj := TOutputBlockItemClass(_TItem).Create(self,P);
394	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
395	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
396	+	end;
397	+
398	+	{$ENDIF}
399	+
400	+	{ TOutputBlockItem }
401	+
402		function TOutputBlockItem.GetCount: integer;
403		begin
404		Result := Length(FItemData^.FSubItems);
#	Line 286 | Line 418 | var i: integer;
418		begin
419		Result := nil;
420		for i := 0 to GetCount - 1 do
421	<	if FItemData^.FSubItems[i]^.FBufPtr^ = char(ItemType) then
421	>	if byte(FItemData^.FSubItems[i]^.FBufPtr^) = ItemType then
422		begin
423		Result := FItemData^.FSubItems[i];
424		Exit;
#	Line 295 | Line 427 | end;
427
428		{ TOutputBlockItem }
429
430	<	procedure TOutputBlockItem.SetString(out S: AnsiString; Buf: PAnsiChar;
431	<	Len: SizeInt; CodePage: TSystemCodePage);
430	>	procedure TOutputBlockItem.SetString(out S: AnsiString; Buf: PByte;
431	>	Len: integer; CodePage: TSystemCodePage);
432		var rs: RawByteString;
433		begin
434	<	system.SetString(rs,Buf,len);
434	>	system.SetString(rs,PAnsiChar(Buf),len);
435		SetCodePage(rs,CodePage,false);
436		S := rs;
437		end;
#	Line 320 | Line 452 | end;
452
453		function TOutputBlockItem.getSize: integer;
454		begin
455	<	Result := FItemData^.FDataLength;
455	>	if FItemData = nil then
456	>	Result := 0
457	>	else
458	>	Result := FItemData^.FDataLength;
459		end;
460
461		procedure TOutputBlockItem.getRawBytes(var Buffer);
#	Line 355 | Line 490 | begin
490		Result := byte(FItemData^.FBufPtr^)
491		end;
492
493	<	function TOutputBlockItem.getAsString: string;
493	>	function TOutputBlockItem.getAsString: AnsiString;
494		var len: integer;
495		begin
496		Result := '';
497		with FItemData^ do
498		case FDataType of
499	+	dtIntegerFixed,
500		dtInteger:
501		Result := IntToStr(getAsInteger);
502		dtByte:
#	Line 376 | Line 512 | begin
512		len := DecodeInteger(FBufPtr+1,2);
513		SetString(Result,FBufPtr+3,len,CP_ACP);
514		end;
515	+	dtOctetString:
516	+	begin
517	+	with FirebirdClientAPI do
518	+	len := DecodeInteger(FBufPtr+1,2);
519	+	SetString(Result,FBufPtr+3,len,CP_NONE);
520	+	end;
521		else
522		IBError(ibxeOutputBlockTypeError,[nil]);
523		end;
#	Line 392 | Line 534 | end;
534
535		function TOutputBlockItem.getAsBytes: TByteArray;
536		var i: integer;
537	<	P: PChar;
537	>	P: PByte;
538		begin
539		with FItemData^ do
540		if FDataType = dtBytes then
#	Line 409 | Line 551 | begin
551		IBError(ibxeOutputBlockTypeError,[nil]);
552		end;
553
554	+	function TOutputBlockItem.getAsDateTime: TDateTime;
555	+	var aDate: integer;
556	+	aTime: integer;
557	+	begin
558	+	with FItemData^, FirebirdClientAPI do
559	+	if FDataType = dtDateTime then
560	+	begin
561	+	aDate := DecodeInteger(FBufPtr+3,4);
562	+	aTime := DecodeInteger(FBufPtr+7,4);
563	+	Result := SQLDecodeDate(@aDate) + SQLDecodeTime(@aTime)
564	+	end
565	+	else
566	+	IBError(ibxeOutputBlockTypeError,[nil]);
567	+	end;
568	+
569	+
570		function TOutputBlockItem.CopyTo(stream: TStream; count: integer): integer;
571		var len: integer;
572		begin
#	Line 454 | Line 612 | begin
612		FBufferParsed := true;
613		end;
614
615	<	function TOutputBlock.AddItem(BufPtr: PChar): POutputBlockItemData;
615	>	function TOutputBlock.AddItem(BufPtr: PByte): POutputBlockItemData;
616		begin
617		new(Result);
618		with Result^ do
#	Line 467 | Line 625 | begin
625		end;
626		end;
627
628	<	function TOutputBlock.AddIntegerItem(BufPtr: PChar): POutputBlockItemData;
628	>	function TOutputBlock.AddIntegerItem(BufPtr: PByte): POutputBlockItemData;
629		begin
630		new(Result);
631		with Result^ do
#	Line 489 | Line 647 | begin
647		end;
648		end;
649
650	<	function TOutputBlock.AddStringItem(BufPtr: PChar): POutputBlockItemData;
650	>	function TOutputBlock.AddStringItem(BufPtr: PByte): POutputBlockItemData;
651		begin
652		new(Result);
653		with Result^ do
#	Line 503 | Line 661 | begin
661		end;
662		end;
663
664	<	function TOutputBlock.AddShortStringItem(BufPtr: PChar): POutputBlockItemData;
664	>	function TOutputBlock.AddShortStringItem(BufPtr: PByte): POutputBlockItemData;
665		begin
666		new(Result);
667		with Result^ do
#	Line 516 | Line 674 | begin
674		end;
675		end;
676
677	<	function TOutputBlock.AddByteItem(BufPtr: PChar): POutputBlockItemData;
677	>	function TOutputBlock.AddByteItem(BufPtr: PByte): POutputBlockItemData;
678		begin
679		new(Result);
680		with Result^ do
#	Line 529 | Line 687 | begin
687		end;
688		end;
689
690	<	function TOutputBlock.AddBytesItem(BufPtr: PChar): POutputBlockItemData;
690	>	function TOutputBlock.AddBytesItem(BufPtr: PByte): POutputBlockItemData;
691		begin
692		new(Result);
693		with Result^ do
#	Line 543 | Line 701 | begin
701		end;
702		end;
703
704	<	function TOutputBlock.AddListItem(BufPtr: PChar): POutputBlockItemData;
704	>	function TOutputBlock.AddListItem(BufPtr: PByte): POutputBlockItemData;
705		begin
706		new(Result);
707		with Result^ do
#	Line 556 | Line 714 | begin
714		end;
715		end;
716
717	<	function TOutputBlock.AddSpecialItem(BufPtr: PChar): POutputBlockItemData;
717	>	function TOutputBlock.AddSpecialItem(BufPtr: PByte): POutputBlockItemData;
718		begin
719		new(Result);
720		with Result^ do
#	Line 569 | Line 727 | begin
727		end;
728		end;
729
730	+	function TOutputBlock.AddDateTimeItem(BufPtr: PByte): POutputBlockItemData;
731	+	begin
732	+	new(Result);
733	+	with Result^ do
734	+	begin
735	+	FDataType := dtDateTime;
736	+	FBufPtr := BufPtr;
737	+	with FirebirdClientAPI do
738	+	FDataLength := DecodeInteger(FBufPtr+1, 2);
739	+	FSize := FDataLength + 3;
740	+	SetLength(FSubItems,0);
741	+	end;
742	+	end;
743	+
744	+	function TOutputBlock.AddOctetString(BufPtr: PByte): POutputBlockItemData;
745	+	begin
746	+	new(Result);
747	+	with Result^ do
748	+	begin
749	+	FDataType := dtOctetString;
750	+	FBufPtr := BufPtr;
751	+	with FirebirdClientAPI do
752	+	FDataLength := DecodeInteger(FBufPtr+1, 2);
753	+	FSize := FDataLength + 3;
754	+	SetLength(FSubItems,0);
755	+	end;
756	+	end;
757	+
758		constructor TOutputBlock.Create(aSize: integer);
759		begin
760		inherited Create;
#	Line 586 | Line 772 | var i, j: integer;
772		begin
773		for i := 0 to length(FItems) - 1 do
774		begin
775	<	for j := 0 to Length(FItems[i]^.FSubItems) -1 do
776	<	dispose(FItems[i]^.FSubItems[j]);
777	<	dispose(FItems[i]);
775	>	if FItems[i] <> nil then
776	>	begin
777	>	for j := 0 to Length(FItems[i]^.FSubItems) -1 do
778	>	if FItems[i]^.FSubItems[j] <> nil then
779	>	dispose(FItems[i]^.FSubItems[j]);
780	>	dispose(FItems[i]);
781	>	end;
782		end;
783		FreeMem(FBuffer);
784		inherited Destroy;
785		end;
786
787	<	function TOutputBlock.Buffer: PChar;
787	>	function TOutputBlock.Buffer: PByte;
788		begin
789		Result := FBuffer;
790		end;
#	Line 624 | Line 814 | var i: integer;
814		begin
815		Result := nil;
816		for i := 0 to getCount - 1 do
817	<	if FItems[i]^.FBufPtr^ = char(ItemType) then
817	>	if byte(FItems[i]^.FBufPtr^) = ItemType then
818		begin
819		Result := FItems[i];
820		Exit;
#	Line 633 | Line 823 | end;
823
824		{$IFDEF DEBUGOUTPUTBLOCK}
825		procedure TOutputBlock.FormattedPrint(
826	<	const aItems: array of POutputBlockItemData; Indent: string);
826	>	const aItems: array of POutputBlockItemData; Indent: AnsiString);
827
828		var i: integer;
829		item: TOutputBlockItem;
#	Line 664 | Line 854 | begin
854		else
855		begin
856		item := TOutputBlockItem.Create(self,(aItems[i]));
857	<	writeln(Indent,'ItemType = ',byte(FBufPtr^),' Value = ',(item as TOutputBlockItem).GetAsString);
857	>	try
858	>	writeln(Indent,'ItemType = ',byte(FBufPtr^),' Value = ',(item as TOutputBlockItem).GetAsString);
859	>	except
860	>	writeln(Indent,'Unknown ItemType = ',byte(FBufPtr^));
861	>	end;
862		end;
863		end;
864		end;
#	Line 681 | Line 875 | begin
875		if byte(FBuffer[i]) = isc_info_end then break;
876		end;
877		writeln;
878	+	for i := 0 to getBufSize - 1 do
879	+	begin
880	+	if chr(FBuffer[i]) in [' '..'~'] then
881	+	write(chr(Buffer[i]))
882	+	else
883	+	write('.');
884	+	if byte(FBuffer[i]) = isc_info_end then break;
885	+	end;
886	+	writeln;
887		end;
888
889		{ TDBInfoItem }
890
891		procedure TDBInfoItem.DecodeIDCluster(var ConnectionType: integer;
892	<	var DBFileName, DBSiteName: string);
893	<	var  P: PChar;
892	>	var DBFileName, DBSiteName: AnsiString);
893	>	var  P: PByte;
894		begin
895		with ItemData^ do
896	<	if FBufPtr^ = char(isc_info_db_id) then
896	>	if FBufPtr^ = isc_info_db_id then
897		begin
898		P := FBufPtr + 3;
899		if FDataLength > 0 then
900		ConnectionType := integer(P^);
901		Inc(P);
902		SetString(DBFileName,P+1,byte(P^),CP_ACP);
903	<	P += Length(DBFileName) + 1;
903	>	P := P + Length(DBFileName) + 1;
904		SetString(DBSiteName,P+1,byte(P^),CP_ACP);
905		end
906		else
#	Line 705 | Line 908 | begin
908		end;
909
910		procedure TDBInfoItem.DecodeVersionString(var Version: byte;
911	<	var VersionString: string);
912	<	var  P: PChar;
911	>	var VersionString: AnsiString);
912	>	var  P: PByte;
913		begin
914		with ItemData^ do
915	<	if FBufPtr^ = char(isc_info_version) then
915	>	if FBufPtr^ = isc_info_version then
916		begin
917		P := FBufPtr+3;
918		VersionString := '';
#	Line 722 | Line 925 | begin
925		end;
926
927		procedure TDBInfoItem.DecodeUserNames(UserNames: TStrings);
928	<	var P: PChar;
929	<	s: string;
928	>	var P: PByte;
929	>	s: AnsiString;
930		begin
931		with ItemData^ do
932	<	if FBufPtr^ = char(isc_info_user_names) then
932	>	if FBufPtr^ = isc_info_user_names then
933		begin
934		P := FBufPtr+3;
935		while (P < FBufPtr + FSize) do
936		begin
937		SetString(s,P+1,byte(P^),CP_ACP);
938		UserNames.Add(s);
939	<	P += Length(s) + 1;
939	>	P := P + Length(s) + 1;
940		end;
941		end
942		else
#	Line 742 | Line 945 | end;
945
946		function TDBInfoItem.getOperationCounts: TDBOperationCounts;
947		var tableCounts: integer;
948	<	P: PChar;
948	>	P: PByte;
949		i: integer;
950		begin
951		with ItemData^ do
#	Line 768 | Line 971 | end;
971
972		{ TDBInformation }
973
974	<	function TDBInformation.AddSpecialItem(BufPtr: PChar): POutputBlockItemData;
974	>	function TDBInformation.AddSpecialItem(BufPtr: PByte): POutputBlockItemData;
975		begin
976		Result := inherited AddSpecialItem(BufPtr);
977		with Result^ do
#	Line 780 | Line 983 | begin
983		end;
984
985		procedure TDBInformation.DoParseBuffer;
986	<	var P: PChar;
986	>	var P: PByte;
987		index: integer;
988		begin
989		P := Buffer;
990		index := 0;
991		SetLength(FItems,0);
992	<	while (P^ <> char(isc_info_end)) and (P < Buffer + getBufSize) do
992	>	while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
993		begin
994		SetLength(FItems,index+1);
995		case byte(P^) of
996	+	isc_info_db_read_only,
997		isc_info_no_reserve,
998		isc_info_allocation,
999		isc_info_ods_minor_version,
#	Line 804 | Line 1008 | begin
1008		isc_info_fetches,
1009		isc_info_marks,
1010		isc_info_reads,
1011	<	isc_info_writes:
1011	>	isc_info_writes,
1012	>	isc_info_active_tran_count,
1013	>	fb_info_pages_used,
1014	>	fb_info_pages_free,
1015	>	fb_info_conn_flags:
1016		FItems[index] := AddIntegerItem(P);
1017
1018		isc_info_implementation,
1019		isc_info_base_level:
1020		FItems[index] := AddBytesItem(P);
1021
1022	+	isc_info_creation_date:
1023	+	FItems[index] := AddDateTimeItem(P);
1024	+
1025	+	fb_info_page_contents:
1026	+	FItems[index] := AddOctetString(P);
1027	+
1028	+	fb_info_crypt_key:
1029	+	FItems[index] := AddStringItem(P);
1030	+
1031		isc_info_db_id,
1032		isc_info_version,
1033		isc_info_backout_count,
#	Line 827 | Line 1044 | begin
1044		else
1045		FItems[index] := AddSpecialItem(P);
1046		end;
1047	<	P += FItems[index]^.FSize;
1047	>	P := P + FItems[index]^.FSize;
1048		Inc(index);
1049		end;
1050		end;
1051
1052	+	{$IFNDEF FPC}
1053	+	function TDBInformation.Find(ItemType: byte): IDBInfoItem;
1054	+	begin
1055	+	Result := inherited Find(ItemType);
1056	+	if Result.GetSize = 0 then
1057	+	Result := nil;
1058	+	end;
1059	+	{$ENDIF}
1060	+
1061		constructor TDBInformation.Create(aSize: integer);
1062		begin
1063		inherited Create(aSize);
#	Line 840 | Line 1066 | end;
1066
1067		{ TServiceQueryResults }
1068
1069	<	function TServiceQueryResults.AddListItem(BufPtr: PChar): POutputBlockItemData;
1070	<	var P: PChar;
1069	>	function TServiceQueryResults.AddListItem(BufPtr: PByte): POutputBlockItemData;
1070	>	var P: PByte;
1071		i: integer;
1072		group: byte;
1073		begin
#	Line 857 | Line 1083 | begin
1083		end;
1084		with Result^ do
1085		begin
1086	<	while (P < FBufPtr + FSize) and (P^ <> char(isc_info_flag_end)) do
1086	>	while (P < FBufPtr + FSize) and (P^ <> isc_info_flag_end) do
1087		begin
1088		SetLength(FSubItems,i+1);
1089	+	FSubItems[i] := nil;
1090		case group of
1091		isc_info_svc_svr_db_info:
1092		case integer(P^) of
#	Line 871 | Line 1098 | begin
1098		FSubItems[i] := AddStringItem(P);
1099
1100		else
1101	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1101	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1102		end;
1103
1104		isc_info_svc_get_license:
#	Line 880 | Line 1107 | begin
1107		isc_spb_lic_key:
1108		FSubItems[i] := AddIntegerItem(P);
1109		else
1110	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1110	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1111		end;
1112
1113		isc_info_svc_limbo_trans:
#	Line 899 | Line 1126 | begin
1126		isc_spb_tra_state:
1127		FSubItems[i] := AddByteItem(P);
1128		else
1129	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1129	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1130		end;
1131
1132		isc_info_svc_get_users:
1133		case integer(P^) of
1134	+	isc_spb_sec_admin,
1135		isc_spb_sec_userid,
1136		isc_spb_sec_groupid:
1137		FSubItems[i] := AddIntegerItem(P);
#	Line 916 | Line 1144 | begin
1144		FSubItems[i] := AddStringItem(P);
1145
1146		else
1147	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1147	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1148		end;
1149
1150		end;
1151	<	P +=  FSubItems[i]^.FSize;
1151	>	P := P + FSubItems[i]^.FSize;
1152		Inc(i);
1153		end;
1154		FDataLength := 0;
1155		for i := 0 to Length(FSubItems) - 1 do
1156	<	FDataLength += FSubItems[i]^.FSize;
1156	>	FDataLength := FDataLength + FSubItems[i]^.FSize;
1157		if group in [isc_info_svc_get_users,isc_info_svc_limbo_trans] then
1158		Exit;
1159
1160	<	if (P < FBufPtr + FSize) and (P^ = char(isc_info_flag_end)) then
1160	>	if (P < FBufPtr + FSize) and (P^ = isc_info_flag_end) then
1161		FSize := FDataLength + 2 {include start and end flag}
1162		else
1163		FSize := FDataLength + 1; {start flag only}
1164		end;
1165		end;
1166
1167	<	function TServiceQueryResults.AddSpecialItem(BufPtr: PChar
1167	>	function TServiceQueryResults.AddSpecialItem(BufPtr: PByte
1168		): POutputBlockItemData;
1169	<	var P: PChar;
1169	>	var P: PByte;
1170		i: integer;
1171		begin
1172		Result := inherited AddSpecialItem(BufPtr);
#	Line 952 | Line 1180 | begin
1180		while P < FBufPtr + FDataLength do
1181		begin
1182		FSubItems[i] := AddIntegerItem(P);
1183	<	P +=  FSubItems[i]^.FSize;
1183	>	P := P + FSubItems[i]^.FSize;
1184		Inc(i);
1185		end;
1186		end;
1187		end;
1188
1189		procedure TServiceQueryResults.DoParseBuffer;
1190	<	var P: PChar;
1190	>	var P: PByte;
1191		i: integer;
1192		begin
1193		P := Buffer;
1194		i := 0;
1195	<	while  (P < Buffer + getBufSize) and (P^ <> char(isc_info_end)) do
1195	>	while  (P < Buffer + getBufSize) and (P^ <> isc_info_end) do
1196		begin
1197		SetLength(FItems,i+1);
1198	+	FItems[i] := nil;
1199		case integer(P^) of
1200		isc_info_svc_line,
1201		isc_info_svc_get_env,
#	Line 1001 | Line 1230 | begin
1230
1231
1232		else
1233	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1233	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,getBufSize - (P-Buffer))]);
1234		end;
1235	<	P += FItems[i]^.FSize;
1235	>	P := P + FItems[i]^.FSize;
1236		Inc(i);
1237		end;
1238		end;
1239
1240	+	{$IFNDEF FPC}
1241	+	function TServiceQueryResults.Find(ItemType: byte): IServiceQueryResultItem;
1242	+	begin
1243	+	Result := inherited Find(ItemType);
1244	+	if Result.GetSize = 0 then
1245	+	Result := nil;
1246	+	end;
1247	+	{$ENDIF}
1248	+
1249		{ TSQLInfoResultsBuffer }
1250
1251	<	function TSQLInfoResultsBuffer.AddListItem(BufPtr: PChar): POutputBlockItemData;
1252	<	var P: PChar;
1251	>	function TSQLInfoResultsBuffer.AddListItem(BufPtr: PByte): POutputBlockItemData;
1252	>	var P: PByte;
1253		i: integer;
1254		begin
1255		Result := inherited AddListItem(BufPtr);
#	Line 1049 | Line 1287 | begin
1287		else
1288		FSubItems[i] := AddSpecialItem(P);
1289		end;
1290	<	P +=  FSubItems[i]^.FSize;
1290	>	P := P + FSubItems[i]^.FSize;
1291		Inc(i);
1292		end;
1293		end;
#	Line 1057 | Line 1295 | begin
1295		end;
1296
1297		procedure TSQLInfoResultsBuffer.DoParseBuffer;
1298	<	var P: PChar;
1298	>	var P: PByte;
1299		index: integer;
1300		begin
1301		P := Buffer;
1302		index := 0;
1303		SetLength(FItems,0);
1304	<	while (P^ <> char(isc_info_end)) and (P < Buffer + getBufSize) do
1304	>	while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
1305		begin
1306		SetLength(FItems,index+1);
1307		case byte(P^) of
#	Line 1091 | Line 1329 | begin
1329		else
1330		FItems[index] := AddSpecialItem(P);
1331		end;
1332	<	P += FItems[index]^.FSize;
1332	>	P := P + FItems[index]^.FSize;
1333		Inc(index);
1334		end;
1335		end;
#	Line 1100 | Line 1338 | constructor TSQLInfoResultsBuffer.Create
1338		begin
1339		inherited Create(aSize);
1340		FIntegerType := dtInteger;
1341	+	end;
1342	+
1343	+	{ TBlobInfo }
1344	+
1345	+	procedure TBlobInfo.DoParseBuffer;
1346	+	var P: PByte;
1347	+	index: integer;
1348	+	begin
1349	+	P := Buffer;
1350	+	index := 0;
1351	+	SetLength(FItems,0);
1352	+	while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
1353	+	begin
1354	+	SetLength(FItems,index+1);
1355	+	case byte(P^) of
1356	+	isc_info_blob_num_segments,
1357	+	isc_info_blob_max_segment,
1358	+	isc_info_blob_total_length,
1359	+	isc_info_blob_type:
1360	+	FItems[index] := AddIntegerItem(P);
1361	+	else
1362	+	FItems[index] := AddSpecialItem(P);
1363	+	end;
1364	+	P := P + FItems[index]^.FSize;
1365	+	Inc(index);
1366	+	end;
1367	+	end;
1368	+
1369	+	constructor TBlobInfo.Create(aSize: integer);
1370	+	begin
1371	+	inherited Create(aSize);
1372	+	FIntegerType := dtInteger;
1373		end;
1374
1375		end.

Diff Legend

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