•  

ГлавнаяIndyЧастые вопросы по Indy → Как с помощью IdSMTPServer и IdSMTP организовать пересылку почты на другой сервер?

Создано: 24.05.2014 23:22:25 · Исправлено: 24.05.2014 23:22:25 · Прочтений: 1100

Камрады, подскажите как с помощью IdSMTPServer и IdSMTP организовать пересылку почты на другой сервер? ...

Задолбался ковыряться с аттачментами. Можно ли так сделать, чтобы проверить по OnCommandMail адрес отправителя и если удовлетворяет, то переслать его с помощью IdSMTP на другой сервер? Я сколько ни бился, все аттачметы в пересылаемом письме в текст закладываются... Сидеть пофайлово перебирать вложения из входящего в отправляемое тоже не хочу, провались бы оно пропадом... Нельзя ли как нибудь сохранить весь AMsg:TIdMessage и неломая пульнуть его через IdSMTP?
procedure TFormMainTest.IdSMTPServer1MsgReceive(ASender: TIdSMTPServerContext;
  AMsg: TStream; var LAction: TIdDataReply);
begin
//событие приема почты 
// amsg - это полностью все сообщение вместе с заголовками, вложениями и прочим
  DoDecodeMIME(amsg);
  LAction:= dOk;
end;

// хотите - разбирайте так
procedure TFormMainTest.DoDecodeMIME(xMsg: TStream);
var xClient: TIdMessageClient;
    xMessage: TIdMessage;
    i:integer;
    xMessageBody: string;
    xMessagePart: TObject;
    xAttachStream: TMemoryStream;
begin
  xClient  := NIL;
  xMessage := NIL;
  try
    try
      // создаем необходимые объекты
      xClient  := TIdMessageClient.Create(nil);
      xMessage := TIdMessage.Create(NIL);
      // передаем сообщение для обработки
      xMsg.Seek(0,0);
      xMessage.LoadFromStream(xMsg);
      // разбор сообщения
      xClient.ProcessMessage( xMessage);
      // обрабатываем результат
      // текст письма
      xMessageBody := ;
      // если частей нет - то передается только текст письма
      if (xMessage.MessageParts.Count <= 0)
        then xMessageBody := xMessage.Body.Text
        else
          // иначе - сканируем все вложенные части письма
          for i := 0 to xMessage.MessageParts.Count - 1 do begin
            // объект части письма
            xMessagePart := xMessage.MessageParts.Items[i];
            // если это текст - тогда сохраняем текст в теле
            if (xMessagePart is TIdText)
              then xMessageBody := TIdText(xMessagePart).Body.Text
              else
                // если это вложенный файл - анализируем его
                if (xMessagePart is TIdAttachment) then begin
                  // забираем тело из прикрепленной части
                  // поскольку имя не интерисует нас - его не проверяем
                  xAttachStream := TMemoryStream.Create;
                  xAttachStream.Clear;
                  TIdAttachment(xMessagePart).SaveToStream(xAttachStream);
                  // анализируем данные
                  DoDecodeStream(xAttachStream.Memory, xAttachStream.Size);
                  xAttachStream.Free;
                end;
{
s:=s
    +#13#10#13#10BODY#13#10+xMessage.Body.Text
    +#13#10#13#10parts = +inttostr(xMessage.MessageParts.Count);
for i := 0 to xMessage.MessageParts.Count - 1 do begin
  s:=s+#13#10==================================================================================
      +#13#10item=+inttostr(i);
  if xMessage.MessageParts.Items[i] is TIdText then begin
    xItem:=TIdText(xMessage.MessageParts.Items[i]);
    s:=s
        +#13#10  id= + xItem.ContentID
        +#13#10  type= + xItem.ContentType
        +#13#10  transf= + xItem.ContentTransfer
        +#13#10  locat= + xItem.ContentLocation
        +#13#10  descr = + xItem.ContentDescription
        +#13#10  body = + xItem.Body.Text
        +#13#10  bound= + xItem.Boundary;
  end else
    if xMessage.MessageParts.Items[i] is TIdAttachment then begin
      xItemA:=TIdAttachment(xMessage.MessageParts.Items[i]);
      s:=s
          +#13#10  id= + xItemA.ContentID
          +#13#10  type= + xItemA.ContentType
          +#13#10  transf= + xItemA.ContentTransfer
          +#13#10  locat= + xItemA.ContentLocation
          +#13#10  descr = + xItemA.ContentDescription
          +#13#10  filename = + xItemA.FileName
          +#13#10  bound= + xItemA.Boundary;
      xM:= TMemoryStream.Create;
      xM.Clear;
      xItemA.SaveToStream(xM);
      setlength(s2, xM.Size);
      move(xM.Memory^, pchar(s2)^, xM.Size);
      xM.Free;
      s:= s+#13#10  SIZE= + inttostr( length(s2));
      s:= s+#13#10  FILE= + tools.BArrayTOSH( pchar(s2), length(s2));
    end else begin
      s:=s
          +#13#10  id= + xMessage.MessageParts.Items[i].ContentID
          +#13#10  type= + xMessage.MessageParts.Items[i].ContentType
          +#13#10  transf= + xMessage.MessageParts.Items[i].ContentTransfer
          +#13#10  locat= + xMessage.MessageParts.Items[i].ContentLocation
          +#13#10  descr = + xMessage.MessageParts.Items[i].ContentDescription;
    end;}
          end;//for//
      except
        on e:Exception
          do messagebox(0,pchar(e.Message), DoDecodeMIME, MB_OK);
    end;
    finally
      if ASSIGNED(xMessage) then xMessage.Free;
      if ASSIGNED(xClient) then xClient.Free;
  end;
end;

для проверки отправителя можно перехватить события
procedure TFormMainTest.IdSMTPServer1MailFrom(ASender: TIdSMTPServerContext;
  const AAddress: string; var VAction: TIdMailFromReply);
begin
  VAction := mAccept;
end;

procedure TFormMainTest.IdSMTPServer1RcptTo(ASender: TIdSMTPServerContext;
  const AAddress: string; var VAction: TIdRCPToReply; var VForward: string);
begin
VAction:= rAddressOk;
VForward:= VForward test !;
end;

procedure TFormMainTest.IdSMTPServer1Received(ASender: TIdSMTPServerContext;
  var AReceived: string);
begin
AReceived:=IdSMTPServer1Received test - ok;
end;

для пересылки - слазте за примерами
http://www.indyproject.org/Sockets/Demos/index.EN.aspx