FPC и UTF-16

Форум для изучающих FPC и их учителей.

Модератор: Модераторы

FPC и UTF-16

Сообщение Putnick » 04.08.2009 14:26:51

Граждане!
Сейчас, наверное, знающие люди скажут мне, что "дурная голова рукам покоя не даёт", но тем не менее...
Возникла следующая проблема:
Пусть есть строка S1 в UTF8 кодировке,
хочу получить строку S2 в UTF16
Вроде бы
Код: Выделить всё
Utf8ToUnicode(s2, s1, Length(s1))

должен осуществлять задуманное, однако, в моём случае (WinXP, Lazarus 9.27 svn 19575), в S2 мы имеем текст в кодировке Win-1251
Поскольку "не царское это дело" — разбираться в чужих кодах :), был написан собственный модуль, каковой я и выкладываю (может кому пригодится)
Код: Выделить всё
unit My_UniCode;
interface
const
  BESign:string=#$FE#$FF;  // Сигнатура для файла с BigEndian последовательностью кодирования, вроде бы, должна использоваться по умолчанию.
  LESign:string=#$FF#$FE;  // Однако весёлые ребята из МелкоСофта, похоже, предпочитают LittleEndian
  UTF8Sign:String=#$EF#$BB#$BF; // Сигнатура для UTF8 файла

function Utf8ToUtf16BE(s:string):string;
function Utf8ToUtf16LE(s:string):string;
function Utf16BETOUtf8(s:string):string;
function Utf16LETOUtf8(s:string):string;

implementation
function Utf8ToUtf16BE(s:string):string;
var
  i, j, MaxI:integer;
  b:byte;
begin
  MaxI:=Length(s);
  SetLength(Result, MaxI*4); // на 4 умножаем, т.к. по стандарту 1 символ может кодироваться 1..4 байтами
  i:=1;
  j:=1;
  While i<=MaxI do begin
    b:=Byte(s[i]);
    if (b and $7F)=b then begin
      Byte(Result[j]):=0;
      Byte(Result[j+1]):=b;
      inc(j,2);
      inc(i);
      Continue
    end;
    if (b and $DF)=b then begin
      Byte(Result[j]):=(b and $1F) shr 2;
      Byte(Result[j+1]):=(b shl 6) or (Byte(s[i+1]) and $3F);
      inc(j,2);
      inc(i,2);
      Continue
    end;
    if (b and $EF)=b then begin
      Byte(Result[j]):=((b and $0F) shl 4) or ((Byte(s[i+1]) and $3F) shr 2);
      Byte(Result[j+1]):=((Byte(s[i+1]) and $03) shl 6) or (Byte(s[i+2]) and $3F);
      inc(i,3);
      inc(j,2);
      Continue
    end;
    if (b and $F7)=b then begin
{ Так преобразуют в Unicode
      Byte(Result[j]):=0;
      Byte(Result[j+1]):=((b and $07) shl 2) or ((Byte(s[i+1]) and $3F) shr 4);
      Byte(Result[j+2]):=((Byte(s[i+1])) shl 4) or ((Byte(s[i+2]) and $3F) shr 2);
      Byte(Result[j+3]):=((Byte(s[i+2]) and $03) shl 6) or (Byte(s[i+3]) and $3F);
}
      b:=(((b and $07) shl 2) or ((Byte(s[i+1]) and $3F) shr 4))-1;
      Byte(Result[j]):=$D8 or (b shr 2);
      Byte(Result[j+1]):=(b shl 6) or ((Byte(s[i+1]) and $0F) shl 2) or ((Byte(s[i+2]) and $3F) shr 4);
      Byte(Result[j+2]):=$DC or ((Byte(s[i+2]) and $0C) shr 2);
      Byte(Result[j+3]):=(Byte(s[i+2]) shl 6) or (Byte(s[i+2]) and $3F);
      inc(i,4);
      inc(j,4);
      Continue
    end
  end;
  SetLength(Result, j-1)
end;
function Utf8ToUtf16LE(s:string):string;
var
  i, j, MaxI:integer;
  b:byte;
begin
  MaxI:=Length(s);
  SetLength(Result, MaxI*4);
  i:=1;
  j:=1;
  While i<=MaxI do begin
    b:=Byte(s[i]);
    if (b and $7F)=b then begin
      Byte(Result[j+1]):=0;
      Byte(Result[j]):=b;
      inc(j,2);
      inc(i);
      Continue
    end;
    if (b and $DF)=b then begin
      Byte(Result[j+1]):=(b and $1F) shr 2;
      Byte(Result[j]):=(b shl 6) or (Byte(s[i+1]) and $3F);
      inc(j,2);
      inc(i,2);
      Continue
    end;
    if (b and $EF)=b then begin
      Byte(Result[j+1]):=((b and $0F) shl 4) or ((Byte(s[i+1]) and $3F) shr 2);
      Byte(Result[j]):=((Byte(s[i+1]) and $03) shl 6) or (Byte(s[i+2]) and $3F);
      inc(i,3);
      inc(j,2);
      Continue
    end;
    if (b and $F7)=b then begin
      b:=(((b and $07) shl 2) or ((Byte(s[i+1]) and $3F) shr 4))-1;
      Byte(Result[j+3]):=$D8 or (b shr 2);
      Byte(Result[j+2]):=(b shl 6) or ((Byte(s[i+1]) and $0F) shl 2) or ((Byte(s[i+2]) and $3F) shr 4);
      Byte(Result[j+1]):=$DC or ((Byte(s[i+2]) and $0C) shr 2);
      Byte(Result[j]):=(Byte(s[i+2]) shl 6) or (Byte(s[i+2]) and $3F);
      inc(i,4);
      inc(j,3);
      Continue
    end
  end;
  SetLength(Result, j-1)
end;
function Utf16BEToUtf8(s:string):string;
var
  i, j, MaxI:integer;
  b:byte;
  w:word;
begin
  MaxI:=Length(s);
  SetLength(Result, MaxI*2); // UTF8 Не более 4 байт на символ, UTF16 - не менее 2
  i:=1;
  j:=1;
  While i<=MaxI do begin
    b:=Byte(s[i]);
    if (b and $D8)=$D8 then begin
      // четырехбайтовый UTF-16 символ
      w:=b;
      w:=(w shl 8) or Byte(s[i+1]);
      // сформируем первые 4 бита (номер плоскости)
      b:=Byte((w xor $D800) shr 6)+1;
      Byte(Result[j]):=$F0 or byte(b shr 2);
      Byte(Result[j+1]):=$80 or ((b and $03) shl 4) or byte((w and $003C) shr 4);
      Byte(Result[j+2]):=$80 or byte((w and $0003) shl 4);
      w:=Byte(s[i+2]);
      w:=(w shl 8) or Byte(s[i+3]);
      w:=w xor $DC00;
      Byte(Result[j+2]):=Byte(Result[j+2]) or Byte((w and $03C0) shr 6);
      Byte(Result[j+3]):=$80 or Byte(w and $003F);
      inc(j,4);
      inc(i,4)
    end else begin
      // двухбайтовый UTF-16 символ
      w:=b;
      w:=(w shl 8) or Byte(s[i+1]);
      if w<$80 then begin
        Byte(Result[j]):=Byte(w);
        inc(j)
      end;
      if ((w>=$80) and (w<$800)) then begin
        Byte(Result[j]):=$C0 or Byte(w shr 6);
        Byte(Result[j+1]):=$80 or Byte(w and $3F);
        inc(j,2)
      end;
      if ((w>=$800) and (w<=$FFFF)) then begin
        Byte(Result[j]):=$E0 or Byte(w shr 12);
        Byte(Result[j+1]):=$80 or Byte((w and $03C0) shr 6);
        Byte(Result[j+2]):=$80 or Byte(w and $3F);
        inc(j,3)
      end;
      inc(i,2)
    end
  end;
  SetLength(Result, j-1)
end;
function Utf16LEToUtf8(s:string):string;
var
  i, j, MaxI:integer;
  b:byte;
  w:word;
begin
  MaxI:=Length(s);
  SetLength(Result, MaxI*2);
  i:=1;
  j:=1;
  While i<=MaxI do begin
    b:=Byte(s[i+1]);
    if (b and $D8)=$D8 then begin
      // четырехбайтовый UTF-16 символ
      w:=b;
      w:=(w shl 8) or Byte(s[i]);
      // сформируем первые 4 бита (номер плоскости)
      b:=Byte((w xor $D800) shr 6)+1;
      Byte(Result[j]):=$F0 or byte(b shr 2);
      Byte(Result[j+1]):=$80 or ((b and $03) shl 4) or byte((w and $003C) shr 4);
      Byte(Result[j+2]):=$80 or byte((w and $0003) shl 4);
      w:=Byte(s[i+3]);
      w:=(w shl 8) or Byte(s[i+2]);
      w:=w xor $DC00;
      Byte(Result[j+2]):=Byte(Result[j+2]) or Byte((w and $03C0) shr 6);
      Byte(Result[j+3]):=$80 or Byte(w and $003F);
      inc(j,4);
      inc(i,4)
    end else begin
      // двухбайтовый UTF-16 символ
      w:=b;
      w:=(w shl 8) or Byte(s[i]);
      if w<$80 then begin
        Byte(Result[j]):=Byte(w);
        inc(j)
      end;
      if ((w>=$80) and (w<$800)) then begin
        Byte(Result[j]):=$C0 or Byte(w shr 6);
        Byte(Result[j+1]):=$80 or Byte(w and $3F);
        inc(j,2)
      end;
      if ((w>=$800) and (w<=$FFFF)) then begin
        Byte(Result[j]):=$E0 or Byte(w shr 12);
        Byte(Result[j+1]):=$80 or Byte((w and $03C0) shr 6);
        Byte(Result[j+2]):=$80 or Byte(w and $3F);
        inc(j,3)
      end;
      inc(i,2)
    end
  end;
  SetLength(Result, j-1)
end;

end.

Буду крайне признателен, если кто-нибудь всё-таки объяснит особоодарённому, как же эту задачку решают знающие люди. А то код всё-таки сыроватый (т.е. мою задачу здесь и сейчас, он, вроде бы, решает, а как он себя поведёт на каких-нибудь иероглифах...).
Putnick
новенький
 
Сообщения: 62
Зарегистрирован: 18.03.2009 13:02:56

Re: FPC и UTF-16

Сообщение Sergei I. Gorelkin » 04.08.2009 15:04:47

Кодировка utf-16 предполагает использование строк типа WideString либо UnicodeString. Если переменная s2 имеет тип AnsiString (либо просто string), то при присвоении ей результата Utf8ToUnicode компилятор вставит преобразование в кодовую страницу системы, и на русской винде получится таки кодировка win1251.
Аватара пользователя
Sergei I. Gorelkin
энтузиаст
 
Сообщения: 1397
Зарегистрирован: 24.07.2005 14:40:41
Откуда: Зеленоград

Re: FPC и UTF-16

Сообщение Putnick » 04.08.2009 16:33:19

Спасибо, Сергей.
Буду знать. Значит зря заморачиваля :( .
Меня что запутало:
в Utf8ToUnicode выходная строка PWideChar, а WideString (по моей хитрой логике) — это последовательность WideChar-ов. Видимо, когда я делаю Write (s2:PWideChar) или Length(s2:PWideChar), происходит неявное преобразование.
Хотя, вот объясните, что я делаю не так:
Код: Выделить всё
var
s1:PChar;
s2:PWideChar;
begin
  s1:=' проверка1 ';
  Utf8ToUnicode(s2, s1, Length(s1));
  WriteLn(WideString(s2),Utf8ToSys(' имеет длину '),Length(s2),Utf8ToSys(' символов'));
end.

на выходе:
Код: Выделить всё
проверка1 имеет длину 11 символов

Всё в Win-1251.
И кстати, что-то Лазарь не понимает UnicodeString, может, этот тип в каком-то дополнительном модуле определяется?

Ещё раз спасибо за помощь.
Putnick
новенький
 
Сообщения: 62
Зарегистрирован: 18.03.2009 13:02:56

Re: FPC и UTF-16

Сообщение Sergei I. Gorelkin » 04.08.2009 18:05:12

При выводе в консоль (writeln()) происходит преобразование в кодовую страницу системы, а количество WideChar в строке " проверка1 " в кодировке utf-16 равно числу Char в ней в кодировке win1251 и равно 11, так что тут вроде все правильно.
С другой стороны, в приведенном примере кода нигде не выделяется память для хранения s2 (а при работе с PChar/PWideChar ее нужно выделять, в отличие от string/WideString), поэтому как оно вообще выдает какой-то результат - непонятно. С этой точки зрения удобнее пользоваться функциями utf8encode и utf8decode.
Наконец, тип UnicodeString - это из fpc 2.3.1, в версии 2.2.х он отсутствует.
Аватара пользователя
Sergei I. Gorelkin
энтузиаст
 
Сообщения: 1397
Зарегистрирован: 24.07.2005 14:40:41
Откуда: Зеленоград

Re: FPC и UTF-16

Сообщение Putnick » 05.08.2009 08:58:28

Сергей, БОЛЬШОЕ СПАСИБО!
Putnick
новенький
 
Сообщения: 62
Зарегистрирован: 18.03.2009 13:02:56

Re: FPC и UTF-16

Сообщение Cheb » 28.08.2009 10:27:54

>Utf8ToUnicode
А разве это делается не функцией Utf8Decode() ? Которая возвращает нормальный WideString ? Чтобы не возиться с PWideChar'ами ?
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 994
Зарегистрирован: 06.06.2005 15:54:34

Re: FPC и UTF-16

Сообщение Mr.Smart » 28.08.2009 10:43:26

UTF8Decode() вызывает непосредственно UTF8ToUnicode :wink:
Mr.Smart
долгожитель
 
Сообщения: 1796
Зарегистрирован: 29.03.2008 01:01:11
Откуда: из леса!


Вернуться в Обучение Free Pascal

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 25

Рейтинг@Mail.ru