pop3prot.pas

BaiduMp3 search baidu mp3

{*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       Fran鏾is PIETTE
Object:       TPop3Cli class implements the POP3 protocol
              (RFC-1225, RFC-1939)
Creation:     03 october 1997
Version:      2.26
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.
Aug 05, 1998  V2.00 New asynchronous version.
Sep 19, 1998  V2.01 Corrected WSocketDataAvailable to count for the added
              nul byte at the end of buffer.
Nov 28, 1998  V2.02 Corrected exception triggered using highlevel function
              when connection or DNS lookup failed (for example using Open).
Dec 03, 1998  V2.03 Added SetErrorMessage in WSocketSessionConnected.
Dec 22, 1998  V2.04 Handle exception when connecting (will be triggered when
              an invalid port has been given).
Feb 27, 1999  V2.05 Adde State property.
Mar 07, 1999  V2.06 Made public property Connected.
Aug 20, 1999  V2.07 Revised conditional compilation, adapted for BCB4, set
              compile options same as TWSocket.
Dec 26, 1999  V2.08 Makes OnRequestDone properly called after a QUIT command.
              Special thanks to [e-mail] for his work
              about that problem.
Jul 22, 2000  V2.09 Checked for buffer overflow in WSocketDataAvailable
              as suggested by Jeroen Stolting <[e-mail]>
Nov 11, 2000  V2.10 Made ClearErrorMessage public. Cleared ErrorMessage when
              connecting. Thanks to Jeroen Nijk <[e-mail]> for pointing
              to problem.
Nov 25, 2000  V2.11 Converted MD5 digest to lower case before sending to the
              server. Thanks to Poessler Thomas <[e-mail]> who
              found the problem and fix.
Jul 30, 2001  V2.12 Jake Traynham <[e-mail]> found a problem in
              end of line logic in WSocketDataAvailable when random CR are
              inside a message line. Changed logic to take only CRLF pair as
              end of line.
Aug 18, 2001  V2.13  Angus Robertson <[e-mail]> found a problem when
              using the RetrSync and TopSync methods that it's not possible to
              retrieve a body that takes longer than the timeout in
              WaitUntilReady. Timeout has to be reevaluated in TriggerResponse.
Sep 09, 2001  V2.14 Beat Boegli <[e-mail]> added LocalAddr property
              for multihomed hosts.
Jul 06, 2002  V2.15 Added header decoding for RETR command. Added corresponding
              properties such as HeaderFrom, HeaderTo, HeaderSubject,...
Apr 29, 2003  V2.16 Use continuation lines in header.
              Remove trailing space in header lines (such as subject) values.
              Thanks to Christophe Thiaux <[e-mail]> for his help.
              Fixed 'reply-to' (dash was missing).
              Added HeaderInReplyTo property.
May 08, 2003  V2.17 Allow not only TAB but also SPACE for continuation lines.
              Thanks to Christophe Thiaux <[e-mail]> for his help.
Sep 15, 2003  V2.18 Added ICSDEF feature to the source code. Thanks to Marco
              van de Voort <[e-mail]> for his help.
Jan 11, 2004  V2.19 "Piotr Hellrayzer Dalek" <[e-mail]> added
              AuthLogin, CRAM-MD5 and CRAM-SHA1 authentication.
              Fixed a problem when an invalid hostname was given for connect.
Feb 23, 2004  V2.20 Daniel <[e-mail]> added IsServerAPOP method. He
              also cleared FTimeStamp in connect method.
Mar 07, 2004  V2.21 Revised WSocketDataAvailable so that LF alone is allowed
              instead of CRLF pair. This is not RFC compliant but some mail
              server send such lines. It should not hurt any RFC compliant
              server so let's do it... By Holger Lembke.
May 31, 2004  V2.22 Used ICSDEFS.INC the same way as in other units
Aug 23, 2004  V2.23 Use MsgWaitForMultipleObjects in WaitUntilReady to avoid
              consumming 100% CPU while waiting.
Sep 08, 2004  V2.24 Fixed a number of compilation problems when using NOFORMS
              MD5 has been renamed to IcsMD5
Jan 13, 2005  V2.25 In WaitUntilReady, moved MsgWaitForMultipleObjects before
              the call to the message pump and added a few flags for
              MsgWaitForMultipleObjects. This make the loop much efficient.
Feb 21, 2005  V2.26 Fixed WSocketDataAvailable to repeat in case of line
              too long. Thanks to Piotr Hellrayzer.


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit Pop3Prot;

interface

{$B-}           { Enable partial boolean evaluation   }
{$T-}           { Untyped pointers                    }
{$X+}           { Enable extended syntax              }
{$I ICSDEFS.INC}
{$IFDEF DELPHI6_UP}
    {$WARN SYMBOL_PLATFORM   OFF}
    {$WARN SYMBOL_LIBRARY    OFF}
    {$WARN SYMBOL_DEPRECATED OFF}
{$ENDIF}
{$IFNDEF VER80}   { Not for Delphi 1                    }
    {$H+}         { Use long strings                    }
    {$J+}         { Allow typed constant to be modified }
{$ENDIF}
{$IFDEF BCB3_UP}
    {$ObjExportAll On}
{$ENDIF}

uses
    Messages,
{$IFDEF USEWINDOWS}
    Windows,
{$ELSE}
    WinTypes, WinProcs,
{$ENDIF}
{$IFNDEF NOFORMS}
    Forms,
{$ENDIF}
    SysUtils, Classes, WSocket, MimeUtil, WinSock,
{$IFDEF DELPHI5_UP}
    IcsSha1,          { SHA1 code require Delphi 5 and up  }
{$ENDIF}
    IcsMD5;

const
    Pop3CliVersion     = 226;
    CopyRight : String = ' POP3 component (c) 1997-2005 F. Piette V2.26 ';
{$IFDEF VER80}
    { Delphi 1 has a 255 characters string limitation }
    POP3_RCV_BUF_SIZE = 255;
{$ELSE}
    POP3_RCV_BUF_SIZE = 4096;
{$ENDIF}
    WM_POP3_REQUEST_DONE = WM_USER + 1;

type
    Pop3Exception = class(Exception);
    TPop3Display  = procedure(Sender: TObject; Msg : String) of object;
    TPop3ProtocolState  = (pop3Disconnected,  pop3WaitingUser,
                           pop3WaitingPass,   pop3Transaction);
    TPop3State    = (pop3Ready,         pop3DnsLookup,       pop3Connecting,
                     pop3Connected,     pop3InternalReady,
                     pop3WaitingBanner, pop3WaitingResponse, pop3Abort);
    TPop3Request  = (pop3Connect, pop3User, pop3Pass, pop3RPop, pop3Quit,
                     pop3Stat,    pop3List, pop3Retr, pop3Top,  pop3Dele,
                     pop3Noop,    pop3Last, pop3RSet, pop3Uidl, pop3APop,
                     pop3Open,    pop3Auth, pop3Custom);
    TPop3Fct      = (pop3FctNone, pop3FctConnect, pop3FctUser, pop3FctPass,
                     pop3FctRPop, pop3FctQuit,    pop3FctAPop, pop3FctStat,
                     pop3FctList, pop3FctUidl,    pop3FctRetr, pop3FctTop,
                     pop3FctDele, pop3FctNoop,    pop3FctRSet, pop3FctLast);
    TPop3AuthType = (popAuthNone,    popAuthLogin,
                     popAuthCramMD5, popAuthCramSHA1); {HLX}
    TPop3FctSet   = set of TPop3Fct;
    TPop3NextProc = procedure of object;
    TPop3RequestDone        = procedure(Sender  : TObject;
                                        RqType    : TPop3Request;
                                        Error     : Word) of object;
    TPop3Method   = function : boolean of object;

    TCustomPop3Cli = class(TComponent)
    private
        FWSocket            : TWSocket;
        FWindowHandle       : HWND;
        FState              : TPop3State;
        FNextProtocolState  : TPop3ProtocolState;
        FProtocolState      : TPop3ProtocolState;
        FConnected          : Boolean;
        FRequestType        : TPop3Request;
        FRequestDoneFlag    : Boolean;
        FReceiveLen         : Integer;
        FRequestResult      : Integer;
        FStatusCode         : Integer;
        FReceiveBuffer      : array [0..POP3_RCV_BUF_SIZE - 1] of char;
        FNext               : TPop3NextProc;
        FWhenConnected      : TPop3NextProc;
        FFctSet             : TPop3FctSet;
        FFctPrv             : TPop3Fct;
        FHighLevelResult    : Integer;
        FHighLevelFlag      : Boolean;
        FNextRequest        : TPop3NextProc;
        FLastResponseSave   : String;
        FStatusCodeSave     : Integer;
        FRestartFlag        : Boolean;
        FDoneAsync          : TPop3NextProc;
        FMultiLineLine      : TNotifyEvent;
        FMultiLineEnd       : TNotifyEvent;
        FMultiLineProcess   : TNotifyEvent;
        FHost               : String;
        FLocalAddr          : String; {bb}
        FPort               : String;
        FUserName           : String;
        FPassWord           : String;
        FAuthType           : TPop3AuthType;{HLX}
        FLastResponse       : String;
        FErrorMessage       : String;
        FTimeStamp          : String;
        FMsgCount           : Integer;
        FMsgSize            : Integer;
        FMsgNum             : Integer;
        FMsgUidl            : String;
        FMsgLines           : Integer;
        FTag                : LongInt;
        FWaitingOnQuit      : Boolean;
        FHeaderPart         : Boolean;
        FHeaderKeyword      : String;
        FHeaderData         : String;
        FHeaderFrom         : String;
        FHeaderTo           : String;
        FHeaderSubject      : String;
        FHeaderReplyTo      : String;
        FHeaderInReplyTo    : String;
        FHeaderMessageId    : String;
        FHeaderDate         : String;
        FHeaderReturnPath   : String;

        FOnDisplay          : TPop3Display;
        FOnMessageBegin     : TNotifyEvent;
        FOnMessageEnd       : TNotifyEvent;
        FOnMessageLine      : TNotifyEvent;
        FOnListBegin        : TNotifyEvent;
        FOnListEnd          : TNotifyEvent;
        FOnListLine         : TNotifyEvent;
        FOnUidlBegin        : TNotifyEvent;
        FOnUidlEnd          : TNotifyEvent;
        FOnUidlLine         : TNotifyEvent;
        FOnStateChange      : TNotifyEvent;
        FOnRequestDone      : TPop3RequestDone;
        FOnResponse         : TPop3Display;
        FOnSessionConnected : TSessionConnected;
        FOnSessionClosed    : TSessionClosed;
        FOnHeaderEnd        : TNotifyEvent;
    function POP3CliAllocateHWnd(Method: TWndMethod): HWND;
    procedure POP3CliDeallocateHWnd(WHandle: HWND);
    protected
        procedure   ExecAsync(RqType      : TPop3Request;
                              Cmd         : String;
                              NextState   : TPop3ProtocolState;
                              DoneAsync   : TPop3NextProc);
        procedure   NextExecAsync;
        procedure   StartTransaction(OpCode      : String;
                                     Params      : String;
                                     RqType      : TPop3Request;
                                     NextState   : TPop3ProtocolState;
                                     DoneTrans   : TPop3NextProc);
        procedure   StartMultiLine(aOnBegin : TNotifyEvent;
                                   aOnLine  : TNotifyEvent;
                                   aOnEnd   : TNotifyEvent;
                                   aProcess : TNotifyEvent);
        procedure   GetALine;
        procedure   StatDone;
        procedure   ListAllDone;
        procedure   ListSingleDone;
        procedure   UidlAllDone;
        procedure   UidlSingleDone;
        procedure   RetrDone;
        procedure   LastDone;
        procedure   WndProc(var MsgRec: TMessage); virtual;
        procedure   WMPop3RequestDone(var msg: TMessage);
                        message WM_POP3_REQUEST_DONE;
        procedure   WSocketDnsLookupDone(Sender: TObject; Error: Word);
        procedure   WSocketSessionConnected(Sender: TObject; Error: Word);
        procedure   WSocketDataAvailable(Sender: TObject; Error: Word);
        procedure   WSocketSessionClosed(Sender : TObject; Error : WORD);
        procedure   DisplayLastResponse;
        procedure   TriggerDisplay(Msg : String);
        procedure   TriggerSessionConnected(Error : Word); virtual;
        procedure   TriggerSessionClosed(Error : Word);
        procedure   TriggerResponse(Msg : String); virtual;
        procedure   TriggerStateChange; virtual;
        procedure   TriggerRequestDone(Error: Word); virtual;
        function    OkResponse : Boolean;
        procedure   StateChange(NewState : TPop3State);
        procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
        procedure   SetErrorMessage;
        procedure   Display(Msg : String);
        procedure   SendCommand(Cmd : String);
        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);
        procedure   CheckReady;
        procedure   DoHighLevelAsync;
        procedure   AuthLoginNext;
        procedure   AuthLoginPass;
{$IFDEF DELPHI5_UP}
        procedure   AuthCramSha1;
{$ENDIF}
        procedure   AuthCramMd5;
    public
        constructor Create(AOwner : TComponent); override;
        destructor  Destroy; override;
        procedure   Connect; virtual;
        procedure   Open; virtual;
        procedure   Auth; virtual; {HLX}
        procedure   User; virtual;
        procedure   Pass; virtual;
        procedure   RPop; virtual;
        procedure   APop; virtual;
        procedure   Quit; virtual;
        procedure   Stat; virtual;
        procedure   List; virtual;
        procedure   Retr; virtual;
        procedure   Top;  virtual;
        procedure   Dele; virtual;
        procedure   Noop; virtual;
        procedure   Last; virtual;
        procedure   RSet; virtual;
        procedure   Uidl; virtual;
        procedure   Abort; virtual;
        function    IsServerAPOP: Boolean;
        procedure   ClearErrorMessage;
        procedure   HighLevelAsync(RqType : TPop3Request; Fcts : TPop3FctSet);

        property CtrlSocket    : TWSocket            read  FWSocket;
        property Host          : String              read  FHost
                                                     write FHost;
        property LocalAddr     : String              read  FLocalAddr   {bb}
                                                     write FLocalAddr;  {bb}
        property Port          : String              read  FPort
                                                     write FPort;
        property UserName      : String              read  FUserName
                                                     write FUserName;
        property PassWord      : String              read  FPassWord