fnewaccountwizard.pas

siMail, siMail, siMail, siMail

(*
# (C) Copyright 2003
# Miha Vrhovnik, [e-mail]
#
# 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 fNewAccountWizard;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, JvWizard, JvWizardRouteMapSteps, OleCtrls, StdCtrls, ExtCtrls, Buttons,
  OmniXML, OmniXMLUtils, StrUtils, account, embeddedWB, SHDocVw, JvExControls,
  JvComponent;

type
  TfrmNewAccountWizard = class(TForm)
    wizard: TJvWizard;
    wizWelcome: TJvWizardWelcomePage;
    WizardRouteMapSteps: TJvWizardRouteMapSteps;
    wizProfile: TJvWizardInteriorPage;
    wizAccount: TJvWizardInteriorPage;
    wizUser: TJvWizardInteriorPage;
    wizServer: TJvWizardInteriorPage;
    wizSummary: TJvWizardInteriorPage;
    GroupBox1: TGroupBox;
    rbAcc1: TRadioButton;
    rbAcc2: TRadioButton;
    pnlAcc2: TGroupBox;
    Label17: TLabel;
    Label22: TLabel;
    Label28: TLabel;
    cmboxAccount: TComboBox;
    txtAccountName2: TEdit;
    pnlAcc1: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    Label6: TLabel;
    Label5: TLabel;
    txtAccountName1: TEdit;
    txtAccountPath: TEdit;
    cmdAccountPath: TBitBtn;
    GroupBox2: TGroupBox;
    Label12: TLabel;
    Label13: TLabel;
    Label21: TLabel;
    txtIncoming: TEdit;
    txtOutgoing: TEdit;
    cmboxSmtpAuth: TComboBox;
    pnlPwd2: TPanel;
    Label26: TLabel;
    Label27: TLabel;
    txtLoginUser2: TEdit;
    txtLoginPwd2: TEdit;
    chkSamePwd: TCheckBox;
    cmdIncoming: TBitBtn;
    cmdOutgoing: TBitBtn;
    txtSummary: TEmbeddedWB;
    Panel1: TPanel;
    Panel2: TPanel;
    Label14: TLabel;
    txtProfile: TEdit;
    Label30: TLabel;
    txtPwd: TEdit;
    Label31: TLabel;
    txtRetypePwd: TEdit;
    Panel3: TPanel;
    Label16: TLabel;
    Label8: TLabel;
    Label24: TLabel;
    Label10: TLabel;
    Label23: TLabel;
    Label15: TLabel;
    Label9: TLabel;
    Label7: TLabel;
    Label25: TLabel;
    txtLoginPwd1: TEdit;
    txtLoginUser1: TEdit;
    txtReplyEmail: TEdit;
    txtEmail: TEdit;
    txtOrganization: TEdit;
    txtYourName: TEdit;
    Panel4: TPanel;
    rbProt1: TRadioButton;
    rbProt2: TRadioButton;
    rbProt3: TRadioButton;
    Label18: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    procedure txtProfileKeyPress(Sender: TObject; var Key: Char);
    procedure rbAcc1Click(Sender: TObject);
    procedure cmboxSmtpAuthChange(Sender: TObject);
    procedure cmdIncomingClick(Sender: TObject);
    procedure chkSamePwdClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormShortCut(var Msg: TWMKey; var Handled: Boolean);
    procedure wizardCancelButtonClick(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure wizardSelectNextPage(Sender: TObject;
      FromPage: TJvWizardCustomPage; var ToPage: TJvWizardCustomPage);
    procedure wizardSelectPriorPage(Sender: TObject;
      FromPage: TJvWizardCustomPage; var ToPage: TJvWizardCustomPage);
    procedure wizardFinishButtonClick(Sender: TObject);
    procedure txtSummaryNavigateComplete2(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
  private
    { Private declarations }
    popAndSmtpLoaded: Boolean;
    serverSett: IXMLDocument;
    Fcancled: Boolean;
    procedure findServerSettings;
    procedure createAccount;
    procedure prepareControls;
    procedure accountSummary;
    function  validateEmail(str: String): Boolean;
  public
    { Public declarations }
    property Cancled: Boolean read FCancled;
    function CheckProfile(profileName: String): Boolean;
    function CheckAccount(accountName: String): Boolean;
  end;

var
  frmNewAccountWizard: TfrmNewAccountWizard;

implementation

uses
  fNewAccServerProperties, mailBox, fMain, gnugettext, defFldrs;

{$R *.dfm}

procedure TfrmNewAccountWizard.txtProfileKeyPress(Sender: TObject; var Key: Char);
begin
  case Key of
    '\', '/', ':', '*', '?', '"', '<', '>', '|':
    begin
      MessageDlg(Format(_('' +
        'Users account name cannot contain any of following characters:' +
        #13#10 + '%s'), ['\,/,:,*,?,",<,>,|']), mtError, [mbOK], 0);
      Key := #0;
    end;
  end;
end;

procedure TfrmNewAccountWizard.rbAcc1Click(Sender: TObject);
begin
  if rbAcc1.Checked then begin
    pnlAcc1.Visible := True;
    pnlAcc2.Visible := False;
  end
  else if rbAcc2.Checked then begin
    pnlAcc1.Visible := False;
    pnlAcc2.Visible := True;
  end;
end;

procedure TfrmNewAccountWizard.cmboxSmtpAuthChange(Sender: TObject);
begin
  if cmboxSmtpAuth.ItemIndex > 0 then pnlPwd2.Visible := True
  else pnlPwd2.Visible := False;
end;

procedure TfrmNewAccountWizard.cmdIncomingClick(Sender: TObject);
begin
  frmNewAccServerProperties.ShowModal;
end;

procedure TfrmNewAccountWizard.chkSamePwdClick(Sender: TObject);
begin
  if chkSamePwd.Checked then begin
    label26.Enabled := False;
    label27.Enabled := False;
    txtLoginUser2.Enabled := False;
    txtLoginPwd2.Enabled := False;
  end
  else begin
    label26.Enabled := True;
    label27.Enabled := True;
    txtLoginUser2.Enabled := True;
    txtLoginPwd2.Enabled := True;
  end;
end;

procedure TfrmNewAccountWizard.accountSummary;
var html: String;
var tmpStr1, tmpStr2: String;
var tmpPath: PChar;
var fle: TFileStream;
begin
  html := '<?XML version="1.0" encoding="utf-8"?>' + #13#10 +
    '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN' + #13#10 +
    '"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">' + #13#10 +
    '<html xmlns="http://www.w3.org/1999/xhtml">' + #13#10 +
    '<head> <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />'
    + #13#10 +
    '<title></title></head>' + #13#10 + '<body>' + #13#10;

  if Trim(txtProfile.Text) <> '' then
    tmpStr1 := Trim(txtProfile.Text)
  else //find user in user list
    tmpStr1 := frmMailbox.Profile.UserName;

    //gettext: account creation summary
  html := html + Format(_('Profile Name: <b>%s</b><br />'), [tmpStr1]);
  if rbAcc1.Checked then
    html := html + Format(_('Account Name: <b>%s</b><br /><br />'),
      [Trim(txtAccountName1.Text)])
  else
    html := html + Format(_('' +
      'All messages from <b>%s</b> are delivered to <b>%s</b>.<br /><br />'),
      [Trim(txtAccountName2.Text), cmboxAccount.Items[cmboxAccount.ItemIndex]]);

  html := html + _('Personal data for this account is:<br />');
  html := html + Format(_('&nbsp;&nbsp;Name: <b>%s</b><br />'), [Trim(txtYourName.Text)]);
  html := html + Format(_('&nbsp;&nbsp;Organization: <b>%s</b><br />'),
    [Trim(txtOrganization.Text)]);
  html := html + Format(_('&nbsp;&nbsp;E-mail: <b>%s</b><br />'), [Trim(txtEmail.Text)]);
  html := html + Format(_('&nbsp;&nbsp;Reply e-mail: <b>%s</b><br /><br />'),
    [Trim(txtReplyEmail.Text)]);

  if rbProt1.Checked then tmpStr1 := _('POP3')
  else if rbProt2.Checked then tmpStr1 := _('IMAP')
  else if rbProt3.Checked then tmpStr1 := _('HTML');

  SetLength(tmpStr2, Length(txtLoginPwd1.Text));
  FillChar(tmpStr2[1], Length(txtLoginPwd1.Text), '*');
  html := html + Format(_('To fetch messages login to <b>%s</b>, using <b>%s</b>' +
    ' with <b>%s</b> and <b>%s</b>.<br />'),
    [Trim(txtIncoming.Text), tmpStr1, txtLoginUser1.Text, tmpStr2]);

  if rbProt1.Checked then tmpStr1 := _('SMTP')
  else if rbProt2.Checked then tmpStr1 := _('SMTP')
  else if rbProt3.Checked then tmpStr1 := _('HTML');

  if cmboxSmtpAuth.ItemIndex = 0 then begin
    html := html + Format(_('To send messages login to <b>%s</b>, using <b>%s</b>' +
      '  without authentication.<br />'), [Trim(txtOutgoing.Text), tmpStr1]);
  end
  else begin
    if chkSamePwd.Checked then begin
      SetLength(tmpStr2, Length(txtLoginPwd1.Text));
      FillChar(tmpStr2[1], Length(txtLoginPwd1.Text), '*');
      html := html + Format(
        _('To send messages login to <b>%s</b>, using <b>%s</b>' +
        ' with <b>%s</b> and <b>%s</b>.<br />'),
        [Trim(txtOutgoing.Text), tmpStr1, txtLoginUser1.Text, tmpStr2]);
    end
    else begin
      SetLength(tmpStr2, Length(txtLoginPwd2.Text));
      FillChar(tmpStr2[1], Length(txtLoginPwd2.Text), '*');
      html := html + Format(
        _('To send messages login to <b>%s</b>, using <b>%s</b>' +
        ' with <b>%s</b> and <b>%s</b>.<br />'),
        [Trim(txtOutgoing.Text), tmpStr1, txtLoginUser2.Text, tmpStr2]);
    end;
  end;

  html := html + #13#10 + '</body></html>';
  html := Utf8Encode(html);

  tmpPath := StrAlloc(512);
  if GetTempPath(512, tmpPath) > 0 then begin
    tmpStr1 := tmpPath;
    StrDispose(tmpPath);
    if tmpStr1[Length(tmpStr1)] <> '\' then tmpStr1 := tmpStr1 + '\';
    tmpStr1 := tmpStr1 + tmpFilePrefix + 'summary.html';
    fle := TFileStream.Create(tmpStr1, fmCreate or fmOpenReadWrite);
    try
      fle.WriteBuffer(html[1], Length(html))
    finally
      FreeAndNil(fle);
    end;
  end;
  txtSummary.Navigate(tmpStr1);
end;

procedure TfrmNewAccountWizard.createAccount;
var accID: Integer;
begin
  accID := -2;
  //add new profile
  txtProfile.Text := Trim(txtProfile.Text);
  if txtProfile.Text <> '' then begin
    frmMailbox.Profiles.Add(txtProfile.Text, txtPwd.Text);
    frmMain.SetDefaultProfile(txtProfile.Text);
    frmMailbox.SetProfile(0);
  end;

  if rbAcc1.Checked then begin
    accID := frmMailbox.Profile.CreateNewAccount(Trim(txtAccountName1.Text));
  end
  else accID := frmMailbox.Profile.CreateNewAccount(Trim(txtAccountName2.Text));

  if (accID >= 0) then begin
    with frmMailbox.Profile.Accounts[accID] do begin
      UnreadMessageCount := 0;
      TotalMessageCount := 0;
      AccountPath := '';
      if rbProt1.Checked then AccountType := accPOP
      else if rbProt2.Checked then AccountType := accIMAP
      else if rbProt2.Checked then AccountType := accHTML;
      AccountDeliverToAccount := cmboxAccount.Items.Strings[cmboxAccount.ItemIndex];
      EMail := Trim(txtEmail.Text);
      Organization := Trim(txtOrganization.Text);
      ReplyEmail := Trim(txtReplyEmail.Text);
      YourName := Trim(txtYourName.Text);

      case AccountType of
        accPOP:
        begin
          POP3Password := txtLoginPwd1.Text;
          POP3Port := StrToInt(frmNewAccServerProperties.txtPOP3Port.Text);
          POP3Server := Trim(txtIncoming.Text);
          POP3Timeout := StrToInt(frmNewAccServerProperties.txtPOP3Timeout.Text);