ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBCustomDataSet.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents):
Revision 41 by tony, Sat Jul 16 12:25:48 2016 UTC vs.
Revision 43 by tony, Thu Sep 22 17:10:15 2016 UTC

# Line 98 | Line 98 | type
98      fdDataSize: Short;
99      fdDataLength: Short;
100      fdDataOfs: Integer;
101 +    {$IFDEF HAS_ANSISTRING_CODEPAGE}
102 +    fdCodePage: TSystemCodePage;
103 +    {$ENDIF}
104    end;
105    PFieldData = ^TFieldData;
106  
# Line 147 | Line 150 | type
150      {$ENDIF}
151    end;
152  
150 –  { TIBWideStringField }
151 –
152 –  TIBWideStringField = class(TWideStringField)
153 –  private
154 –    FCharacterSetName: RawByteString;
155 –    FCharacterSetSize: integer;
156 –  public
157 –    property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
158 –    property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
159 –  end;
160 –
153    { TIBBCDField }
154    {  Actually, there is no BCD involved in this type,
155       instead it deals with currency types.
# Line 209 | Line 201 | type
201     {$ENDIF}
202     end;
203  
212 –   { TIBWideMemoField }
213 –
214 –   TIBWideMemoField = class(TWideMemoField)
215 –   private
216 –     FCharacterSetName: RawByteString;
217 –     FCharacterSetSize: integer;
218 –     FDisplayTextAsClassName: boolean;
219 –     function GetTruncatedText: string;
220 –   protected
221 –     function GetDefaultWidth: Longint; override;
222 –     procedure GetText(var AText: string; ADisplayText: Boolean); override;
223 –   public
224 –     constructor Create(AOwner: TComponent); override;
225 –     property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
226 –     property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
227 –   published
228 –      property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
229 –                                             write FDisplayTextAsClassName;
230 –   end;
231 –
204    TIBDataLink = class(TDetailDataLink)
205    private
206      FDataSet: TIBCustomDataSet;
# Line 777 | Line 749 | DefaultFieldClasses: array[TFieldType] o
749      TBlobField,         { ftTypedBinary }
750      nil,                { ftCursor }
751      TStringField,       { ftFixedChar }
752 <    TIBWideStringField,    { ftWideString }
752 >    nil,    { ftWideString }
753      TLargeIntField,     { ftLargeInt }
754      nil,          { ftADT }
755      nil,        { ftArray }
# Line 792 | Line 764 | DefaultFieldClasses: array[TFieldType] o
764      TDateTimeField,    {ftTimestamp}
765      TIBBCDField,       {ftFMTBcd}
766      nil,  {ftFixedWideChar}
767 <    TIBWideMemoField);   {ftWideMemo}
767 >    nil);   {ftWideMemo}
768   (*
769      TADTField,          { ftADT }
770      TArrayField,        { ftArray }
# Line 809 | Line 781 | DefaultFieldClasses: array[TFieldType] o
781  
782   implementation
783  
784 < uses IBIntf, Variants, FmtBCD, LazUTF8;
784 > uses IBIntf, Variants, FmtBCD, LazUTF8, IBCodePage;
785  
786   const FILE_BEGIN = 0;
787        FILE_CURRENT = 1;
# Line 893 | Line 865 | type
865      Result := str;
866    end;
867  
896 – { TIBWideMemoField }
897 –
898 – function TIBWideMemoField.GetTruncatedText: string;
899 – begin
900 –  Result := GetAsString;
901 –
902 –  if Result <> '' then
903 –    if DisplayWidth = 0 then
904 –      Result := TextToSingleLine(Result)
905 –    else
906 –    if Length(Result) > DisplayWidth then {Show truncation with elipses}
907 –      Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
908 – end;
909 –
910 – function TIBWideMemoField.GetDefaultWidth: Longint;
911 – begin
912 –  Result := 128;
913 – end;
914 –
915 – procedure TIBWideMemoField.GetText(var AText: string; ADisplayText: Boolean);
916 – begin
917 –  if ADisplayText then
918 –  begin
919 –    if not DisplayTextAsClassName and (CharacterSetName<> '') then
920 –      AText := GetTruncatedText
921 –    else
922 –      inherited GetText(AText, ADisplayText);
923 –  end
924 –  else
925 –    AText := GetAsString;
926 – end;
927 –
928 – constructor TIBWideMemoField.Create(AOwner: TComponent);
929 – begin
930 –  inherited Create(AOwner);
931 –  BlobType := ftWideMemo;
932 – end;
933 –
868   { TIBMemoField }
869  
870   function TIBMemoField.GetTruncatedText: string;
# Line 966 | Line 900 | begin
900    s := inherited GetAsString;
901    {$IFDEF HAS_ANSISTRING_CODEPAGE}
902    SetCodePage(s,CodePage,false);
903 +  if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
904 +    SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
905    {$ENDIF}
906    Result := s;
907   end;
# Line 997 | Line 933 | begin
933    s := AValue;
934    {$IFDEF HAS_ANSISTRING_CODEPAGE}
935    if StringCodePage(Value) <> CodePage then
936 <    SetCodePage(s,CodePage,true);
936 >    SetCodePage(s,CodePage,CodePage<>CP_NONE);
937    {$ENDIF}
938    inherited SetAsString(s);
939   end;
# Line 1077 | Line 1013 | function TIBStringField.GetValue(var Val
1013   var
1014    Buffer: PChar;
1015    s: RawByteString;
1016 + //  i: integer;
1017   begin
1018    Buffer := nil;
1019    IBAlloc(Buffer, 0, Size + 1);
# Line 1087 | Line 1024 | begin
1024        {$IFDEF HAS_ANSISTRING_CODEPAGE}
1025        s := string(Buffer);
1026        SetCodePage(s,CodePage,false);
1027 +      if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1028 +        SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1029        Value := s;
1030 < //      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1030 > (*      write(FieldName,': ', StringCodePage(Value),', ',Value,' ');
1031 >      for i := 1 to Length(Value) do
1032 >        write(Format('%x ',[byte(Value[i])]));
1033 >      writeln;*)
1034        {$ELSE}
1035        Value := string(Buffer);
1036        {$ENDIF}
# Line 1111 | Line 1053 | begin
1053      s := Value;
1054      {$IFDEF HAS_ANSISTRING_CODEPAGE}
1055      if StringCodePage(s) <> CodePage then
1056 <      SetCodePage(s,CodePage,true);
1056 >      SetCodePage(s,CodePage,CodePage<>CP_NONE);
1057      {$ENDIF}
1058      StrLCopy(Buffer, PChar(s), Size);
1059      if Transliterate then
# Line 1773 | Line 1715 | var
1715    LocalInt64: Int64;
1716    LocalCurrency: Currency;
1717    FieldsLoaded: Integer;
1776 –  temp: TIBXSQLVAR;
1718   begin
1719    p := PRecordData(Buffer);
1720    { Make sure blob cache is empty }
# Line 1822 | Line 1763 | begin
1763          (Qry.Current[i].Data^.sqltype and 1 = 1);
1764        rdFields[j].fdIsNull :=
1765          (rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
1766 +      {$IFDEF HAS_ANSISTRING_CODEPAGE}
1767 +      rdFields[j].fdCodePage := 0;
1768 +      {$ENDIF}
1769        LocalData := Qry.Current[i].Data^.sqldata;
1770        case rdFields[j].fdDataType of
1771          SQL_TIMESTAMP:
# Line 1902 | Line 1846 | begin
1846          begin
1847            rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1848            rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);
1849 +          {$IFDEF HAS_ANSISTRING_CODEPAGE}
1850 +          TFirebirdCharacterSets.CharSetID2CodePage(Qry.Current[i].Data^.sqlsubtype and $FF,
1851 +                                                    rdFields[j].fdCodePage);
1852 +          {$ENDIF}
1853            if RecordNumber >= 0 then
1854            begin
1855              if (rdFields[j].fdDataLength = 0) then
1856                LocalData := nil
1857              else
1858 <            begin
1911 <              temp :=  Qry.Current[i];
1912 <              LocalData := @temp.Data^.sqldata[2];
1913 < (*              LocalData := @Qry.Current[i].Data^.sqldata[2];*)
1914 <            end;
1858 >              Inc(LocalData,2);
1859            end;
1860          end;
1861          SQL_BOOLEAN:
# Line 1922 | Line 1866 | begin
1866              LocalBool := Qry.Current[i].AsBoolean;
1867            LocalData := PChar(@LocalBool);
1868          end;
1869 <        else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1869 >        SQL_TEXT:
1870 >        begin
1871 >          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1872 >          rdFields[j].fdDataLength := rdFields[j].fdDataSize;
1873 >           {$IFDEF HAS_ANSISTRING_CODEPAGE}
1874 >          TFirebirdCharacterSets.CharSetID2CodePage(Qry.Current[i].Data^.sqlsubtype and $FF,
1875 >                                                    rdFields[j].fdCodePage);
1876 >          {$ENDIF}
1877 >       end;
1878 >        else {  SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1879          begin
1880            rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1928 –          if (rdFields[j].fdDataType = SQL_TEXT) then
1929 –            rdFields[j].fdDataLength := rdFields[j].fdDataSize;
1881          end;
1882        end;
1883        if RecordNumber < 0 then
# Line 2461 | Line 2412 | procedure TIBCustomDataSet.SetInternalSQ
2412   var
2413    i, j: Integer;
2414    cr, data: PChar;
2415 <  fn, st: string;
2415 >  fn: string;
2416 >  st: RawByteString;
2417    OldBuffer: Pointer;
2418    ts: TTimeStamp;
2419   begin
# Line 2509 | Line 2461 | begin
2461                SQL_TEXT, SQL_VARYING:
2462                begin
2463                  SetString(st, data, rdFields[j].fdDataLength);
2464 +                {$IFDEF HAS_ANSISTRING_CODEPAGE}
2465 +                SetCodePage(st,rdFields[j].fdCodePage,false);
2466 +                {$ENDIF}
2467                  Qry.Params[i].AsString := st;
2468                end;
2469              SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
# Line 3429 | Line 3384 | const
3384   var
3385    FieldType: TFieldType;
3386    FieldSize: Word;
3387 <  charSetID: short;
3387 >  charSetID: integer;
3388    CharSetSize: integer;
3389    CharSetName: RawByteString;
3390    {$IFDEF HAS_ANSISTRING_CODEPAGE}
# Line 3575 | Line 3530 | begin
3530             their values }
3531            SQL_VARYING, SQL_TEXT:
3532            begin
3533 <            CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3534 <            CharSetName := FBase.GetCharSetName(sqlsubtype and $FF);
3533 >            CharSetID := SourceQuery.Current[i].GetCharSetID;
3534 >            TFirebirdCharacterSets.CharSetWidth(CharSetID,CharSetSize);
3535 >            CharSetName := TFirebirdCharacterSets.GetCharsetName(CharSetID);
3536              {$IFDEF HAS_ANSISTRING_CODEPAGE}
3537 <            FieldCodePage := FBase.GetCodePage(sqlsubtype and $FF);
3537 >            TFirebirdCharacterSets.CharSetID2CodePage(CharSetID,FieldCodePage);
3538              {$ENDIF}
3583 –            {FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3539              FieldSize := sqllen;
3540 <            if CharSetSize = 2 then
3586 <              FieldType := ftWideString
3587 <            else
3588 <              FieldType := ftString;
3540 >            FieldType := ftString;
3541            end;
3542            { All Doubles/Floats should be cast to doubles }
3543            SQL_DOUBLE, SQL_FLOAT:
# Line 3645 | Line 3597 | begin
3597              FieldSize := sizeof (TISC_QUAD);
3598              if (sqlsubtype = 1) then
3599              begin
3600 <              if FBase.GetDefaultCharSetName <> '' then
3601 <              begin
3602 <                CharSetSize := FBase.GetDefaultCharSetSize;
3603 <                CharSetName := FBase.GetDefaultCharSetName;
3604 <                {$IFDEF HAS_ANSISTRING_CODEPAGE}
3605 <                FieldCodePage := FBase.GetDefaultCodePage;
3606 <                {$ENDIF}
3655 <              end
3656 <              else
3657 <              if strpas(sqlname) <> '' then
3658 <              begin
3659 <                charSetID := GetBlobCharSetID(Database.Handle,Database.InternalTransaction.Handle,
3660 <                        @relname,@sqlname);
3661 <                CharSetSize := FBase.GetCharSetSize(charSetID);
3662 <                CharSetName := FBase.GetCharSetName(charSetID);
3663 <                {$IFDEF HAS_ANSISTRING_CODEPAGE}
3664 <                FieldCodePage := FBase.GetCodePage(charSetID);
3665 <                {$ENDIF}
3666 <             end
3667 <              else  {Complex SQL with no identifiable column and no connection default}
3668 <              begin
3669 <                CharSetName := '';
3670 <                CharSetSize := 1;
3671 <                {$IFDEF HAS_ANSISTRING_CODEPAGE}
3672 <                FieldCodePage := CP_NONE;
3673 <                {$ENDIF}
3674 <              end;
3675 <              if CharSetSize = 2 then
3676 <                FieldType := ftWideMemo
3677 <              else
3678 <                FieldType := ftMemo;
3600 >              CharSetID := SourceQuery.Current[i].GetCharSetID;
3601 >              TFirebirdCharacterSets.CharSetWidth(CharSetID,CharSetSize);
3602 >              CharSetName := TFirebirdCharacterSets.GetCharsetName(CharSetID);
3603 >              {$IFDEF HAS_ANSISTRING_CODEPAGE}
3604 >              TFirebirdCharacterSets.CharSetID2CodePage(CharSetID,FieldCodePage);
3605 >              {$ENDIF}
3606 >              FieldType := ftMemo;
3607              end
3608              else
3609                FieldType := ftBlob;
# Line 3881 | Line 3809 | procedure TIBCustomDataSet.InternalOpen;
3809            end;
3810          end
3811          else
3884 –        if(Fields[i] is TIBWideStringField) then
3885 –        with TIBWideStringField(Fields[i]) do
3886 –        begin
3887 –          IBFieldDef := GetFieldDef(FieldNo);
3888 –          if IBFieldDef <> nil then
3889 –          begin
3890 –            CharacterSetSize := IBFieldDef.CharacterSetSize;
3891 –            CharacterSetName := IBFieldDef.CharacterSetName;
3892 –          end;
3893 –        end
3894 –        else
3812          if(Fields[i] is TIBMemoField) then
3813          with TIBMemoField(Fields[i]) do
3814          begin
# Line 3905 | Line 3822 | procedure TIBCustomDataSet.InternalOpen;
3822              {$ENDIF}
3823            end;
3824          end
3908 –        else
3909 –        if(Fields[i] is TIBWideMemoField) then
3910 –        with TIBWideMemoField(Fields[i]) do
3911 –        begin
3912 –          IBFieldDef := GetFieldDef(FieldNo);
3913 –          if IBFieldDef <> nil then
3914 –          begin
3915 –            CharacterSetSize := IBFieldDef.CharacterSetSize;
3916 –            CharacterSetName := IBFieldDef.CharacterSetName;
3917 –          end;
3918 –        end
3825        end
3826    end;
3827  

Diff Legend

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