Creating a POP3 Server - Implementing the Commands
(Page 3 of 5 )
Once you have all of the components in place and connected, click on pops and go to the object inspector. Click on the events tab, double click on "OnCheckUser" and add the following code:
procedure TForm1.popsCheckUser(aContext: TIdContext;
aServerContext: TIdPOP3ServerContext);
begin
coinitialize(nil);
q2.Close;
//Search for the username and password in "users" table..
q2.SQL.Text := 'SELECT * from users WHERE uname=:user AND
upass=:pwd';
q2.Parameters.ParamByName('user').Value :=
aServerContext.Username;
q2.Parameters.ParamByName('pwd').Value :=
aServerContext.Password;
q2.open;
//if the user is not found, display an error...
if q2.RecordCount = 0 then raise Exception.Create('Authentication
failed');
couninitialize;
end;
The above procedure checks whether the username and password exist in the database.
Next, we deal with the DELE(TE) command. The delete command is in the following format: DELE msgNo. Below is a example C(lient) request the S(erver) to delete msg numbers 1 and 2:
C: DELE 1
S: +OK message 1 deleted
...
C: DELE 2
S: -ERR message 2 already deleted
Double click on OnDelete and add the following code:
procedure TForm1.popsDelete(aCmd: TIdCommand; AMsgNo: Integer);
var
n1,n2:integer;
Data:TStringList;
begin
Data := TStringList.Create;
try
ado1.Open;
//Check if a valid message number has been requested...
if (AMsgNo < 1) or (AMsgNo > ado1.RecordCount) then
raise Exception.Create('invalid message number');
ado1.RecNo := AMsgNo;
n2:=ado1.Fieldbyname('mid').AsInteger;
n1:=1;
//mark the message for deletion...
q2.Close;
q2.SQL.text:='UPDATE email SET ismarked=:num WHERE mid =:msgnum';
q2.Parameters.ParamByName('num').Value:=n1;
q2.Parameters.ParamByName('msgnum').Value:=n2;
q2.ExecSQL;
//Send a reply confirming that message has been deleted
aCmd.Reply.SetReply(OK, 'message'+inttostr(amsgno)
+'deleted');
aCmd.SendReply; // <-- YOU MUST DO THIS BEFORE
SENDING THE DATA
//aCmd.Context.Connection.WriteRFCStrings(Data); //
<-- INCLUDESTHE TERMINATING '.' LINE
finally
FreeAndNil(Data);
end;
Now, you do not actually delete the messages at this point. All that you do is mark them for deletion when the pop3client disconnects from the server. In the above code, to mark a message for deletion I insert "1" in the ismarked column of the table, so, when the pop3 client quits or disconnects, the server will automatically search for messages where the column ismarked is set to 1 for deletion. The way I checked the validity of the msgNo is by comparing the msgNo by the number of records (ado1.RecordCount) in the database. If the message number is greater than the number of records, then an exception will be raised.
Next is the RSET command. This resets (unmarks) any messages previously marked for deletion in this session so that the QUIT command will not delete them. Below is a short example:
C: RSET
S: +OK maildrop has 2 messages (320 octets)
That is the end of the example. Now for some real code:
procedure TForm1.popsReset(aCmd: TIdCommand);
var
n1,n2,i:integer;
begin
n1:=1;//marked for deletion
n2:=0;//not marked
q2.Close;
q2.SQL.text:='select * FROM email WHERE ismarked =:num';
q2.Parameters.ParamByName('num').Value:=n1;
q2.open;
//there are messages marked for deletion
if q2.RecordCount > 0 then begin
for i:= 1 to q2.RecordCount do begin
//reset unmark them
q2.Close;
q2.SQL.text:='UPDATE email SET ismarked=:num';
q2.Parameters.ParamByName('num').Value:=n2;
q2.ExecSQL;
end;
end;
q2.Close;
//get the count of message that is NOT marked
q2.SQL.text:='select * FROM email WHERE ismarked =:num';
q2.Parameters.ParamByName('num').Value:=n2;
q2.open;
//Sent off the count of messages that is not marked
aCmd.Reply.SetReply(OK, inttostr(q2.RecordCount)+' messages
available');
aCmd.SendReply; // <-- YOU MUST DO THIS BEFORE SENDING THE DATA
end;
The LIST command lists all the messages with their message ID and the message size. Below is an example of the LIST command:
C: LIST
S: +OK 2 messages (320 octets)
S: 1 120
S: 2 200
S: .
...
C: LIST 2
S: +OK 2 200
...
C: LIST 3
S: -ERR no such message, only 2 messages in maildrop
That is the end of that example; now for some more code:
procedure TForm1.popsList(aCmd: TIdCommand; AMsgNo: Integer);
var
msgnum,thesize:integer;
begin
CoInitialize(nil);
q2.Close;
q2.SQL.text:='SELECT SUM(msize) AS tsize from email';
q2.open;
//get the size of the total messages...
thesize:=q2.fieldbyname('tsize').AsInteger;
q2.Close;
q2.SQL.text:='SELECT * from email';
q2.open;
//Get total number of messages
msgnum:= q2.recordcount;
//now, send a reply ...
aCmd.Reply.SetReply(OK, inttostr(msgnum) + ' messages '+'('+inttostr(thesize) + ' octets)');
aCmd.SendReply;
q2.Close;
q2.SQL.text:='SELECT * from email';
q2.open;
q2.First;
while not q2.EOF do
begin
with aCmd.Context.Connection.IOHandler do
begin
WriteLn(inttostr(q2.RecNo{.Fieldbyname('mid').Value}) +' '+
inttostr(q2.Fieldbyname('msize').Value));
q2.Next;
end;//cmd
end;//w
aCmd.Context.Connection.IOHandler.writeln('.');
CoUnInitialize;
end;
Sometimes pop3 clients include a msgNo with this command, in which case you will have to retrieve that specific message based on its msgNo. But generally this won't be the case.
Next: Implementing the Commands, continued >>
More Delphi-Kylix Articles
More By Leidago
