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 56 by tony, Mon Mar 6 10:20:02 2017 UTC vs.
Revision 291 by tony, Fri Apr 17 10:26:08 2020 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;
122 +     function GetStrDataLength: short;
123       function GetName: AnsiString; virtual; abstract;
124       function GetScale: integer; virtual; abstract;
125       function GetAsBoolean: boolean;
# Line 145 | Line 134 | type
134       function GetAsShort: short;
135       function GetAsString: AnsiString; virtual;
136       function GetIsNull: Boolean; virtual;
137 <     function getIsNullable: boolean; virtual;
137 >     function GetIsNullable: boolean; virtual;
138       function GetAsVariant: Variant;
139       function GetModified: boolean; virtual;
140 +     function GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats): integer;
141       procedure SetAsBoolean(AValue: boolean); virtual;
142       procedure SetAsCurrency(Value: Currency); virtual;
143       procedure SetAsInt64(Value: Int64); virtual;
# Line 162 | Line 152 | type
152       procedure SetAsShort(Value: short); virtual;
153       procedure SetAsString(Value: AnsiString); virtual;
154       procedure SetAsVariant(Value: Variant);
155 +     procedure SetAsNumeric(Value: Int64; aScale: integer);
156       procedure SetIsNull(Value: Boolean); virtual;
157       procedure SetIsNullable(Value: Boolean); virtual;
158       procedure SetName(aValue: AnsiString); virtual;
# Line 195 | Line 186 | type
186  
187    TSQLDataArea = class
188    private
189 +    FCaseSensitiveParams: boolean;
190      function GetColumn(index: integer): TSQLVarData;
191      function GetCount: integer;
192    protected
# Line 217 | Line 209 | type
209        var data: PByte); virtual;
210      procedure RowChange;
211      function StateChanged(var ChangeSeqNo: integer): boolean; virtual; abstract;
212 +    property CaseSensitiveParams: boolean read FCaseSensitiveParams
213 +                                            write FCaseSensitiveParams; {Only used when IsInputDataArea true}
214      property Count: integer read GetCount;
215      property Column[index: integer]: TSQLVarData read GetColumn;
216      property UniqueRelationName: AnsiString read FUniqueRelationName;
# Line 299 | Line 293 | type
293      FIBXSQLVAR: TSQLVarData;
294      FOwner: IUnknown;         {Keep reference to ensure Metadata/statement not discarded}
295      FPrepareSeqNo: integer;
302    FStatement: IStatement;
296      FChangeSeqNo: integer;
297    protected
298      procedure CheckActive; override;
# Line 311 | Line 304 | type
304      constructor Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
305      destructor Destroy; override;
306      function GetSQLDialect: integer; override;
314    property Statement: IStatement read FStatement;
307  
308    public
309      {IColumnMetaData}
# Line 329 | Line 321 | type
321      function GetSize: cardinal;
322      function GetArrayMetaData: IArrayMetaData;
323      function GetBlobMetaData: IBlobMetaData;
324 +    function GetStatement: IStatement;
325 +    function GetTransaction: ITransaction; virtual;
326      property Name: AnsiString read GetName;
327      property Size: cardinal read GetSize;
328      property CharSetID: cardinal read getCharSetID;
329      property SQLSubtype: integer read getSubtype;
330      property IsNullable: Boolean read GetIsNullable;
331 +  public
332 +    property Statement: IStatement read GetStatement;
333    end;
334  
335    { TIBSQLData }
336  
337    TIBSQLData = class(TColumnMetaData,ISQLData)
338 +  private
339 +    FTransaction: ITransaction;
340    protected
341      procedure CheckActive; override;
342    public
343 +    function GetTransaction: ITransaction; override;
344      function GetIsNull: Boolean; override;
345      function GetAsArray: IArray;
346      function GetAsBlob: IBlob; overload;
# Line 428 | Line 427 | type
427      function getSQLParam(index: integer): ISQLParam;
428      function ByName(Idx: AnsiString): ISQLParam ;
429      function GetModified: Boolean;
430 +    function GetHasCaseSensitiveParams: Boolean;
431    end;
432  
433    { TResults }
# Line 449 | Line 449 | type
449       function ByName(Idx: AnsiString): ISQLData;
450       function getSQLData(index: integer): ISQLData;
451       procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
452 +     function GetStatement: IStatement;
453       function GetTransaction: ITransaction; virtual;
454       procedure SetRetainInterfaces(aValue: boolean);
455   end;
456  
457   implementation
458  
459 < uses FBMessages, FBClientAPI, variants, IBUtils, FBTransaction;
459 <
459 > uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
460  
461   { TSQLDataArea }
462  
# Line 509 | Line 509 | end;
509  
510   procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
511    var sProcessedSQL: AnsiString);
512 var
513  cCurChar, cNextChar, cQuoteChar: AnsiChar;
514  sParamName: AnsiString;
515  j, i, iLenSQL, iSQLPos: Integer;
516  iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
517  iParamSuffix: Integer;
518  slNames: TStrings;
519  StrBuffer: PByte;
520  found: boolean;
521
522 const
523  DefaultState = 0;
524  CommentState = 1;
525  QuoteState = 2;
526  ParamState = 3;
527  ArrayDimState = 4;
528 {$ifdef ALLOWDIALECT3PARAMNAMES}
529  ParamDefaultState = 0;
530  ParamQuoteState = 1;
531  {$endif}
532
533  procedure AddToProcessedSQL(cChar: AnsiChar);
534  begin
535    StrBuffer[iSQLPos] := byte(cChar);
536    Inc(iSQLPos);
537  end;
538
539 begin
540  if not IsInputDataArea then
541    IBError(ibxeNotPermitted,[nil]);
512  
513 <  sParamName := '';
544 <  iLenSQL := Length(sSQL);
545 <  GetMem(StrBuffer,iLenSQL + 1);
546 <  slNames := TStringList.Create;
547 <  try
548 <    { Do some initializations of variables }
549 <    iParamSuffix := 0;
550 <    cQuoteChar := '''';
551 <    i := 1;
552 <    iSQLPos := 0;
553 <    iCurState := DefaultState;
554 <    {$ifdef ALLOWDIALECT3PARAMNAMES}
555 <    iCurParamState := ParamDefaultState;
556 <    {$endif}
557 <    { Now, traverse through the SQL string, character by character,
558 <     picking out the parameters and formatting correctly for InterBase }
559 <    while (i <= iLenSQL) do begin
560 <      { Get the current token and a look-ahead }
561 <      cCurChar := sSQL[i];
562 <      if i = iLenSQL then
563 <        cNextChar := #0
564 <      else
565 <        cNextChar := sSQL[i + 1];
566 <      { Now act based on the current state }
567 <      case iCurState of
568 <        DefaultState:
569 <        begin
570 <          case cCurChar of
571 <            '''', '"':
572 <            begin
573 <              cQuoteChar := cCurChar;
574 <              iCurState := QuoteState;
575 <            end;
576 <            '?', ':':
577 <            begin
578 <              iCurState := ParamState;
579 <              AddToProcessedSQL('?');
580 <            end;
581 <            '/': if (cNextChar = '*') then
582 <            begin
583 <              AddToProcessedSQL(cCurChar);
584 <              Inc(i);
585 <              iCurState := CommentState;
586 <            end;
587 <            '[':
588 <            begin
589 <              AddToProcessedSQL(cCurChar);
590 <              Inc(i);
591 <              iCurState := ArrayDimState;
592 <            end;
593 <          end;
594 <        end;
513 > var slNames: TStrings;
514  
515 <        ArrayDimState:
516 <        begin
517 <          case cCurChar of
518 <          ':',',','0'..'9',' ',#9,#10,#13:
519 <            begin
601 <              AddToProcessedSQL(cCurChar);
602 <              Inc(i);
603 <            end;
604 <          else
605 <            begin
606 <              AddToProcessedSQL(cCurChar);
607 <              Inc(i);
608 <              iCurState := DefaultState;
609 <            end;
610 <          end;
611 <        end;
612 <
613 <        CommentState:
614 <        begin
615 <          if (cNextChar = #0) then
616 <            IBError(ibxeSQLParseError, [SEOFInComment])
617 <          else if (cCurChar = '*') then begin
618 <            if (cNextChar = '/') then
619 <              iCurState := DefaultState;
620 <          end;
621 <        end;
622 <        QuoteState: begin
623 <          if cNextChar = #0 then
624 <            IBError(ibxeSQLParseError, [SEOFInString])
625 <          else if (cCurChar = cQuoteChar) then begin
626 <            if (cNextChar = cQuoteChar) then begin
627 <              AddToProcessedSQL(cCurChar);
628 <              Inc(i);
629 <            end else
630 <              iCurState := DefaultState;
631 <          end;
632 <        end;
633 <        ParamState:
634 <        begin
635 <          { collect the name of the parameter }
636 <          {$ifdef ALLOWDIALECT3PARAMNAMES}
637 <          if iCurParamState = ParamDefaultState then
638 <          begin
639 <            if cCurChar = '"' then
640 <              iCurParamState := ParamQuoteState
641 <            else
642 <            {$endif}
643 <            if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
644 <                sParamName := sParamName + cCurChar
645 <            else if GenerateParamNames then
646 <            begin
647 <              sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
648 <              Inc(iParamSuffix);
649 <              iCurState := DefaultState;
650 <              slNames.AddObject(sParamName,self); //Note local convention
651 <                                                  //add pointer to self to mark entry
652 <              sParamName := '';
653 <            end
654 <            else
655 <              IBError(ibxeSQLParseError, [SParamNameExpected]);
656 <          {$ifdef ALLOWDIALECT3PARAMNAMES}
657 <          end
658 <          else begin
659 <            { determine if Quoted parameter name is finished }
660 <            if cCurChar = '"' then
661 <            begin
662 <              Inc(i);
663 <              slNames.Add(sParamName);
664 <              SParamName := '';
665 <              iCurParamState := ParamDefaultState;
666 <              iCurState := DefaultState;
667 <            end
668 <            else
669 <              sParamName := sParamName + cCurChar
670 <          end;
671 <          {$endif}
672 <          { determine if the unquoted parameter name is finished }
673 <          if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
674 <            (iCurState <> DefaultState) then
675 <          begin
676 <            if not (cNextChar in ['A'..'Z', 'a'..'z',
677 <                                  '0'..'9', '_', '$']) then begin
678 <              Inc(i);
679 <              iCurState := DefaultState;
680 <              slNames.Add(sParamName);
681 <              sParamName := '';
682 <            end;
683 <          end;
684 <        end;
685 <      end;
686 <      if (iCurState <> ParamState) and (i <= iLenSQL) then
687 <        AddToProcessedSQL(sSQL[i]);
688 <      Inc(i);
689 <    end;
690 <    AddToProcessedSQL(#0);
691 <    sProcessedSQL := strpas(PAnsiChar(StrBuffer));
515 >  procedure SetColumnNames(slNames: TStrings);
516 >  var i, j: integer;
517 >      found: boolean;
518 >  begin
519 >    found := false;
520      SetCount(slNames.Count);
521      for i := 0 to slNames.Count - 1 do
522      begin
# Line 709 | Line 537 | begin
537          Column[i].UniqueName := not found;
538        end;
539      end;
540 +  end;
541 +
542 + begin
543 +  if not IsInputDataArea then
544 +    IBError(ibxeNotPermitted,[nil]);
545 +
546 +  slNames := TStringList.Create;
547 +  try
548 +    sProcessedSQL := TSQLParamProcessor.Execute(sSQL,GenerateParamNames,slNames);
549 +    SetColumnNames(slNames);
550    finally
551      slNames.Free;
714    FreeMem(StrBuffer);
552    end;
553   end;
554  
# Line 725 | Line 562 | var
562    s: AnsiString;
563    i: Integer;
564   begin
565 <  {$ifdef UseCaseInSensitiveParamName}
566 <   s := AnsiUpperCase(Idx);
567 <  {$else}
565 >  if not IsInputDataArea or not CaseSensitiveParams then
566 >   s := AnsiUpperCase(Idx)
567 >  else
568     s := Idx;
569 <  {$endif}
569 >
570    for i := 0 to Count - 1 do
571      if Column[i].Name = s then
572      begin
# Line 761 | Line 598 | end;
598  
599   procedure TSQLVarData.SetName(AValue: AnsiString);
600   begin
601 <  if FName = AValue then Exit;
765 <  {$ifdef UseCaseInSensitiveParamName}
766 <  if Parent.IsInputDataArea then
601 >  if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
602      FName := AnsiUpperCase(AValue)
603    else
769  {$endif}
604      FName := AValue;
605   end;
606  
# Line 787 | Line 621 | begin
621  
622    FVarString := aValue;
623    SQLType := SQL_TEXT;
624 +  Scale := 0;
625    SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
626   end;
627  
# Line 947 | Line 782 | begin
782        result := Value;
783   end;
784  
785 + function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
786 + begin
787 +  {$IF declared(DefaultFormatSettings)}
788 +  with DefaultFormatSettings do
789 +  {$ELSE}
790 +  {$IF declared(FormatSettings)}
791 +  with FormatSettings do
792 +  {$IFEND}
793 +  {$IFEND}
794 +  case GetSQLDialect of
795 +    1:
796 +      if IncludeTime then
797 +        result := ShortDateFormat + ' ' + LongTimeFormat
798 +      else
799 +        result := ShortDateFormat;
800 +    3:
801 +      result := ShortDateFormat;
802 +  end;
803 + end;
804 +
805 + function TSQLDataItem.GetTimeFormatStr: AnsiString;
806 + begin
807 +  {$IF declared(DefaultFormatSettings)}
808 +  with DefaultFormatSettings do
809 +  {$ELSE}
810 +  {$IF declared(FormatSettings)}
811 +  with FormatSettings do
812 +  {$IFEND}
813 +  {$IFEND}
814 +    Result := LongTimeFormat;
815 + end;
816 +
817 + function TSQLDataItem.GetTimestampFormatStr: AnsiString;
818 + begin
819 +  {$IF declared(DefaultFormatSettings)}
820 +  with DefaultFormatSettings do
821 +  {$ELSE}
822 +  {$IF declared(FormatSettings)}
823 +  with FormatSettings do
824 +  {$IFEND}
825 +  {$IFEND}
826 +    Result := ShortDateFormat + ' ' +  LongTimeFormat + '.zzz';
827 + end;
828 +
829   procedure TSQLDataItem.SetAsInteger(AValue: Integer);
830   begin
831    SetAsLong(aValue);
# Line 1045 | Line 924 | begin
924     //Do nothing by default
925   end;
926  
927 + constructor TSQLDataItem.Create(api: TFBClientAPI);
928 + begin
929 +  inherited Create;
930 +  FFirebirdClientAPI := api;
931 + end;
932 +
933   function TSQLDataItem.GetSQLTypeName: AnsiString;
934   begin
935    Result := GetSQLTypeName(GetSQLType);
# Line 1071 | Line 956 | begin
956    end;
957   end;
958  
959 + function TSQLDataItem.GetStrDataLength: short;
960 + begin
961 +  with FFirebirdClientAPI do
962 +  if SQLType = SQL_VARYING then
963 +    Result := DecodeInteger(SQLData, 2)
964 +  else
965 +    Result := DataLength;
966 + end;
967 +
968   function TSQLDataItem.GetAsBoolean: boolean;
969   begin
970    CheckActive;
# Line 1151 | Line 1045 | begin
1045    CheckActive;
1046    result := 0;
1047    if not IsNull then
1048 <    with FirebirdClientAPI do
1048 >    with FFirebirdClientAPI do
1049      case SQLType of
1050        SQL_TEXT, SQL_VARYING: begin
1051          try
# Line 1291 | Line 1185 | begin
1185    result := '';
1186    { Check null, if so return a default string }
1187    if not IsNull then
1188 <  with FirebirdClientAPI do
1188 >  with FFirebirdClientAPI do
1189      case SQLType of
1190        SQL_BOOLEAN:
1191          if AsBoolean then
# Line 1316 | Line 1210 | begin
1210            Result := rs
1211        end;
1212        SQL_TYPE_DATE:
1213 <        case GetSQLDialect of
1320 <          1 : result := DateTimeToStr(AsDateTime);
1321 <          3 : result := DateToStr(AsDateTime);
1322 <        end;
1213 >        result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1214        SQL_TYPE_TIME :
1215 <        result := TimeToStr(AsDateTime);
1215 >        result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1216        SQL_TIMESTAMP:
1217 <      {$IF declared(DefaultFormatSettings)}
1327 <      with DefaultFormatSettings do
1328 <      {$ELSE}
1329 <      {$IF declared(FormatSettings)}
1330 <      with FormatSettings do
1331 <      {$IFEND}
1332 <      {$IFEND}
1333 <        result := FormatDateTime(ShortDateFormat + ' ' +
1334 <                            LongTimeFormat+'.zzz',AsDateTime);
1217 >        result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1218        SQL_SHORT, SQL_LONG:
1219          if Scale = 0 then
1220            result := IntToStr(AsLong)
# Line 1359 | Line 1242 | begin
1242    Result := false;
1243   end;
1244  
1245 < function TSQLDataItem.getIsNullable: boolean;
1245 > function TSQLDataItem.GetIsNullable: boolean;
1246   begin
1247    CheckActive;
1248    Result := false;
# Line 1407 | Line 1290 | begin
1290    Result := false;
1291   end;
1292  
1293 + function TSQLDataItem.GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats
1294 +  ): integer;
1295 + begin
1296 +  case DateTimeFormat of
1297 +  dfTimestamp:
1298 +    Result := Length(GetTimestampFormatStr);
1299 +  dfDateTime:
1300 +    Result := Length(GetDateFormatStr(true));
1301 +  dfTime:
1302 +    Result := Length(GetTimeFormatStr);
1303 +  else
1304 +    Result := 0;
1305 +  end;
1306 + end;
1307 +
1308  
1309   procedure TSQLDataItem.SetIsNull(Value: Boolean);
1310   begin
# Line 1470 | Line 1368 | begin
1368  
1369    SQLType := SQL_TYPE_DATE;
1370    DataLength := SizeOf(ISC_DATE);
1371 <  with FirebirdClientAPI do
1371 >  with FFirebirdClientAPI do
1372      SQLEncodeDate(Value,SQLData);
1373    Changed;
1374   end;
# Line 1490 | Line 1388 | begin
1388  
1389    SQLType := SQL_TYPE_TIME;
1390    DataLength := SizeOf(ISC_TIME);
1391 <  with FirebirdClientAPI do
1391 >  with FFirebirdClientAPI do
1392      SQLEncodeTime(Value,SQLData);
1393    Changed;
1394   end;
# Line 1504 | Line 1402 | begin
1402    Changing;
1403    SQLType := SQL_TIMESTAMP;
1404    DataLength := SizeOf(ISC_TIME) + sizeof(ISC_DATE);
1405 <  with FirebirdClientAPI do
1405 >  with FFirebirdClientAPI do
1406      SQLEncodeDateTime(Value,SQLData);
1407    Changed;
1408   end;
# Line 1629 | Line 1527 | begin
1527    end;
1528   end;
1529  
1530 + procedure TSQLDataItem.SetAsNumeric(Value: Int64; aScale: integer);
1531 + begin
1532 +  CheckActive;
1533 +  Changing;
1534 +  if IsNullable then
1535 +    IsNull := False;
1536 +
1537 +  SQLType := SQL_INT64;
1538 +  Scale := aScale;
1539 +  DataLength := SizeOf(Int64);
1540 +  PInt64(SQLData)^ := Value;
1541 +  Changed;
1542 + end;
1543 +
1544   procedure TSQLDataItem.SetAsBoolean(AValue: boolean);
1545   begin
1546    CheckActive;
# Line 1676 | Line 1588 | end;
1588  
1589   constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
1590   begin
1591 <  inherited Create;
1591 >  inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
1592    FIBXSQLVAR := aIBXSQLVAR;
1593    FOwner := aOwner;
1594    FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
# Line 1778 | Line 1690 | begin
1690    result := FIBXSQLVAR.GetBlobMetaData;
1691   end;
1692  
1693 + function TColumnMetaData.GetStatement: IStatement;
1694 + begin
1695 +  Result := FIBXSQLVAR.GetStatement;
1696 + end;
1697 +
1698 + function TColumnMetaData.GetTransaction: ITransaction;
1699 + begin
1700 +  Result := GetStatement.GetTransaction;
1701 + end;
1702 +
1703   { TIBSQLData }
1704  
1705   procedure TIBSQLData.CheckActive;
# Line 1797 | Line 1719 | begin
1719      IBError(ibxeBOF,[nil]);
1720   end;
1721  
1722 + function TIBSQLData.GetTransaction: ITransaction;
1723 + begin
1724 +  if FTransaction = nil then
1725 +    Result := inherited GetTransaction
1726 +  else
1727 +    Result := FTransaction;
1728 + end;
1729 +
1730   function TIBSQLData.GetIsNull: Boolean;
1731   begin
1732    CheckActive;
# Line 1840 | Line 1770 | end;
1770   { TSQLParam }
1771  
1772   procedure TSQLParam.InternalSetAsString(Value: AnsiString);
1773 +
1774 + procedure DoSetString;
1775 + begin
1776 +  Changing;
1777 +  FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1778 +  Changed;
1779 + end;
1780 +
1781   var b: IBlob;
1782 +    dt: TDateTime;
1783 +    CurrValue: Currency;
1784 +    FloatValue: single;
1785   begin
1786    CheckActive;
1787    if IsNullable then
# Line 1866 | Line 1807 | begin
1807  
1808    SQL_VARYING,
1809    SQL_TEXT:
1810 <    begin
1870 <      Changing;
1871 <      FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1872 <      Changed;
1873 <    end;
1810 >    DoSetString;
1811  
1812      SQL_SHORT,
1813      SQL_LONG,
1814      SQL_INT64:
1815 <      SetAsInt64(StrToInt(Value));
1815 >      if TryStrToCurr(Value,CurrValue) then
1816 >        SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
1817 >      else
1818 >        DoSetString;
1819  
1820      SQL_D_FLOAT,
1821      SQL_DOUBLE,
1822      SQL_FLOAT:
1823 <      SetAsDouble(StrToFloat(Value));
1823 >      if TryStrToFloat(Value,FloatValue) then
1824 >        SetAsDouble(FloatValue)
1825 >      else
1826 >        DoSetString;
1827  
1828      SQL_TIMESTAMP:
1829 <      SetAsDateTime(StrToDateTime(Value));
1829 >      if TryStrToDateTime(Value,dt) then
1830 >        SetAsDateTime(dt)
1831 >      else
1832 >        DoSetString;
1833  
1834      SQL_TYPE_DATE:
1835 <      SetAsDate(StrToDateTime(Value));
1835 >      if TryStrToDateTime(Value,dt) then
1836 >        SetAsDate(dt)
1837 >      else
1838 >        DoSetString;
1839  
1840      SQL_TYPE_TIME:
1841 <      SetAsTime(StrToDateTime(Value));
1841 >      if TryStrToDateTime(Value,dt) then
1842 >        SetAsTime(dt)
1843 >      else
1844 >        DoSetString;
1845  
1846      else
1847        IBError(ibxeInvalidDataConversion,[nil]);
# Line 2475 | Line 2427 | begin
2427      end;
2428   end;
2429  
2430 + function TSQLParams.GetHasCaseSensitiveParams: Boolean;
2431 + begin
2432 +  Result := FSQLParams.CaseSensitiveParams;
2433 + end;
2434 +
2435   { TResults }
2436  
2437   procedure TResults.CheckActive;
# Line 2493 | Line 2450 | begin
2450   end;
2451  
2452   function TResults.GetISQLData(aIBXSQLVAR: TSQLVarData): ISQLData;
2453 + var col: TIBSQLData;
2454   begin
2455    if (aIBXSQLVAR.Index < 0) or (aIBXSQLVAR.Index >= getCount) then
2456      IBError(ibxeInvalidColumnIndex,[nil]);
2457  
2458    if not HasInterface(aIBXSQLVAR.Index) then
2459      AddInterface(aIBXSQLVAR.Index, TIBSQLData.Create(self,aIBXSQLVAR));
2460 <  Result := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
2460 >  col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
2461 >  col.FTransaction := GetTransaction;
2462 >  Result := col;
2463   end;
2464  
2465   constructor TResults.Create(aResults: TSQLDataArea);
# Line 2556 | Line 2516 | begin
2516    FResults.GetData(index,IsNull, len,data);
2517   end;
2518  
2519 + function TResults.GetStatement: IStatement;
2520 + begin
2521 +  Result := FStatement;
2522 + end;
2523 +
2524   function TResults.GetTransaction: ITransaction;
2525   begin
2526    Result := FStatement.GetTransaction;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines