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
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; if TLS then Smtp.AutoTLS := True;
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';
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));
SMTPHost := 'smtp.googlemail.com';
SMTPPort := '465';
Login := 'username';
Password := '1234';
SSL := True;
TLS := False;
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.