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