Hola Buscadno otra cosa vi este pos, aca le mando la rutina que uso desde que tenia delphi 5 y ahora uso XE5 y siempre me anduvo:
Código Delphi
[-]
unit UCorreo;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, IdComponent, IdTCPServer, IdSMTPServer, IdBaseComponent,
IdMessage, IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP,
ExtCtrls, ComCtrls, ActnList, Buttons, IdExplicitTLSClientServerBase,
IdSMTPBase,IdAttachmentFile, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack,
IdSSL, IdSSLOpenSSL,
IdGlobal,
IdException, IdSSLOpenSSLHeaders,StrUtils, System.Actions;
type
TFormCorreo = class(TForm)
smtp: TIdSMTP;
Panel1: TPanel;
ProgressBar1: TProgressBar;
edDireccion: TEdit;
Label1: TLabel;
stBar: TStatusBar;
SpeedButton1: TSpeedButton;
ActionList1: TActionList;
Enviar: TAction;
Mail: TIdMessage;
chbConfirmacion: TCheckBox;
Label2: TLabel;
edCopia: TEdit;
edCuerpoMensaje: TEdit;
Label3: TLabel;
IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
procedure smtpStatus(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: String);
procedure smtpWork(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
procedure smtpConnected(Sender: TObject);
procedure smtpDisconnected(Sender: TObject);
procedure smtpWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
procedure EnviarExecute(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
private
FCorreoDestino,FCCopia,
FCorreoOrigen,
FNombreServidorCorreo,
FNombreCuentaCorreo,
FDestinatario,
FRemitente,
FAsunto,
FClave,
FAutenticacion,
FCuerpoCorreo,
FAdjunto:String;
FPuerto:Integer;
public
published
property CorreoDestino:String Read FCorreoDestino write FCorreoDestino;
property CCopia:String Read FCCopia write FCCopia;
property CorreoOrigen:String Read FCorreoOrigen Write FCorreoOrigen;
property NombreServidorCorreo:String Read FNombreServidorCorreo Write FNombreServidorCorreo;
property NombreCuentaCorreo:String Read FNombreCuentaCorreo Write FNombreCuentaCorreo;
property Remitente :String Read FRemitente write FRemitente;
property Destinatario :String Read FDestinatario write FDestinatario;
property Asunto:String Read FAsunto Write FAsunto;
property Autenticacion:String Read FAutenticacion Write FAutenticacion;
property CuerpoCorreo:String Read FCuerpoCorreo Write FCuerpoCorreo;
property Puerto:Integer Read FPuerto Write FPuerto;
property Adjunto:String Read FAdjunto Write FAdjunto;
property Clave:String Read FClave Write FClave;
end;
var
FormCorreo: TFormCorreo;
implementation
{$R *.DFM}
procedure TFormCorreo.smtpStatus(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: String);
begin
stBar.SimpleText:=AStatusText;
end;
procedure TFormCorreo.smtpWork(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
ProgressBar1.Position:=AWorkCount;
end;
procedure TFormCorreo.smtpConnected(Sender: TObject);
begin
stBar.SimpleText:='Conectando al servicio de correo...';
end;
procedure TFormCorreo.smtpDisconnected(Sender: TObject);
begin
stBar.SimpleText:='Mensaje enviado...';
end;
procedure TFormCorreo.smtpWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
ProgressBar1.Max:= smtp.MsgLineLength;
end;
procedure TFormCorreo.EnviarExecute(Sender: TObject);
var Aux:String;
begin
CorreoDestino:=Trim(edDireccion.Text);
if CorreoDestino='' Then
Raise Exception.Create('Falta correo destino...');
CCopia:=Trim(edCopia.Text);
with smtp do
begin
Port := Puerto;
Host := NombreServidorCorreo;
Username := NombreCuentaCorreo;
Password := Clave;
end;
with mail do
begin
Recipients.Add;
Recipients[0].Name := Destinatario;
Recipients[0].Address := Trim(CorreoDestino);
From.Name := Remitente;
From.Address := CorreoOrigen;
Subject := Asunto;
Body.Text := edCuerpoMensaje.Text;
if chbConfirmacion.Checked then
ReceiptRecipient.Address := CorreoOrigen;
if Trim(CCopia)<>'' then
begin
CCList.Add;
CCList[0].Address :=Trim(FCCopia);
end;
end;
Aux:=Copy(NombreServidorCorreo,pos('.',NombreServidorCorreo)+1,Length(NombreServidorCorreo));
Aux:=Copy(Aux,1,pos('.',Aux)-1);
if AnsiMatchStr(Aux,['gmail','hotmail'] ) then
begin
IdSSLIOHandlerSocketOpenSSL1.Port := puerto;
IdSSLIOHandlerSocketOpenSSL1.Host := NombreServidorCorreo;
IdSSLIOHandlerSocketOpenSSL1.SSLOptions.Method := sslvTLSv1;
IdSSLIOHandlerSocketOpenSSL1.SSLOptions.VerifyMode := [];
IdSSLIOHandlerSocketOpenSSL1.SSLOptions.VerifyDepth:= 0;
IdSSLIOHandlerSocketOpenSSL1.SSLOptions.Mode := sslmUnassigned;
smtp.IOHandler := IdSSLIOHandlerSocketOpenSSL1;
SMTP.UseTLS := utUseExplicitTLS;
end;
TIdAttachmentFile.create(mail.MessageParts, Adjunto);
try
smtp.Connect;
try
smtp.Send(mail);
except
on E: Exception do
ShowMessage(E.Message);
end;
except
ShowMessage('Coneccion a Servicio de correo interrumpida..');
if smtp.Connected then
smtp.Disconnect;
end;
Close;
ProgressBar1.Position:=0;
end;
procedure TFormCorreo.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
DeleteFile(Adjunto);
end;
procedure TFormCorreo.FormCreate(Sender: TObject);
begin
AutoSize:=True;
edDireccion.Text := FCorreoDestino;
edCopia.Text := FCCopia;
end;
procedure TFormCorreo.FormDestroy(Sender: TObject);
begin
FormCorreo:=nil;
end;
procedure TFormCorreo.FormShow(Sender: TObject);
begin
if NombreServidorCorreo='' then
begin
ShowMessage('Falta configurar el correo... ver en configuración local...');
Close;
end
else
begin
if Autenticacion='S' Then
smtp.AuthType:=satDefault
else
smtp.AuthType:=satNone;
edDireccion.Text:=CorreoDestino;
end;
edCopia.Text := Trim(CCopia);
edCuerpoMensaje.Text:= CuerpoCorreo;
end;
end.
en el form use dos componentes de las Indiy uno que dice TidMessage y otro TidSMPT
y desde las pantalla que uso para enviar hago esto en un boton o lo que Uds,.Quieran
Código Delphi
[-]
procedure TFormCtaCteVta.EnviarCorreoExecute(Sender: TObject);
begin
if CDSMovCC.IsEmpty Then
Raise Exception.Create(' No hay datos para mandar...');
if not DirectoryExists(ExtractFilePath(ParamStr(0))+'Archivos Temporales') then
CreateDir(ExtractFilePath(ParamStr(0))+'Archivos Temporales');
frCtaCte.PrintOptions.Printer:=PrNomListados;
frCtaCte.SelectPrinter;
frCtaCte.LoadFromFile(DMMain_2.PathReportesLst+'\CtaCteVta.fr3');
DMMain_2.QOpciones.Close;
frCtaCte.Variables['Mascara']:=''''+Mascara+'''';
frCtaCte.PrepareReport;
frxPDFExport1.ShowDialog:=False;
frxPDFExport1.FileName:=ExtractFilePath(ParamStr(0))+'Archivos Temporales\Resumen_'+edNombreCliente.Text+'.pdf';
frCtaCte.Export(frxPDFExport1);
frxPDFExport1.ShowDialog:=True;
if Not(Assigned(FormCorreo)) Then
FormCorreo:=TFormCorreo.Create(Application);
DMMain_2.QOpciones.CLose;
begin
DMBuscadores.QBuscaCorreo.Close;
DMBuscadores.QBuscaCorreo.ParamByName('Codigo').Value:=ceCliente.Text;
DMBuscadores.QBuscaCorreo.Open;
if Not(DMBuscadores.QBuscaCorreo.IsEmpty) Then
FormCorreo.CorreoDestino:=DMBuscadores.QBuscaCorreoCORREOELECTRONICO.Value
else
FormCorreo.CorreoDestino:='';
DMBuscadores.QBuscaCorreo.Close;
end;
FormCorreo.CorreoOrigen :=DirCorreo;
FormCorreo.Remitente :=Remitente;
FormCorreo.CCopia :='';
FormCorreo.edDireccion.Text :=FormCorreo.CorreoDestino;
FormCorreo.Destinatario :=edNombreCliente.Text;
FormCorreo.Puerto :=Puerto;
FormCorreo.NombreServidorCorreo:=NombreServidor;
FormCorreo.NombreCuentaCorreo :=NombreCuenta;
FormCorreo.Clave :=Clave;
FormCorreo.Autenticacion :=Autotenticacion;
FormCorreo.Asunto :='Resumen Cta.Cte - al '+ FormatDateTime('dd-mm-yy',hasta.Date);
FormCorreo.Adjunto :=ExtractFilePath(ParamStr(0))+'Archivos Temporales\Resumen_'+edNombreCliente.Text+'.pdf';
FormCorreo.Show;
end;
Yo Uso FastReport lo que hago es enviar a pdf y luego lo adjunto
Espero que sirva
Luis Roldan
Mar del Plata
Argentina