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

📄 fimportmessageswizard.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 fImportMessagesWizard;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, JvWizard, JvWizardRouteMapSteps, JvWizardRouteMapNodes, JvWaitingGradient, ExtCtrls,
  StdCtrls, VirtualTrees, PluginManager, JvComponent, JvExControls, ActiveX,
  BasePluginInterface, siMailPluginInterfaces, StrUtils;

type
  TfrmImportMessagesWizard = class(TForm)
    wizard: TJvWizard;
    KWizardRouteMapSteps1: TJvWizardRouteMapSteps;
    wizWelcome: TJvWizardWelcomePage;
    wizImport: TJvWizardInteriorPage;
    wizImportFrom: TJvWizardInteriorPage;
    Panel1: TPanel;
    txtLog: TMemo;
    Label1: TLabel;
    lstFormats: TVirtualStringTree;
    lblDescription: TLabel;
    Label2: TLabel;
    wizImportSettings: TJvWizardInteriorPage;
    pnlPlugInContainer: TScrollBox;
    Panel3: TPanel;
    Label3: TLabel;
    cmboxAccounts: TComboBox;
    procedure wizardFinishButtonClick(Sender: TObject);
    procedure wizardCancelButtonClick(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormShortCut(var Msg: TWMKey; var Handled: Boolean);
    procedure lstFormatsGetNodeDataSize(Sender: TBaseVirtualTree;
      var NodeDataSize: Integer);
    procedure lstFormatsGetText(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lstFormatsChange(Sender: TBaseVirtualTree;
      Node: PVirtualNode);
    procedure wizardSelectNextPage(Sender: TObject;
      FromPage: TJvWizardCustomPage; var ToPage: TJvWizardCustomPage);
    procedure wizWelcomeEnterPage(Sender: TObject;
      const Page: TJvWizardCustomPage);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    FPlugIns: TPluginManager;
    imported: Boolean;
    oldOffline: Boolean;
    procedure AddNewFormatToList(plugIn: IsiMailMailboxImportPlugin_V1; no: Integer);
    procedure Import;
    procedure SaveMessage(msg: PChar; accountNo, mailboxNo: Integer);
  public
    { Public declarations }
  end;

var
  frmImportMessagesWizard: TfrmImportMessagesWizard;

implementation

uses
  mailBox, defFldrs, gnugettext, account, fMain, mimemess_siMail, tasks, uMbox,
  uRescue;

{$R *.dfm}

type TTreeFormats = record
    Caption: String;
    pi: IsiMailMailboxImportPlugin_V1;
    Format: Integer;   //format no form plugin
end;

type PTreeFormats = ^TTreeFormats;

var SelectedPlugIn: TTreeFormats;

procedure TfrmImportMessagesWizard.wizardFinishButtonClick(Sender: TObject);
begin
  if not imported then begin
    Import;
    imported := True;
  end
  else
    Self.Close;
end;

procedure TfrmImportMessagesWizard.wizardCancelButtonClick(Sender: TObject);
begin
  Self.Close;
end;

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

procedure TfrmImportMessagesWizard.FormShow(Sender: TObject);
var i, j: Integer;
var ipi_V1: IsiMailMailboxImportPlugin_V1;
begin
  //translate me
  TranslateComponent(Self);
  oldOffline := frmMain.Online;
  frmMain.Online := False;
  
  cmboxAccounts.Clear;
  for i:=  0 to frmMailbox.Profile.Accounts.Count - 1 do
    cmboxAccounts.Items.AddObject(frmMailbox.Profile.Accounts[i].AccountName, Pointer(i));

  cmboxAccounts.ItemIndex := 0;

  lstFormats.Clear;
  wizard.ActivePageIndex := 0;

  //read self position & size
  frmMailbox.Profile.Config.ReadControlSettings(Self);
  lstFormats.Clear;

  if FPlugIns.Count = 0 then begin
    FPlugIns.AddCustomPlugin(uMbox.RegisterPlugin);
    FPlugIns.AddCustomPlugin(uRescue.RegisterPlugin);
    //load dll plug-ins
    FPlugIns.PluginFolder := df.piImportMessages;
    FPlugIns.LoadPlugins;
  end;

  for i := 0 to FPlugIns.Count - 1 do begin
    if FPlugIns.PlugIn[i].QueryInterface(IIsiMailMailboxImportPlugin_V1, ipi_V1) = S_OK then begin
      FPlugIns.PlugIn[i].SetApplication(Application.Handle);
      for j := 1 to ipi_V1.GetSupportedFormatCount do
        AddNewFormatToList(ipi_V1, j);
    end;
  end;
  txtLog.Clear;
end;

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

procedure TfrmImportMessagesWizard.lstFormatsGetNodeDataSize(
  Sender: TBaseVirtualTree; var NodeDataSize: Integer);
begin
  NodeDataSize := SizeOf(TTreeFormats);
end;

procedure TfrmImportMessagesWizard.lstFormatsGetText(
  Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
  TextType: TVSTTextType; var CellText: WideString);
begin
  CellText := PTreeFormats(Sender.GetNodeData(Node)).Caption;
end;

procedure TfrmImportMessagesWizard.FormCreate(Sender: TObject);
begin
  FPlugIns := TPluginManager.Create;
end;

procedure TfrmImportMessagesWizard.FormDestroy(Sender: TObject);
begin
  if SelectedPlugIn.pi <> nil then begin
    SelectedPlugIn.pi.SetParentHandle(0);
    SelectedPlugIn.pi := nil;
  end;
  FreeAndNil(FPlugIns);
end;

procedure TfrmImportMessagesWizard.AddNewFormatToList(
  plugIn: IsiMailMailboxImportPlugin_V1; no: Integer);
var nd: PTreeFormats;
var str: PChar;
begin
  nd := lstFormats.GetNodeData(lstFormats.AddChild(nil));
  nd^.Format := no;
  nd^.pi := plugIn;
  plugIn.GetSupportedFormat(no, str);
  nd^.Caption := str;
end;

procedure TfrmImportMessagesWizard.lstFormatsChange(
  Sender: TBaseVirtualTree; Node: PVirtualNode);
var nd: PTreeFormats;
var str: PChar;
begin
  if Node = nil then
    Exit;
  nd := lstFormats.GetNodeData(Node);
  nd^.pi.GetSupportedFormatDescription(nd^.Format, str);
  lblDescription.Caption := str;
end;

procedure TfrmImportMessagesWizard.wizardSelectNextPage(Sender: TObject;
  FromPage: TJvWizardCustomPage; var ToPage: TJvWizardCustomPage);
var Node: PVirtualNode;
var nd: PTreeFormats;
begin
  if FromPage = wizImportFrom then begin
    Node := lstFormats.GetFirstSelected;
    if Node <> nil then begin
      nd := lstFormats.GetNodeData(Node);
      SelectedPlugIn := nd^;
      //set plug-in to correct format and mode
      nd^.pi.SetFormat(nd^.Format);
      //set plug-in settings parent
      nd^.pi.SetParentHandle(pnlPlugInContainer.Handle);
      pnlPlugInContainer.VertScrollBar.Range := nd^.pi.GetSettingsHeight;
    end
    else begin
      MessageDlg(_('Please select import format.'), mtError, [mbOK], 0);
      ToPage := nil;
    end;
  end
  else if FromPage = wizImportSettings then begin
    if SelectedPlugIn.pi.AllSettingsSet = 0 then begin
      ToPage := nil;
      Exit;
    end;
    ToPage.VisibleButtons := ToPage.VisibleButtons + [bkFinish];
  end;

end;

procedure TfrmImportMessagesWizard.Import;
var mboxCnt: Integer;
var msgCnt: Integer;
var mboxNo: Integer;
var i, j: Integer;
var pi: IsiMailMailboxImportPlugin_V1;
var str: PChar;
var msg: String;
var mboxName: String;
var mbox: TMailbox;
var more: Boolean;

procedure addSeparator;
begin
  txtLog.Lines.Add('');
  txtLog.Lines.Add('');
  txtLog.Lines.Add('+******************************************************+');
end;

begin
  pi := SelectedPlugIn.pi;
  mboxCnt := pi.GetMailboxCount;

  if mboxCnt < 1 then begin
    MessageDlg(_('No mailboxes selected.'), mtInformation, [mbOK], 0);
    Exit;
  end;

  Screen.Cursor := crHourGlass;
  msg := _('Importing message %d.');
  for i := 0 to mboxCnt - 1 do begin
    //set correct mailbox
    pi.SetMailbox(i);
    pi.GetMailboxName(str);
    mboxName := str;

    if i <> 0 then
      addSeparator;
    
    txtLog.Lines.Add(Format(_('Searching for ''%s'' mailbox in ''%s'' account.'), [mboxName, cmboxAccounts.Text]));
    mboxNo := frmMailbox.Profile.Accounts[Integer(cmboxAccounts.Items.Objects[cmboxAccounts.ItemIndex])].Mailboxes.Find(mboxName);

    if mboxNo = -1 then begin
      txtLog.Lines.Add(Format(_('''%s'' mailbox doesn''t exist.'), [mboxName]));
      mboxName := frmMain.ValidateFileName(mboxName);
      frmMailbox.Profile.Accounts[Integer(cmboxAccounts.Items.Objects[cmboxAccounts.ItemIndex])].CreateNewMailbox(mboxName);
      mboxNo := frmMailbox.Profile.Accounts[Integer(cmboxAccounts.Items.Objects[cmboxAccounts.ItemIndex])].Mailboxes.Find(mboxName);
      txtLog.Lines.Add(Format(_('''%s'' mailbox created.'), [mboxName]));
      frmMailbox.AddNewMailboxTo(Integer(cmboxAccounts.Items.Objects[cmboxAccounts.ItemIndex]));
    end;
    mbox := frmMailbox.Profile.Accounts[Integer(cmboxAccounts.Items.Objects[cmboxAccounts.ItemIndex])].Mailboxes[mboxNo];

    txtLog.Lines.Add(Format(_('Importing messages from mailbox: %s'), [mboxName]));
    msgCnt := pi.GetMessageCount;
    txtLog.Lines.Add(Format(ngettext('There is %d message in ''%s''',
      'There are %d messages in ''%s''', msgCnt), [msgCnt, mboxName]));

    more := True;
    j := 0;
    while more do begin
      Inc(j);
      txtLog.Lines.Add(Format(msg, [j]));
      if pi.GetMessage(more, str) = S_OK then begin
        SaveMessage(str, Integer(cmboxAccounts.Items.Objects[cmboxAccounts.ItemIndex]), mboxNo);
        pi.FreeMessage();
      end
      else begin
        txtLog.Lines.Add(Format(_('Plug-in reported error. Message %d not imported.'), [j]));
      end;
    end;
  end;

  addSeparator;
  txtLog.Lines.Add(_('Message import complete.'));
  txtLog.Lines.Add(_('Press Finish or Cancel to close import messages wizard window..'));
  frmMailbox.trMailbox.Refresh;
  
  Screen.Cursor := crDefault;
end;

procedure TfrmImportMessagesWizard.wizWelcomeEnterPage(Sender: TObject;
  const Page: TJvWizardCustomPage);
begin
  imported := False;
end;

//this function is almost the same as save message part in frmTasks
//some day write only one function
procedure TfrmImportMessagesWizard.SaveMessage(msg: PChar; accountNo, mailboxNo: Integer);
var descr: TmsgDescription;
var mime: TMimeMess;
var at: Boolean;
var strm: TMemoryStream;
var i: Integer;
begin
  strm := TMemoryStream.Create;
  mime := TMimeMess.Create;
  mime.Lines.Text := msg;
  mime.DecodeMessage;
  mime.Lines.SaveToStream(strm);

  at := frmTasks.HasAttachments(mime.MessagePart);
  with descr do begin
    subject := UTF8Decode(mime.Header.Subject);
    if mailboxNo <> Integer(mboxSent) - 1 then
      from := UTF8Decode(mime.Header.From)
    else begin
      for i := 0 to mime.Header.ToList.Count - 1 do begin
        from := from + ',' + UTF8Decode(mime.Header.ToList.Strings[i]);
      end;
      from := RightStr(from, Length(from) - 1);
    end;

    comment := '';
    msgPart := '';
    date := mime.Header.Date;
    size := Length(mime.Lines.text);
    priority := Integer(mime.Header.Priority) + 1;
    replyDate := 0;
    forwardDate := 0;
    markId := 0;
    forwardedTo := '';
    account := frmMailbox.Profile.Accounts[accountNo].AccountName;
    if at then
      status := [msgAttachmentInside, msgRead]
    else
      status := [msgRead];

    uidl := '';
    //add message
    frmMailbox.Profile.Accounts[accountNo].TotalMessageCount :=
      frmMailbox.Profile.Accounts[accountNo].TotalMessageCount + 1;
    frmMailbox.Profile.Accounts[accountNo].Mailboxes
      [mailboxNo].AddMessage(strm, descr);
  end;
  FreeAndNil(mime);
  FreeAndNil(strm);
end;

procedure TfrmImportMessagesWizard.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  frmMain.Online := oldOffline;
end;

end.

⌨️ 快捷键说明

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