Delphi DLL

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 DLL

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, FileAccess, Imap, StringBuilder, MessageSet;

...

procedure TForm1.Button1Click(Sender: TObject);
var
success: Boolean;
imapSrc: HCkImap;
imapDest: HCkImap;
fetchUids: Boolean;
mset: HCkMessageSet;
fac: HCkFileAccess;
msetAlreadyCopied: HCkMessageSet;
strMsgSet: PWideChar;
numUids: Integer;
sbFlags: HCkStringBuilder;
i: Integer;
uid: Integer;
flags: PWideChar;
mimeStr: PWideChar;
seen: Boolean;
flagged: Boolean;
answered: Boolean;
draft: Boolean;

begin
success := False;

imapSrc := CkImap_Create();

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

// Connect to our source IMAP server.
CkImap_putSsl(imapSrc,True);
CkImap_putPort(imapSrc,993);
success := CkImap_Connect(imapSrc,'MY-IMAP-DOMAIN');
if (success <> True) then
  begin
    Memo1.Lines.Add(CkImap__lastErrorText(imapSrc));
    Exit;
  end;

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

imapDest := CkImap_Create();

// Connect to our destination IMAP server.
CkImap_putSsl(imapDest,True);
CkImap_putPort(imapDest,993);
success := CkImap_Connect(imapDest,'MY-IMAP-DOMAIN2');
if (success <> True) then
  begin
    Memo1.Lines.Add(CkImap__lastErrorText(imapDest));
    Exit;
  end;

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

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

fetchUids := True;

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

// Load the complete set of UIDs that were previously copied.
// We dont' want to copy any of these to the destination.
fac := CkFileAccess_Create();
msetAlreadyCopied := CkMessageSet_Create();
strMsgSet := CkFileAccess__readEntireTextFile(fac,'qa_cache/saAlreadyLoaded.txt','utf-8');
if (CkFileAccess_getLastMethodSuccess(fac) = True) then
  begin
    CkMessageSet_FromCompactString(msetAlreadyCopied,strMsgSet);
  end;

numUids := CkMessageSet_getCount(mset);
sbFlags := CkStringBuilder_Create();

i := 0;
while i < numUids do
  begin

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

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

        // Get the flags.
        flags := CkImap__fetchFlags(imapSrc,uid,True);
        if (CkImap_getLastMethodSuccess(imapSrc) = False) then
          begin
            Memo1.Lines.Add(CkImap__lastErrorText(imapSrc));
            Exit;
          end;
        CkStringBuilder_SetString(sbFlags,flags);

        // Get the MIME of this email from the source.
        mimeStr := CkImap__fetchSingleAsMime(imapSrc,uid,True);
        if (CkImap_getLastMethodSuccess(imapSrc) = False) then
          begin
            Memo1.Lines.Add(CkImap__lastErrorText(imapSrc));
            Exit;
          end;

        seen := CkStringBuilder_Contains(sbFlags,'\\Seen',False);
        flagged := CkStringBuilder_Contains(sbFlags,'\\Flagged',False);
        answered := CkStringBuilder_Contains(sbFlags,'\\Answered',False);
        draft := CkStringBuilder_Contains(sbFlags,'\\Draft',False);

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

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

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

    i := i + 1;
  end;

CkMessageSet_Dispose(mset);

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

CkImap_Dispose(imapSrc);
CkImap_Dispose(imapDest);
CkFileAccess_Dispose(fac);
CkMessageSet_Dispose(msetAlreadyCopied);
CkStringBuilder_Dispose(sbFlags);

end;