mailbox.pas

siMail, siMail, siMail, siMail

        Application.Terminate;
        Result := True;
      end;
      mrOk: begin
        if Profiles.Count > 1 then
          actUsersSwitch.Execute
        else begin
          Application.Terminate;
          Result := True;
        end;
      end
      end;
    end;
  end;

var tmpStr: String;
begin

  while not Profile.Unlocked do begin
    tmpStr := InputPassword(_('Password required'),
      Format( _('Profile ''%s'' is password protected. Please write password to field below.'),
      [Profile.UserName]), '', '*');
    if tryToUnlock(tmpStr) then break;
  end;

end;

procedure TfrmMailbox.checkIfDefaultClient;
var frm: TfrmDefaultClient;
var reg: TRegistry;
var defCli, tmpStr: String;
begin
  if frmMailbox.Profile.Config.ReadBool(frmSettings.Name, 'dontCheckIfDefault', False) = True then Exit;
  defCli := '"' + Application.ExeName + '" /mailURL "%1"';
  reg := TRegistry.Create(KEY_READ);
  //try to read & open HKEY_CLASSES_ROOT
  try
    reg.RootKey := HKEY_CLASSES_ROOT;
    tmpStr := '';

    if reg.OpenKey('mailto\shell\open\command', False) then
      tmpStr := reg.ReadString('');

    //are we the default mail client?
    //if we are not then ask user what to do
    if tmpStr <> defCli then begin
      reg.CloseKey;

      frm := TfrmDefaultClient.Create(Application);
      try
        frmMain.XPMenu1.InitComponent(frm);
        if frm.ShowModal = mrYes then
          RegisterAsDefault;
      finally
        frmMailbox.Profile.Config.WriteBool(frmSettings.Name, 'dontCheckIfDefault', frm.DontCheckIfDefault);
        frm.Free;
      end;
    end;
  finally
    reg.Free;
  end;
end;

procedure TfrmMailbox.RegisterAsDefault;
var EditFlags: array[1..4] of Byte;
var reg: TRegistry;
var defCli: String;
var tmpStr: String;
begin

  EditFlags[1] := 2;
  EditFlags[2] := 0;
  EditFlags[3] := 0;
  EditFlags[4] := 0;

  defCli := '"' + Application.ExeName + '" /mailURL "%1"';
  reg := TRegistry.Create(KEY_READ);

  //try to read & open HKEY_CLASSES_ROOT
  try
    reg.RootKey := HKEY_CLASSES_ROOT;
    tmpStr := '';

    reg.Access := KEY_WRITE;
    reg.OpenKey('mailto\shell\open\command', True);

    with reg do begin
      WriteString('', defCli);
      CloseKey;
      OpenKey('mailto\DefaultIcon', True);
      WriteString('', '"' + Application.ExeName + '",0');
      CloseKey;
      RootKey := HKEY_LOCAL_MACHINE;
      OpenKey('SOFTWARE\Clients\Mail', True);
      WriteString('', 'si.Mail');
      CloseKey;
      OpenKey('SOFTWARE\Clients\Mail\si.Mail\DefaultIcon', True);
      WriteString('', '"' + Application.ExeName + '",0');
      CloseKey;
      OpenKey('SOFTWARE\Clients\Mail\si.Mail', True);
      WriteString('', 'si.Mail');
      CloseKey;
      OpenKey('SOFTWARE\Clients\Mail\si.Mail', True);
      WriteString('DLLPath', PathGetShortName(ExtractFilePath(Application.ExeName) + 'siMailMapi.dll'));
      WriteString('ExeName', '"' + Application.ExeName + '"');
      CloseKey;
      OpenKey('SOFTWARE\Clients\Mail\si.Mail\Protocols\mailto', True);
      WriteString('', 'URL:MailTo Protocol');
      WriteBinaryData('Edit Flags', EditFlags, 4);
      WriteString('URL Protocol', '');
      CloseKey;
      OpenKey('SOFTWARE\Clients\Mail\si.Mail\Protocols\mailto\DefaultIcon', True);
      WriteString('', '"' + Application.ExeName + '",0');
      CloseKey;
      OpenKey('SOFTWARE\Clients\Mail\si.Mail\Protocols\mailto\shell\open\command', True);
      WriteString('', defCli);
      CloseKey;
      OpenKey('SOFTWARE\Clients\Mail\si.Mail\shell\open\command', True);
      WriteString('', '"' + Application.ExeName + '"');
      RootKey := HKEY_CURRENT_USER;
      OpenKey('SOFTWARE\Clients\Mail', True);
      WriteString('', 'si.Mail');
      CloseKey;
     end;
  finally
    reg.Free;
  end;
end;

procedure TfrmMailbox.tmrCheckAccount(Sender: TObject);
var idx: Integer;
begin
  if frmMain.Online then Exit;
  idx := FtmrList.IndexOf(Sender);
  if idx < 0 then Exit;

  frmTasks.TaskAdd(idx, [], ttFetch);
  if frmMain.Visible and (frmMailbox.Profile.Config.ReadBool('frmTasks', 'showMe', True)) then
    frmTasks.Show;
end;

procedure TfrmMailbox.CreateCheckTimer;
var tmr: TTimer;
begin
  tmr := TTimer.Create(nil);
  tmr.Enabled := False;
  tmr.OnTimer := tmrCheckAccount;
  FtmrList.Add(tmr);
end;

procedure TfrmMailbox.DeleteCheckTimer(accountNo: Integer);
begin
  TTimer(FtmrList.Items[accountNo]).Free;
  FtmrList.Delete(accountNo);
end;

procedure TfrmMailbox.UpdateCheckTimer(accountNo: Integer);
begin
  if frmMailbox.Profile = nil then exit;
  if frmMailbox.Profile.Accounts[accountNo].IncomingCheck then begin
    TTimer(FtmrList[accountNo]).Enabled := False;
    case frmMailbox.Profile.Accounts[accountNo].IncomingTimeUnit of
      ituSeconds:
        TTimer(FtmrList[accountNo]).Interval := 1000 * frmMailbox.Profile.Accounts[accountNo].IncomingTime;
      ituMinutes:
        TTimer(FtmrList[accountNo]).Interval := 1000 * 60 * frmMailbox.Profile.Accounts[accountNo].IncomingTime;
      ituHours:
        TTimer(FtmrList[accountNo]).Interval := 1000 * 360 * frmMailbox.Profile.Accounts[accountNo].IncomingTime;
    end;

    TTimer(FtmrList[accountNo]).Enabled := True;
  end;
end;

procedure TfrmMailbox.trMailboxCompareNodes(Sender: TBaseVirtualTree;
  Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var nd1, nd2: PTreeMailbox;
begin
  nd1 := Sender.GetNodeData(Node1);
  nd2 := Sender.GetNodeData(Node2);
  case Column of
  0: begin
    case nd1^.id of
    cIDUser: Result := WideCompareText(TUser(nd1^.data).UserName, TUser(nd2^.data).UserName);
    cIDAccount: Result := WideCompareText(TAccount(nd1^.data).AccountName, TAccount(nd2^.data).AccountName);
    cIDMailbox: begin
      if (TMailbox(nd1^.data).Id < 0) or (TMailbox(nd2^.data).Id < 0) then
        Result := 0
      else
        Result := WideCompareText(TMailbox(nd1^.data).MailboxName, TMailbox(nd2^.data).MailboxName);
    end
    //cIDFolder: Result := WideCompareText(nd1.text, nd2.text);
    end;
  end
  end;
end;

procedure TfrmMailbox.actMailboxPackAllExecute(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  packAllMailboxes(FSelectedAccount);
  Screen.Cursor := crDefault;
end;

procedure TfrmMailbox.actMailboxPackAllUpdate(Sender: TObject);
begin
  if FSelectedAccount < 0 then
    actMailboxPackAll.Enabled := False
  else
    actMailboxPackAll.Enabled := True;
end;

procedure TfrmMailbox.actAccountPackAllExecute(Sender: TObject);
var i: Integer;
begin
  Screen.Cursor := crHourGlass;
  for i := 0 to Profile.Accounts.Count - 1 do
    packAllMailboxes(i);

  Screen.Cursor := crDefault;
end;

procedure TfrmMailbox.packAllMailboxes(accountNo: Integer);
var i: Integer;
begin
  for i := 0 to Profile.Accounts.Items[accountNo].Mailboxes.Count - 1 do begin
    frmMain.StatusBar1.Panels[infoPanel].Caption := Format(_('Packing mailbox ''%s'' in ''%s''.'),
      [Profile.Accounts.Items[accountNo].Mailboxes.Items[i].MailboxName,
      Profile.Accounts.Items[accountNo].AccountName]);
    Application.ProcessMessages;
    Profile.Accounts.Items[accountNo].Mailboxes.Items[i].Pack;
  end;
  frmMain.StatusBar1.Panels[infoPanel].Caption :=
    Format(_('All mailboxes in ''%s'' packed.'), [Profile.Accounts.Items[accountNo].AccountName]);
end;

procedure TfrmMailbox.actAccountPackAllUpdate(Sender: TObject);
begin
  if trMailbox.RootNodeCount > 0 then
    actAccountPackAll.Enabled := True
  else
    actAccountPackAll.Enabled := False;
end;

procedure TfrmMailbox.actAccountSendAllExecute(Sender: TObject);
var arr: array of Integer;
var mbox: TMailbox;
var i, j, c: Integer;
var descr: TMsgDescription;
begin
  if not frmTasks.TaskInProgress then
    frmTasks.TaskClear;

  //build list of messages which needs to be sent
  for j := 0 to Profile.Accounts.Count - 1 do begin
    mbox := nil;
    mbox := frmMailbox.getMailbox(j, Integer(mboxUnsent) - 1);

    SetLength(arr, mbox.LastMessageIndex);

    c := 0;
    for i := 0 to High(arr) do begin
      descr := mbox.GetMessageDescription(i);
      if not descr.deleted then begin
        arr[c] := i;
        Inc(c);
      end;
    end;

    if c <> 0 then begin
      SetLength(arr, c);
      frmTasks.TaskAdd(j, arr, ttSend);
    end;
  end;
  if frmMailbox.Profile.Config.ReadBool('frmTasks', 'showMe', True) then
    frmTasks.Show;
end;

procedure TfrmMailbox.actAccountSendAllUpdate(Sender: TObject);
var mbox: TMailbox;
var acc: TAccount;
var i: Integer;
begin
  for i := 0 to Profile.Accounts.Count -1 do begin
    if (Profile.Accounts[i].Mailboxes[Integer(mboxUnsent) - 1].TotalMessageCount > 0) then begin
      actAccountSendAll.Enabled := True;
      Break;
    end
    else
      actAccountSendAll.Enabled := False;
  end;
end;

procedure TfrmMailbox.actAccountSendFetchAllExecute(Sender: TObject);
begin
  actAccountFetchMessagesAll.Execute;
  actAccountSendAll.Execute;
end;

procedure TfrmMailbox.actAccountSendFetchAllUpdate(Sender: TObject);
begin
  actAccountSendFetchAll.Enabled := actAccountSendAll.Enabled or
    actAccountFetchMessagesAll.Enabled;
end;

procedure TfrmMailbox.actAccountSendFetchThisExecute(Sender: TObject);
begin
  actAccountFetchMessagesThis.Execute;
  actAccountSendThis.Execute;
end;

procedure TfrmMailbox.actAccountSendFetchThisUpdate(Sender: TObject);
begin
  actAccountSendThis.Update;
  actAccountFetchMessagesThis.Update;
  actAccountSendFetchThis.Enabled := actAccountSendThis.Enabled and
    actAccountFetchMessagesThis.Enabled;
end;

procedure TfrmMailbox.AddNewMailboxTo(accountNo: Integer);
var accNode: PVirtualNode;
var Node: PVirtualNode;
var nd: PTreeMailbox;
begin
  //find account node
  accNode := nil;
  if FShowProfileNode then
    Node := trMailbox.GetFirstChild(trMailbox.GetFirstChild(trMailbox.RootNode))
  else
    Node := trMailbox.GetFirst;

  while Node <> nil do begin
    nd := trMailbox.GetNodeData(Node);
    if nd^.data = Profile.Accounts[accountNo] then begin
      accNode := Node;
      break;
    end;
    Node := trMailbox.GetNextSibling(Node);
  end;

  //add mailbox node
  trMailbox.AddChild(Node);
end;

procedure TfrmMailbox.CMDialogKey(var Msg: TWMKEY);
begin
  if (ActiveControl = trMailbox) and (Msg.Charcode = VK_TAB) then begin
    frmMaillist.lstMailList.SetFocus;
  end;
  inherited;
end;

procedure TfrmMailbox.LoadTheme(themeIndex: Integer; size: Integer);
var p: String;
begin

  //if small or large theme is not implemented but is selected then set the
  //normal size as default one. B/C that size MUST be implemented
  if (lstThemes[themeIndex].Toolbar.SmallSize = -1) and (size = 0) then
    size := 1
  else if (lstThemes[themeIndex].Toolbar.LargeSize = -1) and (size = 2) then
    size := 1;

  p := lstThemes.Items[themeIndex].ThemePath;
  //load the icons which doesn't change its size
  with dmImages do begin
    LoadToolbar(ilAddressBook, p + lstThemes.Items[themeIndex].AddressBook.Icons);
    LoadToolbar(ilAddressBookQuickToolbar, p + lstThemes.Items[themeIndex].AddressBook.QuickBar);
    LoadToolbar(ilMailboxMailboxes, p + lstThemes.Items[themeIndex].MailboxFolders.Icons);
    LoadToolbar(ilMailListHeader, p + lstThemes.Items[themeIndex].MailList.ColumnIcons);
    LoadToolbar(ilMailListMessages, p + lstThemes.Items[themeIndex].MailList.Icons);
    LoadToolbar(ilTask, p + lstThemes.Items[themeIndex].Tasks.Icons);
    LoadToolbar(ilPreview, p + lstThemes.Items[themeIndex].ServerMailboxView.Icons);
  end;

  case size of
  0: begin //small
    with dmImages do begin
      ilAddressBookToolbar.Width := lstThemes.Items[themeIndex].Toolbar.SmallSize;
      ilAddressBookToolbar.Height := lstThemes.Items[themeIndex].Toolbar.SmallSize;
      LoadToolbar(ilAddressBookToolbar, p + lstThemes.Items[themeIndex].AddressBook.Toolbar.Small.Normal);

      ilComposeToolbar.Width := lstThemes.Items[themeIndex].Toolbar.SmallSize;
      ilComposeToolbar.Height := lstThemes.Items[themeIndex].Toolbar.SmallSize;
      LoadTo