account.pas

siMail, siMail, siMail, siMail

    property TotalMessageCount: Integer read getTotalMessageCount
      write setTotalMessageCount;   //account contains xxx messages
    property UnreadMessageCount: Integer read getUnreadMessageCount
      write setUnreadMessageCount;   //account contains xxx unread messages
    //user info properties
    property YourName: String read GetYourName write SetYourName;
    property Organization: String read GetOrganization write SetOrganization;
    property EMail: String read GetEMail write SetEMail;
    property ReplyEMail: String read GetReplyEMail write SetReplyEMail;
    property LastSignature: String read GetLastSignature write SetLastSignature;
    property DefaultSignature: String read GetDefaultSignature write SetDefaultSignature;
    property Aliases: String read GetAliases write SetAliases;
    //general account info properties
    property AccountType: TAccountType read GeTAccountType write SeTAccountType;
    property AccountDeliverToAccount: String
      read GetAccountDeliverToAccount write SetAccountDeliverToAccount;
    property AccountPath: String read GetAccountPath write SetAccountPath;
    property AccountPassword: String read GetAccountPassword write SetAccountPassword;
    property AccountPasswordProtected: Boolean
      read GetAccountPasswordProtected write SetAccountPasswordProtected;
    property AccountAttachmentFolder: String
      read GetAccountAttachmentFolder write SetAccountAttachmentFolder;
    //pop3 server properties
    property POP3UserName: String read GetPOP3UserName write SetPOP3UserName;
    property POP3Password: String read GetPOP3Password write SetPOP3Password;
    property POP3Server: String read GetPOP3Server write SetPOP3Server;
    property POP3Port: Integer read GetPOP3Port write SetPOP3Port;
    property POP3Timeout: Integer read GetPOP3Timeout write SetPOP3Timeout;
    property POP3SecureConnection: TSecureConnection
      read GetPOP3SecureConnection write SetPOP3SecureConnection;
    //smtp server properties
    property SMTPUserName: String read GetSMTPUserName write SetSMTPUserName;
    property SMTPPassword: String read GetSMTPPassword write SetSMTPPassword;
    property SMTPServer: String read GetSMTPServer write SetSMTPServer;
    property SMTPPort: Integer read GetSMTPPort write SetSMTPPort;
    property SMTPTimeout: Integer read GetSMTPTimeout write SetSMTPTimeout;
    property SMTPAuthType: TSmtpAuthType read GetSMTPAuthType write SetSMTPAuthType;
    property SMTPSamePwdAsForIncoming: Boolean
      read GetSMTPSamePwdAsForIncoming write SetSMTPSamePwdAsForIncoming;
    property SMTPSecureConnection: TSecureConnection
      read GetSMTPSecureConnection write SetSMTPSecureConnection;
    //incoming properties
    property IncomingLeaveMail: Boolean read GetIncomingLeaveMail
      write SetIncomingLeaveMail;
    property IncomingLeaveMailDays: Integer
      read GetIncomingLeaveMailDays write SetIncomingLeaveMailDays;
    property IncomingShowHeaders: Boolean read GetIncomingShowHeaders
      write SetIncomingShowHeaders;
    property IncomingShowHeadersLarger: Boolean
      read GetIncomingShowHeadersLarger write SetIncomingShowHeadersLarger;
    property IncomingMaxMailSize: Integer read GetIncomingMaxMailSize
      write SetIncomingMaxMailSize;
    property IncomingCheck: Boolean read GetIncomingCheck write SetIncomingCheck;
    property IncomingTime: Integer read GetIncomingTime write SetIncomingTime;
    property IncomingTimeUnit: TIncomingTimeUnit
      read GetIncomingTimeUnit write SetIncomingTimeUnit;
    //notification properties
    property NotificationNotify: Boolean read GetNotificationNotify
      write SetNotificationNotify;
    property NotificationPlaySound: Boolean
      read GetNotificationPlaySound write SetNotificationPlaySound;
    property NotificationSoundFile: String read GetNotificationSoundFile
      write SetNotificationSoundFile;
    property NotificationDisplay: Boolean read GetNotificationDisplay
      write SetNotificationDisplay;
    property NotificationType: TNotificationType
      read GetNotificationType write SetNotificationType;
    property EmptyTrashOnExit: Boolean read GetEmptyTrashOnExit
      write SetEmptyTrashOnExit;
    property EmptyJunkMailOnExit: Boolean read GetEmptyJunkMailOnExit
      write SetEmptyJunkMailOnExit;
  end;

//list frees all objects in Items
type TAccountList = class(TList)
  private
    function GetAccount(Index: Integer): TAccount;
    procedure PutAccount(Index: Integer; const Value: TAccount);
  public
    property Items[Index: Integer]: TAccount read GetAccount write PutAccount; default;
    function Remove(Item: TAccount): Integer;
    function IndexOf(account: TAccount): Integer;
    procedure Insert(Index: Integer; Item: TAccount);
    procedure Delete(Index: Integer);
    function Add(accnt: TAccount): Integer;
    function Count: Integer;
    procedure Clear; override;
    constructor Create;
    destructor Destroy; override;
  end;

type TUser = class
  private
    FAccountList: TAccountList;
    FUserDirPath: String;
    FUserName: String;
    FFileFound: TeasyFileSearch;
    FSignatures: TSignatures;
    FConfig: TxmlConf;
    FUnlocked: Boolean;
    FAddressBook: TAddressBooks;
    procedure findFileFound(FileFound: TFileInformations);
    procedure SetPassword(const Value: String);
    function GetPassword: String;
  public
    function CreateNewAccount(accountName: String): Integer;
    function DeleteAccount(accountID: Integer): Boolean;
    procedure LoadAccounts;
    function Rename(NewUserName: String): Boolean;
    function Unlock(password: String): Boolean;
    constructor Create(UserDirPath, UserName: String);
    destructor Destroy; override;
  protected
  published
    property Signatures: TSignatures read FSignatures;
    property Config: TxmlConf read FConfig;
    property AddressBook: TAddressBooks read FAddressBook;
    property Accounts: TAccountList read FAccountList;
    property UserName: String read FUserName;
    property UserHomeDir: String read FUserDirPath;
    property Password: String read GetPassword write SetPassword;
    property Unlocked: Boolean read FUnlocked write FUnlocked;
  end;

type TUserList = class(TList)
  private
    FID: TList;
    FPath: String;
    FFileFound: TeasyFileSearch;
    procedure findFileFound(FileFound: TFileInformations);
    function getUser(Index: Integer): TUser;
    procedure putUser(Index: Integer; const Value: TUser);
  public
    property Users[Index: Integer]: TUser read GetUser write PutUser; default;
    function Remove(Item: TUser): Integer;
    function IndexOf(user: TUser): Integer;
    procedure Insert(Index: Integer; Item: TUser; ID: Integer);
    procedure Delete(Index: Integer);
    function Add(userName, password: String): Integer; overload;
    function Add(userName: String): Integer; overload;
    function FindUser(userName: String): Integer;
    procedure LoadUserData;
    function DeleteUser(Index: Integer): Boolean;
    procedure Clear; override;
    function Count: Integer;
    constructor Create(Path: String);
    destructor Destroy; override;
  end;

type TUidlList = class(TList)
  private
    FFile: TFileStream;
    function GetUidl(Index: Integer): TUIdl;
    procedure PutUidl(Index: Integer; const Value: TUIdl);
  public
    property Uidl[Index: Integer]: TUIdl read GetUidl write PutUidl; default;
    function Remove(Item: TUIdl): Integer;
    procedure Delete(Index: Integer);
    function Add(Item: TUIdl): Integer;
    function Count: Integer;
    function Find(uidl_: String): Integer;
    function ShouldDelete(Item: TUIdl): Boolean; overload;
    function ShouldDelete(Index: Integer): Boolean; overload;
    procedure Clear; override;
    constructor Create(const filePath: String);
    destructor Destroy; override;
  published
  end;

implementation

const cTocTag = 'si.Mail table of content file. http://simail.sourceforge.net';
const cMbxTag = 'si.Mail mailbox file. http://simail.sourceforge.net';

const cFileVersion = 1;
const cMinFileVersion = 1;
const cFileVersionRead = 1; //we can read up to cFileVersionRead

//const cIdxExt = '.idx';
const cTocExt = '.toc';
const cMbxExt = '.mbx';

const pwdHash: array [0..15] of
    Byte = ($C0, $2C, $6B, $37, $32, $B6, $46, $D0, $8C, $3C, $E3, $31, $40, $C2, $8F, $91);

{ TMailbox }

function TMailbox.AddMessage(const msg: TStream;
  const description: TMsgDescription): Integer;
begin
  FTocHeader.recordLast := FTocHeader.recordLast + 1;
  Result := FTocHeader.recordLast;
  MailboxIndexReallocate; //add more index records to idx file

  FTocHeader.recordCount := FTocHeader.recordCount + 1;
  writeMsgIndex(FTocHeader.recordLast, description);
  writeMsgStrm(FTocHeader.recordLast, msg);
  saveHeaders;
end;

constructor TMailbox.Create(FAccountPath, mailboxName: String);
begin
  inherited Create;
  FDeleted := False;
  FMailboxPath := FAccountPath;
  FMailboxName := mailboxName;
  FTocFile := nil;
  FMbxFile := nil;

  OpenMailbox(500);

    //memory stream used to prepare record to write it to file is
    //created only once so we do not have any overhead if we need
    //to save lots of messages
  FmsIdx := nil;
  FmsIdx := TMemoryStream.Create;

    //this is used to pad each record to FTocHeader.sectorSize * cBaseSectorSize boundry
  SetLength(FEmptySector, (FTocHeader.sectorSize * cBaseSectorSize));
end;

destructor TMailbox.Destroy;
begin
  if not FDeleted then closeMailbox;

  FmsIdx.Free;
  FEmptySector := nil;
  FRecordMap := nil;

  inherited Destroy;
end;

function TMailbox.GetMessageContent(const msgId: Integer): TStream;
var strm: TMemoryStream;
var toc2mbx: TToc2mbxMap;
begin

  strm := TMemoryStream.Create; //this stream must be freed outside
    //get message offset, skip blockStart
  FTocFile.Position := sizeOf(FTocHeader) + (FRecordMap[msgId].startSector *
    FTocHeader.sectorSize * cBaseSectorSize) +
    sizeOf(TRecordBlockStart);
  FTocFile.Read(toc2mbx, sizeOf(toc2mbx));

    //read data from mbx,skip blockStart
  FMbxFile.Position := sizeOf(FTocHeader) + (toc2mbx.startSector *
    FTocHeader.sectorSize * cBaseSectorSize) +
    sizeOf(TRecordBlockStart);
  strm.Clear;
  strm.SetSize(toc2mbx.size);
  strm.CopyFrom(FMbxFile, toc2mbx.size);
  Result := strm;
end;

function TMailbox.GetMessageDescription(const msgId: Integer): TMsgDescription;
begin
    //seek to msgId description
  FTocFile.Position := sizeOf(FTocHeader) + (FRecordMap[msgId].startSector *
    FTocHeader.sectorSize * cBaseSectorSize) +
    sizeOf(TRecordBlockStart) +
    sizeOf(TToc2mbxMap);

  FmsIdx.Clear;
  FmsIdx.CopyFrom(FTocFile, FRecordMap[msgId].sectorCount * FTocHeader.sectorSize *
    cBaseSectorSize - (sizeOf(TRecordBlockStart) + sizeOf(TToc2mbxMap)));
  FmsIdx.Position := 0;

  if FRecordMap[msgId].deleted then begin
    Result.deleted := True;
    Exit;
  end
  else Result.deleted := False;

    //read record from stream
  with FmsIdx do begin
    with Result do begin
      subject := readWideStringFromStream(FmsIdx);
      from := readWideStringFromStream(FmsIdx);
      comment := readWideStringFromStream(FmsIdx);
      msgPart := readWideStringFromStream(FmsIdx);
      Read(date, sizeOf(date));
      Read(size, sizeOf(size));
      Read(markId, sizeOf(markId));
      Read(status, sizeOf(status));
      Read(replyDate, sizeOf(replyDate));
      Read(forwardDate, sizeOf(forwardDate));
      Read(priority, sizeOf(priority));
      forwardedTo := readWideStringFromStream(FmsIdx);
      account := readWideStringFromStream(FmsIdx);
      uidl := readStringFromStream(FmsIdx);
      Read(reserved, sizeOf(reserved));
    end;
  end;
end;

//this procedure allocates more space for record maps, adjusts record maps to
//point to new location, and copies records from old file. No clean-up is
//performed. Use Mailbox.Compact to clean-up both toc and mbx file.
procedure TMailbox.MailboxIndexReallocate;
var oldHdr: TTocHeader;
var oldFile: TFileStream;
var i: Integer;
var offset: Longword;
var oldMap: array of TRecordMap;
begin
  if FTocHeader.recordLast = FTocHeader.recordMapAlloc then begin
    closeMailbox;

        //delete .old file if exists
    DeleteFile(PChar(FmailboxPath + FmailboxName + cTocExt + '.old'));
    RenameFile(FmailboxPath + FmailboxName + cTocExt, FmailboxPath +
      FmailboxName + cTocExt + '.old');
        //file we are reading from is now known as FmailboxName.idxtoc.old
    oldFile := TFileStream.Create(FmailboxPath + FmailboxName +
      cTocExt + '.old', fmOpenRead);

    OpenMailbox((FTocHeader.recordMapAlloc div
      ((FTocHeader.sectorSize * cBaseSectorSize) div sizeOf(TRecordMap))) + 500);

    oldFile.Read(oldHdr, sizeOf(oldHdr));
        //allocate space for old Record Maping
    SetLength(oldMap, oldHdr.recordMapAlloc);
        //load old record maps
    oldFile.Read(oldMap[0], sizeOf(oldMap[0]) * oldHdr.recordMapAlloc);

    FTocFile.Position := sizeOf(FTocHeader);
        //calculate record ofset from old to new file (in sectors)
    offset := (FTocHeader.recordMapAlloc div ((FTocHeader.sectorSize * cBaseSectorSize)
      div sizeof(TRecordMap))) - (oldHdr.recordMapAlloc div
      ((FTocHeader.sectorSize * cBaseSectorSize) div sizeof(TRecordMap)));

        //copy records maps from old to new file and adjust start sector
    for i := 0 to oldHdr.recordMapAlloc - 1 do begin
      FRecordMap[i] := oldMap[i];
      if oldMap[i].startSector <> 0 then
        FRecordMap[i].startSector := oldMap[i].startSector + offset;
      FTocFile.Write(FRecordMap[i], sizeOf(FRecordMap[0]));
    end;


    FTocFile.Position := sizeOf(FTocHeader) +
      (FTocHeader.recordMapAlloc * sizeOf(FRecordMap[0]));
        //copy records
    if (oldFile.Size - oldFile.Position) > 0 then
      FTocFile.CopyFrom(oldFile, oldFile.Size - oldFile.Position);

    oldFile.Free;
        //delete .old file it is not needed anymore
    DeleteFile(PChar(FmailboxPath + FmailboxName + cTocExt + '.old'));
    oldMap := nil;

        //rewrite some information from oldHdr to FTocHeader
    i := FTocHeader.recordMapAlloc;
    offset := offset + oldHdr.lastSector;
    FTocHeader := oldHdr;
    FTocHeader.recordMapAlloc := i;
    FTocHeader.lastSector := offset;
  end;
end;

function TMailbox.RemoveMessage(const msgId: Integer): Boolean;
var blockStart: TRecordBlockStart;
var idx2mbx: TToc2mbxMap;
var msgInfo: TMsgDescription;
begin
  Result := False;
  msgInfo := GetMessageDescription(msgId);
 //read msgInfo before marking message as deleted

  ZeroMemory( @blockstart, sizeOf(blockstart));
  blockstart.bs := cRecordBlockStart;

  FrecordMap[msgId].deleted := True;
    //write record map
  FTocFile.Position := sizeOf(FTocHeader) + (sizeOf(FrecordMap[msgId]) * msgId);
  FTocFile.Write(FrecordMap[msgId], sizeOf(FrecordMap[msgId]));

    //now mark both the blocks within mail toc (in ioc file) and mail (mbx file) UNUSED
  blockStart.unused := True;
  FTocFile.Position := sizeOf(FTocHeader) + FrecordMap[msgId].startSector *
    FTocHeader.sectorSize * cBaseSectorSize;
  FTocFile.Write(blockStart, sizeOf(blockStart));
    //read mail location in mbx file
  FTocFile.Read(idx2mbx, sizeOf(idx2mbx));