--AF 24-07-03


 proc getdword {fh} {
    binary scan [read $fh 4] i* tmp
    return $tmp
 }

 proc getword {fh} {
    binary scan [read $fh 2] s* tmp
    return $tmp
 }

 proc getFileType {file} {
    set fh [open $file r]
    fconfigure $fh -encoding binary
    if {[read $fh 2] != "MZ"} {close $fh; return UNKNOWN}
    seek $fh 24 start
    if {[scan [read $fh 1] %c] < 64} {close $fh; return MZ}
    seek $fh 60 start
    seek $fh [getword $fh] start
    set sig [read $fh 4]
    close $fh
    if {[string match "NE*" $sig]} {return NE}
    if {$sig == "PE\000\000"} {return PE}
    return UNKNOWN
 }

 proc getMZHeader {file array} {
    set fh [open $file r]
    fconfigure $fh -encoding binary
    if {[read $fh 2] != "MZ"} {close $fh; error "not an DOS executable"}
    upvar $array ret
    array set ret {}
    foreach x {LastPage Pages Relocations HeaderParas MinParas MaxParas SS SP x IP CS \
               RelocationTable Overlay x OEMID OEMInfo} {
        set ret($x) [getword $fh]
    }
    unset ret(x)
    close $fh
 }

 proc getNEHeader {file array} {
    set fh [open $file r]
    fconfigure $fh -encoding binary
    if {[read $fh 2] != "MZ"} {close $fh; error "not an DOS executable"}
    seek $fh 24 start
    if {[scan [read $fh 1] %c] < 64} {close $fh; error "no windows header"}
    seek $fh 60 start
    seek $fh [getword $fh] start
    set offset [tell $fh]
    if {[read $fh 2] != "NE"} {close $fh; error "new executable header not found"}
    upvar $array ret
    array set ret {}

    set ret(Linker) [scan [read $fh 1] %c].[scan [read $fh 1] %c]
    set ret(EntryOffset) [getword $fh]
    set ref(EntryLength) [getword $fh]
    seek $fh 2 current
    set ret(Flags) [getword $fh]
    set ref(AutoData) [getword $fh]
    set ret(Heap) [getword $fh]
    set ret(Stack) [getword $fh]
    seek $fh 4
    set ret(Segments) [getword $fh]
    set ret(Modules) [getword $fh]
    set ret(NRNTSize) [getword $fh]
    set ret(SegmentTable) [expr {[getword $fh] + $offset}]
    set ret(ResourceTable) [expr {[getword $fh] + $offset}]
    set ret(ResidentNameTable) [expr {[getword $fh] + $offset}]
    set ret(ModuleRefTable) [expr {[getword $fh] + $offset}]
    set ret(ImportedNameTable) [expr {[getword $fh] + $offset}]
    set ret(NonResidentNameTable) [expr {[getword $fh] + $offset}]
    set ret(EntryPoints) [getword $fh]
    set ret(SectorAlign) [getword $fh]
    set ret(Resources) [getword $fh]
    set ret(OS) [scan [read $fh 1] %c]
    set ret(Info) [scan [read $fh 1] %c]
    seek $fh 6 current
    set ret(WinVer) [scan [read $fh 1] %c]

    close $fh
 }

 proc getPEHeader {file array} {
    set fh [open $file r]
    fconfigure $fh -encoding binary
    if {[read $fh 2] != "MZ"} {close $fh; error "not an DOS executable"}
    seek $fh 24 start
    if {[scan [read $fh 1] %c] < 64} {close $fh; error "no windows header"}
    seek $fh 60 start
    seek $fh [getword $fh] start
    set offset [tell $fh]
    if {[read $fh 4] != "PE\000\000"} {close $fh; error "portable executable header not found"}
    upvar $array ret
    array set ret {}

    set ret(CPU) [getword $fh]
    set ret(Sections) [getword $fh] 
    set ret(Timestamp) [getdword $fh]
    seek $fh 10 current
    #set ret(HeaderSize) [expr {[getword $fh] + 24}]
    set ret(Flags) [getword $fh]
    if {[getword $fh] != "267"} {close $fh; return}
    set ret(Linker) [scan [read $fh 1] %c].[scan [read $fh 1] %c]
    set ret(CodeSize) [getdword $fh]
    set ret(InitDataSize) [getdword $fh]
    set ret(UnInitDataSize) [getdword $fh]
    seek $fh 12 current
    set ret(ImageBase) [getdword $fh]
    set ret(SectionAlign) [getdword $fh]
    set ret(FileAlign) [getdword $fh]
    set ret(OS) [scan [read $fh 2] %c].[scan [read $fh 2] %c]
    set ret(ImageVer) [scan [read $fh 2] %c].[scan [read $fh 2] %c]
    set ret(SubsystemVer) [scan [read $fh 2] %c].[scan [read $fh 2] %c]
    seek $fh 4 current
    set ret(ImageSize) [getdword $fh]
    set ret(HeaderSize) [getdword $fh]
    seek $fh 4 current
    set ret(Subsystem) [scan [read $fh 2] %c]
    set ret(DllFlags) [scan [read $fh 2] %c]
    set ret(StackReserve) [getdword $fh]
    set ret(StackCommit) [getdword $fh]
    set ret(HeapReserve) [getdword $fh]
    set ret(HeapCommit) [getdword $fh]
    set ret(LoaderFlags) [getdword $fh]

    close $fh
 }

 proc readHeader {file} {
    switch -glob -- [getFileType $file] {
        PE {
            puts "Found Portable Exectuable header"
            readPEHeader $file
        }
        NE {
            puts "Found New Executable header"
            readNEHeader $file
        }
        MZ {
            puts "Found DOS MZ header"
            readMZHeader $file
        }
        default {
            puts "Header not found"
        }
    }
}

 proc readMZHeader {file} {
    if {[catch {getMZHeader $file results} err]} {
        puts "Error reading file header: $err"
        return
    }
    puts "Bytes on last page: $results(LastPage)"
    puts "Pages in file: $results(Pages)"
    puts "Relocations: $results(Relocations)"
    puts "Size of header in paragraphs: $results(HeaderParas)"
    puts "Minimum extra paragraphs needed: $results(MinParas)"
    puts "Maximum extra paragraphs needed: $results(MaxParas)"
    puts "Initial SS: $results(SS)"
    puts "Initial SP: $results(SP)"
    puts "Initial IP: $results(IP)"
    puts "Initial CS: $results(CS)"
    puts "Relocation table offset: $results(RelocationTable)"
    puts "Overlay: $results(Overlay)"
 }

 proc readNEHeader {file} {
    if {[catch {getNEHeader $file results} err]} {
        puts "Error reading file header: $err"
        return
    }
    puts "Linker version: $results(Linker)"
    puts "Flags: $results(Flags)"
    puts "Initial heap size: $results(Heap)"
    puts "Initial stack size: $results(Stack)"
    puts "Segment table entries: $results(Segments)"
    puts "Module reference entries: $results(Modules)"
    puts "Size of nonresident name table: $results(NRNTSize)"
    puts "Resource segments: $results(Resources)"
    puts "OS: $results(OS)"
    puts "Info: $results(Info)"
    puts "Windows version: $results(WinVer)"
 }

 proc readPEHeader {file} {
    if {[catch {getPEHeader $file results} err]} {
        puts "Error reading file header: $err"
        return
    }

    if {[info exists ::pex_cputype($results(CPU))]} {
        puts "CPU: $::pex_cputype($results(CPU))"
    } else {
        puts "CPU: Unidentified"
    }

    puts "Object table entries: $results(Sections)"
    puts "Linked: [clock format $results(Timestamp) -gmt 1]"

    set flags {}
    foreach x [lsort -integer -decreasing [array names ::pex_flags]] {
        if {$results(Flags) > $x} {
            incr results(Flags) -$x
            lappend flags $::pex_flags($x)
        }
    }
    puts "Flags: [join $flags ", "]"

    puts "Linker version: $results(Linker)"
    puts "Size of code: $results(Linker)"
    puts "Size of initialized data: $results(InitDataSize)"
    puts "Size of uninitialized data: $results(UnInitDataSize)"
    puts "Section alignment: $results(SectionAlign)"
    puts "File alignment: $results(FileAlign)"
    puts "Size of headers: $results(HeaderSize)"
    puts "Size of image: $results(ImageSize)"
    puts "OS version: $results(OS)"
    puts "Image version: $results(ImageVer)"

    if {[info exists ::pex_subsystem($results(Subsystem))]} {
        puts "Subsystem: $::pex_subsystem($results(Subsystem))"
    } else {
        puts "Subsystem: Unidentified"
    }
    
    puts "Subsystem version: $results(SubsystemVer)"

    foreach x [lsort -integer -decreasing [array names ::pex_dllflags]] {
        if {$results(DllFlags) >= $x} {
            incr results(DllFlags) -$x
            lappend flags $::pex_dllflags($x)
        }
    }
    if {$flags == ""} { set flags None }
    puts "DLL flags: [join $flags ", "]"

    puts "Stack reserve size: $results(StackReserve)"
    puts "Stack commit size: $results(StackCommit)"
    puts "Heap reserve size: $results(HeapReserve)"
    puts "Heap commit size: $results(HeapCommit)"
 }

----

the get* procs represent a programatic interface to the information. the read* headers use this info to print out a nice readable format.

getFileType: returns MZ NE PE or UNKNOWN

getMZHeader: returns array with the dos header info

getNEHeader: returns array with the NE header info

getPEHeader: returns array with the PE header info

readHeader: prints info on the file header, uses getFileType to determine which header to print

readPEHeader: prints the PE header info

readNEHeader: prints the NE header info


Output looks like this

 getFileType tclkit.exe
 PE

 getPEHeader ../shared/tclkit.exe test
 parray test
 test(CPU)            = 332
 test(CodeSize)       = 671744
 test(Date)           = 0
 test(DllFlags)       = 0
 test(FileAlign)      = 512
 test(FileSubType)    = 0
 test(FileType)       = 2
 test(FileVer)        = 8.4.2.2
 test(Flags)          = 271
 test(HeaderSize)     = 4096
 test(HeapCommit)     = 4096
 test(HeapReserve)    = 1048576
 test(ImageBase)      = 4194304
 test(ImageSize)      = 1777664
 test(ImageVer)       = 0.0
 test(InitDataSize)   = 16384
 test(Linker)         = 6.0
 test(LoaderFlags)    = 0
 test(OS)             = 4.0
 test(ProductVer)     = 8.4.2.2
 test(SectionAlign)   = 4096
 test(Sections)       = 3
 test(StackCommit)    = 4096
 test(StackReserve)   = 1048576
 test(Subsystem)      = 2
 test(SubsystemVer)   = 4.0
 test(Timestamp)      = 1046724905
 test(UnInitDataSize) = 1085440

 readPEHeader tclkit.exe
 CPU: 80386
 Object table entries: 3
 Linked: Mon Mar 03 20:55:05 GMT 2003
 Flags: 32 bit word machine, Local symbols stripped, Line nunbers  stripped, File is executable
 Linker version: 6.0
 Size of code: 6.0
 Size of initialized data: 16384
 Size of uninitialized data: 1085440
 Section alignment: 4096
 File alignment: 512
 Size of headers: 4096
 Size of image: 1777664
 OS version: 4.0
 Image version: 0.0
 Subsystem: Windows GUI
 Subsystem version: 4.0
 DLL flags: 32 bit word machine, Local symbols stripped, Line nunbers  stripped, File is executable
 Stack reserve size: 1048576
 Stack commit size: 4096
 Heap reserve size: 1048576
 Heap commit size: 4096