REBOL [
    Title: "Save email attachments to disk"
    Date: 9-Jun-1999
    File: %detach.r
    Author: "Sterling Newton"
    Usage: "Detach message"
    Purpose: "Detach mail attachments"
    library: [
        level: 'advanced 
        platform: none 
        type: 'tool 
        domain: [email file-handling] 
        tested-under: none 
        support: none 
        license: none 
        see-also: none
    ]
]

find-filename: func [headers [object!] /local file] [
    if error? try [file: to-file headers/content-description] [
        if error? try [
            file: to-file any [
                find/tail headers/content-type {name="}
                find/tail headers/content-disposition {name="}
            ]
            head remove back tail file
        ] [none]
    ]
    file
]

detach: func [
    {takes in the whole email text and returns a block of filenames 
and decoded base64 attachments present in the email}
    email [string!] 
    /local boundary body attached headers file
][
   print "starting decoding process..."
   headers: import-email email
   boundary: headers/content-type
   if boundary: find/tail boundary {boundary="} [
        remove back tail boundary
        print ["Boundary string:" boundary]
   ]
   either boundary [
        attached: make block! 2
        body: headers/content
        while [body: find/tail body boundary] [
            print ["Found message attachment; remaining length:" length? body]
            headers: parse-header system/standard/email skip body 1
            ; end of the message attachments?
            if find/match body "--" [print "attachents finished" break]
            file: copy/part headers/content find body: headers/content "^/--"
            either all [
                not error? try [headers/content-transfer-encoding] 
                find headers/content-transfer-encoding "base64"
            ] [ 
                print "about to decode..."
                insert file "64#{" append file "}"
                print ["Adding attachment; encoded length:" length? file]
                seek: file
                while [seek: find seek "^/"] [remove seek]
                append attached reduce [find-filename headers to-string load file]
            ] [ ; not base64 encoded... just add it directly
                append attached reduce [find-filename headers file]
            ]
        ]
        attached
    ] [none]
]