PureBasic

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. PureBasic

IncludeFile "CkStringBuilder.pb"
IncludeFile "CkImap.pb"
IncludeFile "CkMessageSet.pb"
IncludeFile "CkFileAccess.pb"

Procedure ChilkatExample()

    success.i = 0

    imapSrc.i = CkImap::ckCreate()
    If imapSrc.i = 0
        Debug "Failed to create object."
        ProcedureReturn
    EndIf

    ; 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::setCkSsl(imapSrc, 1)
    CkImap::setCkPort(imapSrc, 993)
    success = CkImap::ckConnect(imapSrc,"MY-IMAP-DOMAIN")
    If success <> 1
        Debug CkImap::ckLastErrorText(imapSrc)
        CkImap::ckDispose(imapSrc)
        ProcedureReturn
    EndIf

    ; Login to the source IMAP server
    success = CkImap::ckLogin(imapSrc,"MY-IMAP-LOGIN","MY-IMAP-PASSWORD")
    If success <> 1
        Debug CkImap::ckLastErrorText(imapSrc)
        CkImap::ckDispose(imapSrc)
        ProcedureReturn
    EndIf

    imapDest.i = CkImap::ckCreate()
    If imapDest.i = 0
        Debug "Failed to create object."
        ProcedureReturn
    EndIf

    ; Connect to our destination IMAP server.
    CkImap::setCkSsl(imapDest, 1)
    CkImap::setCkPort(imapDest, 993)
    success = CkImap::ckConnect(imapDest,"MY-IMAP-DOMAIN2")
    If success <> 1
        Debug CkImap::ckLastErrorText(imapDest)
        CkImap::ckDispose(imapSrc)
        CkImap::ckDispose(imapDest)
        ProcedureReturn
    EndIf

    ; Login to the destination IMAP server
    success = CkImap::ckLogin(imapDest,"MY-IMAP-LOGIN2","MY-IMAP-PASSWORD2")
    If success <> 1
        Debug CkImap::ckLastErrorText(imapDest)
        CkImap::ckDispose(imapSrc)
        CkImap::ckDispose(imapDest)
        ProcedureReturn
    EndIf

    ; Select a source IMAP mailbox on the source IMAP server
    success = CkImap::ckSelectMailbox(imapSrc,"Inbox")
    If success <> 1
        Debug CkImap::ckLastErrorText(imapSrc)
        CkImap::ckDispose(imapSrc)
        CkImap::ckDispose(imapDest)
        ProcedureReturn
    EndIf

    fetchUids.i = 1

    ; Get the set of UIDs for all emails on the source server.
    mset.i = CkImap::ckSearch(imapSrc,"ALL",fetchUids)
    If CkImap::ckLastMethodSuccess(imapSrc) <> 1
        Debug CkImap::ckLastErrorText(imapSrc)
        CkImap::ckDispose(imapSrc)
        CkImap::ckDispose(imapDest)
        ProcedureReturn
    EndIf

    ; Load the complete set of UIDs that were previously copied.
    ; We dont' want to copy any of these to the destination.
    fac.i = CkFileAccess::ckCreate()
    If fac.i = 0
        Debug "Failed to create object."
        ProcedureReturn
    EndIf

    msetAlreadyCopied.i = CkMessageSet::ckCreate()
    If msetAlreadyCopied.i = 0
        Debug "Failed to create object."
        ProcedureReturn
    EndIf

    strMsgSet.s = CkFileAccess::ckReadEntireTextFile(fac,"qa_cache/saAlreadyLoaded.txt","utf-8")
    If CkFileAccess::ckLastMethodSuccess(fac) = 1
        CkMessageSet::ckFromCompactString(msetAlreadyCopied,strMsgSet)
    EndIf

    numUids.i = CkMessageSet::ckCount(mset)
    sbFlags.i = CkStringBuilder::ckCreate()
    If sbFlags.i = 0
        Debug "Failed to create object."
        ProcedureReturn
    EndIf

    i.i = 0
    While i < numUids

        ; If this UID was not already copied...
        uid.i = CkMessageSet::ckGetId(mset,i)
        If Not CkMessageSet::ckContainsId(msetAlreadyCopied,uid)

            Debug "copying " + Str(uid) + "..."

            ; Get the flags.
            flags.s = CkImap::ckFetchFlags(imapSrc,uid,1)
            If CkImap::ckLastMethodSuccess(imapSrc) = 0
                Debug CkImap::ckLastErrorText(imapSrc)
                CkImap::ckDispose(imapSrc)
                CkImap::ckDispose(imapDest)
                CkFileAccess::ckDispose(fac)
                CkMessageSet::ckDispose(msetAlreadyCopied)
                CkStringBuilder::ckDispose(sbFlags)
                ProcedureReturn
            EndIf

            CkStringBuilder::ckSetString(sbFlags,flags)

            ; Get the MIME of this email from the source.
            mimeStr.s = CkImap::ckFetchSingleAsMime(imapSrc,uid,1)
            If CkImap::ckLastMethodSuccess(imapSrc) = 0
                Debug CkImap::ckLastErrorText(imapSrc)
                CkImap::ckDispose(imapSrc)
                CkImap::ckDispose(imapDest)
                CkFileAccess::ckDispose(fac)
                CkMessageSet::ckDispose(msetAlreadyCopied)
                CkStringBuilder::ckDispose(sbFlags)
                ProcedureReturn
            EndIf

            seen.i = CkStringBuilder::ckContains(sbFlags,"\Seen",0)
            flagged.i = CkStringBuilder::ckContains(sbFlags,"\Flagged",0)
            answered.i = CkStringBuilder::ckContains(sbFlags,"\Answered",0)
            draft.i = CkStringBuilder::ckContains(sbFlags,"\Draft",0)

            success = CkImap::ckAppendMimeWithFlags(imapDest,"Inbox",mimeStr,seen,flagged,answered,draft)
            If success <> 1
                Debug CkImap::ckLastErrorText(imapDest)
                CkImap::ckDispose(imapSrc)
                CkImap::ckDispose(imapDest)
                CkFileAccess::ckDispose(fac)
                CkMessageSet::ckDispose(msetAlreadyCopied)
                CkStringBuilder::ckDispose(sbFlags)
                ProcedureReturn
            EndIf

            ; Update msetAlreadyCopied with the uid just copied.
            CkMessageSet::ckInsertId(msetAlreadyCopied,uid)

            ; Save at every iteration just in case there's a failure..
            strMsgSet = CkMessageSet::ckToCompactString(msetAlreadyCopied)
            CkFileAccess::ckWriteEntireTextFile(fac,"qa_cache/saAlreadyLoaded.txt",strMsgSet,"utf-8",0)
        EndIf

        i = i + 1
    Wend
    CkMessageSet::ckDispose(mset)

    ; Disconnect from the IMAP servers.
    success = CkImap::ckDisconnect(imapSrc)
    success = CkImap::ckDisconnect(imapDest)


    CkImap::ckDispose(imapSrc)
    CkImap::ckDispose(imapDest)
    CkFileAccess::ckDispose(fac)
    CkMessageSet::ckDispose(msetAlreadyCopied)
    CkStringBuilder::ckDispose(sbFlags)


    ProcedureReturn
EndProcedure