Ver Mensaje Individual
  #2  
Antiguo 08-03-2023
bucanero bucanero is offline
Miembro
 
Registrado: nov 2013
Ubicación: Almería, España
Posts: 208
Reputación: 11
bucanero Va camino a la fama
En tu código veo que declaras dos TStream y no tengo muy claro al final como los manejas....
Cita:
Empezado por giantonti1801 Ver Mensaje


Código Delphi [-]
procedure TForm1.TMSFMXToolBarButton42Click(Sender: TObject);
var
filename: TStream;
//filename: String;
s1: tStream;
  begin
...
  end;
Dando por hecho que la parte de guardar el PDF en un stream te funciona bien y el problema es en el envio de correo, te paso una adaptación del codigo que yo utilizo y que espero te pueda servir

Código Delphi [-]
uses
  IdAttachmentFile, IdText, IdAttachment, IdMessageParts; 


function TForm2.prepareMessage(AToMail, ASubject: string; ABody: TStrings; AFileStream: TStream; AFileName: string): Boolean;
var
  CCListMail: string;
  HTMLFormat: Boolean;
begin
  Result := False;
  HTMLFormat := true;
  CCListMail := '';

  with IdMessage do begin
    clear;
    Body.clear;

    Recipients.EMailAddresses := AToMail;

    From.Address := FromMail;
    From.Name := FromNombre;
    ReplyTo.Add.Address := FromMail;
    if (CCListMail <> '') then
      BccList.EMailAddresses := CCListMail;

    Subject := ASubject;

      //se insertan los ficheros adjuntos
    with TIdAttachmentFile.Create(MessageParts) do begin
      AFileStream.Seek(0, 0);
      LoadFromStream(AFileStream);
      FileName := ExtractFileName(AFileName);
    end;

    if HTMLFormat then begin
        //la parte del mensaje que contienes HTML
      ContentType := 'multipart/mixed';
      with TIdText.Create(MessageParts, nil) do begin
        ContentType := 'text/html';
        Body.AddStrings(ABody);
      end;

      Body.Add('This is a multi-part message in MIME format.');
    end
    else begin
      ContentType := 'text/plain';
      Body.AddStrings(ABody);
    end;
  end;

  result := True;
end;

function TForm2.SendMail: Boolean;
begin
  result := false;

  // se carga la configuracion del SMTP
  getSMTPConfig;

  IdSMTP.Connect;
  if IdSMTP.connected then
  try
    IdSMTP.Send(IdMessage);
    result := True;
  finally
    IdSMTP.Disconnect(true);
  end;
end;

procedure LoadBitmapIntoStream(stream: TStream; AFileName: string);
var
  Bitmap: TBitmap;
begin
  /// Aqui es donde se carga el contenido del fichero en en un memoryStream
  /// Para las pruebas yo las he realizado con un simple BMP
  Bitmap := TBitmap.create;
  try
    Bitmap.LoadFromFile(AFileName);
    Bitmap.SaveToStream(stream);
  finally
    Bitmap.Free;
  end;
end;

procedure TForm2.Button1Click(Sender: TObject);
var
  Email, asunto: string;
  FileStream: TStream;
  MailFileName: string;
begin
  FileStream := TMemoryStream.Create;
  try
    /// carga el contenido del fichero en en un memoryStream, puede ser una imagen o un fichero PDF o cualquier otro contenido
    LoadBitmapIntoStream(FileStream, 'c:\a\icon_title2.bmp');

    Email := Destinatario; // 'uncorreo@servidor.com';
    asunto := 'El asunto del correo. Esto es una prueba de correo';
    MailFileName := 'MyImagen.bmp'; 
    /// MailFileName es el nombre que aparecera  en el email del receptor. 
    /// No tiene por que ser el mismo nombre que tiene originalmente.

    if not prepareMessage(Email, asunto, memo1.Lines, FileStream, MailFileName) then
      showMessage('Error en el proceso de preparacion del email')
    else if not SendMail then
      showMessage('No se pudo enviar el EMAIL')
    else
      ShowMessage('Correo enviado con exito');
  finally
    FileStream.Free;
  end;
end;

Última edición por bucanero fecha: 08-03-2023 a las 10:00:29. Razón: modificacion del codigo
Responder Con Cita