All pastes #769823 Raw Edit

Something

public text v1 · immutable
·published 2007-11-11 18:22 UTC
rendered paste body
package require Tk
package require zlib
set f [tk_chooseDirectory -mustexist true]
cd $f/..
set f [string range $f [expr [string last "/" $f]+1] end]
	set out [open "$f.fpa" w]
	fconfigure $out -blocking false -buffering full -buffersize 512000 -translation binary
	set files2 [list]
	lappend files2 [glob -nocomplain -types f $f/*]
	lappend files2 [glob -nocomplain -types f $f/*/*]
	lappend files2 [glob -nocomplain -types f $f/*/*/*]
	lappend files2 [glob -nocomplain -types f $f/*/*/*/*]
	lappend files2 [glob -nocomplain -types f $f/*/*/*/*/*]
	lappend files2 [glob -nocomplain -types f $f/*/*/*/*/*/*]
	lappend files2 [glob -nocomplain -types f $f/*/*/*/*/*/*/*]
	lappend files2 [glob -nocomplain -types f $f/*/*/*/*/*/*/*/*]
	set files [list]
	foreach f2 $files2 {
		foreach f0 $f2 {
			lappend files $f0
		}
	}
	set files2 $files
	set buff ""
	set count 0
	foreach f2 $files2 {
		if {$f2 ne ""} {
			set in [open $f2 r]
			fconfigure $in -blocking false -buffering none -translation binary
			set tmp [zlib deflate [read $in [file size $f2]]]
			puts -nonewline $out $tmp
			close $in
			append buff "[string range $f2 [expr [string first "/" $f2]+1] end]\x00[binary format I [string length $tmp]]"
			incr count
		}
	}
	set buff [zlib deflate $buff]
	puts -nonewline $out $buff
	puts -nonewline $out [binary format I [expr [string length $buff]+7]]
	puts -nonewline $out [string range [binary format I $count] 1 3]
	close $out