Можно ли изменить класс TStringField (с новым свойством)

Используя Delphi 11.3 и базу данных Oracle с использованием UniDac, у меня возникла проблема: существует множество старых приложений (написанных на Cobol), которые не поддерживают Unicode, поэтому данные для текстовых полей сохраняются как текст Ansi с использованием кодовой страницы клиента (Windows) ( 125х). Мне приходится заменять их шаг за шагом и использовать «новые» таблицы, в которых я храню данные в Юникоде (UTF-16).

Пока старые приложения все еще используются, мне приходится «переводить» строки Ansi в UTF (и обратно для записи).

Я написал 2 функции:
function AnsiToUTF(Value: AnsiString; codepage: word): string;
и
function UTFToAnsi(Value: string; codepage word): AnsiString
которые работают.

Я поискал по этому форуму и вроде бы можно внести изменения в класс, но у меня нет опыта в этом.

Было бы здорово, если бы я мог применить новое свойствоAsUTFкTStringFieldкласс с двумя моими функциями, встроенными вSetAsUTF()иGetAsUTF()к этому я могу вызвать их в любом компоненте, поддерживающем данные, используяTFields. Например:

MyString := UniQuery1.FieldByName('TEXT').AsUTF(1252);
и
UniQuery1.FieldByName('TEXT').AsUTF(1252) := MyString;

Возможно ли это (или есть ли лучшее решение)?

#EDIT: мне сказали привести воспроизводимый пример, вот он:

      unit UTFStringField;

TUTFStringField = class(TWideStringField)
protected
  procedure SetAsUTF(UTF: string; Codepage: word);
  function GetAsUTF(Codepage: word): string;
  constructor Create; override;
  destructor Destroy; override;
public
  function UTFToAnsi(txt: string; GCodePage: word): Ansistring;
  function AnsiToUTF(txt: Ansistring; GCodepage: word): string;
end;

implementation

procedure TUTFStringField.SetAsUTF(UTF: string; Codepage: word);
begin
  SetAsAnsiString(UTFToAnsi(UTF,Codepage));
end;

function TUTFStringField.GetAsUTF(CodePage: word): string;
begin
  Result := AnsiToUTF(GetAsAnsiString,CodePage);
end;

constructor TUTFStringField.Create;
begin
  inherited Create;
  DefaultFieldClasses[ftWideString] := TUTFStringField;
end;

destructor TUTFStringField.Destroy;
begin
  DefaultFieldClasses[ftWideString] := TWideStringField;
  inherited destroy;
end;

function TUTFStringField.AnsiToUTF(txt: Ansistring; GCodepage:     word): string;
var
  NewStr: string;
  OldChar: AnsiChar;
  NewChar: Char;
  i: integer;
begin
  NewStr := '';
  case GCodepage of
  1250: begin
        for i := 1 to Length(txt) do
          begin
            OldChar := txt[i];
            NewChar := Char(OldChar);
            case Ord(OldChar) of
            $80: NewChar := Char($20AC); // #EURO SIGN
            $82: NewChar := Char($201A); // #SINGLE LOW-9         
            $84: NewChar := Char($201E); // #DOUBLE LOW-9 
            $85: NewChar := Char($2026); // #HORIZONTAL ELLIPSIS
            ....
            end;
            NewStr := NewStr + NewChar;
          end;
        end;
  1251: begin
          for i := 1 to Length(txt) do
          begin
            OldChar := AnsiChar(txt[i]);
            NewChar := Char(OldChar);
            case Ord(OldChar) of
            $80: NewChar := Char($0402); // #CYRILLIC CAPITAL LETTER   
            $81: NewChar := Char($0403); // #CYRILLIC CAPITAL LETTER 
            $82: NewChar := Char($201A); // #SINGLE LOW-9 QUOTATION      
            ...
           end;
            NewStr := NewStr + NewChar;
          end;
        end;
  end;
  Result := NewStr;
end;

function TUTFStringField.UTFToAnsi(txt: string; GCodepage: word):    Ansistring;
var
  NewStr: Ansistring;
  OldChar: Char;
  NewChar: AnsiChar;
  i: integer;
begin

  NewStr := '';

  case GCodepage of
  1250: begin
          for i := 1 to Length(txt) do
          begin
            OldChar := Copy(txt,i,1);
            NewChar := AnsiChar(OldChar);
            case Ord(OldChar) of
            $20AC: NewChar := AnsiChar($80);
            $201A: NewChar := AnsiChar($82);
            $201E: NewChar := AnsiChar($84); // DOUBLE LOW-9 
            $2026: NewChar := AnsiChar($85); // HORIZONTAL ELLIPSIS
            $2020: NewChar := AnsiChar($86); // DAGGER
            ....
            end;
            NewStr := NewStr + NewChar;
          end;
        end;
  1251: begin
          for i := 1 to Length(txt) do
          begin
            OldChar := Char(txt[i]);
            NewChar := AnsiChar(OldChar);
            case Ord(OldChar) of
            $0402: NewChar := AnsiChar($80); //  CYRILLIC CAPITAL 
            $0403: NewChar := AnsiChar($81); //  CYRILLIC CAPITAL 
            $201A: NewChar := AnsiChar($82); //  SINGLE LOW-9 
            $0453: NewChar := AnsiChar($83); //  CYRILLIC SMALL 
            $201E: NewChar := AnsiChar($84); //  DOUBLE LOW-9 
            end;
            NewStr := NewStr + NewChar;
          end;
        end;
  end;

interface

  RegisterClass(TUTFStringField);

end.

Наверняка конструктор/деструктор неправильный, но я понятия не имею, как и где внедрить свой новыйTUTFStringFieldclass, чтобы он всегда использовался в данный момент, например, когда я добавляю компонент UniQuery в свою форму.

Да, и кстати: я поставил"UniCode"в поставщике Oracle Uni установлено значение true, поскольку мои новые приложения должны использовать Unicode по умолчанию (кодировка базы данных — UTF-16).

Источник

1 ответ

К вашему сведению, ваши функции перевода не нужны. RTL имеет свои собственные способы преобразования строк Ansi в/из кодовых страниц, например:System.LocaleCharsFromUnicode()иSystem.UnicodeFromLocaleChars(), илиSysUtils.TEncoding, илиRawByteStringсSystem.SetCodePage().

Вам следует использовать встроенный функционал вместо того, чтобы накатывать свой собственный. тем более, что вы не обрабатываете суррогаты UTF-16, тогда как RTL будет.

Вместо этого попробуйте что-нибудь подобное:

      unit UTFStringField;

interface

uses
  Data.DB;

type
  TUTFStringField = helper class for TField
  public
    procedure SetAsUTF(const UTF: string; Codepage: Word);
    function GetAsUTF(Codepage: Word): string;
  end;

implementation

procedure TUTFStringField.SetAsUTF(const UTF: string; Codepage: Word);
var
  NewStr: AnsiString;
begin
  SetLength(NewStr, LocaleCharsFromUnicode(Codepage, 0, PChar(UTF), Length(UTF), nil, 0, nil, nil));
  LocaleCharsFromUnicode(Codepage, 0, PChar(UTF), Length(UTF), PAnsiChar(NewStr), Length(NewStr), nil, nil);
  SetCodePage(PRawByteString(@NewStr)^, Codepage, False);

  { alternatively:
  var enc: TEncoding := TEncoding.GetEncoding(Codepage);
  try
    SetLength(NewStr, enc.GetByteCount(UTF));
    enc.GetBytes(PChar(UTF), Length(UTF), PByte(PAnsiChar(NewStr)), Length(NewStr));
  finally
    enc.Free;
  end;
  SetCodePage(PRawByteString(@NewStr)^, Codepage, False);
  }

  { alternatively:
  var raw: RawByteString := PRawByteString(@UTF)^;
  SetCodePage(raw, Codepage, True);
  NewStr := PAnsiString(@raw)^;
  }

  Self.AsAnsiString := NewStr;
end;

function TUTFStringField.GetAsUTF(Codepage: Word): string;
var
  txt: AnsiString;
begin
  txt := Self.AsAnsiString;

  SetLength(Result, UnicodeFromLocaleChars(Codepage, 0, PAnsiChar(txt), Length(txt), nil, 0));
  UnicodeFromLocaleChars(Codepage, 0, PAnsiChar(txt), Length(txt), PWideChar(Result), Length(Result));

  { alternatively:
  var enc: TEncoding := TEncoding.GetEncoding(Codepage);
  try
    SetLength(Result, enc.GetCharCount(PByte(PAnsiChar(txt)), Length(txt)));
    enc.GetChars(PByte(PAnsiChar(txt)), Length(txt), PChar(Result), Length(Result));
  finally
    enc.Free;
  end;
  }

  { alternatively:
  SetCodePage(PRawByteString(@txt)^, Codepage, False);
  Result := string(txt);
  }
end;

end.

И затем вы можете называть их так (только убедитесь, чтоUTFStringFieldнаходится вusesпункт):

      MyString := UniQuery1.FieldByName('TEXT').GetAsUTF(1252);

      UniQuery1.FieldByName('TEXT').SetAsUTF(MyString, 1252);
Источник
Другие вопросы по тегам