[Philip Quaife] ''30 Oct 05'', I have toyed with a tcl only installer some time ago, here is the code for inflating compressed files from a zip archive.

I lifted the code from [AMSN], not sure of the copyright. Check with developer before distributing.

I changed the code to take a string and return decompressed string. I also have bracketed the [expr] and it runs in acceptable time. Enough speed that you could use it to uncompress the zlib dll from a SXE file and then use the dll to uncompress the rest of the archive.

[NEM] AMSN is distributed under the [GPL].  See also [zlib].

----

 #
 # Lifted from AMSN (http://amsn.sf.net}
 #
 #
    
    proc zip/inflate { stream } {

	#status_log "reading from file $stream\n"
	set time [clock clicks]

	zip/reset 

 #--- Some sort of header starts the block not zlib block header

	set def ""
	binary scan [zip/read $stream 20] b* zlib

 if {0} {

	puts "read header"
	set CMF [string range $zlib 0 7]
	set FLG [string range $zlib 8 15]
	insLog DEBUG "CMF = $CMF\nFLG = $FLG\n" read

	if { [binary format b* $CMF] != "\x78" || [string range $FLG 5 5] != 0 } {
	    insLog ERROR "Compression of the zlib data is in an unknown format\n" error
	    return -1
	}

	binary scan [binary format b* [string range $zlib 0 15]] S FCHECK
	#status_log "FCHECK is such that CMF_FLG = $FCHECK\n" red
	if { [expr {$FCHECK % 31} ] != 0 } {
	    #status_log "FCHECK is not a multiple of 31, corrupted data\n"
	    return -1
	}

 #--- End of header
 } 

	set bfinal  "0"
#	set idx 16
	set idx 0
	set len 160

	while { $bfinal != "1" } {

	    
	    set bfinal [string range $zlib $idx $idx]
	    incr idx
	    binary scan [binary format b* [string range $zlib $idx [expr {$idx + 1}]]] c btype
	    set idx [expr $idx + 2]

	    #status_log "Reading compressed block, with compression type $btype and final bloc = $bfinal\n"
	    if { $btype == 0 } {

		if { [expr $idx % 8] != 0 } {
		    set idx [expr {$idx + 8 - ( $idx % 8)}]
		}

		binary scan [string range $zlib $idx [expr {$idx + 31}]] SS len nlen 
		set idx [expr {$idx + 32}]
		if { [string map { "0" "1" } $bnlen] != $blen } {
		    #status_log "Len and NLen does not match : [string range $zlib [expr {$idx -32}] [expr {$idx - 17}]] --- [string range $zlib [expr {$idx -16}] [expr {$idx - 1}]]\nValues are $len and $nlen\n" red
		    return -1
		} else {
		    binary scan [string range $zlib $idx [expr {$idx + 1}]] S len 
		}
		
		#status_log "Reading uncompressed block with length $len from index $idx to [expr $idx + 3 + $len]\n"
		set def "${def}[string range $zlib [expr {$idx + 4}] [expr {$idx + 3 + $len}]]"
		set idx [expr {$idx + 3 + $len}]
		
	    } elseif { $btype == 3 } {
		#status_log "Got reserved word 11 for compression type : error\n" error
		return -1
	    } else {
		if { $btype == 2 } {
		    #status_log "Got Huffman's dynamic compression block, processing\n"
		    
		    #set time [clock clicks]

		    binary scan [binary format b* [string range $zlib $idx [expr {$idx + 4}]]] c hlit
		    set idx [expr {$idx + 5}]
		    set hlit [expr {$hlit + 257}]
		    binary scan [binary format b* [string range $zlib $idx [expr {$idx + 4}]]] c hdist
		    set idx [expr {$idx + 5}]
		    incr hdist
		    binary scan [binary format b* [string range $zlib $idx [expr {$idx + 3}]]] c hclen
		    set idx [expr {$idx + 4}]
		    set hclen [expr {$hclen + 4}]

		    #status_log "Got hlit = $hlit \nhdist = $hdist\nhclen = $hclen\n"


		    set codelengths [list 16 17 18 0 8 7 9 6 10 5 11 4 12 3 13 2 14 1 15]
		    for { set i 0 } { $i < [expr {$hclen * 3}] } { set i [expr {$i + 3}]} {
			if { $idx > $len - 3 } {
			    binary scan [zip/read $stream 30] b* tmp
			    set zlib "[string range $zlib $idx end]$tmp"
			    set idx 0
			    set len [string length $zlib]
			}
			binary scan [binary format b* [string range $zlib $idx [expr {$idx + 2}]]] c clen([lindex $codelengths [expr {$i / 3}]])
			set idx [expr {$idx + 3}]
		    }
		    #status_log "Read the codelengths, idx = $idx -- len = $len --- zlib = $zlib\ncodelengths = \n[array get clen]\n"

		    array set huffcodes [zip/createcodes [array get clen] 7 18]



		    #status_log "huffcodes = [array get huffcodes]\n"
		    #status_log "binary : [string range $zlib $idx  [expr $idx + 100]]\n\n"
		    set inc 0
		    set index 0
		    while { $index < $hlit } {
			if { $idx >  $len - 7 } {
			    binary scan [zip/read $stream 30] b* tmp
			    set zlib "[string range $zlib $idx end]$tmp"
			    set idx 0
			    set len [string length $zlib]
			}
			set bin [string range $zlib $idx [expr {$idx + $inc}]]
			if { [info exists huffcodes($bin)] } {
			    #			#status_log "Found a length, for litteral value $index = $huffcodes($bin)\n"
			    set idx [expr {$idx + $inc + 1}]
			    if { $huffcodes($bin) < 16 } {
				set litclen($index) $huffcodes($bin)
				incr index
			    } elseif { $huffcodes($bin) == 16 } {
				set tocopy $litclen([expr {$index - 1}])
				binary scan [binary format b* [string range $zlib $idx [expr {$idx + 1}]]] c length
				set length [expr {$length + 3}]
				incr idx
				incr idx

				#			    #status_log "Copying value $tocopy into the next $length codes starting from $index\n"

				for { set t 0 } { $t < $length } { incr t } {
				    #				#status_log "Literal length $index, copied value : $tocopy\n"
				    set litclen($index) $tocopy
				    incr index
				}

			    } elseif { $huffcodes($bin) == 17 } {
				binary scan [binary format b* [string range $zlib $idx [expr {$idx + 2}]]] c length
				set length [expr {$length + 3}]
				set idx [expr {$idx + 3}]
				#			    #status_log "Copying value 0 into the next $length codes starting from $index\n"
				for { set t 0 } { $t < $length } { incr t } {
				    #				#status_log "Literal length $index, copied value : 0\n"
				    set litclen($index) 0
				    incr index
				}
			    } else {
				binary scan [binary format b* [string range $zlib $idx [expr {$idx + 6}]]] c length
				set length [expr {$length + 11}]
				set idx [expr {$idx + 7}]
				#			    #status_log "Copying value 0 into the next $length codes starting from $index\n"
				for { set t 0 } { $t < $length } { incr t } {
				    #				#status_log "Literal length $index, copied value : 0\n"
				    set litclen($index) 0
				    incr index
				}
				
			    }
			    set inc 0
			} else {
			    incr inc
			    if { $inc > 7 } {
				#status_log "Erreur.. l'increment a depasse 7.. \ndump :\nindex = $idx - increment = $inc, index = $index, $hlit\nmemoire = [string range $zlib [expr $idx ] [expr $idx + $inc ]]\n"
	
				return -1
			    }

			}




		    }

		    array set litval [zip/createcodes [array get litclen] 18 $hlit]
		   

		    set inc 0
		    set index 0
		    while { $index < $hdist } {
			if { $idx > $len - 7 } {
			    binary scan [zip/read $stream 30] b* tmp
			    set zlib "[string range $zlib $idx end]$tmp"
			    set idx 0
			    set len [string length $zlib]
			}
			set bin [string range $zlib $idx [expr {$idx + $inc}]]
			if { [info exists huffcodes($bin)] } {
			    #			#status_log "Found a length, for distance value $index = $huffcodes($bin)\n"
			    set idx [expr {$idx + $inc + 1}]
			    if { $huffcodes($bin) < 16 } {
				set distclen($index) $huffcodes($bin)
				incr index
			    } elseif { $huffcodes($bin) == 16 } {
				set tocopy $distclen([expr {$index - 1}])
				binary scan [binary format b* [string range $zlib $idx [expr {$idx + 1}]]] c length
				set length [expr {$length + 3}]
				incr idx 2

				#			    #status_log "Copying value $tocopy into the next $length codes starting from $index\n"

				for { set t 0 } { $t < $length } { incr t } {
				    #				#status_log "distance length $index, copied value : $tocopy\n"
				    set distclen($index) $tocopy
				    incr index
				}

			    } elseif { $huffcodes($bin) == 17 } {
				binary scan [binary format b* [string range $zlib $idx [expr {$idx + 2}]]] c length
				set length [expr {$length + 3}]
				set idx [expr {$idx + 3}]
				#			    #status_log "Copying value 0 into the next $length codes starting from $index\n"
				for { set t 0 } { $t < $length } { incr t } {
				    #				#status_log "distance length $index, copied value : 0\n"
				    set distclen($index) 0
				    incr index
				}
			    } else {
				binary scan [binary format b* [string range $zlib $idx [expr {$idx + 6}]]] c length
				set length [expr {$length + 11}]
				set idx [expr {$idx + 7}]
				#			    #status_log "Copying value 0 into the next $length codes starting from $index\n"
				for { set t 0 } { $t < $length } { incr t } {
				    #				#status_log "distance length $index, copied value : 0\n"
				    set distclen($index) 0
				    incr index
				}
				
			    }
			    set inc 0
			} else {
			    incr inc
			    if { $inc > 7 } {
				#status_log "Erreur.. l'increment a depasse 7.. \ndump :\nindex = $idx - increment = $inc, index = $index, $hlit\nmemoire = [string range $zlib [expr $idx ] [expr $idx + $inc ]]\n"
	
				return -1
			    }

			}
		    }

		    array set distval [zip/createcodes [array get distclen] 18 $hdist]
	


		} else {
		    #status_log "Got Huffman's compressed block, processing\n"
		    array set litval [zip/createcodes [zip/fill_length lit] 18 287]
		    array set distval [zip/createcodes [zip/fill_length dist] 18 32]
		

		}
		

#		status_log "Time for processing header: [expr [clock clicks] - $time]\n"

		############################################################################################################

		set inc 0
		set index [string length $def]
		#set time [clock clicks]
		for { } { 1 } { } {
		    if { $idx > $len - 15 } {
			binary scan [zip/read $stream 30] b* tmp
			set zlib "[string range $zlib $idx end]$tmp"
			set idx 0
			set len [string length $zlib]
		    }
		    set bin [string range $zlib $idx [expr {$idx + $inc}]]
		    #status_log "time for string range : [time "string range $zlib $idx [expr {$idx + $inc}]"]\n"
		    #status_log "Time for infoexits : [time "info exists litval($bin)"] --- bin = $bin\n"
		    if { [info exists litval($bin)] } {
			set out $litval($bin)
					    #status_log "Found a length in index $index, for output = $out\n"
			set idx [expr {$idx + $inc + 1}]
			if { $out < 256 } {
			    set def "${def}[binary format c $out]"
			    incr index
			   #status_log "Time for literal value : [expr [clock clicks] - $time]\n"
			} elseif { $out == 256 } {
			    #status_log "FOUND END OF BLOCK\n" red
			    break
			} else {
			    #status_log "Need to move backward distance $out -- processing\n"
			    #set time [clock clicks]

			    if { $idx > $len - 5 } {
				binary scan [zip/read $stream 30] b* tmp
				set zlib "[string range $zlib $idx end]$tmp"
				set idx 0
				set len [string length $zlib]
			    }

			    if { $out < 265 } {
				set plus 0
				set length [expr {$out - 254}]
			    } elseif { $out == 285 } {
				set plus 0
				set length 258
			    } elseif { $out > 264 && $out < 269 } {
				binary scan [binary format b* [string range $zlib $idx  $idx]] c plus
				incr idx
				set length [expr {(($out - 265) * 2) + $plus + 11}]
			    } elseif { $out > 268 && $out < 273} {
				binary scan [binary format b* [string range $zlib $idx  [expr {$idx + 1}]]] c plus
				incr idx 2
				set length [expr {(($out - 269) * 4) + $plus + 19}]
			    } elseif { $out > 272 && $out < 277 } {
				binary scan [binary format b* [string range $zlib $idx  [expr {$idx + 2}]]] c plus
				set idx [expr {$idx + 3}]
				set length [expr {(($out - 273) * 8) + $plus + 35}]
			    } elseif { $out > 276 && $out < 281 } {
				binary scan [binary format b* [string range $zlib $idx  [expr {$idx + 3}]]] c plus
				set idx [expr {$idx + 4}]
				set length [expr {(($out - 277) * 16) + $plus + 67}]
			    } else {
				binary scan [binary format b* [string range $zlib $idx  [expr {$idx + 4}]]] c plus
				set idx [expr {$idx + 5}]
				set length [expr {(($out - 281) * 32) + $plus + 131}]
			    }

			    #status_log "time for ifelses : [expr [clock clicks] - $time]"
			    #status_log "Found length $length with added $plus\n"

			    set out2 -1 
			    set inc2 0
			    while { $out2 == -1 } {
				if { $idx > $len - 15 } {
				    binary scan [zip/read $stream 30] b* tmp
				    set zlib "[string range $zlib $idx end]$tmp"
				    set idx 0
				    set len [string length $zlib]
				}
				set bin [string range $zlib $idx [expr {$idx + $inc2}]]
				if { [info exists distval($bin)] } {
				    set out2 $distval($bin)
				    #status_log "Found a distance code  $out2\n"
				    set idx [expr {$idx + $inc2 + 1}]
				} else {
				    incr inc2
				    if { $inc2 > 15 } {
					#status_log "Erreur.. l'increment a depasse 15.. \ndump :\nindex = $idx - increment = $inc2, index = $index, $hlit\nmemoire = [string range $zlib [expr $idx ] [expr $idx + $inc2 ]]\n"
					return -1
				    }
				}
			    }

			    if { $idx > $len - 13 } {
				binary scan [zip/read $stream 30] b* tmp
				set zlib "[string range $zlib $idx end]$tmp"
				set idx 0
				set len [string length $zlib]
			    }

			    if { $out2 < 4 } {
				set plus 0
				set distance [expr {$out2 + 1}]
			    } elseif { $out2 == 4 || $out2 == 5} {
				binary scan [binary format b* [string range $zlib $idx  $idx]] c plus
				set plus [expr $plus % 256]
				incr idx
				set distance [expr {(($out2 - 4) * 2) + $plus + 5}]
			    } elseif { $out2 == 6 || $out2 == 7} {
				binary scan [binary format b* [string range $zlib $idx  [expr {$idx + 1}]]] c plus
				set plus [expr {$plus % 256}]
				incr idx 2
				set distance [expr {(($out2 - 6) * 4) + $plus + 9}]
			    } elseif { $out2 == 8 || $out2 == 9 } {
				binary scan [binary format b* [string range $zlib $idx  [expr {$idx + 2}]]] c plus
				set plus [expr {$plus % 256}]
				set idx [expr {$idx + 3}]
				set distance [expr {(($out2 - 8) * 8) + $plus + 17}]
			    } elseif { $out2 == 10 || $out2 == 11} {
				binary scan [binary format b* [string range $zlib $idx  [expr {$idx + 3}]]] c plus
				set plus [expr {$plus % 256}]
				set idx [expr {$idx + 4}]
				set distance [expr {(($out2 - 10) * 16) + $plus + 33}]
			    } elseif {$out2 == 12 || $out2 == 13 } {
				binary scan [binary format b* [string range $zlib $idx  [expr {$idx + 4}]]] c plus
				set plus [expr {$plus % 256}]
				set idx [expr {$idx + 5}]
				set distance [expr {(($out2 - 12) * 32) + $plus + 65}]
			    } elseif {$out2 == 14 || $out2 == 15 } {
				binary scan [binary format b* [string range $zlib $idx  [expr {$idx + 5}]]] c plus
				set plus [expr {$plus % 256}]
				set idx [expr {$idx + 6}]
				set distance [expr {(($out2 - 14) * 64) + $plus + 129}]
			    } elseif {$out2 == 16 || $out2 == 17 } {
				binary scan [binary format b* [string range $zlib $idx  [expr {$idx + 6}]]] c plus
				set plus [expr {$plus % 256}]
				set idx [expr {$idx + 7}]
				set distance [expr {(($out2 - 16) * 128) + $plus + 257}]
			    } elseif {$out2 == 18 || $out2 == 19 } {
				binary scan [binary format b* [string range $zlib $idx  [expr {$idx + 7}]]] c plus
				set plus [expr {$plus % 256}]
				set idx [expr {$idx + 8}]
				set distance [expr {(($out2 - 18) * 256) + $plus + 513}]
			    } elseif {$out2 == 20 || $out2 == 21 } {
				binary scan [binary format b* [string range $zlib $idx  [expr {$idx + 8}]]] s plus
				set plus [expr {$plus % 65536}]
				set idx [expr {$idx + 9}]
				set distance [expr {(($out2 - 20) * 512) + $plus + 1025}]
			    } elseif {$out2 == 22 || $out2 == 23 } {
				binary scan [binary format b* [string range $zlib $idx  [expr {$idx + 9}]]] s plus
				set plus [expr {$plus % 65536}]
				set idx [expr {$idx + 10}]
				set distance [expr {(($out2 - 22) * 1024) + $plus + 2049}]
			    } elseif {$out2 == 24 || $out2 == 25 } {
				binary scan [binary format b* [string range $zlib $idx  [expr {$idx + 10}]]] s plus
				set plus [expr {$plus % 65536}]
				set idx [expr {$idx + 11}]
				set distance [expr {(($out2 - 24) * 2048) + $plus + 4097}]
			    } elseif {$out2 == 26 || $out2 == 27 } {
				binary scan [binary format b* [string range $zlib $idx  [expr {$idx + 11}]]] s plus
				set plus [expr {$plus % 65536}]
				set idx [expr {$idx + 12}]
				set distance [expr {(($out2 - 26) * 4096) + $plus + 8193}]
			    } elseif {$out2 == 28 || $out2 == 29 } {
				binary scan [binary format b* [string range $zlib $idx  [expr {$idx + 12}]]] s plus
				set plus [expr {$plus % 65536}]
				set idx [expr {$idx + 13}]
				set distance [expr {(($out2 - 28) * 8192) + $plus + 16385}]
			    }

			    #			#status_log "Found distance $distance with added $plus\n"

			    set tocopy [string range $def [expr {$index - $distance}] $index]
			    while { [string length $tocopy] <= $length } {
				set tocopy "${tocopy}${tocopy}"
			    }

			    set tocopy [string range $tocopy 0 [expr {$length -1}]]
			    set def "${def}$tocopy"

			    set index [expr {$index + $length}]
			   #status_log "Time for distance : [expr [clock clicks] - $time]\n"
			}
			set inc 0
#			set time [clock clicks]
		    } else {
			incr inc

		    }
		}
		
	    }
	    
	}


	#status_log "Finished reading and uncompressing zlib blocks of data\n" blue
	#status_log "Time for zlib: [expr [clock clicks] - $time]\n"

	return $def

    }


    proc zip/createcodes { oclen maxbits maxcode } {

	array set clen $oclen 

	#    set clen [list 3 3 3 3 3 2 4 4]

	foreach c [array names clen] {
	    if {[info exists bl_count($clen($c))] } {
		incr bl_count($clen($c))
	    } else {
		set bl_count($clen($c)) 1
	    }
	}

	set code 0

	set bl_count(0) 0;
	#status_log "bl_cout = [array get bl_count]\n"
	for { set bits 1 } { $bits <= $maxbits } {incr bits} {
	    if { ![info exists bl_count([expr {$bits - 1}])] } {
		set bl_count([expr {$bits - 1}]) 0
	    }
	    set code [expr {($code + $bl_count([expr $bits - 1])) << 1}];
	    set next_code($bits) $code;
	}
	
	#status_log "code = $code\nnext_code = [array get next_code]\n"

	for {set n  0} { $n <= $maxcode} {incr n} {
	    if { [info exists clen($n)]} {
		set len $clen($n) 
	    } else {
		set len 0
	    }
	    if { $len != 0} {
		binary scan [binary format s $next_code($len)] b$len bin
		#	    #status_log "$len = $next_code($len) = $bin = [zip/invert $bin]\n"
		set bin [zip/invert $bin]
		set codes($bin) $n
		incr next_code($len)
	    }
	}


	return [array get codes]

    }


    proc zip/invert { bin } {

	set out ""
	
	for { set i [expr {[string length $bin] - 1}] } { $i >= 0 } { incr i -1} {
	    set out "$out[string index $bin $i]"
	}

	return $out
    }

    proc zip/fill_length { type } {
	set out ""
	switch $type { 
	    "lit" {
		for { set i 0 } { $i <= 287 } { incr i } {
		    if { $i <= 143 } {
			set out "$out $i 8"
		    } elseif { $i <= 255 } {
			set out "$out $i 9"
		    } elseif { $i <= 279 } {
			set out "$out $i 7"
		    } else {
			set out "$out $i 8"
		    }
		}
	    }
	    "dist" {
		for { set i 0 } { $i <= 31} { incr i } {
		    set out "$out $i 5"
		}
	    }
	}

	return $out
    }


 variable zip/tell 0


 proc zip/reset {} {variable zip/tell ; set zip/tell 0}


 proc zip/read {stream cnt} {
	variable zip/tell
	set ret [string range $stream ${zip/tell} [expr {${zip/tell} + $cnt -1}]]

	if {${zip/tell} > [string length $stream]} {
		insLog ERROR zip/read past end of file at ${zip/tell} ([string length $stream])
		#error "EOF"
	}
	incr zip/tell $cnt
	set ret
 }


 package provide tclzlib 0.1



----
[Category Tutorial]