📄 fprofiles.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 + -