Все почтовые клиенты сбиваются. Долго я на это смотрел , и сделал единственно верный вариант.
Можно использовать 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;