account.pas

siMail, siMail, siMail, siMail

        Format('''%s'' is not valid Mailbox index file.', [FmailboxPath +
        FmailboxName + cTocExt]));
//raise exception

    if FTocHeader.minVersion > cFileVersionRead then
      raise EMailboxNewerVersion.Create(
        Format('''%s'' requires newer version of si.Mail (v.%d).', [FmailboxPath +
        FmailboxName + cTocExt, FTocHeader.minVersion]));//raise exception
  end;

    //clear memory occupied by FMbxHeader
  ZeroMemory( @FMbxHeader, sizeOf(FMbxHeader));
  if FMbxFile.Size = 0 then begin//write header
    with FMbxHeader do begin
      tag := cMbxTag;
      fileVersion := cFileVersion;
      minVersion := cMinFileVersion;
      clean := False;
      sectorSize := 1;//must equal to FTocHeader.sectorSize
      lastSector := 1;
    end;
        //write default header
    FMbxFile.Write(FMbxHeader, sizeOf(FMbxHeader))
  end
  else begin//check header
        //read Header
    FMbxFile.Read(FMbxHeader, sizeOf(FMbxHeader));

        //is this correct file
    if StrComp(PChar(String(FMbxHeader.tag)), cMbxTag) <> 0 then
      raise EMailboxNotValidFile.Create(
        Format('''%s'' is not valid Mailbox file.', [FmailboxPath + FmailboxName + cMbxExt]));
//raise exception

    if FMbxHeader.minVersion > cFileVersionRead then
      raise EMailboxNewerVersion.Create(
        Format('''%s'' requires newer version of si.Mail.', [FmailboxPath +
        FmailboxName + cMbxExt]));//raise exception
  end;

    //allocate space for Record Maping
  SetLength(FrecordMap, FTocHeader.recordMapAlloc);
    //load record maps
  FTocFile.Read(FrecordMap[0], sizeOf(FrecordMap[0]) * FTocHeader.recordMapAlloc);

  if String(FTocHeader.password) = '' then FUnlocked := True
  else FUnlocked := False;
  FPassword := FTocHeader.password;

  Result := True;
end;

procedure TMailbox.closeMailbox;
begin
    //write idx file header
  FTocHeader.clean := True;
  FTocFile.Position := 0;
  FTocFile.Write(FTocHeader, sizeOf(FTocHeader));

    //write mbx file header
  FMbxHeader.clean := True;
  FMbxFile.Position := 0;
  FMbxFile.Write(FMbxHeader, sizeOf(FMbxHeader));

  FTocFile.Free;
  FMbxFile.Free;
end;

function readWideStringFromStream(stream: TStream): WideString;
var len: Integer;
begin
  stream.Read(len, sizeOf(len));
  SetLength(Result, len);
  stream.Read(PWideChar(Result)^, len * 2);
end;

procedure writeWideStringToStream(stream: TStream; Value: WideString);
var len: Integer;
begin
  len := Length(Value);
  stream.Write(len, sizeOf(len));
  stream.Write(PWideChar(Value)^, len * 2);
end;

function readStringFromStream(stream: TStream): String;
var len: Integer;
begin
  stream.Read(len, sizeOf(len));
  SetLength(Result, len);
  stream.Read(PChar(Result)^, len);
end;

procedure writeStringToStream(stream: TStream; Value: String);
var len: Integer;
begin
  len := Length(Value);
  stream.Write(len, sizeOf(len));
  stream.Write(PChar(Value)^, len);
end;

function TMailbox.FindMessage: Integer;
begin

end;

procedure TMailbox.DeleteFiles;
begin
  FDeleted := True;
  closeMailbox;
  DeleteFile(PChar(FmailboxPath + FmailboxName + cTocExt));
  DeleteFile(PChar(FmailboxPath + FmailboxName + cMbxExt));
end;

procedure TMailbox.Setid(const Value: Integer);
begin
  Fid := Value;
end;

function TMailbox.getTotalMessageCount: Integer;
begin
  Result := FTocHeader.recordCount;
end;

function TMailbox.getUnreadMessageCount: Integer;
begin
  Result := FTocHeader.unreadCount;
end;

function TMailbox.Rename(newName: String): Integer;
begin
  Result := -1;
  closeMailbox;
  RenameFile(FmailboxPath + FmailboxName + cTocExt, FmailboxPath + newName + cTocExt);
  RenameFile(FmailboxPath + FmailboxName + cMbxExt, FmailboxPath + newName + cMbxExt);
  FmailboxName := newName;
    //reOpenMailbox
  OpenMailbox(500);
  Result := 0;
end;

procedure TMailbox.saveHeaders;
begin
    //we write header to file each time we add,update or delete the message
  FTocFile.Position := 0;
  FTocFile.Write(FTocHeader, sizeOf(FTocHeader));
  FMbxFile.Position := 0;
  FMbxFile.Write(FMbxHeader, sizeOf(FMbxHeader));
end;

function TMailbox.FileSize(index: Boolean): Integer;
begin
  if index then Result := FTocFile.Size
  else Result := FMbxFile.Size;
end;

function TMailbox.GetLastMessageIndex: Integer;
begin
  Result := FTocHeader.recordLast + 1;
end;

function TMailbox.UnusedSpace(index: Boolean): Integer;
begin
  if index then Result := FTocHeader.unusedSectors * FTocHeader.sectorSize *
      cBaseSectorSize
  else  Result := FMbxHeader.unusedSectors * FMbxHeader.sectorSize * cBaseSectorSize;
end;

function TMailbox.Empty: Boolean;
begin
  Result := False;
    //we actually delete files here
  DeleteFiles;
  OpenMailbox(500);
  FDeleted := False;
  Result := True;
end;

function TMailbox.ReplaceDescription(const msgID: Integer;
  const description: TMsgDescription): Boolean;
begin
  Result := False;

  writeMsgIndex(msgId, description);
  saveHeaders;
  Result := True;
end;

procedure TMailbox.SetPassword(const Value: String);
var tmpStr: String;
var i: Integer;
begin
  FPassword := Value;

  //set encrypted pwd length to Length(FTocHeader.password)
  SetLength(tmpStr, Length(FTocHeader.password));
  for i := 1 to Length(FTocHeader.password) do begin
    if i < Length(Value) then
      tmpStr[i] := Value[i]
    else
      tmpStr[i] := #0;
  end;

  //if value is emty we remove password protection
  if Value <> '' then tmpStr := DoPassword(tmpStr);

  for i := 0 to Length(FTocHeader.password) - 1 do begin
    FTocHeader.password[i] := tmpStr[i + 1];
  end;
  FUnlocked := True;
  saveHeaders;
end;

function TMailbox.Unlock(password: String): Boolean;
var i: Integer;
var tmpStr: String;
begin
    //set encrypted pwd length to Length(FTocHeader.password)
  SetLength(tmpStr, Length(FTocHeader.password));
  for i := 1 to Length(FTocHeader.password) do begin
    if i < Length(password) then
      tmpStr[i] := password[i]
    else
      tmpStr[i] := #0;
  end;

  if DoPassword(tmpStr) = FTocHeader.password then begin
    FUnlocked := True;
    Result := True;
  end
  else begin
    FUnlocked := False;
    Result := False;
  end;
end;

{ TAccounts }

constructor TAccount.Create(_FaccountPath, _accountName: String);
begin
  inherited Create;
  FDeleteMode := False;

  FaccConf := TxmlConf.Create(_FaccountPath + 'config.xml');
  FfileFound := TEasyFileSearch.Create(nil);
  FfileFound.OnFileFound := findfileFound;
  FfileFound.SearchOptions := [okLookForAnyFile, okIncludeSubfolder];

  if AccountPath = '' then begin
    FaccountPath := _FaccountPath;
  end
  else FaccountPath := FaccountPath;

  FaccountName := _accountName;
  FLastID := -1;

  LoadMailboxes;
end;

function TAccount.CreateNewMailbox(mailboxName: String): Integer;
var mbox: TMAilbox;
begin
  mbox := TMailbox.Create(FaccountPath, mailboxName);
  FMailboxList.Add(mbox, FLastID + 1);
  Inc(FLastID);
  Result := FLastID;
end;

destructor TAccount.Destroy;
begin
  FMailBoxList.Free;
  FaccConf.Free;
  FfileFound.Free;
  inherited Destroy;
end;

{ TMailboxList }

function TMailboxList.Add(mailbox: TMailbox; ID: Integer): Integer;
begin
  mailbox.id := ID;
  Result := inherited Add(mailbox);
end;

procedure TMailboxList.Clear;
var i: Integer;
begin
  for i := 0 to Count - 1 do begin
    Items[i].Free;
  end;

  inherited Clear;
end;

function TMailboxList.Count: Integer;
begin
  Result := inherited Count;
end;

constructor TMailboxList.Create;
begin
  inherited Create;

end;

procedure TMailboxList.Delete(Index: Integer);
begin
  Items[Index].Free;
  inherited Delete(Index);
end;

destructor TMailboxList.Destroy;
begin
   //Clear; we do not have to call this here it is called by Destroy
  inherited Destroy;
end;

function TMailboxList.Find(mailboxName: String): Integer;
var i, c: Integer;
begin
  Result := -1;
  c := Count - 1;
  for i := 0 to c do begin
    if AnsiStrIComp(PChar(mailboxName), PChar(Items[i].MailboxName)) = 0 then begin
      Result := i;
      Break;
    end;
  end;
end;

function TMailboxList.GetMailbox(Index: Integer): TMailbox;
begin
  Result := (inherited Items[Index]);
end;

function TMailboxList.IndexOf(item: TMailbox): Integer;
begin
  Result := inherited IndexOf(item);
end;

procedure TMailboxList.Insert(Index: Integer; Item: TMailbox; ID: Integer);
begin
  inherited Insert(Index, Item);
end;

procedure TMailboxList.PutMailbox(Index: Integer; const Value: TMailbox);
begin
  inherited Put(index, Value);
end;

function TMailboxList.Remove(Item: TMailbox): Integer;
begin
  Items[inherited IndexOf(Item)].Free;
  Result := inherited Remove(Item);
end;

function TAccount.DeleteMailbox(mailbox: TMailbox): Integer;
begin
  if mailbox.id >= 0 then begin
    FMailboxList.Items[FMailboxList.IndexOf(mailbox)].deleteFiles;
    FMailboxList.Delete(FMailboxList.IndexOf(mailbox));
  end;
end;

function TAccount.RenameMailbox(mailbox: TMailbox; newMailboxName: String): Boolean;
begin
  if mailbox.id >= 0 then begin
    FMailboxList.Items[FMailboxList.IndexOf(mailbox)].Rename(newMailboxName);
  end;
end;

{ TUserList }

function TUserList.Add(userName, password: String): Integer;
var usr: TUser;
begin
  Result := -1;
  ForceDirectories(FPath + userName);
  usr := TUser.Create(FPath + userName + '\', userName);
  usr.Password := password;
  Result := (inherited Add(usr));
end;

function TUserList.Add(userName: String): Integer;
var usr: TUser;