unit tpop;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Tsocketc, NWinsock, StdCtrls;

{ If Using the Delphi 32 Winsock.pas }
type
     _Socket = TSocket;
     fd_set = TFDSet;
     Pfd_set = PFDSet;
     timeval = TTimeVal;
     hostent = THostEnt;
     netent = TNetEnt;
     servent = TServEnt;
     protoent = TProtoEnt;
     in_addr = TInAddr;
     Pin_addr = PInAddr;
     Sockaddr_in = TSockAddrIn;
     PSockaddr_in = PSockAddrIn;
     WSADATA = TWSAData;
     LPWSADATA = PWSAData;
     sockaddr = TSockAddr;
     sockproto = TSockProto;
     linger = TLinger;
     LPSOCKADDR = ^sockaddr;
     LPSOCKADDR_IN = ^sockaddr_in;
     LPLINGER = ^linger;
     LPIN_ADDR = ^in_addr;
     LPFD_SET = ^fd_set;
     LPHOSTENT = ^hostent;
     LPSERVENT = ^servent;
     LPPROTOENT = ^protoent;
     LPTIMEVAL = ^timeval;
{ End of Delphi 32 Winsock.pas compatability type definitions }
const
  SKT_NOOP = 0;
  SKT_GETHOSTADDR = 1;
  SKT_CONNECTTOHOST = 2;
  SKT_SENDPACKET = 3;
  SKT_RECVPACKET = 4;
{Constant declarations to represent POP commands. You use these
declarations to keep track of which command was last issued, 
so that responses received from the server can be directed to 
the appropriate procedure}
  MAIL_NOOP = 0;
  MAIL_CONNECT = 1;
  MAIL_USER = 2;
  MAIL_PASS = 3;
  MAIL_QUIT = 4;
  MAIL_STAT = 5;
  MAIL_LIST = 6;
  MAIL_RETR = 7;
  MAIL_DELE = 8;
  MAIL_RSET = 9;
  MAIL_APOP = 10;
  MAIL_TOP = 11;
  MAIL_UIDL = 12;
{User-defined event declarations for socket events. The first is 
for the primary socket, the second for address lookup notifications}
  UWM_SOCKETEVENT = WM_USER + 500;
  UWM_ADDRSOCKETEVENT = WM_USER + 501;
type
  TTPOPClient = class(TForm)
    Label1: TLabel;
    stStatus: TLabel;
    Label2: TLabel;
    sleHost: TEdit;
    Label3: TLabel;
    sleLogin: TEdit;
    Label4: TLabel;
    slePassword: TEdit;
    cbClose: TButton;
    cbConnect: TButton;
    cbRetrieve: TButton;
    lbMessages: TListBox;
    Label5: TLabel;
    mleText: TMemo;
    Label6: TLabel;
    stState: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ProcessHostLookup;
    procedure ProcessHostConnect;
    procedure ClearBuffer(DirtyBuffer: Pchar; BufLength: Integer);
    procedure ProcessHostWelcome;
    procedure ProcessHostSend;
    procedure ProcessHostUser;
    procedure ProcessHostPass;
    procedure ProcessHostQuit;
    procedure ProcessHostStat;
    procedure ProcessHostTop;
    procedure ProcessHostRetr;
    procedure ProcessHostReceive;
    procedure cbCloseClick(Sender: TObject);
    procedure cbConnectClick(Sender: TObject);
    procedure lbMessagesDblClick(Sender: TObject);
  private
    { Private declarations }
    isConnectionSocket: _SOCKET;
    ibConnected: Boolean;
    iiMailStatus: Integer;
    iiNumMessages, iiCurMessage: Integer;
    isFrom: String;
    isSubject: String;
    isHoldBuffer: String;
    procedure UWMSocketEvent(var Msg: TMessage); message UWM_SOCKETEVENT;
    procedure UWMAddrSocketEvent(var Msg: TMessage); message UWM_ADDRSOCKETEVENT;
  public
    { Public declarations }
    NetSocket: _TSocket;
    ReceiveBuffer: array[0..8192] of Char;
    TempBuffer: array[0..8192] of Char;
  end;

var
  TPOPClient: TTPOPClient;

implementation

{$R *.DFM}

procedure TTPOPClient.FormCreate(Sender: TObject);
begin
   ibConnected := FALSE;
   iiMailStatus := MAIL_NOOP;
   {Create the NetSocket class}
   NetSocket := _TSocket.Create;
   {Initialize the WinSock system}
   if not NetSocket.InitializeSocket then
      Close;
end;

procedure TTPOPClient.FormDestroy(Sender: TObject);
begin
     {Cleanup the WinSock interface and system}
     NetSocket.ShutdownSocket;
     NetSocket.Free;
end;

procedure TTPOPClient.ProcessHostLookup;
begin
   {We have received the host address, now we need to connect to it.}
   stStatus.Caption := 'Connecting To Host';
   stStatus.Update;
   if (NetSocket.ProcessHostAddress = TRUE) then
   begin
      {Connect to the host computer}
      isConnectionSocket := NetSocket.OpenSocketConnection(Handle, UWM_SOCKETEVENT, SKT_CONNECTTOHOST, 110);
   end
   else
   begin
      stStatus.Caption := 'Cannot Find Host Address';
      stStatus.Update;
   end;
end;

procedure TTPOPClient.ProcessHostConnect;
begin
   {We have connected to the other computer, so update the display}
   stStatus.Caption := 'Receiving Welcome From Host';
   stStatus.Update;
   iiMailStatus := MAIL_CONNECT;
   stState.Caption := 'MAIL_CONNECT';
   stState.Update;
   ClearBuffer(ReceiveBuffer, 8192);
end;

procedure TTPOPClient.ClearBuffer(DirtyBuffer: Pchar; BufLength: Integer);
var
   liCurPos: Integer;
   lcNullChar: Char;
begin
   {Initialize the position pointer to 0}
   liCurPos := 0;
   {Create a null character}
   lcNullChar := Char(0);
   {Loop through the entire buffer passed in, setting each character
   equal to the null character}
   while (liCurPos < BufLength) do
   begin
      DirtyBuffer^ := lcNullChar;
      Inc(liCurPos);
      Inc(DirtyBuffer);
   end;
end;

procedure TTPOPClient.ProcessHostWelcome;
var
   lsWelcomeMsg, lsRetnCode: String;
begin
   {Convert the received message to a Pascal string}
   lsWelcomeMsg := StrPas(ReceiveBuffer);
   {Copy the response code into the lsRetnCode variable}
   lsRetnCode := Copy(lsWelcomeMsg, 1, 3);
   {Check to see what was returned}
   if (lsRetnCode = '+OK') then
      {Positive Response, you are connected}
      ibConnected := TRUE
   else
      {Negative Response, you are not connected}
      ibConnected := FALSE;
   {Set the command status flag to NOOP}
   iiMailStatus := MAIL_NOOP;
   {Display the response message}
   stStatus.Caption := lsWelcomeMsg;
   stStatus.Update;
   {If you are connected}
   if ibConnected then
   begin
      {Set the command status flag to indicate that you sent a USER}
      iiMailStatus := MAIL_USER;
      stState.Caption := 'MAIL_USER';
      stState.Update;
      {Send the USER command to the mail server, telling it who you are}
      NetSocket.SocketSend(isConnectionSocket, handle, UWM_SOCKETEVENT,
                              'USER ' + sleLogin.Text, SKT_SENDPACKET);
      {Clear the receive buffer}
      ClearBuffer(ReceiveBuffer, 8192);
   end;
end;

procedure TTPOPClient.ProcessHostSend;
begin
   if (iiMailStatus <> MAIL_NOOP) then
   begin
      {Clear the receive buffer}
      ClearBuffer(ReceiveBuffer, 8192);
   end;
end;

procedure TTPOPClient.ProcessHostUser;
var
   lsWelcomeMsg, lsRetnCode: String;
   lbContinue: boolean;
begin
   {Initialize the continue flag to FALSE, so that you have to alter it
   only in the event of a positive response from the server}
   lbContinue := FALSE;
   {Convert the received message to a Pascal string}
   lsWelcomeMsg := StrPas(ReceiveBuffer);
   {Copy the response code into the lsRetnCode variable}
   lsRetnCode := Copy(lsWelcomeMsg, 1, 3);
   {Check to see what was returned}
   if (lsRetnCode = '+OK') then
      {Positive Response, set the continue flag to TRUE}
      lbContinue := TRUE;
   {Set the command status flag to NOOP}
   iiMailStatus := MAIL_NOOP;
   {Display the response message}
   stStatus.Caption := lsWelcomeMsg;
   stStatus.Update;
   {If we are continuing}
   if lbContinue then
   begin
      {Set the command status flag to indicate that you sent a PASS}
      iiMailStatus := MAIL_PASS;
      stState.Caption := 'MAIL_PASS';
      stState.Update;
      {Send the PASS command to the mail server, 
       telling it your password}
      NetSocket.SocketSend(isConnectionSocket, handle, UWM_SOCKETEVENT,
                              'PASS ' + slePassword.Text, SKT_SENDPACKET);
      {Clear the receive buffer}
      ClearBuffer(ReceiveBuffer, 8192);
   end
   else
   begin
      {Set the command status flag to indicate that you sent a QUIT}
      iiMailStatus := MAIL_QUIT;
      stState.Caption := 'MAIL_QUIT';
      stState.Update;
      {Send the QUIT command to the mail server, telling it you have
      finished your session}
      NetSocket.SocketSend(isConnectionSocket, handle, UWM_SOCKETEVENT,
                              'QUIT', SKT_SENDPACKET);
      {Clear the receive buffer}
      ClearBuffer(ReceiveBuffer, 8192);
   end;
end;

procedure TTPOPClient.ProcessHostPass;
var
   lsWelcomeMsg, lsRetnCode: String;
   lbContinue: boolean;
begin
   {Initialize the continue flag to FALSE, so that you have to alter it
   only in the event of a positive response from the server}
   lbContinue := FALSE;
   {Convert the received message to a Pascal string}
   lsWelcomeMsg := StrPas(ReceiveBuffer);
   {Copy the response code into the lsRetnCode variable}
   lsRetnCode := Copy(lsWelcomeMsg, 1, 3);
   {Check to see what was returned}
   if (lsRetnCode = '+OK') then
      {Positive Response, set the continue flag to TRUE}
      lbContinue := TRUE;
   {Set the command status flag to NOOP}
   iiMailStatus := MAIL_NOOP;
   {Display the response message}
   stStatus.Caption := lsWelcomeMsg;
   stStatus.Update;
   {If we are continuing}
   if lbContinue then
   begin
      {Set the command status flag to indicate that you sent a STAT}
      iiMailStatus := MAIL_STAT;
      stState.Caption := 'MAIL_STAT';
      stState.Update;
      {Send the STAT command to the mail server, asking for the mailbox
      status}
      NetSocket.SocketSend(isConnectionSocket, handle, UWM_SOCKETEVENT,
                              'STAT', SKT_SENDPACKET);
      {Clear the receive buffer}
      ClearBuffer(ReceiveBuffer, 8192);
   end
   else
   begin
      {Set the command status flag to indicate that you sent a QUIT}
      iiMailStatus := MAIL_QUIT;
      stState.Caption := 'MAIL_QUIT';
      stState.Update;
      {Send the QUIT command to the mail server, telling it you have
      finished your session}
      NetSocket.SocketSend(isConnectionSocket, handle, UWM_SOCKETEVENT,
                              'QUIT', SKT_SENDPACKET);
      {Clear the receive buffer}
      ClearBuffer(ReceiveBuffer, 8192);
   end;
end;

procedure TTPOPClient.ProcessHostStat;
var
   lsRetnMsg, lsRetnCode: String;
   lbContinue: boolean;
   liSpacePos: Integer;
begin
   {Initialize the continue flag to FALSE, so that you have to alter it
   only in the event of a positive response from the server}
   lbContinue := FALSE;
   {Convert the received message to a Pascal string}
   lsRetnMsg := StrPas(ReceiveBuffer);
   {Copy the response code into the lsRetnCode variable}
   lsRetnCode := Copy(lsRetnMsg, 1, 3);
   {Check to see what was returned}
   if (lsRetnCode = '+OK') then
      {Positive Response, set the continue flag to TRUE}
      lbContinue := TRUE;
   {Set the command status flag to NOOP}
   iiMailStatus := MAIL_NOOP;
   {Display the response message}
   stStatus.Caption := lsRetnMsg;
   stStatus.Update;
   {If we are continuing}
   if lbContinue then
   begin
      {You must parse the returned status message to find out how many
      messages are sitting in the mailbox. You start by locating the
      first space character}
      liSpacePos := Pos(' ', lsRetnMsg);
      if (liSpacePos > 0) then
      begin
         {Trim everything through the first space (the status
         indicator)}
         lsRetnMsg := Copy(lsRetnMsg, (liSpacePos + 1), Length(lsRetnMsg));
         {Find the next space character}
         liSpacePos := Pos(' ', lsRetnMsg);
         {Everything in front of the next space character is the number
         of messages in the mailbox, so you want to copy and convert that
         into a variable to maintain how many messages to expect}
         if (liSpacePos > 0) then
            iiNumMessages := StrToInt(Copy(lsRetnMsg, 1, (liSpacePos - 1)));
      end;
      {Are there any messages to retrieve?}
      if (iiNumMessages > 0) then
      begin
         {Yes, there are messages to retrieve}
         {Set the command status flag to indicate that you sent a TOP}
         iiMailStatus := MAIL_TOP;
         stState.Caption := 'MAIL_TOP 1 of ' + IntToStr(iiNumMessages);
         stState.Update;
         {Set the message counter to indicate that you are retrieving
         the first message}
         iiCurMessage := 1;
         {Send the TOP command to the mail server, requesting the top
         of the first message}
         NetSocket.SocketSend(isConnectionSocket, handle, UWM_SOCKETEVENT,
                              'TOP 1 1', SKT_SENDPACKET);
         {Clear the receive buffer}
         ClearBuffer(ReceiveBuffer, 8192);
      end
      else
      begin
         {No messages to be retrieved, tell the user}
         ShowMessage('No messages on server.');
         {Set the command status flag to indicate that you sent a QUIT}
         iiMailStatus := MAIL_QUIT;
         stState.Caption := 'MAIL_QUIT';
         stState.Update;
         {Send the QUIT command to the mail server, telling it you have
          finished your session}
         NetSocket.SocketSend(isConnectionSocket, handle, UWM_SOCKETEVENT,
                              'QUIT', SKT_SENDPACKET);
         {Clear the receive buffer}
         ClearBuffer(ReceiveBuffer, 8192);
      end;
   end;
end;

procedure TTPOPClient.ProcessHostTop;
var
   lsRetnMsg, lsRetnCode: String;
   lbContinue: boolean;
   lbComplete: boolean;
   liSpacePos: Integer;
begin
   {Initialize the continue flag to FALSE, so that you have to alter it
   only in the event of a positive response from the server}
   lbContinue := FALSE;
   lbComplete := FALSE;
   {Get the first line from the received buffer}
   if (NetSocket.GetLine(TempBuffer, ReceiveBuffer) or (isHoldBuffer <> '')) then
   begin
      {Are you holding anything in the Hold buffer from a previous,
      incomplete message?}
      if (isHoldBuffer <> '') then
         {Yes, so set the continue flag to TRUE and skip the status
         code checking}
         lbContinue := TRUE
      else
      begin
         {No, this is the start of a new message}
         {Convert the received message to a Pascal string}
         lsRetnMsg := StrPas(TempBuffer);
         {Copy the response code into the lsRetnCode variable}
         lsRetnCode := Copy(lsRetnMsg, 1, 3);
         {Check to see what was returned}
         if (lsRetnCode = '+OK') then
            {Positive Response, set the continue flag to TRUE}
            lbContinue := TRUE;
         {Set the command status flag to NOOP}
         iiMailStatus := MAIL_NOOP;
         {Display the response message}
         stStatus.Caption := lsRetnMsg;
         stStatus.Update;
      end;
      {If we are continuing}
      if lbContinue then
      begin
         {Is there anything in the Hold buffer?}
         if (isHoldBuffer <> '') then
         begin
            {Yes, add the first line to what is in the Hold buffer}
            lsRetnMsg := isHoldBuffer + StrPas(TempBuffer);
            {Empty the hold buffer, so you won't trigger this section
            again until you need to}
            isHoldBuffer := '';
            {Did you find the message termination marker?}
            if (lsRetnMsg = '.') then
               {Yes, set the complete flag to TRUE}
               lbComplete := TRUE;
            {Do you have the FROM header field?}
            if (Pos('From:', lsRetnMsg) > 0) then
            begin
               {Yes, copy the field value into the isFrom variable}
               liSpacePos := Pos(' ', lsRetnMsg);
               if (liSpacePos > 0) then
                  isFrom := Copy(lsRetnMsg, (liSpacePos + 1), Length(lsRetnMsg));
            end;
            {Do you have the SUBJECT header field?}
            if (Pos('Subject:', lsRetnMsg) > 0) then
            begin
               {Yes, copy the field value into the isSubject variable}
               liSpacePos := Pos(' ', lsRetnMsg);
               if (liSpacePos > 0) then
                  isSubject := Copy(lsRetnMsg, (liSpacePos + 1), Length(lsRetnMsg));
            end;
            {You are done with special handling to complete
             the unfinished line held in the Hold buffer}
         end;
         {Loop as long as you can get complete lines from the received
         data and we haven't found the message termination marker,
         getting the next line from the received data}
         while (NetSocket.GetLine(TempBuffer, ReceiveBuffer) and (not lbComplete)) do
         begin
            {Convert the received message to a Pascal string}
            lsRetnMsg := StrPas(TempBuffer);
            {Did you find the message termination marker?}
            if (lsRetnMsg = '.') then
               {Yes, set the complete flag to TRUE}
               lbComplete := TRUE;
            {Do you have the FROM header field?}
            if (Pos('From:', lsRetnMsg) > 0) then
            begin
               {Yes, copy the field value into the isFrom variable}
               liSpacePos := Pos(' ', lsRetnMsg);
               if (liSpacePos > 0) then
                  isFrom := Copy(lsRetnMsg, (liSpacePos + 1), Length(lsRetnMsg));
            end;
            {Do you have the SUBJECT header field?}
            if (Pos('Subject:', lsRetnMsg) > 0) then
            begin
               {Yes, copy the field value into the isSubject variable}
               liSpacePos := Pos(' ', lsRetnMsg);
               if (liSpacePos > 0) then
                  isSubject := Copy(lsRetnMsg, (liSpacePos + 1), Length(lsRetnMsg));
            end;
            {Loop back and get the next line from the received data}
         end;
         {Have you received the complete message?}
         if lbComplete then
         begin
            {If so, add the From and Subject information into the
            lbMessages List Box}
            lbMessages.Items.Add(isFrom + ' - ' + isSubject);
            {Are there more messages to retrieve?}
            if (iiNumMessages > iiCurMessage) then
            begin
               {Set the command status flag to indicate that you 
               sent a TOP}
               iiMailStatus := MAIL_TOP;
               {Increment the message counter}
               Inc(iiCurMessage);
               {Update the display to indicate which message you are
               retrieving}
               stState.Caption := 'MAIL_TOP ' + IntToStr(iiCurMessage) + ' of ' + IntToStr(iiNumMessages);
               stState.Update;
               {Send the TOP command to the mail server, requesting the
               top of the next message}
               NetSocket.SocketSend(isConnectionSocket, handle, UWM_SOCKETEVENT,
                           'TOP ' + IntToStr(iiCurMessage) + ' 1', SKT_SENDPACKET);
               {Clear the receive buffer}
               ClearBuffer(ReceiveBuffer, 8192);
            end
            else
            begin
               {No more messages to retrieve, place the client into
               an idle state, waiting for the user to select an action}
               {Set the command status flag to NOOP}
               iiMailStatus := MAIL_NOOP;
               stState.Caption := 'MAIL_NOOP ' + IntToStr(iiCurMessage) + ' of ' + IntToStr(iiNumMessages);
               stState.Update;
               {Change the default command button from the CONNECT
               button to the RETRIEVE button}
               cbConnect.Default := FALSE;
               cbRetrieve.Default := TRUE;
            end;
         end
         else
         begin
            {Set the command status flag to indicate that you sent a TOP}
            iiMailStatus := MAIL_TOP;
            {Update the display to indicate which message you are
               retrieving}
            stState.Caption := 'MAIL_TOP ' + IntToStr(iiCurMessage) + ' of ' + IntToStr(iiNumMessages);
            stState.Update;
            {You haven't received a message termination marker,
            so you must have an incomplete line. You place it into 
            the Hold buffer and add the first line from the next data 
            received to it}
            isHoldBuffer := lsRetnMsg;
            {Clear the receive buffer}
            ClearBuffer(ReceiveBuffer, 8192);
         end;
      end;
   end
   else
   begin
      {Set the command status flag to NOOP}
      iiMailStatus := MAIL_NOOP;
      stState.Caption := 'MAIL_NOOP';
      stState.Update;
      {Display the response message}
      stStatus.Caption := 'Top of message not received.';
      stStatus.Update;
   end;
end;

procedure TTPOPClient.ProcessHostRetr;
var
   lsRetnMsg, lsRetnCode: String;
   lbContinue: boolean;
   lbComplete: boolean;
   liSpacePos: Integer;
begin
   {Initialize the continue flag to FALSE, so that you have to alter it
   only in the event of a positive response from the server}
   lbContinue := FALSE;
   lbComplete := FALSE;
   {Get the first line from the received buffer}
   if (NetSocket.GetLine(TempBuffer, ReceiveBuffer) or (isHoldBuffer <> '')) then
   begin
      {Are you holding anything in the Hold buffer from a previous,
      incomplete message?}
      if (isHoldBuffer <> '') then
         {Yes, so set the continue flag to TRUE and skip the status
         code checking}
         lbContinue := TRUE
      else
      begin
         {Convert the received message to a Pascal string}
         lsRetnMsg := StrPas(TempBuffer);
         {Copy the response code into the lsRetnCode variable}
         lsRetnCode := Copy(lsRetnMsg, 1, 3);
         {Check to see what was returned}
         if (lsRetnCode = '+OK') then
            {Positive Response, set the continue flag to TRUE}
            lbContinue := TRUE;
         {Set the command status flag to NOOP}
         iiMailStatus := MAIL_NOOP;
         {Display the response message}
         stStatus.Caption := lsRetnMsg;
         stStatus.Update;
      end;
      {If we are continuing}
      if lbContinue then
      begin
         {Is there anything in the Hold buffer?}
         if (isHoldBuffer <> '') then
         begin
            {Yes, add the first line to what is in the Hold buffer}
            lsRetnMsg := isHoldBuffer + StrPas(TempBuffer);
            {Empty the hold buffer, so you don't trigger this section
            again until you need to}
            isHoldBuffer := '';
            {Did you find the message termination marker?}
            if (lsRetnMsg = '.') then
               {Yes, set the complete flag to TRUE}
               lbComplete := TRUE
            else
               {No, add the line to the mleText Tmemo field}
               mleText.Lines.Add(lsRetnMsg);
         end;
         {Loop as long as you can get complete lines from the received
         data and haven't found the message termination marker,
         getting the next line from the received data}
         while (NetSocket.GetLine(TempBuffer, ReceiveBuffer) and (not lbComplete)) do
         begin
            {Convert the received message to a Pascal string}
            lsRetnMsg := StrPas(TempBuffer);
            {Did you find the message termination marker?}
            if (lsRetnMsg = '.') then
               {Yes, set the complete flag to TRUE}
               lbComplete := TRUE
            else
               {No, add the line to the mleText Tmemo field}
               mleText.Lines.Add(lsRetnMsg);
         end;
         {Have you not received the complete message?}
         if not lbComplete then
         begin
            {Set the command status flag to indicate 
             that you sent a RETR}
            iiMailStatus := MAIL_RETR;
            isHoldBuffer := lsRetnMsg;
            {Clear the receive buffer}
            ClearBuffer(ReceiveBuffer, 8192);
         end;
      end;
   end
   else
   begin
      {Set the command status flag to NOOP}
      iiMailStatus := MAIL_NOOP;
      stState.Caption := 'MAIL_NOOP';
      stState.Update;
      {Display the response message}
      stStatus.Caption := 'Message not received.';
      stStatus.Update;
   end;
end;

procedure TTPOPClient.ProcessHostQuit;
var
   lsRetnMsg: String;
begin
   {Convert the received message to a Pascal string}
   lsRetnMsg := StrPas(ReceiveBuffer);
   {Set the command status flag to NOOP}
   iiMailStatus := MAIL_NOOP;
   stState.Caption := 'MAIL_NOOP';
   stState.Update;
   {Display the response message}
   stStatus.Caption := lsRetnMsg;
   stStatus.Update;
   cbRetrieve.Default := FALSE;
   cbConnect.Default := TRUE;
   {If you are connected}
   if ibConnected then
      {Close the application, also closing the socket connection}
      Close;
end;

procedure TTPOPClient.ProcessHostReceive;
var
   lsRetnStr: String;
   liCarRetnPos: Integer;
begin
   try
      liCarRetnPos := recv(isConnectionSocket, ReceiveBuffer, 8192, 0);
      ReceiveBuffer[liCarRetnPos] := Char(0);
      if (ReceiveBuffer[0] = Char(0)) then
      begin
         {Clear the receive buffer}
         ClearBuffer(ReceiveBuffer, 8192);
      end
      else
      begin
         case iiMailStatus of
            MAIL_NOOP:;
            MAIL_CONNECT: ProcessHostWelcome;
            MAIL_USER: ProcessHostUser;
            MAIL_PASS: ProcessHostPass;
            MAIL_QUIT: ProcessHostQuit;
            MAIL_STAT: ProcessHostStat;
            MAIL_LIST:;
            MAIL_RETR: ProcessHostRetr;
            MAIL_DELE:;
            MAIL_RSET:;
            MAIL_APOP:;
            MAIL_TOP: ProcessHostTop;
            MAIL_UIDL:;
         end;
      end;
   except
      {Clear the receive buffer}
      ClearBuffer(ReceiveBuffer, 8192);
   end;
end;

procedure TTPOPClient.UWMSocketEvent(var Msg: TMessage);
begin
   case Msg.LParamLo of
      FD_READ: ProcessHostReceive;
      FD_WRITE: ProcessHostSend;
      FD_CONNECT: ProcessHostConnect;
      FD_CLOSE: ;
   end;
end;

procedure TTPOPClient.UWMAddrSocketEvent(var Msg: TMessage);
begin
   if (Msg.lParamHi = 0) then
      ProcessHostLookup;
end;

procedure TTPOPClient.cbCloseClick(Sender: TObject);
begin
   if ibConnected then
   begin
      stStatus.Caption := 'Quitting Session';
      stStatus.Update;
      {Set the command status flag to indicate that you sent a QUIT}
      iiMailStatus := MAIL_QUIT;
      stState.Caption := 'MAIL_QUIT';
      stState.Update;
      {Send the QUIT command to the mail server, telling it you have
      finished your session}
      NetSocket.SocketSend(isConnectionSocket, handle, UWM_SOCKETEVENT,
                              'QUIT', SKT_SENDPACKET);
      {Clear the receive buffer}
      ClearBuffer(ReceiveBuffer, 8192);
   end
   else
      Close;
end;

procedure TTPOPClient.cbConnectClick(Sender: TObject);
begin
   if ((Length(sleHost.Text) > 0) and
      (Length(sleLogin.Text) > 0) and
      (Length(slePassword.Text) > 0)) then
   begin
      lbMessages.Clear;
      stStatus.Caption := 'Looking Up Host Address';
      stStatus.Update;
      iiMailStatus := MAIL_CONNECT;
      stState.Caption := 'MAIL_CONNECT';
      stState.Update;
      NetSocket.GetHostAddress(Handle, UWM_ADDRSOCKETEVENT, sleHost.text, SKT_GETHOSTADDR);
   end;
end;

procedure TTPOPClient.lbMessagesDblClick(Sender: TObject);
var
   liNumSelected: Integer;
begin
   {Get the message number that was selected for retrieval}
   liNumSelected := lbMessages.ItemIndex;
   {Did the user select a message?}
   if (liNumSelected > -1) then
   begin
      {Yes, clear the message area}
      mleText.Clear;
      {Display the action being started}
      stStatus.Caption := 'Retrieving Message ' + IntToStr((liNumSelected + 1));
      stStatus.Update;
      {Set the command status flag to indicate that you sent a RETR}
      iiMailStatus := MAIL_RETR;
      stState.Caption := 'MAIL_RETR';
      stState.Update;
      {Send the RETR command to the mail server, requesting the
      selected message}
      NetSocket.SocketSend(isConnectionSocket, handle, UWM_SOCKETEVENT,
                              'RETR ' + IntToStr((liNumSelected + 1)), SKT_SENDPACKET);
      {Clear the receive buffer}
      ClearBuffer(ReceiveBuffer, 8192);
   end;
end;

end.
