//IMAP4
IdIMAP41.Connect;
//Das muss ich machen, da ich sonst schon beim Abfragen des
//LastCmdResult eine Fehlermeldung bekomme
while IdIMAP41.ConnectionState<>csAuthenticated
do
Application.ProcessMessages;
if IdIMAP41.LastCmdResult.TextCode = '
1'
then
Memo2.Lines.Add('
<< +OK Ready')
else
Memo2.Lines.Add('
<< +OK Result ' + IdIMAP41.LastCmdResult.TextCode);
aCount := IdIMAP41.MailBox.TotalMsgs;
//<-Hier crasht's... ich kann nicht auf MailBox zugreifen (?)
aSize := IdIMAP41.RetrieveMailBoxSize;
Memo2.Lines.Add('
<< +OK ' + IntToStr(aCount) + '
' + IntToStr(aSize));
IdSMTP1.Connect;
if IdSMTP1.Connected = True
then
begin
Memo2.Lines.Add(IntToStr(aCount) + '
messages waiting');
for n := 1
to aCount
do
begin
TmpMsg := TIdMessage.Create(
nil);
try
if IdIMAP41.Retrieve(n, TmpMsg) = True
then
Memo1.Lines.Add('
retrieved')
else
Memo1.Lines.Add('
NOT retrieved');
MS := TMemoryStream.Create;
try
TmpMsg.SaveToStream(MS);
Memo2.Lines.Add('
<< +OK ' + IntToStr(MS.Size));
finally
MS.Free;
end;
Memo2.Lines.Add('
Message from: ' +
ExtractMail(TmpMsg.Headers.Values['
From']));
Memo2.Lines.Add('
to: ' +
ExtractMail(TmpMsg.Headers.Values['
To']));
TmpMsg.Headers.BeginUpdate;
if UserField <> '
'
then
begin
if TmpMsg.Headers.IndexOfName(UserField) = -1
then
TmpMsg.Headers.Add(UserField);
end;
if TmpMsg.Headers.IndexOfName('
Envelope_to') = -1
then
TmpMsg.Headers.Add('
Envelope_to');
FoundApparentlyTo := False;
for m := 0
to TmpMsg.Headers.Count - 1
do
begin
if Copy(LowerCase(TmpMsg.Headers[m]), 1, 13) =
LowerCase('
Apparently-To')
then
begin
SendTo := Copy(TmpMsg.Headers[m], 16,
Length(TmpMsg.Headers[m]));
TmpMsg.Headers[m] := '
Apparently-To: ' + Envelope_to;
FoundApparentlyTo := True;
end
else if Copy(LowerCase(TmpMsg.Headers[m]), 1, 11) =
LowerCase('
Envelope_to')
then
begin
TmpMsg.Headers[m] := '
Envelope_to: ' + Envelope_to;
end
else if (UserField <> '
')
and
(Copy(LowerCase(TmpMsg.Headers[m]),
1,
Length(UserField)) = LowerCase(UserField))
then
TmpMsg.Headers[m] := UserField + '
: ' + Envelope_to;
end;
if FoundApparentlyTo = False
then
begin
for m := 0
to TmpMsg.Headers.Count - 1
do
begin
if Copy(LowerCase(TmpMsg.Headers[m]), 1, 2) = LowerCase('
To')
then
begin
SendTo := Copy(TmpMsg.Headers[m], 5,
Length(TmpMsg.Headers[m]));
TmpMsg.Headers[m] := '
To: ' + Envelope_to;
break;
end;
end;
end;
TMpMsg.Headers.Add('
SendTo: ' + SendTo);
TmpMsg.Headers.EndUpdate;
TmpMsg.ProcessHeaders;
for m := 0
to TmpMsg.Headers.Count - 1
do
Memo1.Lines.Add('
Headers[' + IntToStr(m) + '
] ' +
TmpMsg.Headers[m]);
try
IdSMTP1.Send(TmpMsg);
if IdSMTP1.LastCmdResult.TextCode = '
250'
then
begin
if CheckBox1.Checked = True
then
Memo2.Lines.Add('
<< +OK leave Message on Server')
else if IdPop31.Delete(n) = True
then
Memo2.Lines.Add('
<< +OK Message deleted')
else
begin
Memo2.Lines.Add('
<< +Error Message not deleted');
ErrCnt := ErrCnt + 1;
end;
end
else
Memo2.Lines.Add('
<< +OK ' +
DeQuote(IdSMTP1.LastCmdResult.Text.CommaText));
except
Memo2.Lines.Add('
<< +Error ' +
DeQuote(IdSMTP1.LastCmdResult.Text.CommaText));
ErrCnt := ErrCnt + 1;
end;
finally
TmpMsg.Free;
end;
end;
if ErrCnt = 0
then
Memo2.Lines.Add('
<< +OK Everything done')
else
Memo2.Lines.Add('
<< +Error ' + IntToStr(ErrCnt) +
'
errors while processing');
IdSMTP1.Disconnect;
IdIMAP41.Disconnect;
end
else
Memo2.Lines.Add('
<< +Error not connected to SMTP');