добрый день! Пишу небольшой почтовик исключительно для отправки почты с вложениями. Получать почту не нужно. Необходимо сделать и индикацию состояния отправки письма. Полазил по инету, по форуму. Из всего многоообразия у меня получился следующий код.
Какие недостатки в коде? И основной вопрос - Как заставить работать ProgressBar? Может я с классами напутал? Компилятор ругается на строчку 147. Когда же в процедуре отправки письма пишешь ProgressBar. - мастер кода выскакивает. Код для работы с прогрессбаром взял с другого форума. На текущий момент с классами я практический не работал, поэтому и вникнуть в суть не смог.
| Код |
unit mail;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,IdSMTP,IdMessage, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdMessageClient, StdCtrls, IdPOP3, ComCtrls;
type
TSendMailForm = class
public
procedure IdSMTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
procedure IdSMTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
procedure IdSMTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
procedure IdSMTPStatus(ASender: TObject;const AStatus: TIdStatus; const AStatusText: String);
procedure ShowStatus(StatusText: String);
end;
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
Button1: TButton;
IdPOP31: TIdPOP3;
IdSMTP1: TIdSMTP;
IdMessage1: TIdMessage;
ListBox1: TListBox;
Button2: TButton;
Button3: TButton;
SaveDialog1: TSaveDialog;
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Label4: TLabel;
StatusBar1: TStatusBar;
ProgressBar1: TProgressBar;
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure IdPOP31Connected(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
smtp: TIdSMTP;
mes: TIdMessage;
attach: TIDAttachment;
pop3: TIdPOP3;
implementation
{$R *.dfm}
{=================================}
// //
// создание и отправка письма //
// //
{=================================}
procedure TForm1.Button1Click(Sender: TObject);
var
i,a: Integer;
FileName: String;
f: TSearchRec;
begin
smtp:=TIdSMTP.Create(nil);
mes:=TIdMessage.Create(smtp);
smtp.Host := Edit1.Text;
smtp.Port := strtoint(Edit2.Text);
smtp.Username := 'user';
smtp.Password := 'pass';
smtp.AuthenticationType := atLogin;
mes.ContentType := 'text/plain; charset=windows-1251';
mes.From.Text := Edit3.Text;
mes.Name := 'Name';
mes.Date := Now();
mes.Recipients.EMailAddresses := Edit4.Text;
mes.Subject := 'Subj';
mes.Body.Text := 'Hello!';
mes.MessageParts.Clear;
try
smtp.Connect(500000);
except on E : Exception do
begin
ShowMessage('ERROR: '+e.Message+' at '+DateTimeToStr(now));
exit;
end;
end;
if smtp.Connected then
begin
FindFirst('c:\*.jpg',faAnyFile ,f);
if F.name <> '' then
begin
TIdAttachment.Create(mes.MessageParts, 'c:\'+f.Name );
while FindNext(F) = 0 do
begin
TIdAttachment.Create(mes.MessageParts, 'c:\'+f.Name );
end;
FindClose(f);
end;
try
smtp.Send(mes);
except on E : Exception do
begin
SMTP.Disconnect;
ShowMessage('ERROR: '+e.Message+' at '+DateTimeToStr(now));
end;
end;
if smtp.Connected then smtp.Disconnect;
end;
mes.Free;
smtp.Free;
end;
{=================================}
// //
// progressbar //
// //
{=================================}
procedure TSendMailForm.IdSMTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
Var
S: TMemoryStream;
Begin
If AWorkMode <> wmWrite then Exit; // send process
S := TMemoryStream.Create;
Try
mes.SaveToStream(S, False);
ProgressBar1.Min := 0;
ProgressBar1.Position := 0;
ProgressBar1.Max := S.Size;
S.Clear;
mes.SaveToStream(S, True);
ProgressBar1.Max := ProgressBar1.Max - S.Size;
Finally
S.Free;
End;
Application.ProcessMessages;
end;
procedure TSendMailForm.IdSMTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
begin
If AWorkMode = wmWrite Then ProgressBar1.Position := AWorkCount;
Application.ProcessMessages;
end;
procedure TSendMailForm.IdSMTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
If AWorkMode = wmWrite Then ProgressBar1.Position := 0;
Application.ProcessMessages;
end;
procedure TSendMailForm.IdSMTPStatus(ASender: TObject;const AStatus: TIdStatus; const AStatusText: String);
begin
ShowStatus(AStatusText);
end;
Procedure TSendMailForm.ShowStatus(StatusText: String);
Begin
StatusBar1.SimpleText := StatusText;
Application.ProcessMessages;
End;
end.
|
|
)