Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[18.222.148.124] |
|
Сообщ.
#1
,
|
|
|
Utf8ToWideChar
Приходится изобретать велосипеды из-за того, что MBToWC не работает так, как надо. Функция пригодится для декодирования потока, когда имеющийся буфер может разорвать UTF8 строку на любом месте (в т.ч. посередине последовательности, кодирующей один символ). // Конвертирует UTF8 строку в UTF16-LE // Может просто возвращать количество UTF16 символов в результирующей строке // [in] pSrcMB - указатель на UTF8 строку // [in] SrcLen - длина UTF8 строки // [out] SrcRead - количество сконвертированных символов UTF8 строки // [in] pDestWC - указатель на UTF16 строку-приёмник // [in] DestLen - длина UTF16 строки // [out] DestWritten - количество сконвертированных символов UTF16 строки // Можно указать pDestWC = nil и/или DestLen = 0, тогда процедура просто // посчитает количества исходных и результирующих символов procedure Utf8ToWideChar(pSrcMB: PAnsiChar; SrcLen: Integer; var SrcRead: Integer; pDestWC: PWideChar; DestLen: Integer; var DestWritten: Integer); var CurrBuf, EndBuf: PByte; CharCnt, i: Byte; DoConvert: Boolean; ResultChar: UCS4Char; procedure Utf8Error(ByteCode: Byte); begin raise Exception.Create('Bad UTF8 char: #'+IntToStr(ByteCode)); end; begin SrcRead := 0; DestWritten := 0; if (pSrcMB = nil) or (SrcLen = 0) then Exit; DoConvert := (pDestWC <> nil) and (DestLen > 0); CurrBuf := PByte(pSrcMB); EndBuf := CurrBuf + SrcLen - 1; // указывает на последний байт буфера while (CurrBuf <= EndBuf) and (DestLen > 0) do case CurrBuf^ of // ** Ошибочные символы ** // В тексте UTF-8 принципиально не может быть байтов со значениями 254 (0xFE) и 255 (0xFF). // Поскольку в Юникоде не определены символы с кодами выше 221, то в UTF-8 оказываются // неиспользуемыми также значения байтов от 248 до 253 (0xF8—0xFD). Если запрещены искусственно // удлинённые (за счёт добавления ведущих нулей) последовательности UTF-8, то не используются // также байтовые значения 192 и 193 (0xC0 и 0xC1). 254, 255, 248..253, 192, 193: Utf8Error(CurrBuf^); // ** Как есть ** 0..128: begin if DoConvert then begin pDestWC^ := WideChar(CurrBuf^); Inc(pDestWC); Dec(DestLen); end; Inc(DestWritten); Inc(CurrBuf); end; // ** Символ из нескольких байт - 11xxxxxx 10xxxxxx [10xxxxxx] [10xxxxxx] ** else begin // определяем длину последовательности - она равна количеству ведущих единиц в первом байте // за единицами должен следовать 0, который отделяет "заголовок" от значащих бит CharCnt := 0; if CurrBuf^ shr 5 = $06 { 00000110 bin } then CharCnt := 2 else if CurrBuf^ shr 4 = $0E { 00001110 bin } then CharCnt := 3 else if CurrBuf^ shr 3 = $1E { 00011110 bin } then CharCnt := 4 // "хвосты" от предыдущих символов не принимаются else Utf8Error(CurrBuf^); // проверяем, полностью ли попала в буфер последовательность if EndBuf - CurrBuf + 1 < CharCnt then Break; // проверяем, если результат будет двойным widechar, то он должен влезть if CharCnt = 4 then if (not DoConvert) or (DestLen >= 2) then Inc(DestWritten, 2) else Break else Inc(DestWritten); // попала полностью, конвертируем символ, увеличиваем счётчик итоговых символов и передвигаем указатель if DoConvert then begin // получаем значащие биты из первого байта ResultChar := CurrBuf^ and Byte($7F { 01111111 bin } shr CharCnt); // = $FF shr CharCnt+1 // собираем весь 4-байтовый символ for i := 2 to CharCnt do ResultChar := (ResultChar shl 6) or Byte( (CurrBuf+i-1)^ and $3F { 00111111 bin }); // копируем младшее слово pDestWC^ := WideChar(ResultChar); Inc(pDestWC); Dec(DestLen); // копируем старшее, если есть if CharCnt = 4 then begin pDestWC^ := WideChar(HiWord(ResultChar)); Inc(pDestWC); Dec(DestLen); end; end; // if DoConvert Inc(CurrBuf, CharCnt); end; end; // case & while SrcRead := CurrBuf - pSrcMB; end; Пример использования. В примере создаётся довольно длинная строка с русскими буквами и японскими иероглифами (последовательности из 2-х и 3-х байт в utf8), которая затем в цикле читается маленькими рандомными кусочками. procedure TForm1.Button6Click(Sender: TObject); var s, s1: string; us: utf8string; wccount, mbcount, wclen, mblen, mbcurr, wccurr: integer; begin s := DupeString('проверка わたくし', 200); us := UTF8Encode(s); SetLength(s1, length(us)+16); Randomize; wccurr := 1; mbcurr := 1; while mbcurr < Length(us) do begin mblen := min(Random(15)+1, Length(us)-mbcurr+1); Utf8ToWideChar(@us[mbcurr], mblen, mbcount, @s1[wccurr], Length(s1)-wccurr, wccount); Inc(mbcurr, mbcount); Inc(wccurr, wccount); end; SetLength(s1, wccurr-1); if s = s1 then ShowMessage('OK!'); end; Автор: Fr0sT |
Сообщ.
#2
,
|
|
|
Цитата Krid @ Функция пригодится для декодирования потока, когда имеющийся буфер может разорвать UTF8 строку на любом месте (в т.ч. посередине последовательности, кодирующей один символ). сейчас дельфи под рукой нету, но вообще, в новых дельфях (2009/2010/XE) есть класс TEncoding, который слямзин из дот нета целеком и полностью. Так вот, если эмбаркадеро лямзило капитально, то где то рядом должны находится TDecoder(аналог .NET'овского System.Text.Decoder) который должен решать твою задачу. Плиз, проверьте, у кого дельфи новые стоят, так ли это... |
Сообщ.
#3
,
|
|
|
jack128, ну ты уж совсем "за лоха держишь" Разумеется, я знаю про TEncoding, более того, облазил его практически весь. И выяснил, что на самом нижнем уровне, за всеми этими красивыми static class наслоениями лежит всё тот же MBtoWC/WCtoMB. Да иначе и быть не может, т.к. изобретать велосипед никому не охота. Так что TEncoding страдает от того же недостатка, что и MBtoWC, а именно - не подходит для декодирования потока.
Добавлено P.S. Кроме того, я специально не поленился и прогнал функцию на бенчмарк - она не уступает MBtoWC и даже чуть быстрее. |
Сообщ.
#4
,
|
|
|
Сообщ.
#5
,
|
|
|
Krid, любопытно, спасибо! К сожалению,
Цитата Minimum supported client Windows 7 Minimum supported server Windows Server 2008 R2 |
Сообщ.
#6
,
|
|
|
Utf8 <--> WideChar
Переработал Utf8ToWideChar и сделал обратную WideCharToUtf8 // Конвертирует UTF-8 строку в UTF-16LE // Может просто возвращать количество UTF-16 символов в результирующей строке // [in] pSrcMB - указатель на UTF-8 строку // [in] SrcLen - длина UTF-8 строки // [out] SrcRead - количество сконвертированных символов UTF-8 строки // [in] pDestWC - указатель на UTF-16 строку-приёмник // [in] DestLen - размер (длина) UTF-16 строки-приёмника // [out] DestWritten - количество сконвертированных символов UTF-16 строки // Можно указать pDestWC = nil и/или DestLen = 0, тогда процедура просто // посчитает количества исходных и результирующих символов procedure Utf8ToWideChar(pSrcMB: PAnsiChar; SrcLen: Integer; out SrcRead: Integer; pDestWC: PWideChar; DestLen: Integer; out DestWritten: Integer); var CurrChar, CharCnt, i: Byte; DoConvert: Boolean; TotalChar: UCS4Char; const EBadUtf8Char = 'Bad UTF8 char: #%d'; EBadCharSeq = 'Bad UTF8 char sequence'; // ** Ошибочные символы ** // В тексте UTF-8 принципиально не может быть байтов со значениями 254 (0xFE) и 255 (0xFF). // Поскольку в Юникоде не определены символы с кодами выше 221, то в UTF-8 оказываются // неиспользуемыми также значения байтов от 248 до 253 (0xF8—0xFD). Если запрещены искусственно // удлинённые (за счёт добавления ведущих нулей) последовательности UTF-8, то не используются // также байтовые значения 192 и 193 (0xC0 и 0xC1) - http://ru.wikipedia.org/wiki/UTF-8. ForbiddenChars = [254, 255, 248..253, 192, 193{}, 0]; procedure Error(msg: string); begin raise Exception.Create(msg); end; // Записать UTF-16 символ по указателю, передвинуть указатель, уменьшить счетчик // [in/out] [external] pDestWC - указатель на UTF-16 строку-приёмник // [in/out] [external] DestLen - размер (длина) UTF-16 строки-приёмника // [in] [external] DoConvert - признак, производить ли запись на самом деле // [out] [external] DestWritten - счетчик записанных символов UTF-16 строки // [in] Val - символ для записи procedure WriteWC(Val: WideChar); begin if DoConvert then begin pDestWC^ := Val; Inc(pDestWC); Dec(DestLen); end; Inc(DestWritten); end; // Прочитать UTF8 символ по указателю, передвинуть указатель, уменьшить счетчик // [in/out] [external] pSrcMB - указатель на UTF-8 строку // [in/out] [external] SrcLen - непрочитанная длина UTF-8 строки // [out] [external] SrcRead - счетчик записанных символов UTF-8 строки // [out] Result - прочитанный символ function ReadUtf8: AnsiChar; begin Inc(pSrcMB); Dec(SrcLen); if SrcLen > 0 then Result := pSrcMB^ else Result := #0; // на всякий случай, чтобы избежать range check error end; begin SrcRead := 0; DestWritten := 0; if (pSrcMB = nil) or (SrcLen = 0) then Exit; DoConvert := (pDestWC <> nil) and (DestLen > 0); CurrChar := Byte(pSrcMB^); while SrcLen > 0 do begin case CurrChar of // Символ из одного байта - 0xxxxxxx $00..$7F: begin WriteWC(WideChar(CurrChar)); Inc(SrcRead); end; // Символ из нескольких байт - 11xxxxxx 10xxxxxx [10xxxxxx] [10xxxxxx] else begin // проверка на запрещённые символы if CurrChar in ForbiddenChars then Error(Format(EBadUtf8Char, [CurrChar])); // определяем длину последовательности - она равна количеству ведущих единиц в первом байте // за единицами должен следовать 0, который отделяет "заголовок" от значащих бит CharCnt := 0; if CurrChar shr 5 = $06 { 00000110 bin } then CharCnt := 2 else if CurrChar shr 4 = $0E { 00001110 bin } then CharCnt := 3 else if CurrChar shr 3 = $1E { 00011110 bin } then CharCnt := 4 // "хвосты" от предыдущих символов не принимаются else Error(Format(EBadUtf8Char, [CurrChar])); if SrcLen < CharCnt then Break; // в буфере должно быть CharCnt ANSI символов if DoConvert then if (CharCnt = 4) and (DestLen < 2) then Break; // будет суррогатная пара - должно влезть два Wide символа // влезет, собираем UTF-32 символ TotalChar := CurrChar and ($7F { 01111111 bin } shr CharCnt); // = $FF shr CharCnt+1 for i := 2 to CharCnt do begin CurrChar := Byte(ReadUtf8); // проверка на запрещённые символы; также все они должны иметь маску 10xxxxxx if (CurrChar in ForbiddenChars) or (CurrChar and $C0 { 11000000 bin } <> $80 { 10000000 bin }) then Error(Format(EBadUtf8Char, [CurrChar])); TotalChar := (TotalChar shl 6) or (CurrChar and $3F { 00111111 bin }); end; // преобразуем в UTF16 if CharCnt < 4 then // один UTF16 символ WriteWC(WideChar(LoWord(TotalChar))) else // два UTF16 символа (суррогатная пара) (http://en.wikipedia.org/wiki/UTF-16/UCS-2) begin Dec(TotalChar, $10000); WriteWC(WideChar((TotalChar shr 10) + $D800)); // старший символ WriteWC(WideChar((TotalChar and $3FF { 1111111111 bin }) + $DC00)); // младший символ end; Inc(SrcRead, CharCnt); end; // else end; // case CurrChar := Byte(ReadUtf8); end; // while end; // Конвертирует UTF-8 строку в UTF-16LE // Может просто возвращать количество UTF-16 символов в результирующей строке // [in] pSrcMB - указатель на UTF-8 строку // [in] SrcLen - длина UTF-8 строки // [out] SrcRead - количество сконвертированных символов UTF-8 строки // [in] pDestWC - указатель на UTF-16 строку-приёмник // [in] DestLen - размер (длина) UTF-16 строки-приёмника // [out] DestWritten - количество сконвертированных символов UTF-16 строки // Можно указать pDestWC = nil и/или DestLen = 0, тогда процедура просто // посчитает количества исходных и результирующих символов procedure WideCharToUtf8(pSrcWC: PWideChar; SrcLen: Integer; out SrcRead: Integer; pDestMB: PAnsiChar; DestLen: Integer; out DestWritten: Integer); var CurrChar: Word; DoConvert: Boolean; TotalChar: UCS4Char; const ESurrogateIncomplete = 'Surrogate pair incomplete: incorrect char #%d'; procedure Error(msg: string); begin raise Exception.Create(msg); end; // Записать UTF-8 символ по указателю, передвинуть указатель, уменьшить счетчик // [in/out] [external] pDestMB - указатель на UTF-8 строку-приёмник // [in/out] [external] DestLen - размер (длина) UTF-8 строки-приёмника // [in] [external] DoConvert - признак, производить ли запись на самом деле // [out] [external] DestWritten - счетчик записанных символов UTF-8 строки // [in] Val - символ для записи procedure WriteUtf8(Val: AnsiChar); begin if DoConvert then begin pDestMB^ := Val; Inc(pDestMB); Dec(DestLen); end; Inc(DestWritten); end; // Прочитать UTF-16 символ по указателю, передвинуть указатель, уменьшить счетчик // [in/out] [external] pSrcWC - указатель на UTF-16 строку // [in/out] [external] SrcLen - непрочитанная длина UTF-16 строки // [out] [external] SrcRead - счетчик записанных символов UTF-16 строки // [out] Result - прочитанный символ function ReadWC: WideChar; begin Inc(pSrcWC); Dec(SrcLen); if SrcLen > 0 then Result := pSrcWC^ else Result := #0; // на всякий случай, чтобы избежать range check error end; begin SrcRead := 0; DestWritten := 0; if (pSrcWC = nil) or (SrcLen = 0) then Exit; DoConvert := (pDestMB <> nil) and (DestLen > 0); CurrChar := Word(pSrcWC^); while SrcLen > 0 do begin case CurrChar of // результат - один символ 0xxxxxxx -> 0xxxxxxx $00..$7F: begin WriteUtf8(AnsiChar(CurrChar)); Inc(SrcRead); end; // результат - два символа 00000yyy yyxxxxxx -> 110yyyyy 10xxxxxx $080..$7FF: begin if DoConvert and (DestLen < 2) then Break; // должны влезть два символа WriteUtf8(AnsiChar((CurrChar shr 6) or $C0 { 11000000 bin }) ); WriteUtf8(AnsiChar((CurrChar and $3F { 00111111 bin } ) or $80{ 10000000 bin }) ); Inc(SrcRead); end; // результат - три символа zzzzyyyy yyxxxxxx -> 1110zzzz 10yyyyyy 10xxxxxx // может встретиться суррогатная пара: первый элемент $D800..$DBFF, второй $DC00..$DFFF // результат - четыре символа 000wwwzz zzzzyyyy yyxxxxxx -> 11110www 10zzzzzz 10yyyyyy 10xxxxxx $0800..$FFFF: case CurrChar of $D800..$DBFF: // первый символ суррогатной пары - проверяем, есть ли второй begin if SrcLen < 2 then Break; // в буфере должно быть два Wide символа if DoConvert and (DestLen < 4) then Break; // должны влезть четыре ANSI символа // собираем пару в один UTF32 символ (http://en.wikipedia.org/wiki/UTF-16/UCS-2) TotalChar := (CurrChar - $D800) shl 10; CurrChar := Word(ReadWC); if not ((CurrChar >= $DC00) and (CurrChar <= $DFFF)) then // этот символ - не второй из пары Error(Format(ESurrogateIncomplete, [CurrChar])); TotalChar := (TotalChar or (CurrChar - $DC00)) + $10000; // преобразовываем в UTF-8 (http://en.wikipedia.org/wiki/UTF-8) // 000wwwzz zzzzyyyy yyxxxxxx -> 11110www 10zzzzzz 10yyyyyy 10xxxxxx WriteUtf8(AnsiChar(((TotalChar shr 18) and $07 { 00000111 bin }) or $F0 { 11110000 bin })); WriteUtf8(AnsiChar(((TotalChar shr 12) and $3F { 00111111 bin }) or $80 { 10000000 bin })); WriteUtf8(AnsiChar(((TotalChar shr 6 ) and $3F { 00111111 bin }) or $80 { 10000000 bin })); WriteUtf8(AnsiChar(((TotalChar ) and $3F { 00111111 bin }) or $80 { 10000000 bin })); Inc(SrcRead, 2); end; $DC00..$DFFF: // второй символ суррогатной пары без первого - ошибка Error(Format(ESurrogateIncomplete, [CurrChar])); else // самостоятельный символ begin if DoConvert and (DestLen < 3) then Break; // должны влезть три символа // zzzzyyyy yyxxxxxx -> 1110zzzz 10yyyyyy 10xxxxxx WriteUtf8(AnsiChar(((CurrChar shr 12) and $0F { 00001111 bin }) or $E0 { 11100000 bin })); WriteUtf8(AnsiChar(((CurrChar shr 6 ) and $3F { 00111111 bin }) or $80 { 10000000 bin })); WriteUtf8(AnsiChar(((CurrChar ) and $3F { 00111111 bin }) or $80 { 10000000 bin })); Inc(SrcRead); end; end; // sub case end; // big case CurrChar := Word(ReadWC); end; // while end; Тестовый проект приложен Прикреплённый файлTestUtf8.rar (352,85 Кбайт, скачиваний: 8) |