Текущий архив: 2005.03.06;
Скачать: CL | DM;

Вниз

Определение вида кодировки   Найти похожие ветки 

← →
Dionnis   (2005-01-19 12:01) [0]

Добрый день всем!
Подскажите пожалуйста, с помощью какой функции можно определить
досовская кодировка или нет?
Заранее благодарен.

---

← →
Игорь Шевченко ©   (2005-01-19 12:40) [1]

Нет такой функции

---

← →
DVM ©   (2005-01-19 12:42) [2]

> Dionnis   (19.01.05 12:01)  

Как ты себе представляешь определение кодировки в тексте из одного единственного символа?

---

← →
programania ©   (2005-01-19 21:23) [3]

Можно определить по нескольким символам текста,
чем больше, тем вернее:
Вот определение по i-символам из массива b

PROCEDURE autoKod(i:integer);
var ii,qd,qw:integer; c: char; bc:byte absolute c;
begin
qd:=0; qw:=0;
for ii:=1 to i do begin
 c:=b[ii];
 case bc of
   192..223,240..255:inc(qw);
   128..175:inc(qd);
 end;
end;
ktDos:=qd>qw; //досовских букв больше-кодировка DOS
end;


---

← →
vertal ©   (2005-01-19 22:38) [4]

Стандартной виндоусовской функции нет. Есть вероятностные методы. Например, взять достаточно большой типичный текст на языке, с которым будет работать программа, и составить таблицу, сколько раз встречался в нем каждый символ. Пусть это будет массив из элементов типа Integer с индексами 0..$FF, причем Freq[i] - число символом c кодом i, которое было в тексте - эталоне. Для каждой кодировки понадобится свой такой массив. Для тестируемого текста составляем такой же массив. После чего смотрим, на массив для какой кодировки он наиболее похож - это и будет наиболее вероятная кодировка. Похожесть можно определять как косинус угла между векторами (нашими массивами) (получившимися для тестируемого текста и эталонного текста) или как расстояние между этими точками (тогда будет необходима нормировка векторов) в 256-мерном пространстве. Может быть, имеет смысл игнорировать все символы с кодом менее $80, тогда массивы будут из $80 элементов. Или можно просто, хотя и менее надежно:
1) Посчитать, сколько символов-букв содержит тестируемый текст
2) Сконвертировать его в Ansi (OEMToChar), и посчитать то же самое
Если число букв во втором случае больше - то текст скорей всего был в OEM, иначе - в Ansi.

---

← →
vertal ©   (2005-01-19 22:49) [5]

Вот какая реализация второго метода у меня получилась:

{$APPTYPE CONSOLE}
uses windows,sysutils;
{$B-}
{$WARN SYMBOL_PLATFORM OFF}

function GetAlphaCount(Const s:String):Cardinal;
var
 i:Integer;
 CharInfo:packed array of word;
begin
 SetLength(CharInfo,Length(s));
 Win32Check(GetStringTypeEx(LOCALE_SYSTEM_DEFAULT, CT_CTYPE1, PChar(s),
   Length(s), CharInfo[0]));
 Result:=0;
 for i:=Low(CharInfo) to High(CharInfo) do
  if (CharInfo[i]and C1_ALPHA)<>0 then inc(Result);
end;

var
 s:String;
 hFile:THandle;
 ActualReading: DWORD;
begin
 if ParamCount()<>1 then
 begin
   writeln(Format("Usage: %s FileToDetermineEncoding.txt",[ParamStr(0)]));
   Halt;
 end;
 hFile := CreateFile(PCHar(ParamStr(1)), GENERIC_READ, FILE_SHARE_READ,
   nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
 Win32Check(hFile <> INVALID_HANDLE_VALUE);
 try
   SetLength(s, GetFileSize(hFile, nil));
   Win32Check(ReadFile(hFile, PChar(s)^, Length(s), ActualReading, nil) and (ActualReading = Cardinal(Length(s))));
   writeln(Format("Windows encoding: %u alphabetical characters detected",[GetAlphaCount(s)]));
   OEMToChar(PChar(s), PChar(s));
   writeln(Format("DOS encoding: %u alphabetical characters detected",[GetAlphaCount(s)]));
 finally
   CloseHandle(hFile);
 end;
end.


---

← →
vertal ©   (2005-01-20 02:54) [6]

Интересная задачка. Сейчас набросал код для первого метода с использованием косинуса как меры близости кодировок. Вот что получилось:

{$APPTYPE CONSOLE}
program CalcFrequencies;
uses windows, sysutils;
{$B-}
{$WARN SYMBOL_PLATFORM OFF}

Type
 PFreqInfo = ^TFreqInfo;
 TFreqInfo = packed record
   Freq:packed array[Char]of Cardinal;
   TotalProcessed:Cardinal;
 end;

function CalcFreq(Const FileName:String;PData:PFreqInfo):Boolean;
var
 hFile: THandle;
 hMMF: THandle;
 pMMF: Pointer;
 p:Cardinal;
begin
 try
   hFile := CreateFile(PCHar(FileName), GENERIC_READ, FILE_SHARE_READ,
     nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
   Win32Check(hFile <> INVALID_HANDLE_VALUE);
   try
     hMMF := CreateFileMapping(hFile, nil, PAGE_READONLY, 0, GetFileSize(hFile,nil), nil);
     Win32Check(hMMF <> 0);
     try
       pMMF := MapViewOfFile(hMMF, FILE_MAP_READ, 0, 0, 0);
       Win32Check(pMMF <> nil);
       try
         for p := Cardinal(pMMF) to Cardinal(pMMF) + GetFileSize(hFile, nil) - 1 do
           Inc(PData^.Freq[PChar(Pointer(p))^]);
         inc(PData^.TotalProcessed, GetFileSize(hFile, nil));
         Result := True;
       finally
         UnMapViewOfFile(pMMF);
       end;
     finally
       CloseHandle(hMMF);
     end;
   finally
     CloseHandle(hFile);
   end;
 except
   Result:=False;
 end;
end;

function SaveMemBlockToFile(Const PData:Pointer;Const DataSize:Cardinal;Const FileName:String):Boolean;
var
 hFile: THandle;
 ActualWritten:Cardinal;
begin
 try
   hFile := CreateFile(PCHar(FileName), GENERIC_WRITE, FILE_SHARE_READ,
     nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
   Win32Check(hFile <> INVALID_HANDLE_VALUE);
   Result := WriteFile(hFile, PData^, DataSize, ActualWritten, nil) and (ActualWritten = DataSize);
   CloseHandle(hFile);
 except
   Result := False;
 end;
end;

function LoadMemBlockFromFile(PData:Pointer;Const DataSize:Cardinal;Const FileName:String):Boolean;
var
 hFile: THandle;
 ActualReading:Cardinal;
begin
 try
   hFile := CreateFile(PCHar(FileName), GENERIC_READ, FILE_SHARE_READ,
     nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
   Win32Check(hFile <> INVALID_HANDLE_VALUE);
   Result := ReadFile(hFile, PData^, DataSize, ActualReading, nil) and (ActualReading = DataSize);
   CloseHandle(hFile);
 except
   Result := False;
 end;
end;

function CalcCos(Const Freq1, Freq2: PFreqInfo):Extended;
var
 numerator, len_1, len_2: Extended;
 CurIndex: Char;
begin
 numerator := 0;
 len_1 := 0;
 len_2 := 0;
 For CurIndex := Low(CurIndex) to High(CurIndex)do
 begin
   numerator := numerator + Int64(Freq1^.Freq[CurIndex]) * Int64(Freq2.Freq[CurIndex]);
   len_1 := len_1 + Int64(Freq1^.Freq[CurIndex]) * Int64(Freq1^.Freq[CurIndex]);
   len_2 := len_2 + Int64(Freq2^.Freq[CurIndex]) * Int64(Freq2^.Freq[CurIndex]);
 end;
 Result := numerator / (sqrt(len_1) * sqrt(len_2)) ;
end;

var
 Data: TFreqInfo;// инициализируется нулями автоматически при старте программы
 TestedData: TFreqInfo;
 i: Integer;
begin
 if (ParamCount()<3) or (length(ParamStr(1))<>1) then
 begin
   writeln("Вероятностное определение кодировки - по углу между векторами");
   writeln("Синтаксис: ThisProg.exe <команда> имя_файла_1 имя_файла_2 [... имя_файла_x]");
   writeln("Команда = <c|g>");
   writeln("c = создать или модифицировать таблицу частот");
   writeln("имя_файла_1-вход(эталонный текстовой файл) имя_файла_2-выход(бинарные даннные)");
   writeln("g = получить результат");
   writeln("имя_файла_1-вход(тестируемый текст)");
   writeln(" имя_файла_2,...,имя_файла_x - файлы с полученными ранее таблицами частот");
   writeln(" Рассчитанный cos выводится на stdout");
   Halt;
 end;
 Case UpCase(ParamStr(1)[1]) of
   "C":
     begin
       LoadMemBlockFromFile(@Data, SizeOf(Data),  ParamStr(3));
       if not CalcFreq(ParamStr(2), @Data)then
         writeln(" Ошибка при вычислении частот");
       if not SaveMemBlockToFile(@Data, SizeOf(Data), ParamStr(3))then
         writeln("Ошибка при сохранении данных");
     end;
   "G":
     begin
       if not CalcFreq(ParamStr(2), @TestedData)then
         writeln(" Ошибка при вычислении частот");
       For i:=3 to ParamCount()do
       begin
         if LoadMemBlockFromFile(@Data, SizeOf(Data),  ParamStr(i))then
           writeln(Format("Для %s cos=%g",[ParamStr(i),CalcCos(@Data,@TestedData)]));
       end;
     end;
 end;
end.


---

← →
vertal ©   (2005-01-21 20:42) [7]

Еще откопал алгоритм: http://faqs.org.ru/progr/pascal/delphi_faq5.htm. Там используется подсчет частот не символов, а их пар, а в качестве длины вектора берется не корень из суммы квадратов, а просто сумма модулей координат, и учитываются не все символы, а только предположительно алфавитные.

---

Страницы: 1 вся ветка

Текущий архив: 2005.03.06;
Скачать: CL | DM;

Наверх

Память: 0.5 MB
Время: 0.039 c