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

Comparing ibx/trunk/fbintf/client/FBSQLData.pas (file contents):
Revision 263 by tony, Thu Dec 6 15:55:01 2018 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 { Note on SQL Parameter Names
80  --------------------------------------------
81
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
86 }
87 {$define UseCaseInSensitiveParamName}
79  
80   interface
81  
# Line 101 | Line 92 | type
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 142 | Line 136 | type
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 190 | 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 212 | 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 450 | Line 448 | type
448  
449   implementation
450  
451 < 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 <
451 > uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
452  
453   { TSQLDataArea }
454  
# Line 654 | 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 690 | Line 590 | end;
590  
591   procedure TSQLVarData.SetName(AValue: AnsiString);
592   begin
593 <  if FName = AValue then Exit;
694 <  {$ifdef UseCaseInSensitiveParamName}
695 <  if Parent.IsInputDataArea then
593 >  if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
594      FName := AnsiUpperCase(AValue)
595    else
698  {$endif}
596      FName := AValue;
597   end;
598  
# Line 716 | 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 876 | 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 1251 | Line 1193 | begin
1193            Result := rs
1194        end;
1195        SQL_TYPE_DATE:
1196 <        case GetSQLDialect of
1255 <          1 : result := DateTimeToStr(AsDateTime);
1256 <          3 : result := DateToStr(AsDateTime);
1257 <        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)}
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);
1200 >        result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1201        SQL_SHORT, SQL_LONG:
1202          if Scale = 0 then
1203            result := IntToStr(AsLong)
# Line 1294 | 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 1342 | 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 1789 | 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 1816 | Line 1772 | begin
1772  
1773    SQL_VARYING,
1774    SQL_TEXT:
1775 <    begin
1820 <      Changing;
1821 <      FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1822 <      Changed;
1823 <    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