| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Фунция KoiToWin и сообщение с аттачем [D7, WinXP]

Yeg ©   (2006-07-14 09:25:00) 

Почему такая функция работает не правильно, если сообщение имеет аттач (я получаю только Headers через Indy). Когда я хочу раскодировать Subject, то ничего не получается:

Koi: array[0..66] of Char = (
'T', '¨', '¸', 'À', 'Á', 'Â', 'Ã', 'Ä', 'Å', 'Æ',
'Ç', 'È', 'É', 'Ê', 'Ë', 'Ì', 'Í', 'Î', 'Ï', 'Ð',
'Ñ', 'Ò', 'Ó', 'Ô', 'Õ', 'Ö', '×', 'Ø', 'Ù', 'Ú',
'Û', 'Ü', 'Ý', 'Þ', 'ß', 'à', 'á', 'â', 'ã', 'ä',
'å', 'æ', 'ç', 'è', 'é', 'ê', 'ë', 'ì', 'í', 'î',
'ï', 'ð', 'ñ', 'ò', 'ó', 'ô', 'õ', 'ö', '÷', 'ø',
'ù', 'ú', 'û', 'ü', 'ý', 'þ', 'ÿ');

Win: array[0..66] of Char = (
'¸', '¨', 'T', 'þ', 'à', 'á', 'ö', 'ä', 'å', 'ô',
'ã', 'õ', 'è', 'é', 'ê', 'ë', 'ì', 'í', 'î', 'ï',
'ÿ', 'ð', 'ñ', 'ò', 'ó', 'æ', 'â', 'ü', 'û', 'ç',
'ø', 'ý', 'ù', '÷', 'ú', 'Þ', 'À', 'Á', 'Ö', 'Ä',
'Å', 'Ô', 'Ã', 'Õ', 'È', 'É', 'Ê', 'Ë', 'Ì', 'Í',
'Î', 'Ï', 'ß', 'Ð', 'Ñ', 'Ò', 'Ó', 'Æ', 'Â', 'Ü',
'Û', 'Ç', 'Ø', 'Ý', 'Ù', '×', 'Ú');

function KoiToWin(Str: string): string;
var
 i, j, index: Integer;
begin
 Result := '';

 for i := 1 to Length(Str) do
 begin
   index := -1;
   for j := Low(Win) to High(Win) do
     if Koi[j] = Str[i] then
     begin
       index := j;
       Break;
     end;

   if index = -1 then
     Result := Result + Str[i]
   else
     Result := Result + Win[index];
 end;
end;


---

Slym   (2006-07-14 09:47:00) [1]

Subject: =?windows-1251?B?лялятополя64==?=
        =?кодировка_текста?кодировка_транспортная?текст?=
Subject: lyalyatopolya
        7битныйтекст аля eng

---

Slym   (2006-07-14 09:47:00) [2]

Yeg   (14.07.06 9:34) [2]
CharSet = ''!
У тебя 7битный текст

---

Yeg   (2006-07-14 09:34:00) [3]

Да, я щас посмотрел, у сообщений с аттачем почему то CharSet = ''! Это так и должно быть?

---

Slym   (2006-07-14 09:33:00) [4]

unit CharsetAnalis;

interface
uses Classes;
type
 TCharSet=(csWin,csKoi,csIso,csDos);
const
 CharSetStrings:array [TCharSet] of String=('Win','Koi','Iso','Dos');

function StrCharSetConver(const AStr:string;AFrom,ATo:TCharSet):string;
procedure StreamCharSetConver(InStream,OutStream:TStream;AFrom,ATo:TCharSet);
function StrCharSet(const AStr:string):TCharSet;
function StreamCharSet(Stream:TStream):TCharSet;

implementation
const
CharsSet:array[TCharSet] of string=(
'АаБбВвГгДдЕеЖжЗзИиЙйКкЛлМмНнОоПпРрСсТтУуФфХхЦцЧчШшЩщЪъЫыЬьЭэЮюЯя',
'юЮаАбБцЦдДеЕфФгГхХиИйЙкКлЛмМнНоОпПяЯрРсСтТуУжЖвВьЬыЫзЗшШэЭщЩчЧъЪ',
'РрСсТтУуФфХхЦцЧчШшЩщЪъЫыЬьЭэЮюЯяа№бёвђгѓдєеѕжізїијйљкњлћмќн§оўпџ',
#128#160#129#161#130#162#131#163#132#164#133#165#134#166#135#167#136#168#137#169 #138#170+
#139#171#140#172#141#173#142#174#143#175#144#224#145#225#146#226#147#227#148#228 #149#229+
#150#230#151#231#152#232#153#233#154#234#155#235#156#236#157#237#158#238#159#239 );

var Norm:array['А'..'я'] of double;

procedure PrepareNorm;
begin
norm['А']:=0.001;
norm['Б']:=0;
norm['В']:=0.002;
norm['Г']:=0;
norm['Д']:=0.001;
norm['Е']:=0.001;
norm['Ж']:=0;
norm['З']:=0;
norm['И']:=0.001;
norm['Й']:=0;
norm['К']:=0.001;
norm['Л']:=0;

norm['М']:=0.001;
norm['Н']:=0.001;
norm['О']:=0.001;
norm['П']:=0.002;
norm['Р']:=0.002;
norm['С']:=0.001;
norm['Т']:=0.001;
norm['У']:=0;
norm['Ф']:=0;
norm['Х']:=0;
norm['Ц']:=0;
norm['Ч']:=0.001;
norm['Ш']:=0.001;
norm['Щ']:=0;
norm['Ъ']:=0;
norm['Ы']:=0;
norm['Ь']:=0;

norm['Э']:=0.001;
norm['Ю']:=0;
norm['Я']:=0;
norm['а']:=0.057;
norm['б']:=0.01;
norm['в']:=0.031;
norm['г']:=0.011;
norm['д']:=0.021;
norm['е']:=0.067;
norm['ж']:=0.007;
norm['з']:=0.013;
norm['и']:=0.052;
norm['й']:=0.011;
norm['к']:=0.023;
norm['л']:=0.03;
norm['м']:=0.024;

norm['н']:=0.043;
norm['о']:=0.075;
norm['п']:=0.026;
norm['р']:=0.038;
norm['с']:=0.034;
norm['т']:=0.046;
norm['у']:=0.016;
norm['ф']:=0.001;
norm['х']:=0.006;
norm['ц']:=0.002;
norm['ч']:=0.011;
norm['ш']:=0.004;
norm['щ']:=0.004;
norm['ъ']:=0;
norm['ы']:=0.012;
norm['ь']:=0.012;

norm['э']:=0.003;
norm['ю']:=0.005;
norm['я']:=0.015;
end;

function StrCharSetConver(const AStr:string;AFrom,ATo:TCharSet):string;
var
 Chars:array[char] of char;
 c:char;
 i:integer;
begin
 if AFrom=ATo then
 begin
   result:=AStr;
   exit;
 end;
 for c:=#0 to #255 do Chars[c]:=c;//CodeTable
 for i:=1 to Length(CharsSet[csWin]) do
   Chars[CharsSet[ATo][i]]:=CharsSet[AFrom][i];

 SetLength(result,Length(AStr));
 for i:=1 to Length(AStr) do//Decode
   result[i]:=Chars[AStr[i]];
end;

procedure StreamCharSetConver(InStream,OutStream:TStream;AFrom,ATo:TCharSet);
var
 Chars:array[char] of char;
 c:char;
 buf:array[byte] of char;
 i,Readed:byte;
begin
 if AFrom=ATo then
 begin
   OutStream.CopyFrom(InStream,0);
   exit;
 end;
 for c:=#0 to #255 do Chars[c]:=c;//CodeTable
 for i:=1 to Length(CharsSet[csWin]) do
   Chars[CharsSet[ATo][i]]:=CharsSet[AFrom][i];
 InStream.Position:=0;
 while InStream.Position<InStream.Size do
 begin
   Readed:=InStream.Read(buf,256)-1;
   if Readed<=0 then Continue;
   for i:=0 to Readed do
     buf[i]:=Chars[buf[i]];
   OutStream.WriteBuffer(buf,Readed);
 end;
end;

function StrCharSet(const AStr:string):TCharSet;
var
 CharSet: TCharSet;
 Count:array[char] of integer;
 d,min: single;
 s:string;
 i:integer;
 c:char;
begin
 result:=csWin;
 if length(AStr)=0 then exit;
 fillchar(Count,sizeof(Count),0);
 for i:=1 to Length(AStr) do
   inc(Count[AStr[i]]);
 min:=0;
 for c:='А' to 'я' do
   min:=min+sqr(Count[c]/Length(AStr)-Norm[c]);

 for CharSet:=low(TCharSet) to high(TCharSet) do
 begin
   if CharSet=csWin then continue;
   s:=StrCharSetConver(AStr,CharSet,csWin);

   fillchar(Count,SizeOf(Count),0);//counting chars
   for i:=1 to Length(s) do
     inc(Count[s[i]]);

   d:=0;//calculation
   for c:='А' to 'я' do
     d:=d+sqr(Count[c]/Length(s)-Norm[c]);
   if d<min then
   begin
     result:=CharSet;
     min:=d;
   end;
 end;
end;

function StreamCharSet(Stream:TStream):TCharSet;
var
 CharSet: TCharSet;
 Count:array[char] of integer;
 d,min: single;
 ms:TMemoryStream;
 c:char;
begin
 result:=csWin;
 if Stream.Size=0 then exit;
 fillchar(Count,sizeof(Count),0);
 Stream.Position:=0;
 while Stream.Position<Stream.Size do
 begin
   Stream.Read(c,1);
   inc(Count[c]);
 end;
 min:=0;
 for c:='А' to 'я' do
   min:=min+sqr(Count[c]/Stream.Size-Norm[c]);
 ms:=TMemoryStream.Create;
 try
   for CharSet:=low(TCharSet) to high(TCharSet) do
   begin
     if CharSet=csWin then continue;
     ms.Clear;
     StreamCharSetConver(Stream,ms,CharSet,csWin);
     fillchar(Count,SizeOf(Count),0);//counting chars
     ms.Position:=0;
     while ms.Position<ms.Size do
     begin
       ms.Read(c,1);
       inc(Count[c]);
     end;

     d:=0;//calculation
     for c:='А' to 'я' do
       d:=d+sqr(Count[c]/ms.size-Norm[c]);
     if d<min then
     begin
       result:=CharSet;
       min:=d;
     end;
   end;
 finally
   ms.Free;
 end;
end;

initialization
 PrepareNorm;

end.


---

Наверх