Tak, da się. Nie potrzebowałem tego na razie, a tylko testowałem, więc ma różne niedociągnięcia - główne to brak polskich znaków
uses
imapsend, mimemess, ssl_openssl, ssl_openssl_lib, synacode, mimepart, synachar, regexpr;
procedure TForm1.Button1Click(Sender: TObject);
var
ImapClient: TIMAPSend;
MimeMess: TMimeMess;
MsgsList, Msg: TStringList;
i: Integer;
begin
MimeMess := TMimeMess.Create;
MsgsList := TStringList.Create;
Msg := TStringList.Create;
ImapClient := TIMAPSend.Create;
ImapClient.TargetHost := 'mail8.mydevil.net';
ImapClient.TargetPort := '993';
ImapClient.UserName := maillogin;
ImapClient.Password := mailpasswd;
ImapClient.AutoTLS := False;
ImapClient.FullSSL := True;
ImapClient.Login;
ImapClient.SelectFolder('INBOX'); //foder, z którego ma czytać maile, tutaj skrzynka odbiorcza
if ImapClient.SearchMess('ALL', MsgsList) then
//ALL - wszystkie, UNSEEN - tylko nieprzeczytane (nieprzeczytane automatycznie po pobraniu ustawiane są jako preczytane)
begin
for i := 0 to MsgsList.Count - 1 do
begin
Msg.Clear;
ImapClient.FetchMess(StrToInt(MsgsList[i]), Msg);
MimeMess.Lines.Text := Msg.Text;
MimeMess.DecodeMessage;
Memo1.Lines.Add(MimeMess.Header.From); //nadawca
Memo1.Lines.Add(MimeMess.Header.Subject); //temat
memo1.Lines.Add('------------');
DecodePart(MimeMess.MessagePart); //wiadomość
memo1.Lines.Add('============');
Msg.SaveToFile('D:\' + MsgsList[i] + '.eml'); //zapisz wiadomość do pliku eml
end;
end;
MsgsList.Free;
Msg.Free;
end;
procedure TForm1.DecodePart(Part: TMimePart);
var
i: Integer;
s, pp, ps: String;
begin
Part.DecomposeParts; //decode subparts
Part.DecodePart;
pp := UpperCase(Part.Primary);
ps := UpperCase(Part.Secondary);
if pp <> 'MULTIPART' then //If Multipart, go next level
begin
Part.DecodedLines.Seek(0, soFromBeginning);
if pp = 'TEXT' then
begin
if (ps = 'PLAIN') then
begin
SetLength(s, Part.DecodedLines.Size);
Part.DecodedLines.Read(s[1], Length(s));
Memo1.Lines.Add('Wiadomość tekstowa: ' + s);
end;
if (ps = 'HTML') then
begin
SetLength(s, Part.DecodedLines.Size);
Part.DecodedLines.Read(s[1], Length(s));
s := ReplaceRegExpr('<(script|style).*?</\1>', s, '', false); //usuń znaczniki script i style
s := ReplaceRegExpr('<.*?>', s, '', False); //usuń resztę tagów
Memo1.Lines.Add('Wiadomość HTML: ' + s);
end;
end
else
begin
if Part.FileName <> '' then
begin
Part.DecodedLines.SaveToFile('D:\' + Part.Filename); //zapisz załącznik
end;
end;
end;
for i := 0 to Part.GetSubPartCount - 1 do
begin
DecodePart(Part.GetSubPart(i));
end;
end;