Быстрая перекодировка строки в Unicode?

[kotompazb]

Здравствуйте.
В общем есть весьма корявый код:

Код: Выделить всё

Profi2Uni: array [128..255] of string = (
  '░','▒','▓','│','┤','╡','╢','╖','╕','╣','║','╗','╝','╜','╛','┐',
  '└','┴','┬','├','─','┼','╞','╟','╚','╔','╩','╦','╠','═','╬','╧',
  '╨','╤','╥','╙','╘','╒','╓','╫','╪','┘','┌','█','▄','▌','▐','▀',
  'α','β','γ','π','Σ','σ','μ','τ','Φ','Θ','Ω',' ',' ',' ','Є','∩',
  'ю','а','б','ц','д','е','ф','г','х','и','й','к','л','м','н','о',
  'п','я','р','с','т','у','ж','в','ь','ы','з','ш','э','щ','ч','ъ',
  'Ю','А','Б','Ц','Д','Е','Ф','Г','Х','И','Й','К','Л','М','Н','О',
  'П','Я','Р','С','Т','У','Ж','В','Ь','Ы','З','Ш','Э','Щ','Ч','Ъ');

function ToUnicode (const OriginalTxt: TBytes; ConvertTbl: array of string): string;
var
  i: integer;
begin
  Result:='';
  for i:=0 to High(OriginalTxt) do
    if OriginalTxt[i]<$80 then Result:=Result+Ansichar(OriginalTxt[i])
     else Result:=Result+ConvertTbl[(OriginalTxt[i]-$80)];
end;


Использую так:

Код: Выделить всё

Memo1.Text:=ToUnicode(OriginalBytes,Profi2Uni);

В принципе работает, только уж очень медленно!
Что можете посоветовать?

[zub]

убрать это
Result:=Result+...
и сделать "двухпроходно" на первом проходе расчитываем длину результирующей строки и создаем ее пустой, на втором проходе заменяем в уже созданой строке байтики на нужные

[kotompazb]

Спасибо. А можно поподробнее?
То есть я правильно понял?
Мне стоит хранить в табличках не символы, а соответствующие им в Unicode коды,
затем при первом проходе посчитать длину результирующей строки в байтах,
создать результирующий массив полученной длины,
затем перекодировать один массив байт (исходный), в результирующий массив
и как-то сделать его строкой?
Так?
Я просто не совсем в курсе. Это же просто хобби для меня.

[bormant]

А если так:

Код: Выделить всё

const
  Profi2Uni: array [128..255] of WideChar = (
    #$2591, #$2592, #$2593, #$2502, #$2524, #$2561, #$2562, #$2556,
    #$2555, #$2563, #$2551, #$2557, #$255D, #$255C, #$255B, #$2510,
    #$255A, #$2554, #$2569, #$2566, #$2560, #$2550, #$256C, #$2567,
    //далее самостоятельно
  );
{
  '░','▒','▓','│','┤','╡','╢','╖',
  '╕','╣','║','╗','╝','╜','╛','┐',
  '└','┴','┬','├','─','┼','╞','╟',
  '╚','╔','╩','╦','╠','═','╬','╧',
  '╨','╤','╥','╙','╘','╒','╓','╫',
  '╪','┘','┌','█','▄','▌','▐','▀',
  'α','β','γ','π','Σ','σ','μ','τ',
  'Φ','Θ','Ω',' ',' ',' ','Є','∩',
  'ю','а','б','ц','д','е','ф','г',
  'х','и','й','к','л','м','н','о',
  'п','я','р','с','т','у','ж','в',
  'ь','ы','з','ш','э','щ','ч','ъ',
  'Ю','А','Б','Ц','Д','Е','Ф','Г',
  'Х','И','Й','К','Л','М','Н','О',
  'П','Я','Р','С','Т','У','Ж','В',
  'Ь','Ы','З','Ш','Э','Щ','Ч','Ъ';
}

function ToUnicode(const OriginalTxt: array of Byte; ConvertTbl: array of WideChar): String;
var
  i: Integer;
  w: UnicodeString;
begin
  SetLength(w,High(OriginalTxt));
  for i:=0 to High(OriginalTxt) do
    if OriginalTxt[i]<$80
    then w[i]:=WideChar(OriginalTxt[i])
    else w[i]:=ConvertTbl[(OriginalTxt[i]-$80)];
  ToUnicode:=UTF8Encode(w);
  SetLength(w,0);
end;

[kotompazb]

bormant
Почему-то вылетает ошибка во время выполнения на строке

Код: Выделить всё

ToUnicode:=UTF8Encode(w);

[Лекс Айрин]

kotompazb, какой режим компиляции?
Попробуйте поменять на

Код: Выделить всё

Result:=UTF8Encode(w);

[bormant]

Код: Выделить всё

function ToUnicode(const OriginalTxt: array of Byte; ConvertTbl: array of WideChar): String;
var
  i: Integer;
  w: UnicodeString;
begin
  SetLength(w,High(OriginalTxt)+1);
  for i:=0 to High(OriginalTxt) do
    if OriginalTxt[i]<$80
    then w[i+1]:=WideChar(OriginalTxt[i])
    else w[i+1]:=ConvertTbl[(OriginalTxt[i]-$80)];
  ToUnicode:=UTF8Encode(w);
  SetLength(w,0);
end;


UnicodeString от 1 индексируется, при попытке доступа к 0 элементу -- AV.
Для прикидки использовал чуть другой прототип, function ToUnicode(const OriginalTxt: String; ConvertTbl: array of WideChar): String; а при копировании на форум разницу в индексации (массивы от 0, строки от 1) не поправил.

[kotompazb]

bormant, спасибо, заработало. Теперь вроде быстрее стало.

[kotompazb]

А нет. Все по-прежнему актуально. Как выяснилось, скорость не изменилась абсолютно

[Ism]

Насколько я понял вы под UnicodeString понимаете UTF8 ?
Если так, то базовой должна быть UTF8

Код: Выделить всё

uses LConvEncoding;
procedure TForm1.Button1Click(Sender: TObject);
var
  source,utf8str:string;
  result_str:UnicodeString;
begin
  source:=UTF8ToCP1251('хрень');
  utf8str:= CP1251ToUTF8(source);
  result_str:=UTF8Decode(utf8str);
end;             

[SSerge]

под UnicodeString понимаете UTF8

Ism, под UnicodeString модет пониматься только UnicodeString. Ви таки посмотрите типы строковых данных в мурзилке наконец. Где чотко написано, - для тех версий FPC, которые есть и существуют (2.6х) - UnicodeString есть полный алиас для WideString, которая ваще всегда UTF-16 и у нее нет счетсика экземпляров. Для тех версий FPC, которые как бы есть, но которых как бы не существует (3.х) - UnicodeString в принципе почти тоже WideString, но со счетчиком количества экземпляров и не является полным совпадением с WideString - формально: другой тип данных.

[Ism]

Ism, под UnicodeString модет пониматься только UnicodeString

Выше была упомянута, которая перегоняла в utf8

Код: Выделить всё

Result:=UTF8Encode(w);

[kotompazb]

Ну да. Мне в utf8 получается переводить надо. Ваще-то не существенно. Основной смысл - это вывод переконверченного текста в Memo и (при необходимости) последующее его (текста) сохранение в файл. Возможно я где-то не совсем точно выразился. Извиняюсь.

[bormant]

А вот так?

Код: Выделить всё

const
  Profi2Uni: array [128..255] of string[3] = (
    #$E2#$96#$91, #$E2#$96#$92, #$E2#$96#$93, #$E2#$94#$82,
    #$E2#$94#$A4, #$E2#$95#$A1, #$E2#$95#$A2, #$E2#$95#$96,
    #$E2#$95#$95, #$E2#$95#$A3, #$E2#$95#$91, #$E2#$95#$97,
    #$E2#$95#$9D, #$E2#$95#$9C, #$E2#$95#$9B, #$E2#$94#$90,
    #$E2#$94#$94, #$E2#$94#$B4, #$E2#$94#$AC, #$E2#$94#$9C,
    #$E2#$94#$80, #$E2#$94#$BC, #$E2#$95#$9E, #$E2#$95#$9F,
    #$E2#$95#$9A, #$E2#$95#$94, #$E2#$95#$A9, #$E2#$95#$A6,
    #$E2#$95#$A0, #$E2#$95#$90, #$E2#$95#$AC, #$E2#$95#$A7,
    #$E2#$95#$A8, #$E2#$95#$A4, #$E2#$95#$A5, #$E2#$95#$99,
    #$E2#$95#$98, #$E2#$95#$92, #$E2#$95#$93, #$E2#$95#$AB,
    #$E2#$95#$AA, #$E2#$94#$98, #$E2#$94#$8C, #$E2#$96#$88,
    #$E2#$96#$84, #$E2#$96#$8C, #$E2#$96#$90, #$E2#$96#$80,
    #$CE#$B1,     #$CE#$B2,     #$CE#$B3,     #$CF#$80,
    #$CE#$A3,     #$CF#$83,     #$CE#$BC,     #$CF#$84,
    #$CE#$A6,     #$CE#$98,     #$CE#$A9,     ' ',
    ' ',          ' ',          #$D0#$84,     #$E2#$88#$A9,
    #$D1#$8E,#$D0#$B0,#$D0#$B1,#$D1#$86,#$D0#$B4,#$D0#$B5,#$D1#$84,#$D0#$B3,
    #$D1#$85,#$D0#$B8,#$D0#$B9,#$D0#$BA,#$D0#$BB,#$D0#$BC,#$D0#$BD,#$D0#$BE,
    #$D0#$BF,#$D1#$8F,#$D1#$80,#$D1#$81,#$D1#$82,#$D1#$83,#$D0#$B6,#$D0#$B2,
    #$D1#$8C,#$D1#$8B,#$D0#$B7,#$D1#$88,#$D1#$8D,#$D1#$89,#$D1#$87,#$D1#$8A,
    #$D0#$AE,#$D0#$90,#$D0#$91,#$D0#$A6,#$D0#$94,#$D0#$95,#$D0#$A4,#$D0#$93,
    #$D0#$A5,#$D0#$98,#$D0#$99,#$D0#$9A,#$D0#$9B,#$D0#$9C,#$D0#$9D,#$D0#$9E,
    #$D0#$9F,#$D0#$AF,#$D0#$A0,#$D0#$A1,#$D0#$A2,#$D0#$A3,#$D0#$96,#$D0#$92,
    #$D0#$AC,#$D0#$AB,#$D0#$97,#$D0#$A8,#$D0#$AD,#$D0#$A9,#$D0#$A7,#$D0#$AA);
{
  '░','▒','▓','│','┤','╡','╢','╖','╕','╣','║','╗','╝','╜','╛','┐',
  '└','┴','┬','├','─','┼','╞','╟','╚','╔','╩','╦','╠','═','╬','╧',
  '╨','╤','╥','╙','╘','╒','╓','╫','╪','┘','┌','█','▄','▌','▐','▀',
  'α','β','γ','π','Σ','σ','μ','τ','Φ','Θ','Ω',' ',' ',' ','Є','∩',
  'ю','а','б','ц','д','е','ф','г','х','и','й','к','л','м','н','о',
  'п','я','р','с','т','у','ж','в','ь','ы','з','ш','э','щ','ч','ъ',
  'Ю','А','Б','Ц','Д','Е','Ф','Г','Х','И','Й','К','Л','М','Н','О',
  'П','Я','Р','С','Т','У','Ж','В','Ь','Ы','З','Ш','Э','Щ','Ч','Ъ'
}

function p2u(const s: String): String;
var r: String; p: PChar; i, n: Integer;
begin
  n:=0;
  for i:=1 to Length(s) do
    if s[i]<#$80 then
      Inc(n)
    else
      Inc(n,Length(Profi2Uni[Ord(s[i])]));
  SetLength(r,n); p:=@r[1];
  for i:=1 to Length(s) do
    if s[i]<#$80 then begin
      p^:=s[i]; Inc(p);
    end else
      for n:=1 to Length(Profi2Uni[Ord(s[i])]) do begin
        p^:=Profi2Uni[Ord(s[i])][n]; Inc(p);
      end;
  p2u:=r;
end;


Этот код уже достаточно легко переложить на ассемблер, читать из таблички лучше сразу в 32-битный регистр, тамошний String[3] отлично к тому подходит.

PS. Смущают 3 пробела в позициях $BB, $BC, $BD.

[kotompazb]

PS. Смущают 3 пробела в позициях $BB, $BC, $BD.

Просто я не в курсе, какие там должны быть символы. Жду картинку.

Вечером надо попробовать сей вариант, если поможет, останется только перезабить еще 4 таблички (KOI-8R, CP866, CP1251 и ISO 8859-5) и можно забыть, как о страшном сне

Вот так выглядит полный набор подопытной кодировки в оригинале.