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 56 by tony, Mon Mar 6 10:20:02 2017 UTC vs.
Revision 345 by tony, Mon Aug 23 14:22:29 2021 UTC

#	Line 46 | 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
#	Line 73 | Line 73 | type
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;
#	Line 93 | Line 94 | type
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: PByte;
103		function getBufSize: integer;
#	Line 114 | 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;
#	Line 128 | Line 132 | type
132		function getItemType: byte;
133		function getSize: integer;
134		procedure getRawBytes(var Buffer);
135	<	function getAsInteger: integer;
135	>	function getAsInteger: int64;
136		function getParamType: byte;
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
#	Line 179 | Line 184 | type
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
#	Line 188 | Line 193 | type
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
202		{ TServiceQueryResultItem }
#	Line 203 | Line 211 | type
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
#	Line 213 | Line 225 | type
225		function getItemType: byte;
226		function getSize: integer;
227		function getAsString: AnsiString;
228	<	function getAsInteger: integer;
228	>	function getAsInteger: int64;
229		end;
230
231		ISQLInfoItem = interface(ISQLInfoSubItem)
#	Line 249 | Line 261 | type
261		function AddListItem(BufPtr: PByte): POutputBlockItemData; override;
262		procedure DoParseBuffer; override;
263		public
264	<	constructor Create(aSize: integer = 1024);
264	>	constructor Create(api: TFBClientAPI; aSize: integer= DefaultBufferSize);
265		end;
266
267		IBlobInfoItem = interface
#	Line 257 | Line 269 | type
269		function getItemType: byte;
270		function getSize: integer;
271		function getAsString: AnsiString;
272	<	function getAsInteger: integer;
272	>	function getAsInteger: int64;
273		end;
274
275		IBlobInfo = interface
#	Line 285 | Line 297 | type
297		protected
298		procedure DoParseBuffer; override;
299		public
300	<	constructor Create(aSize: integer=DBInfoDefaultBufferSize);
300	>	constructor Create(api: TFBClientAPI; aSize: integer = DefaultBufferSize);
301		end;
302
303		implementation
304
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
#	Line 322 | Line 340 | function TCustomOutputBlock<_TItem,_IIte
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}
#	Line 344 | Line 365 | var P: POutputBlockItemData;
365		Obj: TOutputBlockItem;
366		begin
367		P := inherited Find(ItemType);
368	<	Obj := TOutputBlockItemClass(_TItem).Create(self.Owner,P);
369	<	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
370	<	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
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 }
#	Line 385 | 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 406 | Line 432 | end;
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,PAnsiChar(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 418 | Line 452 | begin
452		inherited Create;
453		FOwner := AOwner;
454		FOwnerIntf := AOwner;
455	+	FFirebirdClientAPI := AOwner.FFirebirdClientAPI;
456		FItemData := Data;
457		end;
458
#	Line 428 | 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 437 | Line 475 | begin
475		Move(FBufPtr^,Buffer,FDatalength);
476		end;
477
478	<	function TOutputBlockItem.getAsInteger: integer;
478	>	function TOutputBlockItem.getAsInteger: int64;
479		var len: integer;
480		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 469 | Line 507 | begin
507		Result := '';
508		with FItemData^ do
509		case FDataType of
510	+	dtIntegerFixed,
511		dtInteger:
512		Result := IntToStr(getAsInteger);
513		dtByte:
#	Line 480 | 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 517 | 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 532 | 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 589 | 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 604 | Line 665 | begin
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);
#	Line 644 | Line 705 | begin
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);
#	Line 677 | 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 694 | 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;
#	Line 772 | 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 789 | 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 }
#	Line 862 | 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 881 | Line 988 | 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;
#	Line 898 | Line 1005 | begin
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 912 | 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 940 | Line 1061 | begin
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
#	Line 959 | 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;
#	Line 968 | Line 1098 | begin
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 979 | 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 988 | 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 1007 | 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 1024 | 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;
#	Line 1052 | Line 1184 | 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 1075 | Line 1207 | begin
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 1109 | 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 := 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: PByte): POutputBlockItemData;
#	Line 1128 | 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 1204 | Line 1346 | begin
1346		end;
1347		end;
1348
1349	<	constructor TSQLInfoResultsBuffer.Create(aSize: integer);
1349	>	constructor TSQLInfoResultsBuffer.Create(api: TFBClientAPI; aSize: integer);
1350		begin
1351	<	inherited Create(aSize);
1351	>	inherited Create(api,aSize);
1352		FIntegerType := dtInteger;
1353		end;
1354
#	Line 1236 | Line 1378 | begin
1378		end;
1379		end;
1380
1381	<	constructor TBlobInfo.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