Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Сети";
Текущий архив: 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.026 c
3-1087899009
min
2004-06-22 14:10
2004.07.18
sql


3-1088067778
1
2004-06-24 13:02
2004.07.18
Поиск по LOCATE


3-1088202854
Bacuc
2004-06-26 02:34
2004.07.18
DBGrid


1-1088682421
Koba
2004-07-01 15:47
2004.07.18
Install


4-1086339472
Rem
2004-06-04 12:57
2004.07.18
Найти запущенную копию приложения и установить на нее фокус





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский