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 263 by tony, Thu Dec 6 15:55:01 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	+	FFirebirdClientAPI: TFBClientAPI;
77		procedure ParseBuffer;
78		{$IFDEF DEBUGOUTPUTBLOCK}
79		procedure FormattedPrint(const aItems: array of POutputBlockItemData;
80	<	Indent: string);
80	>	Indent: AnsiString);
81		{$ENDIF}
82		procedure PrintBuf;
83		protected
#	Line 82 | Line 86 | type
86		FTruncated: boolean;
87		FItems: array of POutputBlockItemData;
88		procedure DoParseBuffer; virtual; abstract;
89	<	function AddItem(BufPtr: PChar): POutputBlockItemData;
90	<	function AddIntegerItem(BufPtr: PChar): POutputBlockItemData;
91	<	function AddStringItem(BufPtr: PChar): POutputBlockItemData;
92	<	function AddShortStringItem(BufPtr: PChar): POutputBlockItemData;
93	<	function AddByteItem(BufPtr: PChar): POutputBlockItemData;
94	<	function AddBytesItem(BufPtr: PChar): POutputBlockItemData;
95	<	function AddListItem(BufPtr: PChar): POutputBlockItemData; virtual;
96	<	function AddSpecialItem(BufPtr: PChar): POutputBlockItemData; virtual;
89	>	function AddItem(BufPtr: PByte): POutputBlockItemData;
90	>	function AddIntegerItem(BufPtr: PByte): POutputBlockItemData;
91	>	function AddStringItem(BufPtr: PByte): POutputBlockItemData;
92	>	function AddShortStringItem(BufPtr: PByte): POutputBlockItemData;
93	>	function AddByteItem(BufPtr: PByte): POutputBlockItemData;
94	>	function AddBytesItem(BufPtr: PByte): POutputBlockItemData;
95	>	function AddListItem(BufPtr: PByte): POutputBlockItemData; virtual;
96	>	function AddSpecialItem(BufPtr: PByte): POutputBlockItemData; virtual;
97	>	function AddDateTimeItem(BufPtr: PByte): POutputBlockItemData;
98	>	function AddOctetString(BufPtr: PByte): POutputBlockItemData;
99		public
100	<	constructor Create(aSize: integer = DefaultBufferSize);
100	>	constructor Create(api: TFBClientAPI; aSize: integer = DefaultBufferSize);
101		destructor Destroy; override;
102	<	function Buffer: PChar;
102	>	function Buffer: PByte;
103		function getBufSize: integer;
104
105		public
#	Line 111 | Line 117 | type
117		FOwner: TOutputBlock;
118		FOwnerIntf: IUnknown;
119		FItemData: POutputBlockItemData;
120	+	FFirebirdClientAPI: TFBClientAPI;
121		protected
122		function GetItem(index: integer): POutputBlockItemData;
123		function Find(ItemType: byte): POutputBlockItemData;
124	<	procedure SetString(out S: AnsiString; Buf: PAnsiChar; Len: SizeInt;
124	>	procedure SetString(out S: AnsiString; Buf: PByte; Len: integer;
125		CodePage: TSystemCodePage);
126		property ItemData: POutputBlockItemData read FItemData;
127		property Owner: TOutputBlock read FOwner;
#	Line 127 | Line 134 | type
134		procedure getRawBytes(var Buffer);
135		function getAsInteger: integer;
136		function getParamType: byte;
137	<	function getAsString: string;
137	>	function getAsString: AnsiString;
138		function getAsByte: byte;
139		function getAsBytes: TByteArray;
140	+	function getAsDateTime: TDateTime;
141		function CopyTo(stream: TStream; count: integer): integer;
142		end;
143
144	+	TServiceQueryResultSubItem = class(TOutputBlockItem,IServiceQueryResultSubItem);
145	+
146		{ TCustomOutputBlock }
147
148	<	generic TCustomOutputBlock<_TItem,_IItem> = class(TOutputBlock)
148	>	{$IFDEF FPC}
149	>	TCustomOutputBlock<_TItem,_IItem> = class(TOutputBlock)
150	>	{$ELSE}
151	>	TOutputBlockItemClass = class of TOutputBlockItem;
152	>	TCustomOutputBlock<_TItem: TOutputBlockItem;_IItem: IUnknown> = class(TOutputBlock)
153	>	{$ENDIF}
154		public
155		function getItem(index: integer): _IItem;
156		function find(ItemType: byte): _IItem;
#	Line 144 | Line 159 | type
159
160		{ TOutputBlockItemGroup }
161
162	<	generic TOutputBlockItemGroup<_TItem;_IItem> = class(TOutputBlockItem)
162	>	{$IFDEF FPC}
163	>	TOutputBlockItemGroup<_TItem,_IItem> = class(TOutputBlockItem)
164	>	{$ELSE}
165	>	TOutputBlockItemGroup<_TItem: TOutputBlockItem; _IItem: IUnknown> = class(TOutputBlockItem)
166	>	{$ENDIF}
167		public
168		function GetItem(index: integer): _IItem;
169		function Find(ItemType: byte): _IItem;
170		property Items[index: integer]: _IItem read getItem; default;
171		end;
172
154	–	TDBInfoItem = class;
155	–
173		{ TDBInfoItem }
174
175	<	TDBInfoItem = class(specialize TOutputBlockItemGroup<TDBInfoItem,IDBInfoItem>,IDBInfoItem)
175	>	{$IFDEF FPC}
176	>	TDBInfoItem = class;
177	>
178	>	TDBInfoItem = class(TOutputBlockItemGroup<TDBInfoItem,IDBInfoItem>,IDBInfoItem)
179	>	{$ELSE}
180	>	TDBInfoItem = class(TOutputBlockItemGroup<TOutputBlockItem,IDBInfoItem>,IDBInfoItem)
181	>	{$ENDIF}
182		public
183	<	procedure DecodeIDCluster(var ConnectionType: integer; var DBFileName, DBSiteName: string);
184	<	procedure DecodeVersionString(var Version: byte; var VersionString: string);
183	>	procedure DecodeIDCluster(var ConnectionType: integer; var DBFileName, DBSiteName: AnsiString);
184	>	procedure DecodeVersionString(var Version: byte; var VersionString: AnsiString);
185		procedure DecodeUserNames(UserNames: TStrings);
186		function getOperationCounts: TDBOperationCounts;
187	<	end;
187	>	end;
188
189		{ TDBInformation }
190
191	<	TDBInformation = class(specialize TCustomOutputBlock<TDBInfoItem,IDBInfoItem>, IDBInformation)
191	>	TDBInformation = class(TCustomOutputBlock<TDBInfoItem,IDBInfoItem>, IDBInformation)
192		protected
193	<	function AddSpecialItem(BufPtr: PChar): POutputBlockItemData; override;
193	>	function AddSpecialItem(BufPtr: PByte): POutputBlockItemData; override;
194		procedure DoParseBuffer; override;
195		public
196	<	constructor Create(aSize: integer=DBInfoDefaultBufferSize);
196	>	constructor Create(api: TFBClientAPI; aSize: integer = DefaultBufferSize);
197	>	{$IFNDEF FPC}
198	>	function Find(ItemType: byte): IDBInfoItem;
199	>	{$ENDIF}
200		end;
201
176	–	TServiceQueryResultSubItem = class(TOutputBlockItem,IServiceQueryResultSubItem);
177	–
202		{ TServiceQueryResultItem }
203
204	<	TServiceQueryResultItem = class(specialize TOutputBlockItemGroup<TServiceQueryResultSubItem,IServiceQueryResultSubItem>,
204	>	TServiceQueryResultItem = class(TOutputBlockItemGroup<TServiceQueryResultSubItem,IServiceQueryResultSubItem>,
205		IServiceQueryResultItem);
206
207		{ TServiceQueryResults }
208
209	<	TServiceQueryResults = class(specialize TCustomOutputBlock<TServiceQueryResultItem,IServiceQueryResultItem>, IServiceQueryResults)
209	>	TServiceQueryResults = class(TCustomOutputBlock<TServiceQueryResultItem,IServiceQueryResultItem>, IServiceQueryResults)
210		protected
211	<	function AddListItem(BufPtr: PChar): POutputBlockItemData; override;
212	<	function AddSpecialItem(BufPtr: PChar): POutputBlockItemData; override;
211	>	function AddListItem(BufPtr: PByte): POutputBlockItemData; override;
212	>	function AddSpecialItem(BufPtr: PByte): POutputBlockItemData; override;
213		procedure DoParseBuffer; override;
214	+	{$IFNDEF FPC}
215	+	public
216	+	function Find(ItemType: byte): IServiceQueryResultItem;
217	+	{$ENDIF}
218		end;
219
220	+
221		{ ISQLInfoItem }
222
223	<	ISQLInfoItem = interface
223	>	ISQLInfoSubItem = interface
224	>	['{39852ee4-4851-44df-8dc0-26b991250098}']
225		function getItemType: byte;
226		function getSize: integer;
227	<	function getAsString: string;
227	>	function getAsString: AnsiString;
228		function getAsInteger: integer;
229	+	end;
230	+
231	+	ISQLInfoItem = interface(ISQLInfoSubItem)
232	+	['{34e3c39d-fe4f-4211-a7e3-0266495a359d}']
233		function GetCount: integer;
234	<	function GetItem(index: integer): ISQLInfoItem;
235	<	function Find(ItemType: byte): ISQLInfoItem;
234	>	function GetItem(index: integer): ISQLInfoSubItem;
235	>	function Find(ItemType: byte): ISQLInfoSubItem;
236		property Count: integer read GetCount;
237	<	property Items[index: integer]: ISQLInfoItem read getItem; default;
237	>	property Items[index: integer]: ISQLInfoSubItem read getItem; default;
238		end;
239
240		{ISQLInfoResults}
241
242		ISQLInfoResults = interface
243	+	['{0b3fbe20-6f80-44e7-85ef-e708bc1f2043}']
244		function GetCount: integer;
245		function GetItem(index: integer): ISQLInfoItem;
246		function Find(ItemType: byte): ISQLInfoItem;
#	Line 213 | Line 248 | type
248		property Items[index: integer]: ISQLInfoItem read getItem; default;
249		end;
250
251	<	TSQLInfoResultsItem = class;
251	>	TSQLInfoResultsSubItem = class(TOutputBlockItem,ISQLInfoSubItem);
252
253		{ TSQLInfoResultsItem }
254
255	<	TSQLInfoResultsItem = class(specialize TOutputBlockItemGroup<TSQLInfoResultsItem,ISQLInfoItem>,ISQLInfoItem);
255	>	TSQLInfoResultsItem = class(TOutputBlockItemGroup<TSQLInfoResultsSubItem,ISQLInfoSubItem>,ISQLInfoItem);
256
257		{ TSQLInfoResultsBuffer }
258
259	<	TSQLInfoResultsBuffer = class(specialize TCustomOutputBlock<TSQLInfoResultsItem,ISQLInfoItem>, ISQLInfoResults)
259	>	TSQLInfoResultsBuffer = class(TCustomOutputBlock<TSQLInfoResultsItem,ISQLInfoItem>, ISQLInfoResults)
260	>	protected
261	>	function AddListItem(BufPtr: PByte): POutputBlockItemData; override;
262	>	procedure DoParseBuffer; override;
263	>	public
264	>	constructor Create(api: TFBClientAPI; aSize: integer= DefaultBufferSize);
265	>	end;
266	>
267	>	IBlobInfoItem = interface
268	>	['{3a55e558-b97f-4cf3-af95-53b84f4d9a65}']
269	>	function getItemType: byte;
270	>	function getSize: integer;
271	>	function getAsString: AnsiString;
272	>	function getAsInteger: integer;
273	>	end;
274	>
275	>	IBlobInfo = interface
276	>	['{8a340109-f600-4d26-ab1d-e0be2c759f1c}']
277	>	function GetCount: integer;
278	>	function GetItem(index: integer): IBlobInfoItem;
279	>	function Find(ItemType: byte): IBlobInfoItem;
280	>	property Count: integer read GetCount;
281	>	property Items[index: integer]: IBlobInfoItem read getItem; default;
282	>	end;
283	>
284	>	{$IFDEF FPC}
285	>	TBlobInfoItem = class;
286	>
287	>	TBlobInfoItem = class(TOutputBlockItemGroup<TBlobInfoItem,IBlobInfoItem>,IBlobInfoItem)
288	>	{$ELSE}
289	>	TBlobInfoItem = class(TOutputBlockItemGroup<TOutputBlockItem,IBlobInfoItem>,IBlobInfoItem)
290	>	{$ENDIF}
291	>
292	>	end;
293	>
294	>	{ TBlobInfo }
295	>
296	>	TBlobInfo = class(TCustomOutputBlock<TBlobInfoItem,IBlobInfoItem>, IBlobInfo)
297		protected
226	–	function AddListItem(BufPtr: PChar): POutputBlockItemData; override;
298		procedure DoParseBuffer; override;
299		public
300	<	constructor Create(aSize: integer = 1024);
300	>	constructor Create(api: TFBClientAPI; aSize: integer = DefaultBufferSize);
301		end;
302
303		implementation
304
305	<	uses FBMessages;
305	>	uses FBMessages {$IFNDEF FPC}, TypInfo {$ENDIF};
306
307	+	function BufToStr(P: PByte; Len: integer):AnsiString;
308	+	begin
309	+	SetLength(Result,Len);
310	+	Move(P^,Result[1],Len);
311	+	end;
312	+
313	+	{$IFDEF FPC}
314		{ TOutputBlockItemGroup }
315
316	<	function TOutputBlockItemGroup.GetItem(index: integer): _IItem;
316	>	function TOutputBlockItemGroup<_TItem,_IItem>.GetItem(index: integer): _IItem;
317		var P: POutputBlockItemData;
318		begin
319		P := inherited getItem(index);
320		Result := _TItem.Create(self.Owner,P);
321		end;
322
323	<	function TOutputBlockItemGroup.Find(ItemType: byte): _IItem;
323	>	function TOutputBlockItemGroup<_TItem,_IItem>.Find(ItemType: byte): _IItem;
324		var P: POutputBlockItemData;
325		begin
326		P := inherited Find(ItemType);
#	Line 251 | Line 329 | end;
329
330		{ TCustomOutputBlock }
331
332	<	function TCustomOutputBlock.getItem(index: integer): _IItem;
332	>	function TCustomOutputBlock<_TItem,_IItem>.getItem(index: integer): _IItem;
333		var P: POutputBlockItemData;
334		begin
335		P := inherited getItem(index);
336		Result := _TItem.Create(self,P)
337		end;
338
339	<	function TCustomOutputBlock.find(ItemType: byte): _IItem;
339	>	function TCustomOutputBlock<_TItem,_IItem>.find(ItemType: byte): _IItem;
340		var P: POutputBlockItemData;
341		begin
342		P := inherited Find(ItemType);
343	<	Result := _TItem.Create(self,P)
343	>	if P = nil then
344	>	Result := nil
345	>	else
346	>	Result := _TItem.Create(self,P)
347		end;
348
349	+	{$ELSE}
350	+
351		{ TOutputBlockItemGroup }
352
353	+	function TOutputBlockItemGroup<_TItem,_IItem>.GetItem(index: integer): _IItem;
354	+	var P: POutputBlockItemData;
355	+	Obj: TOutputBlockItem;
356	+	begin
357	+	P := inherited getItem(index);
358	+	Obj := TOutputBlockItemClass(_TItem).Create(self.Owner,P);
359	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
360	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
361	+	end;
362	+
363	+	function TOutputBlockItemGroup<_TItem,_IItem>.Find(ItemType: byte): _IItem;
364	+	var P: POutputBlockItemData;
365	+	Obj: TOutputBlockItem;
366	+	begin
367	+	P := inherited Find(ItemType);
368	+	if P = nil then
369	+	Result := Default(_IITEM)
370	+	else
371	+	begin
372	+	Obj := TOutputBlockItemClass(_TItem).Create(self.Owner,P);
373	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
374	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
375	+	end;
376	+	end;
377	+
378	+	{ TCustomOutputBlock }
379	+
380	+	function TCustomOutputBlock<_TItem,_IItem>.getItem(index: integer): _IItem;
381	+	var P: POutputBlockItemData;
382	+	Obj: TOutputBlockItem;
383	+	begin
384	+	P := inherited getItem(index);
385	+	Obj := TOutputBlockItemClass(_TItem).Create(self,P);
386	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
387	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
388	+	end;
389	+
390	+	function TCustomOutputBlock<_TItem,_IItem>.find(ItemType: byte): _IItem;
391	+	var P: POutputBlockItemData;
392	+	Obj: TOutputBlockItem;
393	+	begin
394	+	P := inherited Find(ItemType);
395	+	Obj := TOutputBlockItemClass(_TItem).Create(self,P);
396	+	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
397	+	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
398	+	end;
399	+
400	+	{$ENDIF}
401	+
402	+	{ TOutputBlockItem }
403	+
404		function TOutputBlockItem.GetCount: integer;
405		begin
406		Result := Length(FItemData^.FSubItems);
#	Line 277 | Line 411 | begin
411		if (index >= 0) and (index < Length(FItemData^.FSubItems)) then
412		Result := FItemData^.FSubItems[index]
413		else
414	<	with FirebirdClientAPI do
414	>	with FFirebirdClientAPI do
415		IBError(ibxeOutputBlockIndexError,[index]);
416		end;
417
#	Line 286 | Line 420 | var i: integer;
420		begin
421		Result := nil;
422		for i := 0 to GetCount - 1 do
423	<	if FItemData^.FSubItems[i]^.FBufPtr^ = char(ItemType) then
423	>	if byte(FItemData^.FSubItems[i]^.FBufPtr^) = ItemType then
424		begin
425		Result := FItemData^.FSubItems[i];
426		Exit;
#	Line 295 | Line 429 | end;
429
430		{ TOutputBlockItem }
431
432	<	procedure TOutputBlockItem.SetString(out S: AnsiString; Buf: PAnsiChar;
433	<	Len: SizeInt; CodePage: TSystemCodePage);
432	>	procedure TOutputBlockItem.SetString(out S: AnsiString; Buf: PByte;
433	>	Len: integer; CodePage: TSystemCodePage);
434		var rs: RawByteString;
435	+	i: integer;
436		begin
437	<	system.SetString(rs,Buf,len);
437	>	{There seems to be a memory manager problem with SetString that can cause
438	>	an unhandled exception at the end of a program if it is used to set the
439	>	string. Safer to copy characters one by one. Note that Setlength does
440	>	not work around the bug either.}
441	>	rs := '';
442	>	for i := 0 to len-1 do
443	>	rs := rs + PAnsiChar(buf+i)^;
444	>	//  system.SetString(rs,PAnsiChar(Buf),len);
445		SetCodePage(rs,CodePage,false);
446		S := rs;
447		end;
#	Line 310 | Line 452 | begin
452		inherited Create;
453		FOwner := AOwner;
454		FOwnerIntf := AOwner;
455	+	FFirebirdClientAPI := AOwner.FFirebirdClientAPI;
456		FItemData := Data;
457		end;
458
#	Line 320 | Line 463 | end;
463
464		function TOutputBlockItem.getSize: integer;
465		begin
466	<	Result := FItemData^.FDataLength;
466	>	if FItemData = nil then
467	>	Result := 0
468	>	else
469	>	Result := FItemData^.FDataLength;
470		end;
471
472		procedure TOutputBlockItem.getRawBytes(var Buffer);
#	Line 335 | Line 481 | begin
481		with FItemData^ do
482		case FDataType of
483		dtIntegerFixed:
484	<	with FirebirdClientAPI do
484	>	with FFirebirdClientAPI do
485		Result := DecodeInteger(FBufPtr+1,4);
486
487		dtByte,
488		dtInteger:
489	<	with FirebirdClientAPI do
489	>	with FFirebirdClientAPI do
490		begin
491		len := DecodeInteger(FBufPtr+1,2);
492		Result := DecodeInteger(FBufPtr+3,len);
#	Line 355 | Line 501 | begin
501		Result := byte(FItemData^.FBufPtr^)
502		end;
503
504	<	function TOutputBlockItem.getAsString: string;
504	>	function TOutputBlockItem.getAsString: AnsiString;
505		var len: integer;
506		begin
507		Result := '';
508		with FItemData^ do
509		case FDataType of
510	+	dtIntegerFixed,
511		dtInteger:
512		Result := IntToStr(getAsInteger);
513		dtByte:
#	Line 372 | Line 519 | begin
519		end;
520		dtString2:
521		begin
522	<	with FirebirdClientAPI do
522	>	with FFirebirdClientAPI do
523		len := DecodeInteger(FBufPtr+1,2);
524		SetString(Result,FBufPtr+3,len,CP_ACP);
525		end;
526	+	dtOctetString:
527	+	begin
528	+	with FFirebirdClientAPI do
529	+	len := DecodeInteger(FBufPtr+1,2);
530	+	SetString(Result,FBufPtr+3,len,CP_NONE);
531	+	end;
532		else
533		IBError(ibxeOutputBlockTypeError,[nil]);
534		end;
#	Line 392 | Line 545 | end;
545
546		function TOutputBlockItem.getAsBytes: TByteArray;
547		var i: integer;
548	<	P: PChar;
548	>	P: PByte;
549		begin
550		with FItemData^ do
551		if FDataType = dtBytes then
#	Line 409 | Line 562 | begin
562		IBError(ibxeOutputBlockTypeError,[nil]);
563		end;
564
565	+	function TOutputBlockItem.getAsDateTime: TDateTime;
566	+	var aDate: integer;
567	+	aTime: integer;
568	+	begin
569	+	with FItemData^, FFirebirdClientAPI do
570	+	if FDataType = dtDateTime then
571	+	begin
572	+	aDate := DecodeInteger(FBufPtr+3,4);
573	+	aTime := DecodeInteger(FBufPtr+7,4);
574	+	Result := SQLDecodeDate(@aDate) + SQLDecodeTime(@aTime)
575	+	end
576	+	else
577	+	IBError(ibxeOutputBlockTypeError,[nil]);
578	+	end;
579	+
580	+
581		function TOutputBlockItem.CopyTo(stream: TStream; count: integer): integer;
582		var len: integer;
583		begin
#	Line 424 | Line 593 | begin
593		end;
594		dtString2:
595		begin
596	<	with FirebirdClientAPI do
596	>	with FFirebirdClientAPI do
597		len := DecodeInteger(FBufPtr+1,2);
598		if (count > 0) and (count < len) then len := count;
599		Result := stream.Write((FBufPtr+3)^,len);
#	Line 454 | Line 623 | begin
623		FBufferParsed := true;
624		end;
625
626	<	function TOutputBlock.AddItem(BufPtr: PChar): POutputBlockItemData;
626	>	function TOutputBlock.AddItem(BufPtr: PByte): POutputBlockItemData;
627		begin
628		new(Result);
629		with Result^ do
#	Line 467 | Line 636 | begin
636		end;
637		end;
638
639	<	function TOutputBlock.AddIntegerItem(BufPtr: PChar): POutputBlockItemData;
639	>	function TOutputBlock.AddIntegerItem(BufPtr: PByte): POutputBlockItemData;
640		begin
641		new(Result);
642		with Result^ do
#	Line 481 | Line 650 | begin
650		end
651		else
652		begin
653	<	with FirebirdClientAPI do
653	>	with FFirebirdClientAPI do
654		FDataLength := DecodeInteger(FBufPtr+1, 2);
655		FSize := FDataLength + 3;
656		end;
#	Line 489 | Line 658 | begin
658		end;
659		end;
660
661	<	function TOutputBlock.AddStringItem(BufPtr: PChar): POutputBlockItemData;
661	>	function TOutputBlock.AddStringItem(BufPtr: PByte): POutputBlockItemData;
662		begin
663		new(Result);
664		with Result^ do
665		begin
666		FDataType := dtString2;
667		FBufPtr := BufPtr;
668	<	with FirebirdClientAPI do
668	>	with FFirebirdClientAPI do
669		FDataLength := DecodeInteger(FBufPtr+1, 2);
670		FSize := FDataLength + 3;
671		SetLength(FSubItems,0);
672		end;
673		end;
674
675	<	function TOutputBlock.AddShortStringItem(BufPtr: PChar): POutputBlockItemData;
675	>	function TOutputBlock.AddShortStringItem(BufPtr: PByte): POutputBlockItemData;
676		begin
677		new(Result);
678		with Result^ do
#	Line 516 | Line 685 | begin
685		end;
686		end;
687
688	<	function TOutputBlock.AddByteItem(BufPtr: PChar): POutputBlockItemData;
688	>	function TOutputBlock.AddByteItem(BufPtr: PByte): POutputBlockItemData;
689		begin
690		new(Result);
691		with Result^ do
#	Line 529 | Line 698 | begin
698		end;
699		end;
700
701	<	function TOutputBlock.AddBytesItem(BufPtr: PChar): POutputBlockItemData;
701	>	function TOutputBlock.AddBytesItem(BufPtr: PByte): POutputBlockItemData;
702		begin
703		new(Result);
704		with Result^ do
705		begin
706		FDataType := dtBytes;
707		FBufPtr := BufPtr;
708	<	with FirebirdClientAPI do
708	>	with FFirebirdClientAPI do
709		FDataLength := DecodeInteger(FBufPtr+1, 2);
710		FSize := FDataLength + 3;
711		SetLength(FSubItems,0);
712		end;
713		end;
714
715	<	function TOutputBlock.AddListItem(BufPtr: PChar): POutputBlockItemData;
715	>	function TOutputBlock.AddListItem(BufPtr: PByte): POutputBlockItemData;
716		begin
717		new(Result);
718		with Result^ do
#	Line 556 | Line 725 | begin
725		end;
726		end;
727
728	<	function TOutputBlock.AddSpecialItem(BufPtr: PChar): POutputBlockItemData;
728	>	function TOutputBlock.AddSpecialItem(BufPtr: PByte): POutputBlockItemData;
729		begin
730		new(Result);
731		with Result^ do
#	Line 569 | Line 738 | begin
738		end;
739		end;
740
741	<	constructor TOutputBlock.Create(aSize: integer);
741	>	function TOutputBlock.AddDateTimeItem(BufPtr: PByte): POutputBlockItemData;
742	>	begin
743	>	new(Result);
744	>	with Result^ do
745	>	begin
746	>	FDataType := dtDateTime;
747	>	FBufPtr := BufPtr;
748	>	with FFirebirdClientAPI do
749	>	FDataLength := DecodeInteger(FBufPtr+1, 2);
750	>	FSize := FDataLength + 3;
751	>	SetLength(FSubItems,0);
752	>	end;
753	>	end;
754	>
755	>	function TOutputBlock.AddOctetString(BufPtr: PByte): POutputBlockItemData;
756	>	begin
757	>	new(Result);
758	>	with Result^ do
759	>	begin
760	>	FDataType := dtOctetString;
761	>	FBufPtr := BufPtr;
762	>	with FFirebirdClientAPI do
763	>	FDataLength := DecodeInteger(FBufPtr+1, 2);
764	>	FSize := FDataLength + 3;
765	>	SetLength(FSubItems,0);
766	>	end;
767	>	end;
768	>
769	>	constructor TOutputBlock.Create(api: TFBClientAPI; aSize: integer);
770		begin
771		inherited Create;
772	+	FFirebirdClientAPI := api;
773		FBufSize := aSize;
774		GetMem(FBuffer,aSize);
775		if FBuffer = nil then
#	Line 586 | Line 784 | var i, j: integer;
784		begin
785		for i := 0 to length(FItems) - 1 do
786		begin
787	<	for j := 0 to Length(FItems[i]^.FSubItems) -1 do
788	<	dispose(FItems[i]^.FSubItems[j]);
789	<	dispose(FItems[i]);
787	>	if FItems[i] <> nil then
788	>	begin
789	>	for j := 0 to Length(FItems[i]^.FSubItems) -1 do
790	>	if FItems[i]^.FSubItems[j] <> nil then
791	>	dispose(FItems[i]^.FSubItems[j]);
792	>	dispose(FItems[i]);
793	>	end;
794		end;
795		FreeMem(FBuffer);
796		inherited Destroy;
797		end;
798
799	<	function TOutputBlock.Buffer: PChar;
799	>	function TOutputBlock.Buffer: PByte;
800		begin
801		Result := FBuffer;
802		end;
#	Line 624 | Line 826 | var i: integer;
826		begin
827		Result := nil;
828		for i := 0 to getCount - 1 do
829	<	if FItems[i]^.FBufPtr^ = char(ItemType) then
829	>	if byte(FItems[i]^.FBufPtr^) = ItemType then
830		begin
831		Result := FItems[i];
832		Exit;
#	Line 633 | Line 835 | end;
835
836		{$IFDEF DEBUGOUTPUTBLOCK}
837		procedure TOutputBlock.FormattedPrint(
838	<	const aItems: array of POutputBlockItemData; Indent: string);
838	>	const aItems: array of POutputBlockItemData; Indent: AnsiString);
839
840		var i: integer;
841		item: TOutputBlockItem;
#	Line 664 | Line 866 | begin
866		else
867		begin
868		item := TOutputBlockItem.Create(self,(aItems[i]));
869	<	writeln(Indent,'ItemType = ',byte(FBufPtr^),' Value = ',(item as TOutputBlockItem).GetAsString);
869	>	try
870	>	writeln(Indent,'ItemType = ',byte(FBufPtr^),' Value = ',(item as TOutputBlockItem).GetAsString);
871	>	except
872	>	writeln(Indent,'Unknown ItemType = ',byte(FBufPtr^));
873	>	end;
874		end;
875		end;
876		end;
#	Line 681 | Line 887 | begin
887		if byte(FBuffer[i]) = isc_info_end then break;
888		end;
889		writeln;
890	+	for i := 0 to getBufSize - 1 do
891	+	begin
892	+	if chr(FBuffer[i]) in [' '..'~'] then
893	+	write(chr(Buffer[i]))
894	+	else
895	+	write('.');
896	+	if byte(FBuffer[i]) = isc_info_end then break;
897	+	end;
898	+	writeln;
899		end;
900
901		{ TDBInfoItem }
902
903		procedure TDBInfoItem.DecodeIDCluster(var ConnectionType: integer;
904	<	var DBFileName, DBSiteName: string);
905	<	var  P: PChar;
904	>	var DBFileName, DBSiteName: AnsiString);
905	>	var  P: PByte;
906		begin
907		with ItemData^ do
908	<	if FBufPtr^ = char(isc_info_db_id) then
908	>	if FBufPtr^ = isc_info_db_id then
909		begin
910		P := FBufPtr + 3;
911		if FDataLength > 0 then
912		ConnectionType := integer(P^);
913		Inc(P);
914		SetString(DBFileName,P+1,byte(P^),CP_ACP);
915	<	P += Length(DBFileName) + 1;
915	>	P := P + Length(DBFileName) + 1;
916		SetString(DBSiteName,P+1,byte(P^),CP_ACP);
917		end
918		else
#	Line 705 | Line 920 | begin
920		end;
921
922		procedure TDBInfoItem.DecodeVersionString(var Version: byte;
923	<	var VersionString: string);
924	<	var  P: PChar;
923	>	var VersionString: AnsiString);
924	>	var  P: PByte;
925		begin
926		with ItemData^ do
927	<	if FBufPtr^ = char(isc_info_version) then
927	>	if FBufPtr^ = isc_info_version then
928		begin
929		P := FBufPtr+3;
930		VersionString := '';
#	Line 722 | Line 937 | begin
937		end;
938
939		procedure TDBInfoItem.DecodeUserNames(UserNames: TStrings);
940	<	var P: PChar;
941	<	s: string;
940	>	var P: PByte;
941	>	s: AnsiString;
942		begin
943		with ItemData^ do
944	<	if FBufPtr^ = char(isc_info_user_names) then
944	>	if FBufPtr^ = isc_info_user_names then
945		begin
946		P := FBufPtr+3;
947		while (P < FBufPtr + FSize) do
948		begin
949		SetString(s,P+1,byte(P^),CP_ACP);
950		UserNames.Add(s);
951	<	P += Length(s) + 1;
951	>	P := P + Length(s) + 1;
952		end;
953		end
954		else
#	Line 742 | Line 957 | end;
957
958		function TDBInfoItem.getOperationCounts: TDBOperationCounts;
959		var tableCounts: integer;
960	<	P: PChar;
960	>	P: PByte;
961		i: integer;
962		begin
963		with ItemData^ do
#	Line 754 | Line 969 | begin
969		SetLength(Result,TableCounts);
970		P := FBufPtr + 3;
971		for i := 0 to TableCounts -1 do
972	<	with FirebirdClientAPI do
972	>	with FFirebirdClientAPI do
973		begin
974		Result[i].TableID := DecodeInteger(P,2);
975		Inc(P,2);
#	Line 768 | Line 983 | end;
983
984		{ TDBInformation }
985
986	<	function TDBInformation.AddSpecialItem(BufPtr: PChar): POutputBlockItemData;
986	>	function TDBInformation.AddSpecialItem(BufPtr: PByte): POutputBlockItemData;
987		begin
988		Result := inherited AddSpecialItem(BufPtr);
989		with Result^ do
990		begin
991	<	with FirebirdClientAPI do
991	>	with FFirebirdClientAPI do
992		FDataLength := DecodeInteger(FBufPtr+1,2);
993		FSize := FDataLength + 3;
994		end;
995		end;
996
997		procedure TDBInformation.DoParseBuffer;
998	<	var P: PChar;
998	>	var P: PByte;
999		index: integer;
1000		begin
1001		P := Buffer;
1002		index := 0;
1003		SetLength(FItems,0);
1004	<	while (P^ <> char(isc_info_end)) and (P < Buffer + getBufSize) do
1004	>	while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
1005		begin
1006		SetLength(FItems,index+1);
1007		case byte(P^) of
1008	+	isc_info_db_read_only,
1009		isc_info_no_reserve,
1010		isc_info_allocation,
1011		isc_info_ods_minor_version,
#	Line 804 | Line 1020 | begin
1020		isc_info_fetches,
1021		isc_info_marks,
1022		isc_info_reads,
1023	<	isc_info_writes:
1023	>	isc_info_writes,
1024	>	isc_info_active_tran_count,
1025	>	fb_info_pages_used,
1026	>	fb_info_pages_free,
1027	>	fb_info_conn_flags:
1028		FItems[index] := AddIntegerItem(P);
1029
1030		isc_info_implementation,
1031		isc_info_base_level:
1032		FItems[index] := AddBytesItem(P);
1033
1034	+	isc_info_creation_date:
1035	+	FItems[index] := AddDateTimeItem(P);
1036	+
1037	+	fb_info_page_contents:
1038	+	FItems[index] := AddOctetString(P);
1039	+
1040	+	fb_info_crypt_key:
1041	+	FItems[index] := AddStringItem(P);
1042	+
1043		isc_info_db_id,
1044		isc_info_version,
1045		isc_info_backout_count,
#	Line 827 | Line 1056 | begin
1056		else
1057		FItems[index] := AddSpecialItem(P);
1058		end;
1059	<	P += FItems[index]^.FSize;
1059	>	P := P + FItems[index]^.FSize;
1060		Inc(index);
1061		end;
1062		end;
1063
1064	<	constructor TDBInformation.Create(aSize: integer);
1064	>	{$IFNDEF FPC}
1065	>	function TDBInformation.Find(ItemType: byte): IDBInfoItem;
1066		begin
1067	<	inherited Create(aSize);
1067	>	Result := inherited Find(ItemType);
1068	>	if Result.GetSize = 0 then
1069	>	Result := nil;
1070	>	end;
1071	>	{$ENDIF}
1072	>
1073	>	constructor TDBInformation.Create(api: TFBClientAPI; aSize: integer);
1074	>	begin
1075	>	inherited Create(api,aSize);
1076		FIntegerType := dtInteger;
1077		end;
1078
1079		{ TServiceQueryResults }
1080
1081	<	function TServiceQueryResults.AddListItem(BufPtr: PChar): POutputBlockItemData;
1082	<	var P: PChar;
1081	>	function TServiceQueryResults.AddListItem(BufPtr: PByte): POutputBlockItemData;
1082	>	var P: PByte;
1083		i: integer;
1084		group: byte;
1085		begin
#	Line 851 | Line 1089 | begin
1089		group := byte(BufPtr^);
1090		if group in [isc_info_svc_get_users,isc_info_svc_limbo_trans] then
1091		begin
1092	<	with FirebirdClientAPI do
1092	>	with FFirebirdClientAPI do
1093		Result^.FSize := DecodeInteger(P,2) + 3;
1094		Inc(P,2);
1095		end;
1096		with Result^ do
1097		begin
1098	<	while (P < FBufPtr + FSize) and (P^ <> char(isc_info_flag_end)) do
1098	>	while (P < FBufPtr + FSize) and (P^ <> isc_info_flag_end) do
1099		begin
1100		SetLength(FSubItems,i+1);
1101	+	FSubItems[i] := nil;
1102		case group of
1103		isc_info_svc_svr_db_info:
1104		case integer(P^) of
#	Line 871 | Line 1110 | begin
1110		FSubItems[i] := AddStringItem(P);
1111
1112		else
1113	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1113	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1114		end;
1115
1116		isc_info_svc_get_license:
#	Line 880 | Line 1119 | begin
1119		isc_spb_lic_key:
1120		FSubItems[i] := AddIntegerItem(P);
1121		else
1122	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1122	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1123		end;
1124
1125		isc_info_svc_limbo_trans:
#	Line 899 | Line 1138 | begin
1138		isc_spb_tra_state:
1139		FSubItems[i] := AddByteItem(P);
1140		else
1141	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1141	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1142		end;
1143
1144		isc_info_svc_get_users:
1145		case integer(P^) of
1146	+	isc_spb_sec_admin,
1147		isc_spb_sec_userid,
1148		isc_spb_sec_groupid:
1149		FSubItems[i] := AddIntegerItem(P);
#	Line 916 | Line 1156 | begin
1156		FSubItems[i] := AddStringItem(P);
1157
1158		else
1159	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1159	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1160		end;
1161
1162		end;
1163	<	P +=  FSubItems[i]^.FSize;
1163	>	P := P + FSubItems[i]^.FSize;
1164		Inc(i);
1165		end;
1166		FDataLength := 0;
1167		for i := 0 to Length(FSubItems) - 1 do
1168	<	FDataLength += FSubItems[i]^.FSize;
1168	>	FDataLength := FDataLength + FSubItems[i]^.FSize;
1169		if group in [isc_info_svc_get_users,isc_info_svc_limbo_trans] then
1170		Exit;
1171
1172	<	if (P < FBufPtr + FSize) and (P^ = char(isc_info_flag_end)) then
1172	>	if (P < FBufPtr + FSize) and (P^ = isc_info_flag_end) then
1173		FSize := FDataLength + 2 {include start and end flag}
1174		else
1175		FSize := FDataLength + 1; {start flag only}
1176		end;
1177		end;
1178
1179	<	function TServiceQueryResults.AddSpecialItem(BufPtr: PChar
1179	>	function TServiceQueryResults.AddSpecialItem(BufPtr: PByte
1180		): POutputBlockItemData;
1181	<	var P: PChar;
1181	>	var P: PByte;
1182		i: integer;
1183		begin
1184		Result := inherited AddSpecialItem(BufPtr);
1185		with Result^ do
1186		begin
1187	<	with FirebirdClientAPI do
1187	>	with FFirebirdClientAPI do
1188		FDataLength := DecodeInteger(FBufPtr+1, 2);
1189
1190		P := FBufPtr + 3; {skip length bytes}
#	Line 952 | Line 1192 | begin
1192		while P < FBufPtr + FDataLength do
1193		begin
1194		FSubItems[i] := AddIntegerItem(P);
1195	<	P +=  FSubItems[i]^.FSize;
1195	>	P := P + FSubItems[i]^.FSize;
1196		Inc(i);
1197		end;
1198		end;
1199		end;
1200
1201		procedure TServiceQueryResults.DoParseBuffer;
1202	<	var P: PChar;
1202	>	var P: PByte;
1203		i: integer;
1204		begin
1205		P := Buffer;
1206		i := 0;
1207	<	while  (P < Buffer + getBufSize) and (P^ <> char(isc_info_end)) do
1207	>	while  (P < Buffer + getBufSize) and (P^ <> isc_info_end) do
1208		begin
1209		SetLength(FItems,i+1);
1210	+	FItems[i] := nil;
1211		case integer(P^) of
1212		isc_info_svc_line,
1213		isc_info_svc_get_env,
#	Line 1001 | Line 1242 | begin
1242
1243
1244		else
1245	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1245	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,getBufSize - (P-Buffer))]);
1246		end;
1247	<	P += FItems[i]^.FSize;
1247	>	P := P + FItems[i]^.FSize;
1248		Inc(i);
1249		end;
1250		end;
1251
1252	+	{$IFNDEF FPC}
1253	+	function TServiceQueryResults.Find(ItemType: byte): IServiceQueryResultItem;
1254	+	begin
1255	+	Result := inherited Find(ItemType);
1256	+	if Result.GetSize = 0 then
1257	+	Result := nil;
1258	+	end;
1259	+	{$ENDIF}
1260	+
1261		{ TSQLInfoResultsBuffer }
1262
1263	<	function TSQLInfoResultsBuffer.AddListItem(BufPtr: PChar): POutputBlockItemData;
1264	<	var P: PChar;
1263	>	function TSQLInfoResultsBuffer.AddListItem(BufPtr: PByte): POutputBlockItemData;
1264	>	var P: PByte;
1265		i: integer;
1266		begin
1267		Result := inherited AddListItem(BufPtr);
#	Line 1020 | Line 1270 | begin
1270
1271		if byte(BufPtr^) = isc_info_sql_records then
1272		begin
1273	<	with FirebirdClientAPI do
1273	>	with FFirebirdClientAPI do
1274		Result^.FSize := DecodeInteger(P,2) + 3;
1275		Inc(P,2);
1276		with Result^ do
#	Line 1049 | Line 1299 | begin
1299		else
1300		FSubItems[i] := AddSpecialItem(P);
1301		end;
1302	<	P +=  FSubItems[i]^.FSize;
1302	>	P := P + FSubItems[i]^.FSize;
1303		Inc(i);
1304		end;
1305		end;
#	Line 1057 | Line 1307 | begin
1307		end;
1308
1309		procedure TSQLInfoResultsBuffer.DoParseBuffer;
1310	<	var P: PChar;
1310	>	var P: PByte;
1311		index: integer;
1312		begin
1313		P := Buffer;
1314		index := 0;
1315		SetLength(FItems,0);
1316	<	while (P^ <> char(isc_info_end)) and (P < Buffer + getBufSize) do
1316	>	while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
1317		begin
1318		SetLength(FItems,index+1);
1319		case byte(P^) of
#	Line 1091 | Line 1341 | begin
1341		else
1342		FItems[index] := AddSpecialItem(P);
1343		end;
1344	<	P += FItems[index]^.FSize;
1344	>	P := P + FItems[index]^.FSize;
1345	>	Inc(index);
1346	>	end;
1347	>	end;
1348	>
1349	>	constructor TSQLInfoResultsBuffer.Create(api: TFBClientAPI; aSize: integer);
1350	>	begin
1351	>	inherited Create(api,aSize);
1352	>	FIntegerType := dtInteger;
1353	>	end;
1354	>
1355	>	{ TBlobInfo }
1356	>
1357	>	procedure TBlobInfo.DoParseBuffer;
1358	>	var P: PByte;
1359	>	index: integer;
1360	>	begin
1361	>	P := Buffer;
1362	>	index := 0;
1363	>	SetLength(FItems,0);
1364	>	while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
1365	>	begin
1366	>	SetLength(FItems,index+1);
1367	>	case byte(P^) of
1368	>	isc_info_blob_num_segments,
1369	>	isc_info_blob_max_segment,
1370	>	isc_info_blob_total_length,
1371	>	isc_info_blob_type:
1372	>	FItems[index] := AddIntegerItem(P);
1373	>	else
1374	>	FItems[index] := AddSpecialItem(P);
1375	>	end;
1376	>	P := P + FItems[index]^.FSize;
1377		Inc(index);
1378		end;
1379		end;
1380
1381	<	constructor TSQLInfoResultsBuffer.Create(aSize: integer);
1381	>	constructor TBlobInfo.Create(api: TFBClientAPI; aSize: integer);
1382		begin
1383	<	inherited Create(aSize);
1383	>	inherited Create(api,aSize);
1384		FIntegerType := dtInteger;
1385		end;
1386

Diff Legend

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