pop3cli.pas

BaiduMp3 search baidu mp3

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

   +-----------------------------------------------------------------------+
   | THIS IS AN OUTDATED COMPONENT. FOR NEW APPLICATIONS, USE POP3PROT.PAS |
   | SOURCE. THE NEW POP3 COMPONENT IS ASYNCHONOUS AND MUCH FASTER.        |
   | YOU NEED TO CHANGE YOUR APPLICATION BECAUSE NEW COMPONENT HAS NOT     |
   | EXACTLY THE SAME INTERFACE. COMPONENT CLASS NAME HAS BEEN CHANGED     |
   | SO THAT YOU CAN INSTALL BOTH WHILE YOU ARE UPDATING YOUR APPLICATIONS.|
   | THERE IS ALSO A NEW DEMO: MAILRCV.DPR.                                |
   +-----------------------------------------------------------------------+
   | IF YOU REALLY NEED THIS OLD COMPONENT, YOU ALSO NEED AN OLD TWSOCKET! |
   +-----------------------------------------------------------------------+

Author:       Fran鏾is PIETTE
Object:       TPop3Client class implements the POP3 protocol
              (RFC-1225, RFC-1939)
Creation:     03 october 1997
Version:      1.16
EMail:        [e-mail]  http://www.overbyte.be
              [e-mail]      http://www.rtfm.be/fpiette
                                           [e-mail]
Support:      Use the mailing list [e-mail]
              Follow "support" link at http://www.overbyte.be for subscription.
Legal issues: Copyright (C) 1997, 2005 by Fran鏾is PIETTE
              Rue de Grady 24, 4053 Embourg, Belgium. Fax: [phone]
              <[e-mail]>

              This software is provided 'as-is', without any express or
              implied warranty.  In no event will the author be held liable
              for any  damages arising from the use of this software.

              Permission is granted to anyone to use this software for any
              purpose, including commercial applications, and to alter it
              and redistribute it freely, subject to the following
              restrictions:

              1. The origin of this software must not be misrepresented,
                 you must not claim that you wrote the original software.
                 If you use this software in a product, an acknowledgment
                 in the product documentation would be appreciated but is
                 not required.

              2. Altered source versions must be plainly marked as such, and
                 must not be misrepresented as being the original software.

              3. This notice may not be removed or altered from any source
                 distribution.

              4. You must register this software by sending a picture postcard
                 to the author. Use a nice stamp and mention your name, street
                 address, EMail address and any comment you like to say.

Updates:
Sept 09, 1997 Modified TOP to be able to request 0 lines (bug reported by
              [e-mail])
Oct 10, 1997  V1.10. Published ProtocolState property, made TOP command
              complies with RFC-1939 as suggested by [e-mail]
              Implemented the UIDL command.
Oct 11, 1997  V1.11 Implemented the APOP command, but not tested because no
              server available to test it.
              Made internal error message look like POP3 error messages (-ERR)
Oct 28, 1997  V1.12 Modified TWSocket to handle line buffer overflow and
              TPop3Client to handle that in GetMultiLine.
Jan 10, 1998  V1.13 Made FWSocket accessible with a read only property. This
              eases DNSLookup without a supplementary TWSocket.
              Added a Port property.
Apr 01, 1998  V1.14 Adapted for BCB V3
May 05, 1998  V1.15 Changed GetMultiLine to correctly handle double dots at
              line start.
Jun 01, 1998  V1.16 Ben Robinson <[e-mail]> found that Last did'nt
              update MsgNum and MsgSize.


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit pop3cli;

interface

{$B-}           { Enable partial boolean evaluation   }
{$T-}           { Untyped pointers                    }
{$IFNDEF VER80} { Not for Delphi 1                    }
    {$J+}       { Allow typed constant to be modified }
{$ENDIF}
{$IFDEF VER110} { C++ Builder V3.0                    }
    {$ObjExportAll On}
{$ENDIF}

uses
    WinTypes,
    WinProcs,
    SysUtils,
    Messages, 
    Classes,
    Graphics,
    Controls,
    Forms,
    Dialogs,
    Menus,
    WSocket,
    Wait,
    IcsMD5;

const
    Pop3CliVersion = 116;

type
    TPop3Display  = procedure(Sender: TObject; Msg : String) of object;
    TPop3State    = (pop3Disconnected, pop3WaitingUser, pop3WaitingPass, pop3Transaction, pop3Update);
    TPop3Method   = function : boolean of object;
    TPop3Client = class(TComponent)
    private
        FWSocket        : TWSocket;
        FHost           : String;
        FPort           : String;
        FUserName       : String;
        FPassWord       : String;
        FProtocolState  : TPop3State;
        FLastResponse   : String;
        FErrorMessage   : String;
        FTimeStamp      : String;
        FWait           : TWait;
        FTimeout        : Integer;
        FTimeOutFlag    : Boolean;
        FLineTooLong    : Boolean;
        FMsgCount       : Integer;
        FMsgSize        : Integer;
        FMsgNum         : Integer;
        FMsgUidl        : String;
        FMsgLines       : Integer;
        FTag            : LongInt;

        FOnDisplay      : TPop3Display;
        FOnMessageBegin : TNotifyEvent;
        FOnMessageEnd   : TNotifyEvent;
        FOnMessageLine  : TNotifyEvent;
        FOnListBegin    : TNotifyEvent;
        FOnListEnd      : TNotifyEvent;
        FOnListLine     : TNotifyEvent;
        FOnUidlBegin    : TNotifyEvent;
        FOnUidlEnd      : TNotifyEvent;
        FOnUidlLine     : TNotifyEvent;
    protected
        procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
        procedure   ClearErrorMessage;
        procedure   SetErrorMessage;
        procedure   Display(Msg : String);
        procedure   SetWait(Value : TWait);
        function    GetResponse : Boolean;
        procedure   SendCommand(Cmd : String);
        procedure   WaitTimeOut(Sender : TObject);
        procedure   SessionClosed(Sender : TObject; Error : WORD);
        procedure   LineTooLong(Sender : TObject);
        function    ExtractNumbers(var N1 : Integer; var N2 : Integer) : Boolean;
        function    ExtractUidl(var N1 : Integer; var N2 : String) : Boolean;
        procedure   ProcessUidl(Sender : TObject);
        procedure   ProcessList(Sender : TObject);
        function    GetMultiLine(aOnBegin : TNotifyEvent;
                                 aOnLine  : TNotifyEvent;
                                 aOnEnd   : TNotifyEvent;
                                 aProcess : TNotifyEvent) : Boolean;
        function    StartTransaction(OpCode, Params : String) : Boolean;
        function    PassRpop(OpCode : String) : Boolean;
    public
        constructor Create(AOwner : TComponent); override;
        destructor  Destroy; override;
        function    Connect : Boolean;
        function    User    : Boolean;
        function    Pass    : Boolean;
        function    Quit    : Boolean;
        function    Stat    : Boolean;
        function    List    : Boolean;
        function    Retr    : Boolean;
        function    Dele    : Boolean;
        function    Noop    : Boolean;
        function    Last    : Boolean;
        function    Rset    : Boolean;
        function    Top     : Boolean;
        function    Rpop    : Boolean;
        function    Uidl    : Boolean;
        function    Apop    : Boolean;
        property    WSocket : TWSocket read FWSocket;
    published
        property Host : String                 read  FHost
                                               write FHost;
        property Port : String                 read  FPort
                                               write FPort;
        property UserName : String             read  FUserName
                                               write FUserName;
        property PassWord : String             read  FPassWord
                                               write FPassWord;
        property Wait : TWait                  read  FWait
                                               write SetWait;
        property TimeOut : Integer             read  FTimeout
                                               write FTimeout;
        property ErrorMessage : String         read  FErrorMessage;
        property LastResponse : String         read  FLastResponse;
        property ProtocolState : TPop3State    read  FProtocolState;
        {:Updated by the Stat method with the number of
          messages in the maildrop }
        property MsgCount : Integer            read  FMsgCount;
        {:Updated by the Stat method with the total size
          in byte for the messages in the maildrop }
        property MsgSize : Integer             read  FMsgSize;
        {:This is the number of lines to display in the TOP command
          Set to zero if you wants the default value }
        property MsgLines : Integer            read  FMsgLines
                                               write FMsgLines;
        {:This is the message number which must be returned by the Retr
          method. It is also updated by the Last method }
        property MsgNum : Integer              read  FMsgNum
                                               write FMsgNum;
        property MsgUidl : String              read  FMsgUidl;
        property Tag : LongInt                 read  FTag
                                               write FTag;

        property OnDisplay : TPop3Display      read  FOnDisplay
                                               write FOnDisplay;
        property OnMessageBegin : TNotifyEvent read  FOnMessageBegin
                                               write FOnMessageBegin;
        property OnMessageEnd : TNotifyEvent   read  FOnMessageEnd
                                               write FOnMessageEnd;
        property OnMessageLine : TNotifyEvent  read  FOnMessageLine
                                               write FOnMessageLine;
        property OnListBegin : TNotifyEvent    read  FOnListBegin
                                               write FOnListBegin;
        property OnListEnd : TNotifyEvent      read  FOnListEnd
                                               write FOnListEnd;
        property OnListLine : TNotifyEvent     read  FOnListLine
                                               write FOnListLine;
        property OnUidlBegin : TNotifyEvent    read  FOnUidlBegin
                                               write FOnUidlBegin;
        property OnUidlEnd : TNotifyEvent      read  FOnUidlEnd
                                               write FOnUidlEnd;
        property OnUidlLine : TNotifyEvent     read  FOnUidlLine
                                               write FOnUidlLine;
    end;

procedure Register;

implementation


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFDEF VER80}
procedure SetLength(var S: string; NewLength: Integer);
begin
    S[0] := chr(NewLength);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function RTrim(Str : String) : String;
var
    i : Integer;
begin
    i := Length(Str);
    while (i > 0) and (Str[i] = ' ') do
        i := i - 1;
    Result := Copy(Str, 1, i);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function LTrim(Str : String) : String;
var
    i : Integer;
begin
    if Str[1] <> ' ' then             { Petite optimisation: pas d'espace   }
        Result := Str
    else begin
        i := 1;
        while (i <= Length(Str)) and (Str[i] = ' ') do
            i := i + 1;
        Result := Copy(Str, i, Length(Str) - i + 1);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function Trim(Str : String) : String;
begin
    Result := LTrim(Rtrim(Str));
end;
{$ENDIF}


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function stpblk(PValue : PChar) : PChar;
begin
    Result := PValue;
    while Result^ in [' ', #9, #10, #13] do
        Inc(Result);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function atoi(PValue : PChar) : Integer;
begin
    Result := 0;
    PValue := stpblk(PValue);
    while PValue^ in ['0'..'9'] do begin
        Result := Result * 10 + ord(PValue^) - ord('0');
        Inc(PValue);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TPop3Client.Create(AOwner : TComponent);
begin
    inherited Create(AOwner);
    FWSocket                 := TWSocket.Create(nil);
    FWSocket.OnSessionClosed := SessionClosed;
    FWSocket.OnLineTooLong   := LineTooLong;
    FTimeout                 := 15;
    FProtocolState           := pop3Disconnected;
    FPort                    := 'pop3';
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TPop3Client.Destroy;
begin
    if Assigned(FWSocket) then begin
        FWSocket.Destroy;
        FWSocket := nil;
    end;
    inherited Destroy;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.Connect : Boolean;
var
    I, J : Integer;
begin
    Result     := FALSE;
    FTimeStamp := '';

    if FWait = nil then begin
        FErrorMessage := '-ERR No wait object';
        Display(FErrorMessage);
        Exit;
    end;

    FWait.OnTimeout := WaitTimeout;
    FTimeOutFlag    := FALSE;

    if FProtocolState > pop3Disconnected then begin
        { Already connected, it's ok }
        Result := TRUE;
        Exit;
    end;

    ClearErrorMessage;

    if Length(FHost) = 0 then begin
        FErrorMessage := '-ERR No host specified';
        Display(FErrorMessage);
        Exit;
    end;

    try
        FWSocket.Proto           := 'tcp';
        FWSocket.Port            := FPort;
        FWSocket.Addr            := FHost;
        FWSocket.OnDataAvailable := nil;

        FWSocket.Connect;
    except
        on E:ESocketException do begin
            FErrorMessage := '-ERR ' + E.Message;
            Exit;
        end;
    end;

    if not FWSocket.Wait(FTimeout, wsConnected) then begin
        FErrorMessage := '-ERR Can''t connect to host ''' + FHost + '''';
        Display(FErrorMessage);
        FWSocket.Close;
        Exit;
    end;
    Display('Connected with POP3 server');

    if not GetResponse then begin
        SetErrorMessage;
        FWSocket.Close;
        Exit;
    end;

    I := Pos('<', FLastResponse);
    J := Pos('>', Copy(FLastResponse, I, Length(FLastREsponse)));
    if (I > 0) and (J > 0) then
        FTimeStamp := Copy(FLastResponse, I, J);

    FProtocolState := pop3WaitingUser;
    Result         := TRUE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.Quit : Boolean;
begin
    if FProtocolState = pop3Disconnected then begin
        { Not connected, it's ok }
        Result := TRUE;
        Exit;
    end;

    try
        SendCommand('QUIT');
        Result := GetResponse;
    except
        Result := FALSE;
    end;

    FProtocolState := pop3Disconnected;
    FWSocket.Close;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.User : Boolean;
begin
    Result := FALSE;
    if FProtocolState > pop3WaitingUser then begin
        FErrorMessage := '-ERR USER command invalid now';
        Display(FErrorMessage);
        Exit;
    end;

    if (FProtocolState = pop3Disconnected) and (not Connect) then
        Exit;

    SendCommand('USER ' + Trim(FUserName));
    if not GetResponse then
        Exit;
    Result         := TRUE;
    FProtocolState := pop3WaitingPass;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TPop3Client.Apop : Boolean;
begin
    Result := FALSE;
    if FProtocolState > pop3WaitingUser then begin
        FErrorMessage := '-ERR APOP command invalid now';
        Display(FErrorMessage);
        Exit;
    end;

    if (FProtocolState = pop3Disconnected) and (not Connect) then