Перекодировка HTML-entities to UTF8

[Снег Север]

В synapse гляньте на эти модули: synachar.pas и synacode.pas, по-моему там.

[vitaly_l]

на досуге исходники

tema в принципе правильное направление дал, т.к. можно открыть мнемоники в стандартном HTML-вьювере, который в лазарусе и потом взять оттуда уже текст в UTF-8, а не мнемоники. Конвертером из мнемоник в UTF-8 будет являться стандартный лазарусоовский HTML-вьювер (или хромовский гуугл).

.

[wofs]

на досуге исходники

tema в принципе правильное направление дал, т.к. можно открыть мнемоники в стандартном HTML-вьювере, который в лазарусе и потом взять оттуда уже текст в UTF-8, а не мнемоники. Конвертером из мнемоник в UTF-8 будет являться стандартный лазарусоовский HTML-вьювер (или хромовский гуугл).

.

Памяти сожрет... Буду копать в направлении перекодировки строки. Так как я по мере чтения из файла обрабатываю и импортирую данные в БД.
Файл уж очень сложный fpcspreadsheets ложится, при попытке его прочитать. У меня на i5 с 6гигами памяти даже Libre Office еле его ворочает - работать невозможно.
Пробую работать через xmlss (в названии мог ошибиться по памяти), но вылазит на одном файле проблема с кодировкой.

Добавлено спустя 12 часов 13 минут 25 секунд:
Покурив исходники: http://www.esperanto.mv.ru/UniRed/RUS/index.html
И, немного поправив одну из функций - получил на выходе:

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

function HTMLEntrToUTF8 (const S: WideString): WideString;
var W: WChar;
    i,j,n,code: Integer;
begin
SetLength(result,length(S));
i:=1; j:=1;
while i<=length(S) do
begin
       W:=WChar(S[i]);
       if (Copy(S,i,2)='&#') then
       begin
           i:=i+2;
           Val(Copy(S,i,4),n,code);
           if code=0 then
               i:=i+4
           else
               i:=i+code-1;
           if S[i]=';' then Inc(i);
           W:=WChar(n);
       end
       else
           Inc(i);
       result[j]:=W;
       Inc(j);
end;
SetLength(result,j-1);
end;


Добавлено спустя 24 минуты 58 секунд:
А, главное - выигрыш от использования XMLSS для чтения xlsx вместо fpspreadsheet составил почти 2 раза по памяти:
fpspreadsheet (64bit, 32bit ложится с OutOfMemory) во время чтения файла xlsx ~9Мб съел почти 3Гб RAM
XMLSS (64bit, 32bit) во время чтения того же файла съел почти 1,5Гб RAM

Добавлено спустя 3 минуты 14 секунд:
Всем спасибо за участие!

[sign]

http://alexboiko.narod.ru/prod.html

В коде надо... Раздел Lazarus...

А в чём сложность-то?

Пара строк и готово.

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

1040 - А 1041 - Б 1042 - В 1043 - Г 1044 - Д 1045 - Е 1046 - Ж 1047 - З 1048 - И 1049 - Й
1050 - К 1051 - Л 1052 - М 1053 - Н 1054 - О 1055 - П 1056 - Р 1057 - С 1058 - Т 1059 - У
1060 - Ф 1061 - Х 1062 - Ц 1063 - Ч 1064 - Ш 1065 - Щ 1066 - Ъ 1067 - Ы 1068 - Ь 1069 - Э
1070 - Ю 1071 - Я 1072 - а 1073 - б 1074 - в 1075 - г 1076 - д 1077 - е 1078 - ж 1079 - з
1080 - и 1081 - й 1082 - к 1083 - л 1084 - м 1085 - н 1086 - о 1087 - п 1088 - р 1089 - с
1090 - т 1091 - у 1092 - ф 1093 - х 1094 - ц 1095 - ч 1096 - ш 1097 - щ 1098 - ъ 1099 - ы
1100 - ь 1101 - э 1102 - ю 1103 - я

[vitaly_l]

W:=WChar(n);

Действительно коды мнемоник совпадают с кодами UTF-8 (по крайней мере в буквах) и их можно перекодировать без заложенного массива. Но далеко не факт, что мнемоники совпадают с UTF-8 - в символах, т.к. для символов свои ISO (я давал выше ссылку). При этом я не знаю, по каким правилам кодируют микрософтовцы в xls. Будь-те бдительны, т.к. могут быть накладки.

Добавлено спустя 22 минуты 22 секунды:

else
               i:=i+code-1;

Вышеприведённая строчка с else - вызывает сомнения, вкупе со всем вот этим блоком:

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

           Val(Copy(S,i,4),n,code);
           if code=0 then
               i:=i+4
           else
               i:=i+code-1;
           if S[i]=';' then Inc(i);
           W:=WChar(n);


В смысле дайте этой функции мнемонику из трёх или пяти цифр и функция рухнет

Добавлено спустя 33 минуты 33 секунды:

if S[i]=';' then Inc(i);

И вот сюда нужно добавить понимание глючности функции, например вот так:

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

if S[i]=';'
   then Inc(i)
   else showMessage('oh! so sorry - код облажался ;) ');


Правильно, будет проверять строку до вхождения знака ";" или пробела++ и потом в зависимости от кол-ва символов (4-ре, 3-и или иное) принимать решение с этой функцией Val(Copy(S,i,countChars),n,code); и если оно integer и+ if countChars = 4 , то делать W:=WChar(n);, а если не integer или if countChars <> 4 то ...

Иначе вот этот символ &#38; или вот этот &#169; <== вызовут явный сбой в функции взятой Вами, тут: "Покурив исходники: esperanto.mv.ru/UniRed/RUS/index.html"...

.

[wofs]

Иначе вот этот символ &#38; или вот этот &#169; <== вызовут явный сбой в функции взятой Вами,

Спокойно, без паники!

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

function HTMLEntrToUTF8 (const S: WideString): WideString;
var W: WChar;
    i,j,n,code: Integer;
    _PosSemicolon,_CodeLength:integer;
begin
SetLength(result,length(S));
i:=1; j:=1;
while i<=length(S) do
begin
       W:=WChar(S[i]);
       if (Copy(S,i,2)='&#') then
       begin
           i:=i+2;
           //detect code Length
           _PosSemicolon:=UTF8Pos(';',S,i);
           _CodeLength:= _PosSemicolon-i;

           if (_CodeLength >=2) and (_CodeLength<=4) then
           begin
               Val(Copy(S,i,_CodeLength),n,code);
               if code=0 then
                   i:=i+_CodeLength
               else
                   i:=i+code-1;
               if S[i]=';' then Inc(i);
               W:=WChar(n);
           end;

       end
       else
           Inc(i);
       result[j]:=W;
       Inc(j);
end;
SetLength(result,j-1);
end;   


Добавлено спустя 2 минуты 28 секунд:
Проверка на пробел думаю будет лишним движением, так как стандарт написания кода все таки имеется, имхо.

[vitaly_l]

if (_CodeLength >=2)

А вот это что не мнемоники по Вашему: &#1; &#2; &#3; ... &#9; <== ?


Потом, при нахождении символа ";" всегда должно выполняться i:=i+_CodeLength; и получается, вот этот: i:=i+code-1; <== лишний анахронизм. Однако, в случае, если в Val - окажется не integer, то Ваша функция опять сбойнёт вот в этом лишнем анахронизме:

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

if S[i]=';'
   then Inc(i)
   else showMessage('oh! so sorry - код облажался ;) ');


и соответственно вот здесь у вас какой-то лишний анахронизм:

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

else
                   i:=i+code-1;


У Вас нет правильных действий на случай, если в Val(Copy(S,i,_CodeLength),n,code) code не ноль.
В смысле, после того как Вы ввели правильную: _PosSemicolon:=UTF8Pos(';',S,i); и ограничили длину 4-мя символами, вышеприведённые анахронизмы уже ненужны. Вместо анахронизмов, можно вставить: i:=i+_CodeLength + 1; и сократить код на несколько строк.
.

[wofs]

и сократить код на несколько строк.

Так лучше?

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

function HTMLEntrToUTF8 (const S: WideString): WideString;
var W: WChar;
    i,j,n: Integer;
    _PosSemicolon,_CodeLength:integer;
begin
SetLength(result,length(S));
i:=1; j:=1;
while i<=length(S) do
begin
       W:=WChar(S[i]);
       if (Copy(S,i,2)='&#') then
       begin
           i:=i+2;
           //detect code Length
           _PosSemicolon:=UTF8Pos(';',S,i);
           _CodeLength:= _PosSemicolon-i;

           if (_CodeLength >=1) and (_CodeLength<=4) then
           begin
               TryStrToInt( Copy(S,i,_CodeLength),n); // can be mixed text
               i:=i+_CodeLength+1;
               W:=WChar(n);
           end;

       end
       else
           Inc(i);
       result[j]:=W;
       Inc(j);
end;
SetLength(result,j-1);
end;   


Добавлено спустя 9 минут 57 секунд:

что мнемоники совпадают с UTF-8 - в символах, т.к. для символов свои ISO (я давал выше ссылку).

Судя по диф выборке с http://www.utf8-zeichentabelle.de/unico ... &htmlent=1 совпадают.

[vitaly_l]

Так лучше?

да, но более правильно сделать вот так:

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

if (_CodeLength >=1) and (_CodeLength<=4) then begin
   if TryStrToInt( Copy(S,i,_CodeLength),n)
               then W:=WChar(n)
               else W := '?' ; // тут нужно что-то на случай, если не...
   end else W := '?' ; // тут тоже нужно что-то на случай, если не...

i:=i+_CodeLength+1;             


Так будут исключены сбои. ИМХО

[wofs]

да, но более правильно сделать вот так:

Согласен.
Итоговый результат:

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

function HTMLEntrToUTF8 (const S: WideString): WideString;
var W: WChar;
    i,j,n: Integer;
    _PosSemicolon,_CodeLength:integer;
begin
SetLength(result,length(S));
i:=1; j:=1;
while i<=length(S) do
begin
       W:=WChar(S[i]);
       if (Copy(S,i,2)='&#') then
       begin
           i:=i+2;
           //detect code Length
           _PosSemicolon:=UTF8Pos(';',S,i);
           _CodeLength:= _PosSemicolon-i;

           if (_CodeLength >=1) and (_CodeLength<=4) then
           begin
               if
                 TryStrToInt( Copy(S,i,_CodeLength),n) // can be mixed text
               then
                 W:=WChar(n)
               else
                 W:='?'; // if no...

               i:=i+_CodeLength+1;
           end;

       end
       else
           Inc(i);
       result[j]:=W;
       Inc(j);
end;
SetLength(result,j-1);
end;                   


Спасибо за ликбез.

[vitaly_l]

результат

Там есть ещё одно маловероятное место, на случай, если ВДРУГ мнемоника > 4-х символов.

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

if (_CodeLength >=1) and (_CodeLength<=4) then begin
   if TryStrToInt( Copy(S,i,_CodeLength),n)
               then W:=WChar(n)
               else W := '?' ; // тут нужно что-то на случай, если не...
   end else W := '?' ; // тут тоже нужно что-то на случай, если не...

i:=i+_CodeLength+1;     


[wofs]

если ВДРУГ мнемоника > 4-х символов.

Тогда уж лучше

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

if (_CodeLength >=1) and (_CodeLength<=6) then

Так как судя по
http://www.utf8-zeichentabelle.de/unicode-utf8-table.pl?start=983040&utf8=dec&unicodeinhtml=dec&htmlent=1
там есть еще символы...

[vitaly_l]

Тогда уж лучше ... судя по

Да, так лучше.

PS: Цифру 6 можно заменить на максимально возможную для UTF-8 и/или UTF-16, но при UTF-16 нужна проверка на вхождение пробела.


/

[wofs]

И поправить вот так:

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

function HTMLEntrToUTF8 (const S: WideString): WideString;
var W: WChar;
    i,j,n: Integer;
    _PosSemicolon,_CodeLength:integer;
begin
SetLength(result,length(S));
i:=1; j:=1;
while i<=length(S) do
begin
       W:=WChar(S[i]);
       if (Copy(S,i,2)='&#') then
       begin
           i:=i+2;
           //detect code Length
           _PosSemicolon:=UTF8Pos(';',S,i);
           _CodeLength:= _PosSemicolon-i;

           if (_CodeLength >=1) and (_CodeLength<=6) then
           begin
               if
                 TryStrToInt( Copy(S,i,_CodeLength),n) // can be mixed text
               then
                 W:=WChar(n)
               else
                 W:='?'; // if no...

             //  i:=i+_CodeLength+1;
           end else
               W:='?'; // if no...

             i:=i+_CodeLength+1;
       end
       else
           Inc(i);
       result[j]:=W;
       Inc(j);
end;
SetLength(result,j-1);
end;               


Иначе в случае кода &#12g34 получится ерунда. Правда в этом случае будет потеряна информация, которая заложена в невером коде.

Добавлено спустя 4 минуты 38 секунд:
Нет, нельзя так - в случае строки

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

&#test text;

Потеряем все нафиг, лучше уж пусть вылезут несуразности - максимизация ошибки.

[vitaly_l]

вот так

Да.

Добавлено спустя 1 минуту 58 секунд:

test text

проверять на маловероятное вхождение пробела нужно (например в случае порчи XML).