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.
Revision 263 by tony, Thu Dec 6 15:55:01 2018 UTC

#	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 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 116 | 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 191 | 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}
#	Line 259 | 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 295 | 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 403 | 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 424 | 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 436 | Line 452 | begin
452		inherited Create;
453		FOwner := AOwner;
454		FOwnerIntf := AOwner;
455	+	FFirebirdClientAPI := AOwner.FFirebirdClientAPI;
456		FItemData := Data;
457		end;
458
#	Line 464 | 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 490 | Line 507 | begin
507		Result := '';
508		with FItemData^ do
509		case FDataType of
510	+	dtIntegerFixed,
511		dtInteger:
512		Result := IntToStr(getAsInteger);
513		dtByte:
#	Line 501 | 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 FirebirdClientAPI do
528	>	with FFirebirdClientAPI do
529		len := DecodeInteger(FBufPtr+1,2);
530		SetString(Result,FBufPtr+3,len,CP_NONE);
531		end;
#	Line 548 | Line 566 | function TOutputBlockItem.getAsDateTime:
566		var aDate: integer;
567		aTime: integer;
568		begin
569	<	with FItemData^, FirebirdClientAPI do
569	>	with FItemData^, FFirebirdClientAPI do
570		if FDataType = dtDateTime then
571		begin
572		aDate := DecodeInteger(FBufPtr+3,4);
#	Line 575 | 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 632 | 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 647 | 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 687 | 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 727 | Line 745 | begin
745		begin
746		FDataType := dtDateTime;
747		FBufPtr := BufPtr;
748	<	with FirebirdClientAPI do
748	>	with FFirebirdClientAPI do
749		FDataLength := DecodeInteger(FBufPtr+1, 2);
750		FSize := FDataLength + 3;
751		SetLength(FSubItems,0);
#	Line 741 | Line 759 | begin
759		begin
760		FDataType := dtOctetString;
761		FBufPtr := BufPtr;
762	<	with FirebirdClientAPI do
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(aSize: integer);
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 765 | 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 843 | 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 860 | 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 933 | 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 952 | 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 1034 | Line 1070 | begin
1070		end;
1071		{$ENDIF}
1072
1073	<	constructor TDBInformation.Create(aSize: integer);
1073	>	constructor TDBInformation.Create(api: TFBClientAPI; aSize: integer);
1074		begin
1075	<	inherited Create(aSize);
1075	>	inherited Create(api,aSize);
1076		FIntegerType := dtInteger;
1077		end;
1078
#	Line 1053 | 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 1062 | 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 1073 | 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 1082 | 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 1101 | 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:
#	Line 1119 | 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 1147 | 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 1170 | 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 1204 | 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);
#	Line 1232 | 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 1308 | 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 1340 | 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