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 263 by tony, Thu Dec 6 15:55:01 2018 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
79	<	{ $define ALLOWDIALECT3PARAMNAMES}
77	<
78	<	{$ifndef ALLOWDIALECT3PARAMNAMES}
79	<
80	<	{ Note on SQL Dialects and SQL Parameter Names
79	>	{ Note on SQL Parameter Names
80		--------------------------------------------
81
82	<	Even when dialect 3 quoted format parameter names are not supported, IBX still processes
83	<	parameter names case insensitive. This does result in some additional overhead
85	<	due to a call to "AnsiUpperCase". This can be avoided by undefining
82	>	IBX processes parameter names case insensitive. This does result in some additional
83	>	overhead due to a call to "AnsiUpperCase". This can be avoided by undefining
84		"UseCaseInSensitiveParamName" below.
85
88	–	Note: do not define "UseCaseSensitiveParamName" when "ALLOWDIALECT3PARAMNAMES"
89	–	is defined. This will not give a useful result.
86		}
87		{$define UseCaseInSensitiveParamName}
92	–	{$endif}
88
89		interface
90
91		uses
92	<	Classes, SysUtils, IBExternals, IBHeader, IB,  FBActivityMonitor;
92	>	Classes, SysUtils, IBExternals, IBHeader, IB,  FBActivityMonitor, FBClientAPI;
93
94		type
95
#	Line 102 | Line 97 | type
97
98		TSQLDataItem = class(TFBInterfacedObject)
99		private
100	+	FFirebirdClientAPI: TFBClientAPI;
101		function AdjustScale(Value: Int64; aScale: Integer): Double;
102		function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
103		function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
#	Line 113 | Line 109 | type
109		function GetSQLDialect: integer; virtual; abstract;
110		procedure Changed; virtual;
111		procedure Changing; virtual;
112	<	procedure InternalSetAsString(Value: String); virtual;
113	<	function SQLData: PChar; virtual; abstract;
112	>	procedure InternalSetAsString(Value: AnsiString); virtual;
113	>	function SQLData: PByte; virtual; abstract;
114		function GetDataLength: cardinal; virtual; abstract;
115		function GetCodePage: TSystemCodePage; virtual; abstract;
116		function getCharSetID: cardinal; virtual; abstract;
117	<	function Transliterate(s: string; CodePage: TSystemCodePage): RawByteString;
117	>	function Transliterate(s: AnsiString; CodePage: TSystemCodePage): RawByteString;
118		procedure SetScale(aValue: integer); virtual;
119		procedure SetDataLength(len: cardinal); virtual;
120		procedure SetSQLType(aValue: cardinal); virtual;
121		property DataLength: cardinal read GetDataLength write SetDataLength;
122
123		public
124	+	constructor Create(api: TFBClientAPI);
125		function GetSQLType: cardinal; virtual; abstract;
126	<	function GetSQLTypeName: string; overload;
127	<	class function GetSQLTypeName(SQLType: short): string; overload;
128	<	function GetName: string; virtual; abstract;
126	>	function GetSQLTypeName: AnsiString; overload;
127	>	class function GetSQLTypeName(SQLType: short): AnsiString; overload;
128	>	function GetName: AnsiString; virtual; abstract;
129		function GetScale: integer; virtual; abstract;
130		function GetAsBoolean: boolean;
131		function GetAsCurrency: Currency;
#	Line 140 | Line 137 | type
137		function GetAsPointer: Pointer;
138		function GetAsQuad: TISC_QUAD;
139		function GetAsShort: short;
140	<	function GetAsString: String; virtual;
140	>	function GetAsString: AnsiString; virtual;
141		function GetIsNull: Boolean; virtual;
142	<	function getIsNullable: boolean; virtual;
142	>	function GetIsNullable: boolean; virtual;
143		function GetAsVariant: Variant;
144		function GetModified: boolean; virtual;
145		procedure SetAsBoolean(AValue: boolean); virtual;
#	Line 157 | Line 154 | type
154		procedure SetAsPointer(Value: Pointer);
155		procedure SetAsQuad(Value: TISC_QUAD);
156		procedure SetAsShort(Value: short); virtual;
157	<	procedure SetAsString(Value: String); virtual;
157	>	procedure SetAsString(Value: AnsiString); virtual;
158		procedure SetAsVariant(Value: Variant);
159	+	procedure SetAsNumeric(Value: Int64; aScale: integer);
160		procedure SetIsNull(Value: Boolean); virtual;
161		procedure SetIsNullable(Value: Boolean); virtual;
162	<	procedure SetName(aValue: string); virtual;
162	>	procedure SetName(aValue: AnsiString); virtual;
163		property AsDate: TDateTime read GetAsDateTime write SetAsDate;
164		property AsBoolean:boolean read GetAsBoolean write SetAsBoolean;
165		property AsTime: TDateTime read GetAsDateTime write SetAsTime;
#	Line 175 | Line 173 | type
173		property AsPointer: Pointer read GetAsPointer write SetAsPointer;
174		property AsQuad: TISC_QUAD read GetAsQuad write SetAsQuad;
175		property AsShort: short read GetAsShort write SetAsShort;
176	<	property AsString: String read GetAsString write SetAsString;
176	>	property AsString: AnsiString read GetAsString write SetAsString;
177		property AsVariant: Variant read GetAsVariant write SetAsVariant;
178		property Modified: Boolean read getModified;
179		property IsNull: Boolean read GetIsNull write SetIsNull;
#	Line 195 | Line 193 | type
193		function GetColumn(index: integer): TSQLVarData;
194		function GetCount: integer;
195		protected
196	<	FUniqueRelationName: string;
196	>	FUniqueRelationName: AnsiString;
197		FColumnList: array of TSQLVarData;
198		function GetStatement: IStatement; virtual; abstract;
199		function GetPrepareSeqNo: integer; virtual; abstract;
#	Line 205 | Line 203 | type
203		public
204		procedure Initialize; virtual;
205		function IsInputDataArea: boolean; virtual; abstract; {Input to Database}
206	<	procedure PreprocessSQL(sSQL: string; GenerateParamNames: boolean;
207	<	var sProcessedSQL: string);
206	>	procedure PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
207	>	var sProcessedSQL: AnsiString);
208		function ColumnsInUseCount: integer; virtual;
209	<	function ColumnByName(Idx: string): TSQLVarData;
209	>	function ColumnByName(Idx: AnsiString): TSQLVarData;
210		function CheckStatementStatus(Request: TStatementStatus): boolean; virtual; abstract;
211		procedure GetData(index: integer; var IsNull: boolean; var len: short;
212	<	var data: PChar); virtual;
212	>	var data: PByte); virtual;
213		procedure RowChange;
214		function StateChanged(var ChangeSeqNo: integer): boolean; virtual; abstract;
215		property Count: integer read GetCount;
216		property Column[index: integer]: TSQLVarData read GetColumn;
217	<	property UniqueRelationName: string read FUniqueRelationName;
217	>	property UniqueRelationName: AnsiString read FUniqueRelationName;
218		property Statement: IStatement read GetStatement;
219		property PrepareSeqNo: integer read GetPrepareSeqNo;
220		property TransactionSeqNo: integer read GetTransactionSeqNo;
#	Line 227 | Line 225 | type
225		TSQLVarData = class
226		private
227		FParent: TSQLDataArea;
228	<	FName: string;
228	>	FName: AnsiString;
229		FIndex: integer;
230		FModified: boolean;
231		FUniqueName: boolean;
232		FVarString: RawByteString;
233		function GetStatement: IStatement;
234	<	procedure SetName(AValue: string);
234	>	procedure SetName(AValue: AnsiString);
235		protected
236		function GetSQLType: cardinal; virtual; abstract;
237		function GetSubtype: integer; virtual; abstract;
238	<	function GetAliasName: string;  virtual; abstract;
239	<	function GetFieldName: string; virtual; abstract;
240	<	function GetOwnerName: string;  virtual; abstract;
241	<	function GetRelationName: string;  virtual; abstract;
238	>	function GetAliasName: AnsiString;  virtual; abstract;
239	>	function GetFieldName: AnsiString; virtual; abstract;
240	>	function GetOwnerName: AnsiString;  virtual; abstract;
241	>	function GetRelationName: AnsiString;  virtual; abstract;
242		function GetScale: integer; virtual; abstract;
243		function GetCharSetID: cardinal; virtual; abstract;
244		function GetCodePage: TSystemCodePage; virtual; abstract;
245		function GetIsNull: Boolean;   virtual; abstract;
246		function GetIsNullable: boolean; virtual; abstract;
247	<	function GetSQLData: PChar;  virtual; abstract;
247	>	function GetSQLData: PByte;  virtual; abstract;
248		function GetDataLength: cardinal; virtual; abstract;
249		procedure SetIsNull(Value: Boolean); virtual; abstract;
250		procedure SetIsNullable(Value: Boolean);  virtual; abstract;
251	<	procedure SetSQLData(AValue: PChar; len: cardinal); virtual; abstract;
251	>	procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
252		procedure SetScale(aValue: integer); virtual; abstract;
253		procedure SetDataLength(len: cardinal); virtual; abstract;
254		procedure SetSQLType(aValue: cardinal); virtual; abstract;
255		procedure SetCharSetID(aValue: cardinal); virtual; abstract;
256		public
257		constructor Create(aParent: TSQLDataArea; aIndex: integer);
258	<	procedure SetString(aValue: string);
258	>	procedure SetString(aValue: AnsiString);
259		procedure Changed; virtual;
260		procedure RowChange; virtual;
261		function GetAsArray(Array_ID: TISC_QUAD): IArray; virtual; abstract;
#	Line 268 | Line 266 | type
266		procedure Initialize; virtual;
267
268		public
269	<	property AliasName: string read GetAliasName;
270	<	property FieldName: string read GetFieldName;
271	<	property OwnerName: string read GetOwnerName;
272	<	property RelationName: string read GetRelationName;
269	>	property AliasName: AnsiString read GetAliasName;
270	>	property FieldName: AnsiString read GetFieldName;
271	>	property OwnerName: AnsiString read GetOwnerName;
272	>	property RelationName: AnsiString read GetRelationName;
273		property Parent: TSQLDataArea read FParent;
274		property Index: integer read FIndex;
275	<	property Name: string read FName write SetName;
275	>	property Name: AnsiString read FName write SetName;
276		property CharSetID: cardinal read GetCharSetID write SetCharSetID;
277		property SQLType: cardinal read GetSQLType write SetSQLType;
278		property SQLSubtype: integer read GetSubtype;
279	<	property SQLData: PChar read GetSQLData;
279	>	property SQLData: PByte read GetSQLData;
280		property DataLength: cardinal read GetDataLength write SetDataLength;
281		property IsNull: Boolean read GetIsNull write SetIsNull;
282		property IsNullable: Boolean read GetIsNullable write SetIsNullable;
#	Line 300 | Line 298 | type
298		FChangeSeqNo: integer;
299		protected
300		procedure CheckActive; override;
301	<	function SQLData: PChar; override;
301	>	function SQLData: PByte; override;
302		function GetDataLength: cardinal; override;
303		function GetCodePage: TSystemCodePage; override;
304
#	Line 315 | Line 313 | type
313		function GetIndex: integer;
314		function GetSQLType: cardinal; override;
315		function getSubtype: integer;
316	<	function getRelationName: string;
317	<	function getOwnerName: string;
318	<	function getSQLName: string;    {Name of the column}
319	<	function getAliasName: string;  {Alias Name of column or Column Name if not alias}
320	<	function GetName: string; override;      {Disambiguated uppercase Field Name}
316	>	function getRelationName: AnsiString;
317	>	function getOwnerName: AnsiString;
318	>	function getSQLName: AnsiString;    {Name of the column}
319	>	function getAliasName: AnsiString;  {Alias Name of column or Column Name if not alias}
320	>	function GetName: AnsiString; override;      {Disambiguated uppercase Field Name}
321		function GetScale: integer; override;
322		function getCharSetID: cardinal; override;
323		function GetIsNullable: boolean; override;
324		function GetSize: cardinal;
325		function GetArrayMetaData: IArrayMetaData;
326		function GetBlobMetaData: IBlobMetaData;
327	<	property Name: string read GetName;
327	>	property Name: AnsiString read GetName;
328		property Size: cardinal read GetSize;
329		property CharSetID: cardinal read getCharSetID;
330		property SQLSubtype: integer read getSubtype;
#	Line 343 | Line 341 | type
341		function GetAsArray: IArray;
342		function GetAsBlob: IBlob; overload;
343		function GetAsBlob(BPB: IBPB): IBlob; overload;
344	<	function GetAsString: String; override;
344	>	function GetAsString: AnsiString; override;
345		property AsBlob: IBlob read GetAsBlob;
346		end;
347
#	Line 353 | Line 351 | type
351		protected
352		procedure CheckActive; override;
353		procedure Changed; override;
354	<	procedure InternalSetAsString(Value: String); override;
354	>	procedure InternalSetAsString(Value: AnsiString); override;
355		procedure SetScale(aValue: integer); override;
356		procedure SetDataLength(len: cardinal); override;
357		procedure SetSQLType(aValue: cardinal); override;
#	Line 361 | Line 359 | type
359		procedure Clear;
360		function GetModified: boolean; override;
361		function GetAsPointer: Pointer;
362	<	procedure SetName(Value: string); override;
362	>	procedure SetName(Value: AnsiString); override;
363		procedure SetIsNull(Value: Boolean);  override;
364		procedure SetIsNullable(Value: Boolean); override;
365		procedure SetAsArray(anArray: IArray);
#	Line 378 | Line 376 | type
376		procedure SetAsFloat(AValue: Float);
377		procedure SetAsPointer(AValue: Pointer);
378		procedure SetAsShort(AValue: Short);
379	<	procedure SetAsString(AValue: String); override;
379	>	procedure SetAsString(AValue: AnsiString); override;
380		procedure SetAsVariant(AValue: Variant);
381		procedure SetAsBlob(aValue: IBlob);
382		procedure SetAsQuad(AValue: TISC_QUAD);
#	Line 401 | Line 399 | type
399		destructor Destroy; override;
400		public
401		{IMetaData}
402	<	function GetUniqueRelationName: string;
402	>	function GetUniqueRelationName: AnsiString;
403		function getCount: integer;
404		function getColumnMetaData(index: integer): IColumnMetaData;
405	<	function ByName(Idx: String): IColumnMetaData;
405	>	function ByName(Idx: AnsiString): IColumnMetaData;
406		end;
407
408		{ TSQLParams }
#	Line 423 | Line 421 | type
421		{ISQLParams}
422		function getCount: integer;
423		function getSQLParam(index: integer): ISQLParam;
424	<	function ByName(Idx: String): ISQLParam ;
424	>	function ByName(Idx: AnsiString): ISQLParam ;
425		function GetModified: Boolean;
426		end;
427
#	Line 443 | Line 441 | type
441		constructor Create(aResults: TSQLDataArea);
442		{IResults}
443		function getCount: integer;
444	<	function ByName(Idx: String): ISQLData;
444	>	function ByName(Idx: AnsiString): ISQLData;
445		function getSQLData(index: integer): ISQLData;
446	<	procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PChar);
446	>	procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
447		function GetTransaction: ITransaction; virtual;
448		procedure SetRetainInterfaces(aValue: boolean);
449		end;
450
451		implementation
452
453	<	uses FBMessages, FBClientAPI, variants, IBUtils, FBTransaction;
453	>	uses FBMessages, variants, IBUtils, FBTransaction;
454	>
455	>	type
456	>
457	>	{ TSQLParamProcessor }
458	>
459	>	TSQLParamProcessor = class(TSQLwithNamedParamsTokeniser)
460	>	private
461	>	const
462	>	sIBXParam = 'IBXParam';  {do not localize}
463	>	private
464	>	FInString: AnsiString;
465	>	FIndex: integer;
466	>	function DoExecute(GenerateParamNames: boolean;
467	>	var slNames: TStrings): AnsiString;
468	>	protected
469	>	function GetChar: AnsiChar; override;
470	>	public
471	>	class function Execute(sSQL: AnsiString; GenerateParamNames: boolean;
472	>	var slNames: TStrings): AnsiString;
473	>	end;
474	>
475	>	{ TSQLParamProcessor }
476	>
477	>	function TSQLParamProcessor.DoExecute(GenerateParamNames: boolean;
478	>	var slNames: TStrings): AnsiString;
479	>	var token: TSQLTokens;
480	>	iParamSuffix: Integer;
481	>	begin
482	>	Result := '';
483	>	iParamSuffix := 0;
484	>
485	>	while not EOF do
486	>	begin
487	>	token := GetNextToken;
488	>	case token of
489	>	sqltParam,
490	>	sqltQuotedParam:
491	>	begin
492	>	Result := Result + '?';
493	>	slNames.Add(TokenText);
494	>	end;
495	>
496	>	sqltPlaceHolder:
497	>	if GenerateParamNames then
498	>	begin
499	>	Inc(iParamSuffix);
500	>	slNames.AddObject(sIBXParam + IntToStr(iParamSuffix),self); //Note local convention
501	>	//add pointer to self to mark entry
502	>	Result := Result + '?';
503	>	end
504	>	else
505	>	IBError(ibxeSQLParseError, [SParamNameExpected]);
506	>
507	>	sqltQuotedString:
508	>	Result := Result + '''' + SQLSafeString(TokenText) + '''';
509	>
510	>	sqltIdentifierInDoubleQuotes:
511	>	Result := Result + '"' + StringReplace(TokenText,'"','""',[rfReplaceAll]) + '"';
512	>
513	>	sqltComment:
514	>	Result := Result + '/*' + TokenText + '*/';
515	>
516	>	sqltCommentLine:
517	>	Result := Result + '//' + TokenText + LineEnding;
518	>
519	>	sqltEOL:
520	>	Result := Result + LineEnding;
521	>
522	>	else
523	>	Result := Result + TokenText;
524	>	end;
525	>	end;
526	>	end;
527	>
528	>	function TSQLParamProcessor.GetChar: AnsiChar;
529	>	begin
530	>	if FIndex <= Length(FInString) then
531	>	begin
532	>	Result := FInString[FIndex];
533	>	Inc(FIndex);
534	>	end
535	>	else
536	>	Result := #0;
537	>	end;
538	>
539	>	class function TSQLParamProcessor.Execute(sSQL: AnsiString;
540	>	GenerateParamNames: boolean; var slNames: TStrings): AnsiString;
541	>	begin
542	>	with self.Create do
543	>	try
544	>	FInString := sSQL;
545	>	FIndex := 1;
546	>	Result := DoExecute(GenerateParamNames,slNames);
547	>	finally
548	>	Free;
549	>	end;
550	>	end;
551	>
552
553		{ TSQLDataArea }
554
#	Line 472 | Line 568 | procedure TSQLDataArea.SetUniqueRelation
568		var
569		i: Integer;
570		bUnique: Boolean;
571	<	RelationName: string;
571	>	RelationName: AnsiString;
572		begin
573		bUnique := True;
574		for i := 0 to ColumnsInUseCount - 1 do
#	Line 503 | Line 599 | begin
599		Column[i].Initialize;
600		end;
601
602	<	procedure TSQLDataArea.PreprocessSQL(sSQL: string; GenerateParamNames: boolean;
603	<	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}
602	>	procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
603	>	var sProcessedSQL: AnsiString);
604
605	<	procedure AddToProcessedSQL(cChar: Char);
530	<	begin
531	<	StrBuffer[iSQLPos] := cChar;
532	<	Inc(iSQLPos);
533	<	end;
605	>	var slNames: TStrings;
606
607	<	begin
608	<	if not IsInputDataArea then
609	<	IBError(ibxeNotPermitted,[nil]);
610	<
611	<	sParamName := '';
540	<	iLenSQL := Length(sSQL);
541	<	GetMem(StrBuffer,iLenSQL + 1);
542	<	slNames := TStringList.Create;
543	<	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);
607	>	procedure SetColumnNames(slNames: TStrings);
608	>	var i, j: integer;
609	>	found: boolean;
610	>	begin
611	>	found := false;
612		SetCount(slNames.Count);
613		for i := 0 to slNames.Count - 1 do
614		begin
#	Line 705 | Line 629 | begin
629		Column[i].UniqueName := not found;
630		end;
631		end;
632	+	end;
633	+
634	+	begin
635	+	if not IsInputDataArea then
636	+	IBError(ibxeNotPermitted,[nil]);
637	+
638	+	slNames := TStringList.Create;
639	+	try
640	+	sProcessedSQL := TSQLParamProcessor.Execute(sSQL,GenerateParamNames,slNames);
641	+	SetColumnNames(slNames);
642		finally
643		slNames.Free;
710	–	FreeMem(StrBuffer);
644		end;
645		end;
646
#	Line 716 | Line 649 | begin
649		Result := Count;
650		end;
651
652	<	function TSQLDataArea.ColumnByName(Idx: string): TSQLVarData;
652	>	function TSQLDataArea.ColumnByName(Idx: AnsiString): TSQLVarData;
653		var
654	<	s: String;
654	>	s: AnsiString;
655		i: Integer;
656		begin
657		{$ifdef UseCaseInSensitiveParamName}
#	Line 736 | Line 669 | begin
669		end;
670
671		procedure TSQLDataArea.GetData(index: integer; var IsNull: boolean;
672	<	var len: short; var data: PChar);
672	>	var len: short; var data: PByte);
673		begin
674		//Do Nothing
675		end;
#	Line 755 | Line 688 | begin
688		Result := FParent.Statement;
689		end;
690
691	<	procedure TSQLVarData.SetName(AValue: string);
691	>	procedure TSQLVarData.SetName(AValue: AnsiString);
692		begin
693		if FName = AValue then Exit;
694		{$ifdef UseCaseInSensitiveParamName}
#	Line 774 | Line 707 | begin
707		FUniqueName := true;
708		end;
709
710	<	procedure TSQLVarData.SetString(aValue: string);
710	>	procedure TSQLVarData.SetString(aValue: AnsiString);
711		begin
712		{we take full advantage here of reference counted strings. When setting a string
713		value, a reference is kept in FVarString and a pointer to it placed in the
714	<	SQLVar. This avoids string copies. Note that PChar is guaranteed to point to
714	>	SQLVar. This avoids string copies. Note that PAnsiChar is guaranteed to point to
715		a zero byte when the string is empty, neatly avoiding a nil pointer error.}
716
717		FVarString := aValue;
718		SQLType := SQL_TEXT;
719	<	SetSQLData(PChar(FVarString),Length(aValue));
719	>	SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
720		end;
721
722		procedure TSQLVarData.Changed;
#	Line 799 | Line 732 | end;
732
733		procedure TSQLVarData.Initialize;
734
735	<	function FindVarByName(idx: string; limit: integer): TSQLVarData;
735	>	function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
736		var
737		k: integer;
738		begin
#	Line 814 | Line 747 | procedure TSQLVarData.Initialize;
747
748		var
749		j, j_len: Integer;
750	<	st: String;
751	<	sBaseName: string;
750	>	st: AnsiString;
751	>	sBaseName: AnsiString;
752		begin
753		RowChange;
754
#	Line 902 | Line 835 | function TSQLDataItem.AdjustScaleToCurre
835		var
836		Scaling : Int64;
837		i : Integer;
838	<	FractionText, PadText, CurrText: string;
838	>	FractionText, PadText, CurrText: AnsiString;
839		begin
840		Result := 0;
841		Scaling := 1;
#	Line 921 | Line 854 | begin
854		FractionText := IntToStr(abs(Value mod Scaling));
855		for i := Length(FractionText) to -aScale -1 do
856		PadText := '0' + PadText;
857	+	{$IF declared(DefaultFormatSettings)}
858	+	with DefaultFormatSettings do
859	+	{$ELSE}
860	+	{$IF declared(FormatSettings)}
861	+	with FormatSettings do
862	+	{$IFEND}
863	+	{$IFEND}
864		if Value < 0 then
865	<	CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DefaultFormatSettings.DecimalSeparator + PadText + FractionText
865	>	CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText
866		else
867	<	CurrText := IntToStr(Abs(Value div Scaling)) + DefaultFormatSettings.DecimalSeparator + PadText + FractionText;
867	>	CurrText := IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText;
868		try
869		result := StrToCurr(CurrText);
870		except
#	Line 1006 | Line 946 | begin
946		//Do nothing by default
947		end;
948
949	<	procedure TSQLDataItem.InternalSetAsString(Value: String);
949	>	procedure TSQLDataItem.InternalSetAsString(Value: AnsiString);
950		begin
951		//Do nothing by default
952		end;
953
954	<	function TSQLDataItem.Transliterate(s: string; CodePage: TSystemCodePage
954	>	function TSQLDataItem.Transliterate(s: AnsiString; CodePage: TSystemCodePage
955		): RawByteString;
956		begin
957		Result := s;
#	Line 1034 | Line 974 | begin
974		//Do nothing by default
975		end;
976
977	<	function TSQLDataItem.GetSQLTypeName: string;
977	>	constructor TSQLDataItem.Create(api: TFBClientAPI);
978	>	begin
979	>	inherited Create;
980	>	FFirebirdClientAPI := api;
981	>	end;
982	>
983	>	function TSQLDataItem.GetSQLTypeName: AnsiString;
984		begin
985		Result := GetSQLTypeName(GetSQLType);
986		end;
987
988	<	class function TSQLDataItem.GetSQLTypeName(SQLType: short): string;
988	>	class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
989		begin
990		Result := 'Unknown';
991		case SQLType of
#	Line 1140 | Line 1086 | begin
1086		CheckActive;
1087		result := 0;
1088		if not IsNull then
1089	<	with FirebirdClientAPI do
1089	>	with FFirebirdClientAPI do
1090		case SQLType of
1091		SQL_TEXT, SQL_VARYING: begin
1092		try
#	Line 1270 | Line 1216 | begin
1216		end;
1217
1218
1219	<	function TSQLDataItem.GetAsString: String;
1219	>	function TSQLDataItem.GetAsString: AnsiString;
1220		var
1221	<	sz: PChar;
1221	>	sz: PByte;
1222		str_len: Integer;
1223		rs: RawByteString;
1224		begin
#	Line 1280 | Line 1226 | begin
1226		result := '';
1227		{ Check null, if so return a default string }
1228		if not IsNull then
1229	<	with FirebirdClientAPI do
1229	>	with FFirebirdClientAPI do
1230		case SQLType of
1231		SQL_BOOLEAN:
1232		if AsBoolean then
#	Line 1297 | Line 1243 | begin
1243		str_len := DecodeInteger(SQLData, 2);
1244		Inc(sz, 2);
1245		end;
1246	<	SetString(rs, sz, str_len);
1246	>	SetString(rs, PAnsiChar(sz), str_len);
1247		SetCodePage(rs,GetCodePage,false);
1248		if (SQLType = SQL_TEXT) and (GetCharSetID <> 1) then
1249		Result := TrimRight(rs)
#	Line 1312 | Line 1258 | begin
1258		SQL_TYPE_TIME :
1259		result := TimeToStr(AsDateTime);
1260		SQL_TIMESTAMP:
1261	<	result := FormatDateTime(FormatSettings.ShortDateFormat + ' ' +
1262	<	FormatSettings.LongTimeFormat+'.zzz',AsDateTime);
1261	>	{$IF declared(DefaultFormatSettings)}
1262	>	with DefaultFormatSettings do
1263	>	{$ELSE}
1264	>	{$IF declared(FormatSettings)}
1265	>	with FormatSettings do
1266	>	{$IFEND}
1267	>	{$IFEND}
1268	>	result := FormatDateTime(ShortDateFormat + ' ' +
1269	>	LongTimeFormat+'.zzz',AsDateTime);
1270		SQL_SHORT, SQL_LONG:
1271		if Scale = 0 then
1272		result := IntToStr(AsLong)
#	Line 1400 | Line 1353 | begin
1353		//ignore unless overridden
1354		end;
1355
1356	<	procedure TSQLDataItem.SetName(aValue: string);
1356	>	procedure TSQLDataItem.SetName(aValue: AnsiString);
1357		begin
1358		//ignore unless overridden
1359		end;
#	Line 1452 | Line 1405 | begin
1405
1406		SQLType := SQL_TYPE_DATE;
1407		DataLength := SizeOf(ISC_DATE);
1408	<	with FirebirdClientAPI do
1408	>	with FFirebirdClientAPI do
1409		SQLEncodeDate(Value,SQLData);
1410		Changed;
1411		end;
#	Line 1472 | Line 1425 | begin
1425
1426		SQLType := SQL_TYPE_TIME;
1427		DataLength := SizeOf(ISC_TIME);
1428	<	with FirebirdClientAPI do
1428	>	with FFirebirdClientAPI do
1429		SQLEncodeTime(Value,SQLData);
1430		Changed;
1431		end;
#	Line 1486 | Line 1439 | begin
1439		Changing;
1440		SQLType := SQL_TIMESTAMP;
1441		DataLength := SizeOf(ISC_TIME) + sizeof(ISC_DATE);
1442	<	with FirebirdClientAPI do
1442	>	with FFirebirdClientAPI do
1443		SQLEncodeDateTime(Value,SQLData);
1444		Changed;
1445		end;
#	Line 1576 | Line 1529 | begin
1529		Changed;
1530		end;
1531
1532	<	procedure TSQLDataItem.SetAsString(Value: String);
1532	>	procedure TSQLDataItem.SetAsString(Value: AnsiString);
1533		begin
1534		InternalSetAsString(Value);
1535		end;
#	Line 1611 | Line 1564 | begin
1564		end;
1565		end;
1566
1567	+	procedure TSQLDataItem.SetAsNumeric(Value: Int64; aScale: integer);
1568	+	begin
1569	+	CheckActive;
1570	+	Changing;
1571	+	if IsNullable then
1572	+	IsNull := False;
1573	+
1574	+	SQLType := SQL_INT64;
1575	+	Scale := aScale;
1576	+	DataLength := SizeOf(Int64);
1577	+	PInt64(SQLData)^ := Value;
1578	+	Changed;
1579	+	end;
1580	+
1581		procedure TSQLDataItem.SetAsBoolean(AValue: boolean);
1582		begin
1583		CheckActive;
#	Line 1641 | Line 1608 | begin
1608		IBError(ibxeStatementNotPrepared, [nil]);
1609		end;
1610
1611	<	function TColumnMetaData.SQLData: PChar;
1611	>	function TColumnMetaData.SQLData: PByte;
1612		begin
1613		Result := FIBXSQLVAR.SQLData;
1614		end;
#	Line 1658 | Line 1625 | end;
1625
1626		constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
1627		begin
1628	<	inherited Create;
1628	>	inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
1629		FIBXSQLVAR := aIBXSQLVAR;
1630		FOwner := aOwner;
1631		FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
#	Line 1694 | Line 1661 | begin
1661		result := FIBXSQLVAR.SQLSubtype;
1662		end;
1663
1664	<	function TColumnMetaData.getRelationName: string;
1664	>	function TColumnMetaData.getRelationName: AnsiString;
1665		begin
1666		CheckActive;
1667		result :=  FIBXSQLVAR.RelationName;
1668		end;
1669
1670	<	function TColumnMetaData.getOwnerName: string;
1670	>	function TColumnMetaData.getOwnerName: AnsiString;
1671		begin
1672		CheckActive;
1673		result :=  FIBXSQLVAR.OwnerName;
1674		end;
1675
1676	<	function TColumnMetaData.getSQLName: string;
1676	>	function TColumnMetaData.getSQLName: AnsiString;
1677		begin
1678		CheckActive;
1679		result :=  FIBXSQLVAR.FieldName;
1680		end;
1681
1682	<	function TColumnMetaData.getAliasName: string;
1682	>	function TColumnMetaData.getAliasName: AnsiString;
1683		begin
1684		CheckActive;
1685		result := FIBXSQLVAR.AliasName;
1686		end;
1687
1688	<	function TColumnMetaData.GetName: string;
1688	>	function TColumnMetaData.GetName: AnsiString;
1689		begin
1690		CheckActive;
1691		Result := FIBXSQLVAR. Name;
#	Line 1803 | Line 1770 | begin
1770		result := FIBXSQLVAR.GetAsBlob(AsQuad,BPB);
1771		end;
1772
1773	<	function TIBSQLData.GetAsString: String;
1773	>	function TIBSQLData.GetAsString: AnsiString;
1774		begin
1775		CheckActive;
1776		Result := '';
#	Line 1821 | Line 1788 | end;
1788
1789		{ TSQLParam }
1790
1791	<	procedure TSQLParam.InternalSetAsString(Value: String);
1791	>	procedure TSQLParam.InternalSetAsString(Value: AnsiString);
1792		var b: IBlob;
1793	+	dt: TDateTime;
1794		begin
1795		CheckActive;
1796		if IsNullable then
1797		IsNull := False;
1798		case SQLTYPE of
1799		SQL_BOOLEAN:
1800	<	if CompareText(Value,STrue) = 0 then
1800	>	if AnsiCompareText(Value,STrue) = 0 then
1801		AsBoolean := true
1802		else
1803	<	if CompareText(Value,SFalse) = 0 then
1803	>	if AnsiCompareText(Value,SFalse) = 0 then
1804		AsBoolean := false
1805		else
1806		IBError(ibxeInvalidDataConversion,[nil]);
#	Line 1857 | Line 1825 | begin
1825		SQL_SHORT,
1826		SQL_LONG,
1827		SQL_INT64:
1828	<	SetAsInt64(StrToInt(Value));
1828	>	SetAsNumeric(AdjustScaleFromCurrency(StrToCurr(Value),GetScale),GetScale);
1829
1830		SQL_D_FLOAT,
1831		SQL_DOUBLE,
#	Line 1865 | Line 1833 | begin
1833		SetAsDouble(StrToFloat(Value));
1834
1835		SQL_TIMESTAMP:
1836	<	SetAsDateTime(StrToDateTime(Value));
1836	>	if TryStrToDateTime(Value,dt) then
1837	>	SetAsDateTime(dt)
1838	>	else
1839	>	FIBXSQLVar.SetString(Value);
1840
1841		SQL_TYPE_DATE:
1842	<	SetAsDate(StrToDateTime(Value));
1842	>	if TryStrToDateTime(Value,dt) then
1843	>	SetAsDate(dt)
1844	>	else
1845	>	FIBXSQLVar.SetString(Value);
1846
1847		SQL_TYPE_TIME:
1848	<	SetAsTime(StrToDateTime(Value));
1848	>	if TryStrToDateTime(Value,dt) then
1849	>	SetAsTime(dt)
1850	>	else
1851	>	FIBXSQLVar.SetString(Value);
1852
1853		else
1854		IBError(ibxeInvalidDataConversion,[nil]);
#	Line 1925 | Line 1902 | begin
1902		Result := inherited GetAsPointer;
1903		end;
1904
1905	<	procedure TSQLParam.SetName(Value: string);
1905	>	procedure TSQLParam.SetName(Value: AnsiString);
1906		begin
1907		CheckActive;
1908		FIBXSQLVAR.Name := Value;
#	Line 2231 | Line 2208 | begin
2208		end;
2209		end;
2210
2211	<	procedure TSQLParam.SetAsString(AValue: String);
2211	>	procedure TSQLParam.SetAsString(AValue: AnsiString);
2212		var i: integer;
2213		OldSQLVar: TSQLVarData;
2214		begin
#	Line 2344 | Line 2321 | begin
2321		inherited Destroy;
2322		end;
2323
2324	<	function TMetaData.GetUniqueRelationName: string;
2324	>	function TMetaData.GetUniqueRelationName: AnsiString;
2325		begin
2326		CheckActive;
2327		Result := FMetaData.UniqueRelationName;
#	Line 2372 | Line 2349 | begin
2349		end;
2350		end;
2351
2352	<	function TMetaData.ByName(Idx: String): IColumnMetaData;
2352	>	function TMetaData.ByName(Idx: AnsiString): IColumnMetaData;
2353		var aIBXSQLVAR: TSQLVarData;
2354		begin
2355		CheckActive;
#	Line 2432 | Line 2409 | begin
2409		end;
2410		end;
2411
2412	<	function TSQLParams.ByName(Idx: String): ISQLParam;
2412	>	function TSQLParams.ByName(Idx: AnsiString): ISQLParam;
2413		var aIBXSQLVAR: TSQLVarData;
2414		begin
2415		CheckActive;
#	Line 2500 | Line 2477 | begin
2477		Result := FResults.Count;
2478		end;
2479
2480	<	function TResults.ByName(Idx: String): ISQLData;
2480	>	function TResults.ByName(Idx: AnsiString): ISQLData;
2481		var col: TSQLVarData;
2482		begin
2483		Result := nil;
#	Line 2532 | Line 2509 | begin
2509		end;
2510
2511		procedure TResults.GetData(index: integer; var IsNull: boolean; var len: short;
2512	<	var data: PChar);
2512	>	var data: PByte);
2513		begin
2514		CheckActive;
2515		FResults.GetData(index,IsNull, len,data);
#	Line 2548 | Line 2525 | begin
2525		RetainInterfaces := aValue;
2526		end;
2527
2551	–
2528		end.
2529

Diff Legend

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