ViewVC Help

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

root/public/ibx/branches/udr/client/FBSQLData.pas

Comparing ibx/trunk/fbintf/client/FBSQLData.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 287 by tony, Thu Apr 11 08:51:23 2019 UTC

#	Line 60 | Line 60
60		{                                                                        }
61		{************************************************************************}
62		unit FBSQLData;
63	+	{$IFDEF MSWINDOWS}
64	+	{$DEFINE WINDOWS}
65	+	{$ENDIF}
66
67		{$IFDEF FPC}
68	<	{$mode objfpc}{$H+}
68	>	{$mode delphi}
69		{$codepage UTF8}
70		{$interfaces COM}
71		{$ENDIF}
#	Line 73 | 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
76	–	{ $define ALLOWDIALECT3PARAMNAMES}
77	–
78	–	{$ifndef ALLOWDIALECT3PARAMNAMES}
79	–
80	–	{ Note on SQL Dialects and SQL Parameter Names
81	–	--------------------------------------------
82	–
83	–	Even when dialect 3 quoted format parameter names are not supported, IBX still processes
84	–	parameter names case insensitive. This does result in some additional overhead
85	–	due to a call to "AnsiUpperCase". This can be avoided by undefining
86	–	"UseCaseInSensitiveParamName" below.
87	–
88	–	Note: do not define "UseCaseSensitiveParamName" when "ALLOWDIALECT3PARAMNAMES"
89	–	is defined. This will not give a useful result.
90	–	}
91	–	{$define UseCaseInSensitiveParamName}
92	–	{$endif}
79
80		interface
81
82		uses
83	<	Classes, SysUtils, IBExternals, IBHeader, IB,  FBActivityMonitor;
83	>	Classes, SysUtils, IBExternals, IBHeader, IB,  FBActivityMonitor, FBClientAPI;
84
85		type
86
#	Line 102 | 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 113 | Line 103 | type
103		function GetSQLDialect: integer; virtual; abstract;
104		procedure Changed; virtual;
105		procedure Changing; virtual;
106	<	procedure InternalSetAsString(Value: String); virtual;
107	<	function SQLData: PChar; virtual; abstract;
106	>	procedure InternalSetAsString(Value: AnsiString); virtual;
107	>	function SQLData: PByte; virtual; abstract;
108		function GetDataLength: cardinal; virtual; abstract;
109		function GetCodePage: TSystemCodePage; virtual; abstract;
110	<	function Transliterate(s: string; CodePage: TSystemCodePage): RawByteString;
110	>	function getCharSetID: cardinal; virtual; abstract;
111	>	function Transliterate(s: AnsiString; CodePage: TSystemCodePage): RawByteString;
112		procedure SetScale(aValue: integer); virtual;
113		procedure SetDataLength(len: cardinal); virtual;
114		procedure SetSQLType(aValue: cardinal); virtual;
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: string; overload;
121	<	class function GetSQLTypeName(SQLType: short): string; overload;
122	<	function GetName: string; virtual; abstract;
120	>	function GetSQLTypeName: AnsiString; overload;
121	>	class function GetSQLTypeName(SQLType: short): AnsiString; overload;
122	>	function GetName: AnsiString; virtual; abstract;
123		function GetScale: integer; virtual; abstract;
124		function GetAsBoolean: boolean;
125		function GetAsCurrency: Currency;
#	Line 139 | Line 131 | type
131		function GetAsPointer: Pointer;
132		function GetAsQuad: TISC_QUAD;
133		function GetAsShort: short;
134	<	function GetAsString: String; virtual;
134	>	function GetAsString: AnsiString; virtual;
135		function GetIsNull: Boolean; virtual;
136	<	function getIsNullable: boolean; virtual;
136	>	function GetIsNullable: boolean; virtual;
137		function GetAsVariant: Variant;
138		function GetModified: boolean; virtual;
139	+	function GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats): integer;
140		procedure SetAsBoolean(AValue: boolean); virtual;
141		procedure SetAsCurrency(Value: Currency); virtual;
142		procedure SetAsInt64(Value: Int64); virtual;
#	Line 156 | Line 149 | type
149		procedure SetAsPointer(Value: Pointer);
150		procedure SetAsQuad(Value: TISC_QUAD);
151		procedure SetAsShort(Value: short); virtual;
152	<	procedure SetAsString(Value: String); virtual;
152	>	procedure SetAsString(Value: AnsiString); virtual;
153		procedure SetAsVariant(Value: Variant);
154	+	procedure SetAsNumeric(Value: Int64; aScale: integer);
155		procedure SetIsNull(Value: Boolean); virtual;
156		procedure SetIsNullable(Value: Boolean); virtual;
157	<	procedure SetName(aValue: string); virtual;
157	>	procedure SetName(aValue: AnsiString); virtual;
158		property AsDate: TDateTime read GetAsDateTime write SetAsDate;
159		property AsBoolean:boolean read GetAsBoolean write SetAsBoolean;
160		property AsTime: TDateTime read GetAsDateTime write SetAsTime;
#	Line 174 | Line 168 | type
168		property AsPointer: Pointer read GetAsPointer write SetAsPointer;
169		property AsQuad: TISC_QUAD read GetAsQuad write SetAsQuad;
170		property AsShort: short read GetAsShort write SetAsShort;
171	<	property AsString: String read GetAsString write SetAsString;
171	>	property AsString: AnsiString read GetAsString write SetAsString;
172		property AsVariant: Variant read GetAsVariant write SetAsVariant;
173		property Modified: Boolean read getModified;
174		property IsNull: Boolean read GetIsNull write SetIsNull;
#	Line 191 | Line 185 | type
185
186		TSQLDataArea = class
187		private
188	+	FCaseSensitiveParams: boolean;
189		function GetColumn(index: integer): TSQLVarData;
190		function GetCount: integer;
191		protected
192	<	FUniqueRelationName: string;
192	>	FUniqueRelationName: AnsiString;
193		FColumnList: array of TSQLVarData;
194		function GetStatement: IStatement; virtual; abstract;
195		function GetPrepareSeqNo: integer; virtual; abstract;
#	Line 204 | Line 199 | type
199		public
200		procedure Initialize; virtual;
201		function IsInputDataArea: boolean; virtual; abstract; {Input to Database}
202	<	procedure PreprocessSQL(sSQL: string; GenerateParamNames: boolean;
203	<	var sProcessedSQL: string);
202	>	procedure PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
203	>	var sProcessedSQL: AnsiString);
204		function ColumnsInUseCount: integer; virtual;
205	<	function ColumnByName(Idx: string): TSQLVarData;
205	>	function ColumnByName(Idx: AnsiString): TSQLVarData;
206		function CheckStatementStatus(Request: TStatementStatus): boolean; virtual; abstract;
207		procedure GetData(index: integer; var IsNull: boolean; var len: short;
208	<	var data: PChar); virtual;
208	>	var data: PByte); virtual;
209		procedure RowChange;
210		function StateChanged(var ChangeSeqNo: integer): boolean; virtual; abstract;
211	+	property CaseSensitiveParams: boolean read FCaseSensitiveParams
212	+	write FCaseSensitiveParams; {Only used when IsInputDataArea true}
213		property Count: integer read GetCount;
214		property Column[index: integer]: TSQLVarData read GetColumn;
215	<	property UniqueRelationName: string read FUniqueRelationName;
215	>	property UniqueRelationName: AnsiString read FUniqueRelationName;
216		property Statement: IStatement read GetStatement;
217		property PrepareSeqNo: integer read GetPrepareSeqNo;
218		property TransactionSeqNo: integer read GetTransactionSeqNo;
#	Line 226 | Line 223 | type
223		TSQLVarData = class
224		private
225		FParent: TSQLDataArea;
226	<	FName: string;
226	>	FName: AnsiString;
227		FIndex: integer;
228		FModified: boolean;
229		FUniqueName: boolean;
230		FVarString: RawByteString;
231		function GetStatement: IStatement;
232	<	procedure SetName(AValue: string);
232	>	procedure SetName(AValue: AnsiString);
233		protected
234		function GetSQLType: cardinal; virtual; abstract;
235		function GetSubtype: integer; virtual; abstract;
236	<	function GetAliasName: string;  virtual; abstract;
237	<	function GetFieldName: string; virtual; abstract;
238	<	function GetOwnerName: string;  virtual; abstract;
239	<	function GetRelationName: string;  virtual; abstract;
236	>	function GetAliasName: AnsiString;  virtual; abstract;
237	>	function GetFieldName: AnsiString; virtual; abstract;
238	>	function GetOwnerName: AnsiString;  virtual; abstract;
239	>	function GetRelationName: AnsiString;  virtual; abstract;
240		function GetScale: integer; virtual; abstract;
241		function GetCharSetID: cardinal; virtual; abstract;
242		function GetCodePage: TSystemCodePage; virtual; abstract;
243		function GetIsNull: Boolean;   virtual; abstract;
244		function GetIsNullable: boolean; virtual; abstract;
245	<	function GetSQLData: PChar;  virtual; abstract;
245	>	function GetSQLData: PByte;  virtual; abstract;
246		function GetDataLength: cardinal; virtual; abstract;
247		procedure SetIsNull(Value: Boolean); virtual; abstract;
248		procedure SetIsNullable(Value: Boolean);  virtual; abstract;
249	<	procedure SetSQLData(AValue: PChar; len: cardinal); virtual; abstract;
249	>	procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
250		procedure SetScale(aValue: integer); virtual; abstract;
251		procedure SetDataLength(len: cardinal); virtual; abstract;
252		procedure SetSQLType(aValue: cardinal); virtual; abstract;
253		procedure SetCharSetID(aValue: cardinal); virtual; abstract;
254		public
255		constructor Create(aParent: TSQLDataArea; aIndex: integer);
256	<	procedure SetString(aValue: string);
256	>	procedure SetString(aValue: AnsiString);
257		procedure Changed; virtual;
258		procedure RowChange; virtual;
259		function GetAsArray(Array_ID: TISC_QUAD): IArray; virtual; abstract;
#	Line 267 | Line 264 | type
264		procedure Initialize; virtual;
265
266		public
267	<	property AliasName: string read GetAliasName;
268	<	property FieldName: string read GetFieldName;
269	<	property OwnerName: string read GetOwnerName;
270	<	property RelationName: string read GetRelationName;
267	>	property AliasName: AnsiString read GetAliasName;
268	>	property FieldName: AnsiString read GetFieldName;
269	>	property OwnerName: AnsiString read GetOwnerName;
270	>	property RelationName: AnsiString read GetRelationName;
271		property Parent: TSQLDataArea read FParent;
272		property Index: integer read FIndex;
273	<	property Name: string read FName write SetName;
273	>	property Name: AnsiString read FName write SetName;
274		property CharSetID: cardinal read GetCharSetID write SetCharSetID;
275		property SQLType: cardinal read GetSQLType write SetSQLType;
276		property SQLSubtype: integer read GetSubtype;
277	<	property SQLData: PChar read GetSQLData;
277	>	property SQLData: PByte read GetSQLData;
278		property DataLength: cardinal read GetDataLength write SetDataLength;
279		property IsNull: Boolean read GetIsNull write SetIsNull;
280		property IsNullable: Boolean read GetIsNullable write SetIsNullable;
#	Line 299 | Line 296 | type
296		FChangeSeqNo: integer;
297		protected
298		procedure CheckActive; override;
299	<	function SQLData: PChar; override;
299	>	function SQLData: PByte; override;
300		function GetDataLength: cardinal; override;
301		function GetCodePage: TSystemCodePage; override;
302
#	Line 314 | Line 311 | type
311		function GetIndex: integer;
312		function GetSQLType: cardinal; override;
313		function getSubtype: integer;
314	<	function getRelationName: string;
315	<	function getOwnerName: string;
316	<	function getSQLName: string;    {Name of the column}
317	<	function getAliasName: string;  {Alias Name of column or Column Name if not alias}
318	<	function GetName: string; override;      {Disambiguated uppercase Field Name}
314	>	function getRelationName: AnsiString;
315	>	function getOwnerName: AnsiString;
316	>	function getSQLName: AnsiString;    {Name of the column}
317	>	function getAliasName: AnsiString;  {Alias Name of column or Column Name if not alias}
318	>	function GetName: AnsiString; override;      {Disambiguated uppercase Field Name}
319		function GetScale: integer; override;
320	<	function getCharSetID: cardinal;
320	>	function getCharSetID: cardinal; override;
321		function GetIsNullable: boolean; override;
322		function GetSize: cardinal;
323		function GetArrayMetaData: IArrayMetaData;
324		function GetBlobMetaData: IBlobMetaData;
325	<	property Name: string read GetName;
325	>	property Name: AnsiString read GetName;
326		property Size: cardinal read GetSize;
327		property CharSetID: cardinal read getCharSetID;
328		property SQLSubtype: integer read getSubtype;
#	Line 342 | Line 339 | type
339		function GetAsArray: IArray;
340		function GetAsBlob: IBlob; overload;
341		function GetAsBlob(BPB: IBPB): IBlob; overload;
342	<	function GetAsString: String; override;
342	>	function GetAsString: AnsiString; override;
343		property AsBlob: IBlob read GetAsBlob;
344		end;
345
#	Line 352 | Line 349 | type
349		protected
350		procedure CheckActive; override;
351		procedure Changed; override;
352	<	procedure InternalSetAsString(Value: String); override;
352	>	procedure InternalSetAsString(Value: AnsiString); override;
353		procedure SetScale(aValue: integer); override;
354		procedure SetDataLength(len: cardinal); override;
355		procedure SetSQLType(aValue: cardinal); override;
#	Line 360 | Line 357 | type
357		procedure Clear;
358		function GetModified: boolean; override;
359		function GetAsPointer: Pointer;
360	<	procedure SetName(Value: string); override;
360	>	procedure SetName(Value: AnsiString); override;
361		procedure SetIsNull(Value: Boolean);  override;
362		procedure SetIsNullable(Value: Boolean); override;
363		procedure SetAsArray(anArray: IArray);
#	Line 377 | Line 374 | type
374		procedure SetAsFloat(AValue: Float);
375		procedure SetAsPointer(AValue: Pointer);
376		procedure SetAsShort(AValue: Short);
377	<	procedure SetAsString(AValue: String); override;
377	>	procedure SetAsString(AValue: AnsiString); override;
378		procedure SetAsVariant(AValue: Variant);
379		procedure SetAsBlob(aValue: IBlob);
380		procedure SetAsQuad(AValue: TISC_QUAD);
#	Line 400 | Line 397 | type
397		destructor Destroy; override;
398		public
399		{IMetaData}
400	<	function GetUniqueRelationName: string;
400	>	function GetUniqueRelationName: AnsiString;
401		function getCount: integer;
402		function getColumnMetaData(index: integer): IColumnMetaData;
403	<	function ByName(Idx: String): IColumnMetaData;
403	>	function ByName(Idx: AnsiString): IColumnMetaData;
404		end;
405
406		{ TSQLParams }
#	Line 422 | Line 419 | type
419		{ISQLParams}
420		function getCount: integer;
421		function getSQLParam(index: integer): ISQLParam;
422	<	function ByName(Idx: String): ISQLParam ;
422	>	function ByName(Idx: AnsiString): ISQLParam ;
423		function GetModified: Boolean;
424	+	function GetHasCaseSensitiveParams: Boolean;
425		end;
426
427		{ TResults }
#	Line 442 | Line 440 | type
440		constructor Create(aResults: TSQLDataArea);
441		{IResults}
442		function getCount: integer;
443	<	function ByName(Idx: String): ISQLData;
443	>	function ByName(Idx: AnsiString): ISQLData;
444		function getSQLData(index: integer): ISQLData;
445	<	procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PChar);
445	>	procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
446		function GetTransaction: ITransaction; virtual;
447		procedure SetRetainInterfaces(aValue: boolean);
448		end;
449
450		implementation
451
452	<	uses FBMessages, FBClientAPI, variants, IBUtils, FBTransaction;
452	>	uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
453
454		{ TSQLDataArea }
455
#	Line 471 | Line 469 | procedure TSQLDataArea.SetUniqueRelation
469		var
470		i: Integer;
471		bUnique: Boolean;
472	<	RelationName: string;
472	>	RelationName: AnsiString;
473		begin
474		bUnique := True;
475		for i := 0 to ColumnsInUseCount - 1 do
#	Line 502 | Line 500 | begin
500		Column[i].Initialize;
501		end;
502
503	<	procedure TSQLDataArea.PreprocessSQL(sSQL: string; GenerateParamNames: boolean;
504	<	var sProcessedSQL: string);
507	<	var
508	<	cCurChar, cNextChar, cQuoteChar: Char;
509	<	sParamName: String;
510	<	j, i, iLenSQL, iSQLPos: Integer;
511	<	iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
512	<	iParamSuffix: Integer;
513	<	slNames: TStrings;
514	<	StrBuffer: PChar;
515	<	found: boolean;
516	<
517	<	const
518	<	DefaultState = 0;
519	<	CommentState = 1;
520	<	QuoteState = 2;
521	<	ParamState = 3;
522	<	{$ifdef ALLOWDIALECT3PARAMNAMES}
523	<	ParamDefaultState = 0;
524	<	ParamQuoteState = 1;
525	<	{$endif}
526	<
527	<	procedure AddToProcessedSQL(cChar: Char);
528	<	begin
529	<	StrBuffer[iSQLPos] := cChar;
530	<	Inc(iSQLPos);
531	<	end;
503	>	procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
504	>	var sProcessedSQL: AnsiString);
505
506	<	begin
534	<	if not IsInputDataArea then
535	<	IBError(ibxeNotPermitted,[nil]);
506	>	var slNames: TStrings;
507
508	<	sParamName := '';
509	<	iLenSQL := Length(sSQL);
510	<	GetMem(StrBuffer,iLenSQL + 1);
511	<	slNames := TStringList.Create;
512	<	try
542	<	{ Do some initializations of variables }
543	<	iParamSuffix := 0;
544	<	cQuoteChar := '''';
545	<	i := 1;
546	<	iSQLPos := 0;
547	<	iCurState := DefaultState;
548	<	{$ifdef ALLOWDIALECT3PARAMNAMES}
549	<	iCurParamState := ParamDefaultState;
550	<	{$endif}
551	<	{ Now, traverse through the SQL string, character by character,
552	<	picking out the parameters and formatting correctly for InterBase }
553	<	while (i <= iLenSQL) do begin
554	<	{ Get the current token and a look-ahead }
555	<	cCurChar := sSQL[i];
556	<	if i = iLenSQL then
557	<	cNextChar := #0
558	<	else
559	<	cNextChar := sSQL[i + 1];
560	<	{ Now act based on the current state }
561	<	case iCurState of
562	<	DefaultState: begin
563	<	case cCurChar of
564	<	'''', '"': begin
565	<	cQuoteChar := cCurChar;
566	<	iCurState := QuoteState;
567	<	end;
568	<	'?', ':': begin
569	<	iCurState := ParamState;
570	<	AddToProcessedSQL('?');
571	<	end;
572	<	'/': if (cNextChar = '*') then begin
573	<	AddToProcessedSQL(cCurChar);
574	<	Inc(i);
575	<	iCurState := CommentState;
576	<	end;
577	<	end;
578	<	end;
579	<	CommentState: begin
580	<	if (cNextChar = #0) then
581	<	IBError(ibxeSQLParseError, [SEOFInComment])
582	<	else if (cCurChar = '*') then begin
583	<	if (cNextChar = '/') then
584	<	iCurState := DefaultState;
585	<	end;
586	<	end;
587	<	QuoteState: begin
588	<	if cNextChar = #0 then
589	<	IBError(ibxeSQLParseError, [SEOFInString])
590	<	else if (cCurChar = cQuoteChar) then begin
591	<	if (cNextChar = cQuoteChar) then begin
592	<	AddToProcessedSQL(cCurChar);
593	<	Inc(i);
594	<	end else
595	<	iCurState := DefaultState;
596	<	end;
597	<	end;
598	<	ParamState:
599	<	begin
600	<	{ collect the name of the parameter }
601	<	{$ifdef ALLOWDIALECT3PARAMNAMES}
602	<	if iCurParamState = ParamDefaultState then
603	<	begin
604	<	if cCurChar = '"' then
605	<	iCurParamState := ParamQuoteState
606	<	else
607	<	{$endif}
608	<	if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
609	<	sParamName := sParamName + cCurChar
610	<	else if GenerateParamNames then
611	<	begin
612	<	sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
613	<	Inc(iParamSuffix);
614	<	iCurState := DefaultState;
615	<	slNames.AddObject(sParamName,self); //Note local convention
616	<	//add pointer to self to mark entry
617	<	sParamName := '';
618	<	end
619	<	else
620	<	IBError(ibxeSQLParseError, [SParamNameExpected]);
621	<	{$ifdef ALLOWDIALECT3PARAMNAMES}
622	<	end
623	<	else begin
624	<	{ determine if Quoted parameter name is finished }
625	<	if cCurChar = '"' then
626	<	begin
627	<	Inc(i);
628	<	slNames.Add(sParamName);
629	<	SParamName := '';
630	<	iCurParamState := ParamDefaultState;
631	<	iCurState := DefaultState;
632	<	end
633	<	else
634	<	sParamName := sParamName + cCurChar
635	<	end;
636	<	{$endif}
637	<	{ determine if the unquoted parameter name is finished }
638	<	if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
639	<	(iCurState <> DefaultState) then
640	<	begin
641	<	if not (cNextChar in ['A'..'Z', 'a'..'z',
642	<	'0'..'9', '_', '$']) then begin
643	<	Inc(i);
644	<	iCurState := DefaultState;
645	<	slNames.Add(sParamName);
646	<	sParamName := '';
647	<	end;
648	<	end;
649	<	end;
650	<	end;
651	<	if (iCurState <> ParamState) and (i <= iLenSQL) then
652	<	AddToProcessedSQL(sSQL[i]);
653	<	Inc(i);
654	<	end;
655	<	AddToProcessedSQL(#0);
656	<	sProcessedSQL := strpas(StrBuffer);
508	>	procedure SetColumnNames(slNames: TStrings);
509	>	var i, j: integer;
510	>	found: boolean;
511	>	begin
512	>	found := false;
513		SetCount(slNames.Count);
514		for i := 0 to slNames.Count - 1 do
515		begin
#	Line 674 | Line 530 | begin
530		Column[i].UniqueName := not found;
531		end;
532		end;
533	+	end;
534	+
535	+	begin
536	+	if not IsInputDataArea then
537	+	IBError(ibxeNotPermitted,[nil]);
538	+
539	+	slNames := TStringList.Create;
540	+	try
541	+	sProcessedSQL := TSQLParamProcessor.Execute(sSQL,GenerateParamNames,slNames);
542	+	SetColumnNames(slNames);
543		finally
544		slNames.Free;
679	–	FreeMem(StrBuffer);
545		end;
546		end;
547
#	Line 685 | Line 550 | begin
550		Result := Count;
551		end;
552
553	<	function TSQLDataArea.ColumnByName(Idx: string): TSQLVarData;
553	>	function TSQLDataArea.ColumnByName(Idx: AnsiString): TSQLVarData;
554		var
555	<	s: String;
555	>	s: AnsiString;
556		i: Integer;
557		begin
558	<	{$ifdef UseCaseInSensitiveParamName}
559	<	s := AnsiUpperCase(Idx);
560	<	{$else}
558	>	if not IsInputDataArea or not CaseSensitiveParams then
559	>	s := AnsiUpperCase(Idx)
560	>	else
561		s := Idx;
562	<	{$endif}
562	>
563		for i := 0 to Count - 1 do
564		if Column[i].Name = s then
565		begin
#	Line 705 | Line 570 | begin
570		end;
571
572		procedure TSQLDataArea.GetData(index: integer; var IsNull: boolean;
573	<	var len: short; var data: PChar);
573	>	var len: short; var data: PByte);
574		begin
575		//Do Nothing
576		end;
#	Line 724 | Line 589 | begin
589		Result := FParent.Statement;
590		end;
591
592	<	procedure TSQLVarData.SetName(AValue: string);
592	>	procedure TSQLVarData.SetName(AValue: AnsiString);
593		begin
594	<	if FName = AValue then Exit;
730	<	{$ifdef UseCaseInSensitiveParamName}
731	<	if Parent.IsInputDataArea then
594	>	if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
595		FName := AnsiUpperCase(AValue)
596		else
734	–	{$endif}
597		FName := AValue;
598		end;
599
#	Line 743 | Line 605 | begin
605		FUniqueName := true;
606		end;
607
608	<	procedure TSQLVarData.SetString(aValue: string);
608	>	procedure TSQLVarData.SetString(aValue: AnsiString);
609		begin
610		{we take full advantage here of reference counted strings. When setting a string
611		value, a reference is kept in FVarString and a pointer to it placed in the
612	<	SQLVar. This avoids string copies. Note that PChar is guaranteed to point to
612	>	SQLVar. This avoids string copies. Note that PAnsiChar is guaranteed to point to
613		a zero byte when the string is empty, neatly avoiding a nil pointer error.}
614
615		FVarString := aValue;
616		SQLType := SQL_TEXT;
617	<	SetSQLData(PChar(FVarString),Length(aValue));
617	>	Scale := 0;
618	>	SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
619		end;
620
621		procedure TSQLVarData.Changed;
#	Line 768 | Line 631 | end;
631
632		procedure TSQLVarData.Initialize;
633
634	<	function FindVarByName(idx: string; limit: integer): TSQLVarData;
634	>	function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
635		var
636		k: integer;
637		begin
#	Line 783 | Line 646 | procedure TSQLVarData.Initialize;
646
647		var
648		j, j_len: Integer;
649	<	st: String;
650	<	sBaseName: string;
649	>	st: AnsiString;
650	>	sBaseName: AnsiString;
651		begin
652		RowChange;
653
#	Line 871 | Line 734 | function TSQLDataItem.AdjustScaleToCurre
734		var
735		Scaling : Int64;
736		i : Integer;
737	<	FractionText, PadText, CurrText: string;
737	>	FractionText, PadText, CurrText: AnsiString;
738		begin
739		Result := 0;
740		Scaling := 1;
#	Line 890 | Line 753 | begin
753		FractionText := IntToStr(abs(Value mod Scaling));
754		for i := Length(FractionText) to -aScale -1 do
755		PadText := '0' + PadText;
756	+	{$IF declared(DefaultFormatSettings)}
757	+	with DefaultFormatSettings do
758	+	{$ELSE}
759	+	{$IF declared(FormatSettings)}
760	+	with FormatSettings do
761	+	{$IFEND}
762	+	{$IFEND}
763		if Value < 0 then
764	<	CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DefaultFormatSettings.DecimalSeparator + PadText + FractionText
764	>	CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText
765		else
766	<	CurrText := IntToStr(Abs(Value div Scaling)) + DefaultFormatSettings.DecimalSeparator + PadText + FractionText;
766	>	CurrText := IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText;
767		try
768		result := StrToCurr(CurrText);
769		except
#	Line 905 | Line 775 | begin
775		result := Value;
776		end;
777
778	+	function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
779	+	begin
780	+	{$IF declared(DefaultFormatSettings)}
781	+	with DefaultFormatSettings do
782	+	{$ELSE}
783	+	{$IF declared(FormatSettings)}
784	+	with FormatSettings do
785	+	{$IFEND}
786	+	{$IFEND}
787	+	case GetSQLDialect of
788	+	1:
789	+	if IncludeTime then
790	+	result := ShortDateFormat + ' ' + LongTimeFormat
791	+	else
792	+	result := ShortDateFormat;
793	+	3:
794	+	result := ShortDateFormat;
795	+	end;
796	+	end;
797	+
798	+	function TSQLDataItem.GetTimeFormatStr: AnsiString;
799	+	begin
800	+	{$IF declared(DefaultFormatSettings)}
801	+	with DefaultFormatSettings do
802	+	{$ELSE}
803	+	{$IF declared(FormatSettings)}
804	+	with FormatSettings do
805	+	{$IFEND}
806	+	{$IFEND}
807	+	Result := LongTimeFormat;
808	+	end;
809	+
810	+	function TSQLDataItem.GetTimestampFormatStr: AnsiString;
811	+	begin
812	+	{$IF declared(DefaultFormatSettings)}
813	+	with DefaultFormatSettings do
814	+	{$ELSE}
815	+	{$IF declared(FormatSettings)}
816	+	with FormatSettings do
817	+	{$IFEND}
818	+	{$IFEND}
819	+	Result := ShortDateFormat + ' ' +  LongTimeFormat + '.zzz';
820	+	end;
821	+
822		procedure TSQLDataItem.SetAsInteger(AValue: Integer);
823		begin
824		SetAsLong(aValue);
#	Line 975 | Line 889 | begin
889		//Do nothing by default
890		end;
891
892	<	procedure TSQLDataItem.InternalSetAsString(Value: String);
892	>	procedure TSQLDataItem.InternalSetAsString(Value: AnsiString);
893		begin
894		//Do nothing by default
895		end;
896
897	<	function TSQLDataItem.Transliterate(s: string; CodePage: TSystemCodePage
897	>	function TSQLDataItem.Transliterate(s: AnsiString; CodePage: TSystemCodePage
898		): RawByteString;
899		begin
900		Result := s;
#	Line 1003 | Line 917 | begin
917		//Do nothing by default
918		end;
919
920	<	function TSQLDataItem.GetSQLTypeName: string;
920	>	constructor TSQLDataItem.Create(api: TFBClientAPI);
921	>	begin
922	>	inherited Create;
923	>	FFirebirdClientAPI := api;
924	>	end;
925	>
926	>	function TSQLDataItem.GetSQLTypeName: AnsiString;
927		begin
928		Result := GetSQLTypeName(GetSQLType);
929		end;
930
931	<	class function TSQLDataItem.GetSQLTypeName(SQLType: short): string;
931	>	class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
932		begin
933		Result := 'Unknown';
934		case SQLType of
#	Line 1109 | Line 1029 | begin
1029		CheckActive;
1030		result := 0;
1031		if not IsNull then
1032	<	with FirebirdClientAPI do
1032	>	with FFirebirdClientAPI do
1033		case SQLType of
1034		SQL_TEXT, SQL_VARYING: begin
1035		try
#	Line 1239 | Line 1159 | begin
1159		end;
1160
1161
1162	<	function TSQLDataItem.GetAsString: String;
1162	>	function TSQLDataItem.GetAsString: AnsiString;
1163		var
1164	<	sz: PChar;
1164	>	sz: PByte;
1165		str_len: Integer;
1166		rs: RawByteString;
1167		begin
#	Line 1249 | Line 1169 | begin
1169		result := '';
1170		{ Check null, if so return a default string }
1171		if not IsNull then
1172	<	with FirebirdClientAPI do
1172	>	with FFirebirdClientAPI do
1173		case SQLType of
1174		SQL_BOOLEAN:
1175		if AsBoolean then
#	Line 1266 | Line 1186 | begin
1186		str_len := DecodeInteger(SQLData, 2);
1187		Inc(sz, 2);
1188		end;
1189	<	SetString(rs, sz, str_len);
1189	>	SetString(rs, PAnsiChar(sz), str_len);
1190		SetCodePage(rs,GetCodePage,false);
1191	<	Result := Trim(rs);
1191	>	if (SQLType = SQL_TEXT) and (GetCharSetID <> 1) then
1192	>	Result := TrimRight(rs)
1193	>	else
1194	>	Result := rs
1195		end;
1196		SQL_TYPE_DATE:
1197	<	case GetSQLDialect of
1275	<	1 : result := DateTimeToStr(AsDateTime);
1276	<	3 : result := DateToStr(AsDateTime);
1277	<	end;
1197	>	result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1198		SQL_TYPE_TIME :
1199	<	result := TimeToStr(AsDateTime);
1199	>	result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1200		SQL_TIMESTAMP:
1201	<	result := FormatDateTime(FormatSettings.ShortDateFormat + ' ' +
1282	<	FormatSettings.LongTimeFormat+'.zzz',AsDateTime);
1201	>	result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1202		SQL_SHORT, SQL_LONG:
1203		if Scale = 0 then
1204		result := IntToStr(AsLong)
#	Line 1307 | Line 1226 | begin
1226		Result := false;
1227		end;
1228
1229	<	function TSQLDataItem.getIsNullable: boolean;
1229	>	function TSQLDataItem.GetIsNullable: boolean;
1230		begin
1231		CheckActive;
1232		Result := false;
#	Line 1355 | Line 1274 | begin
1274		Result := false;
1275		end;
1276
1277	+	function TSQLDataItem.GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats
1278	+	): integer;
1279	+	begin
1280	+	case DateTimeFormat of
1281	+	dfTimestamp:
1282	+	Result := Length(GetTimestampFormatStr);
1283	+	dfDateTime:
1284	+	Result := Length(GetDateFormatStr(true));
1285	+	dfTime:
1286	+	Result := Length(GetTimeFormatStr);
1287	+	else
1288	+	Result := 0;
1289	+	end;
1290	+	end;
1291	+
1292
1293		procedure TSQLDataItem.SetIsNull(Value: Boolean);
1294		begin
#	Line 1366 | Line 1300 | begin
1300		//ignore unless overridden
1301		end;
1302
1303	<	procedure TSQLDataItem.SetName(aValue: string);
1303	>	procedure TSQLDataItem.SetName(aValue: AnsiString);
1304		begin
1305		//ignore unless overridden
1306		end;
#	Line 1418 | Line 1352 | begin
1352
1353		SQLType := SQL_TYPE_DATE;
1354		DataLength := SizeOf(ISC_DATE);
1355	<	with FirebirdClientAPI do
1355	>	with FFirebirdClientAPI do
1356		SQLEncodeDate(Value,SQLData);
1357		Changed;
1358		end;
#	Line 1438 | Line 1372 | begin
1372
1373		SQLType := SQL_TYPE_TIME;
1374		DataLength := SizeOf(ISC_TIME);
1375	<	with FirebirdClientAPI do
1375	>	with FFirebirdClientAPI do
1376		SQLEncodeTime(Value,SQLData);
1377		Changed;
1378		end;
#	Line 1451 | Line 1385 | begin
1385
1386		Changing;
1387		SQLType := SQL_TIMESTAMP;
1388	<	DataLength := SizeOf(TISC_QUAD);
1389	<	with FirebirdClientAPI do
1388	>	DataLength := SizeOf(ISC_TIME) + sizeof(ISC_DATE);
1389	>	with FFirebirdClientAPI do
1390		SQLEncodeDateTime(Value,SQLData);
1391		Changed;
1392		end;
#	Line 1542 | Line 1476 | begin
1476		Changed;
1477		end;
1478
1479	<	procedure TSQLDataItem.SetAsString(Value: String);
1479	>	procedure TSQLDataItem.SetAsString(Value: AnsiString);
1480		begin
1481		InternalSetAsString(Value);
1482		end;
#	Line 1577 | Line 1511 | begin
1511		end;
1512		end;
1513
1514	+	procedure TSQLDataItem.SetAsNumeric(Value: Int64; aScale: integer);
1515	+	begin
1516	+	CheckActive;
1517	+	Changing;
1518	+	if IsNullable then
1519	+	IsNull := False;
1520	+
1521	+	SQLType := SQL_INT64;
1522	+	Scale := aScale;
1523	+	DataLength := SizeOf(Int64);
1524	+	PInt64(SQLData)^ := Value;
1525	+	Changed;
1526	+	end;
1527	+
1528		procedure TSQLDataItem.SetAsBoolean(AValue: boolean);
1529		begin
1530		CheckActive;
#	Line 1607 | Line 1555 | begin
1555		IBError(ibxeStatementNotPrepared, [nil]);
1556		end;
1557
1558	<	function TColumnMetaData.SQLData: PChar;
1558	>	function TColumnMetaData.SQLData: PByte;
1559		begin
1560		Result := FIBXSQLVAR.SQLData;
1561		end;
#	Line 1624 | Line 1572 | end;
1572
1573		constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
1574		begin
1575	<	inherited Create;
1575	>	inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
1576		FIBXSQLVAR := aIBXSQLVAR;
1577		FOwner := aOwner;
1578		FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
#	Line 1660 | Line 1608 | begin
1608		result := FIBXSQLVAR.SQLSubtype;
1609		end;
1610
1611	<	function TColumnMetaData.getRelationName: string;
1611	>	function TColumnMetaData.getRelationName: AnsiString;
1612		begin
1613		CheckActive;
1614		result :=  FIBXSQLVAR.RelationName;
1615		end;
1616
1617	<	function TColumnMetaData.getOwnerName: string;
1617	>	function TColumnMetaData.getOwnerName: AnsiString;
1618		begin
1619		CheckActive;
1620		result :=  FIBXSQLVAR.OwnerName;
1621		end;
1622
1623	<	function TColumnMetaData.getSQLName: string;
1623	>	function TColumnMetaData.getSQLName: AnsiString;
1624		begin
1625		CheckActive;
1626		result :=  FIBXSQLVAR.FieldName;
1627		end;
1628
1629	<	function TColumnMetaData.getAliasName: string;
1629	>	function TColumnMetaData.getAliasName: AnsiString;
1630		begin
1631		CheckActive;
1632		result := FIBXSQLVAR.AliasName;
1633		end;
1634
1635	<	function TColumnMetaData.GetName: string;
1635	>	function TColumnMetaData.GetName: AnsiString;
1636		begin
1637		CheckActive;
1638		Result := FIBXSQLVAR. Name;
#	Line 1769 | Line 1717 | begin
1717		result := FIBXSQLVAR.GetAsBlob(AsQuad,BPB);
1718		end;
1719
1720	<	function TIBSQLData.GetAsString: String;
1720	>	function TIBSQLData.GetAsString: AnsiString;
1721		begin
1722		CheckActive;
1723		Result := '';
#	Line 1777 | Line 1725 | begin
1725		if not IsNull then
1726		case SQLType of
1727		SQL_ARRAY:
1728	<	result := '(Array)'; {do not localize}
1728	>	result := SArray;
1729		SQL_BLOB:
1730	<	Result := Trim(FIBXSQLVAR.GetAsBlob(AsQuad,nil).GetAsString);
1730	>	Result := FIBXSQLVAR.GetAsBlob(AsQuad,nil).GetAsString;
1731		else
1732		Result := inherited GetAsString;
1733		end;
#	Line 1787 | Line 1735 | end;
1735
1736		{ TSQLParam }
1737
1738	<	procedure TSQLParam.InternalSetAsString(Value: String);
1738	>	procedure TSQLParam.InternalSetAsString(Value: AnsiString);
1739	>
1740	>	procedure DoSetString;
1741	>	begin
1742	>	Changing;
1743	>	FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1744	>	Changed;
1745	>	end;
1746	>
1747		var b: IBlob;
1748	+	dt: TDateTime;
1749	+	CurrValue: Currency;
1750	+	FloatValue: single;
1751		begin
1752		CheckActive;
1753		if IsNullable then
1754		IsNull := False;
1755		case SQLTYPE of
1756		SQL_BOOLEAN:
1757	<	if CompareText(Value,STrue) = 0 then
1757	>	if AnsiCompareText(Value,STrue) = 0 then
1758		AsBoolean := true
1759		else
1760	<	if CompareText(Value,SFalse) = 0 then
1760	>	if AnsiCompareText(Value,SFalse) = 0 then
1761		AsBoolean := false
1762		else
1763		IBError(ibxeInvalidDataConversion,[nil]);
#	Line 1814 | Line 1773 | begin
1773
1774		SQL_VARYING,
1775		SQL_TEXT:
1776	<	begin
1818	<	Changing;
1819	<	FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1820	<	Changed;
1821	<	end;
1776	>	DoSetString;
1777
1778		SQL_SHORT,
1779		SQL_LONG,
1780		SQL_INT64:
1781	<	SetAsInt64(StrToInt(Value));
1781	>	if TryStrToCurr(Value,CurrValue) then
1782	>	SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
1783	>	else
1784	>	DoSetString;
1785
1786		SQL_D_FLOAT,
1787		SQL_DOUBLE,
1788		SQL_FLOAT:
1789	<	SetAsDouble(StrToFloat(Value));
1789	>	if TryStrToFloat(Value,FloatValue) then
1790	>	SetAsDouble(FloatValue)
1791	>	else
1792	>	DoSetString;
1793
1794		SQL_TIMESTAMP:
1795	<	SetAsDateTime(StrToDateTime(Value));
1795	>	if TryStrToDateTime(Value,dt) then
1796	>	SetAsDateTime(dt)
1797	>	else
1798	>	DoSetString;
1799
1800		SQL_TYPE_DATE:
1801	<	SetAsDate(StrToDateTime(Value));
1801	>	if TryStrToDateTime(Value,dt) then
1802	>	SetAsDate(dt)
1803	>	else
1804	>	DoSetString;
1805
1806		SQL_TYPE_TIME:
1807	<	SetAsTime(StrToDateTime(Value));
1807	>	if TryStrToDateTime(Value,dt) then
1808	>	SetAsTime(dt)
1809	>	else
1810	>	DoSetString;
1811
1812		else
1813		IBError(ibxeInvalidDataConversion,[nil]);
#	Line 1891 | Line 1861 | begin
1861		Result := inherited GetAsPointer;
1862		end;
1863
1864	<	procedure TSQLParam.SetName(Value: string);
1864	>	procedure TSQLParam.SetName(Value: AnsiString);
1865		begin
1866		CheckActive;
1867		FIBXSQLVAR.Name := Value;
#	Line 2197 | Line 2167 | begin
2167		end;
2168		end;
2169
2170	<	procedure TSQLParam.SetAsString(AValue: String);
2170	>	procedure TSQLParam.SetAsString(AValue: AnsiString);
2171		var i: integer;
2172		OldSQLVar: TSQLVarData;
2173		begin
#	Line 2310 | Line 2280 | begin
2280		inherited Destroy;
2281		end;
2282
2283	<	function TMetaData.GetUniqueRelationName: string;
2283	>	function TMetaData.GetUniqueRelationName: AnsiString;
2284		begin
2285		CheckActive;
2286		Result := FMetaData.UniqueRelationName;
#	Line 2338 | Line 2308 | begin
2308		end;
2309		end;
2310
2311	<	function TMetaData.ByName(Idx: String): IColumnMetaData;
2311	>	function TMetaData.ByName(Idx: AnsiString): IColumnMetaData;
2312		var aIBXSQLVAR: TSQLVarData;
2313		begin
2314		CheckActive;
#	Line 2398 | Line 2368 | begin
2368		end;
2369		end;
2370
2371	<	function TSQLParams.ByName(Idx: String): ISQLParam;
2371	>	function TSQLParams.ByName(Idx: AnsiString): ISQLParam;
2372		var aIBXSQLVAR: TSQLVarData;
2373		begin
2374		CheckActive;
#	Line 2423 | Line 2393 | begin
2393		end;
2394		end;
2395
2396	+	function TSQLParams.GetHasCaseSensitiveParams: Boolean;
2397	+	begin
2398	+	Result := FSQLParams.CaseSensitiveParams;
2399	+	end;
2400	+
2401		{ TResults }
2402
2403		procedure TResults.CheckActive;
#	Line 2466 | Line 2441 | begin
2441		Result := FResults.Count;
2442		end;
2443
2444	<	function TResults.ByName(Idx: String): ISQLData;
2444	>	function TResults.ByName(Idx: AnsiString): ISQLData;
2445		var col: TSQLVarData;
2446		begin
2447		Result := nil;
#	Line 2498 | Line 2473 | begin
2473		end;
2474
2475		procedure TResults.GetData(index: integer; var IsNull: boolean; var len: short;
2476	<	var data: PChar);
2476	>	var data: PByte);
2477		begin
2478		CheckActive;
2479		FResults.GetData(index,IsNull, len,data);
#	Line 2514 | Line 2489 | begin
2489		RetainInterfaces := aValue;
2490		end;
2491
2517	–
2492		end.
2493

Diff Legend

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