Popsock.pas

Материал из DRKB



unit PopSock;

{
  CrtSocket for Delphi 32
  Copyright (C) 1999-2001  Paul Toth <tothpaul@free.fr>
  http://tothpaul.free.fr

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

}

interface

uses
  CrtSock, SysUtils;

function OpenMailBox(Server, User, Password: string): Integer;
procedure CloseMailBox;
function MailCount: Integer;
function GetMail(Index: Integer): string;

function MailError: string;

implementation

var
  popin, popout: TextFile;
  last: string;
  Read: Boolean;

function MailError: string;
begin
  Result := last;
end;

function ReadString: string;
begin
  repeat
    ReadLn(popin, Result);
  until (Length(Result) < 4) or (Result[4] <> '-');
  last := Result;
end;

procedure WriteString(s: string);
begin
  WriteLn(popout, s);
end;

function Status: Char;
var
  s: string;
begin
  s := ReadString;
  if s = '' then Status := '?'
  else
    Status := s[1];
end;

function Exec(cmd: string): Char;
begin
  WriteString(cmd);
  Result := Status;
end;

function OpenMailBox(Server, User, Password: string): Integer;
begin
  Result := CallServer(Server, 110);
  if Result > 0 then
  begin
    AssignCrtSock(Result, popin, popout);
    if Status = '+' then
    begin
      if (Exec('USER ' + User) = '+') and (Exec('PASS ' + Password) = '+') then exit;
      Disconnect(Result);
      Result := -3;
    end
    else
    begin
      Disconnect(Result);
      Result := -2;
    end;
  end;
end;

procedure CloseMailBox;
begin
  Exec('QUIT');
  CloseFile(popout);
end;

function MailCount: Integer;
var
  i: Integer;
begin
  Result := -1;
  if Exec('STAT') <> '+' then exit;
  i := pos(' ', Last);
  if i = 0 then exit;
  while Last[i] = ' ' do Inc(i);
  Result := 0;
  while (i < Length(Last)) and (Last[i] in ['0'..'9']) do
  begin
    Result := 10 * Result + Ord(Last[i]) - Ord('0');
    Inc(i);
  end;
end;

function GetMail(Index: Integer): string;
var
  s: string;
begin
  WriteLn(popout, 'RETR ', Index);
  Result := '';
  if Status = '+' then
  begin
    ReadLn(popin, s);
    while s <> '' do
    begin
      Result := Result + s + #13#10; // header
      ReadLn(popin, s);
    end;
    repeat
      Result := Result + s + #13#10; // body
      ReadLn(popin, s);
    until s = '.';
  end;
end;

end.