Rebol Programming/build-attach-body

From Wikibooks, open books for an open world
Jump to navigation Jump to search

USAGE:[edit | edit source]

BUILD-ATTACH-BODY body files boundary 

DESCRIPTION:[edit | edit source]

Return an email body with attached files.

BUILD-ATTACH-BODY is a function value.

ARGUMENTS[edit | edit source]

  • body -- The message body (Type: string)
  • files -- List of files to send [%file1.r [%file2.r "data"]] (Type: block)
  • boundary -- The boundary divider (Type: string)

SOURCE CODE[edit | edit source]

build-attach-body: func [
    "Return an email body with attached files." 
    body [string!] "The message body" 
    files [block!] {List of files to send [%file1.r [%file2.r "data"]]} 
    boundary [string!] "The boundary divider" /local 
    make-mime-header: func [file] [
        net-utils/export context [
            Content-Type: join {application/octet-stream; name="} [file {"}] 
            Content-Transfer-Encoding: "base64" 
            Content-Disposition: join {attachment; filename="} [file {"
    break-lines: func [mesg data /at num] [
        num: any [num 72] 
        while [not tail? data] [
            append mesg join copy/part data num #"^/" 
            data: skip data num
    if not empty? files [
        insert body reduce [boundary "^/Content-type: text/plain^/^/"] 
        append body "^/^/" 
        if not parse files [
            some [
                (file: none) 
                    set file file! (val: read/binary file) 
                    | into [
                        set file file! 
                        set val skip 
                        to end
                ] (
                    if file [
                        repend body [
                            boundary "^/" 
                            make-mime-header any [find/last/tail file #"/" file]
                        val: either any-string? val [val] [mold :val] 
                        break-lines body enbase val
        ] [net-error "Cannot parse file list."] 
        append body join boundary "--^/"