Ver Mensaje Individual
  #10  
Antiguo 28-08-2012
Avatar de AzidRain
[AzidRain] AzidRain is offline
Miembro Premium
 
Registrado: sep 2005
Ubicación: Córdoba, Veracruz, México
Posts: 2.914
Reputación: 21
AzidRain Va camino a la fama
Yo tengo algo funcionando que hace exactamente eso, utiliza Indy y hasta ahorita nunca ha dado problemas salvo con hotmail y cosas raras, pero mi cliente tiene su correo con su propio y no le ha dado lata.

Asi lo hago:
Código Delphi [-]
Procedure EnviarCFD(aEmail:string;aNo_talon:Integer; aSucursal:string;  asilent:boolean = false);overload;
// Componente de envio de correo
 var
   Correo    : TMailer;
   TextoMess : TStringList;
   Adjuntos  : TStringList;
   sFile     : string;

Begin
  Correo    := TMailer.Create;
  TextoMess := TStringList.Create;
  Adjuntos  := TStringList.Create;
  Screen.Cursor := crHourGlass;
  try
    Correo.CargaConfigSistemaDB; //Preparamos para enviar desde el correo del sistema
    sFile := uCFDTools.ExtractXMLFile(aNo_talon, aSucursal);
    Adjuntos.Add(sFile);
    ufqrTalonCFD.GeneraPDFTalonCFD(aNo_talon, aSucursal);
    sFile := uCFDTools.GetFullPDFFileName(aNo_talon, aSucursal);
    Adjuntos.Add(sFile);
    With TextoMess do
    begin
      Add('Estimado XXXXX:');
      Add('');
      Add('Anexo encontrará su comprobante Fiscal Digital');
      Add('');
      Add('Este es un correo generado de forma automática, por favor no lo responda');
      Add('Estamos a sus órdenes en el correo blalalala@aaa.com')
    end;
    Correo.FormatHMTLMessage(TextoMess);
    Correo.ConectaMail;
    Correo.EnviaEmailHTML(CFDMAIL_NOMBRECORREO,Correo.cuenta_origen,aEmail,CFDMAIL_ASUNTOCORREO,TextoMes  s,Adjuntos);
    Correo.DesconectaMail;
    If not asilent Then MessInfo('E-Mail enviado con éxito');
  finally
    Correo.Free;
    Adjuntos.Free;
    TExtoMess.Free;
    Screen.Cursor := crDefault;
   
  end;

end;

Obviamente tiene varias funciones propias, pero la que hace todo es esta:
Código Delphi [-]

Procedure TMailer.EnviaEmailHTML(nombre, desde, hasta, pasunto:String; ahtml,aTXT:TStringList;  adjunto: string);
var
  // Componente de envio de correo
   Mensaje : TIdMessage;
   txtPart : TIdText;
   htmPart : TIdtext;
   bmpPart : TIdAttachment;


Begin
  Mensaje:=TIDMessage.CREATE(nil);


Try
  with Mensaje do
  begin
    From.Address := desde;
    From.Name    := nombre;
    Recipients.EMailAddresses := hasta; //formamails.Emails.;}
    Subject                   := pasunto;
  //  Priority                  := TIdMessagePriority(mpHighest);//prioridad del mensaje
    CCList.EMailAddresses     := '';
    BccList.EMailAddresses    := '';


    ContentType := 'multipart/mixed';   //multipart/alternative
    //Creamos las 2 partes del e-mail, una en texto plano y la otra en html para

    {txtpart             := TIdText.Create( MessageParts,aTXT );
    txtpart.ContentType := 'text/plain';}
    htmpart             := TIdText.Create( MessageParts,ahtml );
    htmpart.ContentType := 'text/html';

    if Adjunto<>'' then
    Begin
        With TIdAttachmentFile.Create(Mensaje.MessageParts,adjunto) do

          //Utilizamos entonces la funcion Extract
          ContentType := GetMIMEType(adjunto);

    End;
  end; //configuracion server smtp

     MailHost.Send(Mensaje);

   finally
      Mensaje.free;
  end;


end;

{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 TMailer.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;

Un poco chapucero el código pero funciona sin problemas, por eso ya no se le ha movido nada bajo la premisa de "si funciona no le muevas"...jejeje
__________________
AKA "El animalito" ||Cordobés a mucha honra||
Responder Con Cita