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 143 by tony, Fri Feb 23 12:11:21 2018 UTC vs.
ibx/branches/udr/client/FBOutputBlock.pas (file contents), Revision 370 by tony, Wed Jan 5 14:59:15 2022 UTC

#	Line 49 | Line 49 | const
49		DBInfoDefaultBufferSize = DefaultBufferSize; {allow for database page}
50
51		type
52	<	TItemDataType = (dtString, dtString2, dtByte, dtBytes, dtInteger, dtIntegerFixed, dtnone,
53	<	dtList,dtSpecial, dtDateTime, dtOctetString);
52	>	TItemDataType = (dtString, dtString2, dtByte, dtBytes, dtInteger, dtIntegerFixed,
53	>	dtTinyInteger, dtShortIntFixed, dtnone, 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;
80		Indent: AnsiString);
81		{$ENDIF}
81	–	procedure PrintBuf;
82		protected
83		FIntegerType: TItemDataType;
84		FError: boolean;
#	Line 86 | Line 86 | type
86		FItems: array of POutputBlockItemData;
87		procedure DoParseBuffer; virtual; abstract;
88		function AddItem(BufPtr: PByte): POutputBlockItemData;
89	<	function AddIntegerItem(BufPtr: PByte): POutputBlockItemData;
89	>	function AddIntegerItem(BufPtr: PByte; IntType: TItemDataType): POutputBlockItemData; overload;
90	>	function AddIntegerItem(BufPtr: PByte): POutputBlockItemData; overload;
91		function AddStringItem(BufPtr: PByte): POutputBlockItemData;
92		function AddShortStringItem(BufPtr: PByte): POutputBlockItemData;
93		function AddByteItem(BufPtr: PByte): POutputBlockItemData;
#	Line 96 | Line 97 | type
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 105 | Line 106 | type
106		function GetCount: integer;
107		function GetItem(index: integer): POutputBlockItemData;
108		function Find(ItemType: byte): POutputBlockItemData;
109	+	procedure PrintBuf;
110		property Count: integer read GetCount;
111		property Items[index: integer]: POutputBlockItemData read getItem; default;
112		end;
#	Line 117 | Line 119 | type
119		FOwnerIntf: IUnknown;
120		FItemData: POutputBlockItemData;
121		protected
122	+	FFirebirdClientAPI: TFBClientAPI;
123		function GetItem(index: integer): POutputBlockItemData;
124		function Find(ItemType: byte): POutputBlockItemData;
125		procedure SetString(out S: AnsiString; Buf: PByte; Len: integer;
#	Line 130 | Line 133 | type
133		function getItemType: byte;
134		function getSize: integer;
135		procedure getRawBytes(var Buffer);
136	<	function getAsInteger: integer;
136	>	function getAsInteger: int64;
137		function getParamType: byte;
138		function getAsString: AnsiString;
139		function getAsByte: byte;
#	Line 191 | Line 194 | type
194		function AddSpecialItem(BufPtr: PByte): POutputBlockItemData; override;
195		procedure DoParseBuffer; override;
196		public
197	<	constructor Create(aSize: integer=DBInfoDefaultBufferSize);
197	>	constructor Create(api: TFBClientAPI; aSize: integer = DefaultBufferSize);
198		{$IFNDEF FPC}
199		function Find(ItemType: byte): IDBInfoItem;
200		{$ENDIF}
#	Line 223 | Line 226 | type
226		function getItemType: byte;
227		function getSize: integer;
228		function getAsString: AnsiString;
229	<	function getAsInteger: integer;
229	>	function getAsInteger: int64;
230		end;
231
232		ISQLInfoItem = interface(ISQLInfoSubItem)
#	Line 259 | Line 262 | type
262		function AddListItem(BufPtr: PByte): POutputBlockItemData; override;
263		procedure DoParseBuffer; override;
264		public
265	<	constructor Create(aSize: integer = 1024);
265	>	constructor Create(api: TFBClientAPI; aSize: integer= DefaultBufferSize);
266		end;
267
268		IBlobInfoItem = interface
#	Line 267 | Line 270 | type
270		function getItemType: byte;
271		function getSize: integer;
272		function getAsString: AnsiString;
273	<	function getAsInteger: integer;
273	>	function getAsInteger: int64;
274		end;
275
276		IBlobInfo = interface
#	Line 295 | Line 298 | type
298		protected
299		procedure DoParseBuffer; override;
300		public
301	<	constructor Create(aSize: integer=DBInfoDefaultBufferSize);
301	>	constructor Create(api: TFBClientAPI; aSize: integer = DefaultBufferSize);
302		end;
303
304		implementation
305
306		uses FBMessages {$IFNDEF FPC}, TypInfo {$ENDIF};
307
308	+	function BufToStr(P: PByte; Len: integer):AnsiString;
309	+	begin
310	+	SetLength(Result,Len);
311	+	Move(P^,Result[1],Len);
312	+	end;
313	+
314		{$IFDEF FPC}
315		{ TOutputBlockItemGroup }
316
#	Line 403 | Line 412 | begin
412		if (index >= 0) and (index < Length(FItemData^.FSubItems)) then
413		Result := FItemData^.FSubItems[index]
414		else
415	<	with FirebirdClientAPI do
415	>	with FFirebirdClientAPI do
416		IBError(ibxeOutputBlockIndexError,[index]);
417		end;
418
#	Line 424 | Line 433 | end;
433		procedure TOutputBlockItem.SetString(out S: AnsiString; Buf: PByte;
434		Len: integer; CodePage: TSystemCodePage);
435		var rs: RawByteString;
436	+	i: integer;
437		begin
438	<	system.SetString(rs,PAnsiChar(Buf),len);
438	>	{There seems to be a memory manager problem with SetString that can cause
439	>	an unhandled exception at the end of a program if it is used to set the
440	>	string. Safer to copy characters one by one. Note that Setlength does
441	>	not work around the bug either.}
442	>	rs := '';
443	>	for i := 0 to len-1 do
444	>	rs := rs + PAnsiChar(buf+i)^;
445	>	//  system.SetString(rs,PAnsiChar(Buf),len);
446		SetCodePage(rs,CodePage,false);
447		S := rs;
448		end;
#	Line 436 | Line 453 | begin
453		inherited Create;
454		FOwner := AOwner;
455		FOwnerIntf := AOwner;
456	+	FFirebirdClientAPI := AOwner.FFirebirdClientAPI;
457		FItemData := Data;
458		end;
459
#	Line 458 | Line 476 | begin
476		Move(FBufPtr^,Buffer,FDatalength);
477		end;
478
479	<	function TOutputBlockItem.getAsInteger: integer;
479	>	function TOutputBlockItem.getAsInteger: int64;
480		var len: integer;
481		begin
482		with FItemData^ do
483		case FDataType of
484		dtIntegerFixed:
485	<	with FirebirdClientAPI do
485	>	with FFirebirdClientAPI do
486		Result := DecodeInteger(FBufPtr+1,4);
487
488	+	dtShortIntFixed:
489	+	with FFirebirdClientAPI do
490	+	Result := DecodeInteger(FBufPtr+1,2);
491	+
492	+	dtTinyInteger:
493	+	with FFirebirdClientAPI do
494	+	begin
495	+	len := DecodeInteger(FBufPtr+1,1);
496	+	Result := DecodeInteger(FBufPtr+2,len);
497	+	end;
498	+
499		dtByte,
500		dtInteger:
501	<	with FirebirdClientAPI do
501	>	with FFirebirdClientAPI do
502		begin
503		len := DecodeInteger(FBufPtr+1,2);
504		Result := DecodeInteger(FBufPtr+3,len);
#	Line 490 | Line 519 | begin
519		Result := '';
520		with FItemData^ do
521		case FDataType of
522	+	dtIntegerFixed,
523		dtInteger:
524		Result := IntToStr(getAsInteger);
525		dtByte:
#	Line 501 | Line 531 | begin
531		end;
532		dtString2:
533		begin
534	<	with FirebirdClientAPI do
534	>	with FFirebirdClientAPI do
535		len := DecodeInteger(FBufPtr+1,2);
536		SetString(Result,FBufPtr+3,len,CP_ACP);
537		end;
538		dtOctetString:
539		begin
540	<	with FirebirdClientAPI do
540	>	with FFirebirdClientAPI do
541		len := DecodeInteger(FBufPtr+1,2);
542		SetString(Result,FBufPtr+3,len,CP_NONE);
543		end;
#	Line 548 | Line 578 | function TOutputBlockItem.getAsDateTime:
578		var aDate: integer;
579		aTime: integer;
580		begin
581	<	with FItemData^, FirebirdClientAPI do
581	>	with FItemData^, FFirebirdClientAPI do
582		if FDataType = dtDateTime then
583		begin
584		aDate := DecodeInteger(FBufPtr+3,4);
#	Line 575 | Line 605 | begin
605		end;
606		dtString2:
607		begin
608	<	with FirebirdClientAPI do
608	>	with FFirebirdClientAPI do
609		len := DecodeInteger(FBufPtr+1,2);
610		if (count > 0) and (count < len) then len := count;
611		Result := stream.Write((FBufPtr+3)^,len);
#	Line 618 | Line 648 | begin
648		end;
649		end;
650
651	<	function TOutputBlock.AddIntegerItem(BufPtr: PByte): POutputBlockItemData;
651	>	function TOutputBlock.AddIntegerItem(BufPtr: PByte; IntType: TItemDataType
652	>	): POutputBlockItemData;
653		begin
654		new(Result);
655		with Result^ do
656		begin
657	<	FDataType := FIntegerType;
657	>	FDataType := IntType;
658		FBufPtr := BufPtr;
659	<	if FDataType = dtIntegerFixed then
660	<	begin
661	<	FDataLength := 4;
662	<	FSize := 5;
663	<	end
664	<	else
665	<	begin
666	<	with FirebirdClientAPI do
667	<	FDataLength := DecodeInteger(FBufPtr+1, 2);
668	<	FSize := FDataLength + 3;
659	>	case FDataType of
660	>	dtIntegerFixed:
661	>	begin
662	>	FDataLength := 4;
663	>	FSize := 5;
664	>	end;
665	>
666	>	dtShortIntFixed:
667	>	begin
668	>	FDataLength := 2;
669	>	FSize := 3;
670	>	end;
671	>
672	>	dtTinyInteger:
673	>	begin
674	>	with FFirebirdClientAPI do
675	>	FDataLength := DecodeInteger(FBufPtr+1, 1);
676	>	FSize := FDataLength + 2;
677	>	end;
678	>
679	>	else
680	>	begin
681	>	with FFirebirdClientAPI do
682	>	FDataLength := DecodeInteger(FBufPtr+1, 2);
683	>	FSize := FDataLength + 3;
684	>	end;
685		end;
686		SetLength(FSubItems,0);
687		end;
688		end;
689
690	+	function TOutputBlock.AddIntegerItem(BufPtr: PByte): POutputBlockItemData;
691	+	begin
692	+	Result := AddIntegerItem(BufPtr,FIntegerType);
693	+	end;
694	+
695		function TOutputBlock.AddStringItem(BufPtr: PByte): POutputBlockItemData;
696		begin
697		new(Result);
#	Line 647 | Line 699 | begin
699		begin
700		FDataType := dtString2;
701		FBufPtr := BufPtr;
702	<	with FirebirdClientAPI do
702	>	with FFirebirdClientAPI do
703		FDataLength := DecodeInteger(FBufPtr+1, 2);
704		FSize := FDataLength + 3;
705		SetLength(FSubItems,0);
#	Line 687 | Line 739 | begin
739		begin
740		FDataType := dtBytes;
741		FBufPtr := BufPtr;
742	<	with FirebirdClientAPI do
742	>	with FFirebirdClientAPI do
743		FDataLength := DecodeInteger(FBufPtr+1, 2);
744		FSize := FDataLength + 3;
745		SetLength(FSubItems,0);
#	Line 727 | Line 779 | begin
779		begin
780		FDataType := dtDateTime;
781		FBufPtr := BufPtr;
782	<	with FirebirdClientAPI do
782	>	with FFirebirdClientAPI do
783		FDataLength := DecodeInteger(FBufPtr+1, 2);
784		FSize := FDataLength + 3;
785		SetLength(FSubItems,0);
#	Line 741 | Line 793 | begin
793		begin
794		FDataType := dtOctetString;
795		FBufPtr := BufPtr;
796	<	with FirebirdClientAPI do
796	>	with FFirebirdClientAPI do
797		FDataLength := DecodeInteger(FBufPtr+1, 2);
798		FSize := FDataLength + 3;
799		SetLength(FSubItems,0);
800		end;
801		end;
802
803	<	constructor TOutputBlock.Create(aSize: integer);
803	>	constructor TOutputBlock.Create(api: TFBClientAPI; aSize: integer);
804		begin
805		inherited Create;
806	+	FFirebirdClientAPI := api;
807		FBufSize := aSize;
808		GetMem(FBuffer,aSize);
809		if FBuffer = nil then
#	Line 765 | Line 818 | var i, j: integer;
818		begin
819		for i := 0 to length(FItems) - 1 do
820		begin
821	<	for j := 0 to Length(FItems[i]^.FSubItems) -1 do
822	<	dispose(FItems[i]^.FSubItems[j]);
823	<	dispose(FItems[i]);
821	>	if FItems[i] <> nil then
822	>	begin
823	>	for j := 0 to Length(FItems[i]^.FSubItems) -1 do
824	>	if FItems[i]^.FSubItems[j] <> nil then
825	>	dispose(FItems[i]^.FSubItems[j]);
826	>	dispose(FItems[i]);
827	>	end;
828		end;
829		FreeMem(FBuffer);
830		inherited Destroy;
#	Line 843 | Line 900 | begin
900		else
901		begin
902		item := TOutputBlockItem.Create(self,(aItems[i]));
903	<	writeln(Indent,'ItemType = ',byte(FBufPtr^),' Value = ',(item as TOutputBlockItem).GetAsString);
903	>	try
904	>	writeln(Indent,'ItemType = ',byte(FBufPtr^),' Value = ',(item as TOutputBlockItem).GetAsString);
905	>	except
906	>	writeln(Indent,'Unknown ItemType = ',byte(FBufPtr^));
907	>	end;
908		end;
909		end;
910		end;
#	Line 856 | Line 917 | begin
917		write(classname,': ');
918		for i := 0 to getBufSize - 1 do
919		begin
920	+	if byte(FBuffer[i]) = $FF then break;
921		write(Format('%x ',[byte(Buffer[i])]));
922	<	if byte(FBuffer[i]) = isc_info_end then break;
922	>	//    if byte(FBuffer[i]) = isc_info_end then break;
923	>	end;
924	>	writeln;
925	>	for i := 0 to getBufSize - 1 do
926	>	begin
927	>	if byte(FBuffer[i]) = $FF then break;
928	>	if chr(FBuffer[i]) in [' '..'~'] then
929	>	write(chr(Buffer[i]))
930	>	else
931	>	write('.');
932	>	//    if byte(FBuffer[i]) = isc_info_end then break;
933		end;
934		writeln;
935		end;
#	Line 933 | Line 1005 | begin
1005		SetLength(Result,TableCounts);
1006		P := FBufPtr + 3;
1007		for i := 0 to TableCounts -1 do
1008	<	with FirebirdClientAPI do
1008	>	with FFirebirdClientAPI do
1009		begin
1010		Result[i].TableID := DecodeInteger(P,2);
1011		Inc(P,2);
#	Line 952 | Line 1024 | begin
1024		Result := inherited AddSpecialItem(BufPtr);
1025		with Result^ do
1026		begin
1027	<	with FirebirdClientAPI do
1027	>	with FFirebirdClientAPI do
1028		FDataLength := DecodeInteger(FBufPtr+1,2);
1029		FSize := FDataLength + 3;
1030		end;
#	Line 986 | Line 1058 | begin
1058		isc_info_reads,
1059		isc_info_writes,
1060		isc_info_active_tran_count,
1061	+	isc_info_attachment_id,
1062		fb_info_pages_used,
1063		fb_info_pages_free,
1064		fb_info_conn_flags:
#	Line 1034 | Line 1107 | begin
1107		end;
1108		{$ENDIF}
1109
1110	<	constructor TDBInformation.Create(aSize: integer);
1110	>	constructor TDBInformation.Create(api: TFBClientAPI; aSize: integer);
1111		begin
1112	<	inherited Create(aSize);
1112	>	inherited Create(api,aSize);
1113		FIntegerType := dtInteger;
1114		end;
1115
#	Line 1053 | Line 1126 | begin
1126		group := byte(BufPtr^);
1127		if group in [isc_info_svc_get_users,isc_info_svc_limbo_trans] then
1128		begin
1129	<	with FirebirdClientAPI do
1129	>	with FFirebirdClientAPI do
1130		Result^.FSize := DecodeInteger(P,2) + 3;
1131		Inc(P,2);
1132		end;
#	Line 1062 | Line 1135 | begin
1135		while (P < FBufPtr + FSize) and (P^ <> isc_info_flag_end) do
1136		begin
1137		SetLength(FSubItems,i+1);
1138	+	FSubItems[i] := nil;
1139		case group of
1140		isc_info_svc_svr_db_info:
1141		case integer(P^) of
#	Line 1073 | Line 1147 | begin
1147		FSubItems[i] := AddStringItem(P);
1148
1149		else
1150	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1150	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1151		end;
1152
1153		isc_info_svc_get_license:
#	Line 1082 | Line 1156 | begin
1156		isc_spb_lic_key:
1157		FSubItems[i] := AddIntegerItem(P);
1158		else
1159	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1159	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1160		end;
1161
1162		isc_info_svc_limbo_trans:
#	Line 1101 | Line 1175 | begin
1175		isc_spb_tra_state:
1176		FSubItems[i] := AddByteItem(P);
1177		else
1178	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1178	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1179		end;
1180
1181		isc_info_svc_get_users:
#	Line 1119 | Line 1193 | begin
1193		FSubItems[i] := AddStringItem(P);
1194
1195		else
1196	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1196	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1197		end;
1198
1199		end;
#	Line 1147 | Line 1221 | begin
1221		Result := inherited AddSpecialItem(BufPtr);
1222		with Result^ do
1223		begin
1224	<	with FirebirdClientAPI do
1224	>	with FFirebirdClientAPI do
1225		FDataLength := DecodeInteger(FBufPtr+1, 2);
1226
1227		P := FBufPtr + 3; {skip length bytes}
#	Line 1170 | Line 1244 | begin
1244		while  (P < Buffer + getBufSize) and (P^ <> isc_info_end) do
1245		begin
1246		SetLength(FItems,i+1);
1247	+	FItems[i] := nil;
1248		case integer(P^) of
1249		isc_info_svc_line,
1250		isc_info_svc_get_env,
#	Line 1204 | Line 1279 | begin
1279
1280
1281		else
1282	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1282	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,getBufSize - (P-Buffer))]);
1283		end;
1284		P := P + FItems[i]^.FSize;
1285		Inc(i);
#	Line 1232 | Line 1307 | begin
1307
1308		if byte(BufPtr^) = isc_info_sql_records then
1309		begin
1310	<	with FirebirdClientAPI do
1310	>	with FFirebirdClientAPI do
1311		Result^.FSize := DecodeInteger(P,2) + 3;
1312		Inc(P,2);
1313		with Result^ do
#	Line 1308 | Line 1383 | begin
1383		end;
1384		end;
1385
1386	<	constructor TSQLInfoResultsBuffer.Create(aSize: integer);
1386	>	constructor TSQLInfoResultsBuffer.Create(api: TFBClientAPI; aSize: integer);
1387		begin
1388	<	inherited Create(aSize);
1388	>	inherited Create(api,aSize);
1389		FIntegerType := dtInteger;
1390		end;
1391
#	Line 1340 | Line 1415 | begin
1415		end;
1416		end;
1417
1418	<	constructor TBlobInfo.Create(aSize: integer);
1418	>	constructor TBlobInfo.Create(api: TFBClientAPI; aSize: integer);
1419		begin
1420	<	inherited Create(aSize);
1420	>	inherited Create(api,aSize);
1421		FIntegerType := dtInteger;
1422		end;
1423

Diff Legend

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