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

📄 fprofiles.pas

📁 siMail, siMail, siMail, siMail
💻 PAS
字号:
(*
# (C) Copyright 2003
# Miha Vrhovnik, miha.vrhovnik@cordia.si
#
# 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)2003.
# All Rights Reserved.
#==============================================================================
# Contributor(s):
#==============================================================================
# History: see whats new.txt from distribution package
#==============================================================================
*)
unit fProfiles;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, account, ActnList;

type TIdentityMode = (imManage, imSwitch);

type
  TfrmProfiles = class(TForm)
    lstProfiles: TListBox;
    Label1: TLabel;
    cmdNew: TButton;
    cmdDelete: TButton;
    cmdClose: TButton;
    cmdEdit: TButton;
    Bevel1: TBevel;
    cmdUse: TButton;
    ActionList1: TActionList;
    actNew: TAction;
    actDelete: TAction;
    actEdit: TAction;
    procedure cmdCloseClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure lstProfilesDblClick(Sender: TObject);
    procedure actNewExecute(Sender: TObject);
    procedure actDeleteExecute(Sender: TObject);
    procedure actDeleteUpdate(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure actNewUpdate(Sender: TObject);
    procedure cmdUseClick(Sender: TObject);
    procedure FormShortCut(var Msg: TWMKey; var Handled: Boolean);
    procedure lstProfilesClick(Sender: TObject);
    procedure actEditExecute(Sender: TObject);
    procedure actEditUpdate(Sender: TObject);
  private
    FMode: TIdentityMode;
    procedure SetMode(const Value: TIdentityMode);
    function isDefaultProfile: Boolean;
    function isCurrentProfile: Boolean;
    { Private declarations }
  public
    { Public declarations }
    property Mode: TIdentityMode read FMode write SetMode;
  end;

var
  frmProfiles: TfrmProfiles;

implementation

uses
  mailBox, fMyInputBox, fNewAccountWizard, fMain, gnugettext, defFldrs,
  fProfileEdit;

{$R *.dfm}

procedure TfrmProfiles.cmdCloseClick(Sender: TObject);
begin
  Self.Close;
end;

procedure TfrmProfiles.SetMode(const Value: TIdentityMode);
begin
  //read self position & size
  if frmMailbox.Profile <> nil then
    frmMailbox.Profile.Config.ReadControlSettings(Self)
  else
    frmMain.CenterForm(Self);

  FMode := Value;
  case Mode of
    imManage:
    begin
      Self.ClientWidth := cmdNew.Left + cmdNew.Width + 8;
      cmdUse.Visible := False;
      Bevel1.Visible := True;
      Self.Caption := _('Manage profiles');
    end;
    imSwitch:
    begin
      Self.ClientWidth := lstProfiles.Left + lstProfiles.Width + 8;
      cmdUse.Visible := True;
      Bevel1.Visible := False;
      Self.Caption := _('Select profile');
    end;
  end;
end;

procedure TfrmProfiles.FormShow(Sender: TObject);
var i: Integer;
begin
  //translate me
  TranslateComponent(Self);

  lstProfiles.Clear;
  for i := 0 to frmMailbox.Profiles.Count - 1 do
    lstProfiles.Items.AddObject(frmMailbox.Profiles[i].UserName, Pointer(i));

  cmdUse.Enabled := False;

  actDelete.Enabled := False;
  actEdit.Enabled := False;
end;

procedure TfrmProfiles.lstProfilesDblClick(Sender: TObject);
begin
  cmdUseClick(cmdUse);
end;

procedure TfrmProfiles.actNewExecute(Sender: TObject);
var id: Integer;
begin
  frmProfileEdit.txtProfileName.Text := '';
  frmProfileEdit.txtPwd.Text := '';
  frmProfileEdit.ShowModal;
  if not frmProfileEdit.Cancled then begin
    frmProfileEdit.txtProfileName.Text := Trim(frmProfileEdit.txtProfileName.Text);
    if not frmNewAccountWizard.CheckProfile(frmProfileEdit.txtProfileName.Text) then begin
      id := frmMailbox.Profiles.Add(frmProfileEdit.txtProfileName.Text,
        frmProfileEdit.txtPwd.Text);
      lstProfiles.Items.AddObject(frmProfileEdit.txtProfileName.Text, Pointer(id));
    end;
  end;
end;

procedure TfrmProfiles.actDeleteExecute(Sender: TObject);
var i, c: Integer;
var rslt: Boolean;
var tmpStr: String;
begin
  i := MessageDlg(Format(_('' + 
    'All accounts, messages, attachments and settings will be deleted.' +
    #13#10 + 'Do you still want to delete ''%s''?'),
    [lstProfiles.Items.Strings[lstProfiles.ItemIndex]]), mtConfirmation, [mbYes, mbNo], 0);
  if i = mrYes then begin

    tmpStr := frmMailbox.Profiles[Integer(
      lstProfiles.Items.Objects[lstProfiles.ItemIndex])].UserHomeDir;
    rslt := frmMailbox.Profiles.DeleteUser(
      Integer(lstProfiles.Items.Objects[lstProfiles.ItemIndex]));
    if rslt then begin
       //frmMailbox.Profiles.Delete(Integer(lstProfiles.Items.Objects[lstProfiles.ItemIndex]));
      lstProfiles.Items.Delete(lstProfiles.ItemIndex);
    end
    else
      MessageDlg(Format(_('Profile delete failed. Some files in ' +
        #13#10 + '''%s''' + #13#10 +
        ' might still be in use. You''ll have to manually delete profile.'), [tmpStr]),
        mtError, [mbOK], 0);
  end;
end;

procedure TfrmProfiles.actDeleteUpdate(Sender: TObject);
begin
  if lstProfiles.ItemIndex < 0 then
    exit;

  if (xmlIni.ReadString('general', 'defaultProfile', '') <>
    lstProfiles.Items[lstProfiles.ItemIndex])
    and (lstProfiles.Items.Count > 1) and isDefaultProfile then
    actDelete.Enabled := True
  else
    actDelete.Enabled := False;
end;

procedure TfrmProfiles.FormHide(Sender: TObject);
begin
  //write self position & size
  frmMailbox.Profile.Config.WriteControlSettings(Self);
end;

function TfrmProfiles.isDefaultProfile: Boolean;
begin
  Result := False;
  if frmMailbox.Profile <> nil then
    Result := frmMailbox.Profile.UserName =
      xmlIni.ReadString('general', 'defaultProfile', '');
end;

procedure TfrmProfiles.actNewUpdate(Sender: TObject);
begin
  actNew.Enabled := isDefaultProfile;
end;

procedure TfrmProfiles.cmdUseClick(Sender: TObject);
begin
  frmMailbox.SetProfile(Integer(lstProfiles.Items.Objects[lstProfiles.ItemIndex]));
  Self.Close;
end;

function TfrmProfiles.isCurrentProfile: Boolean;
begin
  Result := frmMailbox.Profile =
    frmMailbox.Profiles[Integer(lstProfiles.Items.Objects[lstProfiles.ItemIndex])];
end;

procedure TfrmProfiles.FormShortCut(var Msg: TWMKey; var Handled: Boolean);
begin
  if msg.CharCode = 27 then begin
    Self.Close;
    Handled := True;
  end;
end;

procedure TfrmProfiles.lstProfilesClick(Sender: TObject);
begin
  cmdUse.Enabled := True;
end;

procedure TfrmProfiles.actEditExecute(Sender: TObject);
var current, default, rslt: Boolean;
var tmpStr: String;
begin
  frmProfileEdit.txtProfileName.Text :=
    frmMailbox.Profiles[Integer(lstProfiles.Items.Objects[lstProfiles.ItemIndex])].UserName;
  frmProfileEdit.txtPwd.Text :=
    frmMailbox.Profiles[Integer(lstProfiles.Items.Objects[lstProfiles.ItemIndex])].Password;
  frmProfileEdit.ShowModal;
  if not frmProfileEdit.Cancled then begin
    frmProfileEdit.txtProfileName.Text := Trim(frmProfileEdit.txtProfileName.Text);
    frmMailbox.Profiles[Integer(
      lstProfiles.Items.Objects[lstProfiles.ItemIndex])].Password := frmProfileEdit.txtPwd.Text;
    //is profile name changed
    if not (frmProfileEdit.txtProfileName.Text =
      lstProfiles.Items[lstProfiles.ItemIndex]) then begin
      //we have to close all mailboxes,...
      if not frmNewAccountWizard.checkProfile(frmProfileEdit.txtProfileName.Text) then
      begin
        default := isDefaultProfile;
        current := isCurrentProfile;
        if current then
          frmMailbox.SetProfile( -1);

        tmpStr := frmMailbox.Profiles[Integer(
          lstProfiles.Items.Objects[lstProfiles.ItemIndex])].UserHomeDir;
        rslt := frmMailbox.Profiles[Integer(lstProfiles.ItemIndex)].Rename(frmProfileEdit.txtProfileName.Text);
        if not rslt then begin
          MessageDlg(
            Format(_('Profile rename failed. Some files in ' + #13#10 + '''%s''' +
            #13#10 + ' might still be in use.'), [tmpStr]), mtError, [mbOK], 0);
          exit;
        end
        else
          lstProfiles.Items.Strings[lstProfiles.ItemIndex] :=
            frmProfileEdit.txtProfileName.Text;

        //if we rename the default profile then write it to file
        if default then
          frmMain.SetDefaultProfile(frmProfileEdit.txtProfileName.Text);

        if current then //set it back if we were renaming current profile
          frmMailbox.SetProfile(frmMailbox.Profiles.FindUser(
            frmProfileEdit.txtProfileName.Text));
      end;
    end;
  end;
end;

procedure TfrmProfiles.actEditUpdate(Sender: TObject);
begin
  if (lstProfiles.ItemIndex < 0) or (frmMailbox.Profile = nil) then
    exit;

  if isDefaultProfile or (lstProfiles.Items[lstProfiles.ItemIndex] =
    frmMailbox.Profile.UserName) then
    actEdit.Enabled := True
  else
    actEdit.Enabled := False;
end;

end.

⌨️ 快捷键说明

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