Club Delphi  
    FTP   CCD     Enlaces   Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Internet
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Respuesta
 
Herramientas Desplegado
  #1  
Antiguo 30-04-2012
xomen xomen is offline
Miembro
 
Registrado: ago 2011
Ubicación: Jalisco, Mexico
Posts: 18
xomen Va por buen camino
Post Exportar a PDF y enviar documento por correo electrónico. Usando ppReport

Buen día. Esta vez tratare de explicar una forma para generar y enviar por correo electrónico un documento en PDF. (claro puede ser en cualquier otro formato que el componente ofrezca pero ahora lo hice con PDF). espero y sea de ayuda.

En este primer paso vamos a guardar el documento en PDF.
Código Delphi [-]
procedure TFormCatalogo.SpeedButtonExportarClick(
  Sender: TObject);
var
  IDMaestro : integer;
  Ruta : string;
  saveDialog : TSaveDialog;
  ArchivoPDF : String;
begin
  try
    Screen.Cursor := crHourGlass;
    //Creamos un saveDialog   y le damos las características del documento.
    //En mi caso voy a recuperar el identificador de la consulta para cargar el ppReport
    IDMaestro := ADOQueryCatalogo.FieldByName('ID').AsInteger;
   //Recupero los datos a imprimir
    DatosParaImpresion(IDMaestro);
    saveDialog := TSaveDialog.Create(self);
    saveDialog.Title := 'Guardar Archivo';
    saveDialog.Filter := 'PDF|*.pdf';
    saveDialog.DefaultExt := 'pdf';
    saveDialog.FilterIndex := 1;
    if saveDialog.Execute then
    begin
      //Obtenemos la ruta, aquí desdi poner una variable publica tipo string ya que a usare en otro procedimiento
      FRuta := saveDialog.FileName;
      saveDialog.Free;
      //Ahora con el ppReport lo configuramos para guardarlo en pdf 
      ppReport.ShowPrintDialog := False;
      ppReport.DeviceType := 'PDF';
      ppReport.PDFSettings.Author := 'Autor';
      ppReport.TextFileName := FRuta;
    end;
    ppReport.Print;
    EnviaCorreoElectronico;
    Screen.Cursor := crDefault;
  except
    on E:Exception do
    begin
      Screen.Cursor := crDefault;
       raise Exception.Create('Error el exportar a formato PDF:'+#13+ E.Message);
    end;
  end;
end;

Ahora para enviar el correo electrónico se necesitan dos componentes en la pestaña indy Clients necesitamos el objeto IdSMTP y en la pestaña Indy Misc necesitamos el objeto IdMessage. ahora vamos a configurar.

Código Delphi [-]
procedure TFormCatalogo.EnviaCorreoElectronico;
var
   NombreUsuario : string;
   Correo   : string;
   Password : string;
   Host : string;
   Puerto : string;
   Autenticacion : TAuthenticationType;
   Firma : string;
   Destinatario : string;
   SMTP: TIdSMTP;
   Mensaje: TIdMessage;
   Adjunto: TIdAttachment;
   IDMaestro : integer;

begin
  //Recuperamos datos para el llenado de los requisitos del e-mail.
  //En este caso recupere mis datos de un catalogo anteriormente capturado.
  with ADOQueryRecuperaConfigMail do
  begin
    Close;
    Parameters.ParamByName('IDUsuario').Value :=  FUsuarioLink;
    Open;
    NombreUsuario :=
      FieldByName('NOMBREDELUSUARIO').AsString;
    Correo :=
      FieldByName('CORREO').AsString;
    Password :=
      FieldByName('CONTRASEÑA').AsString;
    Host :=
      FieldByName('HOST').AsString;
    Puerto :=
      FieldByName('PUERTO').AsString;
    if FieldByName('AUTENTICACION').AsString = '' then
      Autenticacion := atLogin
    else
      Autenticacion :=
        FieldByName('AUTENTICACION').AsVariant;
    Firma :=
      FieldByName('FIRMA').AsString;
  end;
  //El destinatario lo extraigo de mi catalogo según lo requiera se va a ir configurando dinamicamente.
  Destinatario :=
    ADOQueryReporte.FieldByName('EMAIL').AsString;
  if Destinatario = '' then
    raise Exception.Create('No existe correo electronico del destinatario.');
  //Creamos el componente de conexión con el servidor
  SMTP := TIdSMTP.Create( nil );
  SMTP.Username := Correo;
  SMTP.Password := Password;
  SMTP.Host := Host;
  SMTP.Port := StrToInt(Puerto);
  SMTP.AuthenticationType := Autenticacion;
  //Creamos el contenido del mensaje
  Mensaje := TIdMessage.Create( nil );
  Mensaje.Clear;
  Mensaje.From.Name := NombreUsuario;
  Mensaje.From.Address := Correo;
  Mensaje.Subject := 'Asunto';
  Mensaje.Body.Text := 'Cuerpo del mensaje '+#13+#13+Firma;
  Mensaje.Recipients.Add;
  Mensaje.Recipients.Items[0].Address := Destinatario;
  //Si hay que meter un archivo adjunto lo creamos y lo asignamos al mensaje
  if not ADOQueryReporteDetalle.IsEmpty then
  begin
    //Recuerdan la variable FRuta declarada en la seccion publica? aquí la utilizamos para saber de donde vamos a adjuntar.
    Adjunto := TIdAttachment.Create(Mensaje.MessageParts,FRuta);
  end
  else
    Adjunto := nil;
  //Le mostramos al usuario como quedara el correo electronico.
  if MessageDlg('El correo electrónico que se enviara es el siguiente:'+#13+#13+
    'Usuario: '+NombreUsuario+#13+
    'Correo: '+Correo+#13+#13+
    'Destinatario: '+Destinatario+#13+#13+
    'Ruta de Archivo Adjunto:'+FRuta+#13+#13+
    'Asunto: Asunto'+#13+
    'Body: '+#13+
    'Cuerpo del mensaje '+#13+#13+Firma,
    mtConfirmation, mbYesNoCancel, 0) = mrYes then
  begin
    // Si es afirmativa la respuesta entonces conectamos con el servidor SMTP
    try
      SMTP.Connect;
    except
      raise Exception.Create('Error al conectar con el servidor.');
    end;
    //Si ha conectado enviamos el mensaje y desconectamos
    if SMTP.Connected then
    begin
      try
        SMTP.Send( Mensaje );
      except
        raise Exception.Create('Error al enviar el mensaje.');
      end;
      try
        SMTP.Disconnect;
      except
        raise Exception.Create('Error al desconectar del servidor.');
      end;
    end;
    //Liberamos los objetos creados
    if Adjunto <> nil then
    FreeAndNil( Adjunto );
    FreeAndNil( Mensaje );
    FreeAndNil( SMTP );
    Application.MessageBox('Mensaje enviado correctamente.',
      ' ',MB_ICONINFORMATION );
  end;
end;

Bueno de mi parte es todo espero les sea de ayuda. Muchas gracias por leerme. Se aceptan criticas y mejoras al código. Muchas gracias
Responder Con Cita
  #2  
Antiguo 30-04-2012
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador gruñón
 
Registrado: sep 2004
Ubicación: Planeta Agua
Posts: 23.118
Casimiro Notevi Va camino a la fama
Gracias por el aporte
__________________
/* Saludos
*/
La otra guía de estilo | Búsquedas avanzadas | Etiquetas para código

$ sudo mv system > /dev/null

Responder Con Cita
  #3  
Antiguo 30-04-2012
xomen xomen is offline
Miembro
 
Registrado: ago 2011
Ubicación: Jalisco, Mexico
Posts: 18
xomen Va por buen camino
Cita:
Empezado por Casimiro Notevi Ver Mensaje
Gracias por el aporte
De nada amigo.
Responder Con Cita
  #4  
Antiguo 30-04-2012
Avatar de AzidRain
[AzidRain] AzidRain is offline
Miembro Premium
 
Registrado: sep 2005
Ubicación: Córdoba, Veracruz, México
Posts: 2.843
AzidRain Va por buen camino
Ya que andamos de ofrecidos, les dejo esta función con su explicación:
Código Delphi [-]
{Esta función analiza la extensión del archivo pasado como parámetro y nos
devuelte un MIMETYpe adecuado para enviar por mail como adjunto si la extension
no es reconocida se manda como genérico.
}
function GetMIMEType(afilename: string): String;
var Ext: string;
begin
  Ext := UpperCase(ExtractFileExt(afilename));

  if Ext='.PDF' then
   Result := 'application/pdf'
   else
     if Ext='.ZIP' then
       Result := 'application/zip'
     else
        if Ext='.MP3' then
         Result := 'audio/mpeg'
       else
       if (Ext='.JPG') OR (Ext='.JPEG') then
         Result := 'image/jpeg'
       else
         if (Ext='.XLS')  then
           Result := 'application/vnd.ms-excel'
         else
          if (Ext='.XLSX') then
            Result := 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet'
         else
           if (Ext='.DOC')  then
            Result := 'application/msword'
           else
           if (Ext='.DOCX')  then
            Result := 'application/vnd.openxmlformats-officedocument.wordprocessingml.document'
           else
            Result := 'application/octet-stream';


end;

En donde la usamos:

Código Delphi [-]
  With TIdAttachmentFile.Create(Mensaje.MessageParts,adjunto) do
                 ContentType := GetMIMEType(adjunto)

// Mensaje es un objeto de la case TIdMessage, adjunto es una variable que contiene el nombre del archivo con extensión que se desea enviar

Es recomendable fijar la propiedad ContentType debido a que algunos servicios de correo, sobre todo los de empresas, no reconocen las extensiones por defecto y en algunos casos sencillamente el mensaje aparecerá como si no trajera adjunto. Se pueden añadir mas tipos a la función que puse, los tipos los pueden obtener de aquí o bien aqui que también viene completo. Atención a que no hay que meter todos los tipos de manera forzada, solo los que consideren que su aplicación va a manejar.
__________________
AKA "El animalito" ||Cordobés a mucha honra||

Última edición por AzidRain fecha: 30-04-2012 a las 23:28:41.
Responder Con Cita
  #5  
Antiguo 30-04-2012
xomen xomen is offline
Miembro
 
Registrado: ago 2011
Ubicación: Jalisco, Mexico
Posts: 18
xomen Va por buen camino
Cita:
Empezado por AzidRain Ver Mensaje
Ya que andamos de ofrecidos, les dejo esta función con su explicación:
Justo lo que necesitaba para mi siguiente proyecto muchas gracias AzidRain. Voy a jugar con ese código un rato después publico los resultados. Saludos.
Responder Con Cita
Respuesta


Herramientas
Desplegado

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
enviar correo electronico desde delphi morfeo21 Servers 3 06-05-2010 00:21:57
Enviar un correo electronico desde delphi 7 carlos gonzalez Varios 3 07-06-2008 19:04:29
Enviar correo electrónico desde delphi luisneria Internet 3 02-03-2007 19:07:27
Enviar correo electronico mediante MAPI adebonis API de Windows 3 12-10-2006 09:38:25
Fallo al enviar correo electrónico nuppy Internet 1 05-02-2006 00:54:34


La franja horaria es GMT +2. Ahora son las 22:21:16.


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