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 287 by tony, Thu Apr 11 08:51:23 2019 UTC vs.
Revision 309 by tony, Tue Jul 21 08:00:42 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 +     function GetCharSetWidth: integer; virtual; abstract;
143       procedure SetAsBoolean(AValue: boolean); virtual;
144       procedure SetAsCurrency(Value: Currency); virtual;
145       procedure SetAsInt64(Value: Int64); virtual;
# Line 239 | Line 242 | type
242      function GetRelationName: AnsiString;  virtual; abstract;
243      function GetScale: integer; virtual; abstract;
244      function GetCharSetID: cardinal; virtual; abstract;
245 +    function GetCharSetWidth: integer; virtual; abstract;
246      function GetCodePage: TSystemCodePage; virtual; abstract;
247      function GetIsNull: Boolean;   virtual; abstract;
248      function GetIsNullable: boolean; virtual; abstract;
# Line 292 | Line 296 | type
296      FIBXSQLVAR: TSQLVarData;
297      FOwner: IUnknown;         {Keep reference to ensure Metadata/statement not discarded}
298      FPrepareSeqNo: integer;
295 –    FStatement: IStatement;
299      FChangeSeqNo: integer;
300    protected
301      procedure CheckActive; override;
# Line 304 | Line 307 | type
307      constructor Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
308      destructor Destroy; override;
309      function GetSQLDialect: integer; override;
307 –    property Statement: IStatement read FStatement;
310  
311    public
312      {IColumnMetaData}
# Line 319 | Line 321 | type
321      function GetScale: integer; override;
322      function getCharSetID: cardinal; override;
323      function GetIsNullable: boolean; override;
324 <    function GetSize: cardinal;
324 >    function GetSize: cardinal; override;
325 >    function GetCharSetWidth: integer; override;
326      function GetArrayMetaData: IArrayMetaData;
327      function GetBlobMetaData: IBlobMetaData;
328 +    function GetStatement: IStatement;
329 +    function GetTransaction: ITransaction; virtual;
330      property Name: AnsiString read GetName;
331      property Size: cardinal read GetSize;
332      property CharSetID: cardinal read getCharSetID;
333      property SQLSubtype: integer read getSubtype;
334      property IsNullable: Boolean read GetIsNullable;
335 +  public
336 +    property Statement: IStatement read GetStatement;
337    end;
338  
339    { TIBSQLData }
340  
341    TIBSQLData = class(TColumnMetaData,ISQLData)
342 +  private
343 +    FTransaction: ITransaction;
344    protected
345      procedure CheckActive; override;
346    public
347 +    function GetTransaction: ITransaction; override;
348      function GetIsNull: Boolean; override;
349      function GetAsArray: IArray;
350      function GetAsBlob: IBlob; overload;
# Line 443 | Line 453 | type
453       function ByName(Idx: AnsiString): ISQLData;
454       function getSQLData(index: integer): ISQLData;
455       procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
456 +     function GetStatement: IStatement;
457       function GetTransaction: ITransaction; virtual;
458       procedure SetRetainInterfaces(aValue: boolean);
459   end;
# Line 949 | Line 960 | begin
960    end;
961   end;
962  
963 + function TSQLDataItem.GetStrDataLength: short;
964 + begin
965 +  with FFirebirdClientAPI do
966 +  if SQLType = SQL_VARYING then
967 +    Result := DecodeInteger(SQLData, 2)
968 +  else
969 +    Result := DataLength;
970 + end;
971 +
972   function TSQLDataItem.GetAsBoolean: boolean;
973   begin
974    CheckActive;
# Line 1158 | Line 1178 | begin
1178    end;
1179   end;
1180  
1181 + {Copied from LazUTF8}
1182 +
1183 + function UTF8CodepointSizeFull(p: PAnsiChar): integer;
1184 + const TopBitSetMask   = $80; {%10000000}
1185 +      Top2BitsSetMask = $C0; {%11000000}
1186 +      Top3BitsSetMask = $E0; {%11100000}
1187 +      Top4BitsSetMask = $F0; {%11110000}
1188 +      Top5BitsSetMask = $F8; {%11111000}
1189 + begin
1190 +  case p^ of
1191 +  #0..#191: // %11000000
1192 +    // regular single byte character (#0 is a character, this is Pascal ;)
1193 +    Result:=1;
1194 +  #192..#223: // p^ and %11100000 = %11000000
1195 +    begin
1196 +      // could be 2 byte character
1197 +      if (ord(p[1]) and Top2BitsSetMask) = TopBitSetMask then
1198 +        Result:=2
1199 +      else
1200 +        Result:=1;
1201 +    end;
1202 +  #224..#239: // p^ and %11110000 = %11100000
1203 +    begin
1204 +      // could be 3 byte character
1205 +      if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1206 +      and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask) then
1207 +        Result:=3
1208 +      else
1209 +        Result:=1;
1210 +    end;
1211 +  #240..#247: // p^ and %11111000 = %11110000
1212 +    begin
1213 +      // could be 4 byte character
1214 +      if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1215 +      and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask)
1216 +      and ((ord(p[3]) and Top2BitsSetMask) = TopBitSetMask) then
1217 +        Result:=4
1218 +      else
1219 +        Result:=1;
1220 +    end;
1221 +  else
1222 +    Result:=1;
1223 +  end;
1224 + end;
1225 +
1226 + {Returns the byte length of a UTF8 string with a fixed charwidth}
1227 +
1228 + function GetStrLen(p: PAnsiChar; CharWidth, MaxDataLength: cardinal): integer;
1229 + var i: integer;
1230 +    cplen: integer;
1231 +    s: AnsiString;
1232 + begin
1233 +  Result := 0;
1234 +  s := strpas(p);
1235 +  for i := 1 to CharWidth do
1236 +  begin
1237 +    cplen := UTF8CodepointSizeFull(p);
1238 +    Inc(p,cplen);
1239 +    Inc(Result,cplen);
1240 +    if Result >= MaxDataLength then
1241 +    begin
1242 +      Result := MaxDataLength;
1243 +      Exit;
1244 +    end;
1245 +  end;
1246 + end;
1247  
1248   function TSQLDataItem.GetAsString: AnsiString;
1249   var
# Line 1181 | Line 1267 | begin
1267        begin
1268          sz := SQLData;
1269          if (SQLType = SQL_TEXT) then
1270 <          str_len := DataLength
1270 >        begin
1271 >          if GetCodePage = cp_utf8 then
1272 >            str_len := GetStrLen(PAnsiChar(sz),GetSize div GetCharSetWidth,DataLength)
1273 >          else
1274 >            str_len := DataLength
1275 >        end
1276          else begin
1277 <          str_len := DecodeInteger(SQLData, 2);
1277 >          str_len := DecodeInteger(sz, 2);
1278            Inc(sz, 2);
1279          end;
1280          SetString(rs, PAnsiChar(sz), str_len);
1281          SetCodePage(rs,GetCodePage,false);
1282 <        if (SQLType = SQL_TEXT) and (GetCharSetID <> 1) then
1192 <          Result := TrimRight(rs)
1193 <        else
1194 <          Result := rs
1282 >        Result := rs;
1283        end;
1284        SQL_TYPE_DATE:
1285          result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
# Line 1662 | Line 1750 | begin
1750    result := FIBXSQLVAR.DataLength;
1751   end;
1752  
1753 + function TColumnMetaData.GetCharSetWidth: integer;
1754 + begin
1755 +  CheckActive;
1756 +  result := FIBXSQLVAR.GetCharSetWidth;
1757 + end;
1758 +
1759   function TColumnMetaData.GetArrayMetaData: IArrayMetaData;
1760   begin
1761    CheckActive;
# Line 1674 | Line 1768 | begin
1768    result := FIBXSQLVAR.GetBlobMetaData;
1769   end;
1770  
1771 + function TColumnMetaData.GetStatement: IStatement;
1772 + begin
1773 +  Result := FIBXSQLVAR.GetStatement;
1774 + end;
1775 +
1776 + function TColumnMetaData.GetTransaction: ITransaction;
1777 + begin
1778 +  Result := GetStatement.GetTransaction;
1779 + end;
1780 +
1781   { TIBSQLData }
1782  
1783   procedure TIBSQLData.CheckActive;
# Line 1693 | Line 1797 | begin
1797      IBError(ibxeBOF,[nil]);
1798   end;
1799  
1800 + function TIBSQLData.GetTransaction: ITransaction;
1801 + begin
1802 +  if FTransaction = nil then
1803 +    Result := inherited GetTransaction
1804 +  else
1805 +    Result := FTransaction;
1806 + end;
1807 +
1808   function TIBSQLData.GetIsNull: Boolean;
1809   begin
1810    CheckActive;
# Line 2416 | Line 2528 | begin
2528   end;
2529  
2530   function TResults.GetISQLData(aIBXSQLVAR: TSQLVarData): ISQLData;
2531 + var col: TIBSQLData;
2532   begin
2533    if (aIBXSQLVAR.Index < 0) or (aIBXSQLVAR.Index >= getCount) then
2534      IBError(ibxeInvalidColumnIndex,[nil]);
2535  
2536    if not HasInterface(aIBXSQLVAR.Index) then
2537      AddInterface(aIBXSQLVAR.Index, TIBSQLData.Create(self,aIBXSQLVAR));
2538 <  Result := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
2538 >  col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
2539 >  col.FTransaction := GetTransaction;
2540 >  Result := col;
2541   end;
2542  
2543   constructor TResults.Create(aResults: TSQLDataArea);
# Line 2479 | Line 2594 | begin
2594    FResults.GetData(index,IsNull, len,data);
2595   end;
2596  
2597 + function TResults.GetStatement: IStatement;
2598 + begin
2599 +  Result := FStatement;
2600 + end;
2601 +
2602   function TResults.GetTransaction: ITransaction;
2603   begin
2604    Result := FStatement.GetTransaction;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines