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 291 by tony, Fri Apr 17 10:26:08 2020 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 138 | 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 240 | 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 318 | 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;
# Line 1174 | 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 1197 | 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
1208 <          Result := TrimRight(rs)
1209 <        else
1210 <          Result := rs
1282 >        Result := rs;
1283        end;
1284        SQL_TYPE_DATE:
1285          result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
# Line 1678 | 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;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines