(Tcl) Copy Email from one IMAP Account to Another

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

Chilkat Tcl Extension Downloads Chilkat Tcl Extension Downloads

load ./chilkat.dll

set imapSrc [new_CkImap]

# This example assumes Chilkat Imap to have been previously unlocked.
# See Unlock Imap for sample code.

# Connect to our source IMAP server.
CkImap_put_Ssl $imapSrc 1
CkImap_put_Port $imapSrc 993
set success [CkImap_Connect $imapSrc "MY-IMAP-DOMAIN"]
if {$success != 1} then {
    puts [CkImap_lastErrorText $imapSrc]
    delete_CkImap $imapSrc
    exit
}

# Login to the source IMAP server
set success [CkImap_Login $imapSrc "MY-IMAP-LOGIN" "MY-IMAP-PASSWORD"]
if {$success != 1} then {
    puts [CkImap_lastErrorText $imapSrc]
    delete_CkImap $imapSrc
    exit
}

set imapDest [new_CkImap]

# Connect to our destination IMAP server.
CkImap_put_Ssl $imapDest 1
CkImap_put_Port $imapDest 993
set success [CkImap_Connect $imapDest "MY-IMAP-DOMAIN2"]
if {$success != 1} then {
    puts [CkImap_lastErrorText $imapDest]
    delete_CkImap $imapSrc
    delete_CkImap $imapDest
    exit
}

# Login to the destination IMAP server
set success [CkImap_Login $imapDest "MY-IMAP-LOGIN2" "MY-IMAP-PASSWORD2"]
if {$success != 1} then {
    puts [CkImap_lastErrorText $imapDest]
    delete_CkImap $imapSrc
    delete_CkImap $imapDest
    exit
}

# Select a source IMAP mailbox on the source IMAP server
set success [CkImap_SelectMailbox $imapSrc "Inbox"]
if {$success != 1} then {
    puts [CkImap_lastErrorText $imapSrc]
    delete_CkImap $imapSrc
    delete_CkImap $imapDest
    exit
}

set fetchUids 1

# Get the set of UIDs for all emails on the source server.
# mset is a CkMessageSet
set mset [CkImap_Search $imapSrc "ALL" $fetchUids]
if {[CkImap_get_LastMethodSuccess $imapSrc] != 1} then {
    puts [CkImap_lastErrorText $imapSrc]
    delete_CkImap $imapSrc
    delete_CkImap $imapDest
    exit
}

# Load the complete set of UIDs that were previously copied.
# We dont' want to copy any of these to the destination.
set fac [new_CkFileAccess]

set msetAlreadyCopied [new_CkMessageSet]

set strMsgSet [CkFileAccess_readEntireTextFile $fac "qa_cache/saAlreadyLoaded.txt" "utf-8"]
if {[CkFileAccess_get_LastMethodSuccess $fac] == 1} then {
    CkMessageSet_FromCompactString $msetAlreadyCopied $strMsgSet
}

set numUids [CkMessageSet_get_Count $mset]
set sbFlags [new_CkStringBuilder]

set i 0
while {$i < $numUids} {

    # If this UID was not already copied...
    set uid [CkMessageSet_GetId $mset $i]
    if {![CkMessageSet_ContainsId $msetAlreadyCopied $uid]} then {

        puts "copying $uid..."

        # Get the flags.
        set flags [CkImap_fetchFlags $imapSrc $uid 1]
        if {[CkImap_get_LastMethodSuccess $imapSrc] == 0} then {
            puts [CkImap_lastErrorText $imapSrc]
            delete_CkImap $imapSrc
            delete_CkImap $imapDest
            delete_CkFileAccess $fac
            delete_CkMessageSet $msetAlreadyCopied
            delete_CkStringBuilder $sbFlags
            exit
        }

        CkStringBuilder_SetString $sbFlags $flags

        # Get the MIME of this email from the source.
        set mimeStr [CkImap_fetchSingleAsMime $imapSrc $uid 1]
        if {[CkImap_get_LastMethodSuccess $imapSrc] == 0} then {
            puts [CkImap_lastErrorText $imapSrc]
            delete_CkImap $imapSrc
            delete_CkImap $imapDest
            delete_CkFileAccess $fac
            delete_CkMessageSet $msetAlreadyCopied
            delete_CkStringBuilder $sbFlags
            exit
        }

        set seen [CkStringBuilder_Contains $sbFlags "\\Seen" 0]
        set flagged [CkStringBuilder_Contains $sbFlags "\\Flagged" 0]
        set answered [CkStringBuilder_Contains $sbFlags "\\Answered" 0]
        set draft [CkStringBuilder_Contains $sbFlags "\\Draft" 0]

        set success [CkImap_AppendMimeWithFlags $imapDest "Inbox" $mimeStr $seen $flagged $answered $draft]
        if {$success != 1} then {
            puts [CkImap_lastErrorText $imapDest]
            delete_CkImap $imapSrc
            delete_CkImap $imapDest
            delete_CkFileAccess $fac
            delete_CkMessageSet $msetAlreadyCopied
            delete_CkStringBuilder $sbFlags
            exit
        }

        # Update msetAlreadyCopied with the uid just copied.
        CkMessageSet_InsertId $msetAlreadyCopied $uid

        # Save at every iteration just in case there's a failure..
        set strMsgSet [CkMessageSet_toCompactString $msetAlreadyCopied]
        CkFileAccess_WriteEntireTextFile $fac "qa_cache/saAlreadyLoaded.txt" $strMsgSet "utf-8" 0
    }

    set i [expr $i + 1]
}
delete_CkMessageSet $mset

# Disconnect from the IMAP servers.
set success [CkImap_Disconnect $imapSrc]
set success [CkImap_Disconnect $imapDest]

delete_CkImap $imapSrc
delete_CkImap $imapDest
delete_CkFileAccess $fac
delete_CkMessageSet $msetAlreadyCopied
delete_CkStringBuilder $sbFlags