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 47 by tony, Mon Jan 9 15:31:51 2017 UTC vs.
Revision 270 by tony, Fri Jan 18 11:10:37 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 getCharSetID: cardinal; virtual; abstract;
111	<	function Transliterate(s: string; CodePage: TSystemCodePage): RawByteString;
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 140 | 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 157 | 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 175 | 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 192 | 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 205 | 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 227 | 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 268 | 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 300 | 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 315 | 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; 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 343 | 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 353 | 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 361 | 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 378 | 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 401 | 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 423 | 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		end;
425
#	Line 443 | Line 439 | type
439		constructor Create(aResults: TSQLDataArea);
440		{IResults}
441		function getCount: integer;
442	<	function ByName(Idx: String): ISQLData;
442	>	function ByName(Idx: AnsiString): ISQLData;
443		function getSQLData(index: integer): ISQLData;
444	<	procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PChar);
444	>	procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
445		function GetTransaction: ITransaction; virtual;
446		procedure SetRetainInterfaces(aValue: boolean);
447		end;
448
449		implementation
450
451	<	uses FBMessages, FBClientAPI, variants, IBUtils, FBTransaction;
451	>	uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
452
453		{ TSQLDataArea }
454
#	Line 472 | Line 468 | procedure TSQLDataArea.SetUniqueRelation
468		var
469		i: Integer;
470		bUnique: Boolean;
471	<	RelationName: string;
471	>	RelationName: AnsiString;
472		begin
473		bUnique := True;
474		for i := 0 to ColumnsInUseCount - 1 do
#	Line 503 | Line 499 | begin
499		Column[i].Initialize;
500		end;
501
502	<	procedure TSQLDataArea.PreprocessSQL(sSQL: string; GenerateParamNames: boolean;
503	<	var sProcessedSQL: string);
508	<	var
509	<	cCurChar, cNextChar, cQuoteChar: Char;
510	<	sParamName: String;
511	<	j, i, iLenSQL, iSQLPos: Integer;
512	<	iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
513	<	iParamSuffix: Integer;
514	<	slNames: TStrings;
515	<	StrBuffer: PChar;
516	<	found: boolean;
517	<
518	<	const
519	<	DefaultState = 0;
520	<	CommentState = 1;
521	<	QuoteState = 2;
522	<	ParamState = 3;
523	<	ArrayDimState = 4;
524	<	{$ifdef ALLOWDIALECT3PARAMNAMES}
525	<	ParamDefaultState = 0;
526	<	ParamQuoteState = 1;
527	<	{$endif}
528	<
529	<	procedure AddToProcessedSQL(cChar: Char);
530	<	begin
531	<	StrBuffer[iSQLPos] := cChar;
532	<	Inc(iSQLPos);
533	<	end;
502	>	procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
503	>	var sProcessedSQL: AnsiString);
504
505	<	begin
536	<	if not IsInputDataArea then
537	<	IBError(ibxeNotPermitted,[nil]);
505	>	var slNames: TStrings;
506
507	<	sParamName := '';
508	<	iLenSQL := Length(sSQL);
509	<	GetMem(StrBuffer,iLenSQL + 1);
510	<	slNames := TStringList.Create;
511	<	try
544	<	{ Do some initializations of variables }
545	<	iParamSuffix := 0;
546	<	cQuoteChar := '''';
547	<	i := 1;
548	<	iSQLPos := 0;
549	<	iCurState := DefaultState;
550	<	{$ifdef ALLOWDIALECT3PARAMNAMES}
551	<	iCurParamState := ParamDefaultState;
552	<	{$endif}
553	<	{ Now, traverse through the SQL string, character by character,
554	<	picking out the parameters and formatting correctly for InterBase }
555	<	while (i <= iLenSQL) do begin
556	<	{ Get the current token and a look-ahead }
557	<	cCurChar := sSQL[i];
558	<	if i = iLenSQL then
559	<	cNextChar := #0
560	<	else
561	<	cNextChar := sSQL[i + 1];
562	<	{ Now act based on the current state }
563	<	case iCurState of
564	<	DefaultState:
565	<	begin
566	<	case cCurChar of
567	<	'''', '"':
568	<	begin
569	<	cQuoteChar := cCurChar;
570	<	iCurState := QuoteState;
571	<	end;
572	<	'?', ':':
573	<	begin
574	<	iCurState := ParamState;
575	<	AddToProcessedSQL('?');
576	<	end;
577	<	'/': if (cNextChar = '*') then
578	<	begin
579	<	AddToProcessedSQL(cCurChar);
580	<	Inc(i);
581	<	iCurState := CommentState;
582	<	end;
583	<	'[':
584	<	begin
585	<	AddToProcessedSQL(cCurChar);
586	<	Inc(i);
587	<	iCurState := ArrayDimState;
588	<	end;
589	<	end;
590	<	end;
591	<
592	<	ArrayDimState:
593	<	begin
594	<	case cCurChar of
595	<	':',',','0'..'9',' ',#9,#10,#13:
596	<	begin
597	<	AddToProcessedSQL(cCurChar);
598	<	Inc(i);
599	<	end;
600	<	else
601	<	begin
602	<	AddToProcessedSQL(cCurChar);
603	<	Inc(i);
604	<	iCurState := DefaultState;
605	<	end;
606	<	end;
607	<	end;
608	<
609	<	CommentState:
610	<	begin
611	<	if (cNextChar = #0) then
612	<	IBError(ibxeSQLParseError, [SEOFInComment])
613	<	else if (cCurChar = '*') then begin
614	<	if (cNextChar = '/') then
615	<	iCurState := DefaultState;
616	<	end;
617	<	end;
618	<	QuoteState: begin
619	<	if cNextChar = #0 then
620	<	IBError(ibxeSQLParseError, [SEOFInString])
621	<	else if (cCurChar = cQuoteChar) then begin
622	<	if (cNextChar = cQuoteChar) then begin
623	<	AddToProcessedSQL(cCurChar);
624	<	Inc(i);
625	<	end else
626	<	iCurState := DefaultState;
627	<	end;
628	<	end;
629	<	ParamState:
630	<	begin
631	<	{ collect the name of the parameter }
632	<	{$ifdef ALLOWDIALECT3PARAMNAMES}
633	<	if iCurParamState = ParamDefaultState then
634	<	begin
635	<	if cCurChar = '"' then
636	<	iCurParamState := ParamQuoteState
637	<	else
638	<	{$endif}
639	<	if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
640	<	sParamName := sParamName + cCurChar
641	<	else if GenerateParamNames then
642	<	begin
643	<	sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
644	<	Inc(iParamSuffix);
645	<	iCurState := DefaultState;
646	<	slNames.AddObject(sParamName,self); //Note local convention
647	<	//add pointer to self to mark entry
648	<	sParamName := '';
649	<	end
650	<	else
651	<	IBError(ibxeSQLParseError, [SParamNameExpected]);
652	<	{$ifdef ALLOWDIALECT3PARAMNAMES}
653	<	end
654	<	else begin
655	<	{ determine if Quoted parameter name is finished }
656	<	if cCurChar = '"' then
657	<	begin
658	<	Inc(i);
659	<	slNames.Add(sParamName);
660	<	SParamName := '';
661	<	iCurParamState := ParamDefaultState;
662	<	iCurState := DefaultState;
663	<	end
664	<	else
665	<	sParamName := sParamName + cCurChar
666	<	end;
667	<	{$endif}
668	<	{ determine if the unquoted parameter name is finished }
669	<	if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
670	<	(iCurState <> DefaultState) then
671	<	begin
672	<	if not (cNextChar in ['A'..'Z', 'a'..'z',
673	<	'0'..'9', '_', '$']) then begin
674	<	Inc(i);
675	<	iCurState := DefaultState;
676	<	slNames.Add(sParamName);
677	<	sParamName := '';
678	<	end;
679	<	end;
680	<	end;
681	<	end;
682	<	if (iCurState <> ParamState) and (i <= iLenSQL) then
683	<	AddToProcessedSQL(sSQL[i]);
684	<	Inc(i);
685	<	end;
686	<	AddToProcessedSQL(#0);
687	<	sProcessedSQL := strpas(StrBuffer);
507	>	procedure SetColumnNames(slNames: TStrings);
508	>	var i, j: integer;
509	>	found: boolean;
510	>	begin
511	>	found := false;
512		SetCount(slNames.Count);
513		for i := 0 to slNames.Count - 1 do
514		begin
#	Line 705 | Line 529 | begin
529		Column[i].UniqueName := not found;
530		end;
531		end;
532	+	end;
533	+
534	+	begin
535	+	if not IsInputDataArea then
536	+	IBError(ibxeNotPermitted,[nil]);
537	+
538	+	slNames := TStringList.Create;
539	+	try
540	+	sProcessedSQL := TSQLParamProcessor.Execute(sSQL,GenerateParamNames,slNames);
541	+	SetColumnNames(slNames);
542		finally
543		slNames.Free;
710	–	FreeMem(StrBuffer);
544		end;
545		end;
546
#	Line 716 | Line 549 | begin
549		Result := Count;
550		end;
551
552	<	function TSQLDataArea.ColumnByName(Idx: string): TSQLVarData;
552	>	function TSQLDataArea.ColumnByName(Idx: AnsiString): TSQLVarData;
553		var
554	<	s: String;
554	>	s: AnsiString;
555		i: Integer;
556		begin
557	<	{$ifdef UseCaseInSensitiveParamName}
558	<	s := AnsiUpperCase(Idx);
559	<	{$else}
557	>	if not IsInputDataArea or not CaseSensitiveParams then
558	>	s := AnsiUpperCase(Idx)
559	>	else
560		s := Idx;
561	<	{$endif}
561	>
562		for i := 0 to Count - 1 do
563		if Column[i].Name = s then
564		begin
#	Line 736 | Line 569 | begin
569		end;
570
571		procedure TSQLDataArea.GetData(index: integer; var IsNull: boolean;
572	<	var len: short; var data: PChar);
572	>	var len: short; var data: PByte);
573		begin
574		//Do Nothing
575		end;
#	Line 755 | Line 588 | begin
588		Result := FParent.Statement;
589		end;
590
591	<	procedure TSQLVarData.SetName(AValue: string);
591	>	procedure TSQLVarData.SetName(AValue: AnsiString);
592		begin
593	<	if FName = AValue then Exit;
761	<	{$ifdef UseCaseInSensitiveParamName}
762	<	if Parent.IsInputDataArea then
593	>	if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
594		FName := AnsiUpperCase(AValue)
595		else
765	–	{$endif}
596		FName := AValue;
597		end;
598
#	Line 774 | Line 604 | begin
604		FUniqueName := true;
605		end;
606
607	<	procedure TSQLVarData.SetString(aValue: string);
607	>	procedure TSQLVarData.SetString(aValue: AnsiString);
608		begin
609		{we take full advantage here of reference counted strings. When setting a string
610		value, a reference is kept in FVarString and a pointer to it placed in the
611	<	SQLVar. This avoids string copies. Note that PChar is guaranteed to point to
611	>	SQLVar. This avoids string copies. Note that PAnsiChar is guaranteed to point to
612		a zero byte when the string is empty, neatly avoiding a nil pointer error.}
613
614		FVarString := aValue;
615		SQLType := SQL_TEXT;
616	<	SetSQLData(PChar(FVarString),Length(aValue));
616	>	Scale := 0;
617	>	SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
618		end;
619
620		procedure TSQLVarData.Changed;
#	Line 799 | Line 630 | end;
630
631		procedure TSQLVarData.Initialize;
632
633	<	function FindVarByName(idx: string; limit: integer): TSQLVarData;
633	>	function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
634		var
635		k: integer;
636		begin
#	Line 814 | Line 645 | procedure TSQLVarData.Initialize;
645
646		var
647		j, j_len: Integer;
648	<	st: String;
649	<	sBaseName: string;
648	>	st: AnsiString;
649	>	sBaseName: AnsiString;
650		begin
651		RowChange;
652
#	Line 902 | Line 733 | function TSQLDataItem.AdjustScaleToCurre
733		var
734		Scaling : Int64;
735		i : Integer;
736	<	FractionText, PadText, CurrText: string;
736	>	FractionText, PadText, CurrText: AnsiString;
737		begin
738		Result := 0;
739		Scaling := 1;
#	Line 921 | Line 752 | begin
752		FractionText := IntToStr(abs(Value mod Scaling));
753		for i := Length(FractionText) to -aScale -1 do
754		PadText := '0' + PadText;
755	+	{$IF declared(DefaultFormatSettings)}
756	+	with DefaultFormatSettings do
757	+	{$ELSE}
758	+	{$IF declared(FormatSettings)}
759	+	with FormatSettings do
760	+	{$IFEND}
761	+	{$IFEND}
762		if Value < 0 then
763	<	CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DefaultFormatSettings.DecimalSeparator + PadText + FractionText
763	>	CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText
764		else
765	<	CurrText := IntToStr(Abs(Value div Scaling)) + DefaultFormatSettings.DecimalSeparator + PadText + FractionText;
765	>	CurrText := IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText;
766		try
767		result := StrToCurr(CurrText);
768		except
#	Line 936 | Line 774 | begin
774		result := Value;
775		end;
776
777	+	function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
778	+	begin
779	+	{$IF declared(DefaultFormatSettings)}
780	+	with DefaultFormatSettings do
781	+	{$ELSE}
782	+	{$IF declared(FormatSettings)}
783	+	with FormatSettings do
784	+	{$IFEND}
785	+	{$IFEND}
786	+	case GetSQLDialect of
787	+	1:
788	+	if IncludeTime then
789	+	result := ShortDateFormat + ' ' + LongTimeFormat
790	+	else
791	+	result := ShortDateFormat;
792	+	3:
793	+	result := ShortDateFormat;
794	+	end;
795	+	end;
796	+
797	+	function TSQLDataItem.GetTimeFormatStr: AnsiString;
798	+	begin
799	+	{$IF declared(DefaultFormatSettings)}
800	+	with DefaultFormatSettings do
801	+	{$ELSE}
802	+	{$IF declared(FormatSettings)}
803	+	with FormatSettings do
804	+	{$IFEND}
805	+	{$IFEND}
806	+	Result := LongTimeFormat;
807	+	end;
808	+
809	+	function TSQLDataItem.GetTimestampFormatStr: 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 := ShortDateFormat + ' ' +  LongTimeFormat + '.zzz';
819	+	end;
820	+
821		procedure TSQLDataItem.SetAsInteger(AValue: Integer);
822		begin
823		SetAsLong(aValue);
#	Line 1006 | Line 888 | begin
888		//Do nothing by default
889		end;
890
891	<	procedure TSQLDataItem.InternalSetAsString(Value: String);
891	>	procedure TSQLDataItem.InternalSetAsString(Value: AnsiString);
892		begin
893		//Do nothing by default
894		end;
895
896	<	function TSQLDataItem.Transliterate(s: string; CodePage: TSystemCodePage
896	>	function TSQLDataItem.Transliterate(s: AnsiString; CodePage: TSystemCodePage
897		): RawByteString;
898		begin
899		Result := s;
#	Line 1034 | Line 916 | begin
916		//Do nothing by default
917		end;
918
919	<	function TSQLDataItem.GetSQLTypeName: string;
919	>	constructor TSQLDataItem.Create(api: TFBClientAPI);
920	>	begin
921	>	inherited Create;
922	>	FFirebirdClientAPI := api;
923	>	end;
924	>
925	>	function TSQLDataItem.GetSQLTypeName: AnsiString;
926		begin
927		Result := GetSQLTypeName(GetSQLType);
928		end;
929
930	<	class function TSQLDataItem.GetSQLTypeName(SQLType: short): string;
930	>	class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
931		begin
932		Result := 'Unknown';
933		case SQLType of
#	Line 1140 | Line 1028 | begin
1028		CheckActive;
1029		result := 0;
1030		if not IsNull then
1031	<	with FirebirdClientAPI do
1031	>	with FFirebirdClientAPI do
1032		case SQLType of
1033		SQL_TEXT, SQL_VARYING: begin
1034		try
#	Line 1270 | Line 1158 | begin
1158		end;
1159
1160
1161	<	function TSQLDataItem.GetAsString: String;
1161	>	function TSQLDataItem.GetAsString: AnsiString;
1162		var
1163	<	sz: PChar;
1163	>	sz: PByte;
1164		str_len: Integer;
1165		rs: RawByteString;
1166		begin
#	Line 1280 | Line 1168 | begin
1168		result := '';
1169		{ Check null, if so return a default string }
1170		if not IsNull then
1171	<	with FirebirdClientAPI do
1171	>	with FFirebirdClientAPI do
1172		case SQLType of
1173		SQL_BOOLEAN:
1174		if AsBoolean then
#	Line 1297 | Line 1185 | begin
1185		str_len := DecodeInteger(SQLData, 2);
1186		Inc(sz, 2);
1187		end;
1188	<	SetString(rs, sz, str_len);
1188	>	SetString(rs, PAnsiChar(sz), str_len);
1189		SetCodePage(rs,GetCodePage,false);
1190		if (SQLType = SQL_TEXT) and (GetCharSetID <> 1) then
1191		Result := TrimRight(rs)
#	Line 1305 | Line 1193 | begin
1193		Result := rs
1194		end;
1195		SQL_TYPE_DATE:
1196	<	case GetSQLDialect of
1309	<	1 : result := DateTimeToStr(AsDateTime);
1310	<	3 : result := DateToStr(AsDateTime);
1311	<	end;
1196	>	result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1197		SQL_TYPE_TIME :
1198	<	result := TimeToStr(AsDateTime);
1198	>	result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1199		SQL_TIMESTAMP:
1200	<	result := FormatDateTime(FormatSettings.ShortDateFormat + ' ' +
1316	<	FormatSettings.LongTimeFormat+'.zzz',AsDateTime);
1200	>	result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1201		SQL_SHORT, SQL_LONG:
1202		if Scale = 0 then
1203		result := IntToStr(AsLong)
#	Line 1341 | Line 1225 | begin
1225		Result := false;
1226		end;
1227
1228	<	function TSQLDataItem.getIsNullable: boolean;
1228	>	function TSQLDataItem.GetIsNullable: boolean;
1229		begin
1230		CheckActive;
1231		Result := false;
#	Line 1389 | Line 1273 | begin
1273		Result := false;
1274		end;
1275
1276	+	function TSQLDataItem.GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats
1277	+	): integer;
1278	+	begin
1279	+	case DateTimeFormat of
1280	+	dfTimestamp:
1281	+	Result := Length(GetTimestampFormatStr);
1282	+	dfDateTime:
1283	+	Result := Length(GetDateFormatStr(true));
1284	+	dfTime:
1285	+	Result := Length(GetTimeFormatStr);
1286	+	else
1287	+	Result := 0;
1288	+	end;
1289	+	end;
1290	+
1291
1292		procedure TSQLDataItem.SetIsNull(Value: Boolean);
1293		begin
#	Line 1400 | Line 1299 | begin
1299		//ignore unless overridden
1300		end;
1301
1302	<	procedure TSQLDataItem.SetName(aValue: string);
1302	>	procedure TSQLDataItem.SetName(aValue: AnsiString);
1303		begin
1304		//ignore unless overridden
1305		end;
#	Line 1452 | Line 1351 | begin
1351
1352		SQLType := SQL_TYPE_DATE;
1353		DataLength := SizeOf(ISC_DATE);
1354	<	with FirebirdClientAPI do
1354	>	with FFirebirdClientAPI do
1355		SQLEncodeDate(Value,SQLData);
1356		Changed;
1357		end;
#	Line 1472 | Line 1371 | begin
1371
1372		SQLType := SQL_TYPE_TIME;
1373		DataLength := SizeOf(ISC_TIME);
1374	<	with FirebirdClientAPI do
1374	>	with FFirebirdClientAPI do
1375		SQLEncodeTime(Value,SQLData);
1376		Changed;
1377		end;
#	Line 1486 | Line 1385 | begin
1385		Changing;
1386		SQLType := SQL_TIMESTAMP;
1387		DataLength := SizeOf(ISC_TIME) + sizeof(ISC_DATE);
1388	<	with FirebirdClientAPI do
1388	>	with FFirebirdClientAPI do
1389		SQLEncodeDateTime(Value,SQLData);
1390		Changed;
1391		end;
#	Line 1576 | Line 1475 | begin
1475		Changed;
1476		end;
1477
1478	<	procedure TSQLDataItem.SetAsString(Value: String);
1478	>	procedure TSQLDataItem.SetAsString(Value: AnsiString);
1479		begin
1480		InternalSetAsString(Value);
1481		end;
#	Line 1611 | Line 1510 | begin
1510		end;
1511		end;
1512
1513	+	procedure TSQLDataItem.SetAsNumeric(Value: Int64; aScale: integer);
1514	+	begin
1515	+	CheckActive;
1516	+	Changing;
1517	+	if IsNullable then
1518	+	IsNull := False;
1519	+
1520	+	SQLType := SQL_INT64;
1521	+	Scale := aScale;
1522	+	DataLength := SizeOf(Int64);
1523	+	PInt64(SQLData)^ := Value;
1524	+	Changed;
1525	+	end;
1526	+
1527		procedure TSQLDataItem.SetAsBoolean(AValue: boolean);
1528		begin
1529		CheckActive;
#	Line 1641 | Line 1554 | begin
1554		IBError(ibxeStatementNotPrepared, [nil]);
1555		end;
1556
1557	<	function TColumnMetaData.SQLData: PChar;
1557	>	function TColumnMetaData.SQLData: PByte;
1558		begin
1559		Result := FIBXSQLVAR.SQLData;
1560		end;
#	Line 1658 | Line 1571 | end;
1571
1572		constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
1573		begin
1574	<	inherited Create;
1574	>	inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
1575		FIBXSQLVAR := aIBXSQLVAR;
1576		FOwner := aOwner;
1577		FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
#	Line 1694 | Line 1607 | begin
1607		result := FIBXSQLVAR.SQLSubtype;
1608		end;
1609
1610	<	function TColumnMetaData.getRelationName: string;
1610	>	function TColumnMetaData.getRelationName: AnsiString;
1611		begin
1612		CheckActive;
1613		result :=  FIBXSQLVAR.RelationName;
1614		end;
1615
1616	<	function TColumnMetaData.getOwnerName: string;
1616	>	function TColumnMetaData.getOwnerName: AnsiString;
1617		begin
1618		CheckActive;
1619		result :=  FIBXSQLVAR.OwnerName;
1620		end;
1621
1622	<	function TColumnMetaData.getSQLName: string;
1622	>	function TColumnMetaData.getSQLName: AnsiString;
1623		begin
1624		CheckActive;
1625		result :=  FIBXSQLVAR.FieldName;
1626		end;
1627
1628	<	function TColumnMetaData.getAliasName: string;
1628	>	function TColumnMetaData.getAliasName: AnsiString;
1629		begin
1630		CheckActive;
1631		result := FIBXSQLVAR.AliasName;
1632		end;
1633
1634	<	function TColumnMetaData.GetName: string;
1634	>	function TColumnMetaData.GetName: AnsiString;
1635		begin
1636		CheckActive;
1637		Result := FIBXSQLVAR. Name;
#	Line 1803 | Line 1716 | begin
1716		result := FIBXSQLVAR.GetAsBlob(AsQuad,BPB);
1717		end;
1718
1719	<	function TIBSQLData.GetAsString: String;
1719	>	function TIBSQLData.GetAsString: AnsiString;
1720		begin
1721		CheckActive;
1722		Result := '';
#	Line 1821 | Line 1734 | end;
1734
1735		{ TSQLParam }
1736
1737	<	procedure TSQLParam.InternalSetAsString(Value: String);
1737	>	procedure TSQLParam.InternalSetAsString(Value: AnsiString);
1738	>
1739	>	procedure DoSetString;
1740	>	begin
1741	>	Changing;
1742	>	FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1743	>	Changed;
1744	>	end;
1745	>
1746		var b: IBlob;
1747	+	dt: TDateTime;
1748	+	CurrValue: Currency;
1749	+	FloatValue: single;
1750		begin
1751		CheckActive;
1752		if IsNullable then
1753		IsNull := False;
1754		case SQLTYPE of
1755		SQL_BOOLEAN:
1756	<	if CompareText(Value,STrue) = 0 then
1756	>	if AnsiCompareText(Value,STrue) = 0 then
1757		AsBoolean := true
1758		else
1759	<	if CompareText(Value,SFalse) = 0 then
1759	>	if AnsiCompareText(Value,SFalse) = 0 then
1760		AsBoolean := false
1761		else
1762		IBError(ibxeInvalidDataConversion,[nil]);
#	Line 1848 | Line 1772 | begin
1772
1773		SQL_VARYING,
1774		SQL_TEXT:
1775	<	begin
1852	<	Changing;
1853	<	FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1854	<	Changed;
1855	<	end;
1775	>	DoSetString;
1776
1777		SQL_SHORT,
1778		SQL_LONG,
1779		SQL_INT64:
1780	<	SetAsInt64(StrToInt(Value));
1780	>	if TryStrToCurr(Value,CurrValue) then
1781	>	SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
1782	>	else
1783	>	DoSetString;
1784
1785		SQL_D_FLOAT,
1786		SQL_DOUBLE,
1787		SQL_FLOAT:
1788	<	SetAsDouble(StrToFloat(Value));
1788	>	if TryStrToFloat(Value,FloatValue) then
1789	>	SetAsDouble(FloatValue)
1790	>	else
1791	>	DoSetString;
1792
1793		SQL_TIMESTAMP:
1794	<	SetAsDateTime(StrToDateTime(Value));
1794	>	if TryStrToDateTime(Value,dt) then
1795	>	SetAsDateTime(dt)
1796	>	else
1797	>	DoSetString;
1798
1799		SQL_TYPE_DATE:
1800	<	SetAsDate(StrToDateTime(Value));
1800	>	if TryStrToDateTime(Value,dt) then
1801	>	SetAsDate(dt)
1802	>	else
1803	>	DoSetString;
1804
1805		SQL_TYPE_TIME:
1806	<	SetAsTime(StrToDateTime(Value));
1806	>	if TryStrToDateTime(Value,dt) then
1807	>	SetAsTime(dt)
1808	>	else
1809	>	DoSetString;
1810
1811		else
1812		IBError(ibxeInvalidDataConversion,[nil]);
#	Line 1925 | Line 1860 | begin
1860		Result := inherited GetAsPointer;
1861		end;
1862
1863	<	procedure TSQLParam.SetName(Value: string);
1863	>	procedure TSQLParam.SetName(Value: AnsiString);
1864		begin
1865		CheckActive;
1866		FIBXSQLVAR.Name := Value;
#	Line 2231 | Line 2166 | begin
2166		end;
2167		end;
2168
2169	<	procedure TSQLParam.SetAsString(AValue: String);
2169	>	procedure TSQLParam.SetAsString(AValue: AnsiString);
2170		var i: integer;
2171		OldSQLVar: TSQLVarData;
2172		begin
#	Line 2344 | Line 2279 | begin
2279		inherited Destroy;
2280		end;
2281
2282	<	function TMetaData.GetUniqueRelationName: string;
2282	>	function TMetaData.GetUniqueRelationName: AnsiString;
2283		begin
2284		CheckActive;
2285		Result := FMetaData.UniqueRelationName;
#	Line 2372 | Line 2307 | begin
2307		end;
2308		end;
2309
2310	<	function TMetaData.ByName(Idx: String): IColumnMetaData;
2310	>	function TMetaData.ByName(Idx: AnsiString): IColumnMetaData;
2311		var aIBXSQLVAR: TSQLVarData;
2312		begin
2313		CheckActive;
#	Line 2432 | Line 2367 | begin
2367		end;
2368		end;
2369
2370	<	function TSQLParams.ByName(Idx: String): ISQLParam;
2370	>	function TSQLParams.ByName(Idx: AnsiString): ISQLParam;
2371		var aIBXSQLVAR: TSQLVarData;
2372		begin
2373		CheckActive;
#	Line 2500 | Line 2435 | begin
2435		Result := FResults.Count;
2436		end;
2437
2438	<	function TResults.ByName(Idx: String): ISQLData;
2438	>	function TResults.ByName(Idx: AnsiString): ISQLData;
2439		var col: TSQLVarData;
2440		begin
2441		Result := nil;
#	Line 2532 | Line 2467 | begin
2467		end;
2468
2469		procedure TResults.GetData(index: integer; var IsNull: boolean; var len: short;
2470	<	var data: PChar);
2470	>	var data: PByte);
2471		begin
2472		CheckActive;
2473		FResults.GetData(index,IsNull, len,data);
#	Line 2548 | Line 2483 | begin
2483		RetainInterfaces := aValue;
2484		end;
2485
2551	–
2486		end.
2487

Diff Legend

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