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 209 by tony, Wed Mar 14 12:48:51 2018 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 93 | Line 93 | type
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;
#	Line 133 | Line 135 | type
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
#	Line 179 | Line 182 | type
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
#	Line 189 | Line 192 | type
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
200		{ TServiceQueryResultItem }
#	Line 203 | Line 209 | type
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
#	Line 292 | Line 302 | implementation
302
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
#	Line 322 | Line 338 | function TCustomOutputBlock<_TItem,_IIte
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}
#	Line 344 | Line 363 | var P: POutputBlockItemData;
363		Obj: TOutputBlockItem;
364		begin
365		P := inherited Find(ItemType);
366	<	Obj := TOutputBlockItemClass(_TItem).Create(self.Owner,P);
367	<	if Obj.QueryInterface(GetTypeData(TypeInfo(_IItem))^.Guid,Result) <> 0 then
368	<	IBError(ibxeInterfaceNotSupported,[GuidToString(GetTypeData(TypeInfo(_IItem))^.Guid)]);
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 }
#	Line 406 | Line 430 | end;
430		procedure TOutputBlockItem.SetString(out S: AnsiString; Buf: PByte;
431		Len: integer; CodePage: TSystemCodePage);
432		var rs: RawByteString;
433	+	i: integer;
434		begin
435	<	system.SetString(rs,PAnsiChar(Buf),len);
435	>	{There seems to be a memory manager problem with SetString that can cause
436	>	an unhandled exception at the end of a program if it is used to set the
437	>	string. Safer to copy characters one by one. Note that Setlength does
438	>	not work around the bug either.}
439	>	rs := '';
440	>	for i := 0 to len-1 do
441	>	rs := rs + PAnsiChar(buf+i)^;
442	>	//  system.SetString(rs,PAnsiChar(Buf),len);
443		SetCodePage(rs,CodePage,false);
444		S := rs;
445		end;
#	Line 428 | Line 460 | end;
460
461		function TOutputBlockItem.getSize: integer;
462		begin
463	<	Result := FItemData^.FDataLength;
463	>	if FItemData = nil then
464	>	Result := 0
465	>	else
466	>	Result := FItemData^.FDataLength;
467		end;
468
469		procedure TOutputBlockItem.getRawBytes(var Buffer);
#	Line 469 | Line 504 | begin
504		Result := '';
505		with FItemData^ do
506		case FDataType of
507	+	dtIntegerFixed,
508		dtInteger:
509		Result := IntToStr(getAsInteger);
510		dtByte:
#	Line 484 | Line 520 | begin
520		len := DecodeInteger(FBufPtr+1,2);
521		SetString(Result,FBufPtr+3,len,CP_ACP);
522		end;
523	+	dtOctetString:
524	+	begin
525	+	with FirebirdClientAPI do
526	+	len := DecodeInteger(FBufPtr+1,2);
527	+	SetString(Result,FBufPtr+3,len,CP_NONE);
528	+	end;
529		else
530		IBError(ibxeOutputBlockTypeError,[nil]);
531		end;
#	Line 517 | Line 559 | begin
559		IBError(ibxeOutputBlockTypeError,[nil]);
560		end;
561
562	+	function TOutputBlockItem.getAsDateTime: TDateTime;
563	+	var aDate: integer;
564	+	aTime: integer;
565	+	begin
566	+	with FItemData^, FirebirdClientAPI do
567	+	if FDataType = dtDateTime then
568	+	begin
569	+	aDate := DecodeInteger(FBufPtr+3,4);
570	+	aTime := DecodeInteger(FBufPtr+7,4);
571	+	Result := SQLDecodeDate(@aDate) + SQLDecodeTime(@aTime)
572	+	end
573	+	else
574	+	IBError(ibxeOutputBlockTypeError,[nil]);
575	+	end;
576	+
577	+
578		function TOutputBlockItem.CopyTo(stream: TStream; count: integer): integer;
579		var len: integer;
580		begin
#	Line 677 | Line 735 | begin
735		end;
736		end;
737
738	+	function TOutputBlock.AddDateTimeItem(BufPtr: PByte): POutputBlockItemData;
739	+	begin
740	+	new(Result);
741	+	with Result^ do
742	+	begin
743	+	FDataType := dtDateTime;
744	+	FBufPtr := BufPtr;
745	+	with FirebirdClientAPI do
746	+	FDataLength := DecodeInteger(FBufPtr+1, 2);
747	+	FSize := FDataLength + 3;
748	+	SetLength(FSubItems,0);
749	+	end;
750	+	end;
751	+
752	+	function TOutputBlock.AddOctetString(BufPtr: PByte): POutputBlockItemData;
753	+	begin
754	+	new(Result);
755	+	with Result^ do
756	+	begin
757	+	FDataType := dtOctetString;
758	+	FBufPtr := BufPtr;
759	+	with FirebirdClientAPI do
760	+	FDataLength := DecodeInteger(FBufPtr+1, 2);
761	+	FSize := FDataLength + 3;
762	+	SetLength(FSubItems,0);
763	+	end;
764	+	end;
765	+
766		constructor TOutputBlock.Create(aSize: integer);
767		begin
768		inherited Create;
#	Line 694 | Line 780 | var i, j: integer;
780		begin
781		for i := 0 to length(FItems) - 1 do
782		begin
783	<	for j := 0 to Length(FItems[i]^.FSubItems) -1 do
784	<	dispose(FItems[i]^.FSubItems[j]);
785	<	dispose(FItems[i]);
783	>	if FItems[i] <> nil then
784	>	begin
785	>	for j := 0 to Length(FItems[i]^.FSubItems) -1 do
786	>	if FItems[i]^.FSubItems[j] <> nil then
787	>	dispose(FItems[i]^.FSubItems[j]);
788	>	dispose(FItems[i]);
789	>	end;
790		end;
791		FreeMem(FBuffer);
792		inherited Destroy;
#	Line 772 | Line 862 | begin
862		else
863		begin
864		item := TOutputBlockItem.Create(self,(aItems[i]));
865	<	writeln(Indent,'ItemType = ',byte(FBufPtr^),' Value = ',(item as TOutputBlockItem).GetAsString);
865	>	try
866	>	writeln(Indent,'ItemType = ',byte(FBufPtr^),' Value = ',(item as TOutputBlockItem).GetAsString);
867	>	except
868	>	writeln(Indent,'Unknown ItemType = ',byte(FBufPtr^));
869	>	end;
870		end;
871		end;
872		end;
#	Line 789 | Line 883 | begin
883		if byte(FBuffer[i]) = isc_info_end then break;
884		end;
885		writeln;
886	+	for i := 0 to getBufSize - 1 do
887	+	begin
888	+	if chr(FBuffer[i]) in [' '..'~'] then
889	+	write(chr(Buffer[i]))
890	+	else
891	+	write('.');
892	+	if byte(FBuffer[i]) = isc_info_end then break;
893	+	end;
894	+	writeln;
895		end;
896
897		{ TDBInfoItem }
#	Line 898 | Line 1001 | begin
1001		begin
1002		SetLength(FItems,index+1);
1003		case byte(P^) of
1004	+	isc_info_db_read_only,
1005		isc_info_no_reserve,
1006		isc_info_allocation,
1007		isc_info_ods_minor_version,
#	Line 912 | Line 1016 | begin
1016		isc_info_fetches,
1017		isc_info_marks,
1018		isc_info_reads,
1019	<	isc_info_writes:
1019	>	isc_info_writes,
1020	>	isc_info_active_tran_count,
1021	>	fb_info_pages_used,
1022	>	fb_info_pages_free,
1023	>	fb_info_conn_flags:
1024		FItems[index] := AddIntegerItem(P);
1025
1026		isc_info_implementation,
1027		isc_info_base_level:
1028		FItems[index] := AddBytesItem(P);
1029
1030	+	isc_info_creation_date:
1031	+	FItems[index] := AddDateTimeItem(P);
1032	+
1033	+	fb_info_page_contents:
1034	+	FItems[index] := AddOctetString(P);
1035	+
1036	+	fb_info_crypt_key:
1037	+	FItems[index] := AddStringItem(P);
1038	+
1039		isc_info_db_id,
1040		isc_info_version,
1041		isc_info_backout_count,
#	Line 940 | Line 1057 | begin
1057		end;
1058		end;
1059
1060	+	{$IFNDEF FPC}
1061	+	function TDBInformation.Find(ItemType: byte): IDBInfoItem;
1062	+	begin
1063	+	Result := inherited Find(ItemType);
1064	+	if Result.GetSize = 0 then
1065	+	Result := nil;
1066	+	end;
1067	+	{$ENDIF}
1068	+
1069		constructor TDBInformation.Create(aSize: integer);
1070		begin
1071		inherited Create(aSize);
#	Line 968 | Line 1094 | begin
1094		while (P < FBufPtr + FSize) and (P^ <> isc_info_flag_end) do
1095		begin
1096		SetLength(FSubItems,i+1);
1097	+	FSubItems[i] := nil;
1098		case group of
1099		isc_info_svc_svr_db_info:
1100		case integer(P^) of
#	Line 979 | Line 1106 | begin
1106		FSubItems[i] := AddStringItem(P);
1107
1108		else
1109	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1109	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1110		end;
1111
1112		isc_info_svc_get_license:
#	Line 988 | Line 1115 | begin
1115		isc_spb_lic_key:
1116		FSubItems[i] := AddIntegerItem(P);
1117		else
1118	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1118	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1119		end;
1120
1121		isc_info_svc_limbo_trans:
#	Line 1007 | Line 1134 | begin
1134		isc_spb_tra_state:
1135		FSubItems[i] := AddByteItem(P);
1136		else
1137	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1137	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1138		end;
1139
1140		isc_info_svc_get_users:
1141		case integer(P^) of
1142	+	isc_spb_sec_admin,
1143		isc_spb_sec_userid,
1144		isc_spb_sec_groupid:
1145		FSubItems[i] := AddIntegerItem(P);
#	Line 1024 | Line 1152 | begin
1152		FSubItems[i] := AddStringItem(P);
1153
1154		else
1155	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1155	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1156		end;
1157
1158		end;
#	Line 1075 | Line 1203 | begin
1203		while  (P < Buffer + getBufSize) and (P^ <> isc_info_end) do
1204		begin
1205		SetLength(FItems,i+1);
1206	+	FItems[i] := nil;
1207		case integer(P^) of
1208		isc_info_svc_line,
1209		isc_info_svc_get_env,
#	Line 1109 | Line 1238 | begin
1238
1239
1240		else
1241	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1241	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,getBufSize - (P-Buffer))]);
1242		end;
1243		P := P + FItems[i]^.FSize;
1244		Inc(i);
1245		end;
1246		end;
1247
1248	+	{$IFNDEF FPC}
1249	+	function TServiceQueryResults.Find(ItemType: byte): IServiceQueryResultItem;
1250	+	begin
1251	+	Result := inherited Find(ItemType);
1252	+	if Result.GetSize = 0 then
1253	+	Result := nil;
1254	+	end;
1255	+	{$ENDIF}
1256	+
1257		{ TSQLInfoResultsBuffer }
1258
1259		function TSQLInfoResultsBuffer.AddListItem(BufPtr: PByte): POutputBlockItemData;

Diff Legend

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