account.pas

siMail, siMail, siMail, siMail

    //update unused sector count
  FTocHeader.unusedSectors := FTocHeader.unusedSectors + FrecordMap[msgId].sectorCount;
  FMbxHeader.unusedSectors := FMbxHeader.unusedSectors + idx2mbx.sectorCount;

  FMbxFile.Position := sizeOf(FMbxHeader) + idx2mbx.startSector *
    FMbxHeader.sectorSize * cBaseSectorSize;
  FMbxFile.Write(blockStart, sizeOf(blockStart));

  if (FTocHeader.unreadCount <> 0) and not (msgRead in msgInfo.status) then
    FTocHeader.unreadCount := FTocHeader.unreadCount - 1;

  if FTocHeader.recordCount <> 0 then
    FTocHeader.recordCount := FTocHeader.recordCount - 1;

  saveHeaders;
  Result := True;
end;

function TMailbox.ReplaceMessage(const msgId: Integer; const msg: TStream;
  const description: TMsgDescription): Boolean;
begin
  Result := False;

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

procedure TMailbox.WriteMsgStrm(msgId: Integer; msg: TStream);
var idx2mbx: TToc2mbxMap;
var blockStart: TRecordBlockStart;
var padCount: Integer;
begin

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

    //read old idx2mbxMap
  FTocFile.Position := sizeOf(FTocHeader) + (FRecordMap[msgId].startSector *
    FTocHeader.sectorSize * cBaseSectorSize) + sizeOf(blockstart);
  FTocFile.Read(idx2mbx, sizeOf(idx2mbx));

  if (idx2mbx.startSector = 0) and (idx2mbx.size = 0) and
    (idx2mbx.sectorCount = 0) then
  begin //new msg
    idx2mbx.size := msg.Size;
    idx2mbx.startSector := FMbxHeader.lastSector;
    idx2mbx.sectorCount := getSectorCount(msg.Size + sizeOf(blockStart));
        //update last sector
    FMbxHeader.lastSector := FMbxHeader.lastSector +
      getSectorCount(msg.Size + sizeOf(blockStart));
  end
  else begin //overwrite old message
    if getSectorCount(msg.Size + sizeOf(blockStart)) > idx2mbx.sectorCount then begin
            //update unused sector count
      FMbxHeader.unusedSectors := FMbxHeader.unusedSectors + idx2mbx.sectorCount;

            //first overwrite old record start with unused flag
      blockstart.unused := True;
      FMbxFile.Position := sizeOf(FMbxHeader) + idx2mbx.startSector *
        FMbxHeader.sectorSize * cBaseSectorSize;
      FMbxFile.Write(blockStart, sizeOf(blockStart));
      blockstart.unused := False;

            //get start sector
      idx2mbx.startSector := FMbxHeader.lastSector;
      idx2mbx.sectorCount := getSectorCount(msg.Size + sizeOf(blockStart));
 //get msg sector count
            //update last sector
      FMbxHeader.lastSector := FMbxHeader.lastSector +
        getSectorCount(msg.Size + sizeOf(blockStart));
    end;
    idx2mbx.size := msg.Size; //size must be always updated
  end;

    //write mbx data
  FMbxFile.Position := sizeOf(FMbxHeader) + idx2mbx.startSector *
    FTocHeader.sectorSize * cBaseSectorSize;
  msg.Position := 0;
  FMbxFile.Write(blockStart, sizeOf(blockStart));
  FMbxFile.CopyFrom(msg, msg.Size);

    //how many bytes wee need that record position will be aligned to (FTocHeader + (FTocHeader.sectorSize * cBaseSectorSize))
  padCount := (msg.Size + sizeOf(blockStart)) mod
    (FMbxHeader.sectorSize * cBaseSectorSize);
  if padCount <> 0 then padCount := (FMbxHeader.sectorSize * cBaseSectorSize) - padCount;
  FMbxFile.Write(FemptySector[0], padCount);

    //update idxtoc
  FTocFile.Position := sizeOf(FTocHeader) + (FRecordMap[msgId].startSector *
    FTocHeader.sectorSize * cBaseSectorSize) + sizeOf(TRecordBlockStart);
  FTocFile.Write(idx2mbx, sizeOf(idx2mbx));
end;

procedure TMailbox.WriteMsgIndex(msgId: Integer; descr: TMsgDescription);
var i: Integer;
var padCount: Integer;
var blockStart: TRecordBlockStart;
var tmpMap: TToc2mbxMap;
var msgInfo: TMsgDescription;
begin
    //read old info only if we have old message
  if FrecordMap[msgId].startSector <> 0 then msgInfo := GetMessageDescription(msgId);
  FmsIdx.Clear;
  ZeroMemory( @blockstart, sizeOf(blockstart));
  blockstart.bs := cRecordBlockStart;
  blockstart.unused := False;

  ZeroMemory( @tmpMap, sizeOf(tmpMap));

    //build up a record stream
  with FmsIdx do begin
    with descr do begin
      writeWideStringToStream(FmsIdx, subject);
      writeWideStringToStream(FmsIdx, from);
      writeWideStringToStream(FmsIdx, comment);
      writeWideStringToStream(FmsIdx, msgPart);
      Write(date, sizeOf(date));
      Write(descr.size, sizeOf(descr.size));
      Write(markId, sizeOf(markId));
      Write(status, sizeOf(status));
      Write(replyDate, sizeOf(replyDate));
      Write(forwardDate, sizeOf(forwardDate));
      Write(priority, sizeOf(priority));
      writeWideStringToStream(FmsIdx, forwardedTo);
      writeWideStringToStream(FmsIdx, account);
      writeStringToStream(FmsIdx, uidl);
      Write(reserved, sizeOf(reserved));
    end;
  end;

    //if startSector = 0 then this is new record
  if FrecordMap[msgId].startSector = 0 then begin
    if ( not (msgRead in descr.status)) then begin
      if (FTocHeader.unreadCount + 1 <= FTocHeader.recordCount + 1) then
        FTocHeader.unreadCount := FTocHeader.unreadCount + 1;
    end;
    with FrecordMap[msgId] do begin
      deleted := False;
      startSector := FTocHeader.lastSector;
            //update record map sector count
      FrecordMap[msgId].sectorCount :=
        getSectorCount(FmsIdx.Size + sizeOf(blockstart) + sizeOf(tmpMap));
            //update last sector
      FTocHeader.lastSector := FTocHeader.lastSector + FrecordMap[msgId].sectorCount;
    end;
  end
  else begin //update record
        //update read/unread message counts
    if msgInfo.status <> descr.status then begin
      if (msgRead in descr.status) and not (msgRead in msgInfo.status) then begin
        if (FTocHeader.unreadCount <> 0) then
          FTocHeader.unreadCount := FTocHeader.unreadCount - 1;
      end
      else if ( not (msgRead in descr.status)) and (msgRead in msgInfo.status) then
      begin
        if (FTocHeader.unreadCount + 1 <= FTocHeader.recordCount) then
          FTocHeader.unreadCount := FTocHeader.unreadCount + 1;
      end;
    end;
        //get space allready allocated for this index
    i := (FTocHeader.sectorSize * cBaseSectorSize) * FrecordMap[msgId].sectorCount;

        //read old idx2mbxMap
    FTocFile.Position := sizeOf(FTocHeader) +
      (FRecordMap[msgId].startSector * FTocHeader.sectorSize * cBaseSectorSize) +
      sizeOf(blockstart);
    FTocFile.Read(tmpMap, sizeOf(tmpMap));

        //if new size is larger than old then allocate new sectors
    if (FmsIdx.Size + sizeOf(blockstart) + sizeOf(tmpMap)) > i then begin
            //first overwrite old record start with unused flag
      blockstart.unused := True;
      FTocFile.Position := sizeOf(FTocHeader) + FrecordMap[msgId].startSector *
        FTocHeader.sectorSize * cBaseSectorSize;
      FTocFile.Write(blockStart, sizeOf(blockStart));
      blockstart.unused := False;

            //get record location
      FrecordMap[msgId].startSector := FTocHeader.lastSector;
            //update record map sector count
      FrecordMap[msgId].sectorCount :=
        getSectorCount(FmsIdx.Size + sizeOf(blockstart) + sizeOf(tmpMap));
            //update last sector
      FTocHeader.lastSector := FTocHeader.lastSector + FrecordMap[msgId].sectorCount;
            //update unused sector count
      FTocHeader.unusedSectors := FTocHeader.unusedSectors +
        FrecordMap[msgId].sectorCount;
    end;
  end;

    //write idx data
  FTocFile.Position := sizeOf(FTocHeader) + FrecordMap[msgId].startSector *
    FTocHeader.sectorSize * cBaseSectorSize;
  FmsIdx.Position := 0;
  FTocFile.Write(blockStart, sizeOf(blockStart));
  FTocFile.Write(tmpMap, sizeOf(tmpMap));
  FTocFile.CopyFrom(FmsIdx, FmsIdx.Size);

    //how many bytes we need that record position will be aligned to (FTocHeader + (FTocHeader.sectorSize * cBaseSectorSize))
  padCount := (FmsIdx.Size + sizeOf(blockStart) + sizeOf(tmpMap)) mod
    (FTocHeader.sectorSize * cBaseSectorSize);
  if padCount <> 0 then padCount := (FTocHeader.sectorSize * cBaseSectorSize) - padCount;
  FTocFile.Write(FemptySector[0], padCount);

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

end;

//you must reload current mail list if you are compacting it.
function TMailbox.Pack: Boolean;
var oldIdxHdr: TTocHeader;
var oldIdxFile, oldMbxFile: TFileStream;
var i: Integer;
var oldMap: array of TRecordMap;
var tmpMap: TRecordMap;
var idx2mbx: TToc2mbxMap;
var strm: TMemoryStream;
var idxData: TMsgDescription;
var blockStart: TRecordBlockStart;
var tmpFS: TFileStream;
begin
  Result := False;

  closeMailbox;
  strm := TMemoryStream.Create;

    //delete .idx.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.toc.old
  oldIdxFile := TFileStream.Create(FmailboxPath + FmailboxName +
    cTocExt + '.old', fmOpenRead);

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

    //calculate old allocated sectors
  i := (FTocHeader.recordMapAlloc div ((FTocHeader.sectorSize * cBaseSectorSize) div
    sizeof(TRecordMap)));
    //we try to be a little smart here
    //if old allocated sectors is at least 70% full when counting
    //used messages then we make index space bigger
  if FTocHeader.recordCount / FTocHeader.recordMapAlloc >= 0.7 then
    OpenMailbox(i + 500)
  else OpenMailbox(i);

  oldIdxFile.Read(oldIdxHdr, sizeOf(oldIdxHdr));
    //allocate space for old Record Maping
  SetLength(oldMap, oldIdxHdr.recordMapAlloc);

    //load old record maps
  for i := 0 to oldIdxHdr.recordMapAlloc - 1 do begin
    oldIdxFile.Read(oldMap[i], sizeOf(oldMap[0]));
  end;

    //now start copying data from old to new file
  FCurrentMessage := 0;
  for i := 0 to oldIdxHdr.recordMapAlloc - 1 do begin
    if ( not oldMap[i].deleted) and (oldMap[i].startSector <> 0) and
      (oldMap[i].sectorCount <> 0) then begin
      Inc(FCurrentMessage);
            //read data from old idx
      oldIdxFile.Position := sizeOf(FTocHeader) + (oldMap[i].startSector *
        FTocHeader.sectorSize * cBaseSectorSize) +
        sizeOf(blockStart);
      oldIdxFile.Read(idx2mbx, sizeOf(idx2mbx));
      tmpFS := FTocFile; //save new file handle
      FTocFile := oldIdxFile;
            //save old idxmap
      tmpMap := FRecordMap[i];
      FRecordMap[i] := oldMap[i];
            //let the function read msg description from old file
      idxData := GetMessageDescription(i);
      FTocFile := tmpFS; //put handle back
      FRecordMap[i] := tmpMap; //put old map back

            //read data from old mbx
      oldMbxFile.Position := sizeOf(FTocHeader) + (idx2mbx.startSector *
        FTocHeader.sectorSize * cBaseSectorSize) +
        sizeOf(blockStart);
      strm.Clear;
      strm.CopyFrom(oldMbxFile, idx2mbx.size);

            //write data to new files
      AddMessage(strm, idxData);
    end;
  end;

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

  oldMbxFile.Free;
    //delete mbx.old file it is not needed anymore
  DeleteFile(PChar(FmailboxPath + FmailboxName + cMbxExt + '.old'));

  strm.Free;
    //write header now so we have correct numer of mails ... saved in file if program crashes
  FTocFile.Position := 0;
  FTocFile.Write(FTocHeader, sizeOf(FTocHeader));
  Result := True;
end;

function TMailbox.Compress(factor: Byte; compress: Boolean): Boolean;
begin

end;

//function calculates how many sectors is needed for size
function TMailbox.getSectorCount(const size: Integer): Integer;
begin
  if size mod (FTocHeader.sectorSize * cBaseSectorSize) = 0 then
    Result := size div (FTocHeader.sectorSize * cBaseSectorSize)
  else Result := size div (FTocHeader.sectorSize * cBaseSectorSize) + 1;
end;

function TMailbox.openMailbox(sectorCount: Integer): Boolean;
var i: Integer;
begin
  Result := False;
    //max file name length is 64 chars
  if Length(FmailboxName) > 64 then FmailboxName := Copy(FmailboxName, 0, 64);
  if not FileExists(FmailboxPath + FmailboxName + cTocExt) then begin
    FTocFile := TFileStream.Create(FmailboxPath + FmailboxName +
      cTocExt, fmOpenReadWrite or fmCreate or fmShareDenyWrite);
  end
  else FTocFile := TFileStream.Create(FmailboxPath + FmailboxName +
      cTocExt, fmOpenReadWrite or fmShareDenyWrite);

  if not FileExists(FmailboxPath + FmailboxName + cMbxExt) then begin
    FMbxFile := TFileStream.Create(FmailboxPath + FmailboxName +
      cMbxExt, fmOpenReadWrite or fmCreate or fmShareDenyWrite);
  end
  else FMbxFile := TFileStream.Create(FmailboxPath + FmailboxName +
      cMbxExt, fmOpenReadWrite or fmShareDenyWrite);


    //clear memory occupied by FTocHeader
  ZeroMemory( @FTocHeader, sizeOf(FTocHeader));
  if FTocFile.Size = 0 then begin //write header
    with FTocHeader do begin
      tag := cTocTag;
      fileVersion := cFileVersion;
      minVersion := cMinFileVersion;
      clean := False;
      sectorSize := 1; //must equal to FMbxHeader.sectorSize
      lastSector := sectorCount + 1;
 //set this to one more than in recordMapAlloc sectorCount
      recordCount := 0;
            //this allocates 500 sectors of space for record maps (currently this is 4000 record maps)
            //it should be enough that there will be no need to allocate more :-)
      recordMapAlloc := sectorCount * ((sectorSize * cBaseSectorSize) div
        sizeof(TRecordMap));
      recordLast := -1;
    end;

        //write default header
    FTocFile.Write(FTocHeader, sizeOf(FTocHeader));
    SetLength(FRecordMap, FTocHeader.recordMapAlloc);
        //zero the memory ocupied by FRecordMap
    ZeroMemory( @FRecordMap[0], sizeOf(FRecordMap[0]) * FTocHeader.recordMapAlloc);
        //allocate record map for first records
    FTocFile.Write(FRecordMap[0], sizeOf(FrecordMap[0]) * FTocHeader.recordMapAlloc);
  end
  else begin //check header
        //read Header
    FTocFile.Read(FTocHeader, sizeOf(FTocHeader));

        //is this correct file
    if StrComp(PChar(String(FTocHeader.tag)), cTocTag) <> 0 then
      raise EMailboxNotValidFile.Create(