На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
Модераторы: jack128, Rouse_, Krid
  
    > Utf8ToWideChar - ручное конвертирование Utf8 в Utf16
      Utf8ToWideChar

      Приходится изобретать велосипеды из-за того, что MBToWC не работает так, как надо. Функция пригодится для декодирования потока, когда имеющийся буфер может разорвать UTF8 строку на любом месте (в т.ч. посередине последовательности, кодирующей один символ).

      ExpandedWrap disabled
        // Конвертирует 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), которая затем в цикле читается маленькими рандомными кусочками.
      ExpandedWrap disabled
        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
        Цитата Krid @
        Функция пригодится для декодирования потока, когда имеющийся буфер может разорвать UTF8 строку на любом месте (в т.ч. посередине последовательности, кодирующей один символ).


        сейчас дельфи под рукой нету, но вообще, в новых дельфях (2009/2010/XE) есть класс TEncoding, который слямзин из дот нета целеком и полностью. Так вот, если эмбаркадеро лямзило капитально, то где то рядом должны находится TDecoder(аналог .NET'овского System.Text.Decoder) который должен решать твою задачу. Плиз, проверьте, у кого дельфи новые стоят, так ли это...
          jack128, ну ты уж совсем "за лоха держишь" ;) Разумеется, я знаю про TEncoding, более того, облазил его практически весь. И выяснил, что на самом нижнем уровне, за всеми этими красивыми static class наслоениями лежит всё тот же MBtoWC/WCtoMB. Да иначе и быть не может, т.к. изобретать велосипед никому не охота. Так что TEncoding страдает от того же недостатка, что и MBtoWC, а именно - не подходит для декодирования потока.

          Добавлено
          P.S. Кроме того, я специально не поленился и прогнал функцию на бенчмарк - она не уступает MBtoWC и даже чуть быстрее.
              Krid, любопытно, спасибо! К сожалению,
              Цитата
              Minimum supported client Windows 7
              Minimum supported server Windows Server 2008 R2
                Utf8 <--> WideChar

                Переработал Utf8ToWideChar и сделал обратную WideCharToUtf8

                ExpandedWrap disabled
                  // Конвертирует 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;


                ExpandedWrap disabled
                  // Конвертирует 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)
                0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                0 пользователей:


                Рейтинг@Mail.ru
                [ Script execution time: 0,0405 ]   [ 17 queries used ]   [ Generated: 28.03.24, 23:44 GMT ]