Tema: Crear Hilos de Ejecución con TIdFTP
Ver Mensaje Individual
  #12  
Antiguo 13-12-2013
Broskil Giovann Broskil Giovann is offline
Registrado
  
Registrado: abr 2004
Posts: 4
Reputación: 0
Broskil Giovann Va por buen camino
Muchas gracias Nelson,

contesto a tus comentarios...

Cita:
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.
Cita:
2-El código señalado es para enviar archivos a un servidor FTP, no para el envío de emails.
Cita:
Pregunto:
Cita:
1- ¿Que versión de Windows, Delphi y Indy utilizas?.
* Windows 7 Professional
* Delphi 7
* Indy 10.5.5

Cita:
2- ¿Podrías publicar el error que te aparece en el código del Msg #8?.
No da error. Fue un error mio.

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

Cita:
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.
Responder Con Cita