Hola,
He escrito algo para que hagas unas pruebas y tal. Parece funcionar, pero, de todos modos, no dejes de revisar la ayuda de los eventos, de los componentes, en fin, de lo que sea menester, porque puedo estar olvidándome de cosas, por poner un ejemplo de lo que puedo estar haciendo mal. No va con mala intención, desde luego.
Código Delphi
[-]
const
ADJUNTO = 'C:\adjunto.zip';
ORIGEN = 'origen@wanadoo.es';
DESTINO = 'destino@correo.com';
SERVIDOR = 'smtp.correo.es';
function GetFileSize(FileName: string): int64;
var
Srec: TSearchRec;
begin
if FindFirst(FileName, $01+$04+$20, Srec) = 0 then
Result := Srec.FindData.nFileSizeHigh *MAXDWORD +
Srec.FindData.nFileSizeLow
else
Result := 0;
findclose(Srec);
end;
procedure TForm1.ButtonClick(Sender: TObject);
begin
IdMessage.From.Address := ORIGEN;
IdMessage.Recipients.Add;
IdMessage.Recipients[0].Address := DESTINO;
TidAttachment.Create(IdMessage.MessageParts, ADJUNTO);
ProgressBar.Max := GetFileSize(ADJUNTO);
IdSMTP.Host := SERVIDOR;
try
IdSMTP.Connect; try
IdSMTP.Send(IdMessage); finally
if IdSMTP.Connected then IdSMTP.Disconnect;
ShowMessage('El correo se ha enviado correctamente');
end;
except
on E: Exception do
MessageDlg(E.Message, mtError, [mbOK], 0);
end;
ProgressBar.Position := 0; end;
procedure TForm1.IdSMTPWorkBegin(Sender: TObject;
AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
if (AWorkCountMax <> 0) then
ProgressBar.Max := AWorkCountMax;
end;
procedure TForm1.IdSMTPWork(Sender: TObject;
AWorkMode: TWorkMode; const AWorkCount: Integer);
begin
Application.ProcessMessages;
ProgressBar.Position := AWorkCount;
end;
procedure TForm1.IdSMTPWorkEnd(Sender: TObject;
AWorkMode: TWorkMode);
begin
end;