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 287 by tony, Thu Apr 11 08:51:23 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 423 | Line 421 | type
421      function getSQLParam(index: integer): ISQLParam;
422      function ByName(Idx: AnsiString): ISQLParam ;
423      function GetModified: Boolean;
424 +    function GetHasCaseSensitiveParams: Boolean;
425    end;
426  
427    { TResults }
# Line 450 | Line 449 | type
449  
450   implementation
451  
452 < 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 <
452 > uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
453  
454   { TSQLDataArea }
455  
# Line 654 | Line 555 | var
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 690 | Line 591 | end;
591  
592   procedure TSQLVarData.SetName(AValue: AnsiString);
593   begin
594 <  if FName = AValue then Exit;
694 <  {$ifdef UseCaseInSensitiveParamName}
695 <  if Parent.IsInputDataArea then
594 >  if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
595      FName := AnsiUpperCase(AValue)
596    else
698  {$endif}
597      FName := AValue;
598   end;
599  
# Line 716 | Line 614 | begin
614  
615    FVarString := aValue;
616    SQLType := SQL_TEXT;
617 +  Scale := 0;
618    SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
619   end;
620  
# Line 876 | 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 1251 | Line 1194 | begin
1194            Result := rs
1195        end;
1196        SQL_TYPE_DATE:
1197 <        case GetSQLDialect of
1255 <          1 : result := DateTimeToStr(AsDateTime);
1256 <          3 : result := DateToStr(AsDateTime);
1257 <        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 <      {$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);
1201 >        result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1202        SQL_SHORT, SQL_LONG:
1203          if Scale = 0 then
1204            result := IntToStr(AsLong)
# Line 1294 | 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 1342 | 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 1789 | Line 1736 | end;
1736   { TSQLParam }
1737  
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
# Line 1816 | Line 1773 | begin
1773  
1774    SQL_VARYING,
1775    SQL_TEXT:
1776 <    begin
1820 <      Changing;
1821 <      FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1822 <      Changed;
1823 <    end;
1776 >    DoSetString;
1777  
1778      SQL_SHORT,
1779      SQL_LONG,
1780      SQL_INT64:
1781 <      SetAsNumeric(AdjustScaleFromCurrency(StrToCurr(Value),GetScale),GetScale);
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        if TryStrToDateTime(Value,dt) then
1796          SetAsDateTime(dt)
1797        else
1798 <        FIBXSQLVar.SetString(Value);
1798 >        DoSetString;
1799  
1800      SQL_TYPE_DATE:
1801        if TryStrToDateTime(Value,dt) then
1802          SetAsDate(dt)
1803        else
1804 <        FIBXSQLVar.SetString(Value);
1804 >        DoSetString;
1805  
1806      SQL_TYPE_TIME:
1807        if TryStrToDateTime(Value,dt) then
1808          SetAsTime(dt)
1809        else
1810 <        FIBXSQLVar.SetString(Value);
1810 >        DoSetString;
1811  
1812      else
1813        IBError(ibxeInvalidDataConversion,[nil]);
# Line 2434 | 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;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines