ViewVC Help

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

root/public/ibx/branches/journaling/fbintf/client/FBSQLData.pas

Comparing ibx/trunk/fbintf/client/FBSQLData.pas (file contents):
Revision 270 by tony, Fri Jan 18 11:10:37 2019 UTC vs.
Revision 309 by tony, Tue Jul 21 08:00:42 2020 UTC

#	Line 80 | Line 80 | unit FBSQLData;
80		interface
81
82		uses
83	<	Classes, SysUtils, IBExternals, IBHeader, IB,  FBActivityMonitor, FBClientAPI;
83	>	Classes, SysUtils, IBExternals, IBHeader, {$IFDEF WINDOWS} Windows, {$ENDIF} IB,  FBActivityMonitor, FBClientAPI;
84
85		type
86
#	Line 119 | Line 119 | type
119		function GetSQLType: cardinal; virtual; abstract;
120		function GetSQLTypeName: AnsiString; overload;
121		class function GetSQLTypeName(SQLType: short): AnsiString; overload;
122	+	function GetStrDataLength: short;
123		function GetName: AnsiString; virtual; abstract;
124		function GetScale: integer; virtual; abstract;
125		function GetAsBoolean: boolean;
#	Line 137 | Line 138 | type
138		function GetAsVariant: Variant;
139		function GetModified: boolean; virtual;
140		function GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats): integer;
141	+	function GetSize: cardinal; virtual; abstract;
142	+	function GetCharSetWidth: integer; virtual; abstract;
143		procedure SetAsBoolean(AValue: boolean); virtual;
144		procedure SetAsCurrency(Value: Currency); virtual;
145		procedure SetAsInt64(Value: Int64); virtual;
#	Line 239 | Line 242 | type
242		function GetRelationName: AnsiString;  virtual; abstract;
243		function GetScale: integer; virtual; abstract;
244		function GetCharSetID: cardinal; virtual; abstract;
245	+	function GetCharSetWidth: integer; virtual; abstract;
246		function GetCodePage: TSystemCodePage; virtual; abstract;
247		function GetIsNull: Boolean;   virtual; abstract;
248		function GetIsNullable: boolean; virtual; abstract;
#	Line 292 | Line 296 | type
296		FIBXSQLVAR: TSQLVarData;
297		FOwner: IUnknown;         {Keep reference to ensure Metadata/statement not discarded}
298		FPrepareSeqNo: integer;
295	–	FStatement: IStatement;
299		FChangeSeqNo: integer;
300		protected
301		procedure CheckActive; override;
#	Line 304 | Line 307 | type
307		constructor Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
308		destructor Destroy; override;
309		function GetSQLDialect: integer; override;
307	–	property Statement: IStatement read FStatement;
310
311		public
312		{IColumnMetaData}
#	Line 319 | Line 321 | type
321		function GetScale: integer; override;
322		function getCharSetID: cardinal; override;
323		function GetIsNullable: boolean; override;
324	<	function GetSize: cardinal;
324	>	function GetSize: cardinal; override;
325	>	function GetCharSetWidth: integer; override;
326		function GetArrayMetaData: IArrayMetaData;
327		function GetBlobMetaData: IBlobMetaData;
328	+	function GetStatement: IStatement;
329	+	function GetTransaction: ITransaction; virtual;
330		property Name: AnsiString read GetName;
331		property Size: cardinal read GetSize;
332		property CharSetID: cardinal read getCharSetID;
333		property SQLSubtype: integer read getSubtype;
334		property IsNullable: Boolean read GetIsNullable;
335	+	public
336	+	property Statement: IStatement read GetStatement;
337		end;
338
339		{ TIBSQLData }
340
341		TIBSQLData = class(TColumnMetaData,ISQLData)
342	+	private
343	+	FTransaction: ITransaction;
344		protected
345		procedure CheckActive; override;
346		public
347	+	function GetTransaction: ITransaction; override;
348		function GetIsNull: Boolean; override;
349		function GetAsArray: IArray;
350		function GetAsBlob: IBlob; overload;
#	Line 421 | Line 431 | type
431		function getSQLParam(index: integer): ISQLParam;
432		function ByName(Idx: AnsiString): ISQLParam ;
433		function GetModified: Boolean;
434	+	function GetHasCaseSensitiveParams: Boolean;
435		end;
436
437		{ TResults }
#	Line 442 | Line 453 | type
453		function ByName(Idx: AnsiString): ISQLData;
454		function getSQLData(index: integer): ISQLData;
455		procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
456	+	function GetStatement: IStatement;
457		function GetTransaction: ITransaction; virtual;
458		procedure SetRetainInterfaces(aValue: boolean);
459		end;
#	Line 948 | Line 960 | begin
960		end;
961		end;
962
963	+	function TSQLDataItem.GetStrDataLength: short;
964	+	begin
965	+	with FFirebirdClientAPI do
966	+	if SQLType = SQL_VARYING then
967	+	Result := DecodeInteger(SQLData, 2)
968	+	else
969	+	Result := DataLength;
970	+	end;
971	+
972		function TSQLDataItem.GetAsBoolean: boolean;
973		begin
974		CheckActive;
#	Line 1157 | Line 1178 | begin
1178		end;
1179		end;
1180
1181	+	{Copied from LazUTF8}
1182	+
1183	+	function UTF8CodepointSizeFull(p: PAnsiChar): integer;
1184	+	const TopBitSetMask   = $80; {%10000000}
1185	+	Top2BitsSetMask = $C0; {%11000000}
1186	+	Top3BitsSetMask = $E0; {%11100000}
1187	+	Top4BitsSetMask = $F0; {%11110000}
1188	+	Top5BitsSetMask = $F8; {%11111000}
1189	+	begin
1190	+	case p^ of
1191	+	#0..#191: // %11000000
1192	+	// regular single byte character (#0 is a character, this is Pascal ;)
1193	+	Result:=1;
1194	+	#192..#223: // p^ and %11100000 = %11000000
1195	+	begin
1196	+	// could be 2 byte character
1197	+	if (ord(p[1]) and Top2BitsSetMask) = TopBitSetMask then
1198	+	Result:=2
1199	+	else
1200	+	Result:=1;
1201	+	end;
1202	+	#224..#239: // p^ and %11110000 = %11100000
1203	+	begin
1204	+	// could be 3 byte character
1205	+	if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1206	+	and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask) then
1207	+	Result:=3
1208	+	else
1209	+	Result:=1;
1210	+	end;
1211	+	#240..#247: // p^ and %11111000 = %11110000
1212	+	begin
1213	+	// could be 4 byte character
1214	+	if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1215	+	and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask)
1216	+	and ((ord(p[3]) and Top2BitsSetMask) = TopBitSetMask) then
1217	+	Result:=4
1218	+	else
1219	+	Result:=1;
1220	+	end;
1221	+	else
1222	+	Result:=1;
1223	+	end;
1224	+	end;
1225	+
1226	+	{Returns the byte length of a UTF8 string with a fixed charwidth}
1227	+
1228	+	function GetStrLen(p: PAnsiChar; CharWidth, MaxDataLength: cardinal): integer;
1229	+	var i: integer;
1230	+	cplen: integer;
1231	+	s: AnsiString;
1232	+	begin
1233	+	Result := 0;
1234	+	s := strpas(p);
1235	+	for i := 1 to CharWidth do
1236	+	begin
1237	+	cplen := UTF8CodepointSizeFull(p);
1238	+	Inc(p,cplen);
1239	+	Inc(Result,cplen);
1240	+	if Result >= MaxDataLength then
1241	+	begin
1242	+	Result := MaxDataLength;
1243	+	Exit;
1244	+	end;
1245	+	end;
1246	+	end;
1247
1248		function TSQLDataItem.GetAsString: AnsiString;
1249		var
#	Line 1180 | Line 1267 | begin
1267		begin
1268		sz := SQLData;
1269		if (SQLType = SQL_TEXT) then
1270	<	str_len := DataLength
1270	>	begin
1271	>	if GetCodePage = cp_utf8 then
1272	>	str_len := GetStrLen(PAnsiChar(sz),GetSize div GetCharSetWidth,DataLength)
1273	>	else
1274	>	str_len := DataLength
1275	>	end
1276		else begin
1277	<	str_len := DecodeInteger(SQLData, 2);
1277	>	str_len := DecodeInteger(sz, 2);
1278		Inc(sz, 2);
1279		end;
1280		SetString(rs, PAnsiChar(sz), str_len);
1281		SetCodePage(rs,GetCodePage,false);
1282	<	if (SQLType = SQL_TEXT) and (GetCharSetID <> 1) then
1191	<	Result := TrimRight(rs)
1192	<	else
1193	<	Result := rs
1282	>	Result := rs;
1283		end;
1284		SQL_TYPE_DATE:
1285		result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
#	Line 1661 | Line 1750 | begin
1750		result := FIBXSQLVAR.DataLength;
1751		end;
1752
1753	+	function TColumnMetaData.GetCharSetWidth: integer;
1754	+	begin
1755	+	CheckActive;
1756	+	result := FIBXSQLVAR.GetCharSetWidth;
1757	+	end;
1758	+
1759		function TColumnMetaData.GetArrayMetaData: IArrayMetaData;
1760		begin
1761		CheckActive;
#	Line 1673 | Line 1768 | begin
1768		result := FIBXSQLVAR.GetBlobMetaData;
1769		end;
1770
1771	+	function TColumnMetaData.GetStatement: IStatement;
1772	+	begin
1773	+	Result := FIBXSQLVAR.GetStatement;
1774	+	end;
1775	+
1776	+	function TColumnMetaData.GetTransaction: ITransaction;
1777	+	begin
1778	+	Result := GetStatement.GetTransaction;
1779	+	end;
1780	+
1781		{ TIBSQLData }
1782
1783		procedure TIBSQLData.CheckActive;
#	Line 1692 | Line 1797 | begin
1797		IBError(ibxeBOF,[nil]);
1798		end;
1799
1800	+	function TIBSQLData.GetTransaction: ITransaction;
1801	+	begin
1802	+	if FTransaction = nil then
1803	+	Result := inherited GetTransaction
1804	+	else
1805	+	Result := FTransaction;
1806	+	end;
1807	+
1808		function TIBSQLData.GetIsNull: Boolean;
1809		begin
1810		CheckActive;
#	Line 2392 | Line 2505 | begin
2505		end;
2506		end;
2507
2508	+	function TSQLParams.GetHasCaseSensitiveParams: Boolean;
2509	+	begin
2510	+	Result := FSQLParams.CaseSensitiveParams;
2511	+	end;
2512	+
2513		{ TResults }
2514
2515		procedure TResults.CheckActive;
#	Line 2410 | Line 2528 | begin
2528		end;
2529
2530		function TResults.GetISQLData(aIBXSQLVAR: TSQLVarData): ISQLData;
2531	+	var col: TIBSQLData;
2532		begin
2533		if (aIBXSQLVAR.Index < 0) or (aIBXSQLVAR.Index >= getCount) then
2534		IBError(ibxeInvalidColumnIndex,[nil]);
2535
2536		if not HasInterface(aIBXSQLVAR.Index) then
2537		AddInterface(aIBXSQLVAR.Index, TIBSQLData.Create(self,aIBXSQLVAR));
2538	<	Result := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
2538	>	col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
2539	>	col.FTransaction := GetTransaction;
2540	>	Result := col;
2541		end;
2542
2543		constructor TResults.Create(aResults: TSQLDataArea);
#	Line 2473 | Line 2594 | begin
2594		FResults.GetData(index,IsNull, len,data);
2595		end;
2596
2597	+	function TResults.GetStatement: IStatement;
2598	+	begin
2599	+	Result := FStatement;
2600	+	end;
2601	+
2602		function TResults.GetTransaction: ITransaction;
2603		begin
2604		Result := FStatement.GetTransaction;

Diff Legend

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