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(CodeSize)"
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"
8192 "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 UNKNOWNgetMZHeader: returns array with the dos header infogetNEHeader: returns array with the NE header infogetPEHeader: returns array with the PE header inforeadHeader: prints info on the file header, uses getFileType to determine which header to printreadMZHeader: prints the MZ header inforeadPEHeader: prints the PE header inforeadNEHeader: prints the NE header infoOutput looks like this
getFileType tclkit.exe PE getPEHeader ../shared/tclkit.exe test parray test test(CPU) = 332 test(CodeSize) = 671744 test(DllFlags) = 0 test(FileAlign) = 512 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(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: 671744 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
