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 59 by tony, Mon Mar 13 09:51:56 2017 UTC vs.
Revision 270 by tony, Fri Jan 18 11:10:37 2019 UTC

# Line 76 | Line 76 | unit FBSQLData;
76    methods are needed for SQL parameters only. The string getters and setters
77    are virtual as SQLVar and Array encodings of string data is different.}
78  
79 { $define ALLOWDIALECT3PARAMNAMES}
80
81 {$ifndef ALLOWDIALECT3PARAMNAMES}
82
83 { Note on SQL Dialects and SQL Parameter Names
84  --------------------------------------------
85
86  Even when dialect 3 quoted format parameter names are not supported, IBX still processes
87  parameter names case insensitive. This does result in some additional overhead
88  due to a call to "AnsiUpperCase". This can be avoided by undefining
89  "UseCaseInSensitiveParamName" below.
90
91  Note: do not define "UseCaseSensitiveParamName" when "ALLOWDIALECT3PARAMNAMES"
92  is defined. This will not give a useful result.
93 }
94 {$define UseCaseInSensitiveParamName}
95 {$endif}
79  
80   interface
81  
82   uses
83 <  Classes, SysUtils, IBExternals, IBHeader, IB,  FBActivityMonitor;
83 >  Classes, SysUtils, IBExternals, IBHeader, IB,  FBActivityMonitor, FBClientAPI;
84  
85   type
86  
# Line 105 | Line 88 | type
88  
89    TSQLDataItem = class(TFBInterfacedObject)
90    private
91 +     FFirebirdClientAPI: TFBClientAPI;
92       function AdjustScale(Value: Int64; aScale: Integer): Double;
93       function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
94       function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
95 +     function GetTimestampFormatStr: AnsiString;
96 +     function GetDateFormatStr(IncludeTime: boolean): AnsiString;
97 +     function GetTimeFormatStr: AnsiString;
98       procedure SetAsInteger(AValue: Integer);
99    protected
100       function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
# Line 128 | Line 115 | type
115       property DataLength: cardinal read GetDataLength write SetDataLength;
116  
117    public
118 +     constructor Create(api: TFBClientAPI);
119       function GetSQLType: cardinal; virtual; abstract;
120       function GetSQLTypeName: AnsiString; overload;
121       class function GetSQLTypeName(SQLType: short): AnsiString; overload;
# Line 145 | Line 133 | type
133       function GetAsShort: short;
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 196 | Line 185 | type
185  
186    TSQLDataArea = class
187    private
188 +    FCaseSensitiveParams: boolean;
189      function GetColumn(index: integer): TSQLVarData;
190      function GetCount: integer;
191    protected
# Line 218 | Line 208 | type
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: AnsiString read FUniqueRelationName;
# Line 456 | Line 448 | type
448  
449   implementation
450  
451 < uses FBMessages, FBClientAPI, variants, IBUtils, FBTransaction;
460 <
451 > uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
452  
453   { TSQLDataArea }
454  
# Line 510 | Line 501 | end;
501  
502   procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
503    var sProcessedSQL: AnsiString);
513 var
514  cCurChar, cNextChar, cQuoteChar: AnsiChar;
515  sParamName: AnsiString;
516  j, i, iLenSQL, iSQLPos: Integer;
517  iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
518  iParamSuffix: Integer;
519  slNames: TStrings;
520  StrBuffer: PByte;
521  found: boolean;
522
523 const
524  DefaultState = 0;
525  CommentState = 1;
526  QuoteState = 2;
527  ParamState = 3;
528  ArrayDimState = 4;
529 {$ifdef ALLOWDIALECT3PARAMNAMES}
530  ParamDefaultState = 0;
531  ParamQuoteState = 1;
532  {$endif}
504  
505 <  procedure AddToProcessedSQL(cChar: AnsiChar);
535 <  begin
536 <    StrBuffer[iSQLPos] := byte(cChar);
537 <    Inc(iSQLPos);
538 <  end;
539 <
540 < begin
541 <  if not IsInputDataArea then
542 <    IBError(ibxeNotPermitted,[nil]);
543 <
544 <  sParamName := '';
545 <  iLenSQL := Length(sSQL);
546 <  GetMem(StrBuffer,iLenSQL + 1);
547 <  slNames := TStringList.Create;
548 <  try
549 <    { Do some initializations of variables }
550 <    iParamSuffix := 0;
551 <    cQuoteChar := '''';
552 <    i := 1;
553 <    iSQLPos := 0;
554 <    iCurState := DefaultState;
555 <    {$ifdef ALLOWDIALECT3PARAMNAMES}
556 <    iCurParamState := ParamDefaultState;
557 <    {$endif}
558 <    { Now, traverse through the SQL string, character by character,
559 <     picking out the parameters and formatting correctly for InterBase }
560 <    while (i <= iLenSQL) do begin
561 <      { Get the current token and a look-ahead }
562 <      cCurChar := sSQL[i];
563 <      if i = iLenSQL then
564 <        cNextChar := #0
565 <      else
566 <        cNextChar := sSQL[i + 1];
567 <      { Now act based on the current state }
568 <      case iCurState of
569 <        DefaultState:
570 <        begin
571 <          case cCurChar of
572 <            '''', '"':
573 <            begin
574 <              cQuoteChar := cCurChar;
575 <              iCurState := QuoteState;
576 <            end;
577 <            '?', ':':
578 <            begin
579 <              iCurState := ParamState;
580 <              AddToProcessedSQL('?');
581 <            end;
582 <            '/': if (cNextChar = '*') then
583 <            begin
584 <              AddToProcessedSQL(cCurChar);
585 <              Inc(i);
586 <              iCurState := CommentState;
587 <            end;
588 <            '[':
589 <            begin
590 <              AddToProcessedSQL(cCurChar);
591 <              Inc(i);
592 <              iCurState := ArrayDimState;
593 <            end;
594 <          end;
595 <        end;
596 <
597 <        ArrayDimState:
598 <        begin
599 <          case cCurChar of
600 <          ':',',','0'..'9',' ',#9,#10,#13:
601 <            begin
602 <              AddToProcessedSQL(cCurChar);
603 <              Inc(i);
604 <            end;
605 <          else
606 <            begin
607 <              AddToProcessedSQL(cCurChar);
608 <              Inc(i);
609 <              iCurState := DefaultState;
610 <            end;
611 <          end;
612 <        end;
505 > var slNames: TStrings;
506  
507 <        CommentState:
508 <        begin
509 <          if (cNextChar = #0) then
510 <            IBError(ibxeSQLParseError, [SEOFInComment])
511 <          else if (cCurChar = '*') then begin
619 <            if (cNextChar = '/') then
620 <              iCurState := DefaultState;
621 <          end;
622 <        end;
623 <        QuoteState: begin
624 <          if cNextChar = #0 then
625 <            IBError(ibxeSQLParseError, [SEOFInString])
626 <          else if (cCurChar = cQuoteChar) then begin
627 <            if (cNextChar = cQuoteChar) then begin
628 <              AddToProcessedSQL(cCurChar);
629 <              Inc(i);
630 <            end else
631 <              iCurState := DefaultState;
632 <          end;
633 <        end;
634 <        ParamState:
635 <        begin
636 <          { collect the name of the parameter }
637 <          {$ifdef ALLOWDIALECT3PARAMNAMES}
638 <          if iCurParamState = ParamDefaultState then
639 <          begin
640 <            if cCurChar = '"' then
641 <              iCurParamState := ParamQuoteState
642 <            else
643 <            {$endif}
644 <            if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
645 <                sParamName := sParamName + cCurChar
646 <            else if GenerateParamNames then
647 <            begin
648 <              sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
649 <              Inc(iParamSuffix);
650 <              iCurState := DefaultState;
651 <              slNames.AddObject(sParamName,self); //Note local convention
652 <                                                  //add pointer to self to mark entry
653 <              sParamName := '';
654 <            end
655 <            else
656 <              IBError(ibxeSQLParseError, [SParamNameExpected]);
657 <          {$ifdef ALLOWDIALECT3PARAMNAMES}
658 <          end
659 <          else begin
660 <            { determine if Quoted parameter name is finished }
661 <            if cCurChar = '"' then
662 <            begin
663 <              Inc(i);
664 <              slNames.Add(sParamName);
665 <              SParamName := '';
666 <              iCurParamState := ParamDefaultState;
667 <              iCurState := DefaultState;
668 <            end
669 <            else
670 <              sParamName := sParamName + cCurChar
671 <          end;
672 <          {$endif}
673 <          { determine if the unquoted parameter name is finished }
674 <          if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
675 <            (iCurState <> DefaultState) then
676 <          begin
677 <            if not (cNextChar in ['A'..'Z', 'a'..'z',
678 <                                  '0'..'9', '_', '$']) then begin
679 <              Inc(i);
680 <              iCurState := DefaultState;
681 <              slNames.Add(sParamName);
682 <              sParamName := '';
683 <            end;
684 <          end;
685 <        end;
686 <      end;
687 <      if (iCurState <> ParamState) and (i <= iLenSQL) then
688 <        AddToProcessedSQL(sSQL[i]);
689 <      Inc(i);
690 <    end;
691 <    AddToProcessedSQL(#0);
692 <    sProcessedSQL := strpas(PAnsiChar(StrBuffer));
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 710 | 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;
715    FreeMem(StrBuffer);
544    end;
545   end;
546  
# Line 726 | Line 554 | var
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 762 | Line 590 | end;
590  
591   procedure TSQLVarData.SetName(AValue: AnsiString);
592   begin
593 <  if FName = AValue then Exit;
766 <  {$ifdef UseCaseInSensitiveParamName}
767 <  if Parent.IsInputDataArea then
593 >  if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
594      FName := AnsiUpperCase(AValue)
595    else
770  {$endif}
596      FName := AValue;
597   end;
598  
# Line 788 | Line 613 | begin
613  
614    FVarString := aValue;
615    SQLType := SQL_TEXT;
616 +  Scale := 0;
617    SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
618   end;
619  
# Line 948 | 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 1046 | Line 916 | begin
916     //Do nothing by default
917   end;
918  
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);
# Line 1152 | 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 1292 | 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 1317 | Line 1193 | begin
1193            Result := rs
1194        end;
1195        SQL_TYPE_DATE:
1196 <        case GetSQLDialect of
1321 <          1 : result := DateTimeToStr(AsDateTime);
1322 <          3 : result := DateToStr(AsDateTime);
1323 <        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 <      {$IF declared(DefaultFormatSettings)}
1328 <      with DefaultFormatSettings do
1329 <      {$ELSE}
1330 <      {$IF declared(FormatSettings)}
1331 <      with FormatSettings do
1332 <      {$IFEND}
1333 <      {$IFEND}
1334 <        result := FormatDateTime(ShortDateFormat + ' ' +
1335 <                            LongTimeFormat+'.zzz',AsDateTime);
1200 >        result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1201        SQL_SHORT, SQL_LONG:
1202          if Scale = 0 then
1203            result := IntToStr(AsLong)
# Line 1360 | 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 1408 | 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 1471 | 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 1491 | 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 1505 | 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 1691 | 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 1855 | Line 1735 | end;
1735   { TSQLParam }
1736  
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
# Line 1882 | Line 1772 | begin
1772  
1773    SQL_VARYING,
1774    SQL_TEXT:
1775 <    begin
1886 <      Changing;
1887 <      FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1888 <      Changed;
1889 <    end;
1775 >    DoSetString;
1776  
1777      SQL_SHORT,
1778      SQL_LONG,
1779      SQL_INT64:
1780 <      SetAsNumeric(AdjustScaleFromCurrency(StrToCurr(Value),GetScale),GetScale);
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        if TryStrToDateTime(Value,dt) then
1795          SetAsDateTime(dt)
1796        else
1797 <        FIBXSQLVar.SetString(Value);
1797 >        DoSetString;
1798  
1799      SQL_TYPE_DATE:
1800        if TryStrToDateTime(Value,dt) then
1801          SetAsDate(dt)
1802        else
1803 <        FIBXSQLVar.SetString(Value);
1803 >        DoSetString;
1804  
1805      SQL_TYPE_TIME:
1806        if TryStrToDateTime(Value,dt) then
1807          SetAsTime(dt)
1808        else
1809 <        FIBXSQLVar.SetString(Value);
1809 >        DoSetString;
1810  
1811      else
1812        IBError(ibxeInvalidDataConversion,[nil]);

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines