ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/FBSQLData.pas
(Generate patch)

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