[ViewVC] Diff of: public/ibx/branches/journaling/fbintf/client/FBSQLData.pas

Comparing ibx/trunk/fbintf/client/FBSQLData.pas (file contents):
Revision 59 by tony, Mon Mar 13 09:51:56 2017 UTC vs.
Revision 309 by tony, Tue Jul 21 08:00:42 2020 UTC

#	Line 76 \| Line 76 \| unit FBSQLData;
76		methods are needed for SQL parameters only. The string getters and setters
77		are virtual as SQLVar and Array encodings of string data is different.}
78
79	–	{ $define ALLOWDIALECT3PARAMNAMES}
80	–
81	–	{$ifndef ALLOWDIALECT3PARAMNAMES}
82	–
83	–	{ Note on SQL Dialects and SQL Parameter Names
84	–	--------------------------------------------
85	–
86	–	Even when dialect 3 quoted format parameter names are not supported, IBX still processes
87	–	parameter names case insensitive. This does result in some additional overhead
88	–	due to a call to "AnsiUpperCase". This can be avoided by undefining
89	–	"UseCaseInSensitiveParamName" below.
90	–
91	–	Note: do not define "UseCaseSensitiveParamName" when "ALLOWDIALECT3PARAMNAMES"
92	–	is defined. This will not give a useful result.
93	–	}
94	–	{$define UseCaseInSensitiveParamName}
95	–	{$endif}
79
80		interface
81
82		uses
83	<	Classes, SysUtils, IBExternals, IBHeader, IB, FBActivityMonitor;
83	>	Classes, SysUtils, IBExternals, IBHeader, {$IFDEF WINDOWS} Windows, {$ENDIF} IB, FBActivityMonitor, FBClientAPI;
84
85		type
86
#	Line 105 \| Line 88 \| type
88
89		TSQLDataItem = class(TFBInterfacedObject)
90		private
91	+	FFirebirdClientAPI: TFBClientAPI;
92		function AdjustScale(Value: Int64; aScale: Integer): Double;
93		function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
94		function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
95	+	function GetTimestampFormatStr: AnsiString;
96	+	function GetDateFormatStr(IncludeTime: boolean): AnsiString;
97	+	function GetTimeFormatStr: AnsiString;
98		procedure SetAsInteger(AValue: Integer);
99		protected
100		function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
#	Line 128 \| Line 115 \| type
115		property DataLength: cardinal read GetDataLength write SetDataLength;
116
117		public
118	+	constructor Create(api: TFBClientAPI);
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 145 \| Line 134 \| type
134		function GetAsShort: short;
135		function GetAsString: AnsiString; virtual;
136		function GetIsNull: Boolean; virtual;
137	<	function getIsNullable: boolean; virtual;
137	>	function GetIsNullable: boolean; virtual;
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 196 \| Line 188 \| type
188
189		TSQLDataArea = class
190		private
191	+	FCaseSensitiveParams: boolean;
192		function GetColumn(index: integer): TSQLVarData;
193		function GetCount: integer;
194		protected
#	Line 218 \| Line 211 \| type
211		var data: PByte); virtual;
212		procedure RowChange;
213		function StateChanged(var ChangeSeqNo: integer): boolean; virtual; abstract;
214	+	property CaseSensitiveParams: boolean read FCaseSensitiveParams
215	+	write FCaseSensitiveParams; {Only used when IsInputDataArea true}
216		property Count: integer read GetCount;
217		property Column[index: integer]: TSQLVarData read GetColumn;
218		property UniqueRelationName: AnsiString read FUniqueRelationName;
#	Line 247 \| 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 300 \| Line 296 \| type
296		FIBXSQLVAR: TSQLVarData;
297		FOwner: IUnknown; {Keep reference to ensure Metadata/statement not discarded}
298		FPrepareSeqNo: integer;
303	–	FStatement: IStatement;
299		FChangeSeqNo: integer;
300		protected
301		procedure CheckActive; override;
#	Line 312 \| Line 307 \| type
307		constructor Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
308		destructor Destroy; override;
309		function GetSQLDialect: integer; override;
315	–	property Statement: IStatement read FStatement;
310
311		public
312		{IColumnMetaData}
#	Line 327 \| 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 429 \| 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 450 \| 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;
460
461		implementation
462
463	<	uses FBMessages, FBClientAPI, variants, IBUtils, FBTransaction;
460	<
463	>	uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
464
465		{ TSQLDataArea }
466
#	Line 510 \| Line 513 \| end;
513
514		procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
515		var sProcessedSQL: AnsiString);
513	–	var
514	–	cCurChar, cNextChar, cQuoteChar: AnsiChar;
515	–	sParamName: AnsiString;
516	–	j, i, iLenSQL, iSQLPos: Integer;
517	–	iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
518	–	iParamSuffix: Integer;
519	–	slNames: TStrings;
520	–	StrBuffer: PByte;
521	–	found: boolean;
522	–
523	–	const
524	–	DefaultState = 0;
525	–	CommentState = 1;
526	–	QuoteState = 2;
527	–	ParamState = 3;
528	–	ArrayDimState = 4;
529	–	{$ifdef ALLOWDIALECT3PARAMNAMES}
530	–	ParamDefaultState = 0;
531	–	ParamQuoteState = 1;
532	–	{$endif}
516
517	<	procedure AddToProcessedSQL(cChar: AnsiChar);
535	<	begin
536	<	StrBuffer[iSQLPos] := byte(cChar);
537	<	Inc(iSQLPos);
538	<	end;
517	>	var slNames: TStrings;
518
519	<	begin
520	<	if not IsInputDataArea then
521	<	IBError(ibxeNotPermitted,[nil]);
522	<
523	<	sParamName := '';
545	<	iLenSQL := Length(sSQL);
546	<	GetMem(StrBuffer,iLenSQL + 1);
547	<	slNames := TStringList.Create;
548	<	try
549	<	{ Do some initializations of variables }
550	<	iParamSuffix := 0;
551	<	cQuoteChar := '''';
552	<	i := 1;
553	<	iSQLPos := 0;
554	<	iCurState := DefaultState;
555	<	{$ifdef ALLOWDIALECT3PARAMNAMES}
556	<	iCurParamState := ParamDefaultState;
557	<	{$endif}
558	<	{ Now, traverse through the SQL string, character by character,
559	<	picking out the parameters and formatting correctly for InterBase }
560	<	while (i <= iLenSQL) do begin
561	<	{ Get the current token and a look-ahead }
562	<	cCurChar := sSQL[i];
563	<	if i = iLenSQL then
564	<	cNextChar := #0
565	<	else
566	<	cNextChar := sSQL[i + 1];
567	<	{ Now act based on the current state }
568	<	case iCurState of
569	<	DefaultState:
570	<	begin
571	<	case cCurChar of
572	<	'''', '"':
573	<	begin
574	<	cQuoteChar := cCurChar;
575	<	iCurState := QuoteState;
576	<	end;
577	<	'?', ':':
578	<	begin
579	<	iCurState := ParamState;
580	<	AddToProcessedSQL('?');
581	<	end;
582	<	'/': if (cNextChar = '*') then
583	<	begin
584	<	AddToProcessedSQL(cCurChar);
585	<	Inc(i);
586	<	iCurState := CommentState;
587	<	end;
588	<	'[':
589	<	begin
590	<	AddToProcessedSQL(cCurChar);
591	<	Inc(i);
592	<	iCurState := ArrayDimState;
593	<	end;
594	<	end;
595	<	end;
596	<
597	<	ArrayDimState:
598	<	begin
599	<	case cCurChar of
600	<	':',',','0'..'9',' ',#9,#10,#13:
601	<	begin
602	<	AddToProcessedSQL(cCurChar);
603	<	Inc(i);
604	<	end;
605	<	else
606	<	begin
607	<	AddToProcessedSQL(cCurChar);
608	<	Inc(i);
609	<	iCurState := DefaultState;
610	<	end;
611	<	end;
612	<	end;
613	<
614	<	CommentState:
615	<	begin
616	<	if (cNextChar = #0) then
617	<	IBError(ibxeSQLParseError, [SEOFInComment])
618	<	else if (cCurChar = '*') then begin
619	<	if (cNextChar = '/') then
620	<	iCurState := DefaultState;
621	<	end;
622	<	end;
623	<	QuoteState: begin
624	<	if cNextChar = #0 then
625	<	IBError(ibxeSQLParseError, [SEOFInString])
626	<	else if (cCurChar = cQuoteChar) then begin
627	<	if (cNextChar = cQuoteChar) then begin
628	<	AddToProcessedSQL(cCurChar);
629	<	Inc(i);
630	<	end else
631	<	iCurState := DefaultState;
632	<	end;
633	<	end;
634	<	ParamState:
635	<	begin
636	<	{ collect the name of the parameter }
637	<	{$ifdef ALLOWDIALECT3PARAMNAMES}
638	<	if iCurParamState = ParamDefaultState then
639	<	begin
640	<	if cCurChar = '"' then
641	<	iCurParamState := ParamQuoteState
642	<	else
643	<	{$endif}
644	<	if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
645	<	sParamName := sParamName + cCurChar
646	<	else if GenerateParamNames then
647	<	begin
648	<	sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
649	<	Inc(iParamSuffix);
650	<	iCurState := DefaultState;
651	<	slNames.AddObject(sParamName,self); //Note local convention
652	<	//add pointer to self to mark entry
653	<	sParamName := '';
654	<	end
655	<	else
656	<	IBError(ibxeSQLParseError, [SParamNameExpected]);
657	<	{$ifdef ALLOWDIALECT3PARAMNAMES}
658	<	end
659	<	else begin
660	<	{ determine if Quoted parameter name is finished }
661	<	if cCurChar = '"' then
662	<	begin
663	<	Inc(i);
664	<	slNames.Add(sParamName);
665	<	SParamName := '';
666	<	iCurParamState := ParamDefaultState;
667	<	iCurState := DefaultState;
668	<	end
669	<	else
670	<	sParamName := sParamName + cCurChar
671	<	end;
672	<	{$endif}
673	<	{ determine if the unquoted parameter name is finished }
674	<	if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
675	<	(iCurState <> DefaultState) then
676	<	begin
677	<	if not (cNextChar in ['A'..'Z', 'a'..'z',
678	<	'0'..'9', '_', '$']) then begin
679	<	Inc(i);
680	<	iCurState := DefaultState;
681	<	slNames.Add(sParamName);
682	<	sParamName := '';
683	<	end;
684	<	end;
685	<	end;
686	<	end;
687	<	if (iCurState <> ParamState) and (i <= iLenSQL) then
688	<	AddToProcessedSQL(sSQL[i]);
689	<	Inc(i);
690	<	end;
691	<	AddToProcessedSQL(#0);
692	<	sProcessedSQL := strpas(PAnsiChar(StrBuffer));
519	>	procedure SetColumnNames(slNames: TStrings);
520	>	var i, j: integer;
521	>	found: boolean;
522	>	begin
523	>	found := false;
524		SetCount(slNames.Count);
525		for i := 0 to slNames.Count - 1 do
526		begin
#	Line 710 \| Line 541 \| begin
541		Column[i].UniqueName := not found;
542		end;
543		end;
544	+	end;
545	+
546	+	begin
547	+	if not IsInputDataArea then
548	+	IBError(ibxeNotPermitted,[nil]);
549	+
550	+	slNames := TStringList.Create;
551	+	try
552	+	sProcessedSQL := TSQLParamProcessor.Execute(sSQL,GenerateParamNames,slNames);
553	+	SetColumnNames(slNames);
554		finally
555		slNames.Free;
715	–	FreeMem(StrBuffer);
556		end;
557		end;
558
#	Line 726 \| Line 566 \| var
566		s: AnsiString;
567		i: Integer;
568		begin
569	<	{$ifdef UseCaseInSensitiveParamName}
570	<	s := AnsiUpperCase(Idx);
571	<	{$else}
569	>	if not IsInputDataArea or not CaseSensitiveParams then
570	>	s := AnsiUpperCase(Idx)
571	>	else
572		s := Idx;
573	<	{$endif}
573	>
574		for i := 0 to Count - 1 do
575		if Column[i].Name = s then
576		begin
#	Line 762 \| Line 602 \| end;
602
603		procedure TSQLVarData.SetName(AValue: AnsiString);
604		begin
605	<	if FName = AValue then Exit;
766	<	{$ifdef UseCaseInSensitiveParamName}
767	<	if Parent.IsInputDataArea then
605	>	if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
606		FName := AnsiUpperCase(AValue)
607		else
770	–	{$endif}
608		FName := AValue;
609		end;
610
#	Line 788 \| Line 625 \| begin
625
626		FVarString := aValue;
627		SQLType := SQL_TEXT;
628	+	Scale := 0;
629		SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
630		end;
631
#	Line 948 \| Line 786 \| begin
786		result := Value;
787		end;
788
789	+	function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
790	+	begin
791	+	{$IF declared(DefaultFormatSettings)}
792	+	with DefaultFormatSettings do
793	+	{$ELSE}
794	+	{$IF declared(FormatSettings)}
795	+	with FormatSettings do
796	+	{$IFEND}
797	+	{$IFEND}
798	+	case GetSQLDialect of
799	+	1:
800	+	if IncludeTime then
801	+	result := ShortDateFormat + ' ' + LongTimeFormat
802	+	else
803	+	result := ShortDateFormat;
804	+	3:
805	+	result := ShortDateFormat;
806	+	end;
807	+	end;
808	+
809	+	function TSQLDataItem.GetTimeFormatStr: AnsiString;
810	+	begin
811	+	{$IF declared(DefaultFormatSettings)}
812	+	with DefaultFormatSettings do
813	+	{$ELSE}
814	+	{$IF declared(FormatSettings)}
815	+	with FormatSettings do
816	+	{$IFEND}
817	+	{$IFEND}
818	+	Result := LongTimeFormat;
819	+	end;
820	+
821	+	function TSQLDataItem.GetTimestampFormatStr: AnsiString;
822	+	begin
823	+	{$IF declared(DefaultFormatSettings)}
824	+	with DefaultFormatSettings do
825	+	{$ELSE}
826	+	{$IF declared(FormatSettings)}
827	+	with FormatSettings do
828	+	{$IFEND}
829	+	{$IFEND}
830	+	Result := ShortDateFormat + ' ' + LongTimeFormat + '.zzz';
831	+	end;
832	+
833		procedure TSQLDataItem.SetAsInteger(AValue: Integer);
834		begin
835		SetAsLong(aValue);
#	Line 1046 \| Line 928 \| begin
928		//Do nothing by default
929		end;
930
931	+	constructor TSQLDataItem.Create(api: TFBClientAPI);
932	+	begin
933	+	inherited Create;
934	+	FFirebirdClientAPI := api;
935	+	end;
936	+
937		function TSQLDataItem.GetSQLTypeName: AnsiString;
938		begin
939		Result := GetSQLTypeName(GetSQLType);
#	Line 1072 \| 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 1152 \| Line 1049 \| begin
1049		CheckActive;
1050		result := 0;
1051		if not IsNull then
1052	<	with FirebirdClientAPI do
1052	>	with FFirebirdClientAPI do
1053		case SQLType of
1054		SQL_TEXT, SQL_VARYING: begin
1055		try
#	Line 1281 \| 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 1292 \| Line 1255 \| begin
1255		result := '';
1256		{ Check null, if so return a default string }
1257		if not IsNull then
1258	<	with FirebirdClientAPI do
1258	>	with FFirebirdClientAPI do
1259		case SQLType of
1260		SQL_BOOLEAN:
1261		if AsBoolean then
#	Line 1304 \| 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
1315	<	Result := TrimRight(rs)
1316	<	else
1317	<	Result := rs
1282	>	Result := rs;
1283		end;
1284		SQL_TYPE_DATE:
1285	<	case GetSQLDialect of
1321	<	1 : result := DateTimeToStr(AsDateTime);
1322	<	3 : result := DateToStr(AsDateTime);
1323	<	end;
1285	>	result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1286		SQL_TYPE_TIME :
1287	<	result := TimeToStr(AsDateTime);
1287	>	result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1288		SQL_TIMESTAMP:
1289	<	{$IF declared(DefaultFormatSettings)}
1328	<	with DefaultFormatSettings do
1329	<	{$ELSE}
1330	<	{$IF declared(FormatSettings)}
1331	<	with FormatSettings do
1332	<	{$IFEND}
1333	<	{$IFEND}
1334	<	result := FormatDateTime(ShortDateFormat + ' ' +
1335	<	LongTimeFormat+'.zzz',AsDateTime);
1289	>	result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1290		SQL_SHORT, SQL_LONG:
1291		if Scale = 0 then
1292		result := IntToStr(AsLong)
#	Line 1360 \| Line 1314 \| begin
1314		Result := false;
1315		end;
1316
1317	<	function TSQLDataItem.getIsNullable: boolean;
1317	>	function TSQLDataItem.GetIsNullable: boolean;
1318		begin
1319		CheckActive;
1320		Result := false;
#	Line 1408 \| Line 1362 \| begin
1362		Result := false;
1363		end;
1364
1365	+	function TSQLDataItem.GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats
1366	+	): integer;
1367	+	begin
1368	+	case DateTimeFormat of
1369	+	dfTimestamp:
1370	+	Result := Length(GetTimestampFormatStr);
1371	+	dfDateTime:
1372	+	Result := Length(GetDateFormatStr(true));
1373	+	dfTime:
1374	+	Result := Length(GetTimeFormatStr);
1375	+	else
1376	+	Result := 0;
1377	+	end;
1378	+	end;
1379	+
1380
1381		procedure TSQLDataItem.SetIsNull(Value: Boolean);
1382		begin
#	Line 1471 \| Line 1440 \| begin
1440
1441		SQLType := SQL_TYPE_DATE;
1442		DataLength := SizeOf(ISC_DATE);
1443	<	with FirebirdClientAPI do
1443	>	with FFirebirdClientAPI do
1444		SQLEncodeDate(Value,SQLData);
1445		Changed;
1446		end;
#	Line 1491 \| Line 1460 \| begin
1460
1461		SQLType := SQL_TYPE_TIME;
1462		DataLength := SizeOf(ISC_TIME);
1463	<	with FirebirdClientAPI do
1463	>	with FFirebirdClientAPI do
1464		SQLEncodeTime(Value,SQLData);
1465		Changed;
1466		end;
#	Line 1505 \| Line 1474 \| begin
1474		Changing;
1475		SQLType := SQL_TIMESTAMP;
1476		DataLength := SizeOf(ISC_TIME) + sizeof(ISC_DATE);
1477	<	with FirebirdClientAPI do
1477	>	with FFirebirdClientAPI do
1478		SQLEncodeDateTime(Value,SQLData);
1479		Changed;
1480		end;
#	Line 1691 \| Line 1660 \| end;
1660
1661		constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
1662		begin
1663	<	inherited Create;
1663	>	inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
1664		FIBXSQLVAR := aIBXSQLVAR;
1665		FOwner := aOwner;
1666		FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
#	Line 1781 \| 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 1793 \| 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 1812 \| 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 1855 \| Line 1848 \| end;
1848		{ TSQLParam }
1849
1850		procedure TSQLParam.InternalSetAsString(Value: AnsiString);
1851	+
1852	+	procedure DoSetString;
1853	+	begin
1854	+	Changing;
1855	+	FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1856	+	Changed;
1857	+	end;
1858	+
1859		var b: IBlob;
1860		dt: TDateTime;
1861	+	CurrValue: Currency;
1862	+	FloatValue: single;
1863		begin
1864		CheckActive;
1865		if IsNullable then
#	Line 1882 \| Line 1885 \| begin
1885
1886		SQL_VARYING,
1887		SQL_TEXT:
1888	<	begin
1886	<	Changing;
1887	<	FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1888	<	Changed;
1889	<	end;
1888	>	DoSetString;
1889
1890		SQL_SHORT,
1891		SQL_LONG,
1892		SQL_INT64:
1893	<	SetAsNumeric(AdjustScaleFromCurrency(StrToCurr(Value),GetScale),GetScale);
1893	>	if TryStrToCurr(Value,CurrValue) then
1894	>	SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
1895	>	else
1896	>	DoSetString;
1897
1898		SQL_D_FLOAT,
1899		SQL_DOUBLE,
1900		SQL_FLOAT:
1901	<	SetAsDouble(StrToFloat(Value));
1901	>	if TryStrToFloat(Value,FloatValue) then
1902	>	SetAsDouble(FloatValue)
1903	>	else
1904	>	DoSetString;
1905
1906		SQL_TIMESTAMP:
1907		if TryStrToDateTime(Value,dt) then
1908		SetAsDateTime(dt)
1909		else
1910	<	FIBXSQLVar.SetString(Value);
1910	>	DoSetString;
1911
1912		SQL_TYPE_DATE:
1913		if TryStrToDateTime(Value,dt) then
1914		SetAsDate(dt)
1915		else
1916	<	FIBXSQLVar.SetString(Value);
1916	>	DoSetString;
1917
1918		SQL_TYPE_TIME:
1919		if TryStrToDateTime(Value,dt) then
1920		SetAsTime(dt)
1921		else
1922	<	FIBXSQLVar.SetString(Value);
1922	>	DoSetString;
1923
1924		else
1925		IBError(ibxeInvalidDataConversion,[nil]);
#	Line 2500 \| 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 2518 \| 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 2581 \| 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

Comparing ibx/trunk/fbintf/client/FBSQLData.pas (file contents): Revision 59 by tony, Mon Mar 13 09:51:56 2017 UTC vs. Revision 309 by tony, Tue Jul 21 08:00:42 2020 UTC

Diff Legend

Comparing ibx/trunk/fbintf/client/FBSQLData.pas (file contents):
Revision 59 by tony, Mon Mar 13 09:51:56 2017 UTC vs.
Revision 309 by tony, Tue Jul 21 08:00:42 2020 UTC