account.pas

siMail, siMail, siMail, siMail

(*
# (C) Copyright 2003
# Miha Vrhovnik, [e-mail]
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
#
# The Initial Developer of the Original Code is Miha Vrhovnik (Slovenia).
# Portions created by Miha Vrhovnik are Copyright (c)2000-2003.
# All Rights Reserved.
#==============================================================================
# Contributor(s):
#==============================================================================
# History: see whats new.txt from distribution package
#==============================================================================
*)

unit account;

interface
uses SysUtils, Classes, Windows, Dialogs, OmniXMLConf, base64, FileSearch,
  EasyFileSearch, signatures, addrBk, Forms;

type TAccountType = (accPOP, accIMAP, accHTML);
type TSmtpAuthType = (smtpAuthNone, smtpAuthAutomatic);
type TSecureConnection = (scNone, scAutoTSL, scSSL);
type TIncomingTimeUnit = (ituSeconds, ituMinutes, ituHours);
type TNotificationType = (ntBalloon, ntWindow, ntAnimated);
type TMailboxType = (mbox0, mboxNew, mboxInbox, mboxUnsent, mboxUnfinished,
    mboxSent, mboxTrash, mboxJunk, mboxOther);

//this type takes 2 bytes when saved to file
type TMsgStatus = (msgReplied, msgForwarded, msgRead, msgAttachmentInside,
    msgAttachmentOutside, msgNotUsed1, msgNotUsed2, msgNotUsed3,
    msgNotUsed4);

type TMsgDescription = record
    subject: WideString; //message subject
    from: WideString;    //message is from ...
    comment: WideString; //message comment
    msgPart: WideString; //part of message e.g first 256 bytes
    date: TDateTime; //message date/time
    size: Integer;  //message size
    markId: Byte;        //message is marked as...
    status: set of TMsgStatus; //message status e.g. read, replyed, forward,...
    replyDate: TDateTime;    //stores message reply date/time
    forwardDate: TDateTime;  //stores message forward date/time
    priority: Byte;  //message priority
    forwardedTo: WideString; //message was forwarded to ...
    account: WideString; //message was composed received with account
    uidl: String;
    //message unique id (from server) it is allways in ASCII so we don't need widestring here
    reserved: array [0..63] of Char; //reserve for future use
    id: Longword;    //message id
    deleted: Boolean; //message was deleted
  end;

//start of low level types (file based)
//mailbox index file header
type TTocHeader = packed record //128B
    tag: array [0..63] of Char; //unique file tag
    fileVersion: Longword;      //
    minVersion: Longword;
       //program must support minimum minVersion to read/write files
    clean: Boolean;             //was it clean shutdown
    sectorSize: Byte;           //SectorSize*128B
    lastSector: Longword;       //1st unused sector
    unusedSectors: Longword;    //no of unused sectors in file
    recordCount: Longword;
      //record count in file this is used for total message count too
    recordMapAlloc: Longword;   //record Map allocation Size
    recordLast: Integer;        //last record used
    password: array [0..9] of Char;
 //we save only firstg 10 chars of password. for encryption same key is used as for xml files
    unreadCount: Longword;      //unread message count
    reserved: array [0..19] of Char;
  end;

//this type maps each record in idx file to corresponding e-mail message
//it is written imediately after TRecordBlockStart
type TToc2mbxMap = packed record
    startSector: Longword;   //so we can directy seek the message
    size: Longword;          //so we know how much data we can read
    sectorCount: Longword;
   //so we can write msg on same place if it fits to allready allocated space
  end;

//mailbox file header
type TMbxHeader = packed record //128B
    tag: array [0..63] of Char; //unique file tag
    fileVersion: Longword;      //
    minVersion: Longword;
       //program must support minimum minVersion to read/write files
    clean: Boolean;             //was it clean shutdown
    sectorSize: Byte;           //SectorSize*128B
    lastSector: Longword;       //1st unused sector
    unusedSectors: Longword;    //no of unused sectors in file
    reserved: array [0..45] of Char;
  end;

//this header is in front of each block in idx and mbx file
type TRecordBlockStart = packed record //24B
    bs: array [0..16] of Char;           //block start is used for simplify file recovery
    unused: Boolean;                    //block is unused
    reserved: array [0..5] of Byte; //reserved for future use
  end;

//index file to real index record map
//!!!!! sizeOf recordMap MUST divide all available sector sizes!!!!!!
type TRecordMap = packed record //16B
    deleted: Boolean;
    compressed: Boolean;
    startSector: Longword;
    sectorCount: Longword;
    reserved: array [0..5] of Byte;
  end;

//uidl.dat file type
type TUidl = record
    uidl: String;
    deleteDate: TDateTime;
    ignore: Boolean;
  end;
type PUidl = ^TUidl;

(*
- uidl.dat file structure
$00 recordCount
$04 TUidl
....
*)

// end of low-level types

//mailbox exceptions
type EMailboxNotValidFile = class(Exception);
  EMailboxNewerVersion = class(Exception);

(*
    - toc file structure
      $00       TTocHeader
      $80       TRecordMap * TTocHeader.recordMapAlloc
      ...
      $??
      $??       TBlockStart
      $?? + $18 TToc2mbxMap
      $?? + $20 TMsgDescription (everything except deleted and id)!!!!
      ...

      strings are written to file as folowing: string length (4 bytes) + actual string
      all blocks except the 1st one and part with recod maps are
      cBaseSectorSize * TTocHeader.sectorSize

    - mbx file structure
    $00         TMbxHeader
    $80         1st msg TBlockStart
    $98         1st message
    ...

    all blocks except the 1st one are cBaseSectorSize * TMbxHeader.sectorSize

*)

const cRecordBlockStart = '-> BLOCK_start <-';
const cBaseSectorSize = 128;

function DoPassword(str: String): String;
procedure DelTree(const Directory: TFileName);
procedure writeWideStringToStream(stream: TStream; Value: WideString);
procedure writeStringToStream(stream: TStream; Value: String);
function readWideStringFromStream(stream: TStream): WideString;
function readStringFromStream(stream: TStream): String;

//this class handles low-level mailBox routines
type TMailbox = class
  private
    FDeleted: Boolean;
    FMailboxPath: String;
    FMailboxName: String;
    FTocFile: TFileStream;
    FMbxFile: TFileStream;
    FTocHeader: TTocHeader;
    FMbxHeader: TMbxHeader;
    FRecordMap: array of TRecordMap;
    FEmptySector: array of Byte;
    FmsIdx: TMemoryStream;    //memory stream used to prepare record to write it to file
    FCurrentMessage: Integer;
    FId: Integer;
    FUnlocked: Boolean;
    FPassword: String;
    procedure mailboxIndexReallocate;
    procedure writeMsgIndex(msgId: Integer; descr: TMsgDescription);
    procedure writeMsgStrm(msgId: Integer; msg: TStream);
    function getSectorCount(const size: Integer): Integer;
    function openMailbox(sectorCount: Integer): Boolean;
 //sectir count is used only for idx file
    procedure closeMailbox;
    procedure setId(const Value: Integer);
    function getTotalMessageCount: Integer;
    function getUnreadMessageCount: Integer;
    procedure saveHeaders;
    function getLastMessageIndex: Integer;
    procedure setPassword(const Value: String);
  public
    function AddMessage(const msg: TStream; const description: TMsgDescription): Integer;
    function RemoveMessage(const msgId: Integer): Boolean;
    function ReplaceMessage(const msgId: Integer; const msg: TStream;
      const description: TMsgDescription): Boolean;
    function GetMessageDescription(const msgId: Integer): TMsgDescription;
    function GetMessageContent(const msgId: Integer): TStream;
    function ReplaceDescription(const msgId: Integer;
      const description: TMsgDescription): Boolean;
    function Pack: Boolean;      //remove unused space from mailbox
    function Empty: Boolean;  //empty mailbox
    function Compress(factor: Byte; compress: Boolean): Boolean;
 //compress mailbox use compr 1-9 compress=true compress else uncompress
    function FindMessage: Integer;
    procedure DeleteFiles;
    function Rename(newName: String): Integer;
    function UnusedSpace(index: Boolean): Integer;
    function FileSize(index: Boolean): Integer;
    function Unlock(password: String): Boolean;
    constructor Create(FaccountPath, mailboxName: String);
    destructor Destroy; override;
  protected
  published
    property TotalMessageCount: Integer read getTotalMessageCount;
   //mailbox contains xxx messages
    property UnreadMessageCount: Integer read getUnreadMessageCount;
   //mailbox contains xxx unread messages
    property CurrentMessage: Integer read FcurrentMessage;
  //indicates message we are compressing/ compacting
    property MailboxName: String read FmailboxName;
    property Id: Integer read Fid write Setid;
    property LastMessageIndex: Integer read GetLastMessageIndex;
    property Unlocked: Boolean read FUnlocked;
    property Password: String read FPassword write SetPassword;
  end;

//list frees all objects in Items
type TMailboxList = class(TList)
  private
    function getMailbox(Index: Integer): TMailbox;
    procedure putMailbox(Index: Integer; const Value: TMailbox);
  public
    property Items[Index: Integer]: TMailbox read GetMailbox write PutMailbox;
      default;
    function Remove(Item: TMailbox): Integer;
    function IndexOf(Item: TMailbox): Integer;
    procedure Insert(Index: Integer; Item: TMailbox; ID: Integer);
    procedure Delete(Index: Integer);
    function Add(mailbox: TMailbox; id: Integer): Integer;
    function Count: Integer;
    function Find(mailboxName: String): Integer;
    procedure Clear; override;
    constructor Create;
    destructor Destroy; override;
  end;

//this class handles User accounts
type TAccount = class
  private
    FMailboxList: TMailboxList;
    FAccountPath: String;
    FAccountName: String;
    FLastID: Integer;
    FAccConf: TxmlConf;
    FFileFound: TEasyFileSearch;
    FDeleteMode: Boolean;
    FDeleteSuccesfull: Boolean;
    procedure findFileFound(FileFound: TFileInformations);
    procedure loadMailboxes;
    function getAccountPath: String;
    function getDefaultSignature: String;
    function getAccountDeliverToAccount: String;
    function getEMail: String;
    function getLastSignature: String;
    function getOrganization: String;
    function getReplyEMail: String;
    function getYourName: String;
    procedure setAccountPath(const Value: String);
    procedure setDefaultSignature(const Value: String);
    procedure setAccountDeliverToAccount(const Value: String);
    procedure setEMail(const Value: String);
    procedure setLastSignature(const Value: String);
    procedure setOrganization(const Value: String);
    procedure setReplyEMail(const Value: String);
    procedure setYourName(const Value: String);
    function getAccountType: TAccountType;
    procedure setAccountType(const Value: TAccountType);
    function getPOP3Password: String;
    function getPOP3Port: Integer;
    function getPOP3Server: String;
    function getPOP3Timeout: Integer;
    function getPOP3UserName: String;
    procedure setPOP3Password(const Value: String);
    procedure setPOP3Port(const Value: Integer);
    procedure setPOP3Server(const Value: String);
    procedure setPOP3Timeout(const Value: Integer);
    procedure setPOP3UserName(const Value: String);
    function getSMTPAuthType: TSmtpAuthType;
    function getSMTPPassword: String;
    function getSMTPPort: Integer;
    function getSMTPServer: String;
    function getSMTPTimeout: Integer;
    function getSMTPUserName: String;
    procedure setSMTPAuthType(const Value: TSmtpAuthType);
    procedure setSMTPPassword(const Value: String);
    procedure setSMTPPort(const Value: Integer);
    procedure setSMTPServer(const Value: String);
    procedure setSMTPTimeout(const Value: Integer);
    procedure setSMTPUserName(const Value: String);
    function getAccountAttachmentFolder: String;
    function getAccountPassword: String;
    function getAccountPasswordProtected: Boolean;
    procedure setAccountAttachmentFolder(const Value: String);
    procedure setAccountPassword(const Value: String);
    procedure setAccountPasswordProtected(const Value: Boolean);
    function getTotalMessageCount: Integer;
    function getUnreadMessageCount: Integer;
    procedure setTotalMessageCount(const Value: Integer);
    procedure setUnreadMessageCount(const Value: Integer);
    function GetSMTPSamePwdAsForIncoming: Boolean;
    procedure SetSMTPSamePwdAsForIncoming(const Value: Boolean);
    function GetPOP3SecureConnection: TSecureConnection;
    procedure SetPOP3SecureConnection(const Value: TSecureConnection);
    function GetIncomingCheck: Boolean;
    function GetIncomingLeaveMail: Boolean;
    function GetIncomingLeaveMailDays: Integer;
    function GetIncomingMaxMailSize: Integer;
    function GetIncomingTime: Integer;
    function GetIncomingTimeUnit: TIncomingTimeUnit;
    procedure SetIncomingCheck(const Value: Boolean);
    procedure SetIncomingLeaveMail(const Value: Boolean);
    procedure SetIncomingLeaveMailDays(const Value: Integer);
    procedure SetIncomingMaxMailSize(const Value: Integer);
    procedure SetIncomingTime(const Value: Integer);
    procedure SetIncomingTimeUnit(const Value: TIncomingTimeUnit);
    function GetNotificationDisplay: Boolean;
    function GetNotificationNotify: Boolean;
    function GetNotificationPlaySound: Boolean;
    function GetNotificationSoundFile: String;
    function GetNotificationType: TNotificationType;
    procedure SetNotificationDisplay(const Value: Boolean);
    procedure SetNotificationNotify(const Value: Boolean);
    procedure SetNotificationPlaySound(const Value: Boolean);
    procedure SetNotificationSoundFile(const Value: String);
    procedure SetNotificationType(const Value: TNotificationType);
    function GetIncomingShowHeaders: Boolean;
    function GetIncomingShowHeadersLarger: Boolean;
    procedure SetIncomingShowHeaders(const Value: Boolean);
    procedure SetIncomingShowHeadersLarger(const Value: Boolean);
    function GetSMTPSecureConnection: TSecureConnection;
    procedure SetSMTPSecureConnection(const Value: TSecureConnection);
    function GetEmptyJunkMailOnExit: Boolean;
    function GetEmptyTrashOnExit: Boolean;
    procedure SetEmptyJunkMailOnExit(const Value: Boolean);
    procedure SetEmptyTrashOnExit(const Value: Boolean);
    function GetAliases: String;
    procedure SetAliases(const Value: String);
  public
    function CreateNewMailbox(mailboxName: String): Integer;
    function DeleteMailbox(mailbox: TMailbox): Integer;
    function RenameMailbox(mailbox: TMailbox; newMailboxName: String): Boolean;
    function Rename(newAccountName: String): Boolean;
    function DeleteFiles: Boolean;
    constructor Create(_FaccountPath, _accountName: String);
    destructor Destroy; override;
  protected
  published
    property AccountName: String read FaccountName;
    property Mailboxes: TMailboxList read FMailboxList;