AF 2004-08-04 This is a series of procs for reading information from the resource tree compiled into windows executable files. The resource tree holds such information as the menus, icons, cursors, version information, and accelerator keys for the program.
proc FindWindowsHeader {file sig} {
set fh [open $file r]
fconfigure $fh -encoding binary -eofchar {} -translation lf
if {[read $fh 2] != "MZ"} {close $fh; error "not an DOS executable"}
seek $fh 60 start
seek $fh [getword $fh] start
if {[read $fh 2] != $sig} {close $fh; error "windows header not found"}
seek $fh -2 current
return $fh
}
proc EnumNEResources {file} {
set fh [FindWindowsHeader $file NE]
seek $fh 36 current
seek $fh [expr {[getword $fh] - 36}] current
set base [tell $fh]
set ret {}
while {[set type [getNEResName $fh $base [getushort $fh]]] != 0} {
set num [getushort $fh]
seek $fh [expr {$num * 12 + 4}] current
lappend ret $type $num
}
return $ret
}
proc getNEResource {file restype {resid {}}} {
set fh [FindWindowsHeader $file NE]
seek $fh 36 current
seek $fh [expr {[getword $fh] - 38}] current
set base [tell $fh]
set shift [expr {int(pow(2, [getushort $fh]))}]
while {[set type [getNEResName $fh $base [getushort $fh]]] != 0} {
set num [getushort $fh]
if {$type != $restype} {
seek $fh [expr {$num * 12 + 4}] current
continue
}
seek $fh 4 current
set ret {}
for {set i 0} {$i < $num} {incr i} {
set offset [expr {[getushort $fh] * $shift}]
set len [getushort $fh]
seek $fh 2 current
lappend ret[getNEResName $fh $base [getushort $fh]] $offset $len
seek $fh 4 current
}
close $fh
return $ret
}
return {}
}
proc getNEResName {fh base data} {
if {$data == 0} {
return 0
} elseif {[getbit $data 0] == 0} {
set cur [tell $fh]
seek $fh [expr {$data + $base}] start
set len [getchar $fh]
set name [read $fh $len]
seek $fh $cur start
return $name
} else {
return [expr {$data & 0x7fff}]
}
}
proc getdword {fh} {
binary scan [read $fh 4] i tmp
return $tmp
}
proc getulong {fh} {
binary scan [read $fh 4] i tmp
return [format %u $tmp]
}
proc getushort {fh} {
binary scan [read $fh 2] s tmp
return [expr {$tmp & 0x0000FFFF}]
}
proc getword {fh} {
binary scan [read $fh 2] s tmp
return $tmp
}
proc getchar {fh} {
binary scan [read $fh 1] c tmp
return $tmp
}usage:
EnumNEResources ''file'' getNEResource ''file'' ''res type'' EnumPEResources ''file'' getPEResource ''file'' ''res type''
more to come soon