[Решено] Laz1.6.0 - глюки с Юникодом в Win10

[slyubez]

Приветствую уважаемых коллег.

Есть код:

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

function GetWorkDir: string;
begin
{$IFDEF WINDOWS}
Result:=GetWindowsSpecialDir (CSIDL_LOCAL_APPDATA);
Result:=Result+'Lyubeznyy'+AppName+'';}
{$ELSE}
Result:=GetAppConfigDir (false);
{$ENDIF}
if not DirectoryExists (Result)
  then if not ForceDirectories (Result)
   then Raise Exception.Create('Не удается создать рабочий каталог.');
end;

С незначительными изменениями в перекодировках он очень хорошо работал в Laz 1.4 на FPC 2.6.4. Но в связке Laz1.6 с FPC3 у меня никак не получается заставить CreateDir создать каталог. Русские символы в имени юзера есть. Прописал в uses LazFileUtils вместо FileUtil - бесполезно. Прошу помочь.

Добавлено спустя 2 минуты 4 секунды:
Да, при отладке имя пользователя в переменной отображается кракозябрами; остальной путь корректен. Есть желание вернуться на Laz1.2.6 - там проблему, ИМХО, гораздо легче обойтить.

Добавлено спустя 1 час 6 минут 1 секунду:
Сейчас немного поэкспериментировал.

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

s:=GetWindowsSpecialDir (CSIDL_LOCAL_APPDATA);
s1:='';
for I:=1 to Length(s)
  do s1:=s1+IntToStr (ord (s [I]))+' ';
s1:=s1+sLineBreak+s;
ShowMessage (s1);

В сообщение выводится вот это:

67 58 92 85 115 101 114 115 92 209 229 240 227 229 233 92 65 112 112 68 97 116 97 92 76 111 99 97 108 92
C:Users??????AppDataLocal

Следовательно, в переменную s возвращена ANSI-строка. Но почему перекодировка строки в UTF8 не спасает - неясно.

Добавлено спустя 10 минут 41 секунду:
С перекодировкой - картина иная, но толку...

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

s:=GetWindowsSpecialDir (CSIDL_LOCAL_APPDATA);
s2:=AnsiToUTF8 (s);
s1:='';
for I:=1 to Length(s2)
  do s1:=s1+IntToStr (ord (s2 [I]))+' ';
s1:=s1+sLineBreak+s2;
ShowMessage (s1);

Возврат в сообщении:

67 58 92 85 115 101 114 115 92 239 191 189 239 191 189 239 191 189 239 191 189 239 191 189 239 191 189 92 65 112 112 68 97 116 97 92 76 111 99 97 108 92
C:Users������AppDataLocal

Видно, что, похоже, имя пользователя (Сергей) перекодируется в текст бОльшей длины. Сейчас попробую определить, во что именно.

Добавлено спустя 2 минуты 17 секунд:
Да, и прошу прощения - движок форума местами обрезает виндовые слэши, и они отображаются не везде.

Добавлено спустя 18 минут 33 секунды:
Бред какой-то. Одинаковые комбинации по три байта на каждый символ - ХЗ что. Придется свою функцию писать.

[SSerge]

Не в том направлении двигаетесь, коллега. Сначала уясните, с меткой какой кодовой страницы вышли ваши строки, далее то, как сделать перекодировку без AnsiToUTF8.

http://wiki.freepascal.org/Better_Unico ... Lazarus/ru
http://wiki.freepascal.org/FPC_Unicode_support/ru

[resident]

Сейчас попробую определить, во что именно.

Интересно было бы посмотреть, как такое определять?

[slyubez]

SSerge, большое спасибо за первую ссылку - она помогла. Использовал функцию WinCPToUTF8 из модуля LazUTF8 - с ней всё пошло как надо.
С другой стороны, очень жаль, что в релизах до сих пор не исправили баг в полезной функции GetAppConfigDir, из-за которого при наличии русских символов в имени Windows-пользователя эта функция выдает полный бред.

Добавлено спустя 56 секунд:

Интересно было бы посмотреть, как такое определять?

Планировал загнать в HEX-редактор и декодировать, но присмотрелся - а последовательности-то одинаковые.

[resident]

Планировал загнать в HEX-редактор и декодировать

Иде результаты?

Добавлено спустя 8 минут 43 секунды:
Хотя уже сам сделал.

67 58 92 85 115 101 114 115 92 239 191 189 239 191 189 239 191 189 239 191 189 239 191 189 239 191 189 92 65 112 112 68 97 116 97 92 76 111 99 97 108 92

239 191 189 = 1111 + 111111 + 111101 = 1111111111111101 = 65533 = $FFFD

Бред какой-то. Одинаковые комбинации по три байта на каждый символ - ХЗ что.

Спецсимвол.
http://stackoverflow.com/questions/3526 ... mark-65533

One common reason for a "corrupt" sequence is that the wrong decoder has been applied.

[slyubez]

239 191 189 = 1111 + 111111 + 111101 = 1111111111111101 = 65533 = $FFFD

Расчета не понял.
239 191 189 = EFBFBD = 15721289

Error: U+EFBFBD is outside the legal range of codepoints.
The legal range of codepoints is U+0000 through U+10FFFF.

[Дож]

Кажется, что надёжней для отладки было бы печатать не ord (s [I]), а конкретно последовательность SizeOf(Char)*Length(s) байт начиная с @s[1]

Что будет, если s объявить как WideString, а не String?

[resident]

Расчета не понял.

UTF-8

Кажется, что надёжней для отладки было бы печатать не ord (s [I]), а конкретно последовательность SizeOf(Char)*Length(s) байт начиная с @s[1]

Есть какая-то функция для её печати?

[Дож]

Есть какая-то функция для её печати?

Обычным циклом можно распечатать PByte(@s[1])[I]

[resident]

Ok

[slyubez]

Нарыл тут на StackOverflow и перевел с С полезную функцию для расчета длины UTF8-символостроки по первому ее символу.

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

function GetSymLength (const s: String): Integer;
var b: Byte;
begin
b:=Byte (s [1]);
if (b and $c0)=$c0
  then if (b and $f0)=$f0
        then Result:=4
        else if (b and $e0)=$e0
              then Result:=3
              else Result:=2
  else Result:=1;
end;

[alexs]

slyubez
А чем не устроила функция UTF8CharacterLength из модуля LazUTF8?

[slyubez]

А чем не устроила функция UTF8CharacterLength из модуля LazUTF8?

Во-первых, ей на вход нужен PChar. Во-вторых, мне было проще не искать, а самому написать именно такую функцию под свою задачу - распарсить UTF8-строку на слова. Сейчас копаюсь с реализацией задачи.

[alexs]

ей на вход нужен PChar

Так ты же с символами и работаешь.

распарсить UTF8-строку на слова.

Так разделители все находятся в первых 127 символах. Что там писать? Простой перебор...

[slyubez]

Так разделители все находятся в первых 127 символах. Что там писать? Простой перебор...

Вот я и пробую. Хотя не очень красиво получается.

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

procedure DivideTextToWords (const ttxt: String);
var II, JJ, LenSym, WCnt: Integer;
    sym, wrd: String;
begin
II:=0;
WCnt:=1;
SetLength (Words, WCnt);
Words [0]:='';
while II<=Length (ttxt)
  do begin
      Inc (II);
      sym:=ttxt [II];
      LenSym:=GetUTF8SymLength (sym);
      if LenSym>1
       then for JJ:=2 to LenSym-1
             do begin
                 Inc (II);
                 sym:=sym+ttxt [II];
                end;
      if sym=' '
       then begin
             if Words [WCnt-1]<>''
              then begin
                    Inc (WCnt);
                    SetLength (Words, WCnt);
                   end;
            end
       else begin
             Words [WCnt-1]:=Words [WCnt-1]+sym;
             if sym=sLineBreak
              then begin
                    Inc (WCnt);
                    SetLength (Words, WCnt);
                   end;
            end;
     end;
end;