Ver Mensaje Individual
  #15  
Antiguo 07-03-2014
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Reputación: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
José Luis Garcí,

Cita:
Empezado por José Luis Garcí
...Windows 7 64 bits y Delphi 2010...
El código sugerido en el Msg #9 fue probado solamente en Delphi 7 bajo Windows 7 Professional x32.

Cita:
Empezado por José Luis Garcí
...cuando funcione, si en vez de mandarlo por Gmail, lo manda por una cuenta diferente, el código seguiría valiendo o habría que cambiarlo todo...
Depende de las opciones de configuración de la otra cuenta de email, en general se debe hacer ajustes.

Revisa este código:
Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, blcksock, smtpsend, pop3send, ssl_openssl, MIMEPart, MIMEMess;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  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 Login: ' + 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.Button1Click(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

   MsgText := TStringList.Create;
   
   MailFrom := 'username@gmail.com';  
   // MailFrom := 'username@hotmail.com';
   MailTo := 'anotherusername@gmail.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 Gmail
   SMTPHost := 'smtp.googlemail.com';
   SMTPPort := '465';
   Login := 'username';
   Password := '1234';
   SSL := True;
   TLS := False;

   // 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.
El código anterior permite enviar un email y su attachment con Delphi 7 y Delphi 2010 bajo Windows 7 Professional x32 y la librería Synapse (2012-04-23 - Release no. 40). En todos los casos de prueba funciono correctamente con cuentas de Gmail y Hotmail sin requerir ninguna modificación la función de envío de email, es decir: La función sirve por igual para cuentas de tipo SSL, TLS y planas.

La librería Synapse esta disponible en : Synapse TCP/IP and Serial Library

Las características de la librería están detalladas en : Synapse's Features

Nota: La librería Synapse no funciona en Windows de 64 Bits, no requiere instalación de componentes y solo se debe hacer referencia a las unidades de la librería en el Library Path de Delphi 7 y Delphi 2010.

Pregunto : ¿Tienes la posibilidad de hacer el Desarrollo de la aplicación en Windows 7 de 32 Bits?.

Delphi 2010 compila los ejecutables en 32 Bits y si tienes la posibilidad de usar Windows 7 de 32 Bits podrías solventar el problema de los emails con el código sugerido anteriormente, de no ser así avísame y esta semana haré pruebas con Delphi 2010 y Indy bajo Windows 7 Professional x64.

Espero sea útil

Nelson.

Última edición por nlsgarcia fecha: 07-03-2014 a las 04:51:51.
Responder Con Cita