Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > OOP
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 02-08-2014
Efren2006 Efren2006 is offline
Miembro
 
Registrado: feb 2006
Posts: 172
Poder: 19
Efren2006 Va por buen camino
Envió de Correo desde mi aplicación con Adjunto

Saludos

Amigos Necesito enviar desde mi Aplicación Correos electrónicos de mis reportes, es decir con adjunto, ya he buscado en el FORO todas los Link y ejemplos que colocaron, y la verdad NINGUNO me ha servidor, Todos me dan algún tipo de error, he probado con varios tipos de cuenta (Gmail, Hotmail),, pero nada.. Sera este teme algo muy complicado ??? Existe algún ejemplo por allí que funcione del cual yo pueda revisar como ejemplo... y adaptarlo....

Nota: Uso Delphi 2009

Pleases
Responder Con Cita
  #2  
Antiguo 03-08-2014
Avatar de ozsWizzard
ozsWizzard ozsWizzard is offline
Miembro
 
Registrado: may 2004
Ubicación: Murcia
Posts: 190
Poder: 20
ozsWizzard Va por buen camino
Ejemplo Gmail (Está escrito casi de cabeza mirando un programa mío, creo que está bien y debería funcionar:

Código Delphi [-]
procedure Enviar;
var
   SMTP: TIdSMTP;
   Mensaje: TIdMessage;
   i: Integer;
   lMens: String;
   gmailssl: TIdSSLIOHandlerSocketOpenSSL;
   Para: TIdEmailAddressList;
begin
   gmailIssl := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
   
   SMTP := nil;
   SMTP := TIdSMTP.Create(nil);
   try   
      gmailssl.Destination = 'smtp.gmail.com:587';
      gmailssl.Host = 'smtp.gmail.com';
      gmailssl.Port = 587;

      SMTP.Username  := 'usuario@gmail.com';
      SMTP.Password  := 'Clave';
      SMTP.Host      := 'smtp.gmail.com';
      SMTP.Port      := '587'; //'465 si es con SSL. Aunque esto no lo tengo claro del todo.
      SMTP.IOHandler := gmailSSL;
      SMTP.UseTLS    := utUseExplicitTLS;
      
      Mensaje := TIdMessage.Create(nil);
      Para := TIdEmailAddressList.Create(nil);
      Cuerpo := TStringList.Create;
      try
         Mensaje.Clear;
         
         Mensaje.From.Name    := Desde;
         Mensaje.From.Address := Login;
         
         Para.Add.Address = 'correo@correo.com'. //Es una lista
         Mensaje.Recipients := Para; 
         Mensaje.Subject    := 'Asunto';
         Correo.Cuerpo.Add('Cuerpo'); //Es una lista
         Mensaje.Body.Text  := Cuerpo.Text;
         
        //Aquí es donde va lo de los adjuntos 
        TIdAttachmentFile.Create(Mensaje.MessageParts, 'direccionFichero'); //Es una lista         
         
         Mensaje.Priority := mpHighest;
            try
               lMens := 'Error al conectar con el servidor:';
               SMTP.Connect;
               // Si ha conectado enviamos el mensaje y desconectamos
               if SMTP.Connected then
               begin
                  lMens := 'Error al enviar el mensaje:';
                  SMTP.Send(Mensaje);

                  lMens := 'Error al desconectar del servidor:';
                  SMTP.Disconnect;
               end;
               //Sacar mensaje de correcto
            except
               on E:Exception do
               begin
                  lMens := lMens + ' ' + E.Message;
                  //Sacar mensaje de error
               end;
            end;

         finally
            //Este error no debería de darse, se crear un count más de los que hay
            //cuando falla el envío
            try
               for i := 0 to Mensaje.MessageParts.Count - 1 do
                  TIdAttachmentFile(Mensaje.MessageParts[i]).Free;
            except
            end;
            Mensaje.Free;
            Para.Free;
            Cuerpo.Free;
      end;
   finally
      if Assigned(SMTP)       then SMTP.Free;
      if Assigned(gmailIssl)  then SMTP.Free;
   end;

Donde pone "//Es una lista" es que puedes poner esa línea dentro de un bucle y rellenar varios datos.
__________________
La Madurez se llama...
~~~Gaia~~~
Responder Con Cita
  #3  
Antiguo 03-08-2014
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.039
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
Cita:
Empezado por Efren2006 Ver Mensaje
NINGUNO me ha servidor, Todos me dan algún tipo de error
¿El error no será que no tienes conexión a internet?
Responder Con Cita
  #4  
Antiguo 04-08-2014
Efren2006 Efren2006 is offline
Miembro
 
Registrado: feb 2006
Posts: 172
Poder: 19
Efren2006 Va por buen camino
Gracias por tan pronta Respuesta..

Efectivamente ya logre con esta Rutina Enviar el correo, por cierto con el puerto 465.. El problema que tengo es que cuando reviso el correo NO me muestra el Adjunto,,, OJO cuando veo el correo a modo lista dice que tiene adjunto, pero al abrirlo NO lo muestra,,, Hice la prueba de Reenviando el correo y me muestra un Archivo ATT00001 y no deja abrirlo (este caso es enviando el correo a una Cuenta Hotmail) Tambien hice la prueba con un correo Gmail y si lo muestra pero el nombre me dice NONAME y no reconoce automáticamente el tipo de archivo que estoy enviando..

En mi Caso necesito enviar un correo con un Archivo PDF adjunto..

Saludos

Última edición por Efren2006 fecha: 04-08-2014 a las 03:49:21.
Responder Con Cita
  #5  
Antiguo 04-08-2014
Efren2006 Efren2006 is offline
Miembro
 
Registrado: feb 2006
Posts: 172
Poder: 19
Efren2006 Va por buen camino
Adjunto Mi Programa:

Código Delphi [-]
procedure TDataImpresion.EnvioCorreo(Sender: TObject);
Var
  ArcAdjunto,NomArchivo:string;
  Adjunto:TIdAttachmentFile;
begin
   with SMTP do
   begin
     AuthType := satDefault;
     Port := StrToInt(BioPuerto.Text);
     Host := BioHost.Text;
     Username := BioNomUsuario.Text;
     Password := BioNomClave.Text;
     UseTLS := utUseImplicitTLS;
     IOHandler:=Socket;
   end;
   with Socket do
   begin
     DefaultPort:=0;
     Host:=BioHost.Text;
     Destination:=BioHost.Text+':'+BioPuerto.Text;
     Port:=StrToInt(BioPuerto.Text);
     SSLOptions.Method:=sslvSSLv3;
     SSLOptions.Mode:=sslmUnassigned;
     SSLOptions.VerifyDepth:=0;
   end;
   Mensaje.Clear;
   with Mensaje do
   begin
     Recipients.Clear;
     Recipients.Add;
     Recipients[0].Name := 'EFREN AGUILAR';
     Recipients[0].Address := BioPara.Text;
     From.Name := Global.Cia.Nombre;
     From.Address := BioNomUsuario.Text;
     Subject := BioAsunto.Text;
     Body.Clear;
     Body.Text :=BioTexto.Lines.Text;
     IsEncoded :=False;
     ContentType := 'multipart/mixed';
     MessageParts.Clear;
     Priority := mpHighest;
   end;
   // adjuntamos el archivo
   ArcAdjunto:=ArchivoAdjunto;
   if (ArcAdjunto<>'') and (FileExists(ArcAdjunto)) then
      begin
      NomArchivo:=ExtractFileName(ArcAdjunto);
      Adjunto:=TIdAttachmentFile.Create(Mensaje.MessageParts, ArcAdjunto);
      Adjunto.ContentType:='application/pdf';
      Adjunto. FileName:=NomArchivo;
      Adjunto.ContentID:=NomArchivo;
      Adjunto.DisplayName:=NomArchivo;
      end
    else
      begin
      Adjunto := nil;
      end;
   try
     Smtp.Connect;
     try
        smtp.Send(Mensaje);
        ShowMessage('El Correo Fue Enviado Satisfactoriamente...');
     except
        on E: Exception do ShowMessage(E.Message);
     end;
   finally
     if smtp.Connected then
        smtp.Disconnect;
     if Adjunto <> nil then
        FreeAndNil( Adjunto );
   end;
end;
Responder Con Cita
  #6  
Antiguo 04-08-2014
JuanHC JuanHC is offline
Miembro
 
Registrado: sep 2006
Posts: 25
Poder: 0
JuanHC Va por buen camino
Hola,

Por si os sirve de algo. Adjunto el codigo que yo utilizo y funciona bien enviando adjuntos.

Me pasaba algo parecido, si el mail no tenia adjuntos, se veia bien, pero si tenia adjunto, lo indicaba pero no se veia.
El cambio que hice fue:

NO tiene adjunto: compMensaje.ContentType := 'text/html' ;
SI tiene adjunto: compMensaje.ContentType := 'multipart/mixed' ;

y me funciona bien.



function TFmails.enviarEmail(servidor : string; usuario : string; contrasena : string;
puerto : integer; asunto : string; mensaje : TStringList; conAutenticacion : boolean;
emisor : string; nombreEmisor : string; destinatario : string; cc : string) : boolean;
var
compMensaje : TIdMessage;
envioCorrecto : boolean;
var Linea: string ;
var b, FlagAdjuntos: Integer;
begin
if conAutenticacion then
begin
compEnvioEmail.AuthType := satDefault;
compEnvioEmail.Username := usuario;
compEnvioEmail.Password := contrasena;
end
else
compEnvioEmail.AuthType := satNone;

compMensaje := TIdMessage.Create (nil);
compMensaje.From.Address := emisor;
compMensaje.From.Name := nombreEmisor;
compMensaje.Recipients.Add.Address := destinatario;
if Trim(cc) <> '' then compMensaje.CCList.Add.Address := cc;
compMensaje.ContentType := 'text/html' ;
compMensaje.CharSet := 'iso-8859-1' ;
compMensaje.Subject := asunto;
compMensaje.ReplyTo.Add.Address := emisor;


FlagAdjuntos := 0 ;
ListaAdjuntos := Trim(ListaAdjuntos) + ';';
if Length(ListaAdjuntos) > 1 then
begin
i := 1 ;
while ( i <= 10 ) do
begin
nFicheros[i] := '' ;
ListaAdjuntos := Trim(ListaAdjuntos);
Largo := Length(ListaAdjuntos) ;
Posicion := Pos(';', ListaAdjuntos);

if Posicion > 0 then
begin
FlagAdjuntos := 1 ;
nFicheros[i] := Copy(ListaAdjuntos, 1,Posicion-1);
ListaAdjuntos := Copy(ListaAdjuntos, Posicion+1, Largo+Posicion) ;
TIdAttachmentFile.Create(compMensaje.MessageParts, Trim(nFicheros[i]));
end;
i := i + 1;
end;
end;

if FlagAdjuntos = 1 then compMensaje.ContentType := 'multipart/mixed' ;

for b:=0 to mensaje.count -1 do
begin
if FlagAdjuntos = 1 then Linea := mensaje[b] else Linea := mensaje[b] + '<BR>';
compMensaje.Body.Add(Linea);
end;


envioCorrecto := true;
try
compEnvioEmail.Send(compMensaje);
except
envioCorrecto := false;
end;

TIdAttachment.NewInstance.Free ;
compMensaje.Free;
enviarEmail := envioCorrecto;
end;
Responder Con Cita
  #7  
Antiguo 04-08-2014
Efren2006 Efren2006 is offline
Miembro
 
Registrado: feb 2006
Posts: 172
Poder: 19
Efren2006 Va por buen camino
Cita:
Empezado por JuanHC Ver Mensaje
Hola,

Por si os sirve de algo. Adjunto el codigo que yo utilizo y funciona bien enviando adjuntos.

Me pasaba algo parecido, si el mail no tenia adjuntos, se veia bien, pero si tenia adjunto, lo indicaba pero no se veia.
El cambio que hice fue:

NO tiene adjunto: compMensaje.ContentType := 'text/html' ;
SI tiene adjunto: compMensaje.ContentType := 'multipart/mixed' ;

y me funciona bien.



function TFmails.enviarEmail(servidor : string; usuario : string; contrasena : string;
puerto : integer; asunto : string; mensaje : TStringList; conAutenticacion : boolean;
emisor : string; nombreEmisor : string; destinatario : string; cc : string) : boolean;
var
compMensaje : TIdMessage;
envioCorrecto : boolean;
var Linea: string ;
var b, FlagAdjuntos: Integer;
begin
if conAutenticacion then
begin
compEnvioEmail.AuthType := satDefault;
compEnvioEmail.Username := usuario;
compEnvioEmail.Password := contrasena;
end
else
compEnvioEmail.AuthType := satNone;

compMensaje := TIdMessage.Create (nil);
compMensaje.From.Address := emisor;
compMensaje.From.Name := nombreEmisor;
compMensaje.Recipients.Add.Address := destinatario;
if Trim(cc) <> '' then compMensaje.CCList.Add.Address := cc;
compMensaje.ContentType := 'text/html' ;
compMensaje.CharSet := 'iso-8859-1' ;
compMensaje.Subject := asunto;
compMensaje.ReplyTo.Add.Address := emisor;


FlagAdjuntos := 0 ;
ListaAdjuntos := Trim(ListaAdjuntos) + ';';
if Length(ListaAdjuntos) > 1 then
begin
i := 1 ;
while ( i <= 10 ) do
begin
nFicheros[i] := '' ;
ListaAdjuntos := Trim(ListaAdjuntos);
Largo := Length(ListaAdjuntos) ;
Posicion := Pos(';', ListaAdjuntos);

if Posicion > 0 then
begin
FlagAdjuntos := 1 ;
nFicheros[i] := Copy(ListaAdjuntos, 1,Posicion-1);
ListaAdjuntos := Copy(ListaAdjuntos, Posicion+1, Largo+Posicion) ;
TIdAttachmentFile.Create(compMensaje.MessageParts, Trim(nFicheros[i]));
end;
i := i + 1;
end;
end;

if FlagAdjuntos = 1 then compMensaje.ContentType := 'multipart/mixed' ;

for b:=0 to mensaje.count -1 do
begin
if FlagAdjuntos = 1 then Linea := mensaje[b] else Linea := mensaje[b] + '<BR>';
compMensaje.Body.Add(Linea);
end;


envioCorrecto := true;
try
compEnvioEmail.Send(compMensaje);
except
envioCorrecto := false;
end;

TIdAttachment.NewInstance.Free ;
compMensaje.Free;
enviarEmail := envioCorrecto;
end;

Amigo Juan Gracias por tu respuesta, pero como veras en el post anterior (Programa Fuente) ya coloque el Valor de la Propiedad:
Código Delphi [-]
ContentType := 'multipart/mixed'
.. y sigo con el mismo problema.

Saludos
Responder Con Cita
  #8  
Antiguo 04-08-2014
JuanHC JuanHC is offline
Miembro
 
Registrado: sep 2006
Posts: 25
Poder: 0
JuanHC Va por buen camino
No sera que cuando adjuntas el archivo cambias el valor y pones esto?
Adjunto.ContentType:='application/pdf';

ya por probar, podrias quitar esta linea a ver que pasa.

suerte!
Responder Con Cita
  #9  
Antiguo 04-08-2014
Efren2006 Efren2006 is offline
Miembro
 
Registrado: feb 2006
Posts: 172
Poder: 19
Efren2006 Va por buen camino
Cita:
Empezado por JuanHC Ver Mensaje
No sera que cuando adjuntas el archivo cambias el valor y pones esto?
Adjunto.ContentType:='application/pdf';

ya por probar, podrias quitar esta linea a ver que pasa.

suerte!

Descubrí que de esta forma si envió al correo a un GMAIL por lo menos me reconoce que el archivo es PDF... pero sigue sin aparecer el nombre,, en una Cuenta HOTMAIL, nada de Nada...

He probado también como me indicas y NADA cuando veo el script del correo en los navegadores me lo reconoce como
Código:
application/octet-stream
...
Responder Con Cita
  #10  
Antiguo 18-04-2023
AzqLaaClub AzqLaaClub is offline
Registrado
 
Registrado: abr 2023
Posts: 4
Poder: 0
AzqLaaClub Va por buen camino
Exclamation NAda

Código Delphi [-]
<div style="margin:20px; margin-top:5px; ">
  <div class="smallfont" style="margin-bottom:2px">Cita:div>
  
class="alt2" style="border:1px inset"> <div> Empezado por ozsWizzard class="inlineimg" src="http://www.clubdelphi.com/foros/images/botones/viewpost.gif" border="0" alt="Ver Mensaje" /> div> <div style="font-style:italic">Ejemplo Gmail (Está escrito casi de cabeza mirando un programa mío, creo que está bien y debería funcionar:
class='delphi'><div class="frame_codigo_delphi">Código Delphi [-]<div id="delphi_div_66299d1642296" class="texto_codigo_delphi">
class='keyword'>procedure Enviar;
class='keyword'>var
   SMTP: TIdSMTP;
   Mensaje: TIdMessage;
   i: Integer;
   lMens: class='keyword'>String;
   gmailssl: TIdSSLIOHandlerSocketOpenSSL;
   Para: TIdEmailAddressList;
class='keyword'>begin
   gmailIssl := TIdSSLIOHandlerSocketOpenSSL.Create(class='keyword'>nil);
   
   SMTP := class='keyword'>nil;
   SMTP := TIdSMTP.Create(class='keyword'>nil);
   class='keyword'>try   
      gmailssl.Destination = class='quote'>'smtp.gmail.com:587';
      gmailssl.Host = class='quote'>'smtp.gmail.com';
      gmailssl.Port = 587;

      SMTP.Username  := class='quote'>'usuario@gmail.com';
      SMTP.Password  := class='quote'>'Clave';
      SMTP.Host      := class='quote'>'smtp.gmail.com';
      SMTP.Port      := class='quote'>'587'; class='comment'>//'465 si es con SSL. Aunque esto no lo tengo claro del todo.
      SMTP.IOHandler := gmailSSL;
      SMTP.UseTLS    := utUseExplicitTLS;
      
      Mensaje := TIdMessage.Create(class='keyword'>nil);
      Para := TIdEmailAddressList.Create(class='keyword'>nil);
      Cuerpo := TStringList.Create;
      class='keyword'>try
         Mensaje.Clear;
         
         Mensaje.From.Name    := Desde;
         Mensaje.From.Address := Login;
         
         Para.Add.Address = class='quote'>'correo@correo.com'. class='comment'>//Es una lista
         Mensaje.Recipients := Para; 
         Mensaje.Subject    := class='quote'>'Asunto';
         Correo.Cuerpo.Add(class='quote'>'Cuerpo'); class='comment'>//Es una lista
         Mensaje.Body.Text  := Cuerpo.Text;
         
        class='comment'>//Aquí es donde va lo de los adjuntos 
        TIdAttachmentFile.Create(Mensaje.MessageParts, class='quote'>'direccionFichero'); class='comment'>//Es una lista         
         
         Mensaje.Priority := mpHighest;
            class='keyword'>try
               lMens := class='quote'>'Error al conectar con el servidor:';
               SMTP.Connect;
               class='comment'>// Si ha conectado enviamos el mensaje y desconectamos
               class='keyword'>if SMTP.Connected class='keyword'>then
               class='keyword'>begin
                  lMens := class='quote'>'Error al enviar el mensaje:';
                  SMTP.Send(Mensaje);

                  lMens := class='quote'>'Error al desconectar del servidor:';
                  SMTP.Disconnect;
               class='keyword'>end;
               class='comment'>//Sacar mensaje de correcto
            class='keyword'>except
               class='keyword'>on E:Exception class='keyword'>do
               class='keyword'>begin
                  lMens := lMens + class='quote'>' ' + E.class='keyword'>Message;
                  class='comment'>//Sacar mensaje de error
               class='keyword'>end;
            class='keyword'>end;

         class='keyword'>finally
            class='comment'>//Este error no debería de darse, se crear un count más de los que hay
            class='comment'>//cuando falla el envío
            class='keyword'>try
               class='keyword'>for i := 0 class='keyword'>to Mensaje.MessageParts.Count - 1 class='keyword'>do
                  TIdAttachmentFile(Mensaje.MessageParts[i]).Free;
            class='keyword'>except
            class='keyword'>end;
            Mensaje.Free;
            Para.Free;
            Cuerpo.Free;
      class='keyword'>end;
   class='keyword'>finally
      class='keyword'>if Assigned(SMTP)       class='keyword'>then SMTP.Free;
      class='keyword'>if Assigned(gmailIssl)  class='keyword'>then SMTP.Free;
   class='keyword'>end;
div>div>
Donde pone "//Es una lista" es que puedes poner esa línea dentro de un bucle y rellenar varios datos.
div>

Este ejemplo, me da este error: Invalid Pointer Operation. Como lo puedo corregir?
Responder Con Cita
  #11  
Antiguo 18-04-2023
Avatar de Neftali [Germán.Estévez]
Neftali [Germán.Estévez] Neftali [Germán.Estévez] is offline
[becario]
 
Registrado: jul 2004
Ubicación: Barcelona - España
Posts: 18.272
Poder: 10
Neftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en bruto
Cita:
Empezado por AzqLaaClub Ver Mensaje
Este ejemplo, me da este error: Invalid Pointer Operation. Como lo puedo corregir?
Estás poniendo mensajes sobre los mismo en distintos foros. Si lo haces pueden acabar borrados y tú baneado.

Revisa la guia de estilo de los foros.



Crea un nuevo hilo y explica bien tu problema.
También puedes editar el mensaje anterior y corregirlo.
__________________
Germán Estévez => Web/Blog
Guía de estilo, Guía alternativa
Utiliza TAG's en tus mensajes.
Contactar con el Clubdelphi

P.D: Más tiempo dedicado a la pregunta=Mejores respuestas.
Responder Con Cita
  #12  
Antiguo 18-04-2023
AzqLaaClub AzqLaaClub is offline
Registrado
 
Registrado: abr 2023
Posts: 4
Poder: 0
AzqLaaClub Va por buen camino
Solucionado - Solucion

Usando el ejemplo de Envio de correo con Synapse pude enviar correo pude enviar.

Uso Win 10 64 bits
Delphi 10 32bits EMBARCADERO RAD Studio.

La solucion es q en la cuenta gmail q vas a usar debes dale permiso al programa q vas a
usar como gestor.

Aqui les dejo un enlace de como se hace la configuracion de la cuenta gmail.
https://www.ovalsoft.es/configura-gm...s-de-terceros/

En concreto el codigo completo.


Código Delphi [-]
unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,IdHTTP, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, ShellApi, IdMessage, IdExplicitTLSClientServerBase,
  IdMessageClient, IdSMTPBase, IdSMTP, IdIOHandler, IdIOHandlerSocket,
  IdIOHandlerStack, Mapi,IdSSL, IdSSLOpenSSL, IdServerIOHandler,
   blcksock, smtpsend, pop3send, ssl_openssl, MIMEPart, MIMEMess, IdEmailAddress;


type
  TForm1 = class(TForm)
    Button1: TButton;
    sen: TIdHTTP;
    Edit1: TEdit;
    Memo1: TMemo;
    Button2: TButton;
    Button3: TButton;
    IdSMTP1: TIdSMTP;
    IdMessage1: TIdMessage;
    Button4: TButton;
    IdServerIOHandlerSSLOpenSSL1: TIdServerIOHandlerSSLOpenSSL;
    IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
    Button5: TButton;
    Edit2: TEdit;
    Button6: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
//    procedure IdSSLIOHandlerSocketOpenSSL1GetPassword(var Password: AnsiString);
  private
    { Private declarations }
  public
 
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


function SendMail(const MailFrom, MailTo, Subject : String;
                  MsgText : TStrings;
                  SMTPHost, SMTPPort : String;
                  Login, Password : String;
                  FileName : String;
                  SSL : Boolean;
                  TLS : Boolean
                 ) : Boolean;

var
   Msg : TMimeMess;
   MimePart : TMimepart;
   Smtp: TSMTPSend;
   MsgErr : String;

begin

   if MailFrom = EmptyStr then
   begin
      MsgErr := 'MailFrom No Puede Estar en Blanco';
      MessageDlg(MsgErr,mtError,[mbOK],0);
      Result := False;
      Exit;
   end;

   if MailTo = EmptyStr then
   begin
      MsgErr := 'MailTo No Puede Estar en Blanco';
      MessageDlg(MsgErr,mtError,[mbOK],0);
      Result := False;
      Exit;
   end;

   if Subject = EmptyStr then
   begin
      MsgErr := 'Subject No Puede Estar en Blanco';
      MessageDlg(MsgErr,mtError,[mbOK],0);
      Result := False;
      Exit;
   end;

   if MsgText.Count = 0 then
   begin
      MsgErr := 'MsgText No Puede Estar en Blanco';
      MessageDlg(MsgErr,mtError,[mbOK],0);
      Result := False;
      Exit;
   end;

   if SMTPHost = EmptyStr then
   begin
      MsgErr := 'SMTPHost No Puede Estar en Blanco';
      MessageDlg(MsgErr,mtError,[mbOK],0);
      Result := False;
      Exit;
   end;

   if SMTPPort = EmptyStr then
   begin
      MsgErr := 'SMTPPort No Puede Estar en Blanco';
      MessageDlg(MsgErr,mtError,[mbOK],0);
      Result := False;
      Exit;
   end;

   if Login = EmptyStr then
   begin
      MsgErr := 'Login No Puede Estar en Blanco';
      MessageDlg(MsgErr,mtError,[mbOK],0);
      Result := False;
      Exit;
   end;

   if Password = EmptyStr then
   begin
      MsgErr := 'Password No Puede Estar en Blanco';
      MessageDlg(MsgErr,mtError,[mbOK],0);
      Result := False;
      Exit;
   end;

   Msg := TMimeMess.Create;
   Smtp := TSMTPSend.Create;

   Msg.Header.Date := Now;
   Msg.Header.From := MailFrom;
   Msg.Header.ToList.Clear;
   Msg.Header.ToList.add(MailTo);
   Msg.Header.CcList.Clear;
   Msg.Header.Subject := Subject;

   MIMEPart := Msg.AddPartMultipart('mixed', nil);
   Msg.AddPartText(MsgText, MIMEPart);
   if (FileName <> EmptyStr) and FileExists(FileName) then
      Msg.AddPartBinaryFromFile(FileName, MIMEPart);

   Msg.EncodeMessage;

   Smtp.UserName := Login;
   Smtp.Password := Password;
   Smtp.TargetHost := SmtpHost;
   Smtp.TargetPort := SmtpPort;

   if SSL then Smtp.FullSSL := True;  // Gmail
   if TLS then Smtp.AutoTLS := True;  // Hotmail

   if not smtp.Login() then
   begin
      MsgErr := 'Error Logineee: ' + smtp.EnhCodeString;
      MessageDlg(MsgErr,mtError,[mbOK],0);
      Result := False;
      Exit;
   end;

   if not smtp.MailFrom(MailFrom, Length(MailFrom)) then
   begin
      MsgErr := 'Error MailFrom: ' + smtp.EnhCodeString;
      MessageDlg(MsgErr,mtError,[mbOK],0);
      Result := False;
      Exit;
   end;

   if not smtp.MailTo(MailTo) then
   begin
      MsgErr := 'Error MailTo: ' + smtp.EnhCodeString;
      MessageDlg(MsgErr,mtError,[mbOK],0);
      Result := False;
      Exit;
   end;

   if not smtp.MailData(Msg.Lines) then
   begin
      MsgErr := 'Error MailData: ' + smtp.EnhCodeString;
      MessageDlg(MsgErr,mtError,[mbOK],0);
      Result := False;
      Exit;
   end;

   if not smtp.Logout() then
   begin
      MsgErr := 'Error Logout: ' + smtp.EnhCodeString;
      MessageDlg(MsgErr,mtError,[mbOK],0);
      Result := False;
      Exit;
   end;

   Msg.Free;
   Smtp.Free;

   Result := True;

end;

procedure TForm1.Button4Click(Sender: TObject);
var
   MailFrom, MailTo, Subject : String;
   MsgText : TStrings;
   SMTPHost, SMTPPort : String;
   Login, Password : String;
   FileName : String;
   FileOnDisk : String;
   SSL, TLS : Boolean;
   i : Integer;


begin
   // Configuración de Gmail
   SMTPHost := 'smtp.gmail.com';
   SMTPPort := '465';
   Login := 'micuentadegmail@gmail.com';
   Password := edit1.Text;
   SSL := True;
   TLS := False;

  MsgText := TStringList.Create;

   MailFrom := 'micuentadegmail@gmail.com';
   // MailFrom := 'username@hotmail.com';
   MailTo := 'xxxxxxx@xxxx.com';
   Subject := 'Test de Email con Synapse: ' + DateTimeToStr(Now);

   for i := 1 to 10 do
      MsgText.Add('Línea de Texto de email ' + IntToStr(i));

   // Configuración de Hotmail
   {
   SMTPHost := 'smtp.live.com';
   SMTPPort := '587';
   Login := 'username@hotmail.com';
   Password := '1234';
   SSL := False;
   TLS := True;
   }

   //FileOnDisk := 'TestFile.txt';

  // FileName := IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) + FileOnDisk;

   if SendMail(MailFrom, MailTo, Subject, MsgText, SMTPHost, SMTPPort, Login,
               Password, FileName, SSL, TLS)
   then
      MessageDlg('Email Enviado Satisfactoriamente', mtInformation, [mbOK], 0)
   else
      MessageDlg('Error en Envío de Email', mtError, [mbOK], 0);

   MsgText.Free;

end;

end.
Gracias a todos por sus aportes.

El codigo es tomado de este sitio!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Última edición por Neftali [Germán.Estévez] fecha: 19-04-2023 a las 08:23:37. Razón: Añado TAGs y corrijo el código
Responder Con Cita
  #13  
Antiguo 18-04-2023
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.039
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
16. Si alguien te remite a la guía de estilo, no te molestes en leerla. Tú tienes cosas más importantes que hacer y a fin de cuentas, nadie la lee.
Responder Con Cita
  #14  
Antiguo 19-04-2023
Avatar de Neftali [Germán.Estévez]
Neftali [Germán.Estévez] Neftali [Germán.Estévez] is offline
[becario]
 
Registrado: jul 2004
Ubicación: Barcelona - España
Posts: 18.272
Poder: 10
Neftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en bruto
Cita:
Empezado por AzqLaaClub Ver Mensaje
Usando el ejemplo de Envio de correo con Synapse pude enviar correo pude enviar.
La solucion es q en la cuenta gmail q vas a usar debes dale permiso al programa q vas a
usar como gestor.

Gracias por publicar la solución.
Te recuerdo que cuando tengas un momento revises La guía de estilo y coloques tags cuando añadas código al mensaje.
He editado tu mensaje para ajustar el link y añadir los tags.
__________________
Germán Estévez => Web/Blog
Guía de estilo, Guía alternativa
Utiliza TAG's en tus mensajes.
Contactar con el Clubdelphi

P.D: Más tiempo dedicado a la pregunta=Mejores respuestas.
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Error en envío de mail con adjunto + Indy 10 agustibaldo Internet 8 23-01-2015 21:23:31
Envío de mail con un archivo adjunto. y_a_p Varios 16 08-06-2013 23:40:46
Problema con envio de correos con fichero adjunto apicito OOP 5 09-02-2012 13:29:36
Como envío correo desde Excel sin que me pida confirmación? luisdevis Varios 3 11-10-2006 23:18:18
Envio de correo desde una ISAPI anitra_cattivo Internet 1 22-10-2003 23:12:42


La franja horaria es GMT +2. Ahora son las 02:00:22.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi