Not realy nice yet just quick and splashes of blood.
together in the right way if one expands into an empty filepath.
The archive format description is taken from "Technical Documentation for FreeDOS Backup & Restore" [L1 ]
#!/usr/bin/tclsh
set ptype U
set pre_path ".\\restore\\"
set do 1
set idx 0
while {1} {
set bidx [ format %03d [ incr idx ] ]
set backup backup.$bidx
set control control.$bidx
set stfd [ open $backup r ]
fconfigure $stfd -encoding binary -translation binary
set ctrlfd [ open $control r ]
fconfigure $ctrlfd -encoding binary -translation binary
set index [ read $ctrlfd ]
set len [string length $index] ; puts stderr indexlen:$len
set pos 0
while {$pos < $len} {
set act [string index $index $pos ]
scan $act %c val
puts -nonewline stderr [format "0x%02x " $val]
switch -- $act \
\x8b {
puts stderr "Header"
set headerentry [ string range $index $pos [ incr pos 0x8b ] ]
set hd_signature [ string range $headerentry 1 7 ]
scan [ string range $headerentry 9 9 ] %c hd_backno
set hd_filler [ string range $headerentry 10 137 ]
scan [ string range $headerentry 138 138 ] %c hd_lastdisk
puts stderr [format "\t\"%s\" %d %d\n" $hd_signature $hd_backno $hd_lastdisk]
} \x46 {
puts stderr "Dir Entry"
set direntry [ string range $index $pos [ incr pos 0x46 ] ]
set dir_path [ string range $direntry 1 63 ]
set dir_path [ string trimright ${pre_path}$dir_path \x0 ]
set dir_fcnt [ string range $direntry 64 65 ]
binary scan $dir_fcnt s dir_fcnt
set dir_dummy [ string range $direntry 66 69 ]
puts stderr [format "\t\"%s\" %d \n" $dir_path $dir_fcnt ]
if {$do} {
if { $ptype== "U" } {
set dir_path [ string map [ list \\ /] $dir_path ]
}
puts stderr "trying: mkdir $dir_path"
catch [ file mkdir $dir_path ]
}
} \x22 {
puts stderr "File Entry"
set fileentry [ string range $index $pos [ incr pos 0x22 ] ]
set file_name [ string range $fileentry 1 12 ]
set file_name [ string trimright $file_name \x0 ]
scan [string range $fileentry 13 13 ] %c file_split
set file_size [ string range $fileentry 14 17 ]
binary scan $file_size i file_size
set file_cidx [ string range $fileentry 18 19 ]
binary scan $file_cidx s file_cidx
set file_coffs [ string range $fileentry 20 23 ]
binary scan $file_coffs i file_coffs
set file_clen [ string range $fileentry 24 27 ]
binary scan $file_clen i file_clen
scan [ string range $fileentry 28 28 ] %c file_attrib
set file_dummy [ string range $fileentry 29 29 ]
set file_dtime [ string range $fileentry 30 33 ]
binary scan $file_dtime i file_dtime
puts stderr [format "\t\"%s\" %d %d %08x:%08x %02x %08x\n" \
$file_name $file_size $file_cidx \
$file_coffs $file_clen $file_attrib \
$file_dtime \
]
if {$do} {
seek $stfd $file_coffs start
set file_cont [ read $stfd $file_clen ]
puts stderr "trying: open [ file join $dir_path $file_name ]"
set fd [ open [ file join $dir_path $file_name ] a ]
fconfigure $fd -encoding binary -translation binary
puts -nonewline $fd $file_cont
close $fd
}
} \x00 {
puts stderr "End of File"
incr pos
}
puts -nonewline stderr next? ; # gets stdin
}
close $stfd
close $ctrlfd
}