Автор: Antananarivu
Дата сообщения: 31.03.2008 13:33
Короче говоря, вроде как переустановил Indy, но проблема не исчезла...
Программа считывает почту с сервера, 150 сообщений могут пройти нормально, без сбоев и вдруг.. ошибка "Асcess violation at address.....".
При этом текст программы в общем-то стандартный... да и те письма, которые приводят к ошибке, ничем особенным не выделяются.
Код:
unit Unit222;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdMessage, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdMessageClient, IdPOP3, IdHeaderCoder;
const
cod='=?ISO-8859-1?';
koi=';';
win='';
base64_tbl: array[0..63] of Char = (
'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P',
'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X',
'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f',
'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n',
'o', 'p', 'q', 'r', 's', 't', 'u', 'v',
'w', 'x', 'y', 'z', '0', '1', '2', '3',
'4', '5', '6', '7', '8', '9', '+', '/');
type
TForm1 = class(TForm)
Button1: TButton;
POP3: TIdPOP3;
IdMessage: TIdMessage;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
function MailDeCode(Value: string): string;
function KoiToWin(Value: string): string;
public
{ Public declarations }
end;
var
Form1: TForm1;
intIndex: integer;
attach: TIdAttachment;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
label f;
var
mailcicl: integer;
partstr: integer;
s: string;
addr: string;
FN: string;
koi: boolean;
tt:integer;
begin
POP3.Host:='pop.mail.ru';
POP3.Port:=110;
POP3.UserID:='antananarivu83@mail.ru';
POP3.Password:='**';
addr:=ExtractFilePath(Application.ExeName)+'bol\';
POP3.Connect;
tt:=POP3.CheckMessages;
for mailcicl:=1 to tt do
begin
if POP3.CheckMessages<1 then goto f;
IdMessage.Clear; ;
Memo1.Clear;
IdMessage.NoDecode:=false;
POP3.Retrieve(mailcicl,IdMessage);
for intIndex := 0 to IdMessage.MessageParts.Count-1 do
begin
if IdMessage.MessageParts.Items[intIndex].ClassType=TIdattachment then
begin
FN:= TIdAttachment(IdMessage.MessageParts.Items[intIndex]).Filename;
FN:=MailDeCode(FN);
FN:=AnsiUpperCase(FN);
Attach := IdMessage.MessageParts.Items[intIndex] as TIdAttachment ;
Attach.SaveToFile(addr+FN);
// TIdAttachment(IdMessage.MessageParts.Items[intIndex]).SaveToFile(
// TIdAttachment(Idmessage.MessageParts.Items[intIndex]).Filename);
// TIdAttachment.Create(Idmessage.MessageParts,
// TIdAttachment(Idmessage.MessageParts.Items[intIndex]).Filename)
end;
if IdMessage.MessageParts.Items[intIndex].ClassType=TidText then
begin
For PartStr:=0 to TIdText(IdMessage.MessageParts.Items[IntIndex]).Body.Count-1 do
begin
s:=TIdText(IdMessage.MessageParts.Items[intIndex]).Body.Strings[PartStr];
if (IdMessage.ContentType='text/plain; charset=koi8-r') then s:=KoiToWin(s);
if Pos('multipart', LowerCase(IdMessage.ContentType)) > 0 then
begin
if IdMessage.MessageParts.Items[intIndex].ContentType='text/plain; charset=koi8-r' then s:=KoiToWin(s);
end;
memo1.Lines.Add(s);
end;
Memo1.Lines.SaveToFile(addr+inttostr(mailcicl)+'.txt');
end;
end;
// POP3.Delete(mailcicl);
end;
Attach.Free;
f:
POP3.Disconnect;
end;
end;
function TForm1.MailDeCode(Value: String): string;
var q:integer;
l:integer;
koi:boolean;
begin
//
if (Pos('=?KOI8-R', UpperCase(value)) > 0) or (Pos('=?WIN', UpperCase(value)) > 0)then
begin
IdMessage.CharSet:='KOI8-R';
q:=0;
koi:=(Pos('=?KOI8-R', UpperCase(value)) > 0);
while q<2 do
begin
l:=pos('?',value);
delete(value,1,l);
inc(q);
end;
value := cod + Value;
result:=DecodeHeader(value);
While pos(#0,result)>0 do
// result:=AnsiReplaceStr(result,#0,'');
delete(result,pos(#0,result),1);
if koi then result:= KoiToWin(result);
end
else
result:=value;
end;
function TForm1.KoiToWin(Value: string): String;
var L, I, Q:integer;
s:string;
chkoi, chwin :char;
Lkoi:integer;
conv:boolean;
begin
s:='';
Lkoi:=length(koi);
L:=length(value);
for I:=1 to L do
begin
chkoi:=value[I];
q:=1;
conv:=false;
while (not conv) and (q<=lkoi) do
begin
chwin:=win[q];
conv:= (chkoi = chwin);
if not conv then
inc(Q);
end;
if q<=lkoi then
s:=s+koi[q]
else
s:=s+chkoi;
end;
value:=s;
result:=Value;
end;
end.
