fexportmessageswizard.pas

siMail, siMail, siMail, siMail

  FromPage: TJvWizardCustomPage; var ToPage: TJvWizardCustomPage);
var Node: PVirtualNode;
var nd: PTreeFormats;
var i, t: Integer;
begin
  if FromPage = wizWelcome then begin
    t := 0;
    for i := 0 to chklstMailboxes.Items.Count - 1 do begin
      if chklstMailboxes.Checked[i] then
        Inc(t);
    end;

    if t = 0 then begin
      MessageDlg(_('Please select at least one mailbox to export.'), mtError, [mbOK], 0);
      ToPage := nil;
    end;
  end
  else if FromPage = wizExportFrom 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 export format.'), mtError, [mbOK], 0);
      ToPage := nil;
    end;
  end
  else if FromPage = wizExportSettings then begin
    if SelectedPlugIn.pi.AllSettingsSet = 0 then begin
      ToPage := nil;
      Exit;
    end;
    ToPage.VisibleButtons := ToPage.VisibleButtons + [bkFinish];
  end;

end;

procedure TfrmExportMessagesWizard.Export;
var mboxCnt: Integer;
var mboxNo: Integer;
var i, j, k: Integer;
var pi: IsiMailMailboxExportPlugin_V1;
var str: String;
var msg: String;
var mboxName: String;
var mbox: TMailbox;
var msgDescr: TMsgDescription;
var mboxes: TStringList;
var accountNo: Integer;
var msgIDs: array of Integer;

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

begin
  pi := SelectedPlugIn.pi;
  mboxes := TStringList.Create;
  for i := 0 to chklstMailboxes.Items.Count -1 do begin
    if chklstMailboxes.Checked[i] then
      mboxes.Add(IntToStr(i));
  end;
  mboxCnt := mboxes.Count;

  pi.SetMailboxCount(mboxCnt);

  Screen.Cursor := crHourGlass;
  msg := _('Exporting message %d.');
  accountNo := Integer(cmboxAccounts.Items.Objects[cmboxAccounts.ItemIndex]);
  for i := 0 to mboxCnt - 1 do begin
    //set correct mailbox
    pi.SetMailbox(i);
    mboxNo := StrToInt(mboxes.Strings[i]);
    mboxName := frmMailbox.Profile.Accounts[accountNo].Mailboxes[mboxNo].MailboxName;
    pi.SetMailboxName(PChar(mboxName));

    if i <> 0 then
      addSeparator;

    mbox := frmMailbox.Profile.Accounts[accountNo].Mailboxes[mboxNo];

    txtLog.Lines.Add(Format(_('Exporting messages from mailbox: %s'), [mboxName]));
    pi.SetMessageCount(mbox.TotalMessageCount);
    txtLog.Lines.Add(Format(ngettext('There is %d message in ''%s''',
    'There are %d messages in ''%s''', mbox.TotalMessageCount), [mbox.TotalMessageCount, mboxName]));

    //cache undeleted message IDs
    SetLength(msgIDs, mbox.TotalMessageCount);
    k := 0;
    for j := 0 to mbox.LastMessageIndex -1 do begin
      msgDescr := mbox.GetMessageDescription(j);
      if not msgDescr.deleted then begin
        msgIDs[k] := j;
        Inc(k);
      end;
    end;

    for j := 0 to mbox.TotalMessageCount - 1 do begin
      txtLog.Lines.Add(Format(msg, [j]));
      buildMessage(mbox, msgIDs[j], str);
      if pi.SetMessage(j = mbox.TotalMessageCount - 1, PChar(str)) <> S_OK then
        txtLog.Lines.Add(Format(_('Plug-in reported error. Message %d not exported.'), [j]));
    end;
  end;

  addSeparator;
  txtLog.Lines.Add(_('Message export complete.'));
  txtLog.Lines.Add(_('Press Finish or Cancel to close export messages wizard window..'));
  msgIDs := nil;
  FreeAndNil(mboxes);

  Screen.Cursor := crDefault;
end;

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

procedure TfrmExportMessagesWizard.buildMessage(mbox: TMailbox; msgID: Integer; var str: String);
var oldMime, FMime: TmimeMess;
var mimeMulti: TMimePart;
var flatMsg: TFlatMsg;
var i: Integer;
var msgDescr: TMsgDescription;
var strm: TMemoryStream;
begin
  str := '';
  msgDescr := mbox.GetMessageDescription(msgID);

  strm := TMemoryStream(mbox.GetMessageContent(msgID));
  strm.Position := 0;
  //if there is no attachments just read msg from file and write it to str
  if not ((msgAttachmentOutside in msgDescr.status) and (msgAttachmentInside in msgDescr.status)) then
    str := readStringFromStream(strm.Size, strm)
  //otherwise build message and write it to string
  else begin
    oldMime := TMimeMess.Create;
    oldMime.Lines.LoadFromStream(strm);
    oldMime.DecodeMessage;
    oldMime.MessagePart.DecodePart;

    FMime := TMimeMess.Create;

    flatMsg := TFlatMsg.Create;
    flatMsg.MakeFlat(oldMime.MessagePart);

    //build headers
    with FMime.Header do begin
      Clear;
      From := oldMime.Header.From;
      ToList.Assign(oldMime.Header.ToList);
      CCList.Assign(oldMime.Header.CCList);
      Subject := oldMime.Header.Subject;
      Organization := oldMime.Header.Organization;
      Date := oldMime.Header.Date;
      XMailer := oldMime.Header.XMailer;
      Priority := oldMime.Header.Priority;
      ReplyTo := oldMime.Header.ReplyTo;
      Notification := oldMime.Header.Notification;
    end;

    if (oldMime.Header.AttachList.Count = 0) and (flatMsg.AttachmentPartCount = 0) then begin //no attachments
      FMime.AddPart(nil).Assign(flatMsg.Parts[0]);
    end
    else begin
      mimeMulti := FMime.AddPartMultipart('mixed', nil);
      FMime.AddPart(mimeMulti).Assign(flatMsg.Parts[0]);

      //add attachments to list
      for i := 0 to oldMime.Header.AttachList.Count - 1 do begin
        oldMime.Header.AttachList.Strings[i] :=
          UTF8Decode(oldMime.Header.AttachList.Strings[i]);
        if FileExists(oldMime.Header.AttachList.Strings[i]) then
          FMime.AddPartBinaryFromFile(
            oldMime.Header.AttachList.Strings[i], mimeMulti);
      end;

      for i := 0 to flatMsg.AttachmentPartCount - 1 do
        FMime.AddPart(mimeMulti).Assign(flatMsg.Attachments[i]);
    end;
    FMime.EncodeMessage;
    str := FMime.Lines.Text;

    FreeAndNil(oldMime);
    FreeAndNil(flatMsg);
    FreeAndNil(FMime);
  end;
  FreeAndNil(strm);
end;

procedure TfrmExportMessagesWizard.mnuSelectAllClick(Sender: TObject);
var i:Integer;
begin
  for i := 0 to chklstMailboxes.Items.Count - 1 do begin
    chklstMailboxes.Checked[i] := True;
  end;
end;

procedure TfrmExportMessagesWizard.mnuSelectNoneClick(Sender: TObject);
var i: Integer;
begin
  for i := 0 to chklstMailboxes.Items.Count - 1 do begin
    chklstMailboxes.Checked[i] := False;
  end;
end;

procedure TfrmExportMessagesWizard.mnuInvertSelectionClick(Sender: TObject);
var i: Integer;
begin
  for i := 0 to chklstMailboxes.Items.Count - 1 do begin
    chklstMailboxes.Checked[i] := not chklstMailboxes.Checked[i];
  end;
end;

procedure TfrmExportMessagesWizard.cmboxAccountsChange(Sender: TObject);
var i: Integer;
var cnt: Integer;
begin
  chklstMailboxes.Clear;
  cnt := Integer(cmboxAccounts.Items.Objects[cmboxAccounts.ItemIndex]);
  for i := 0 to frmMailbox.Profile.Accounts[cnt].Mailboxes.Count - 1 do
    chklstMailboxes.Items.Add(frmMailbox.Profile.Accounts[cnt].Mailboxes[i].MailboxName);
end;

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

function TfrmExportMessagesWizard.readStringFromStream(len: Integer; stream: TStream): String;
begin
  SetLength(Result, len);
  stream.Read(PChar(Result)^, len);
end;

end.