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 144 by tony, Sat Feb 24 23:15:51 2018 UTC vs.
Revision 359 by tony, Tue Dec 7 09:37:32 2021 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
#	Line 409 | 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 430 | 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 442 | Line 453 | begin
453		inherited Create;
454		FOwner := AOwner;
455		FOwnerIntf := AOwner;
456	+	FFirebirdClientAPI := AOwner.FFirebirdClientAPI;
457		FItemData := Data;
458		end;
459
#	Line 464 | 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 508 | 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 555 | 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 582 | 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 625 | 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 654 | 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 694 | 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 734 | 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 748 | 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 871 | 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;
932	>	//    if byte(FBuffer[i]) = isc_info_end then break;
933		end;
934		writeln;
935		end;
#	Line 957 | 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 976 | 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 1058 | Line 1106 | begin
1106		end;
1107		{$ENDIF}
1108
1109	<	constructor TDBInformation.Create(aSize: integer);
1109	>	constructor TDBInformation.Create(api: TFBClientAPI; aSize: integer);
1110		begin
1111	<	inherited Create(aSize);
1111	>	inherited Create(api,aSize);
1112		FIntegerType := dtInteger;
1113		end;
1114
#	Line 1077 | Line 1125 | begin
1125		group := byte(BufPtr^);
1126		if group in [isc_info_svc_get_users,isc_info_svc_limbo_trans] then
1127		begin
1128	<	with FirebirdClientAPI do
1128	>	with FFirebirdClientAPI do
1129		Result^.FSize := DecodeInteger(P,2) + 3;
1130		Inc(P,2);
1131		end;
#	Line 1172 | Line 1220 | begin
1220		Result := inherited AddSpecialItem(BufPtr);
1221		with Result^ do
1222		begin
1223	<	with FirebirdClientAPI do
1223	>	with FFirebirdClientAPI do
1224		FDataLength := DecodeInteger(FBufPtr+1, 2);
1225
1226		P := FBufPtr + 3; {skip length bytes}
#	Line 1258 | Line 1306 | begin
1306
1307		if byte(BufPtr^) = isc_info_sql_records then
1308		begin
1309	<	with FirebirdClientAPI do
1309	>	with FFirebirdClientAPI do
1310		Result^.FSize := DecodeInteger(P,2) + 3;
1311		Inc(P,2);
1312		with Result^ do
#	Line 1334 | Line 1382 | begin
1382		end;
1383		end;
1384
1385	<	constructor TSQLInfoResultsBuffer.Create(aSize: integer);
1385	>	constructor TSQLInfoResultsBuffer.Create(api: TFBClientAPI; aSize: integer);
1386		begin
1387	<	inherited Create(aSize);
1387	>	inherited Create(api,aSize);
1388		FIntegerType := dtInteger;
1389		end;
1390
#	Line 1366 | Line 1414 | begin
1414		end;
1415		end;
1416
1417	<	constructor TBlobInfo.Create(aSize: integer);
1417	>	constructor TBlobInfo.Create(api: TFBClientAPI; aSize: integer);
1418		begin
1419	<	inherited Create(aSize);
1419	>	inherited Create(api,aSize);
1420		FIntegerType := dtInteger;
1421		end;
1422

Diff Legend

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