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 270 by tony, Fri Jan 18 11:10:37 2019 UTC vs.
Revision 308 by tony, Sat Jul 18 10:26:30 2020 UTC

# Line 80 | Line 80 | unit FBSQLData;
80   interface
81  
82   uses
83 <  Classes, SysUtils, IBExternals, IBHeader, IB,  FBActivityMonitor, FBClientAPI;
83 >  Classes, SysUtils, IBExternals, IBHeader, {$IFDEF WINDOWS} Windows, {$ENDIF} IB,  FBActivityMonitor, FBClientAPI;
84  
85   type
86  
# Line 119 | Line 119 | type
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 137 | Line 138 | type
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 292 | Line 294 | type
294      FIBXSQLVAR: TSQLVarData;
295      FOwner: IUnknown;         {Keep reference to ensure Metadata/statement not discarded}
296      FPrepareSeqNo: integer;
295 –    FStatement: IStatement;
297      FChangeSeqNo: integer;
298    protected
299      procedure CheckActive; override;
# Line 304 | Line 305 | type
305      constructor Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
306      destructor Destroy; override;
307      function GetSQLDialect: integer; override;
307 –    property Statement: IStatement read FStatement;
308  
309    public
310      {IColumnMetaData}
# Line 319 | 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 421 | 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 442 | 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;
# Line 948 | 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 1157 | 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 1180 | 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
1191 <          Result := TrimRight(rs)
1192 <        else
1193 <          Result := rs
1277 >        Result := rs;
1278        end;
1279        SQL_TYPE_DATE:
1280          result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
# Line 1673 | 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 1692 | 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 2392 | 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 2410 | 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 2473 | 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