[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 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?``

The 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:



----

[Category Windows]