Script Library: 1238 scripts
 

rebzip.r

REBOL [ Title: "rebzip" Date: 17-Jul-2009 Version: 1.0.1 File: %rebzip.r Author: "Vincent Ecuyer" Purpose: "Zip archiver / unarchiver" Usage: { Two functions: 'zip and 'unzip [archiving: zip] you can zip a single file: zip %new-zip.zip %my-file a block of files: zip %new-zip.zip [%file-1.txt %file-2.exe] a block of data (binary!/string!) and files: zip %new-zip.zip [%my-file "my data"] a entire directory: zip/deep %new-zip.zip %my-directory/ from an url: zip %new-zip.zip ftp://192.168.1.10/my-file.txt any combinaison of these: zip/deep %new-zip.zip [ %readme.txt "An example" ftp://192.168.1.10/my-file.txt %my-directory ] [unarchiving: unzip] ! only works from REBOL/View, ! only understands methods 'store and 'deflate you can uncompress to a directory (created if inexistant): unzip %my-new-dir %my-zip-file.zip or a block: unzip my-block %my-zip-file.zip my-block == [%file-1.txt #{...} %file-2.exe #{...}] } Comment: { 'compress uses a zlib compatible format - always with deflate algorithm, 32k window size, max compression and no dictionary - followed by adler-32 checksum (4 bytes) and uncompressed data length (4 bytes). 'deflate method is used in gzip, PiNG, and in most .zip files. For decompression, as the adler-32 checksum is unknown, a PiNG file is build with the data to decompress, letting 'load to do the work. } History: [ 1.0.0 [13-Jan-2005 "First version"] 1.0.1 [17-Jul-2009 "Bugfix: empty files compressed with 'deflate now properly handled"] ] Library: [ level: 'advanced platform: 'all type: [module tool] domain: [compression file-handling files] tested-under: [ view 1.2.1.3.1 on [Win2K] view 1.2.1.1.1 on [AmigaOS30] view 1.2.57.3.1 on [Win2K] view 2.7.6.4.2 on [Linux] ] support: none license: 'public-domain see-also: %zip-fix.r ] ] ctx-zip: context [ crc-long: [ 0 1996959894 -301047508 -1727442502 124634137 1886057615 -379345611 -1637575261 249268274 2044508324 -522852066 -1747789432 162941995 2125561021 -407360249 -1866523247 498536548 1789927666 -205950648 -2067906082 450548861 1843258603 -187386543 -2083289657 325883990 1684777152 -43845254 -1973040660 335633487 1661365465 -99664541 -1928851979 997073096 1281953886 -715111964 -1570279054 1006888145 1258607687 -770865667 -1526024853 901097722 1119000684 -608450090 -1396901568 853044451 1172266101 -589951537 -1412350631 651767980 1373503546 -925412992 -1076862698 565507253 1454621731 -809855591 -1195530993 671266974 1594198024 -972236366 -1324619484 795835527 1483230225 -1050600021 -1234817731 1994146192 31158534 -1731059524 -271249366 1907459465 112637215 -1614814043 -390540237 2013776290 251722036 -1777751922 -519137256 2137656763 141376813 -1855689577 -429695999 1802195444 476864866 -2056965928 -228458418 1812370925 453092731 -2113342271 -183516073 1706088902 314042704 -1950435094 -54949764 1658658271 366619977 -1932296973 -69972891 1303535960 984961486 -1547960204 -725929758 1256170817 1037604311 -1529756563 -740887301 1131014506 879679996 -1385723834 -631195440 1141124467 855842277 -1442165665 -586318647 1342533948 654459306 -1106571248 -921952122 1466479909 544179635 -1184443383 -832445281 1591671054 702138776 -1328506846 -942167884 1504918807 783551873 -1212326853 -1061524307 -306674912 -1698712650 62317068 1957810842 -355121351 -1647151185 81470997 1943803523 -480048366 -1805370492 225274430 2053790376 -468791541 -1828061283 167816743 2097651377 -267414716 -2029476910 503444072 1762050814 -144550051 -2140837941 426522225 1852507879 -19653770 -1982649376 282753626 1742555852 -105259153 -1900089351 397917763 1622183637 -690576408 -1580100738 953729732 1340076626 -776247311 -1497606297 1068828381 1219638859 -670225446 -1358292148 906185462 1090812512 -547295293 -1469587627 829329135 1181335161 -882789492 -1134132454 628085408 1382605366 -871598187 -1156888829 570562233 1426400815 -977650754 -1296233688 733239954 1555261956 -1026031705 -1244606671 752459403 1541320221 -1687895376 -328994266 1969922972 40735498 -1677130071 -351390145 1913087877 83908371 -1782625662 -491226604 2075208622 213261112 -1831694693 -438977011 2094854071 198958881 -2032938284 -237706686 1759359992 534414190 -2118248755 -155638181 1873836001 414664567 -2012718362 -15766928 1711684554 285281116 -1889165569 -127750551 1634467795 376229701 -1609899400 -686959890 1308918612 956543938 -1486412191 -799009033 1231636301 1047427035 -1362007478 -640263460 1088359270 936918000 -1447252397 -558129467 1202900863 817233897 -1111625188 -893730166 1404277552 615818150 -1160759803 -841546093 1423857449 601450431 -1285129682 -1000256840 1567103746 711928724 -1274298825 -1022587231 1510334235 755167117 ] right-shift-8: func [ "Right-shifts the value by 8 bits and returns it." value [integer!] "The value to shift" ][ either negative? value [ -1 xor value and -256 / 256 xor -1 and 16777215 ][ -256 and value / 256 ] ] update-crc: func [ "Returns the data crc." data [any-string!] "Data to checksum" crc [integer!] "Initial value" ][ foreach char data [ crc: (right-shift-8 crc) xor pick crc-long crc and 255 xor char + 1 ] ] crc-32: func [ "Returns a CRC32 checksum." data [any-string!] "Data to checksum" ][ either empty? data [#{00000000}][ load join "#{" [to-hex -1 xor update-crc data -1 "}"] ] ] ;signatures local-file-sig: to-string #{504B0304} central-file-sig: to-string #{504B0102} end-of-central-sig: to-string #{504B0506} data-descriptor-sig: to-string #{504B0708} ;conversion funcs to-ilong: func [ "Converts an integer to a little-endian long." value [integer!] "Value to convert" ][ to-binary rejoin [ to-char value and 255 to-char to-integer (value and 65280) / 256 to-char to-integer (value and 16711680) / 65536 to-char to-integer (value / 16777216) ] ] to-ishort: func [ "Converts an integer to a little-endian short." value [integer!] "Value to convert" ][ to-binary rejoin [ to-char value and 255 to-char to-integer value / 256 ] ] to-long: func [ "Converts an integer to a big-endian long." value [integer!] "Value to convert" ][do join "#{" [to-hex value "}"]] get-ishort: func [ "Converts a little-endian short to an integer." value [any-string! port!] "Value to convert" ][to-integer head reverse to-binary copy/part value 2] get-ilong: func [ "Converts a little-endian long to an integer." value [any-string! port!] "Value to convert" ][to-integer head reverse to-binary copy/part value 4] to-msdos-time: func [ "Converts to a msdos time." value [time!] "Value to convert" ][ to-ishort (value/hour * 2048) or (value/minute * 32) or (to-integer value/second / 2) ] to-msdos-date: func [ "Converts to a msdos date." value [date!] "Value to convert" ][ to-ishort 512 * (max 0 value/year - 1980) or (value/month * 32) or value/day ] get-msdos-time: func [ "Converts from a msdos time." value [any-string! port!] "Value to convert" ][ value: get-ishort value to-time reduce [ 63488 and value / 2048 2016 and value / 32 31 and value * 2 ] ] get-msdos-date: func [ "Converts from a msdos date." value [any-string! port!] "Value to convert" ][ value: get-ishort value to-date reduce [ 65024 and value / 512 + 1980 480 and value / 32 31 and value ] ] zip-entry: func [ {Compresses a file and returns [ local file header + compressed file central file directory entry ]} name [file!] "Name of file" date [date!] "Modification date of file" data [any-string!] "Data to compress" /local crc method compressed-data uncompressed-size compressed-size ][ ; info on data before compression crc: head reverse crc-32 data uncompressed-size: to-ilong length? data either empty? data [ method: 'store ][ ; zlib stream compressed-data: compress data ; if compression inefficient, store the data instead either (length? data) > (length? compressed-data) [ data: copy/part skip compressed-data 2 skip tail compressed-data -8 method: 'deflate ][ method: 'store clear compressed-data ] ] ; info on data after compression compressed-size: to-ilong length? data reduce [ ; local file entry join #{} [ local-file-sig #{0000} ; version #{0000} ; flags either method = 'store [ #{0000} ; method = store ][ #{0800} ; method = deflate ] to-msdos-time date/time to-msdos-date date/date crc ; crc-32 compressed-size uncompressed-size to-ishort length? name ; filename length #{0000} ; extrafield length name ; filename ; no extrafield data ; compressed data ] ; central-dir file entry join #{} [ central-file-sig #{0000} ; version source #{0000} ; version min #{0000} ; flags either method = 'store [ #{0000} ; method = store ][ #{0800} ; method = deflate ] to-msdos-time date/time to-msdos-date date/date crc ; crc-32 compressed-size uncompressed-size to-ishort length? name ; filename length #{0000} ; extrafield length #{0000} ; filecomment length #{0000} ; disknumber start #{0000} ; internal attributes #{00000000} ; external attributes #{00000000} ; header offset name ; filename ; extrafield ; comment ] ] ] any-file?: func [ "Returns TRUE for file and url values." value [any-type!] ][any [file? value url? value]] to-path-file: func [ {Converts url! to file! and removes heading "/"} value [file! url!] "Value to convert" ][ if file? value [ if #"/" = first value [value: copy next value] return value ] value: decode-url value join %"" [ value/host "/" any [value/path ""] any [value/target ""] ] ] set 'zip func [ {Builds a zip archive from a file or a block of files. Returns number of entries in archive.} where [file! url! binary! string!] "Where to build it" source [file! url! block!] "Files to include in archive" /deep "Includes files in subdirectories" /verbose "Lists files while compressing" /local name data entry nb-entries files no-modes central-directory files-size out date ][ out: func [value] either any-file? where [ [insert where value] ][ [where: insert where value] ] if any-file? where [where: open/direct/binary/write where] files-size: nb-entries: 0 central-directory: copy #{} source: compose [(source)] while [not tail? source][ name: source/1 no-modes: any [url? name dir? name] files: any [ all [dir? name name: dirize name read name][] ] ; is name a not empty directory? either all [deep not empty? files] [ ; append content to file list foreach file read name [ insert tail source name/:file ] ][ nb-entries: nb-entries + 1 date: now ; is next one data or filename? data: either any [tail? next source any-file? source/2][ either #"/" = last name [copy #{}][ if not no-modes [ date: get-modes name 'modification-date ] read/binary name ] ][ first source: next source ] name: to-path-file name if verbose [print name] ; get compressed file + directory entry entry: zip-entry name date data ; write file offset in archive change skip entry/2 42 to-ilong files-size ; directory entry insert tail central-directory entry/2 ; compressed file + header out entry/1 files-size: files-size + length? entry/1 ] ; next arg source: next source ] out join #{} [ central-directory end-of-central-sig #{0000} ; disk num #{0000} ; disk central dir to-ishort nb-entries ; nb entries disk to-ishort nb-entries ; nb entries to-ilong length? central-directory to-ilong files-size #{0000} ; zip file comment length ; zip file comment ] if port? where [close where] nb-entries ] set 'unzip func [ {Decompresses a zip archive to a directory or a block. Only works with compression methods 'store and 'deflate.} where [file! url! any-block!] "Where to decompress it" source [file! url! any-string!] "Archive to decompress" /verbose "Lists files while decompressing (default)" /quiet "Don't lists files while decompressing" /local flags method compressed-size uncompressed-size name-length name extrafield-length data time date uncompressed-data nb-entries path file info errors ][ errors: 0 info: func [value] either all [quiet not verbose][ [none] ][ [prin join "" value] ] if any-file? where [where: dirize where] if all [any-file? where not exists? where][ make-dir/deep where ] if any-file? source [source: read/binary source] nb-entries: 0 parse/all source [ to local-file-sig some [ thru local-file-sig (nb-entries: nb-entries + 1) 2 skip ; version copy flags 2 skip (if not zero? flags/1 and 1 [return false]) copy method 2 skip (method: get-ishort method) copy time 2 skip (time: get-msdos-time time) copy date 2 skip ( date: get-msdos-date date date/time: time date: date - now/zone ) 4 skip ; crc-32 copy compressed-size 4 skip (compressed-size: get-ilong compressed-size) copy uncompressed-size 4 skip (uncompressed-size: get-ilong uncompressed-size) copy name-length 2 skip (name-length: get-ishort name-length) copy extrafield-length 2 skip (extrafield-length: get-ishort extrafield-length) copy name name-length skip ( name: to-file name info name ) extrafield-length skip data: compressed-size skip ( switch/default method [ 0 [ uncompressed-data: copy/part data compressed-size info "^- -> ok [store]^/" ] 8 [ data: either zero? uncompressed-size [ copy #{} ][ to-binary rejoin [ #{89504E47} #{0D0A1A0A} ; signature #{0000000D} ; IHDR length "IHDR" ; type: header ; width = uncompressed size to-long uncompressed-size #{00000001} ; height = 1 line #{08} ; bit depth #{00} ; color type = grayscale #{00} ; compression method #{00} ; filter method = none #{00} ; no interlace #{00000000} ; no checksum ; length to-long 2 + 6 + compressed-size "IDAT" ; type: data #{789C} ; zlib header ; 0 = no filter for scanline #{00 0100 FEFF 00} copy/part data compressed-size #{00000000} ; no checksum #{00000000} ; length "IEND" ; type: end #{00000000} ; no checksum ] ] either error? try [data: load data][ info "^- -> failed [deflate]^/" errors: errors + 1 uncompressed-data: none ][ uncompressed-data: make binary! uncompressed-size repeat i uncompressed-size [ insert tail uncompressed-data to-char pick pick data i 1 ] info "^- -> ok [deflate]^/" ] ] ][ info ["^- -> failed [method " method "]^/"] errors: errors + 1 uncompressed-data: none ] either any-block? where [ where: insert where name where: insert where either all [ #"/" = last name empty? uncompressed-data ][none][uncompressed-data] ][ ; make directory and / or write file either #"/" = last name [ if not exists? where/:name [ make-dir/deep where/:name ] ][ set [path file] split-path name if not exists? where/:path [ make-dir/deep where/:path ] if uncompressed-data [ write/binary where/:name uncompressed-data set-modes where/:name [ modification-date: date ] ] ] ] ) ] to end ] info ["^/" "Files/Dirs unarchived: " nb-entries "^/" "Decompression errors: " errors "^/" ] zero? errors ] ]
halt ;; to terminate script if DO'ne from webpage