ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/fbintf/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 144 by tony, Sat Feb 24 23:15: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 428 | Line 452 | end;
452
453		function TOutputBlockItem.getSize: integer;
454		begin
455	<	Result := FItemData^.FDataLength;
455	>	if FItemData = nil then
456	>	Result := 0
457	>	else
458	>	Result := FItemData^.FDataLength;
459		end;
460
461		procedure TOutputBlockItem.getRawBytes(var Buffer);
#	Line 469 | Line 496 | begin
496		Result := '';
497		with FItemData^ do
498		case FDataType of
499	+	dtIntegerFixed,
500		dtInteger:
501		Result := IntToStr(getAsInteger);
502		dtByte:
#	Line 484 | Line 512 | begin
512		len := DecodeInteger(FBufPtr+1,2);
513		SetString(Result,FBufPtr+3,len,CP_ACP);
514		end;
515	+	dtOctetString:
516	+	begin
517	+	with FirebirdClientAPI do
518	+	len := DecodeInteger(FBufPtr+1,2);
519	+	SetString(Result,FBufPtr+3,len,CP_NONE);
520	+	end;
521		else
522		IBError(ibxeOutputBlockTypeError,[nil]);
523		end;
#	Line 517 | Line 551 | begin
551		IBError(ibxeOutputBlockTypeError,[nil]);
552		end;
553
554	+	function TOutputBlockItem.getAsDateTime: TDateTime;
555	+	var aDate: integer;
556	+	aTime: integer;
557	+	begin
558	+	with FItemData^, FirebirdClientAPI do
559	+	if FDataType = dtDateTime then
560	+	begin
561	+	aDate := DecodeInteger(FBufPtr+3,4);
562	+	aTime := DecodeInteger(FBufPtr+7,4);
563	+	Result := SQLDecodeDate(@aDate) + SQLDecodeTime(@aTime)
564	+	end
565	+	else
566	+	IBError(ibxeOutputBlockTypeError,[nil]);
567	+	end;
568	+
569	+
570		function TOutputBlockItem.CopyTo(stream: TStream; count: integer): integer;
571		var len: integer;
572		begin
#	Line 677 | Line 727 | begin
727		end;
728		end;
729
730	+	function TOutputBlock.AddDateTimeItem(BufPtr: PByte): POutputBlockItemData;
731	+	begin
732	+	new(Result);
733	+	with Result^ do
734	+	begin
735	+	FDataType := dtDateTime;
736	+	FBufPtr := BufPtr;
737	+	with FirebirdClientAPI do
738	+	FDataLength := DecodeInteger(FBufPtr+1, 2);
739	+	FSize := FDataLength + 3;
740	+	SetLength(FSubItems,0);
741	+	end;
742	+	end;
743	+
744	+	function TOutputBlock.AddOctetString(BufPtr: PByte): POutputBlockItemData;
745	+	begin
746	+	new(Result);
747	+	with Result^ do
748	+	begin
749	+	FDataType := dtOctetString;
750	+	FBufPtr := BufPtr;
751	+	with FirebirdClientAPI do
752	+	FDataLength := DecodeInteger(FBufPtr+1, 2);
753	+	FSize := FDataLength + 3;
754	+	SetLength(FSubItems,0);
755	+	end;
756	+	end;
757	+
758		constructor TOutputBlock.Create(aSize: integer);
759		begin
760		inherited Create;
#	Line 694 | Line 772 | var i, j: integer;
772		begin
773		for i := 0 to length(FItems) - 1 do
774		begin
775	<	for j := 0 to Length(FItems[i]^.FSubItems) -1 do
776	<	dispose(FItems[i]^.FSubItems[j]);
777	<	dispose(FItems[i]);
775	>	if FItems[i] <> nil then
776	>	begin
777	>	for j := 0 to Length(FItems[i]^.FSubItems) -1 do
778	>	if FItems[i]^.FSubItems[j] <> nil then
779	>	dispose(FItems[i]^.FSubItems[j]);
780	>	dispose(FItems[i]);
781	>	end;
782		end;
783		FreeMem(FBuffer);
784		inherited Destroy;
#	Line 772 | Line 854 | begin
854		else
855		begin
856		item := TOutputBlockItem.Create(self,(aItems[i]));
857	<	writeln(Indent,'ItemType = ',byte(FBufPtr^),' Value = ',(item as TOutputBlockItem).GetAsString);
857	>	try
858	>	writeln(Indent,'ItemType = ',byte(FBufPtr^),' Value = ',(item as TOutputBlockItem).GetAsString);
859	>	except
860	>	writeln(Indent,'Unknown ItemType = ',byte(FBufPtr^));
861	>	end;
862		end;
863		end;
864		end;
#	Line 789 | Line 875 | begin
875		if byte(FBuffer[i]) = isc_info_end then break;
876		end;
877		writeln;
878	+	for i := 0 to getBufSize - 1 do
879	+	begin
880	+	if chr(FBuffer[i]) in [' '..'~'] then
881	+	write(chr(Buffer[i]))
882	+	else
883	+	write('.');
884	+	if byte(FBuffer[i]) = isc_info_end then break;
885	+	end;
886	+	writeln;
887		end;
888
889		{ TDBInfoItem }
#	Line 898 | Line 993 | begin
993		begin
994		SetLength(FItems,index+1);
995		case byte(P^) of
996	+	isc_info_db_read_only,
997		isc_info_no_reserve,
998		isc_info_allocation,
999		isc_info_ods_minor_version,
#	Line 912 | Line 1008 | begin
1008		isc_info_fetches,
1009		isc_info_marks,
1010		isc_info_reads,
1011	<	isc_info_writes:
1011	>	isc_info_writes,
1012	>	isc_info_active_tran_count,
1013	>	fb_info_pages_used,
1014	>	fb_info_pages_free,
1015	>	fb_info_conn_flags:
1016		FItems[index] := AddIntegerItem(P);
1017
1018		isc_info_implementation,
1019		isc_info_base_level:
1020		FItems[index] := AddBytesItem(P);
1021
1022	+	isc_info_creation_date:
1023	+	FItems[index] := AddDateTimeItem(P);
1024	+
1025	+	fb_info_page_contents:
1026	+	FItems[index] := AddOctetString(P);
1027	+
1028	+	fb_info_crypt_key:
1029	+	FItems[index] := AddStringItem(P);
1030	+
1031		isc_info_db_id,
1032		isc_info_version,
1033		isc_info_backout_count,
#	Line 940 | Line 1049 | begin
1049		end;
1050		end;
1051
1052	+	{$IFNDEF FPC}
1053	+	function TDBInformation.Find(ItemType: byte): IDBInfoItem;
1054	+	begin
1055	+	Result := inherited Find(ItemType);
1056	+	if Result.GetSize = 0 then
1057	+	Result := nil;
1058	+	end;
1059	+	{$ENDIF}
1060	+
1061		constructor TDBInformation.Create(aSize: integer);
1062		begin
1063		inherited Create(aSize);
#	Line 968 | Line 1086 | begin
1086		while (P < FBufPtr + FSize) and (P^ <> isc_info_flag_end) do
1087		begin
1088		SetLength(FSubItems,i+1);
1089	+	FSubItems[i] := nil;
1090		case group of
1091		isc_info_svc_svr_db_info:
1092		case integer(P^) of
#	Line 979 | Line 1098 | begin
1098		FSubItems[i] := AddStringItem(P);
1099
1100		else
1101	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1101	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1102		end;
1103
1104		isc_info_svc_get_license:
#	Line 988 | Line 1107 | begin
1107		isc_spb_lic_key:
1108		FSubItems[i] := AddIntegerItem(P);
1109		else
1110	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1110	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1111		end;
1112
1113		isc_info_svc_limbo_trans:
#	Line 1007 | Line 1126 | begin
1126		isc_spb_tra_state:
1127		FSubItems[i] := AddByteItem(P);
1128		else
1129	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1129	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1130		end;
1131
1132		isc_info_svc_get_users:
1133		case integer(P^) of
1134	+	isc_spb_sec_admin,
1135		isc_spb_sec_userid,
1136		isc_spb_sec_groupid:
1137		FSubItems[i] := AddIntegerItem(P);
#	Line 1024 | Line 1144 | begin
1144		FSubItems[i] := AddStringItem(P);
1145
1146		else
1147	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1147	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,FSize - (P-FBufPtr))]);
1148		end;
1149
1150		end;
#	Line 1075 | Line 1195 | begin
1195		while  (P < Buffer + getBufSize) and (P^ <> isc_info_end) do
1196		begin
1197		SetLength(FItems,i+1);
1198	+	FItems[i] := nil;
1199		case integer(P^) of
1200		isc_info_svc_line,
1201		isc_info_svc_get_env,
#	Line 1109 | Line 1230 | begin
1230
1231
1232		else
1233	<	IBError(ibxeOutputParsingError, [integer(P^)]);
1233	>	IBError(ibxeOutputParsingError, [integer(P^),BufToStr(P,getBufSize - (P-Buffer))]);
1234		end;
1235		P := P + FItems[i]^.FSize;
1236		Inc(i);
1237		end;
1238		end;
1239
1240	+	{$IFNDEF FPC}
1241	+	function TServiceQueryResults.Find(ItemType: byte): IServiceQueryResultItem;
1242	+	begin
1243	+	Result := inherited Find(ItemType);
1244	+	if Result.GetSize = 0 then
1245	+	Result := nil;
1246	+	end;
1247	+	{$ENDIF}
1248	+
1249		{ TSQLInfoResultsBuffer }
1250
1251		function TSQLInfoResultsBuffer.AddListItem(BufPtr: PByte): POutputBlockItemData;

Diff Legend

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