procedure TForm1.Button1Click(Sender: TObject); var imapsnd: TImapSend; n,i: integer; sl: TStringList; mime:TMimemess; part: TMimepart; begin sl := TStringList.Create; imapsnd := TImapSend.Create; mime:=TMimemess.create; imapsnd.Username := 'mybox@gmail.com'; imapsnd.Password := 'pass'; imapsnd.TargetHost := 'imap.googlemail.com'; imapsnd.AutoTLS:=true; imapsnd.TargetPort:='993'; imapsnd.FullSSL:=true; Memo1.Lines.Assign(imapsnd.FullResult); if imapsnd.Login then begin imapsnd.List('', Listbox1.Items); if imapsnd.SelectFolder('inbox') then begin for i:=1 to 10 do begin imapsnd.FetchMess(i,mime.Lines); mime.DecodeMessage; Memo2.Lines.Add(mime.Header.From); Memo2.Lines.Add(DateTimeToStr(mime.Header.Date)); Memo2.Lines.Add(''); for n := 0 to mime.MessagePart.GetSubPartCount-1 do begin part:=mime.MessagePart.GetSubPart(n); part.DecodePart; Memo2.Lines.Add(part.Charset); if (LowerCase(part.Primary)='text') and (LowerCase(part.FileName)='') then //Проверим , данный блок - текст сообщения begin if LowerCase(part.Secondary)='plain' then begin //Memo1.Lines.LoadFromStream(part.DecodedLines) part.DecodedLines.SaveToFile('.\attaches\'+IntToStr(i)+'_'+part.Charset+'.txt') end else begin part.DecodedLines.SaveToFile('.\attaches\'+IntToStr(i)+'_'+part.Charset+'.html') end; end; if part.FileName<>'' then begin part.DecodedLines.SaveToFile('.\attaches\'+IntToStr(i)+'_'+part.FileName) ; Memo3.Lines.Add(IntToStr(i)+' '+part.FileName); Application.ProcessMessages; end; end; end; imapsnd.CloseFolder; end; imapsnd.Logout; end else Memo1.Lines.Add('Соединение с сервером не установлено' ); mime.Free; imapsnd.Free; sl.Free; end;
У вас нет необходимых прав для просмотра вложений в этом сообщении.
Последний раз редактировалось Ism 26.05.2012 13:26:28, всего редактировалось 1 раз.
type TForm1 = class(TForm) ... procedure Button1Click(Sender: TObject); procedure GetParts(const part: TMimepart); private { Private declarations } public { Public declarations } end;
var Form1: TForm1; IdMes:TMimeMess; implementation
{$R *.dfm} procedure TForm1.GetParts(const part: TMimepart); var s: string; i: integer; begin if (LowerCase(part.Primary)='text') and (LowerCase(part.FileName)='') then //Проверим ÷то данный блок - текст сообщения begin part.DecodePart; if LowerCase(part.Secondary)='plain' then // Определяем что это простой текст Memo1.Lines.LoadFromStream(part.DecodedLines) // Загружаем раскодированные данные else // о, нашелся еще и альтеративный метод отображения, я предположил что у меня всегда формат html begin // загрузим в браузер, не обязательно, можно и просто сохранить как страницу html WebBrowser1.Navigate('html.htm'); while WebBrowser1.ReadyState < READYSTATE_INTERACTIVE do Application.ProcessMessages; (WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(part.DecodedLines)); end; end; if LowerCase(part.FileName)<>'' then begin // а вдруг это вложение part.DecodePart; part.DecodedLines.SaveToFile('c:\'+part.FileName) ; Memo3.Lines.Add('Сохранено в '+'c:\'+part.FileName) end; for i := 0 to part.GetSubPartCount - 1 do GetParts( part.getsubpart(i)); // проверяем наличие следующего блока end;
procedure TForm1.Button1Click(Sender: TObject); var i:integer; begin if OpenDialog1.Execute then begin IdMes:=TMimeMess.Create; IdMes.Lines.LoadFromFile(OpenDialog1.FileName); end; IdMes.DecodeMessage; // Раскодируем сообщение, обязательно LabeledEdit2.Text:=IdMes.Header.From; LabeledEdit1.Text:=trim(IdMes.Header.ToList.Text); // Получатели сообщения LabeledEdit3.Text:=IdMes.Header.Subject; Memo2.Lines.Assign(IdMes.Header.CustomHeaders); // Заголовки, не спицифичные для формата MIME GetParts(IdMes.MessagePart); // рекурсивная процедура обхода блоков сообщения