Delphi ActiveX

Copy Email from one IMAP Account to Another

See more IMAP Examples

Demonstrates how to copy the email in a mailbox from one account to another. Delphi ActiveX

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Chilkat_TLB;

...

procedure TForm1.Button1Click(Sender: TObject);
var
success: Integer;
imapSrc: TChilkatImap;
imapDest: TChilkatImap;
fetchUids: Integer;
mset: IMessageSet;
fac: TCkFileAccess;
msetAlreadyCopied: TMessageSet;
strMsgSet: WideString;
numUids: Integer;
sbFlags: TChilkatStringBuilder;
i: Integer;
uid: Integer;
flags: WideString;
mimeStr: WideString;
seen: Integer;
flagged: Integer;
answered: Integer;
draft: Integer;

begin
success := 0;

imapSrc := TChilkatImap.Create(Self);

// This example requires the Chilkat API to have been previously unlocked.
// See Global Unlock Sample for sample code.

// Connect to our source IMAP server.
imapSrc.Ssl := 1;
imapSrc.Port := 993;
success := imapSrc.Connect('MY-IMAP-DOMAIN');
if (success <> 1) then
  begin
    Memo1.Lines.Add(imapSrc.LastErrorText);
    Exit;
  end;

// Login to the source IMAP server
success := imapSrc.Login('MY-IMAP-LOGIN','MY-IMAP-PASSWORD');
if (success <> 1) then
  begin
    Memo1.Lines.Add(imapSrc.LastErrorText);
    Exit;
  end;

imapDest := TChilkatImap.Create(Self);

// Connect to our destination IMAP server.
imapDest.Ssl := 1;
imapDest.Port := 993;
success := imapDest.Connect('MY-IMAP-DOMAIN2');
if (success <> 1) then
  begin
    Memo1.Lines.Add(imapDest.LastErrorText);
    Exit;
  end;

// Login to the destination IMAP server
success := imapDest.Login('MY-IMAP-LOGIN2','MY-IMAP-PASSWORD2');
if (success <> 1) then
  begin
    Memo1.Lines.Add(imapDest.LastErrorText);
    Exit;
  end;

// Select a source IMAP mailbox on the source IMAP server
success := imapSrc.SelectMailbox('Inbox');
if (success <> 1) then
  begin
    Memo1.Lines.Add(imapSrc.LastErrorText);
    Exit;
  end;

fetchUids := 1;

// Get the set of UIDs for all emails on the source server.
mset := imapSrc.Search('ALL',fetchUids);
if (imapSrc.LastMethodSuccess <> 1) then
  begin
    Memo1.Lines.Add(imapSrc.LastErrorText);
    Exit;
  end;

// Load the complete set of UIDs that were previously copied.
// We dont' want to copy any of these to the destination.
fac := TCkFileAccess.Create(Self);
msetAlreadyCopied := TMessageSet.Create(Self);
strMsgSet := fac.ReadEntireTextFile('qa_cache/saAlreadyLoaded.txt','utf-8');
if (fac.LastMethodSuccess = 1) then
  begin
    msetAlreadyCopied.FromCompactString(strMsgSet);
  end;

numUids := mset.Count;
sbFlags := TChilkatStringBuilder.Create(Self);

i := 0;
while i < numUids do
  begin

    // If this UID was not already copied...
    uid := mset.GetId(i);
    if (not msetAlreadyCopied.ContainsId(uid)) then
      begin

        Memo1.Lines.Add('copying ' + IntToStr(uid) + '...');

        // Get the flags.
        flags := imapSrc.FetchFlags(uid,1);
        if (imapSrc.LastMethodSuccess = 0) then
          begin
            Memo1.Lines.Add(imapSrc.LastErrorText);
            Exit;
          end;
        sbFlags.SetString(flags);

        // Get the MIME of this email from the source.
        mimeStr := imapSrc.FetchSingleAsMime(uid,1);
        if (imapSrc.LastMethodSuccess = 0) then
          begin
            Memo1.Lines.Add(imapSrc.LastErrorText);
            Exit;
          end;

        seen := sbFlags.Contains('\\Seen',0);
        flagged := sbFlags.Contains('\\Flagged',0);
        answered := sbFlags.Contains('\\Answered',0);
        draft := sbFlags.Contains('\\Draft',0);

        success := imapDest.AppendMimeWithFlags('Inbox',mimeStr,seen,flagged,answered,draft);
        if (success <> 1) then
          begin
            Memo1.Lines.Add(imapDest.LastErrorText);
            Exit;
          end;

        // Update msetAlreadyCopied with the uid just copied.
        msetAlreadyCopied.InsertId(uid);

        // Save at every iteration just in case there's a failure..
        strMsgSet := msetAlreadyCopied.ToCompactString();
        fac.WriteEntireTextFile('qa_cache/saAlreadyLoaded.txt',strMsgSet,'utf-8',0);
      end;

    i := i + 1;
  end;

// Disconnect from the IMAP servers.
success := imapSrc.Disconnect();
success := imapDest.Disconnect();
end;