Модераторы: Snowy, Poseidon, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> отправка почты, progressbar, через IdSMTP, индикация Progressbar 
:(
    Опции темы
RosemaN
Дата 10.5.2008, 19:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 19
Регистрация: 4.11.2007

Репутация: нет
Всего: нет
добрый день! Пишу небольшой почтовик исключительно для отправки почты с вложениями. Получать почту не нужно. Необходимо сделать и индикацию состояния отправки письма. Полазил по инету, по форуму. Из всего многоообразия у меня получился следующий код.
Какие недостатки в коде? И основной вопрос - Как заставить работать 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.



Это сообщение отредактировал(а) RosemaN - 10.5.2008, 19:05
PM MAIL   Вверх
Exai1e
Дата 10.5.2008, 20:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 908
Регистрация: 3.12.2006
Где: Moscow

Репутация: нет
Всего: 30
http://forum.vingrad.ru/index.php?showtopi...t&p=1139163


--------------------
"Решение зависит от выбранного геморроя" © Snowy
"у нас как в армии - либо работает, либо так и задумано"
PM MAIL ICQ   Вверх
RosemaN
Дата 10.5.2008, 20:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 19
Регистрация: 4.11.2007

Репутация: нет
Всего: нет
Exai1e, уже читал этот пост. Yе понял как работать с OnWorkBegin OnWork. Парметры ProgressBar1 - integer! Как их связать
PM MAIL   Вверх
Exai1e
Дата 10.5.2008, 21:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 908
Регистрация: 3.12.2006
Где: Moscow

Репутация: нет
Всего: 30
Цитата(RosemaN @  10.5.2008,  21:33 Найти цитируемый пост)
Exai1e, уже читал этот пост. Yе понял как работать с OnWorkBegin OnWork. Парметры ProgressBar1 - integer! Как их связать 


Код

procedure TForm1.IdSMTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Integer);


читаем внимательно 
Код
...AWorkCountMax: Integer);


Добавлено @ 21:07
Код

procedure TForm1.IdSMTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Integer);


Код

...AWorkCount: Integer);


Это сообщение отредактировал(а) Exai1e - 10.5.2008, 21:08


--------------------
"Решение зависит от выбранного геморроя" © Snowy
"у нас как в армии - либо работает, либо так и задумано"
PM MAIL ICQ   Вверх
RosemaN
Дата 10.5.2008, 21:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 19
Регистрация: 4.11.2007

Репутация: нет
Всего: нет
в каком месте когда необходимо вставить изменение прогрессбара? После 
Код

smtp.Send(mes);
PM MAIL   Вверх
Exai1e
Дата 10.5.2008, 21:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 908
Регистрация: 3.12.2006
Где: Moscow

Репутация: нет
Всего: 30
 smile 
Код

procedure TForm1.IdSMTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Integer);


вот сюда его надо вставлять, когда идет отправка сообщения. В посте написанно как вычислить единицу на которую увеличивается process


--------------------
"Решение зависит от выбранного геморроя" © Snowy
"у нас как в армии - либо работает, либо так и задумано"
PM MAIL ICQ   Вверх
RosemaN
Дата 11.5.2008, 13:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 19
Регистрация: 4.11.2007

Репутация: нет
Всего: нет
вот такой код у меня получился. Но компилятор ругается на исключение "must be local recipient to send mail"
Код

procedure TForm1.IdSMTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  FWorkCountMax:=AWorkCountMax;
  ProgressBar1.Position :=0;
end;


procedure TForm1.IdSMTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
 ProgressBar1.Position := (round(AWorkCount/FWorkCountMax))*100;
 Application.ProcessMessages;
end;


иногда возникает исключение с 0. Когда начал копаться, оказалось что  AworkCountMax равен 0, хотя данные передаются.

Это сообщение отредактировал(а) RosemaN - 11.5.2008, 13:41
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Сети"
Snowy
Poseidon
MetalFan

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Snowy, Poseidon, MetalFan.
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Сети | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0663 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.