--[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)"
 }

 array set pex_cputype {
    0 Unknown
    332 80386
    333 80486
    334 Pentium
    354 "MIPS Mark 1"
    355 "MIPS Mark 2"
    358 "MIPS Mark 3"
    388 "Alpha AXP"
    448 ARM
    496 "PowerPC"
    512 "Itanium"
 }

 array set pex_flags {
    1     "Relocation info stripped"
    2     "File is executable"
    4     "Line nunbers stripped"
    8     "Local symbols stripped"
    16    "Agressively trim working set"
    32    "Can handle >2GB addresses"
    128   "Bytes of machine word are reversed"
    256   "32 bit word machine"
    512   "Debugging info stripped"
    1024  "Dont run from removable media"
    2048  "Dont run from network"
    4096  "System file"
    8092  "DLL"
    16384 "Run only on UP machine"
    32768 "Bytes of machine word are reversed"
 }

 array set pex_subsystem {
    0 Unknown
    1 Native
    2 "Windows GUI"
    3 "Windows Character"
    5 "OS/2 Character"
    7 "POSIX Character"
 }

 array set pex_dllflags {
    1 "Per process library initialization"
    2 "Per process library termination"
    4 "Per thread library initialization"
    8 "Per thread library termination"
 }

----

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

readMZHeader: prints the MZ header info

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