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 308 by tony, Sat Jul 18 10:26:30 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, {$IFDEF WINDOWS} Windows, {$ENDIF} 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 +     function GetSize: cardinal; virtual; abstract;
142       procedure SetAsBoolean(AValue: boolean); virtual;
143       procedure SetAsCurrency(Value: Currency); virtual;
144       procedure SetAsInt64(Value: Int64); virtual;
# Line 196 | Line 187 | type
187  
188    TSQLDataArea = class
189    private
190 +    FCaseSensitiveParams: boolean;
191      function GetColumn(index: integer): TSQLVarData;
192      function GetCount: integer;
193    protected
# Line 218 | Line 210 | type
210        var data: PByte); virtual;
211      procedure RowChange;
212      function StateChanged(var ChangeSeqNo: integer): boolean; virtual; abstract;
213 +    property CaseSensitiveParams: boolean read FCaseSensitiveParams
214 +                                            write FCaseSensitiveParams; {Only used when IsInputDataArea true}
215      property Count: integer read GetCount;
216      property Column[index: integer]: TSQLVarData read GetColumn;
217      property UniqueRelationName: AnsiString read FUniqueRelationName;
# Line 300 | Line 294 | type
294      FIBXSQLVAR: TSQLVarData;
295      FOwner: IUnknown;         {Keep reference to ensure Metadata/statement not discarded}
296      FPrepareSeqNo: integer;
303    FStatement: IStatement;
297      FChangeSeqNo: integer;
298    protected
299      procedure CheckActive; override;
# Line 312 | Line 305 | type
305      constructor Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
306      destructor Destroy; override;
307      function GetSQLDialect: integer; override;
315    property Statement: IStatement read FStatement;
308  
309    public
310      {IColumnMetaData}
# Line 327 | Line 319 | type
319      function GetScale: integer; override;
320      function getCharSetID: cardinal; override;
321      function GetIsNullable: boolean; override;
322 <    function GetSize: cardinal;
322 >    function GetSize: cardinal; override;
323      function GetArrayMetaData: IArrayMetaData;
324      function GetBlobMetaData: IBlobMetaData;
325 +    function GetStatement: IStatement;
326 +    function GetTransaction: ITransaction; virtual;
327      property Name: AnsiString read GetName;
328      property Size: cardinal read GetSize;
329      property CharSetID: cardinal read getCharSetID;
330      property SQLSubtype: integer read getSubtype;
331      property IsNullable: Boolean read GetIsNullable;
332 +  public
333 +    property Statement: IStatement read GetStatement;
334    end;
335  
336    { TIBSQLData }
337  
338    TIBSQLData = class(TColumnMetaData,ISQLData)
339 +  private
340 +    FTransaction: ITransaction;
341    protected
342      procedure CheckActive; override;
343    public
344 +    function GetTransaction: ITransaction; override;
345      function GetIsNull: Boolean; override;
346      function GetAsArray: IArray;
347      function GetAsBlob: IBlob; overload;
# Line 429 | Line 428 | type
428      function getSQLParam(index: integer): ISQLParam;
429      function ByName(Idx: AnsiString): ISQLParam ;
430      function GetModified: Boolean;
431 +    function GetHasCaseSensitiveParams: Boolean;
432    end;
433  
434    { TResults }
# Line 450 | Line 450 | type
450       function ByName(Idx: AnsiString): ISQLData;
451       function getSQLData(index: integer): ISQLData;
452       procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
453 +     function GetStatement: IStatement;
454       function GetTransaction: ITransaction; virtual;
455       procedure SetRetainInterfaces(aValue: boolean);
456   end;
457  
458   implementation
459  
460 < uses FBMessages, FBClientAPI, variants, IBUtils, FBTransaction;
460 <
460 > uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
461  
462   { TSQLDataArea }
463  
# Line 510 | Line 510 | end;
510  
511   procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
512    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}
533
534  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;
513  
514 <        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;
514 > var slNames: TStrings;
515  
516 <        CommentState:
517 <        begin
518 <          if (cNextChar = #0) then
519 <            IBError(ibxeSQLParseError, [SEOFInComment])
520 <          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));
516 >  procedure SetColumnNames(slNames: TStrings);
517 >  var i, j: integer;
518 >      found: boolean;
519 >  begin
520 >    found := false;
521      SetCount(slNames.Count);
522      for i := 0 to slNames.Count - 1 do
523      begin
# Line 710 | Line 538 | begin
538          Column[i].UniqueName := not found;
539        end;
540      end;
541 +  end;
542 +
543 + begin
544 +  if not IsInputDataArea then
545 +    IBError(ibxeNotPermitted,[nil]);
546 +
547 +  slNames := TStringList.Create;
548 +  try
549 +    sProcessedSQL := TSQLParamProcessor.Execute(sSQL,GenerateParamNames,slNames);
550 +    SetColumnNames(slNames);
551    finally
552      slNames.Free;
715    FreeMem(StrBuffer);
553    end;
554   end;
555  
# Line 726 | Line 563 | var
563    s: AnsiString;
564    i: Integer;
565   begin
566 <  {$ifdef UseCaseInSensitiveParamName}
567 <   s := AnsiUpperCase(Idx);
568 <  {$else}
566 >  if not IsInputDataArea or not CaseSensitiveParams then
567 >   s := AnsiUpperCase(Idx)
568 >  else
569     s := Idx;
570 <  {$endif}
570 >
571    for i := 0 to Count - 1 do
572      if Column[i].Name = s then
573      begin
# Line 762 | Line 599 | end;
599  
600   procedure TSQLVarData.SetName(AValue: AnsiString);
601   begin
602 <  if FName = AValue then Exit;
766 <  {$ifdef UseCaseInSensitiveParamName}
767 <  if Parent.IsInputDataArea then
602 >  if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
603      FName := AnsiUpperCase(AValue)
604    else
770  {$endif}
605      FName := AValue;
606   end;
607  
# Line 788 | Line 622 | begin
622  
623    FVarString := aValue;
624    SQLType := SQL_TEXT;
625 +  Scale := 0;
626    SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
627   end;
628  
# Line 948 | Line 783 | begin
783        result := Value;
784   end;
785  
786 + function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
787 + begin
788 +  {$IF declared(DefaultFormatSettings)}
789 +  with DefaultFormatSettings do
790 +  {$ELSE}
791 +  {$IF declared(FormatSettings)}
792 +  with FormatSettings do
793 +  {$IFEND}
794 +  {$IFEND}
795 +  case GetSQLDialect of
796 +    1:
797 +      if IncludeTime then
798 +        result := ShortDateFormat + ' ' + LongTimeFormat
799 +      else
800 +        result := ShortDateFormat;
801 +    3:
802 +      result := ShortDateFormat;
803 +  end;
804 + end;
805 +
806 + function TSQLDataItem.GetTimeFormatStr: AnsiString;
807 + begin
808 +  {$IF declared(DefaultFormatSettings)}
809 +  with DefaultFormatSettings do
810 +  {$ELSE}
811 +  {$IF declared(FormatSettings)}
812 +  with FormatSettings do
813 +  {$IFEND}
814 +  {$IFEND}
815 +    Result := LongTimeFormat;
816 + end;
817 +
818 + function TSQLDataItem.GetTimestampFormatStr: AnsiString;
819 + begin
820 +  {$IF declared(DefaultFormatSettings)}
821 +  with DefaultFormatSettings do
822 +  {$ELSE}
823 +  {$IF declared(FormatSettings)}
824 +  with FormatSettings do
825 +  {$IFEND}
826 +  {$IFEND}
827 +    Result := ShortDateFormat + ' ' +  LongTimeFormat + '.zzz';
828 + end;
829 +
830   procedure TSQLDataItem.SetAsInteger(AValue: Integer);
831   begin
832    SetAsLong(aValue);
# Line 1046 | Line 925 | begin
925     //Do nothing by default
926   end;
927  
928 + constructor TSQLDataItem.Create(api: TFBClientAPI);
929 + begin
930 +  inherited Create;
931 +  FFirebirdClientAPI := api;
932 + end;
933 +
934   function TSQLDataItem.GetSQLTypeName: AnsiString;
935   begin
936    Result := GetSQLTypeName(GetSQLType);
# Line 1072 | Line 957 | begin
957    end;
958   end;
959  
960 + function TSQLDataItem.GetStrDataLength: short;
961 + begin
962 +  with FFirebirdClientAPI do
963 +  if SQLType = SQL_VARYING then
964 +    Result := DecodeInteger(SQLData, 2)
965 +  else
966 +    Result := DataLength;
967 + end;
968 +
969   function TSQLDataItem.GetAsBoolean: boolean;
970   begin
971    CheckActive;
# Line 1152 | Line 1046 | begin
1046    CheckActive;
1047    result := 0;
1048    if not IsNull then
1049 <    with FirebirdClientAPI do
1049 >    with FFirebirdClientAPI do
1050      case SQLType of
1051        SQL_TEXT, SQL_VARYING: begin
1052          try
# Line 1281 | Line 1175 | begin
1175    end;
1176   end;
1177  
1178 + {Copied from LazUTF8}
1179 +
1180 + function UTF8CodepointSizeFull(p: PAnsiChar): integer;
1181 + const TopBitSetMask   = $8000; {%10000000}
1182 +      Top2BitsSetMask = $C000; {%11000000}
1183 +      Top3BitsSetMask = $E000; {%11100000}
1184 +      Top4BitsSetMask = $F000; {%11110000}
1185 +      Top5BitsSetMask = $F800; {%11111000}
1186 + begin
1187 +  case p^ of
1188 +  #0..#191: // %11000000
1189 +    // regular single byte character (#0 is a character, this is Pascal ;)
1190 +    Result:=1;
1191 +  #192..#223: // p^ and %11100000 = %11000000
1192 +    begin
1193 +      // could be 2 byte character
1194 +      if (ord(p[1]) and Top2BitsSetMask) = TopBitSetMask then
1195 +        Result:=2
1196 +      else
1197 +        Result:=1;
1198 +    end;
1199 +  #224..#239: // p^ and %11110000 = %11100000
1200 +    begin
1201 +      // could be 3 byte character
1202 +      if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1203 +      and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask) then
1204 +        Result:=3
1205 +      else
1206 +        Result:=1;
1207 +    end;
1208 +  #240..#247: // p^ and %11111000 = %11110000
1209 +    begin
1210 +      // could be 4 byte character
1211 +      if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1212 +      and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask)
1213 +      and ((ord(p[3]) and Top2BitsSetMask) = TopBitSetMask) then
1214 +        Result:=4
1215 +      else
1216 +        Result:=1;
1217 +    end;
1218 +  else
1219 +    Result:=1;
1220 +  end;
1221 + end;
1222 +
1223 + {Returns the byte length of a UTF8 string with a fixed charwidth}
1224 +
1225 + function GetStrLen(p: PAnsiChar; CharWidth, MaxDataLength: cardinal): integer;
1226 + var i: integer;
1227 +    cplen: integer;
1228 + begin
1229 +  Result := 0;
1230 +  for i := 1 to CharWidth do
1231 +  begin
1232 +    cplen := UTF8CodepointSizeFull(p);
1233 +    Inc(p,cplen);
1234 +    Inc(Result,cplen);
1235 +    if Result >= MaxDataLength then
1236 +    begin
1237 +      Result := MaxDataLength;
1238 +      Exit;
1239 +    end;
1240 +  end;
1241 + end;
1242  
1243   function TSQLDataItem.GetAsString: AnsiString;
1244   var
# Line 1292 | Line 1250 | begin
1250    result := '';
1251    { Check null, if so return a default string }
1252    if not IsNull then
1253 <  with FirebirdClientAPI do
1253 >  with FFirebirdClientAPI do
1254      case SQLType of
1255        SQL_BOOLEAN:
1256          if AsBoolean then
# Line 1304 | Line 1262 | begin
1262        begin
1263          sz := SQLData;
1264          if (SQLType = SQL_TEXT) then
1265 <          str_len := DataLength
1265 >        begin
1266 >          if GetCodePage = cp_utf8 then
1267 >            str_len := GetStrLen(PAnsiChar(sz),GetSize,DataLength)
1268 >          else
1269 >            str_len := DataLength
1270 >        end
1271          else begin
1272 <          str_len := DecodeInteger(SQLData, 2);
1272 >          str_len := DecodeInteger(sz, 2);
1273            Inc(sz, 2);
1274          end;
1275          SetString(rs, PAnsiChar(sz), str_len);
1276          SetCodePage(rs,GetCodePage,false);
1277 <        if (SQLType = SQL_TEXT) and (GetCharSetID <> 1) then
1315 <          Result := TrimRight(rs)
1316 <        else
1317 <          Result := rs
1277 >        Result := rs;
1278        end;
1279        SQL_TYPE_DATE:
1280 <        case GetSQLDialect of
1321 <          1 : result := DateTimeToStr(AsDateTime);
1322 <          3 : result := DateToStr(AsDateTime);
1323 <        end;
1280 >        result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1281        SQL_TYPE_TIME :
1282 <        result := TimeToStr(AsDateTime);
1282 >        result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1283        SQL_TIMESTAMP:
1284 <      {$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);
1284 >        result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1285        SQL_SHORT, SQL_LONG:
1286          if Scale = 0 then
1287            result := IntToStr(AsLong)
# Line 1360 | Line 1309 | begin
1309    Result := false;
1310   end;
1311  
1312 < function TSQLDataItem.getIsNullable: boolean;
1312 > function TSQLDataItem.GetIsNullable: boolean;
1313   begin
1314    CheckActive;
1315    Result := false;
# Line 1408 | Line 1357 | begin
1357    Result := false;
1358   end;
1359  
1360 + function TSQLDataItem.GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats
1361 +  ): integer;
1362 + begin
1363 +  case DateTimeFormat of
1364 +  dfTimestamp:
1365 +    Result := Length(GetTimestampFormatStr);
1366 +  dfDateTime:
1367 +    Result := Length(GetDateFormatStr(true));
1368 +  dfTime:
1369 +    Result := Length(GetTimeFormatStr);
1370 +  else
1371 +    Result := 0;
1372 +  end;
1373 + end;
1374 +
1375  
1376   procedure TSQLDataItem.SetIsNull(Value: Boolean);
1377   begin
# Line 1471 | Line 1435 | begin
1435  
1436    SQLType := SQL_TYPE_DATE;
1437    DataLength := SizeOf(ISC_DATE);
1438 <  with FirebirdClientAPI do
1438 >  with FFirebirdClientAPI do
1439      SQLEncodeDate(Value,SQLData);
1440    Changed;
1441   end;
# Line 1491 | Line 1455 | begin
1455  
1456    SQLType := SQL_TYPE_TIME;
1457    DataLength := SizeOf(ISC_TIME);
1458 <  with FirebirdClientAPI do
1458 >  with FFirebirdClientAPI do
1459      SQLEncodeTime(Value,SQLData);
1460    Changed;
1461   end;
# Line 1505 | Line 1469 | begin
1469    Changing;
1470    SQLType := SQL_TIMESTAMP;
1471    DataLength := SizeOf(ISC_TIME) + sizeof(ISC_DATE);
1472 <  with FirebirdClientAPI do
1472 >  with FFirebirdClientAPI do
1473      SQLEncodeDateTime(Value,SQLData);
1474    Changed;
1475   end;
# Line 1691 | Line 1655 | end;
1655  
1656   constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
1657   begin
1658 <  inherited Create;
1658 >  inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
1659    FIBXSQLVAR := aIBXSQLVAR;
1660    FOwner := aOwner;
1661    FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
# Line 1793 | Line 1757 | begin
1757    result := FIBXSQLVAR.GetBlobMetaData;
1758   end;
1759  
1760 + function TColumnMetaData.GetStatement: IStatement;
1761 + begin
1762 +  Result := FIBXSQLVAR.GetStatement;
1763 + end;
1764 +
1765 + function TColumnMetaData.GetTransaction: ITransaction;
1766 + begin
1767 +  Result := GetStatement.GetTransaction;
1768 + end;
1769 +
1770   { TIBSQLData }
1771  
1772   procedure TIBSQLData.CheckActive;
# Line 1812 | Line 1786 | begin
1786      IBError(ibxeBOF,[nil]);
1787   end;
1788  
1789 + function TIBSQLData.GetTransaction: ITransaction;
1790 + begin
1791 +  if FTransaction = nil then
1792 +    Result := inherited GetTransaction
1793 +  else
1794 +    Result := FTransaction;
1795 + end;
1796 +
1797   function TIBSQLData.GetIsNull: Boolean;
1798   begin
1799    CheckActive;
# Line 1855 | Line 1837 | end;
1837   { TSQLParam }
1838  
1839   procedure TSQLParam.InternalSetAsString(Value: AnsiString);
1840 +
1841 + procedure DoSetString;
1842 + begin
1843 +  Changing;
1844 +  FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1845 +  Changed;
1846 + end;
1847 +
1848   var b: IBlob;
1849      dt: TDateTime;
1850 +    CurrValue: Currency;
1851 +    FloatValue: single;
1852   begin
1853    CheckActive;
1854    if IsNullable then
# Line 1882 | Line 1874 | begin
1874  
1875    SQL_VARYING,
1876    SQL_TEXT:
1877 <    begin
1886 <      Changing;
1887 <      FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1888 <      Changed;
1889 <    end;
1877 >    DoSetString;
1878  
1879      SQL_SHORT,
1880      SQL_LONG,
1881      SQL_INT64:
1882 <      SetAsNumeric(AdjustScaleFromCurrency(StrToCurr(Value),GetScale),GetScale);
1882 >      if TryStrToCurr(Value,CurrValue) then
1883 >        SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
1884 >      else
1885 >        DoSetString;
1886  
1887      SQL_D_FLOAT,
1888      SQL_DOUBLE,
1889      SQL_FLOAT:
1890 <      SetAsDouble(StrToFloat(Value));
1890 >      if TryStrToFloat(Value,FloatValue) then
1891 >        SetAsDouble(FloatValue)
1892 >      else
1893 >        DoSetString;
1894  
1895      SQL_TIMESTAMP:
1896        if TryStrToDateTime(Value,dt) then
1897          SetAsDateTime(dt)
1898        else
1899 <        FIBXSQLVar.SetString(Value);
1899 >        DoSetString;
1900  
1901      SQL_TYPE_DATE:
1902        if TryStrToDateTime(Value,dt) then
1903          SetAsDate(dt)
1904        else
1905 <        FIBXSQLVar.SetString(Value);
1905 >        DoSetString;
1906  
1907      SQL_TYPE_TIME:
1908        if TryStrToDateTime(Value,dt) then
1909          SetAsTime(dt)
1910        else
1911 <        FIBXSQLVar.SetString(Value);
1911 >        DoSetString;
1912  
1913      else
1914        IBError(ibxeInvalidDataConversion,[nil]);
# Line 2500 | Line 2494 | begin
2494      end;
2495   end;
2496  
2497 + function TSQLParams.GetHasCaseSensitiveParams: Boolean;
2498 + begin
2499 +  Result := FSQLParams.CaseSensitiveParams;
2500 + end;
2501 +
2502   { TResults }
2503  
2504   procedure TResults.CheckActive;
# Line 2518 | Line 2517 | begin
2517   end;
2518  
2519   function TResults.GetISQLData(aIBXSQLVAR: TSQLVarData): ISQLData;
2520 + var col: TIBSQLData;
2521   begin
2522    if (aIBXSQLVAR.Index < 0) or (aIBXSQLVAR.Index >= getCount) then
2523      IBError(ibxeInvalidColumnIndex,[nil]);
2524  
2525    if not HasInterface(aIBXSQLVAR.Index) then
2526      AddInterface(aIBXSQLVAR.Index, TIBSQLData.Create(self,aIBXSQLVAR));
2527 <  Result := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
2527 >  col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
2528 >  col.FTransaction := GetTransaction;
2529 >  Result := col;
2530   end;
2531  
2532   constructor TResults.Create(aResults: TSQLDataArea);
# Line 2581 | Line 2583 | begin
2583    FResults.GetData(index,IsNull, len,data);
2584   end;
2585  
2586 + function TResults.GetStatement: IStatement;
2587 + begin
2588 +  Result := FStatement;
2589 + end;
2590 +
2591   function TResults.GetTransaction: ITransaction;
2592   begin
2593    Result := FStatement.GetTransaction;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines