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 39 by tony, Tue May 17 08:14:52 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 740 | Line 712 | type
712    protected
713      FField: TField;
714      FBlobStream: TIBBlobStream;
715 +    function  GetSize: Int64; override;
716    public
717      constructor Create(AField: TField; ABlobStream: TIBBlobStream;
718                         Mode: TBlobStreamMode);
# Line 776 | 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 791 | 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 808 | 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 892 | Line 865 | type
865      Result := str;
866    end;
867  
895 – { TIBWideMemoField }
896 –
897 – function TIBWideMemoField.GetTruncatedText: string;
898 – begin
899 –  Result := GetAsString;
900 –
901 –  if Result <> '' then
902 –    if DisplayWidth = 0 then
903 –      Result := TextToSingleLine(Result)
904 –    else
905 –    if Length(Result) > DisplayWidth then {Show truncation with elipses}
906 –      Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
907 – end;
908 –
909 – function TIBWideMemoField.GetDefaultWidth: Longint;
910 – begin
911 –  Result := 128;
912 – end;
913 –
914 – procedure TIBWideMemoField.GetText(var AText: string; ADisplayText: Boolean);
915 – begin
916 –  if ADisplayText then
917 –  begin
918 –    if not DisplayTextAsClassName and (CharacterSetName<> '') then
919 –      AText := GetTruncatedText
920 –    else
921 –      inherited GetText(AText, ADisplayText);
922 –  end
923 –  else
924 –    AText := GetAsString;
925 – end;
926 –
927 – constructor TIBWideMemoField.Create(AOwner: TComponent);
928 – begin
929 –  inherited Create(AOwner);
930 –  BlobType := ftWideMemo;
931 – end;
932 –
868   { TIBMemoField }
869  
870   function TIBMemoField.GetTruncatedText: string;
# Line 965 | 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 996 | 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 1076 | 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 1086 | 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 1110 | 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 1772 | Line 1715 | var
1715    LocalInt64: Int64;
1716    LocalCurrency: Currency;
1717    FieldsLoaded: Integer;
1775 –  temp: TIBXSQLVAR;
1718   begin
1719    p := PRecordData(Buffer);
1720    { Make sure blob cache is empty }
# Line 1821 | 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 1901 | 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
1910 <              temp :=  Qry.Current[i];
1911 <              LocalData := @temp.Data^.sqldata[2];
1912 < (*              LocalData := @Qry.Current[i].Data^.sqldata[2];*)
1913 <            end;
1858 >              Inc(LocalData,2);
1859            end;
1860          end;
1861          SQL_BOOLEAN:
# Line 1921 | 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;
1927 –          if (rdFields[j].fdDataType = SQL_TEXT) then
1928 –            rdFields[j].fdDataLength := rdFields[j].fdDataSize;
1881          end;
1882        end;
1883        if RecordNumber < 0 then
# Line 2460 | 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 2508 | 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 3428 | 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 3574 | 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}
3582 –            {FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3539              FieldSize := sqllen;
3540 <            if CharSetSize = 2 then
3585 <              FieldType := ftWideString
3586 <            else
3587 <              FieldType := ftString;
3540 >            FieldType := ftString;
3541            end;
3542            { All Doubles/Floats should be cast to doubles }
3543            SQL_DOUBLE, SQL_FLOAT:
# Line 3644 | 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}
3654 <              end
3655 <              else
3656 <              if strpas(sqlname) <> '' then
3657 <              begin
3658 <                charSetID := GetBlobCharSetID(Database.Handle,Database.InternalTransaction.Handle,
3659 <                        @relname,@sqlname);
3660 <                CharSetSize := FBase.GetCharSetSize(charSetID);
3661 <                CharSetName := FBase.GetCharSetName(charSetID);
3662 <                {$IFDEF HAS_ANSISTRING_CODEPAGE}
3663 <                FieldCodePage := FBase.GetCodePage(charSetID);
3664 <                {$ENDIF}
3665 <             end
3666 <              else  {Complex SQL with no identifiable column and no connection default}
3667 <              begin
3668 <                CharSetName := '';
3669 <                CharSetSize := 1;
3670 <                {$IFDEF HAS_ANSISTRING_CODEPAGE}
3671 <                FieldCodePage := CP_NONE;
3672 <                {$ENDIF}
3673 <              end;
3674 <              if CharSetSize = 2 then
3675 <                FieldType := ftWideMemo
3676 <              else
3677 <                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 3880 | Line 3809 | procedure TIBCustomDataSet.InternalOpen;
3809            end;
3810          end
3811          else
3883 –        if(Fields[i] is TIBWideStringField) then
3884 –        with TIBWideStringField(Fields[i]) do
3885 –        begin
3886 –          IBFieldDef := GetFieldDef(FieldNo);
3887 –          if IBFieldDef <> nil then
3888 –          begin
3889 –            CharacterSetSize := IBFieldDef.CharacterSetSize;
3890 –            CharacterSetName := IBFieldDef.CharacterSetName;
3891 –          end;
3892 –        end
3893 –        else
3812          if(Fields[i] is TIBMemoField) then
3813          with TIBMemoField(Fields[i]) do
3814          begin
# Line 3904 | Line 3822 | procedure TIBCustomDataSet.InternalOpen;
3822              {$ENDIF}
3823            end;
3824          end
3907 –        else
3908 –        if(Fields[i] is TIBWideMemoField) then
3909 –        with TIBWideMemoField(Fields[i]) do
3910 –        begin
3911 –          IBFieldDef := GetFieldDef(FieldNo);
3912 –          if IBFieldDef <> nil then
3913 –          begin
3914 –            CharacterSetSize := IBFieldDef.CharacterSetSize;
3915 –            CharacterSetName := IBFieldDef.CharacterSetName;
3916 –          end;
3917 –        end
3825        end
3826    end;
3827  
# Line 4677 | Line 4584 | begin
4584    DataSet.SetInternalSQLParams(Query, buff);
4585   end;
4586  
4587 + function TIBDSBlobStream.GetSize: Int64;
4588 + begin
4589 +  Result := FBlobStream.BlobSize;
4590 + end;
4591 +
4592   { TIBDSBlobStream }
4593   constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
4594                                      Mode: TBlobStreamMode);
# Line 4685 | Line 4597 | begin
4597    FBlobStream := ABlobStream;
4598    FBlobStream.Seek(0, soFromBeginning);
4599    if (Mode = bmWrite) then
4600 +  begin
4601      FBlobStream.Truncate;
4602 +    TIBCustomDataSet(FField.DataSet).RecordModified(True);
4603 +    TBlobField(FField).Modified := true;
4604 +    FHasWritten := true;
4605 +  end;
4606   end;
4607  
4608   destructor TIBDSBlobStream.Destroy;

Diff Legend

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