Mandar email con adjunto

[[newtron]]

Hola.

Te envío un trozo de código de lo que yo uso, usando SSL. Si algo no ves claro me preguntas.

Saludos

Código Delphi [-]
  IdEnviar := TIdMessage.Create(Self);
  TextoMensaje:=Texto+#13+#10+Firma+#13+#10+TablaDatos.FieldByname('TEXTOMAIL').Value;
  IdEnviar.Body.Text     := TextoMensaje;
  IdEnviar.From.Address  := CorreoPropio; { e-mail del que envía }
  IdEnviar.From.Name     := DlgPropiedades.NombreEmpresa; { El nombre del que envía }
  IdEnviar.Subject       := Subject;

  TIdAttachmentFile.Create(IdEnviar.MessageParts, GetTempDir+'\DOCUMENTO.PDF'); //Para adjuntar archivos al mensaje

  ListaDestinatarios:=CargaRegistro(Correo,';');

  for N := 0 to ListaDestinatarios.Count - 1 do begin
    ElDestinatario         := IdEnviar.Recipients.Add;
    ElDestinatario.Address := ListaDestinatarios[N]; { Primer destinatario }
  end;
//  ElDestinatario.Name    := 'Nombre del primer destinario';
  If Copia<>'' then begin
    ElDestinatario         := IdEnviar.Recipients.Add;
    ElDestinatario.Address := Copia; { Primer destinatario }
  end;
  Application.ProcessMessages ;
  IdSMTP1.Host       := Host;
  IdSMTP1.UserName   := UserId;
  IdSMTP1.Password   := Pass;

  if Puerto<>0 then IdSMTP1.Port:= Puerto;

  if(TablaDatos.FieldByName('TLSMAIL').AsString<>'') and (Copy(TablaDatos.FieldByName('TLSMAIL').AsString,1,1)<>'1') then begin
    idSMTP1.IOHandler := IdSSLIOHandlerSocketOpenSSL;
    if Copy(TablaDatos.FieldByname('TLSMAIL').AsString,1,1)='2' then begin
      idSMTP1.UseTLS := utUseExplicitTLS;
    end else if Copy(TablaDatos.FieldByname('TLSMAIL').AsString,1,1)='3' then begin
      idSMTP1.UseTLS := utUseImplicitTLS;
    end else if Copy(TablaDatos.FieldByname('TLSMAIL').AsString,1,1)='4' then begin
      idSMTP1.UseTLS := utUseRequireTLS;
    end else begin
      idSMTP1.UseTLS := utNoTLSSupport;
    end;
//    IdSSLIOHandlerSocketOpenSSL.Host :=TablaDatos.FieldByname('HOSTCO').AsString;
//    IdSSLIOHandlerSocketOpenSSL.Destination :=TablaDatos.FieldByname('HOSTCO').AsString+':'+IntToStr(IdSMTP1.Port);
  end;
  Bd.CierraTabla (TablaDatos);

  Try
    IdSMTP1.Connect;
    try
      IdSMTP1.Send(idEnviar);
    finally

    end;

  except
raise;
     ShowMessage('¡ATENCION! Problema de conexion');
     Close;
  end;
  IdSMTP1.Disconnect(true);

[[José Luis Garcí]]

hola compañeros agradezco vuestra ayuda, pero no logro que tire, el error que más me sale es



e puesto un componente IdSSLIOHandlerSocketOpenSSL vinculado a mi IDSMTP y la propiedad UseTLS en sus diferentes modos y nada, la verdad es que me tiene totalmente parado ya que es una parte fundamental en el trabajo que estoy haciendo, así que os pido ayuda nuevamente

Así es como paso los datos



Y así es el form en diseño con los componentes que veis únicamente

[[José Luis Garcí]]

siguiendo dando vueltas al tema, he vuelto a la función que se que me funciona, que es

Código Delphi [-]
procedure TForm1.Button1Click(Sender: TObject);
function EnviarEmail(aData, aHora : TDateTime; aHost, aLogin, aSenha,aListaEmail, aAssunto, aCorpo : String; Mifile:string) : Boolean;
var
  IdSMTP    : TIdSMTP;
  IdMessage : TIdMessage;
  Cabecalho: string;
begin
  Cabecalho:= '';
  Result:= False;
  IdSMTP    := TIdSMTP   .Create(nil);
  IdMessage := TIdMessage.Create(nil);
  try
    IdSMTP.Host:= aHost;
    IdSMTP.AuthType:= satDefault;
    IdSMTP.Username:= aLogin;
    IdSMTP.Password:= aSenha;
    IdSMTP.Connect;

    IdMessage.From.Address:= aLogin;
    IdMessage.Recipients.EMailAddresses:= aListaEmail;
    IdMessage.Subject:= aAssunto;
    IdMessage.Body.Text:='Data: '+DateToStr(aData)+#13#10+'Hora: '+TimeToStr(aHora)+#13#10+ aCorpo;
    IdMessage.MessageParts.Clear;
    if Mifile<>'' then TIdAttachmentFile.Create(IdMessage.MessageParts,Mifile);
    try
      IdSMTP.Send(IdMessage);
    except
      on E: Exception do
        begin
          MessageDlg('Error al intentar enviar este correo '+#13#10+e.Message,mtWarning,[mbok],0);
          Exit;
        end;
    end;
  finally
    IdSMTP   .Disconnect;
    IdSMTP   .Free;
    IdMessage.Free;
  end;
  Result:= True;
end;

begin                      //Servido Email     Correo Origen   //Clave Origen    Correo Destino          Asunto    Mensaje

//    EnviarEmail(Date,Time, 'smtp.eresmas.com','[email protected]','xxx', '[email protected]','Evido de email','Enviando email via programa��o utilizando os recursos da poderosa paleta indy',fichero);
    EnviarEmail(Date,Time, 'smtp.eresmas.com','[email protected]','xxx', Edit1.text,Edit2.Text,Memo1.Lines.Text,fichero);
end;

a esta le he añadido para adjuntar ficheros en mifile con esta única linea

Código Delphi [-]
    if Mifile<>'' then TIdAttachmentFile.Create(IdMessage.MessageParts,Mifile);

y me sale el error



que como veis es totalmente diferente, en cambio si lo mando sin fichero, funciona perfectamente, siempre y cuando no lo mande desde una cuenta Gmail, en la que me da el error antes comentado.

[[newtron]]

Hola.

Eso tiene toda la pinta de ser un problema de que el fichero por algún motivo no lo localiza. ¿Estás seguro de que el fichero está ahí? o igual esa ruta con acentos, espacios, etc no le mola al componente. Puedes probar a hacer una prueba con un fichero en una carpeta de nombre sencillo. p.e. C:\TEMP\PRUEBA.JPG

Saludos

[[José Luis Garcí]]

Hola Newtron, si el fichero es ese, lo cargo para estar seguro con un openDialog y e probado con un archivo simple en el raiz la ruta es c:\1.txt y ni así funciona

[[nlsgarcia]]

Club Delphi,

Empezado por José Luis Garcí

...podéis facilitarme el trozo de código que manda un email con un adjunto...

Revisa este código:

Código Delphi [-]
unit UfrmPrincipal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,

  IdIOHandler, IdIOHandlerSocket, IdSSLOpenSSL, IdMessage,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdMessageClient, IdSMTP;

type
  TfrmPrincipal = class(TForm)
    mCuerpoEmail: TMemo;
    edAsuntoEmail: TEdit;
    edServidorSmtp: TEdit;
    lbAsuntoEmail: TLabel;
    lbCuerpoEmail: TLabel;
    lbServidorSmtp: TLabel;
    edNombreUsuario: TEdit;
    btnEnviarEmail: TButton;
    lbNombreUsuario: TLabel;
    edEmailRemitente: TEdit;
    lbEmailRemitente: TLabel;
    edContrasenaUsuario: TEdit;
    edEmailDestinatario: TEdit;
    lbEmailDestinatario: TLabel;
    lbContrasenaUsuario: TLabel;
    IdSMTP: TIdSMTP;
    IdMessage: TIdMessage;
    IdSSLIOHandlerSocket: TIdSSLIOHandlerSocket;
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    procedure btnEnviarEmailClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  end;

var
  frmPrincipal: TfrmPrincipal;
  Adjunto : String;

implementation

{$R *.dfm}

procedure TfrmPrincipal.btnEnviarEmailClick(Sender: TObject);
begin

  with IdMessage do
  begin

     Body.Clear();
     Recipients.Clear();
     Sender.Address := edEmailRemitente.Text;
     Recipients.EMailAddresses := edEmailDestinatario.Text;
     Subject := edAsuntoEmail.Text;
     Body.AddStrings(mCuerpoEmail.Lines);

     if FileExists(Adjunto) then
        with TIdAttachment.Create(MessageParts,Adjunto) do
        begin
           ContentType := 'binary';
        end

  end;

  with IdSMTP do
  begin

     IOHandler := IdSSLIOHandlerSocket;
     IdSSLIOHandlerSocket.SSLOptions.Method := sslvSSLv23; // sslv : SSLv2, SSLv3, TLSv1, SSLv23.
     IdSSLIOHandlerSocket.SSLOptions.Mode := sslmUnassigned;
     IdSSLIOHandlerSocket.SSLOptions.VerifyMode := [];
     IdSSLIOHandlerSocket.SSLOptions.VerifyDepth := 0;
     Port := 465;
     Host := edServidorSmtp.Text;
     AuthenticationType := atLogin;
     Username := edNombreUsuario.Text;
     Password := edContrasenaUsuario.Text;

     try
        Connect(5000);
     except
        raise Exception.Create('Error de Conexión');
     end;

     btnEnviarEmail.Enabled := false;
     try
        Send(IdMessage);
        ShowMessage('Correo enviado con éxito');
     finally
        btnEnviarEmail.Enabled := true;
     end;

     if Connected then
        Disconnect();

  end;

end;

procedure TfrmPrincipal.Button1Click(Sender: TObject);
begin
   if openDialog1.Execute then
      adjunto := openDialog1.Filename;
end;

end.

El código anterior envía un email con su adjunto vía Gmail con Delphi 7 bajo Windows 7 Professional x32, Indy 9.00.10 y la librería ssl indy_openssl096 (libeay32.dll y ssleay32.dll).

La librería indy_openssl096 esta disponible en : indy_openssl096.zip

Espero sea útil

Nelson.

[[José Luis Garcí]]

hola buenos días y gracias por tu respuesta nlsgarcia (supongo que es Nelsón García) lo he seguido intentando, pero no hay manera en cuanto a las Dll, he bajado las siguientes

librery32dll y ssleay32.dll de la web http://indy.fulgan.com/SSL/, se supone que son para Windows 64 y mis indi son los 10.5.5, en cuanto a cargar las Dll, me he limitado a soltarlas en el directorio del programa y no he usado la tipica linea de código

stdcall; external 'xxx.dll';

para llamarlas, ya que no veo que se haga en ninguno de los ejemplos aportados, puede que hay ocurra mi error, pero si es asi, en que proceso las llamo y son las librerias correctas