Indy10Demos/MailServer/Pop3DBModule.pas

unit Pop3DBModule;
{ This unit is performing all the internal data housekeeping:
  Mailboxes
  Accounts
  Passwords
  Email Adresses
  Most are kept in Stringlists, the Objects containing some additional data.
  You can easily extend this using a small database (Firebird recommended)
  to have the data for the users stored in a convenient way.

  (c)2005
  Jörg Meier (Bob)
  [email protected]
}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;




//  Some Globals
Const
  MBoxFolder      = 'MailBoxes\';    // Foldername for storing Mailboxes
  SentArchive     = 'SentMails\';
Type
  TPop3DBMod = class(TDataModule)
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
    fMailboxList  : tStringList;
    fEmailAddrs   : tStringList;
    fSendQueue    : tThreadList;
    Function  AddUser(Const AUserName,APassword,AMBoxName:String):Boolean;
    Function  AddEmailAccount(Const AEmailAddress,AUserName:String):Boolean;
    Procedure FillUserList;
  public
    { Public-Deklarationen }
    Property  MailBoxList : tStringList read fMailBoxList;
    Property  EmailAddrs  : tStringList read fEmailAddrs;
    Property  SendQueue   : tThreadList  read fSendQueue;
    Function  GetSendMailCount:Integer;
    Function  GetMailNumber:Cardinal;
    Function  GetSendFileName(Const AMBox:String):String;
    Function  GetRecvFileName(const AMBox: String): String;
    Procedure EnterToSendMail(Const AFileName:String);
    Function  GetMBoxName(Const AUser:String):String;
  end;

var
  Pop3DBMod: TPop3DBMod;

Function GetValidMailBoxName(Const AUserName,APassword:String):String;
Function GetMailBoxList:tStringList;

implementation
Uses IdGlobal;
{$R *.DFM}
Type
    tUserObject = Class(tObject)
       PassWord     : String;
       MBoxName     : String;
       Constructor Create(Const APassword,AMBoxName:String);
    end;

{ if you use a database, this can be used to sequence accesses to the DB which
  normally wouldn't be thread-save
}
Var DBSection : tIdCriticalSection;
{ TPop3DBMod }

function GetValidMailBoxName(const AUserName,APassword: String): String;
{
         A user is logging in. He gave us a Username together with a password.
         Check for a legal combination and return the path to the mailfolder
         if it was NOT successful, return an epty string instead.
}
Var      Nr     : Integer;
         This   : tUserObject;
begin
     With Pop3DBMod do
     begin
          Result := ''; // assume failure
          Nr := fMailBoxList.IndexOf(AUserName);
          If Nr < 0 then Exit; // User is unknown
          This := tUserObject(fMailBoxList.Objects[Nr]);
          If This.PassWord = APassword then Result := This.MBoxName
          Else                              Result := '';
     end;
end;

Function GetMailBoxList:tStringList;
{
     Return a list of all known local mailboxes
}

Var      ii    : Integer;
Begin
     Result := tStringlist.Create;
     Result.Duplicates := DupIgnore;
     With Pop3DBMod do
     begin
          for ii := 0 to fMailBoxList.Count-1 do
          begin
               Result.Add(tUserObject(fMailboxlist.Objects[ii]).MBoxName);
          end;
     end;
end;

procedure TPop3DBMod.DataModuleCreate(Sender: TObject);
begin
     DBSection    := tIdCriticalSection.Create;

     fMailBoxList := tStringList.Create;
     fMailboxlist.Duplicates := DupError;
     fMailboxlist.Sorted := True;

     fEmailAddrs  := tStringlist.Create;
     fEmailAddrs.Duplicates := DupError;
     fEmailAddrs.Sorted := True;

     FillUserList;
     fSendQueue    := tThreadList.Create;
end;

procedure TPop3DBMod.DataModuleDestroy(Sender: TObject);
Var       ii    : Integer;
          MyUsr : tUserObject;
begin
     // Clear MailBoxList
     For ii := 0 to fMailBoxList.Count-1 do
     begin
          MyUsr := tUserObject(fMailBoxList.Objects[ii]);
          FreeAndNil(MyUsr);
          fMailBoxList.Objects[ii] := nil;
     end;
     FreeAndNil(fMailBoxList);
     FreeAndNil(FEmailAddrs);
     FreeAndNil(DBSection);
end;

function TPop3DBMod.AddUser(const AUserName, APassword,AMBoxName: String): Boolean;
{ Add a user to the local system
  AUsername : is the account
  APassword : plain-text password
  AMBoxname : is the folder where this user's mail will be stored.
              actually, this folder is created below the folder where
              this program runs.
  All this information is NOT saved, it is kept in mem as long as the server lives.

}
Var      ThisUser : tUserObject;
begin
     Result := True; // assume all goes well
     try
        ThisUser := tUserObject.Create(APassword,AMBoxName);
        fMailBoxList.AddObject(AUserName,ThisUser);
     Except
           Result := False;
     end;
end;

function TPop3DBMod.AddEmailAccount(const AEmailAddress, AUserName: String): Boolean;
Var      Nr     : Integer;
begin
     Result := False; // Assume Error
     Try
        Nr := MailBoxList.IndexOf(AUserName);
        If Nr < 0 then exit;  // Not found

        EmailAddrs.AddObject(AEmailAddress,Pointer(Nr));
        Result := True;   // Success;
     except
           Exit;
     end;
end;

procedure TPop3DBMod.FillUserList;
{
  Here the Users are fed into the system. Hard coded only, but it's a demo.
  You should again use a database and read out every information.
}
begin
     try
        DBSection.Enter;
{ first the user in the system }
//      AddUser(AccountName,Password,Foldername);
        AddUser('Thats.MySelf','Top_Secret','MyMailBox');
{ then the external email-address and the Username (for delivering inbound mail)}
//      AddEmail(Email-Address,Username)
        AddEmailAccount('[email protected]','Thats.MySelf');
     Finally
            DBSection.Leave;
     end;
end;

function TPop3DBMod.GetMailNumber: Cardinal;
{ This routine (a pretty good database-candidate as well) generates
  a unique ascending number
}
Const   NumberFName = 'MailNum.Dat';
Var     NumberFile  : File of Cardinal;
        FName       : String;
begin
     DBSection.Enter;
     Try
        FName := ExtractFilePath(Application.ExeName)+NumberFName;
        AssignFile(NumberFile,FName);
        If FileExists(FName) Then
        begin
             Reset(NumberFile);
             Read(NumberFile,Result);
             Inc(Result);
             Seek(NumberFile,0);
        end
        else begin
             Rewrite(NumberFile);
             Result := 1; // Start with one
        End;
        Write(NumberFile,Result);
     Finally
            CloseFile(NumberFile);
            DBSection.Leave;
     end;
end;

function TPop3DBMod.GetSendFileName(const AMBox: String): String;
// Generate FileName for a mail to send
begin
     Result := AMBox + '\'
            +  Format('M%.8d.SNT',[GetMailNumber]);
end;

function TPop3DBMod.GetRecvFileName(const AMBox: String): String;
// Generate FileName for a mail to send
begin
     Result := AMBox + '\'
            +  Format('M%.8d.RAW',[GetMailNumber]);
end;

function TPop3DBMod.GetSendMailCount: Integer;
Var      MyList : tList;
begin
     MyList := SendQueue.LockList;
     Result := MyList.Count;
     SendQueue.UnlockList;
end;

procedure TPop3DBMod.EnterToSendMail(const AFileName: String);
{
   Put the Filename to send into our Sendqueue. This is a thread-safe
   list, so we can put in, send and delete simultaneously.
}
begin
     SendQueue.Add(StrNew(PChar(AFileName)));
end;

function TPop3DBMod.GetMBoxName(const AUser: String): String;
Var      Nr  : Integer;
begin
     Result := '';
     Nr := MailBoxList.IndexOf(AUser);
     If Nr < 0 then exit; // Not found, could rise an Exception as well
     Result := tUserObject(MailBoxList.Objects[Nr]).MBoxName;
end;

{ tUserObject }

constructor tUserObject.Create(const APassword,AMBoxName: String);
begin
     Self.PassWord := APassWord;
     Self.MBoxName := AMBoxName;
end;

end.