Определение кодировки методом ядерного взрыва

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

Определение кодировки методом ядерного взрыва

Сообщение Ism » 05.07.2013 15:37:15

Я пишу программу разбора почты, но письма, которые приходят часто приходят с некорректными параметрами. Кодировка одна, а текст в другой.
Все почтовые клиенты сбиваются. Долго я на это смотрел , и сделал единственно верный вариант.
Можно использовать enca, но она на коротких текстах ошибается, статистики мало.

Итак в mysql создаем словарь

Код: Выделить всё
CREATE TABLE table_s_russian_slovar (
  id int(11) UNSIGNED NOT NULL AUTO_INCREMENT,
  word varchar(255) NOT NULL,
  language tinyint(4) NOT NULL COMMENT '1 русский, 2 украинский',
  insert_time datetime NOT NULL DEFAULT '0000-00-00 00:00:00',
  PRIMARY KEY (id),
  INDEX IDX_table_s_russian_slovar_word (word),
  UNIQUE INDEX UK_table_s_russian_slovar_words (word, language)
)
ENGINE = INNODB
AUTO_INCREMENT = 1700484
AVG_ROW_LENGTH = 50
CHARACTER SET utf8
CHECKSUM = 1
COLLATE utf8_general_ci
ROW_FORMAT = DYNAMIC;


Вот процедуры определения, фишка в последовательных запросах к словари в разных кодировках, в случае правильной кодировке в словаре находится слово
Данный способ позволяет определить даже язык текста. Работает только для не ASCII текста, но переделать не проблема.

Процедура по тексту, используется synapse synachar и lconvencoding
Код: Выделить всё
function SimpleDetectCyrillicUTF8Phrase(InputStr:string;DefaultCharset:TMimeChar;var ResultInfo:string;TempQuery:TZReadOnlyQuery):TMimeChar;
var
  i:integer;
  word,CharStr,ResStr,NameCharsetDefault:string;
  CharCode:byte;
  Founded:boolean;
  Delimiters:set of char;
begin
  InputStr:=Trim(InputStr);
  WriteStr(NameCharsetDefault,DefaultCharset);
  ResStr:='';
  ResultInfo:='';
  Delimiters:=[' ',',','<','>','.','"','''','-'];
  Founded:=false;
  // ASCII символы нас не интересуют
  for i:=1 to Length(InputStr) do
  begin
    CharStr:=InputStr[i];
    CharCode:=Ord(CharStr[1]);
    if (CharCode>127) or (chr(CharCode) in Delimiters) then ResStr:=ResStr+CharStr;
  end;

  if ResStr<>'' then
  begin
    Result:=DefaultCharset;
    for i:=1 to 50 do
    begin
      word:=ExtractWord(i,ResStr,Delimiters);
      if (UTF8Length(word)>=MinDictionaryWordLength) then
        Result:=SimpleDetectCyrillicUTF8Word(word,DefaultCharset,ResultInfo,Founded,TempQuery);
      if Founded then break;
    end;
    if not Founded then
    begin
      ResultInfo:='Не найдено слово в тексте по словарю, оставляем '+NameCharsetDefault;
    end;
  end
  else
  begin
    ResultInfo:='Пустая строка, оставляем '+NameCharsetDefault;
  end;
end;


Процедура по слову
Код: Выделить всё
function SimpleDetectCyrillicUTF8Word(InputStr:string;DefaultCharset:TMimeChar;var ResultInfo:string
                                       ;var FoundInDictionary:boolean;TempQuery:TZReadOnlyQuery):TMimeChar;
type TestStr=record
       Str:string;
       Charset:TMimeChar;
     end;
var
  TestStrArray:array of TestStr;
  i:integer;
  NameCharset,NameCharsetDefault:string;
begin
  FoundInDictionary:=false;
  ResultInfo:='';
  Result:=UTF_8;
  InputStr:=CorrectUTF8Str(InputStr,false);
  if InputStr='' then
  begin
    ResultInfo:='Пустая строка, оставляем UTF8'
  end
  else
  begin
    InputStr:=LeftStr(InputStr,255);    // Даже если юникод , такого длинного слова нет
    SetLength(TestStrArray,0);
    SetLength(TestStrArray,Length(TestStrArray)+1);
    TestStrArray[Length(TestStrArray)-1].Str:=InputStr;
    TestStrArray[Length(TestStrArray)-1].Charset:=UTF_8;

    SetLength(TestStrArray,Length(TestStrArray)+1);
    TestStrArray[Length(TestStrArray)-1].Str:=CP1251ToUTF8(InputStr);
    TestStrArray[Length(TestStrArray)-1].Charset:=CP1251;

    SetLength(TestStrArray,Length(TestStrArray)+1);
    TestStrArray[Length(TestStrArray)-1].Str:=KOI8ToUTF8(InputStr);
    TestStrArray[Length(TestStrArray)-1].Charset:=KOI8_RU;

    TempQuery.Close;
    TempQuery.SQL.Text:='select id,language from table_s_russian_slovar where word = :word limit 1';
    Result:=DefaultCharset;
    WriteStr(NameCharsetDefault,DefaultCharset);
    for i:=0 to Length(TestStrArray)-1 do
    begin
      try
        TempQuery.Close;
        TempQuery.ParamByName('word').AsString:=TestStrArray[i].Str;
        TempQuery.Open;
        WriteStr(NameCharset,TestStrArray[i].Charset);
        if TempQuery.RecordCount=0 then
        begin
          ResultInfo:='В словаре не найдено, оставляем '+NameCharsetDefault
        end
        else
        begin
          Result:=TestStrArray[i].Charset;
          ResultInfo:='Найдено "'+TempQuery.ParamByName('word').AsString
                      +'" в словаре '+TempQuery.FieldByName('language').AsString
                      +' Кодировка '+NameCharset;
          FoundInDictionary:=true;
          break;
        end;
      except
        if i>0 then Result:=TestStrArray[i-1].Charset;
        ResultInfo:='Исключение, бааальшие проблемы';
      end;
    end;
  end;
end;     


Процедура импорта словарей
Словари брать
http://speakrus.ru/dict/index.htm
Кстати там много веселого
Код: Выделить всё
procedure BreakText(Str:string;Delims:TSysCharSet;SList:TStringList);
var
  i,LengthStr:integer;
  StrTemp:string;
begin
  SList.Clear;
  if Str<>'' then
  begin
    i:=0;
    //LengthCount:=0;
    LengthStr:=UTF8Length(Str);
    Str:=CorrectUTF8Str(Str,false);
    repeat
      StrTemp:=ExtractWord(i,Str,Delims);
      Inc(i);
      //LengthCount:=LengthCount+UTF8Length(StrTemp);
      SList.Add(StrTemp);
    until (i>=LengthStr) and (StrTemp='');
  end;
end;

procedure TFormSlovar.ButtonImportClick(Sender: TObject);
var
  Str,Query:string;
  Delimiters:TSysCharSet;
  i,j,LengthEmptyQuery,InsertedCount:integer;
  SList,SListRes:TStringList;
const MaxRecInsertCount=100;
begin
  try
    InsertedCount:=0;
    Delimiters:=[' '..'@','['..'`','{'..'~'];
    SListRes:=TStringList.Create;
    SList:=TStringList.Create;
    SList.Sorted:=true;
    SList.Duplicates:=dupIgnore;
    if OpenDialogFileTxt.Execute then
    begin
      EditPath.Text:=OpenDialogFileTxt.FileName;
      SList.LoadFromFile(OpenDialogFileTxt.FileName);
      BGRAFlashProgressBar1.MinValue:=0;
      BGRAFlashProgressBar1.MaxValue:=SList.Count-1;
      for i:=0 to SList.Count-1 do
      begin
        if ComboBoxCharset.ItemIndex=0 then
          Str:=CorrectUTF8Str(CP1251ToUTF8(SList[i]),false)
        else
          Str:=CorrectUTF8Str(SList[i],false) ;
        //ShowMessage(Str);
        BreakText(Str,Delimiters,SListRes);
        Query:='insert ignore into table_s_russian_slovar'+CRLF
               +'(word,language) values '+CRLF;
        LengthEmptyQuery:=UTF8Length(Query);
        for j:=0 to SListRes.Count-1 do
        begin
          Str:=Trim(SListRes[j]);
          if (Length(Str)=Length(UTF8ToCP1251(Str))*2) and (UTF8Length(Str)>=MinDictionaryWordLength) then
          begin
            Query:=Query+'('+QuotedStr(Str)+','+IntToStr(ComboBoxLanguage.ItemIndex+1)+'),'+CRLF;
            if pos(' ',Str)>0 then ShowMessage(Str+CRLF+CRLF+SListRes.Text);
          end;
        end;

        try
          if LengthEmptyQuery<UTF8Length(Query) then
          begin
            Query:=UTF8Copy(Query,1,UTF8Length(Query)-3)+';';
            ZReadOnlyQueryInsertInDict.SQL.Text:=Query;
            ZReadOnlyQueryInsertInDict.ExecSQL;
            InsertedCount:=InsertedCount+ZReadOnlyQueryInsertInDict.RowsAffected;
          end;
        except
          ZReadOnlyQueryInsertInDict.SQL.SaveToFile('c:\test.txt');
          ShowMessage('Отказ');
          exit;
        end;
        BGRAFlashProgressBar1.Value:=i;
        Application.ProcessMessages;
      end;
      ZReadOnlyQueryInsertInDict.Connection.ExecuteDirect('delete from table_s_russian_slovar where char_length(word)<'+IntToStr(MinDictionaryWordLength));
    end;
  finally
    BGRAFlashProgressBar1.Value:=0;
    FreeAndNil(SList);
    FreeAndNil(SListRes);
    ShowMessage('Добавлено '+IntToStr(InsertedCount));
  end;
end;   
Ism
энтузиаст
 
Сообщения: 908
Зарегистрирован: 06.04.2007 17:36:08

Вернуться в Алгоритмы

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

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

Рейтинг@Mail.ru