Crear Hilos de Ejecución con TIdFTP

[Casimiro Notevi]

Está muy bien esa solución.

Aunque para estas cosas no sé yo si vale la pena, me explico: si tiene que subir 1000 archivos entonces tardará según el ancho de banda que tenga. Si usa hilos lo único que se consigue es que en lugar de subir un archivo a, por ejemplo, 1 mega, subirán 2 a medio mega, 4 a un cuarto de mega, etc. o sea, que no se reducirá el tiempo. Es por lo que personalmente prefiero subir uno a uno, ya que el tiempo para subirlos no va a mejorar, así que no lo encuentro muy necesario.
Es sólo una preferencia personal.

Tengo algunos programitas que hacen eso, por ejemplo, uno de ellos sube imágenes casi diariamente (por FTP) a una web, son imágenes pequeñas (10 a 50 Kb), aunque son muchas (alrededor de 20 ó 30 mil) y lo hace una a una. Por supuesto, envía una cuando ha acabado con otra, no se intenta enviar todas al mismo tiempo, que es el problema que no ha controlado JAI_ME.

De todas formas, la solución propuesta nlsgarcia es excelente.

[Broskil Giovann]

Hola a todos,

gracias nslgarcia por el código propuesto.
Tengo un problema con el código que he utilizado yo para enviar mediante un TidSMTP un correo electrónico.
El problema me aparece en mi código pero tambien en el proyecto que he descargado en el link que nos indicas.

En estas dos funciones, al acceder al Formulario para añadir las lineas en el Memo1, me devuelve un "Access Violation".

Código Delphi [-]
// Fin de envío con TUploaderThread
procedure TUploaderThread.FinishedUpload;
begin
   form1.memo1.lines.add('Finalizando FTP Upload: ' + FFilename);
   form1.ProgressBar1.Position := FTPMax;
end;

// Error de envío con TUploaderThread
procedure TUploaderThread.HandleException;
begin
   form1.memo1.lines.add('Error en FTP Uploading en ' + FFilename + ': ' + fe.Message);
end;

¿Alguna idea?

[[nlsgarcia]]

Broskil Giovann,

Empezado por Broskil Giovann

...Tengo un problema con el código que he utilizado...para enviar mediante un TidSMTP un correo electrónico...pero también en el proyecto que he descargado en el link que nos indicas...

Te comento:

1- El código señalado en el Msg #8 funciona correctamente en Delphi 7 usando el Componente FTP de Indy 9 bajo Windows 7 Professional x32.

2-El código señalado es para enviar archivos a un servidor FTP, no para el envío de emails.

Pregunto:

1- ¿Que versión de Windows, Delphi y Indy utilizas?.

2- ¿Podrías publicar el error que te aparece en el código del Msg #8?.

3- ¿Si usas la opción de Envío de Archivos Simple (Uno a uno) funciona?.

Empezado por Broskil Giovann

...al acceder al Formulario para añadir las lineas en el Memo1, me devuelve un "Access Violation"...

4- ¿El formulario en cuestión esta instanciado?.

Espero sea útil

Nelson.

[Broskil Giovann]

Muchas gracias Nelson,

contesto a tus comentarios...

1- El código señalado en el Msg #8 funciona correctamente en Delphi 7 usando el Componente FTP de Indy 9 bajo Windows 7 Professional x32.

2-El código señalado es para enviar archivos a un servidor FTP, no para el envío de emails.

Pregunto:

1- ¿Que versión de Windows, Delphi y Indy utilizas?.

* Windows 7 Professional
* Delphi 7
* Indy 10.5.5

2- ¿Podrías publicar el error que te aparece en el código del Msg #8?.

No da error. Fue un error mio.

3- ¿Si usas la opción de Envío de Archivos Simple (Uno a uno) funciona?.

Funcionan los dos.

4- ¿El formulario en cuestión esta instanciado?.

Te adjunto todo el codigo para que lo veas:

Código Delphi [-]
unit U_PS025;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, DBCtrls, Mask, MesControls,
  Dades_Mensaje, Buttons, jpeg, MesStrings, MesDates, DateUtils,
  mesBaseDades, Dades_Finestres, ComCtrls, IdEmailAddress,
  IdMessageParts, IdAttachmentFile, MyAccess, IdSMTP, IdFTP, IdFTPCommon,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdExplicitTLSClientServerBase, AdvMetroButton, GIFImg, IdAntiFreezeBase,
  IdAntiFreeze, IdMessageClient, IdSMTPBase,
  IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack,
  IdSSL, IdSSLOpenSSL, frxExportPDF, Dades_Aplicacio,
  IdReplySMTP, IdSSLOpenSSLHeaders,
  Registry, ShellAPI, IdHTTP, IdMessage;

type
  TF_PS025 = class(TForm)
    GBCorreo: TGroupBox;
    Label26: TLabel;
    LReferencias: TLabel;
    EAsunto: TEdit;
    Label1: TLabel;
    LUsuario: TLabel;
    ECuerpo: TMemo;
    GBEnviando: TGroupBox;
    CBSolicitarConfirmacion: TCheckBox;
    GroupBox1: TGroupBox;
    Label3: TLabel;
    EPassword: TEdit;
    GroupBox2: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    GroupBox3: TGroupBox;
    LlistaAdjunts: TListBox;
    GBFax: TGroupBox;
    Label7: TLabel;
    EFax: TEdit;
    Button2: TButton;
    GBCorreoElectronico: TGroupBox;
    Label2: TLabel;
    EDestinatario: TEdit;
    Button1: TButton;
    CBTodos: TCheckBox;
    LCorreoElectronico: TLabel;
    LFax: TLabel;
    Label8: TLabel;
    LFtp: TLabel;
    GBFtp: TGroupBox;
    Label9: TLabel;
    ENombre: TEdit;
    EEmpresa: TEdit;
    Button3: TButton;
    Label10: TLabel;
    LEmpresa: TLabel;
    AdvMetroButton3: TAdvMetroButton;
    AdvMetroButton1: TAdvMetroButton;
    Memo1: TMemo;
    procedure FormShow(Sender: TObject);
    procedure EAsuntoKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure EDestinatarioKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Label4Click(Sender: TObject);
    procedure Label6Click(Sender: TObject);
    procedure Label5Click(Sender: TObject);
    procedure LlistaAdjuntsDblClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure LCorreoElectronicoClick(Sender: TObject);
    procedure LFaxClick(Sender: TObject);
    procedure Label8Click(Sender: TObject);
    procedure LFtpClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure AdvMetroButton3Click(Sender: TObject);
    procedure AdvMetroButton1Click(Sender: TObject);
    procedure ThreadDone(Sender: TObject);
  private
    i: SmallInt;
    Mail, Fax, Ftp: Boolean;
    { Private declarations }
    procedure FinestraDireccions;
    procedure FinestraFax;
    procedure FinestraDocumento;
    Procedure FinestraEmpresa;
  public
    IdEmpleado: Integer;
    Todos, Borrar, SolicitarConfirmacion: Boolean;
    Asunto, Destinatario, Cuerpo, DocumentoAdjunto, Password: String;
    { Public declarations }
    Procedure EditAVariable;
  end;

var
  F_PS025: TF_PS025;
  compEnvioEmail : TIdSMTP;
  PTIdFtp : TIdFtp;
  compIoHandler: TIdSSLIOHandlerSocketOpenSSL;

implementation

{$R *.dfm}

// Clase Threads
type
  TThreadMail = class(TThread)
  private
    TServidorUsuario : String;
    TMailUsuario : String;
    TPassUsuario : String;
    TPuertoUsuario : Integer;
    TAsunto: String;
    TMensaje: TStringList;
    TAutenticacion: Boolean;
    TEmisor: String;
    TNombreEmisor: String;
    TDestinatario: String;
    TCc: String;
    TAdjunto: String;
    TSolicitarConfirmacion: Boolean;
    TFinalitzar: Boolean;
    TBorrar: Boolean;
    TListaAdjuntos: TStringList;
    TEx : Exception;
    { Private declarations }
    procedure EnvioFinalizado;
    procedure HandleException;
    procedure InicioEnvio;
  protected
    procedure execute; override;
  public
    Constructor Create(
      ServidorUsuario, MailUsuario, PassUsuario : String;
      PuertoUsuario : Integer;
      Asunto: String;
      Mensaje: TStringList;
      Autenticacion, Borrar, SolicitarConfirmacion: Boolean;
      Emisor, NombreEmisor: String;
      MailsDestinatarios: String;
      Cc, Adjunto: String; ListaAdjuntos: TStringList);
  end;

procedure TF_PS025.FormCreate(Sender: TObject);
begin
    inherited;
    i:=0;
    Fax:=False;
    GBFax.SendToBack;
    LFax.Font.Color:=$00C08000;
    GBCorreo.BringToFront;
    GBCorreoElectronico.BringToFront;
    LCorreoElectronico.Font.Color:=clBlue;
    with TIdAntiFreeze.Create(self) do Active:=true;
end;



Procedure TF_PS025.FormShow(Sender: TObject);
begin
    LEmpresa.Caption:='';
    LUsuario.Caption:=ValorCamp('IDEMPLEADO', 'EMPLEADOS', 'NOMBRE', IdEmpleado);
    EAsunto.Text:=Asunto;
    EDestinatario.Text:=Destinatario;
    EFax.Clear;
    ECuerpo.Lines.Clear;
    if Cuerpo<>'' then
     ECuerpo.Lines.Add(Cuerpo);
    EPassword.Text:=Password;
    if Todos then
      CBTodos.Checked:=True
    else
      CBTodos.Checked:=False;

    if SolicitarConfirmacion then
      CBSolicitarConfirmacion.Checked:=True
    else
      CBSolicitarConfirmacion.Checked:=False;

    Mail:= True; Fax:=False; Ftp:=False;
    GBFax.SendToBack;
    LFax.Font.Color:=$00C08000;
    GBFtp.Visible:=False;
    LFtp.Font.Color:=$00C08000;
    GBCorreoElectronico.BringToFront;
    LCorreoElectronico.Font.Color:=clBlue;

    ECuerpo.Visible:=True;
    GroupBox3.Visible:=True;
    GroupBox2.Visible:=True;
end;


Procedure TF_PS025.EditAVariable;
begin
    Asunto:=EAsunto.Text;
    if not(Fax) then
      Destinatario:=EDestinatario.Text
    else
      Destinatario:=EFax.Text;

    Password:=EPassword.Text;
    Cuerpo:=ECuerpo.Lines.Text;

    if CBTodos.Checked then
      Todos:=True
    else
      Todos:=False;

    if CBSolicitarConfirmacion.Checked then
      SolicitarConfirmacion:=True
    else
      SolicitarConfirmacion:=False;
end;


procedure TF_PS025.EDestinatarioKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
    case key of
     VK_RETURN:
      begin
       key := VK_TAB;
       Perform(WM_NEXTDLGCTL,0,0);
      end;
    end;
end;

procedure TF_PS025.LCorreoElectronicoClick(Sender: TObject);
begin
    Mail:= True; Fax:=False; Ftp:=False;
    GBFax.SendToBack;
    LFax.Font.Color:=$00C08000;
    GBFtp.Visible:=False;
    LFtp.Font.Color:=$00C08000;
    GBCorreoElectronico.BringToFront;
    LCorreoElectronico.Font.Color:=clBlue;

    Label26.Enabled:=True;
    EAsunto.Enabled:=True;
    ECuerpo.Visible:=True;
    GroupBox1.Visible:=True;
end;

procedure TF_PS025.LFaxClick(Sender: TObject);
begin
    Mail:= False; Fax:=True; Ftp:=False;
    GBCorreoElectronico.SendToBack;
    LCorreoElectronico.Font.Color:=$00C08000;
    GBFtp.Visible:=False;
    LFtp.Font.Color:=$00C08000;
    GBFax.BringToFront;
    LFax.Font.Color:=clBlue;

    Label26.Enabled:=True;
    EAsunto.Enabled:=True;
    ECuerpo.Visible:=True;
    GroupBox1.Visible:=True;
end;

procedure TF_PS025.LFtpClick(Sender: TObject);
begin
    Mail:= False; Fax:=False; Ftp:=True;
    GBCorreoElectronico.SendToBack;
    LCorreoElectronico.Font.Color:=$00C08000;
    GBFax.SendToBack;
    LFax.Font.Color:=$00C08000;
    GBFtp.Visible:=True;
    GBFtp.BringToFront;
    LFtp.Font.Color:=clBlue;

    Label26.Enabled:=False;
    EAsunto.Enabled:=False;
    ECuerpo.Visible:=False;
    GroupBox1.Visible:=False;
end;

procedure TF_PS025.LlistaAdjuntsDblClick(Sender: TObject);
begin
    LlistaAdjunts.DeleteSelected;
end;

procedure TF_PS025.AdvMetroButton1Click(Sender: TObject);
begin
    ModalResult:=mrCancel;
end;

procedure TF_PS025.AdvMetroButton3Click(Sender: TObject);
var maildestinatario: TIdEMailAddressList;
    vtMensajeTexto: TStringList;
    Question: TMyQuery;
    i: Integer;
    Llista: TStringList;
begin
    Memo1.Lines.Clear;

    if (AdvMetroButton3.Tag=1) then
     begin
       ModalResult:=mrOk;
     end
    else
     begin
      GBCorreo.SendToBack;
      GBEnviando.Height:=413;
      GBEnviando.BringToFront;
      EditAVariable;

      vtMensajeTexto:=TStringList.Create;
      vtMensajeTexto.Add(Cuerpo);

      maildestinatario:=TIdEMailAddressList.Create(nil);
      // Estamos enviando mail ...
      if Mail then
       begin
        Memo1.Lines.Add('Enviando correo electrónico.');
        Memo1.Lines.Add('Espere confirmación de finalización.');
        if Todos then
         begin
          Question:=TMyQuery.Create(nil);
          Question.Connection:=D_Aplicacio.ConexionMSql;
          Question.SQL.Add(
          ' SELECT E.EMAIL FROM EMPLEADOS E, USUARIOS U '+
          ' WHERE (E.USUARIO_ASOCIADO=U.IDUSUARIO) AND (E.ACTIVO=''T'') AND NOT(E.EMAIL IS NULL) ');
          Question.Active:=True;
          Question.First;
          while not(Question.Eof) do
           begin
            maildestinatario.Add.Address := Question.FieldByName('EMAIL').AsString;
            Question.Next;
           end;
          if Assigned(Question) then
           Question.Free;
         end
        else
         begin
          for i:=1 to (ContarCaracterEnCadena(';',Destinatario)+1) do
           maildestinatario.Add.Address:= CadenaEntreSeparadors(';', i, Destinatario);
         end;
       end;

      // Estamos enviando Fax ...
      if Fax then
       begin
        Memo1.Lines.Add('Enviando fax.');
        Memo1.Lines.Add('Espere confirmación de finalización.');
        for i:=1 to (ContarCaracterEnCadena(';',Destinatario)+1) do
         maildestinatario.Add.Address:= 'fax.' + CadenaEntreSeparadors(';', i, Destinatario) + '@fax.vodafone.es';
       end;

      Question:=TMyQuery.Create(nil);
      Question.Connection:=D_Aplicacio.ConexionMSql;
      if Fax then
       begin
        Question.SQL.Add(
        ' SELECT ''Previnsa, S.L.'' AS NOMBRE, MAILFAX AS EMAIL, SERVIDOR, PUERTO '+
        ' FROM GESTORES '+
        ' WHERE (IDGESTOR=:IDGESTOR) ');
        Question.ParamByName('IDGESTOR').AsInteger:=llistaemp.GestorActiu;
        Question.Active:=True;
       end
      else
       begin
        Question.SQL.Add(
        ' SELECT E.NOMBRE, E.EMAIL, E.SERVIDOR, E.PUERTO '+
        ' FROM EMPLEADOS E, USUARIOS U '+
        ' WHERE (E.USUARIO_ASOCIADO=U.IDUSUARIO) AND (U.IDUSUARIO=:IDUSUARIO) ');
        Question.ParamByName('IDUSUARIO').AsInteger:=llistaemp.UsuariActual;
        Question.Active:=True;
       end;

      Llista:=TStringList.Create;
      Llista.Assign(LlistaAdjunts.Items);
      TThreadMail.Create(Question.FieldByName('SERVIDOR').AsString,
       Question.FieldByName('EMAIL').AsString, Password,
       Question.FieldByName('PUERTO').AsInteger, Asunto, vtMensajeTexto,
       True, Borrar, SolicitarConfirmacion, Question.FieldByName('EMAIL').AsString,
       Question.FieldByName('NOMBRE').AsString, mailDestinatario.EMailAddresses, '',
       DocumentoAdjunto, Llista);

      AdvMetroButton3.Tag:=1;
     end;
end;

procedure TF_PS025.Button1Click(Sender: TObject);
begin
    FinestraDireccions;
end;

procedure TF_PS025.Button2Click(Sender: TObject);
begin
    FinestraFax;
end;

procedure TF_PS025.Button3Click(Sender: TObject);
begin
    FinestraEmpresa;
end;

Procedure TF_PS025.EAsuntoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
    case key of
     VK_RETURN:
      begin
       key := VK_TAB;
       Perform(WM_NEXTDLGCTL,0,0);
      end;
    end;
end;


procedure TF_PS025.Label4Click(Sender: TObject);
begin
    FinestraDocumento;
end;

procedure TF_PS025.Label5Click(Sender: TObject);
var fitxer: String;
    dialeg: TOpenDialog;
begin
    inherited;
    Dialeg:=TOpenDialog.Create(Application);
    Dialeg.Title:='Ficheros adjuntos';
    Dialeg.Filter:='Ficheros adjuntos|*.*;';
    If not dialeg.Execute then
     begin
         if Assigned(Dialeg) then
          Dialeg.free;
         Exit;
     end;
    Fitxer:=Dialeg.FileName;

    try
     LlistaAdjunts.Items.Add(fitxer);
    except
    end;

    if Assigned(Dialeg) then
     Dialeg.Free;
end;

procedure TF_PS025.Label6Click(Sender: TObject);
begin
    LlistaAdjunts.DeleteSelected;
end;

procedure TF_PS025.Label8Click(Sender: TObject);
begin
    AdvMetroButton3.Tag:=0;
    GBCorreo.BringToFront;
    GBEnviando.Height:=293;
    GBEnviando.SendToBack;
end;


{ ThReadMail }
constructor TThreadMail.Create(
    ServidorUsuario, MailUsuario, PassUsuario : String;
    PuertoUsuario : Integer;
    Asunto: String;
    Mensaje: TStringList;
    Autenticacion, Borrar, SolicitarConfirmacion: Boolean;
    Emisor, NombreEmisor: String;
    MailsDestinatarios: String;
    Cc, Adjunto: String; ListaAdjuntos: TStringList);
begin
    IdSSLOpenSSLHeaders.Load;
    TServidorUsuario:=ServidorUsuario;
    TMailUsuario:=MailUsuario;
    TPassUsuario:=PassUsuario;
    TPuertoUsuario:=PuertoUsuario;
    TAsunto:=Asunto;
    TMensaje:=Mensaje;
    TAutenticacion:=Autenticacion;
    TEmisor:=Emisor;
    TNombreEmisor:=NombreEmisor;
    TDestinatario:=MailsDestinatarios;
    TCC:=Cc;
    TAdjunto:=Adjunto;
    TSolicitarConfirmacion:=SolicitarConfirmacion;
    TBorrar:=Borrar;
    TListaAdjuntos:=ListaAdjuntos;
    OnTerminate := F_PS025.ThreadDone;
    FreeOnTerminate := True;
    inherited create(false);
end;


// Envía un mensaje al finalizar todos los Threads activos
procedure TF_PS025.ThreadDone(Sender: TObject);
begin
   //MessageDlg('Hilo Creado', mtinformation, [mbok], 0);
end;


Procedure TThreadMail.Execute;
var compMensaje : TIdMessage;
    i: SmallInt;
begin
  IdSSLOpenSSLHeaders.Load;

  compIoHandler:=TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  compIoHandler.RecvBufferSize := 65000;
  compIoHandler.SendBufferSize := 65000;
  compIoHandler.PassThrough := True;
  compIoHandler.SSLOptions.Method := sslvTLSv1;//sslvSSLv2;//sslvSSLv3;
  compIoHandler.SSLOptions.Mode :=sslmUnassigned ;
  compIoHandler.SSLOptions.VerifyMode := [];
  compIoHandler.SSLOptions.VerifyDepth := 0;
  compIoHandler.Host := TServidorUsuario;
  compIoHandler.Destination := TServidorUsuario + ':' + IntToStr(TPuertoUsuario);
  compIoHandler.DefaultPort := 0;
  compIoHandler.Port := TPuertoUsuario;
  compIoHandler.UseNagle := False;

  compEnvioEmail:=TIdSMTP.Create(nil);
  compEnvioEmail.PipeLine:=False;
  compEnvioEmail.UseEhlo:=True;
  compEnvioEmail.IOHandler:=compIoHandler;
  compEnvioEmail.Host:=TServidorUsuario;
  compEnvioEmail.Port:=TPuertoUsuario;

  if (TPuertoUsuario = 465) then
   compEnvioEmail.UseTLS:= utUseImplicitTLS
  else
   compEnvioEmail.UseTLS:= utUseExplicitTLS;

  if TAutenticacion then
   compEnvioEmail.AuthType := satDefault
  else
   compEnvioEmail.AuthType := satNone;

  compEnvioEmail.Password:=TPassUsuario;
  compEnvioEmail.Username:=TMailUsuario;

  try
    compEnvioEmail.connect;
  except
    MensajeDialogo('Error en la conexión con el servidor.', mtError, [mbAceptar], '');
    compEnvioEmail.Free;
    Exit;
  end;

  compMensaje := TIdMessage.Create (nil);
  compMensaje.From.Address := TMailUsuario;
  compMensaje.From.User := TMailUsuario;
  compMensaje.From.Name := TNombreEmisor;
  compMensaje.ReplyTo.Add.Address := TMailUsuario;
  compMensaje.CharSet := 'ISO-8859-2'; //'UTF-8';

  compMensaje.Recipients.EMailAddresses := TDestinatario;

  compMensaje.Priority := TIdMessagePriority(mpHighest); // prioridad del mensaje
  compMensaje.Body.AddStrings (Tmensaje);
  compMensaje.Subject := TAsunto;

  if TSolicitarConfirmacion then
   begin
    compMensaje.ReceiptRecipient.Text := compMensaje.From.Text;
    compMensaje.ReceiptRecipient.Address := TEmisor;
    compMensaje.ReceiptRecipient.Name := TNombreEmisor;
   end;

  if ((TAdjunto<>'') and (TAdjunto <> NULL)) then
   TIdAttachmentFile.Create(compMensaje.MessageParts, TAdjunto);

  for i:=0 to TListaAdjuntos.Count-1 do
   if Fileexists(TListaAdjuntos.Strings[i]) then
     TIdAttachmentFile.Create(compMensaje.MessageParts, TListaAdjuntos.Strings[i]);

  try
    //Synchronize(InicioEnvio);
    compEnvioEmail.Send(compMensaje);
    Synchronize(EnvioFinalizado);
  except
     on E: Exception do
      begin
          Tex:=E;
          Synchronize(HandleException);
      end;
  end;

  compMensaje.Free;
  TFinalitzar:=True;
end;

// Inicio de envío con TUploaderThread
procedure TThreadMail.InicioEnvio;
begin
    //F_PS025.Label8.Enabled:=False;
end;

// Fin de envío con TUploaderThread
procedure TThreadMail.EnvioFinalizado;
begin
    MensajeDialogo('Envio finalizado con éxito.', mtAviso, [mbAceptar], '');
    F_PS025.Memo1.lines.add('Envio finalizado con éxito.');
end;

// Error de envío con TUploaderThread
procedure TThreadMail.HandleException;
begin
    MensajeDialogo('Error en el envio - ' + Tex.Message, mtAviso, [mbAceptar], '');
    F_PS025.Memo1.Lines.Add('Error en el envio. ' + Tex.Message);
end;

end.

Y la creación del Form:

Código Delphi [-]
Function EnviarCorreoAdjunto(Asunto, Mensaje, PathDocumento, Destinatarios: String; Borrar: Boolean):Boolean;
var F_PS025: TF_PS025;
begin
        F_PS025:=TF_PS025.Create(nil);
        F_PS025.Asunto:=Asunto;
        F_PS025.Destinatario:=Destinatarios;
        F_PS025.Cuerpo:=Mensaje;
        F_PS025.Password:='';
        F_PS025.Todos:=False;
        F_PS025.DocumentoAdjunto:=PathDocumento;
        F_PS025.Borrar:=Borrar;
        F_PS025.SolicitarConfirmacion:=False;

        F_PS025.ShowModal;

        if Assigned(F_PS025) then
         F_PS025.Free;
        EnviarCorreoAdjunto:=True;
end;

El error aparece en:

Código Delphi [-]
// Fin de envío con TUploaderThread
procedure TThreadMail.EnvioFinalizado;
begin
    F_PS025.Memo1.lines.add('Envio finalizado con éxito.');
end;

Cuando en el Execute se llama a

Código Delphi [-]
Synchronize(EnvioFinalizado);

En Debug, poniendo un break en la linea donde me aparece el Access Violation, el F_PS025 lo tengo a "nil" y sus componentes no tienen valor...

Jose.

[[nlsgarcia]]

Broskil Giovann,

Empezado por Broskil Giovann

...Te adjunto todo el código para que lo veas...En Debug...el F_PS025 lo tengo a "nil" y sus componentes no tienen valor...

Te comento:

1- La función EnviarCorreoAdjunto instancia y libera el formulario TF_PS025.

2- La declaración de la función EnviarCorreoAdjunto esta en en código del Msg #12, pero la llamada a la función ¿Donde esta?.

3- Al parecer, según lo mostrado en el código del Msg #12, el formulario TF_PS025 no esta instanciado y por ello al ejecutar Synchronize(EnvioFinalizado) se produce el error de Access Violation, dado que se trata de acceder en runtime a un objeto que no ha sido creado previamente.

4- Revisa este código:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Unit2;

function ShowModalForm2(Msg : String) : Boolean;
var
   Form2 : TForm2;
   i : Integer;
   
begin

   try

      Form2 := TForm2.Create(nil);

      with Form2 do
         for i := 0 to 10 do
            Memo1.Lines.Add('Line-' + IntToStr(i) + ' ' + Msg);

      Form2.ShowModal;

      if Assigned(Form2) then
         Form2.Free;

      Result := True;

   except

      Result := False;

   end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if ShowModalForm2('Text') then
      MessageDlg('La función ShowModalForm2 fue ejecutada correctamente',mtInformation,[mbOK],0)
   else
      MessageDlg('Error al ejecutar la función ShowModalForm2',mtError,[mbOK],0);
end;

end.

El código anterior instancia y libera el formulario TForm2 por medio de la función ShowModalForm2 y carga 11 líneas en el componente TMemo1, si se comenta la línea Form2 := TForm2.Create(nil) se producirá un Access Violation (Gestionado por try...except statements), al ejecutar la línea Memo1.Lines.Add('Line-' + IntToStr(i) + ' ' + Msg) dado que el objeto que contiene al componente nunca fue creado.

Espero sea útil

Nelson.