Creating a POP3 Server

Next is the RETR [msgNo] command. This command retrieves all messages or  a specific message based on its msgNo provided it is not marked for deletion.  Here's a quick example: 

C: RETR 1

             S: +OK 120 octets

             S: <the POP3 server sends the entire message here>

             S: .

And now for the code:

procedure TForm1.popsRetrieve(aCmd: TIdCommand; AMsgNo: Integer);
    var
        // using a TStringList so that Indy can automatically
ensure
        // that any lines beginning with '.' does not mess up the
response
        Data: TStringList;
        n2:integer;
    begin
        Data := TStringList.Create;
        try
        n2:=0;//not marked for deletion
q2.Close;
//get all msgs that is not marked for deletion...
q2.SQL.text:='SELECT * from email WHERE ismarked =:num';
q2.Parameters.ParamByName('num').Value:=n2;
q2.open;
//Check to see if msg number is valid...
            if (AMsgNo < 1) or (AMsgNo > q2.RecordCount) then
                raise Exception.Create('invalid message number');
//Set the table marker to the msg number i.e., if the msg# is 2
then set the tbl record to #2
            q2.RecNo := AMsgNo;
//add msg details to the data object...
            Data.Add('From: ' + q2.FieldByName('from').Text);
            Data.Add('To: ' + q2.FieldByName('to').Text);
            Data.Add('Subject: ' + q2.FieldByName
('subject').Text);
            Data.Add('');
            Data.Add(q2.FieldByName('mbody').AsString);
            aCmd.Reply.SetReply(OK, 'message follows');
            aCmd.SendReply; // <-- YOU MUST DO THIS BEFORE
SENDING THE DATA
            aCmd.Context.Connection.WriteRFCStrings(Data); // <--
INCLUDESTHE TERMINATING '.' LINE
        finally
           FreeAndNil(Data);
        end;
    end;

Next the STAT command lists the number of messages and their combined sizes. An example:

C: STAT
             S: +OK 2 320 <- two messages with a combined size of
320

And here's the code:

procedure TForm1.popsStat(aCmd: TIdCommand; out oCount, oSize: Integer);
var
msgnum,n2:integer;
begin
n2:=0;
q2.Close;
//Get msg sizes that is unmarked..
q2.SQL.text:='SELECT SUM(msize) AS tsize from email WHERE
ismarked =:num';
q2.Parameters.ParamByName('num').Value:=n2;
q2.open;
osize:=q2.Fieldbyname('tsize').AsInteger;
 q2.Close;
q2.SQL.text:='SELECT * from email WHERE ismarked =:num';
q2.Parameters.ParamByName('num').Value:=n2;
q2.open;
//Get number of msgs
ocount:=q2.RecordCount;
 aCmd.Reply.SetReply(OK, inttostr(ocount)+' '+inttostr(osize));
end;

Next the QUIT command disconnects the pop3client and deletes all messages marked for deletion. Here's the code: 

procedure TForm1.popsQuit(aCmd: TIdCommand);
var
n1:integer;
begin
n1:=1;
q2.Close;
//Delete all marked messages
q2.SQL.text:='DELETE * FROM email WHERE ismarked =:num';
q2.Parameters.ParamByName('num').Value:=n1;
q2.ExecSQL;
aCmd.Reply.SetReply(OK, 'Server signing off (maildrop empty)');
 aCmd.SendReply; // <-- YOU MUST DO THIS BEFORE SENDING THE DATA
end;

Next the TOP [msgNo msgLines] command sends the headers of the message, the blank line separating the headers from the body, and then the number of lines of the indicated message's body. Here's an example:

C: TOP 1 10
             S: +OK
             S: <the POP3 server sends the headers of the
                message, a blank line, and the first 10 lines
                of the body of the message>
             S: .
                ...
C: TOP 100 3
             S: -ERR no such message

And here's the code:

procedure TForm1.popsTop(aCmd: TIdCommand; aMsgNo, aLines:
Integer);
var
thestr:string;
Data:TStringList;
begin
Data := TStringList.Create;
        try
            ado1.Open;
            if (AMsgNo < 1) or (AMsgNo > ado1.RecordCount) then
                raise Exception.Create('invalid message number');
            ado1.RecNo := AMsgNo;
//check if number of lines are specified..
            if alines > 0 then begin
            thestr:= Copy(ado1.Fieldbyname('mbody').AsString, 1,
aLines);
            end else begin
            thestr:=ado1.Fieldbyname('mbody').AsString;
            end;
            Data.Add('From: ' + ado1.FieldByName('from').Text);
            Data.Add('To: ' + ado1.FieldByName('to').Text);
            Data.Add('Subject: ' + ado1.FieldByName
('subject').Text);
            Data.Add('');
            Data.Add(thestr);
            aCmd.Reply.SetReply(OK, 'top of message follows');
            aCmd.SendReply; // <-- YOU MUST DO THIS BEFORE
SENDING THE DATA
            aCmd.Context.Connection.WriteRFCStrings(Data); // <--
INCLUDESTHE TERMINATING '.' LINE
        finally
           FreeAndNil(Data);
        end;
end;

Sometimes the command is issued without the number of lines specified, in which case you have to show the entire body of the message. This is demonstrated by the code above.

The next command is UIDL [msgNo]. When this command is issued the POP3 server responds with a line containing information for that message. This line is called a "unique-id listing" for that message. The unique number can be made up of anything, as long as it is unique. Below is an example of the UIDL command:

C: UIDL
          S: +OK
          S: 1 whqtswO00WBw418f9t5JxYwZ
          S: 2 QhdPYR:00WBw1Ph7x7
          S: .
             ...
          C: UIDL 2
          S: +OK 2 QhdPYR:00WBw1Ph7x7
             ...
          C: UIDL 3
          S: -ERR no such message, only 2 messages in maildrop

And here is the code:

procedure TForm1.popsUIDL(aCmd: TIdCommand; AMsgNo: Integer);
var
Data:TStringList;
begin
 Data := TStringList.Create;
        try
            ado1.Open;
            if (AMsgNo < 1) or (AMsgNo > ado1.RecordCount) then
                raise Exception.Create('invalid message number');
            ado1.RecNo := AMsgNo;
            Data.Add(inttostr(ado1.RecNo)+'
'+'whqtswO00WB'+inttostr(ado1.FieldByName('mid').AsInteger)
+'w418f9t5JxYwZ');
            aCmd.Reply.SetReply(OK, 'unique-id listing follows');
            aCmd.SendReply; // <-- YOU MUST DO THIS BEFORE
SENDING THE DATA
            aCmd.Context.Connection.WriteRFCStrings(Data); // <--
INCLUDESTHE TERMINATING '.' LINE
        finally
           FreeAndNil(Data);
        end;
end;

The above code creates a unique number by adding the msgnumber to "whqtswO00WBw418f9t5JxYwZ" as you can see from the above code. You can create/add anything you want to make this a unique number.

Double click on "OnException" and add the following code:

procedure TForm1.popsException(AContext: TIdContext;
  AException: Exception);
begin
AContext.Connection.IOHandler.Write( AException.Message);
 end;
//the code below activates the pop3 Server
procedure TForm1.Button1Click(Sender: TObject);
begin
if not pops.Active then begin
pops.Active:=true;
label1.Caption:='Connected';
end;
end;

Double click on "OnExecute" and add the following code:

procedure TForm1.popsExecute(AContext: TIdContext);
begin
logfile.DoLogWriteString(acontext.Connection.IOHandler.ReadLn);
end;
end.