Script Library: rip.r

Script Library: 1247 scripts
rip.r

REBOL [
    Title: "RIP - Standard File Archiver"
    Date: 23-Jun-2000
    Version: 1.3.1
    File: %rip.r
    Author: "Carl Sassenrath"
    Purpose: {
        A file archiver that works across 37 platforms.
        Compresses all files and subdirectories into a
        single binary, self-extracting archive file.
        (Similar to ZIP programs, but only 3KB.)
    }
    History: [
    1.0.0 22-Feb-2000 "Carl Sassenrath" "Original code." 
    1.1.0 24-Feb-2000 "Cal Dixon" "Added subdirectoy support" 
    1.2.0 20-May-2000 "Carl Sassenrath" "Standard security is better" 
    1.3.0 9-Jun-2000 "Various cleanup." 
    1.3.1 23-Jun-2000 "Merged Cal's code back."
]
    Email: %carl--rebol--com
    Note: "Overwrites files by default!"
    library: [
        level: 'advanced 
        platform: none 
        type: 'tool 
        domain: 'file-handling 
        tested-under: none 
        support: none 
        license: none 
        see-also: none
    ]
]

verbose: on  ; turn off for less info

path: to-file ask {
Enter the relative directory path.
Press RETURN key for current directory,
or type a path in the form: dir/dir/dir

Directory? }

if empty? path [path: %./]
if (last path) <> #"/" [append path #"/"]
if not exists? path [print [path "does not exist"] halt]

file-list: []
archive: make binary! 32000

if verbose [print "Archiving:"]
foreach file files: read path [
    either dir? path/:file [
        append file-list reduce [file 'DIR ]
        foreach newfile read path/:file [append files file/:newfile]
    ][
        if verbose [prin [tab file " "]]
        data: read/binary path/:file
        if verbose [prin [length? data " -> "]]
        data: compress data
        if verbose [print [length? data]]
        append archive data
        append file-list reduce [file length? data]
    ]
]

if verbose [
    print [newline "Total size:" length? archive "Checksum:" checksum archive newline]
]

filename: to-file ask "Output archive file name? "
if empty? filename [filename: %archive.rip]
if not find filename "." [append filename ".rip"]
if all [exists? filename not confirm reform ["Overwrite file" filename "? "]] [
    print "stopped" halt
]
set [ignore file] split-path filename
file: to-file file  ; for 2.2 compat

header: mold compose/deep [
    REBOL [
        Title: "REBOL Self-extracting Binary Archive (RIP)"
        Date: (now)
        File: (file)
        Note: (reform [{To extract, type REBOL} file {or run REBOL and type: do} file])
    ]
    file: (file)
    size: (length? archive)
    path: (path)
    verbose: not all [system/script/args system/script/args = 'quiet]
    files: (reduce [file-list])
    check: (checksum archive)
    if not exists? path [make-dir path]
    archive: read/binary file
    archive: next find/case/tail archive to-binary join "!DATA" ":"
    if check <> checksum archive [print ["Checksum failed" check checksum archive] halt]
    foreach [file len] files [
        if verbose [print [tab file]]
        either len = 'DIR [
           if not exists? path/:file [make-dir path/:file]
        ][
           data: decompress copy/part archive len
           archive: skip archive len
           either any [
               not exists? path/:file
               confirm reform [file "already exists - overwrite? "]
           ][write/binary path/:file data][print "skipped"]
       ]
    ]
    none
]

insert archive reduce [header newline "!DATA:" newline]
write/binary filename archive
Notes
email address(es) have been munged to protect them from spam harvesters. If you are a Library member, you can log on and view this script without the munging.
(carl:rebol:com)