Ver Mensaje Individual
  #19  
Antiguo 16-04-2018
Chaja Chaja is offline
No confirmado
 
Registrado: ago 2004
Ubicación: Mar del Plata
Posts: 238
Reputación: 0
Chaja Va por buen camino
envio de correo

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
    { Private declarations }
    FCorreoDestino,FCCopia,
    FCorreoOrigen,
    FNombreServidorCorreo,
    FNombreCuentaCorreo,
    FDestinatario,
    FRemitente,
    FAsunto,
    FClave,
    FAutenticacion,
    FCuerpoCorreo,
    FAdjunto:String;
    FPuerto:Integer;
  public
    { Public declarations }
  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
 // mail.Create(self);
//  CorreoDestino:=Trim(edDireccion.Text);
  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.Clear;
         CCList.Add;
         CCList[0].Address :=Trim(FCCopia);
       end;
//      SaveToFile('C:\Correo_'+Destinatario,tRUE);
   end;
   Aux:=Copy(NombreServidorCorreo,pos('.',NombreServidorCorreo)+1,Length(NombreServidorCorreo));
   Aux:=Copy(Aux,1,pos('.',Aux)-1);

 //  smtp.IOHandler:=nil;
   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
Responder Con Cita