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.