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 38 by tony, Mon Feb 15 14:44:25 2016 UTC vs.
Revision 39 by tony, Tue May 17 08:14:52 2016 UTC

# Line 33 | Line 33
33  
34   unit IBCustomDataSet;
35  
36 + {$IF FPC_FULLVERSION >= 20700 }
37 + {$codepage UTF8}
38 + {$DEFINE HAS_ANSISTRING_CODEPAGE}
39 + {$DEFINE NEW_TBOOKMARK}
40 + {$ENDIF}
41 +
42   {$R-}
43  
44   {$Mode Delphi}
# Line 120 | Line 126 | type
126  
127    TIBStringField = class(TStringField)
128    private
129 <    FCharacterSetName: string;
129 >    FCharacterSetName: RawByteString;
130      FCharacterSetSize: integer;
131    protected
132      function GetDefaultWidth: Longint; override;
# Line 131 | Line 137 | type
137      function GetAsVariant: Variant; override;
138      function GetValue(var Value: string): Boolean;
139      procedure SetAsString(const Value: string); override;
140 <    property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
140 >    property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
141      property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
142 +    {$IFDEF HAS_ANSISTRING_CODEPAGE}
143 +    private
144 +      FCodePage: TSystemCodePage;
145 +    public
146 +      property CodePage: TSystemCodePage read FCodePage write FCodePage;
147 +    {$ENDIF}
148    end;
149  
150    { TIBWideStringField }
151  
152    TIBWideStringField = class(TWideStringField)
153    private
154 <    FCharacterSetName: string;
154 >    FCharacterSetName: RawByteString;
155      FCharacterSetSize: integer;
156    public
157 <    property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
157 >    property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
158      property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
159    end;
160  
# Line 172 | Line 184 | type
184  
185     TIBMemoField = class(TMemoField)
186     private
187 <     FCharacterSetName: string;
187 >     FCharacterSetName: RawByteString;
188       FCharacterSetSize: integer;
189       FDisplayTextAsClassName: boolean;
190       function GetTruncatedText: string;
191     protected
192 +     function GetAsString: string; override;
193       function GetDefaultWidth: Longint; override;
194       procedure GetText(var AText: string; ADisplayText: Boolean); override;
195 +     procedure SetAsString(const AValue: string); override;
196     public
197       constructor Create(AOwner: TComponent); override;
198 <     property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
198 >     property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
199       property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
200 <  published
200 >   published
201       property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
202                                              write FDisplayTextAsClassName;
203 +   {$IFDEF HAS_ANSISTRING_CODEPAGE}
204 +   private
205 +     FCodePage: TSystemCodePage;
206 +     FFCodePage: TSystemCodePage;
207 +   public
208 +     property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
209 +   {$ENDIF}
210     end;
211  
212     { TIBWideMemoField }
213  
214     TIBWideMemoField = class(TWideMemoField)
215     private
216 <     FCharacterSetName: string;
216 >     FCharacterSetName: RawByteString;
217       FCharacterSetSize: integer;
218       FDisplayTextAsClassName: boolean;
219       function GetTruncatedText: string;
# Line 201 | Line 222 | type
222       procedure GetText(var AText: string; ADisplayText: Boolean); override;
223     public
224       constructor Create(AOwner: TComponent); override;
225 <     property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
225 >     property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
226       property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
227     published
228        property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
# Line 816 | Line 837 | type
837  
838    TIBFieldDef = class(TFieldDef)
839    private
840 <    FCharacterSetName: string;
840 >    FCharacterSetName: RawByteString;
841      FCharacterSetSize: integer;
842 +    {$IFDEF HAS_ANSISTRING_CODEPAGE}
843 +    FCodePage: TSystemCodePage;
844 +    {$ENDIF}
845    published
846 <    property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
846 >    property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
847      property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
848 +    {$IFDEF HAS_ANSISTRING_CODEPAGE}
849 +    property CodePage: TSystemCodePage read FCodePage write FCodePage;
850 +    {$ENDIF}
851    end;
852  
853  
# Line 888 | Line 915 | procedure TIBWideMemoField.GetText(var A
915   begin
916    if ADisplayText then
917    begin
918 <    if not DisplayTextAsClassName then
918 >    if not DisplayTextAsClassName and (CharacterSetName<> '') then
919        AText := GetTruncatedText
920      else
921        inherited GetText(AText, ADisplayText);
# Line 932 | Line 959 | begin
959     end
960   end;
961  
962 + function TIBMemoField.GetAsString: string;
963 + var s: RawByteString;
964 + begin
965 +  s := inherited GetAsString;
966 +  {$IFDEF HAS_ANSISTRING_CODEPAGE}
967 +  SetCodePage(s,CodePage,false);
968 +  {$ENDIF}
969 +  Result := s;
970 + end;
971 +
972   function TIBMemoField.GetDefaultWidth: Longint;
973   begin
974    if DisplayTextAsClassName then
# Line 944 | Line 981 | procedure TIBMemoField.GetText(var AText
981   begin
982    if ADisplayText then
983    begin
984 <    if not DisplayTextAsClassName then
984 >    if not DisplayTextAsClassName and (CharacterSetName <> '') then
985        AText := GetTruncatedText
986      else
987        inherited GetText(AText, ADisplayText);
# Line 953 | Line 990 | begin
990      AText := GetAsString;
991   end;
992  
993 + procedure TIBMemoField.SetAsString(const AValue: string);
994 + var s: RawByteString;
995 + begin
996 +  s := AValue;
997 +  {$IFDEF HAS_ANSISTRING_CODEPAGE}
998 +  if StringCodePage(Value) <> CodePage then
999 +    SetCodePage(s,CodePage,true);
1000 +  {$ENDIF}
1001 +  inherited SetAsString(s);
1002 + end;
1003 +
1004   constructor TIBMemoField.Create(AOwner: TComponent);
1005   begin
1006    inherited Create(AOwner);
1007    BlobType := ftMemo;
1008 +  {$IFDEF HAS_ANSISTRING_CODEPAGE}
1009 +  FCodePage := CP_NONE;
1010 +  {$ENDIF}
1011   end;
1012  
1013   { TIBControlLink }
# Line 999 | Line 1050 | constructor TIBStringField.Create(aOwner
1050   begin
1051    inherited Create(aOwner);
1052    FCharacterSetSize := 1;
1053 +  {$IFDEF HAS_ANSISTRING_CODEPAGE}
1054 +  FCodePage := CP_NONE;
1055 +  {$ENDIF}
1056   end;
1057  
1058   class procedure TIBStringField.CheckTypeSize(Value: Integer);
# Line 1021 | Line 1075 | end;
1075   function TIBStringField.GetValue(var Value: string): Boolean;
1076   var
1077    Buffer: PChar;
1078 +  s: RawByteString;
1079   begin
1080    Buffer := nil;
1081    IBAlloc(Buffer, 0, Size + 1);
# Line 1028 | Line 1083 | begin
1083      Result := GetData(Buffer);
1084      if Result then
1085      begin
1086 +      {$IFDEF HAS_ANSISTRING_CODEPAGE}
1087 +      s := string(Buffer);
1088 +      SetCodePage(s,CodePage,false);
1089 +      Value := s;
1090 + //      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1091 +      {$ELSE}
1092        Value := string(Buffer);
1093 +      {$ENDIF}
1094        if Transliterate and (Value <> '') then
1095          DataSet.Translate(PChar(Value), PChar(Value), False);
1096      end
# Line 1040 | Line 1102 | end;
1102   procedure TIBStringField.SetAsString(const Value: string);
1103   var
1104    Buffer: PChar;
1105 +  s: RawByteString;
1106   begin
1107    Buffer := nil;
1108    IBAlloc(Buffer, 0, Size + 1);
1109    try
1110 <    StrLCopy(Buffer, PChar(Value), Size);
1110 >    s := Value;
1111 >    {$IFDEF HAS_ANSISTRING_CODEPAGE}
1112 >    if StringCodePage(s) <> CodePage then
1113 >      SetCodePage(s,CodePage,true);
1114 >    {$ENDIF}
1115 >    StrLCopy(Buffer, PChar(s), Size);
1116      if Transliterate then
1117        DataSet.Translate(Buffer, Buffer, True);
1118      SetData(Buffer);
# Line 1260 | Line 1328 | end;
1328  
1329   procedure TIBCustomDataSet.ApplyUpdates;
1330   var
1331 <  {$IF FPC_FULLVERSION >= 20700 }
1331 >  {$IFDEF NEW_TBOOKMARK }
1332    CurBookmark: TBookmark;
1333    {$ELSE}
1334    CurBookmark: string;
# Line 1995 | Line 2063 | function TIBCustomDataSet.InternalLocate
2063    const KeyValues: Variant; Options: TLocateOptions): Boolean;
2064   var
2065    keyFieldList: TList;
2066 <  {$IF FPC_FULLVERSION >= 20700 }
2066 >  {$IFDEF NEW_TBOOKMARK }
2067    CurBookmark: TBookmark;
2068    {$ELSE}
2069    CurBookmark: string;
# Line 2937 | Line 3005 | end;
3005  
3006   procedure TIBCustomDataSet.FetchAll;
3007   var
3008 <  {$IF FPC_FULLVERSION >= 20700 }
3008 >  {$IFDEF NEW_TBOOKMARK }
3009    CurBookmark: TBookmark;
3010    {$ELSE}
3011    CurBookmark: string;
# Line 3362 | Line 3430 | var
3430    FieldSize: Word;
3431    charSetID: short;
3432    CharSetSize: integer;
3433 <  CharSetName: string;
3433 >  CharSetName: RawByteString;
3434 >  {$IFDEF HAS_ANSISTRING_CODEPAGE}
3435 >  FieldCodePage: TSystemCodePage;
3436 >  {$ENDIF}
3437    FieldNullable : Boolean;
3438    i, FieldPosition, FieldPrecision: Integer;
3439    FieldAliasName, DBAliasName: string;
# Line 3495 | Line 3566 | begin
3566          FieldNullable := SourceQuery.Current[i].IsNullable;
3567          CharSetSize := 0;
3568          CharSetName := '';
3569 +        {$IFDEF HAS_ANSISTRING_CODEPAGE}
3570 +        FieldCodePage := CP_NONE;
3571 +        {$ENDIF}
3572          case sqltype and not 1 of
3573            { All VARCHAR's must be converted to strings before recording
3574             their values }
# Line 3502 | Line 3576 | begin
3576            begin
3577              CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3578              CharSetName := FBase.GetCharSetName(sqlsubtype and $FF);
3579 +            {$IFDEF HAS_ANSISTRING_CODEPAGE}
3580 +            FieldCodePage := FBase.GetCodePage(sqlsubtype and $FF);
3581 +            {$ENDIF}
3582              {FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3583              FieldSize := sqllen;
3584              if CharSetSize = 2 then
# Line 3567 | Line 3644 | begin
3644              FieldSize := sizeof (TISC_QUAD);
3645              if (sqlsubtype = 1) then
3646              begin
3647 <              if strpas(sqlname) = '' then {Complex SQL with no identifiable column - use connection default}
3647 >              if FBase.GetDefaultCharSetName <> '' then
3648                begin
3649                  CharSetSize := FBase.GetDefaultCharSetSize;
3650                  CharSetName := FBase.GetDefaultCharSetName;
3651 +                {$IFDEF HAS_ANSISTRING_CODEPAGE}
3652 +                FieldCodePage := FBase.GetDefaultCodePage;
3653 +                {$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
# Line 3612 | Line 3704 | begin
3704              InternalCalcField := False;
3705              CharacterSetSize := CharSetSize;
3706              CharacterSetName := CharSetName;
3707 +            {$IFDEF HAS_ANSISTRING_CODEPAGE}
3708 +            CodePage := FieldCodePage;
3709 +            {$ENDIF}
3710              if (FieldName <> '') and (RelationName <> '') then
3711              begin
3712                if Has_COMPUTED_BLR(RelationName, FieldName) then
# Line 3779 | Line 3874 | procedure TIBCustomDataSet.InternalOpen;
3874            begin
3875              CharacterSetSize := IBFieldDef.CharacterSetSize;
3876              CharacterSetName := IBFieldDef.CharacterSetName;
3877 +            {$IFDEF HAS_ANSISTRING_CODEPAGE}
3878 +            CodePage := IBFieldDef.CodePage;
3879 +            {$ENDIF}
3880            end;
3881          end
3882          else
# Line 3801 | Line 3899 | procedure TIBCustomDataSet.InternalOpen;
3899            begin
3900              CharacterSetSize := IBFieldDef.CharacterSetSize;
3901              CharacterSetName := IBFieldDef.CharacterSetName;
3902 +            {$IFDEF HAS_ANSISTRING_CODEPAGE}
3903 +            CodePage := IBFieldDef.CodePage;
3904 +            {$ENDIF}
3905            end;
3906          end
3907          else
# Line 3970 | Line 4071 | end;
4071   function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4072                                   Options: TLocateOptions): Boolean;
4073   var
4074 <  {$IF FPC_FULLVERSION >= 20700 }
4074 >  {$IFDEF NEW_TBOOKMARK }
4075    CurBookmark: TBookmark;
4076    {$ELSE}
4077    CurBookmark: string;
# Line 3992 | Line 4093 | function TIBCustomDataSet.Lookup(const K
4093                                   const ResultFields: string): Variant;
4094   var
4095    fl: TList;
4096 <  {$IF FPC_FULLVERSION >= 20700 }
4096 >  {$IFDEF NEW_TBOOKMARK }
4097    CurBookmark: TBookmark;
4098    {$ELSE}
4099    CurBookmark: string;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines