Email服务器

开发平台：
Delphi

Pop3Server.pas：源码内容
							unit Pop3Server;
(******************************************************************************)
(*                                                                            *)
(* Pop3 Server Objects                                                        *)
(* Part of Hermes SMTP/POP3 Server.                                           *)
(* Copyright(C) 2000 by Alexander J. Fanti, All Rights Reserver Worldwide.    *)
(*                                                                            *)
(* Contains: TPop3Server, TPop3Connection                                     *)
(*                                                                            *)
(* Created January 11, 2000 by Alexander J. Fanti.  See License.txt           *)
(*                                                                            *)
(* Depends on: DataU1 (Pop3 User Information, Pop3 Mail Information Object)   *)
(*                                                                            *)
(* Also Uses: WSocket, MD5 (Francois Piette Internet Component Suite)         *)
(*                                                                            *)
(* Used by: Main                                                              *)
(*                                                                            *)
(* Implememtation Note: No support for UIDL.  This requires persistant state  *)
(*                                            info for messages I don't want  *)
(*                                            to store                        *)
(*                      APOP support depends on Francois' MD5 code.           *)
(*                      Refer to RFC 1725                                     *)
(* Description:                                                               *)
(* TPop3Server - This server object manages the Pop3 connections, controls    *)
(*               listening for connections, and accepts them.                 *)
(* TPop3Connection - The Connection object is the real server.  It handles    *)
(*                   the individual Pop3 connection, and any requests by the  *)
(*                   connected user.                                          *)
(*                                                                            *)
(*  Revisions: 1/12/2000  AJF  Commented                                      *)
(*  Revisions: 1/25/2000  AJF  Commented                                      *)
(*                                                                            *)
(******************************************************************************)
interface
uses Classes, SysUtils, FileCtrl, ExtCtrls, INIFiles, Messages, Windows,
     WSocket, MD5, {Francois Components, MD5 for APOP only}
     DataU1;
const
  CRLF = #13 + #10;
  WM_FREECONNECTION = WM_USER + 100;
type
  TPop3Connection = class;
  TPop3Server_ErrorCode = (pec_Bad_Mailbox_Path, pec_CantListen,
                           pec_SocketError);
  TPop3Server_StateChange = procedure(Sender : TObject; Active : Boolean;
                                      OpenConnections : Longint) of Object;
  TPop3Server_StatusUpdate = procedure(Sender : TObject; Status : String;
                                       Level : Integer) of Object;
  TPop3Server_Error = procedure(Sender : TObject;
                                ErrorCode : TPop3Server_ErrorCode) of Object;
  TPop3Server = class(TWHComponent)
  private
    FSocket : TWSocket;        // Socket for Listening for Pop3 requests
    ConnectionList : TList;    // List of TPop3Connection objects currently open
    // Bind address, Port, server name, mailboxpath and other Pop3 server
    // settings come straight from global INI object
    FActive : Boolean;                          // True when server is listening
    FOnStateChange : TPop3Server_StateChange;   // Event Ptr for OnChangeState
    FOnStatusUpdate : TPop3Server_StatusUpdate; // Event Ptr for StatusUpdate
    FOnError : TPop3Server_Error;               // Event Ptr for Server Error
    // We use this to let the connection object tell us when it's finished
    // so we can free it!
    procedure WindowsMessage(Sender : TObject; Msg: TMessage);
    function GetActive : Boolean;            // Read if server's active
    function GetConnectionCount : Longint;   // Read Pop3Connection Count
    // Socket procedures for Listening socket
    procedure SocketSessionAvailable(Sender: TObject; Error: Word);
    procedure SocketChangeState(Sender: TObject;
                                OldState, NewState: TSocketState);
    procedure SocketSessionClosed(Sender: TObject; Error: Word);
    procedure SocketError(Sender: TObject);
    procedure SocketBgException(Sender: TObject; E: Exception;
                                var CanClose: Boolean);
    // Triggered when TPop3Connection fires a StatusUpdate event
    procedure Pop3ConnectionStatusUpdate(Sender : TObject; Status : String;
                                         Level : Integer);
    procedure CloseConnection(AConnection : TPop3Connection);
    procedure CloseAllConnections;
  public
    constructor Create(AOwner : TComponent); Override;
    destructor Destroy; Override;
    // Methods
    procedure Listen;   // Listen for Pop3 Connections
    procedure Stop;     // Stop listening for Pop3 Connections
    procedure Shutdown; // Stop listening and close all open Pop3 Connections
    // Used by TPop3Connection to see if "MailBox Locked" meaning someone is
    // already talking to the mailbox (that user's logged in from elsewhere)
    function IsUserAlreadyConnected(OpenConn : TPop3Connection;
                                    User : String) : Boolean;
    procedure ConnectionInactivityTimeout(Minutes : Integer);
              // Check all connections for inactivity
    // Properties
    property Active : Boolean read GetActive;
    property Count : Longint read GetConnectionCount;
    // Events
    property OnStateChange : TPop3Server_StateChange    // Fired on Server State
             read FOnStateChange write FOnStateChange;  // Change (Active)
    property OnStatusUpdate : TPop3Server_StatusUpdate    // Fired on Status
             read FOnStatusUpdate write FOnStatusUpdate;  // Update
    property OnError : TPop3Server_Error                // Fired on Server Error
             read FOnError write FOnError;
  end;
  TPop3Connection_State = (pcs_AUTHENTICATION_WAITUSER,
                           pcs_AUTHENTICATION_WAITPASS,
                           pcs_TRANSACTION, pcs_UPDATE);
  TPop3Connection_StatusUpdate = procedure(Sender : TObject; Status : String;
                                           Level : Integer) of Object;
  TPop3Connection = class(TComponent)
  private
    FServer : TPop3Server;
    FSocket : TWSocket;        // Socket for Talking to Pop3 User
    FBufferStr : String;       // To buffer commands from Socket
    FState  : TPop3Connection_State;  // State of Pop3 Connection
    FLastActivity : TDateTime; // Time of last activity (for timeout)
    FServerMD5ID : String;            // The String send on connect (for APOP)
    FUserID   : String;               // User ID (of user logged in)
    FUserInfo : TPop3UserInformation; // Pop3 User Information (like password)
                                      // See DataU1
    FMailInfo : TPop3MailInformation; // User's Pop3 Mail information (count...)
                                      // See DataU1
    FOnStatusUpdate : TPop3Connection_StatusUpdate; // Event Ptr for StatusUpd.
    procedure StatusUpdate(Status : String; Level : Integer);
              // Used internally to Trigger Status Update
    procedure ProcessRequest(UserRequest : String);  // Process Pop3 Request
    // Socket Procedures for Connected Socket
    procedure SocketDataAvailable(Sender: TObject; Error: Word);
    procedure SocketDataSent(Sender: TObject; Error: Word);
    procedure SocketSessionClosed(Sender: TObject; Error: Word);
    procedure SocketError(Sender: TObject);
    procedure SocketBgException(Sender: TObject; E: Exception;
                                var CanClose: Boolean);
    procedure Close;                          // Close connection and terminate
  public
    constructor Create(AOwner : TPop3Server);
    destructor Destroy; Override;
    procedure Accept(SocketHandle : Integer); // Pop3 Connection
    property User : String read FUserID;      // Connected User
    property LastActivity : TDateTime read FLastActivity;
    property OnStatusUpdate : TPop3Connection_StatusUpdate  // Fired on Status
             read FOnStatusUpdate write FOnStatusUpdate;    // Update
  end;
implementation
(******************************************************************************)
(*                                                                            *)
(*  START POP3 Server Object                                                  *)
(*                                                                            *)
(* This Object listens for connections, accepts them and tracks them.  It     *)
(* also reports on them, and can drop them.                                   *)
(*                                                                            *)
(******************************************************************************)
constructor TPop3Server.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  OnWindowsMessage := WindowsMessage;
  // Initialize variables
  ConnectionList := TList.Create;
  FActive := False;
  // Listening Socket Create and Setup
  FSocket := TWSocket.Create(Self);
  FSocket.OnSessionAvailable := SocketSessionAvailable;
  FSocket.OnChangeState      := SocketChangeState;
  FSocket.OnSessionClosed    := SocketSessionClosed;
  FSocket.OnError            := SocketError;
  FSocket.OnBgException      := SocketBgException;
end;
procedure TPop3Server.WindowsMessage(Sender : TObject; Msg: TMessage);
begin
  if Msg.Msg = WM_FREECONNECTION then
    CloseConnection(TPop3Connection(Msg.WParam));
end;
destructor TPop3Server.Destroy;
begin
  if Assigned(FSocket) then begin
    FSocket.Destroy;
    FSocket := nil;
  end;
  CloseAllConnections;
  ConnectionList.Free;
  inherited Destroy;
end;
procedure TPop3Server.CloseConnection(AConnection : TPop3Connection);
var
  x : Longint;
  Connection : TPop3Connection;
begin
  for x := ConnectionList.Count -1 downto 0 do begin
    Connection := TPop3Connection(ConnectionList[x]);
    if Connection = AConnection then begin
      ConnectionList.Delete(x);
      AConnection.Free;
      if Assigned(FOnStateChange) then
        OnStateChange(Self, FSocket.State = wsListening, ConnectionList.Count);
    end;
  end;
end;
procedure TPop3Server.CloseAllConnections;
var
  x : Longint;
  Connection : TPop3Connection;
begin
  for x := ConnectionList.Count -1 downto 0 do begin
    Connection := TPop3Connection(ConnectionList[x]);
    CloseConnection(Connection);
  end;
end;
function TPop3Server.GetActive : Boolean;
begin
  FActive := FSocket.State = wsListening;
  Result := FActive;
end;
function TPop3Server.GetConnectionCount : Longint;
begin
  Result := ConnectionList.Count;
end;
function TPop3Server.IsUserAlreadyConnected(OpenConn : TPop3Connection;
                                            User : String) : Boolean;
var
  x : Longint;
  Connection : TPop3Connection;
begin
  Result := False;
  // See if there's a connection (other than the requesting one) for this user
  // This is how we determine if the mailbox is "locked"
  for x := ConnectionList.Count -1 downto 0 do begin
    Connection := TPop3Connection(ConnectionList[x]);
    if (LowerCase(Connection.User) = LowerCase(User)) and
       (Connection <> OpenConn) then Result := True;
  end;
end;
procedure TPop3Server.ConnectionInactivityTimeout(Minutes : Integer);
const
  HOUR = 0.04167;
  MINUTE = 0.00069;
var
  x : Longint;
  Connection : TPop3Connection;
  DT : TDateTime;
begin
  // See if there's a connection that hasn't been active for a while
  if Minutes > 0 then begin
    for x := ConnectionList.Count -1 downto 0 do begin
      Connection := TPop3Connection(ConnectionList[x]);
      DT := Now - Connection.LastActivity;
      if DT > (Minutes * MINUTE) then begin
        if Assigned(FOnStatusUpdate) then
          OnStatusUpdate(Self, '<POP3 ID ' + IntToStr(Integer(Connection)) + '> ' +
                         'Closing due to inactivity (' + IntToStr(Minutes) + ' minutes).',
                         STAT_SERVERERROR);
        CloseConnection(Connection);
      end;
    end;
  end;
end;
procedure TPop3Server.Listen;
begin
  FSocket.Close;
  FSocket.Addr := INI.Pop3_BindAddress;
  FSocket.Port := IntToStr(INI.Pop3_Port);
  FSocket.Proto := 'TCP';
  FSocket.Listen;
end;
procedure TPop3Server.Stop;
begin
  FSocket.Close;
end;
procedure TPop3Server.Shutdown;
begin
  Stop;  // Stop listening for new connections
  CloseAllConnections;
end;
procedure TPop3Server.SocketSessionAvailable(Sender: TObject; Error: Word);
var
  Connection : TPop3Connection;
begin
  // Pop3 Seccion Request
  // Create a new Pop3 Connection and accept the request to it...
  Connection := TPop3Connection.Create(Self);
  Connection.OnStatusUpdate := Pop3ConnectionStatusUpdate;
  ConnectionList.Add(Connection);  // Keep track of the connection (add to list)
  if Assigned(FOnStateChange) then
    OnStateChange(Self, FSocket.State = wsListening, ConnectionList.Count);
  Connection.Accept(FSocket.Accept);
end;
procedure TPop3Server.SocketChangeState(Sender: TObject;
                                        OldState, NewState: TSocketState);
var
  OldActive : Boolean;
begin
  OldActive := FActive;
  FActive := FSocket.State = wsListening;
  if (OldActive <> FActive) and Assigned(FOnStateChange) then
    OnStateChange(Self, FSocket.State = wsListening, ConnectionList.Count);
end;
procedure TPop3Server.SocketSessionClosed(Sender: TObject; Error: Word);
begin
  if Assigned(FOnStateChange) then
    OnStateChange(Self, FSocket.State = wsListening, ConnectionList.Count);
end;
procedure TPop3Server.SocketError(Sender: TObject);
var
  Error : Integer;
begin
  // Socket error.  This could be because the listening socket can't bind to
  // the port (10048) or something else.  In fact, bind failure is so common,
  // I'll treat it seperately.
  Error := FSocket.LastError;
  if Error = 10048 then begin  // Unable to bind to port
    if Assigned(FOnStatusUpdate) then
      OnStatusUpdate(Self, 'Can''t Bind to ' + INI.Pop3_BindAddress +':' +
                           IntToStr(INI.Pop3_Port), STAT_SERVERERROR);
    if Assigned(FOnError) then OnError(Self, pec_CantListen);
  end else begin      // Other Error
    if Assigned(FOnStatusUpdate) then
      OnStatusUpdate(Self, 'Error #' + IntToStr(FSocket.LastError),
                           STAT_SERVERERROR);
    if Assigned(FOnError) then OnError(Self, pec_SocketError);
  end;
end;
procedure TPop3Server.SocketBgException(Sender: TObject; E: Exception;
                                        var CanClose: Boolean);
begin
  // Critical Socket Error...
  // This is because something caused an Exception during the socket's
  // processing while it was in an event handler.
  // If the program is good, this will never happen... but...
  CanClose := False;
  if Assigned(FOnStatusUpdate) then
    OnStatusUpdate(Self, 'Unknown BG Exception', STAT_CRITICALERROR);
  if Assigned(FOnError) then OnError(Self, pec_SocketError);
end;
procedure TPop3Server.Pop3ConnectionStatusUpdate(Sender : TObject;
                                                 Status : String;
                                                 Level : Integer);
begin
  // the Pop3Connection has something to report... I'll pass it on,
  // but add where I got it from...
  if Assigned(FOnStatusUpdate) then
    OnStatusUpdate(Self, '<POP3 ID ' + IntToStr(Integer(Sender)) + '> ' +
                         Status, Level);
end;
(******************************************************************************)
(*                                                                            *)
(*  STOP  POP3 Server Object                                                  *)
(*                                                                            *)
(******************************************************************************)
(******************************************************************************)
(*                                                                            *)
(*  START POP3 Connection Object                                              *)
(*                                                                            *)
(* The actual Pop3 server protocols are implemented here.  This is the real   *)
(* Pop3 server code. We try to handle all Pop3 requests here and act on       *)
(* whatever we get.                                                           *)
(*                                                                            *)
(* Note: not all commands are implemented.                                    *)
(*                                                                            *)
(******************************************************************************)
constructor TPop3Connection.Create(AOwner : TPop3Server);
begin
  inherited Create(AOwner);
  FServer := TPop3Server(AOwner);
  // Initialize variables
  FLastActivity := Now;
  FState := pcs_AUTHENTICATION_WAITUSER;
  FServerMD5ID := '';
  FUserID := '';
  FUserInfo := TPop3UserInformation.Create;
  FMailInfo := TPop3MailInformation.Create;
  // Connecting Socket Create and Setup
  FSocket := TWSocket.Create(Self);
  FSocket.OnDataAvailable    := SocketDataAvailable;
  FSocket.OnDataSent         := SocketDataSent;
  FSocket.OnSessionClosed    := SocketSessionClosed;
  FSocket.OnError            := SocketError;
  FSocket.OnBgException      := SocketBgException;
  FBufferStr := '';
end;
destructor TPop3Connection.Destroy;
begin
  FUserInfo.Free;
  FMailInfo.Free;
  if Assigned(FSocket) then begin
    FSocket.Destroy;
    FSocket := nil;
  end;
  inherited Destroy;
end;
procedure TPop3Connection.StatusUpdate(Status : String; Level : Integer);
begin
  if Assigned(FOnStatusUpdate) then OnStatusUpdate(Self, Status, Level);
end;
procedure TPop3Connection.Accept(SocketHandle : Integer);
begin
  FSocket.Dup(SocketHandle);
  StatusUpdate('Accepted', STAT_CONNECTIONEVENT);
  // Initialize Connection State
  FState := pcs_AUTHENTICATION_WAITUSER;
  if FSocket.State = wsConnected then begin
    StatusUpdate('Connected', STAT_CONNECTIONEVENT);
    // Determine Server Info for possible APOP command (MD5 ID)
    FServerMD5ID := '<' + IntToStr(Integer(Self)) + '.' +
                    FloatToStr(Now) + '@' + INI.ServerName + '>';
    // Send Greeting
    case INI.Banner_Level of
      bannerlevel_NameVersionService : FSocket.SendStr('+OK ' + 'Hermes ' + AppVersion + ' POP3 Ready. ' + FServerMD5ID + CRLF);
      bannerlevel_NameService        : FSocket.SendStr('+OK ' + 'Hermes POP3 Ready. ' + FServerMD5ID + CRLF);
      bannerlevel_Service            : FSocket.SendStr('+OK ' + 'POP3 Ready. ' + FServerMD5ID + CRLF);
      else FSocket.SendStr('+OK ' + 'Hermes POP3 Ready. ' + FServerMD5ID + CRLF);
    end;
  end else begin
    //
    // DEBUG
    //
    // Is there ever a time we could accept the connection and then not be
    // connected?  If this happened, we assume the SessionClosed event would
    // fire, thereby closing our connection and object.
    //
    // This is also seen in the TSmtpConnection Object
  end;
end;
procedure TPop3Connection.Close;
begin
  // We want to close.
  // If the socket is open, close it... if not,
  // send the message that will free this connection object
  if FSocket.State <> wsClosed then FSocket.Close
    else PostMessage(FServer.Handle, WM_FREECONNECTION, Integer(Self), 0);
end;
// procedure SocketSessionConnected(Sender: TObject; Error: Word);
// This is not called when we accept a connection
procedure TPop3Connection.SocketDataAvailable(Sender: TObject; Error: Word);
var
  x : Longint;
  len : Integer;                    // Length of data accepted from the socket
  Buffer : Array[0..1023] of Char;  // buffer of data we'll accept from socket
                                    // we add this data to the socket's command
                                    // buffer (FBufferStr) and then parse it
                                    // for CRLF to seperate out commands we
                                    // need to act on.
  UserRequest : String;             // the command we got from the buffer
begin
  // Data is available from the socket for processing.
  // we'll receive the data, and buffer it until we get a CRLF,
  // indicating the end of some sort of command from the client
  len := FSocket.Receive(@Buffer[0], 1024);
  FLastActivity := Now;  // We have activity...
  // add to Command Buffer (FBufferStr)
  for x := 0 to len -1 do FBufferStr := FBufferStr + Buffer[x];
  // Process buffer (look for CRLF) and process each command
  while Pos(CRLF, FBufferStr) > 0 do begin
    UserRequest := Copy(FBufferStr, 1, Pos(CRLF, FBufferStr) -1);
    FBufferStr := Copy(FBufferStr, Pos(CRLF, FBufferStr) +2,
                       Length(FBufferStr));
    // Process a command
    ProcessRequest(UserRequest);
  end;
end;
procedure TPop3Connection.SocketDataSent(Sender: TObject; Error: Word);
begin
  FLastActivity := Now;  // We have activity...
end;
procedure TPop3Connection.ProcessRequest(UserRequest : String);
var
  Command : String;                            // User Command
  Parameter1, Parameter2 : String;             // Possible Command Parameters
  Para_MessageID, Para_LineCount : Longint;            // Parameters specific
  Para_UserName, Para_Password, Para_Digest : String;  // to given commands
  x, y : Longint;
  UserValid, PasswordValid : Boolean;  // Is the requested user / pwd valid?
  HeaderBreak : Longint;  // The Index of the blank line of the header (for TOP)
  MailItem : PPop3MailEntry;  // Pointer to a mail item (see DataU1)
  SL : TStringList;  // Temporary string list for holding message to send
begin
  if UserRequest <> '' then begin
    // Seperate out command from parameters to command
    Command := UpperCase(Trim(UserRequest));
    Parameter1 := '';
    if Pos(' ', UserRequest) > 0 then begin
      Command := UpperCase(Trim(Copy(UserRequest, 1, Pos(' ', UserRequest))));
      Parameter1 := Trim(Copy(UserRequest, Pos(' ', UserRequest),
                              Length(UserRequest)));
    end;
    StatusUpdate('Command: ' + Command, STAT_CONNECTIONEVENT);
    if (Command = 'USER') and
       (FState = pcs_AUTHENTICATION_WAITUSER) and
       (FSocket.State = wsConnected) then begin
      // User wants to log in... giving us User ID
      // Determine User ID
      Para_UserName := Parameter1;
      UserValid := INI.User_Exists(Para_UserName);
      // Do we create user on demand?
      if (not UserValid) and (INI.Pop3_CreateUserOnDemand) then
        if INI.User_Create(Para_UserName) then UserValid := True;
      if UserValid then begin
        FUserID := Para_UserName;
        // Fetch user information (password and whatnot)
        FUserInfo.LoadFromFile(FUserID);
        FState := pcs_AUTHENTICATION_WAITPASS;
        FSocket.SendStr('+OK Send Password' + CRLF);
        StatusUpdate('User ' + FUserID + ' OK', STAT_COMMANDEVENT);
      end else begin
        FSocket.SendStr('-ERR Unknown User' + CRLF);
        StatusUpdate('User ' + FUserID + ' BAD', STAT_COMMANDERROR);
      end;
    end else
    if (Command = 'PASS') and
       (FState = pcs_AUTHENTICATION_WAITPASS) and
       (FSocket.State = wsConnected) then begin
      // User whats to finish logging in... give us password
      // Determine user password
      Para_Password := Parameter1;
      PasswordValid := (FUserInfo.Password = Para_Password) and
                       (FUserInfo.Password <> '');
      // Do we create password on demand?
      if (not PasswordValid) and
         (INI.Pop3_CreateUserPasswordOnDemand) then begin
        FUserInfo.Password := Para_Password;
        FUserInfo.SaveToFile(FUserID);
        PasswordValid := True;
      end;
      if PasswordValid then begin
        // Be sure we havn't got another connection to this user already!
        if FServer.IsUserAlreadyConnected(Self, FUserID) then begin
          // Mailbox locked by same user on different connection
          FState := pcs_AUTHENTICATION_WAITUSER;
          FSocket.SendStr('-ERR Cannot Lock Mailbox' + CRLF);
          StatusUpdate('User Password OK, but mailbox locked.',
                       STAT_COMMANDERROR);
        end else begin
          // Mailbox available, Get Mailbox information
          FState := pcs_TRANSACTION;
          FMailInfo.ReadFolder(FUserID);
          FSocket.SendStr('+OK ' + IntToStr(FMailInfo.Count) + ' ' +
                          IntToStr(FMailInfo.ByteCount) + CRLF);
          StatusUpdate('User Password OK', STAT_COMMANDEVENT);
        end;
      end else begin
        // User Password not good
        FState := pcs_AUTHENTICATION_WAITUSER;
        FSocket.SendStr('-ERR Password Invalid' + CRLF);
        StatusUpdate('User Password BAD', STAT_COMMANDERROR);
      end;
    end else
    if (Command = 'APOP') and                            // Optional
       (FState = pcs_AUTHENTICATION_WAITUSER) and
       (FSocket.State = wsConnected) then begin
      // User wants to login with APOP
      // Get User ID and Digest
      Para_UserName := Parameter1;
      Para_Digest := '';
      if Pos(' ', Parameter1) > 0 then begin
        Para_UserName := UpperCase(Trim(Copy(Parameter1, 1,
                                             Pos(' ', Parameter1))));
        Para_Digest := Trim(Copy(Parameter1, Pos(' ', Parameter1),
                                 Length(Parameter1)));
      end;
      if (Para_UserName <> '') and (Para_Digest <> '') then begin
        UserValid := DirectoryExists(INI.MailBoxPath + '' + Para_UserName);
        if UserValid then begin
          FUserID := LowerCase(Para_UserName);
          // Can't create a user on demand without a password
          FUserInfo.LoadFromFile(FUserID);
          // Check digest
          if StrMD5(FServerMD5ID + FUserInfo.Password) = Para_Digest then
          begin
            // Be sure we havn't got another connection to this user already!
            if FServer.IsUserAlreadyConnected(Self, FUserID) then begin
              // Mailbox locked by same user on different connection
              FState := pcs_AUTHENTICATION_WAITUSER;
              FSocket.SendStr('-ERR Cannot Lock Mailbox' + CRLF);
              StatusUpdate('User Password OK, but mailbox locked.',
                           STAT_COMMANDERROR);
            end else begin
              // Mailbox available, Get Mailbox information
              FState := pcs_TRANSACTION;
              FMailInfo.ReadFolder(FUserID);
              FSocket.SendStr('+OK ' + IntToStr(FMailInfo.Count) + ' ' +
                              IntToStr(FMailInfo.ByteCount) + CRLF);
              StatusUpdate('User Password OK', STAT_COMMANDEVENT);
            end;
          end else begin
            // MD5 digest didn't match... user not accepted
            FState := pcs_AUTHENTICATION_WAITUSER;
            FSocket.SendStr('-ERR Bad Digest' + CRLF);
            StatusUpdate('User Digest BAD', STAT_COMMANDERROR);
          end;
        end else begin
          // User Name not recognized
          FSocket.SendStr('-ERR Unknown User' + CRLF);
          StatusUpdate('User ' + Para_UserName + ' BAD', STAT_COMMANDERROR);
        end;
      end else begin
        // We need a name and digest
        FSocket.SendStr('-ERR Command Incomplete' + CRLF);
        StatusUpdate('Command missing parameters', STAT_COMMANDERROR);
      end;
    end else
    if (Command = 'QUIT') and
       (FSocket.State = wsConnected) then begin
      if FState = pcs_TRANSACTION then begin
        // Enter "Update" state and Delete marked messages
        x := FMailInfo.DeleteMarkedMessages;
        FSocket.SendStr('+OK ' + IntToStr(x) + ' Messages Deleted.  Bye.' +
                        CRLF);
        StatusUpdate('Updated', STAT_CONNECTIONEVENT);
      end else begin
        // No update, just goodbye
        FSocket.SendStr('+OK Signing Off' + CRLF);
        StatusUpdate('NOT Updated', STAT_CONNECTIONEVENT);
      end;
      // Close socket, this will eventually terminate the component
      FSocket.Close;
    end else
    if (Command = 'STAT') and
       (FState = pcs_TRANSACTION) and
       (FSocket.State = wsConnected) then begin
      // Get status of mailbox
      FSocket.SendStr('+OK ' + IntToStr(FMailInfo.Count) + ' ' +
                      IntToStr(FMailInfo.ByteCount) + CRLF);
      StatusUpdate('Status: ' + IntToStr(FMailInfo.Count) + ' ' +
                   IntToStr(FMailInfo.ByteCount), STAT_COMMANDEVENT);
    end else
    if (Command = 'LIST') and
       (FState = pcs_TRANSACTION) and
       (FSocket.State = wsConnected) then begin
      // List info on one or more messages
      // Get message number if avaiable
      if Parameter1 <> '' then begin
        // We want info on a single message
        try
          Para_MessageID := StrToInt(Parameter1);
        except
          on E: Exception do Para_MessageID := -1
        end;
        // Find the message
        MailItem := FMailInfo.Find(Para_MessageID);
        if MailItem = nil then begin
          FSocket.SendStr('-ERR No Such Message' + CRLF);
          StatusUpdate('No such message', STAT_COMMANDERROR);
        end else
        if MailItem.MarkForDelete then begin
          FSocket.SendStr('-ERR Message Deleted' + CRLF);
          StatusUpdate('Message Deleted', STAT_COMMANDERROR);
        end else begin
          FSocket.SendStr('+OK ' + IntToSTr(MailItem.Number) + ' ' +
                          IntToSTr(MailItem.FileSize) + CRLF);
          StatusUpdate('Info: ' + IntToSTr(MailItem.Number) + ' ' +
                       IntToSTr(MailItem.FileSize), STAT_COMMANDEVENT);
        end;
      end else begin
        FSocket.SendStr('+OK ' + IntToStr(FMailInfo.Count) + ' Messages ' +
                        IntToStr(FMailInfo.ByteCount) + ' octets' + CRLF);
        StatusUpdate('Info: ' + IntToSTr(FMailInfo.Count) + ' Messages ' +
                     IntToSTr(FMailInfo.ByteCount) + ' octets',
                     STAT_COMMANDEVENT);
        for x := 0 to FMailInfo.Count -1 do begin
          MailItem := FMailInfo.Mail[x];
          FSocket.SendStr(IntToStr(MailItem.Number) + ' ' +
                          IntToStr(MailItem.FileSize) + CRLF);
        end;
        FSocket.SendStr('.' + CRLF);  // multi-line listings must end with '.'
      end;
    end else
    if (Command = 'RETR') and
       (FState = pcs_TRANSACTION) and
       (FSocket.State = wsConnected) then begin
      // User wants a message
      // Which message does the user want?
      if Parameter1 <> '' then begin
        try
          Para_MessageID := StrToInt(Parameter1);
        except
          on E: Exception do Para_MessageID := -1
        end;
        // Find the message
        MailItem := FMailInfo.Find(Para_MessageID);
        if MailItem = nil then begin
          FSocket.SendStr('-ERR No Such Message' + CRLF);
          StatusUpdate('No Such Message', STAT_COMMANDERROR);
        end else
        if MailItem.MarkForDelete then begin
          FSocket.SendStr('-ERR Message Deleted' + CRLF);
          StatusUpdate('Message Deleted', STAT_COMMANDERROR);
        end else begin
          FSocket.SendStr('+OK ' + IntToSTr(MailItem.FileSize) + ' octets' +
                          CRLF);
          StatusUpdate('Message: ' + IntToSTr(MailItem.FileSize) + ' octets',
                       STAT_COMMANDEVENT);
          // Message itself
          SL := TStringList.Create;
          SL.LoadFromFile(INI.MailBoxPath + FUserID + '' + MailItem.Filename);
          // Stuff . byte
          for x := 0 to SL.Count -1 do begin
            if Copy(SL[x], 1, 1) = '.' then
              FSocket.SendStr('.' + SL[x] + CRLF)
            else
              FSocket.SendStr(SL[x] + CRLF);
            if x mod 700 = 0 then
              StatusUpdate('Sent: ' + IntToSTr(x) + ' of ' +
                           IntToStr(SL.Count) + ' lines.', STAT_PROCESSINGEVENT);
          end;
          SL.Free;
          // Send terminator
          StatusUpdate('Sent: Terminator.', STAT_PROCESSINGEVENT);
          FSocket.SendStr('.' + CRLF);
        end;
      end else begin
        FSocket.SendStr('-ERR No Message Specified' + CRLF);
        StatusUpdate('No Message Specified', STAT_COMMANDERROR);
      end;
    end else
    if (Command = 'DELE') and
       (FState = pcs_TRANSACTION) and
       (FSocket.State = wsConnected) then begin
      // Mark a message for delete
      // which message?
      if Parameter1 <> '' then begin
        try
          Para_MessageID := StrToInt(Parameter1);
        except
          on E: Exception do Para_MessageID := -1
        end;
        // Find message
        MailItem := FMailInfo.Find(Para_MessageID);
        if MailItem = nil then begin
          FSocket.SendStr('-ERR No Such Message' + CRLF);
          StatusUpdate('No Such Message', STAT_COMMANDERROR);
        end else
        if MailItem.MarkForDelete then begin
          FSocket.SendStr('-ERR Message Already Deleted' + CRLF);
          StatusUpdate('Message Already Deleted', STAT_COMMANDERROR);
        end else begin
          MailItem.MarkForDelete := True;
          FSocket.SendStr('+OK Message ' + IntToSTr(MailItem.Number) +
                          ' Deleted' + CRLF);
          StatusUpdate('Message ' + IntToSTr(MailItem.Number) + ' Deleted',
                       STAT_COMMANDEVENT);
        end;
      end else begin
        FSocket.SendStr('-ERR No Message Specified' + CRLF);
        StatusUpdate('No Message Specified', STAT_COMMANDERROR);
      end;
    end else
    if (Command = 'NOOP') and
       (FState = pcs_TRANSACTION) and
       (FSocket.State = wsConnected) then begin
      // No operation
      FSocket.SendStr('+OK' + CRLF);
    end else
    if (Command = 'RSET') and
       (FState = pcs_TRANSACTION) and
       (FSocket.State = wsConnected) then begin
      // un-mark messages marked for delete
      for x := 0 to FMailInfo.Count -1 do begin
        MailItem := FMailInfo.Mail[x];
        MailItem.MarkForDelete := False;
      end;
      FSocket.SendStr('+OK' + CRLF);
      StatusUpdate('Message(s) Un-Deleted', STAT_COMMANDEVENT);
    end else
    if (Command = 'TOP') and                       // Optional
       (FState = pcs_TRANSACTION) and
       (FSocket.State = wsConnected) then begin
      // User wants top n lines of message
      // Find message number and number of lines
      if Parameter1 <> '' then begin
        Parameter2 := '';
        if Pos(' ', Parameter1) > 0 then begin
          Parameter2 := Trim(Copy(Parameter1, Pos(' ', Parameter1),
                                  Length(Parameter1)));
          Parameter1 := Trim(Copy(Parameter1, 1, Pos(' ', Parameter1)));
        end;
        try
          Para_MessageID := StrToInt(Parameter1);
        except
          on E: Exception do Para_MessageID := -1
        end;
        try
          Para_LineCount := StrToInt(Parameter2);
        except
          on E: Exception do Para_LineCount := -1
        end;
        // Find message
        MailItem := FMailInfo.Find(Para_MessageID);
        if MailItem = nil then begin
          FSocket.SendStr('-ERR No Such Message' + CRLF);
          StatusUpdate('No Such Message', STAT_COMMANDERROR);
        end else
        if MailItem.MarkForDelete then begin
          FSocket.SendStr('-ERR Message Deleted' + CRLF);
          StatusUpdate('Message Deleted', STAT_COMMANDERROR);
        end else begin
          FSocket.SendStr('+OK' + CRLF);
          // Message itself
          SL := TStringList.Create;
          SL.LoadFromFile(INI.MailBoxPath + FUserID + '' + MailItem.Filename);
          // Find where the header stops!
          HeaderBreak := SL.Count -1;
          for x := SL.Count -1 downto 0 do if SL[x] = '' then HeaderBreak := x;
          // Write Header (do we byte stuff the header?  I will)
          for x := 0 to HeaderBreak do
            if Copy(SL[x], 1, 1) = '.' then
              FSocket.SendStr('.' + SL[x] + CRLF)
              else FSocket.SendStr(SL[x] + CRLF);
          // Write Body
          y := HeaderBreak + Para_LineCount;
          if y > SL.Count then y := SL.Count;
          // Stuff . byte
          for x := (HeaderBreak +1) to y do
            if Copy(SL[x], 1, 1) = '.' then
              FSocket.SendStr('.' + SL[x] + CRLF)
              else FSocket.SendStr(SL[x] + CRLF);
          SL.Free;
          // Send terminator
          FSocket.SendStr('.' + CRLF);
          StatusUpdate('Sent ' + IntToStr(y) + ' lines', STAT_COMMANDEVENT);
        end;
      end else begin
        FSocket.SendStr('-ERR No Message Specified' + CRLF);
        StatusUpdate('No Message Specified', STAT_COMMANDERROR);
      end;
    end else
    if (Command = 'UIDL') and                        // Optional
       (FState = pcs_TRANSACTION) and
       (FSocket.State = wsConnected) then begin
      // We don't support the UID!!!
      FSocket.SendStr('-ERR Command Not Supported' + CRLF);
      StatusUpdate('Command Not Supported', STAT_COMMANDERROR);
    end else
    begin // Unknown command
      if FSocket.State = wsConnected then
        FSocket.SendStr('-ERR Unrecognized Command' + CRLF);
    end;
  end;
end;
procedure TPop3Connection.SocketSessionClosed(Sender: TObject; Error: Word);
begin
  StatusUpdate('Closed', STAT_CONNECTIONEVENT);
  // Socket is closed, we must tell Server Object
  // to free this connection.  There's no point to
  // carrying on without a connection, now is there?
  PostMessage(FServer.Handle, WM_FREECONNECTION, Integer(Self), 0);
end;
procedure TPop3Connection.SocketError(Sender: TObject);
begin
  StatusUpdate('Socket Error', STAT_CONNECTIONERROR);
  // We had a socket error. This isn't a protocol error like the user
  // typed the wrong command, it's a dropped connection, or something else.
  // we'll close on this too, because we don't know how to recover from it.
  // the user can open a new connection if they really want.
  Close; // Close on Error
end;
procedure TPop3Connection.SocketBgException(Sender: TObject; E: Exception;
                                            var CanClose: Boolean);
begin
  StatusUpdate('Background Exception Error', STAT_CRITICALERROR);
  // We had a background exception.  This is like a socket error in that
  // we don't know what happened, and we don't know how to recover, so
  // we'd better just close this connection.
  Close; // Close on Error
end;
(******************************************************************************)
(*                                                                            *)
(*  STOP  POP3 Connection Object                                              *)
(*                                                                            *)
(******************************************************************************)
end.

						