REBOL [
    Title: "JPG analyse"
    Date: 4-Jan-2002/18:22:48+1:00
    Version: 1.0.0
    File: %jpg-analyse.r
    Author: "Oldes"
    Usage: "NEWjpg: jpg-analyse %/e/testjpg.jpg"
    Purpose: {To remove some data from the JPG files to make them smaller.
^-For example files from Adobe contains so many other informations that the file is twice bigger than may be.}
    Email: oliva.david@seznam.cz
    library: [
        level: 'advanced 
        platform: none 
        type: 'tool 
        domain: 'file-handling 
        tested-under: none 
        support: none 
        license: none 
        see-also: none
    ]
]

jpg-analyse: func[
    "Analyses the JPG file and tries to remove some unnecessary infos from file"
    file [file! url! binary!]   "JPG file to analyse"
    /remove tags-to-remove [block!] {If not specified these tags are removed:
            ["Photoshop 3.0" "ICC_PROFILE" "Adobe" "Ducky"] if presents}
    /quiet "Will not print informations"
    /local
        img to-int buf newimg jfif version units Xdensity Ydensity
        Xthumbnail Ythumbnail rgb length lng identifier data APP0
][
    if not remove [
        tags-to-remove: [
            "Photoshop 3.0"
            "ICC_PROFILE"
            "Adobe"
            "Ducky"
        ]
    ]
    img: either binary? file [file][read/binary file]
    newimg: make binary! length? img
    
    to-int: func[i][to-integer to-binary i]
    msg: func[m][if not quiet [print m]]
    JFIF: [
        ["JFIF^@"
            copy version 2 skip (
                version: (to-int version/1) + ((to-int version/2) / 100)
            )
            copy units 1 skip (units: to-int units)
            copy Xdensity 2 skip
            copy Ydensity 2 skip
            copy Xthumbnail 1 skip
            copy Ythumbnail 1 skip
            copy rgb to end
        ] (
            
            print "JFIF HEADER:"
            print ["^-  version:" version]
            print ["^-    units:" pick [
                "no units, X and Y specify the pixel aspect ratio"
                "X and Y are dots per inch"
                "X and Y are dots per cm"
                ] 1 + units
            ]
            print ["^-  density:" to-pair reduce [to-int Xdensity to-int Ydensity]]
            print ["^-thumbnail:" to-pair reduce [
                to-int Xthumbnail
                to-int Ythumbnail]
            ]
        )
    ]
    parse/all img [
        copy buf thru "ÿØ" (insert tail newimg buf)
        some [
            "ÿ"
            copy APP0 1 skip
            copy length 2 skip (lng: (to-int length) - 2)
            copy data lng skip (
                identifier: none
                either APP0 = "à" [
                    if not quiet [parse/all data JFIF]
                ][
                    if not none? data [
                    parse/all data [
                        copy identifier to "^@" 1 skip
                        to end
                    ]
                    ]
                ]
                either any [
                    found? find tags-to-remove identifier
                    APP0 = "þ"  ;info about the creator's program
                ][
                    msg either none? identifier [
                        ["Removed data:" data]
                    ][
                        ["Removed tag" mold identifier "lenght:" lng + 4]
                    ]
                ][
                    insert tail newimg rejoin ["ÿ" APP0 length data]
                ]
            )
        ]
        copy buf to end (insert tail newimg buf)
    ]
    msg ["Original  image:" length? img "B"]
    msg ["Optimised image:" length? newimg "B"]
    newimg
]

replace-jpgs: func[
    "Replaces all JPG files"
    /local path tsz1 tsz2 sz1 sz2 ext img newimg modes
][
    path: to-file ask {Directory? }
    if empty? path [path: %./]
    if (last path) <> #"/" [append path #"/"]
    if not exists? path [print [path "does not exist"] halt]
    tsz1: 0
    tsz2: 0
    foreach file files: read path [
        either dir? path/:file [
            foreach newfile read path/:file [append files file/:newfile]
        ][
            ext: last (parse mold path/:file ".")
            if ext = "jpg" [
                if error? try [
                img: read/binary path/:file
                modes: get-modes path/:file [modification-date owner-write]
                if not last modes [
                    ;change back tail modes true
                    ;set-modes path/:file modes
                    ;uncomment if you want to replace locked files
                ]
                sz1: length? img
                newimg: jpg-analyse/quiet img
                sz2: length? newimg
                tsz1: tsz1 + sz1
                tsz2: tsz2 + sz2
                if sz1 > sz2 [
                    write/binary path/:file newimg
                    set-modes path/:file modes
                    print [path/:file sz1 sz2]
                ]
                ][  print ["ERROR: " path/:file]]
            ]
        ]
    ]
    print ["Before: " tsz1]
    print ["Now:    " tsz2]
    print ["Removed:" tsz1 - tsz2]
]