Учебный POP3-Client (пример использования класса TClientSocket

---

Проект в первоначальном виде опубликовал в Инете Н.Карих. Здесь этот проект приспособлен для работы с POP3-сервером.
При отлаживании проекта весьма полезным оказалась программа SocketSpy, разработанная Franois PIETTE (francois.piette@rtfm.be http://www.overbyte.be wilfried@mestdagh.biz ). Эта программа показывает содержимое сообщений, передаваемых от клиента - серверу и обратно. Скачать SocketSpy.rar (180Kb) можно здесь SocketSpy.rar.

На рисунке показано подключение POP3-Client к серверу pop.mail.ru через SocketSpy (незаметно присутствует также Kerio Firewall). В окне Log программы SocketSpy видим сообщения от клиента - серверу и обратно. Обратите внимание на содержимое окошек Host (Address), Port, Login.
Сообщения от клиента поступают в порт 8080 локального компьютера (localhost). Этот порт прослушивает SocketSpy. Он копирует это сообщение в порт 110 удаленного хоста pop.mail.ru. Ответ сервера передается по этой же цепочке в обратном направлении.

Файл Unit4.pas (единственный модуль проекта)

{ Учебный проект.}

unit Unit4;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Button1: TButton;
    Label3: TLabel;
    Edit3: TEdit;
    Label4: TLabel;
    Edit4: TEdit;
    SB1: TStatusBar;
    Memo1: TMemo;
    Label5: TLabel;
    edCmd: TEdit;
    Label6: TLabel;
    btnCmd: TButton;
    procedure Button1Click(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnCmdClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ClientSocket1: TClientSocket;

implementation

{$R *.DFM}
var MySocket: TWinSocketStream; lada: Integer;

procedure TForm1.Button1Click(Sender: TObject);
begin
  {Присваиваем свойствам Host и Port нужные значения}
  ClientSocket1.Host := Edit1.Text;
  ClientSocket1.Port := StrToInt(Edit2.Text);
  {Пытаемся открыть сокет и установить соединение}
  ClientSocket1.Open;
end;

function ReadLine(): string;
var bufbuf: array [0..1023] of char;
   Count,ii: Integer; FromServ:string;
begin
    if MySocket.WaitForData(60000) then
    begin
      FillChar(Bufbuf,1024,0);
      Count:= MySocket.Read(Bufbuf,1024);
      if Count = 0 then
        begin
//        ClientSocket1.Close;
          result:= '';
          exit;
        end;
      FromServ:='';
      for ii:=0 to Count-1 do
        FromServ:= FromServ + BufBuf[ii];
    end else
      ClientSocket1.Close;
   Result:= FromServ;
   lada:= 4;
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
 var login,password,ll,pp,rl: string;  Count1: Integer;
begin
  SB1.SimpleText:= 'Подключился';
  MySocket := TWinSocketStream.Create(Socket,60000);
  {Добавляем к логину и паролю символ перевода строки,
   чтобы сервер смог отделить логин и пароль.}
  Memo1.Clear;
    Repeat
      rl:= rl + ReadLine();
    until pos(#13#10,rl) > 0 ;

  Memo1.Lines.Append('Serv: '+copy(rl,1,length(rl)-2));

  login := 'user ' + Edit3.Text;
  password := 'pass ' + Edit4.Text;
  ll:= login + #13#10;
  pp:= password + #13#10;

  try
    Count1:= MySocket.Write(ll[1],Length(ll));
    Memo1.Lines.Append('Cli :' + login);
//    rl:= ReadLine();
    rl:= '';
    Repeat
      rl:= rl + ReadLine();
    until pos(#13#10,rl) > 0 ;
    Memo1.Lines.Append('Serv: ' + copy(rl,1,length(rl)-2));
    MySocket.Write(pp[1], Length(pp) );
    Memo1.Lines.Append('Cli :' + password);
//    rl:= ReadLine();
    rl:= '';
    Repeat
      rl:= rl + ReadLine();
    until pos(#13#10,rl)  > 0 ;
    Memo1.Lines.Append('Serv: '+copy(rl,1,length(rl)-2));
    Memo1.Lines.Append('Вводите любые команды POP3');
    Memo1.Lines.Append('Например: LIST, RETR 1, TOP 2 5,');
    Memo1.Lines.Append('DELE 2, STAT');
    Memo1.Lines.Append('--- QUIT - выход ------');
    Memo1.Lines.Append(' ');
  except
    SB1.SimpleText:= 'Не подключился';
  end;
end;

procedure TForm1.btnCmdClick(Sender: TObject);
var rl,rl2,cmd,cmd2: string; poza: Integer;
begin
  cmd:= edCmd.Text;
  cmd2:= cmd + #13#10;
  MySocket.Write(cmd2[1], Length(cmd2));
  Memo1.Lines.Append('Cli: ' + cmd);

  rl:= '';

  Repeat
  rl:= rl + ReadLine();
  until pos(#13#10+'.'+#13#10,rl)  > 0 ;
  Memo1.Lines.Append('Serv: '+ rl);

{  Repeat
  showmessage(rl+' '+ IntToStr(length(rl)));
  poza := pos(#13#10,rl);
  if poza < 1 then break;
  rl2:= copy(rl,1,poza-1);
  if rl2 <> '' then
  Memo1.Lines.Append('Serv: '+ rl2) else
  Memo1.Lines.Append('----------');
  delete(rl,1,poza+1);
  until false;  }

//  until rl='.';
//  except
//    showmessage('Ошибка чтения');
//  end;
  Memo1.Lines.Append('<<<<<< Команда исполнена >>>>>>');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ClientSocket1:= TClientSocket.Create(Self);
  with ClientSocket1 do
    begin
      OnConnect:= ClientSocket1Connect;
      Active:= False;
      ClientType:= ctBlocking;
      Port:= 0;
    end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MySocket.Free;
  ClientSocket1.Close;
  ClientSocket1.Free;
end;

(* Пример многопоточности при работе серевера. К этому проекту не относится.
procedure TMyServerThread.ClientExecute;

var
  Stream : TWinSocketStream;
  Buffer : array[0 .. 9] of Char;
begin
  { make sure connection is active }
  while (not Terminated) and ClientSocket.Connected do
  begin
    try
      Stream := TWinSocketStream.Create(ClientSocket, 60000);
      try
        FillChar(Buffer, 10, 0); { initialize the buffer }
        { give the client 60 seconds to start writing }
        if Stream.WaitForData(60000) then

        begin
          if Stream.Read(Buffer, 10) = 0 then { if can’t read in 60 seconds }
            ClientSocket.Close;               { close the connection }
          { now process the request }
          ...
        end
        else
          ClientSocket.Close; { if client doesn’t start, close }
      finally
        Stream.Free;
      end;
    except
      HandleException;
    end;
  end;
end;
*)

end.

Скачать RAR-архив исходников + .exe(380 Кб)