⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mailbox.pas

📁 siMail, siMail, siMail, siMail
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    cIDUser:
    begin
      FSelectedAccount := -1;
    end
  end;
  FSelectedNodeType := TSelectedNodeType(nd^.id - 1);
end;

function TfrmMailbox.findAccountID(const Node: PVirtualNode): Integer;
var Node1: PVirtualNode;
begin
  Node1 := Node;
  Result := -1;
  while PTreeMailbox(trMailbox.GetNodeData(Node1))^.id <> cIDAccount do begin
    Node1 := Node.Parent;
    if Node1 = nil then break;
  end;
  Result := Profile.Accounts.IndexOf(PTreeMailbox(trMailbox.GetNodeData(Node1))^.data);
end;

function TfrmMailbox.findMailboxID(const Node: PVirtualNode): Integer;
var nd: PTreeMailbox;
var accID: Integer;
begin
  Result := -1;
  accID := findAccountID(Node);
  if accID < 0 then begin
    MessageDlg(Format(_('%s returned -1. 1st account selected.'), ['findAccountID']), mtError, [mbOK], 0);
    accID := 0;
  end;
  nd := trMailbox.GetNodeData(Node);
  Result := Profile.Accounts[accID].Mailboxes.IndexOf(nd^.data);
  if Result < 0 then begin
    MessageDlg(Format(_('%s returned -1. 1st mailbox selected.'), ['findMailboxID']), mtError, [mbOK], 0);
    Result := 0;
  end;
end;

function TfrmMailbox.getMailbox(accountID, mailboxID: Integer): TMailbox;
begin
  Result := Profile.Accounts[accountID].Mailboxes[mailboxID];
end;

function TfrmMailbox.findMailbox(accountID, internalID: Integer): TMailbox;
var i, c: Integer;
begin
  c := Profile.Accounts[accountID].Mailboxes.Count - 1;
  for i := 0 to c do begin
    if Profile.Accounts[accountID].Mailboxes[i].id = internalID then begin
      Result := Profile.Accounts[accountID].Mailboxes[i];
      Break;
    end;
  end;
end;

procedure TfrmMailbox.FormDestroy(Sender: TObject);
var i: integer;
var tmr: TTimer;
var mbox: TMailbox;
begin
  SelectedTheme := -1;
  if Profile <> nil then
    FAutoCompleteList.SaveToFile(frmMailbox.Profile.UserHomeDir + '\AutoComplete.txt');
  //write sizes and positions maillist columns
  try
    for i := 0 to trMailbox.Header.Columns.Count - 1 do begin
      Profile.Config.WriteInteger(
        Self.Name, Format('mailboxColumnWidth_%s', [IntToHex(i, 2)]), Trunc(10000 *
        (trMailbox.Header.Columns[i].Width / trMailbox.Width)));
      Profile.Config.WriteInteger(
        Self.Name, Format('mailboxColumnPosition_%s', [IntToHex(i, 2)]),
        trMailbox.Header.Columns[i].Position);
    end;
  except
  end;

  for i := 0 to FtmrList.Count - 1 do begin
    tmr := FtmrList.Items[i];
    tmr.Enabled := False;
    FreeAndNil(tmr);
  end;
  FtmrList.Clear;

  //empty trash and junk
  for i := 0 to Profile.Accounts.Count - 1 do begin
    if Profile.Accounts.Items[i].EmptyTrashOnExit then begin
      mbox := findMailbox(i, -Integer(mboxTrash));
      mbox.Empty;
    end;
    if Profile.Accounts.Items[i].EmptyJunkMailOnExit then begin
      mbox := findMailbox(i, -Integer(mboxJunk));
      mbox.Empty;
    end;
    refreshTotals(i);
  end;

  FtmrList.Free;
  Profiles.Free;
  PublicAddressBook.Free;
  FreeAndNil(FAutoCompleteList);
end;

procedure TfrmMailbox.FormShow(Sender: TObject);
begin

  if FScheduleNewAccount then begin
    frmMain.tray.IconVisible := False;
    frmNewAccountWizard.ShowModal;
    FScheduleNewAccount := False;
    //just in case user cancled creation of first profile/account
    try
      SetProfile(0);
    except
    end;
    frmMain.tray.IconVisible := True;
  end;

    //let's check if we are default mail client
    checkIfDefaultClient;

end;

procedure TfrmMailbox.trMailboxDragOver(Sender: TBaseVirtualTree;
  Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
  Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
var nd: PTreeMailbox;
var Node: PVirtualNode;
begin
   //if source is lstMaillist and target is not current mailbox then allow drop
  if Source = frmMaillist.lstMailList then begin
    try
      Node := trMailbox.GetNodeAt(Pt.x, Pt.y);
      nd := trMailbox.GetNodeData(Node);
      if (nd.id = cIDMailbox) and ((findMailboxID(Node) <> FSelectedMailbox) or
        (findAccountID(Node) <> FSelectedAccount)) then Accept := True;
    except
      on EAccessViolation do Exit;
    end;
  end;
end;

procedure TfrmMailbox.trMailboxDragDrop(Sender: TBaseVirtualTree;
  Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
  Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var nd: PTreeMailbox;
var Node, tmpNode: PVirtualNode;
var NAccount, NMailbox: Integer;
var sameAccount: Boolean;
begin
  //if source is lstMaillist and target is not current mailbox then allow drop
  if Source = frmMaillist.lstMailList then begin
    try
      Node := trMailbox.GetNodeAt(Pt.x, Pt.y);
      nd := trMailbox.GetNodeData(Node);
      //move mails from one mbox to other
      if (nd.id = cIDMailbox) and ((findMailboxID(Node) <> FSelectedMailbox) or
        (findAccountID(Node) <> FSelectedAccount)) then begin
        //find target
        NMailbox := findMailboxID(Node);
        tmpNode := Node;
        NAccount := findAccountID(tmpNode);

        if NAccount = SelectedAccount then sameAccount := True
        else sameAccount := False;
        frmMailList.MoveToMailbox(getMailbox(NAccount, NMailbox), sameAccount);
        if not sameAccount then
          RefreshTotals(NAccount);
      end;
    except
      on EAccessViolation do Exit;
    end;
  end;
end;

procedure TfrmMailbox.actMailboxPackExecute(Sender: TObject);
var mbox: TMailbox;
begin
  mbox := getMailboxFromNode(trMailbox.GetFirstSelected);
  if mbox <> nil then begin
    Screen.Cursor := crHourglass;
    frmMain.StatusBar1.Panels[infoPanel].Caption := _('Packing mailbox');
    if mbox.Pack then MessageDlg(
        Format(_('Mailbox ''%s'' succesfully packed.'), [mbox.MailboxName]),
        mtInformation, [mbOK], 0);
    Screen.Cursor := crDefault;
    frmMailList.ShowMailbox;
  end;
end;

procedure TfrmMailbox.actMailboxPropertiesExecute(Sender: TObject);
var mbox: TMailbox;
begin
  mbox := getMailboxFromNode(trMailbox.GetFirstSelected);
  if mbox <> nil then begin
    frmMailboxInfo.LoadInfo(mbox);
    frmMailboxInfo.ShowModal;
  end;
end;

procedure TfrmMailbox.trMailboxGetPopupMenu(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; const P: TPoint;
  var AskParent: Boolean; var PopupMenu: TPopupMenu);
begin
  trMailbox.SetFocus;
  if Node = nil then begin
    PopupMenu := popUser;
    Exit;
  end;
  case PTreeMailbox(trMailbox.GetNodeData(Node))^.id of
    cIDUser:
      PopupMenu := popUser;
    cIDAccount:
      PopupMenu := popAccount;
    cIDMailbox:
      PopupMenu := popMbox;
  end;
end;

procedure TfrmMailbox.actMailboxDeleteUpdate;
var mbox: TMailbox;
var acc: TAccount;
begin
  mbox := nil; acc := nil;

  mbox := getMailboxFromNode(trMailbox.GetFirstSelected);
  acc := getAccountFromNode(trMailbox.GetFirstSelected);
  if mbox <> nil then begin
    if mbox.id >= 0 then
      frmMain.actDelete.Enabled := True
    else
      frmMain.actDelete.Enabled := False;
  end
  else if acc <> nil then begin
    frmMain.actDelete.Enabled := True;
  end
  else
    frmMain.actDelete.Enabled := False;

end;

procedure TfrmMailbox.actMailboxEmptyExecute(Sender: TObject);
var mbox: TMailbox;
begin
  mbox := getMailboxFromNode(trMailbox.GetFirstSelected);
    //ask user if is sure
  EmptyMailbox(mbox);

end;

procedure TfrmMailbox.actMailboxEmptyUpdate(Sender: TObject);
var mbox: TMailbox;
begin
  mbox := getMailboxFromNode(trMailbox.GetFirstSelected);
    //empty mailbox menu can be enabled non empty mailbox is selected
  if (mbox <> nil) then begin
    if mbox.TotalMessageCount <> 0 then actMailboxEmpty.Enabled := True
    else actMailboxEmpty.Enabled := False;  //disable it
  end
end;

procedure TfrmMailbox.actMailboxEmptyJunkUpdate(Sender: TObject);
var mbox: TMailbox;
begin
  if FSelectedAccount < 0 then begin
    actMailboxEmptyJunk.Enabled := False;
    exit;
  end;
  mbox := findMailbox(FSelectedAccount, -Integer(mboxJunk));
  if mbox.TotalMessageCount = 0 then actMailboxEmptyJunk.Enabled := False
  else actMailboxEmptyJunk.Enabled := True;
end;

procedure TfrmMailbox.actMailboxEmptyJunkExecute(Sender: TObject);
var mbox: TMailbox;
begin
  mbox := findMailbox(FSelectedAccount, -Integer(mboxjunk));
  emptyMailbox(mbox);
end;

procedure TfrmMailbox.actMailboxEmptyTrashUpdate(Sender: TObject);
var mbox: TMailbox;
begin
  if FSelectedAccount < 0 then begin
    actMailboxEmptyTrash.Enabled := False;
    exit;
  end;
  mbox := findMailbox(FSelectedAccount, -Integer(mboxTrash));
  if mbox.TotalMessageCount = 0 then actMailboxEmptyTrash.Enabled := False
  else actMailboxEmptyTrash.Enabled := True;
end;

procedure TfrmMailbox.actMailboxEmptyTrashExecute(Sender: TObject);
var mbox: TMailbox;
begin
  mbox := findMailbox(FSelectedAccount, -Integer(mboxTrash));
  emptyMailbox(mbox);
end;

procedure TfrmMailbox.emptyMailbox(mbox: TMailbox);
begin
  if (mbox <> nil) then begin
    if MessageDlg(Format(_('Are you sure you want to empty mailbox ''%s''?'),
      [mbox.MailboxName]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin

      mbox.Empty;
      trMailbox.Repaint;
      frmMaillist.ShowMailbox;
      actAccountRefreshTot.Execute; //refresh unread/total msg count 
    end;
  end;
end;

procedure TfrmMailbox.actMailboxPackUpdate(Sender: TObject);
var mbox: TMailbox;
begin
  mbox := getMailboxFromNode(trMailbox.GetFirstSelected);
  if (mbox <> nil) then actMailboxPack.Enabled := True
  else actMailboxPack.Enabled := False;  //disable it
end;

procedure TfrmMailbox.actAccountFetchMessagesThisExecute(Sender: TObject);
begin
  if (FSelectedAccount >= 0) then begin
    if not frmTasks.TaskInProgress then
      frmTasks.TaskClear;

        //add task to list & show task list
        //fetch headers if Show message headers for incoming mail is set and
        //... but only if message size is over is > 0
    if Profile.Accounts[FSelectedAccount].IncomingShowHeaders and
      ( not Profile.Accounts[FSelectedAccount].IncomingShowHeadersLarger) then
      frmTasks.TaskAdd(FSelectedAccount, [], ttFetchHeaders)
    else
      frmTasks.TaskAdd(FSelectedAccount, [], ttFetch);
    if frmMain.Visible and (frmMailbox.Profile.Config.ReadBool('frmTasks', 'showMe', True)) then
      frmTasks.Show;
  end;
end;

procedure TfrmMailbox.actAccountFetchMessagesThisUpdate(Sender: TObject);
var mbox: TMailbox;
var acc: TAccount;
begin
  mbox := getMailboxFromNode(trMailbox.GetFirstSelected);
    //fetch this menu can be enabled if account or mailbox is selected
  if mbox = nil then acc := getAccountFromNode(trMailbox.GetFirstSelected);
  if (mbox <> nil) or (acc <> nil) then begin
    actAccountFetchMessagesThis.Enabled := True;
    actAccountPreviewThis.Enabled := True;
        //frmMain.actTBFetch.Enabled:=True;
  end
  else begin
    actAccountFetchMessagesThis.Enabled := False;  //disable it
    actAccountPreviewThis.Enabled := False;
        //frmMain.actTBFetch.Enabled:=False;
  end;
end;

procedure TfrmMailbox.actAccountComposeMessageThisExecute(Sender: TObject);
begin
  frmMain.actTBMessageNew.Execute;
end;

procedure TfrmMailbox.actMailboxPasswordProtectExecute(Sender: TObject);
var mbox: TMailbox;
begin
  mbox := getMailboxFromNode(trMailbox.GetFirstSelected);
  if mbox = nil then exit;

  if mbox.Unlocked and (mbox.Password <> '') then
    mbox.Password := ''
  else
    mbox.Password := InputPassword(_('Password required'),
      Format(_('Please write password for ''%s'' to field below.'),
      [mbox.MailboxName]), '', '*');
end;

procedure TfrmMailbox.actMailboxPasswordProtectUpdate(Sender: TObject);
var mbox: TMailbox;
begin
  mbox := getMailboxFromNode(trMailbox.GetFirstSelected);
    //fetch this menu can be enabled if account or mailbox is selected
  if (mbox <> nil) then begin
    if not mbox.Unlocked and (mbox.Password <> '') then
      actMailboxPasswordProtect.Enabled := False
    else
      actMailboxPasswordProtect.Enabled := True;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -