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 EnumPEResources {file} {
set fh [FindWindowsHeader $file PE]
binary scan [read $fh 24] x6sx12s sections headersize
seek $fh $headersize current
for {set i 0} {$i < $sections} {incr i} {
binary scan [read $fh 40] a8x4ix4i type baserva base
if {[string match .rsrc* $type]} {break}
}
if {![string match .rsrc* $type]} {close $fh; return {}}
seek $fh [expr {$base + 12}] start
set res {}
set entries [expr {[getushort $fh] + [getushort $fh]}]
for {set i 0} {$i < $entries} {incr i} {
lappend res [getPEResName $fh $base [getulong $fh]]
set offset [expr {[getulong $fh] & 0x7fffffff}]
set cur [tell $fh]
seek $fh [expr {$base + $offset + 12}] start
lappend res [expr {[getushort $fh] + [getushort $fh]}]
seek $fh $cur start
}
close $fh
return $res
}
proc getPEResource {file restype {resid {}}} {
set fh [FindWindowsHeader $file PE]
binary scan [read $fh 24] x6sx12s sections headersize
seek $fh $headersize current
for {set i 0} {$i < $sections} {incr i} {
binary scan [read $fh 40] a8x4ix4i type baserva base
if {[string match .rsrc* $type]} {break}
}
if {![string match .rsrc* $type]} {close $fh; return {}}
seek $fh [expr {$base + 12}] start
set entries [expr {[getushort $fh] + [getushort $fh]}]
for {set i 0} {$i < $entries} {incr i} {
set name [getPEResName $fh $base [getulong $fh]]
set offset [expr {[getulong $fh] & 0x7fffffff}]
if {$name != $restype} {continue}
set cur [tell $fh]
seek $fh [expr {$base + $offset + 12}] start
set entries2 [expr {[getushort $fh] + [getushort $fh]}]
for {set i2 0} {$i2 < $entries2} {incr i2} {
set name [getulong $fh]
set offset [expr {[getulong $fh] & 0x7fffffff}]
set name [getPEResName $fh $base $name]
if {$resid != "" && $name != $resid} {continue}
set cur2 [tell $fh]
seek $fh [expr {$offset + $base + 12}] start
set entries3 [expr {[getushort $fh] + [getushort $fh]}]
for {set i3 0} {$i3 < $entries3} {incr i3} {
binary scan [read $fh 4] H2H2 n1 n2
set offset [expr {[getulong $fh] & 0x7fffffff}]
set cur3 [tell $fh]
seek $fh [expr {$offset + $base}] start
set rva [getulong $fh]
set size [getulong $fh]
lappend ret $name [expr {$rva - $baserva + $base}] $size
seek $fh $cur3 start
}
seek $fh $cur2 start
}
close $fh
return $ret
}
return {}
}
proc getPEResName {fh start data} {
if {($data & 0x80000000) != 0} {
set cur [tell $fh]
seek $fh [expr {($data & 0x7fffffff) + $start}] start
set len [getushort $fh]
set name [read $fh [expr {$len * 2}]]
seek $fh $cur start
return [encoding convertfrom unicode $name]
} else {
return $data
}
}
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> ?res id? EnumPEResources <file> getPEResource <file> <res type> ?res id?Enum* returns a list of resource types found and the number of resources for that type.get* returns a list of the resource id, its offset, and its size for the resources of the specified typeThe NE and PE methods corespond to 16bit and 32bit files. DLL, OCX, ICL, and other files are also executable format and will work with these procedures.Resource types may have a string or integer id. The integer types are defined as follows:
#define RT_CURSOR 1
#define RT_BITMAP 2
#define RT_ICON 3
#define RT_MENU 4
#define RT_DIALOG 5
#define RT_STRING 6
#define RT_FONTDIR 7
#define RT_FONT 8
#define RT_ACCELERATORS 9
#define RT_RCDATA 10
#define RT_MESSAGETABLE 11
#define RT_GROUP_CURSOR 12
#define RT_GROUP_ICON 14
#define RT_VERSION 16For more information see: [1]Also see TWAPI's resource module [2].
