VPF::Получение почты - Форум программистов

Snowy

Дата 22.2.2006, 20:02 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 53
Всего: 484

Не получил. Но поковырял разные типы сообщений. Получилось примерно следующее:

Код


procedure ReseiveMail(Host: string; Port: integer; User, Password: string);
var
  pop: TIdPOP3;
  m:   TIdMessage;
  mc,i: integer;
  dm:   TIdDecoderMIME;
begin
  Form1.Memo1.Clear;
  pop:=TIdPOP3.Create(nil);
  pop.Host:=Host; pop.Port:=Port;
  pop.Username:=User; pop.Password:=Password;
  try
    pop.Connect(60000);
    mc:=pop.CheckMessages;
    while mc>0 do begin
      m:=TIdMessage.Create(pop);
      pop.Retrieve(mc,m);
      m.SaveToFile('C:\'+IntToStr(mc)+'.msg');
      Form1.Memo1.Lines.Add('======== Mail ' + IntToStr(mc));
      Form1.Memo1.Lines.Add('-- From: ' + m.From.Text);
      if m.MessageParts.Count=0 then begin
        if pos('base64', m.ContentTransferEncoding)>0 then
        begin
          dm := TIdDecoderMIME.Create(pop);
          m.Body.Text := dm.DecodeString(m.Body.Text);
          dm.Free;
        end;
        Form1.Memo1.Lines.AddStrings(m.Body);
      end else
      for i:=0 to m.MessageParts.Count-1 do
        with m.MessageParts do
        begin
          if items[i].ClassType=TIdAttachment then
            with TIdAttachment(items[i]) do
              try
                Form1.Memo1.Lines.Add('-- Attach: '+FileName);
                if FileExists(FileName) then DeleteFile(FileName);
                SaveToFile(FileName);
              except
                ShowMessage('Не удается сохранить файл');
              end;
          if items[i].ClassType = TIdText then
            with TIdText(items[i]) do
            begin
              Form1.Memo1.Lines.Add('-- Text: ');
              Form1.Memo1.Lines.AddStrings(Body);
            end;
        end;
      m.Free; dec(mc);
    end;
    ShowMessage('Все в порядке');
  except
    ShowMessage('Не удалось подключиться к серверу');
  end;
  pop.Free;
end;

Count действительно равен 0, если сообщение не мультипарт.
Сделал отдельную обработку для простых сообщений.
С Base64 не проверял, но вроде должно работать.
Также не проверял с UUE. Не знаю, какой у него ContentTransferEncoding .

Pakshin A. S.

Дата 22.2.2006, 21:45 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: нет
Всего: 61

Пока не проверял, но такое точно должно работать, правда проще не декодировать всё письмо, а продекодить только сообщение (благо общий шаблон документа один и тот же)...

Но вот файл оно явно не будет сохранять... Вот тут провел эксперимент:
Поставил задачу убрать #13#10 из файла (его текста кодированного в письме) и раскодировать... Процессор 3GHz c 512Mb ОЗУ cправился с поставленной задачей через достаточно большой промежуток времени. Прикинув, что прога будет работать на медленных компах, постановил, что способ сохранения фала "ручками" не идет...

Все-таки как-то можно сохранить этот вложенный файл? smile

Добавлено @ 21:50

Цитата(Snowy @ 22.2.2006, 20:02

)

Не получил.

Отправил с ящика... Не уверен, что сообщение будет таким же, каким оно пришло ко мне...
Добавлено @ 21:58
Да... разница есть:

Выдержка из оригинала:

Цитата

Return-path: <>
Envelope-to:
Delivery-date: Wed, 22 Feb 2006 21:31:35 +0500
Received: from nobody by server.uzdesign.com with local (Exim 4.52)
id 1FBwtL-0006kd-JX
for ; Wed, 22 Feb 2006 21:31:12 +0500
To:
Subject: Testing...
From: [email protected]
Errors-To: [EMAIL=][/EMAIL]
Content-type: text/plain; charset=windows-1251
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary = bc78d03e383c4c12234d4df1a94f11f7d
Message-Id: <>
Date: Wed, 22 Feb 2006 21:31:03 +0500
This is a MIME encoded message.

--bc78d03e383c4c12234d4df1a94f11f7d
Content-Type: text/plain
Content-Transfer-Encoding: base64

...

--bc78d03e383c4c12234d4df1a94f11f7d
Content-Type: file;
name = "Bootfont.bin"
Content-Transfer-Encoding: base64

...

А вот выдержка из письма, которое переслалось:

Цитата

Return-path: <>
Envelope-to:
Delivery-date: Wed, 22 Feb 2006 23:51:30 +0500
Received: from ([] helo=user)
by server.uzdesign.com with smtp (Exim 4.52)
id 1FBz59-0007ai-CY; Wed, 22 Feb 2006 23:51:28 +0500
Message-ID: <001e01c637e0$f91f7c30$d4c05358@user>
From: "Pakshin A. S." <>
To: <>,
<>
Subject: Testing...
Date: Wed, 22 Feb 2006 21:49:37 +0300
MIME-Version: 1.0
Content-Type: multipart/mixed;
boundary="----=_NextPart_000_0013_01C637F9.E0151420"
X-Priority: 3
X-MSMail-Priority: Normal
X-Mailer: Microsoft Outlook Express 6.00.2900.2180
X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2900.2180

This is a multi-part message in MIME format.

------=_NextPart_000_0013_01C637F9.E0151420
Content-Type: text/plain;
format=flowed;
charset="koi8-r";
reply-type=original
Content-Transfer-Encoding: 7bit

...

------=_NextPart_000_0013_01C637F9.E0151420
Content-Type: application/octet-stream;
name="Bootfont.bin"
Content-Transfer-Encoding: base64
Content-Disposition: attachment;
filename="Bootfont.bin"
...

Есть разница...
Добавлено @ 22:00
И эта разница оказалась существенной! Программа заработала именно с письмом, которое переслалось...

Pakshin A. S.

Дата 22.2.2006, 22:02 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: нет
Всего: 61

Но ведь тот же самый Outlook все прекрасно читает (оба варианта письма)... Значит как--то все-таки это можно сделать, не изменяя отправку письма... smile

Snowy

Дата 22.2.2006, 23:00 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 53
Всего: 484

Оригинал мультипарт. Значит должен отлично проходить по стандартной схеме.
сделай m.SaveToFile и пришли мне на petin<at>pisem.net

Pakshin A. S.

Дата 22.2.2006, 23:06 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: нет
Всего: 61

Цитата(Snowy @ 22.2.2006, 23:00

)

пришли мне

Отправлено...

Pakshin A. S.

Дата 23.2.2006, 13:34 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: нет
Всего: 61

Так... наконец-таки все заработало...

Средство: изменил исходный текст письма, которое формировалось на сервере.

Snowy

Дата 23.2.2006, 14:17 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 53
Всего: 484

Ну, блин. Докопался до истины - мелкий баг в Indy9. В 10-й пока не смотрел.

Цитата(Pakshin A. S. @ 22.2.2006, 21:45

)

Content-Type: multipart/mixed; boundary = bc78d03e383c4c12234d4df1a94f11f7d

Вот на этом она спотыкается.
Недоработка в class function TIdMIMEBoundary.FindBoundary
Не предусмотрено, что могут быть пробелы слева и справа от '='.
Вот из-за этих пробелов инди не находит маркер частей.
Если пробелы убрать, то все проходит на ура.
Код инди корректировать некультурно. Значит нужно под нее подстраиваться.
Код напишу позже. Сейчас есть хочу smile

Snowy

Дата 23.2.2006, 16:41 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 53
Всего: 484

Готово:

Код


procedure ProcessMessage(m: TIdMessage);
var
  sl: TStringList;
  i:  integer;
  pp: string;

  function Decode64(s: string): string;
  var dm: TIdDecoderMIME;
  begin
    result := s;
    dm := TIdDecoderMIME.Create(nil);
    try
      result := dm.DecodeString(s);
    finally
      dm.Free;
    end;
  end;

  procedure FixMsg;
  var
    i, b: integer;
    s:    string;
    ms:   TMemoryStream;
  begin
    s := m.ContentType;
    b := pos('boundary', LowerCase(s));
    if b = 0 then Exit;
    for i := Length(s) downto b do
      if s[i] = ' ' then delete(s, i, 1);
    if s = m.ContentType then Exit;
    m.ContentType := s;
    ms := TMemoryStream.Create;
    m.SaveToStream(ms);
    ms.Position := 0;
    m.LoadFromStream(ms);
    ms.Free;
  end;

  procedure ProcessAttach(att: TIdAttachment);
  var
    Path: string;
  begin
    Path := pp + 'Attach';
    ForceDirectories(Path);
    Path := Path + '\' + att.FileName;
    try
      if FileExists(Path) then DeleteFile(Path);
      att.SaveToFile(Path);
      sl.Add('Attach: ' + att.FileName);
    except
      ShowMessage('Не удается сохранить файл');
    end;
  end;

begin
  sl := TStringList.Create;
  pp := ExtractFilePath(ParamStr(0));
  FixMsg;
  if m.MessageParts.Count = 0 then
  begin
    if pos('base64', m.ContentTransferEncoding)>0 then
      m.Body.Text := Decode64(m.Body.Text);
    sl.AddStrings(m.Body);
  end else
    for i:=0 to m.MessageParts.Count-1 do
    with m.MessageParts do
    begin
      if items[i].ClassType=TIdAttachment then
        ProcessAttach(TIdAttachment(items[i]));
      if items[i].ClassType = TIdText then
        with TIdText(items[i]) do
          sl.AddStrings(Body);
  end;
  try
    pp := pp + 'Messages';
    ForceDirectories(pp);
    for i := 1 to 9 do
    m.MsgId := StringReplace(m.MsgId, copy('<>:/\+*?"', i, 1),
                               '', [rfReplaceAll]);
    if sl.Count > 0 then sl.SaveToFile(pp + '\' + m.MsgId + '.msg');
  finally
    sl.Free;
  end;
end;

procedure ReseiveMail(Host: string; Port: integer; User, Password: string);
var
  pop: TIdPOP3;
  m:   TIdMessage;
  mc:  integer;
begin
  pop:=TIdPOP3.Create(nil);
  pop.Host:=Host; pop.Port:=Port;
  pop.Username:=User; pop.Password:=Password;
  try
    pop.Connect(60000);
    mc:=pop.CheckMessages;
  except
    mc := 0;
    ShowMessage('Не удалось подключиться к серверу');
  end;
  while mc>0 do
  begin
    m:=TIdMessage.Create(pop);
    try
      pop.Retrieve(mc,m);
      ProcessMessage(m);
    finally
      m.Free; dec(mc);
    end;
  end;
  pop.Free;
end;

jon76

Дата 15.1.2010, 14:29 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 1
Регистрация: 14.1.2010

Репутация: нет
Всего: нет

Немного

подниму тему.
Вопрос такой, как доработать пример получниея почты что бы он после отделения присоединенного файла, удалял само письмо с сервера?
А если не удалять письма, то как не получать ранее полученные письма? Приходит в голову проверять при получении MSgId получаемого письма и тех которые были получены ранее, но для этого прийдется хранить Id всех ранее полученных писем. Возможно есть более красивый способ.

Это сообщение отредактировал(а) jon76 - 15.1.2010, 15:05

hkdkest

Дата 16.1.2010, 00:04 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 300
Регистрация: 30.11.2008

Репутация: нет
Всего: 1

Цитата(Pakshin A. S. @ 20.2.2006, 23:20)

Итак, на почтовый ящик в инете поступило n штук писем с вложенными файлами.

Вот эти письма я должен получить поочередно из программы; получить текст письма, сохранить на жестком диске вложенный файл под определенным именем, получить адрес отправителя и время получения письма на сервер. Как это реализуется? Киньте ссылки на исходники таких функций (получение нужной информации, описанной выше)...

Заранее огромное Спасибо! smile

материалы и исходник
TIdMessage - объект почтового сообщения Indy
Отправить письмо на E-mail
Почтовый клиент (основы)

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Сети \| Следующая тема »