Форум: "Сети";
Текущий архив: 2004.07.18;
Скачать: [xml.tar.bz2];

Вниз

Почтовик   Найти похожие ветки 

← →
Sergo ©   (2004-05-19 11:02) [0]

Как удалить письма с сервера?

---

← →
Rouse_ ©   (2004-05-19 14:06) [1]

Что-то вроде этого:

unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   Edit1: TEdit;
   Edit3: TEdit;
   Label1: TLabel;
   Label2: TLabel;
   GroupBox1: TGroupBox;
   Button1: TButton;
   Memo1: TMemo;
   ClientSocket1: TClientSocket;
   Edit2: TEdit;
   Label3: TLabel;
   Button2: TButton;
   Label4: TLabel;
   Edit4: TEdit;
   Button3: TButton;
   procedure Button1Click(Sender: TObject);
   procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
   procedure ClientSocket1Connect(Sender: TObject;
     Socket: TCustomWinSocket);
   procedure ClientSocket1Disconnect(Sender: TObject;
     Socket: TCustomWinSocket);
   procedure Button2Click(Sender: TObject);
   procedure Edit4KeyPress(Sender: TObject; var Key: Char);
   procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
     ErrorEvent: TErrorEvent; var ErrorCode: Integer);
   procedure Button3Click(Sender: TObject);
 private
   { Private declarations }
 public
   Step: Integer;
   MailCount: Integer;
   CurrentMail: Integer;
   NoDel: Boolean;
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
 NoDel := True;
 Step := 0;
 Memo1.Lines.Clear;
 ClientSocket1.Host := Edit1.Text;
 try
   ClientSocket1.Port := StrToInt(Edit4.Text);
 except
   Memo1.Lines.Add("Неверный порт");
   Exit;
 end;
 ClientSocket1.Active := True;
 Memo1.Lines.Add("Соединяюсь с " + Edit1.Text);
 Edit1.Enabled := False;
 Edit2.Enabled := False;
 Edit3.Enabled := False;
 Edit4.Enabled := False;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin

 if MessageBoxEx(Handle, "Удалить все письма из почтового ящика?",
   "Подтверждение...", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2,
   LANG_NEUTRAL) = IDNO then Exit;

 NoDel := False;
 Step := 0;
 Memo1.Lines.Clear;
 ClientSocket1.Host := Edit1.Text;
 try
   ClientSocket1.Port := StrToInt(Edit4.Text);
 except
   Memo1.Lines.Add("Неверный порт");
   Exit;
 end;
 ClientSocket1.Active := True;
 Memo1.Lines.Add("Соединяюсь с " + Edit1.Text);
 Edit1.Enabled := False;
 Edit2.Enabled := False;
 Edit3.Enabled := False;
 Edit4.Enabled := False;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
 Socket: TCustomWinSocket);
var
 Txt: String;
 Parser: TStringList;
begin
 Txt := Socket.ReceiveText;
 //Memo1.Lines.Add("<<< "+Txt);

 if Txt[1] = "-" then
 begin
   Memo1.Lines.Add("Ошибка!!!");
   Socket.SendText("QUIT");
   ClientSocket1.Active := False;
   MailCount := 0;
   CurrentMail := 0;
   Step := 0;
   Exit;
 end;

 if Txt[1] <> "+" then Exit;

 case Step of
   0:
   begin
     Inc(Step);
     Memo1.Lines.Add("Аутентификация:"+#13#10+#13#10+"Отправка имени пользователя...");
     Txt := "USER " + Edit2.Text + #10#13;
     Socket.SendText(Txt);
   end;
   1:
   begin
     Inc(Step);
     Memo1.Lines.Add("Отправка пароля...");
     Txt := "PASS " + Edit3.Text + #10#13;
     Memo1.Lines.Add(">>> "+Txt);
     Socket.SendText(Txt);
   end;
   2:
   begin
     Memo1.Lines.Add("Аутентификация успешна");
     Inc(Step);
     Memo1.Lines.Add("Получения количества писем...");
     Txt := "STAT" + #10#13;
     Socket.SendText(Txt);
   end;
   3:
   begin
     Parser := TStringList.Create;
     Parser.Text := StringReplace(Txt, " ", #13#10, [rfReplaceAll]);
     MailCount := StrToInt(Parser.Strings[1]);
     if MailCount = 0 then
     begin
       Memo1.Lines.Add("Письма в почтовом ящике отсутствуют");
       ClientSocket1.Active := False;
       Exit;
     end;
     Memo1.Lines.Add("Писем в почтовом ящике: " + Parser.Strings[1]);
     Memo1.Lines.Add("Их общий размер: " + Parser.Strings[2] + #13#10);
     Parser.Free;
     if NoDel then
     begin
       ClientSocket1.Active := False;
       Exit;
     end;
     Inc(Step);
     CurrentMail := 1;
     Memo1.Lines.Add("Приступаю к удалению...");
     Memo1.Lines.Add("Запрос на удаление письма №" + IntToStr(CurrentMail) + "...");
     Txt := "DELE " + IntToStr(CurrentMail) + #10#13;
     Socket.SendText(Txt);
   end;
   4:
   begin
     Memo1.Lines.Add("Принят");
     if CurrentMail < MailCount then
     begin
       Inc(CurrentMail);
       Memo1.Lines.Add("Запрос на удаление письма №" + IntToStr(CurrentMail) + "...");
       Txt := "DELE " + IntToStr(CurrentMail) + #10#13;
       Socket.SendText(Txt);
     end
     else
     begin
       Inc(Step);
       Memo1.Lines.Add("Все запросы завершены");
       Memo1.Lines.Add("Подтверждаю удаление...");
       Txt := "QUIT" + #10#13;
       Socket.SendText(Txt);
     end;
   end;
   5:
   begin
     Memo1.Lines.Add("Удаление завершено");
     Memo1.Lines.Add("Удалено писем: " + IntToStr(MailCount));
     ClientSocket1.Active := False;
   end;
 end;
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
 Socket: TCustomWinSocket);
begin
 Memo1.Lines.Add("Соединение установлено");
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
 Socket: TCustomWinSocket);
begin
 Memo1.Lines.Add("Соединение завершено");
 Edit1.Enabled := True;
 Edit2.Enabled := True;
 Edit3.Enabled := True;
 Edit4.Enabled := True;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 ClientSocket1.Active := False;
end;

procedure TForm1.Edit4KeyPress(Sender: TObject; var Key: Char);
begin
 if not(Key in ["0".."9", #8]) then Key := #0;
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
 Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
 var ErrorCode: Integer);
begin
 Memo1.Lines.Add("Ошибка!!!");
 ErrorCode := 0;
end;

end.

---

← →
Sergo ©   (2004-05-20 13:39) [2]

спасибо

---

Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2004.07.18;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.035 c