--AF 13-07-03
array set cputype {
0 Unknown
332 80386
333 80486
334 Pentium
354 "MIPS Mark 1"
355 "MIPS Mark 2"
358 "MIPS Mark 3"
}
array set 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 subsystem {
0 Unknown
1 Native
2 "Windows GUI"
3 "Windows Character"
5 "OS/2 Character"
7 "POSIX Character"
}
array set dllflags {
1 "Per process library initialization"
2 "Per process library termination"
4 "Per thread library initialization"
8 "Per thread library termination"
}
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 readPEInfo {file} {
set fh [open $file r]
fconfigure $fh -encoding binary
seek $fh 24 start
set tmp [scan [read $fh 1] %c]
if {$tmp < 64} { puts "no windows header"; return }
seek $fh 60 start
set tmp [scan [read $fh 1] %c]
seek $fh $tmp start
if {[read $fh 4] != "PE\000\000"} { puts "windows header not found"; return }
set tmp [getword $fh]
if {[info exists ::cputype($tmp)]} {
puts "CPU: $::cputype($tmp)"
} else {
puts "CPU: Unidentified"
}
puts "Object table entries: [getword $fh]"
puts "Linked: [clock format [getdword $fh] -gmt 1]"
seek $fh 8 current
puts "Header size: [expr [getword $fh] + 192] bytes"
set tmp [getword $fh]
set flags {}
foreach x [lsort -integer -decreasing [array names ::flags]] {
if {$tmp > $x} {
incr tmp -$x
lappend flags $::flags($x)
}
}
puts "Flags: [join $flags ", "]"
seek $fh 2 current
puts "Linker version: [scan [read $fh 1] %c].[scan [read $fh 1] %c]"
puts "Size of code: [getdword $fh]"
puts "Size of initialized data: [getdword $fh]"
puts "Size of uninitialized data: [getdword $fh]"
seek $fh 16 current
puts "Section alignment: [getdword $fh]"
puts "File alignment: [getdword $fh]"
puts "OS version: [scan [read $fh 2] %c].[scan [read $fh 2] %c]"
puts "Image version: [scan [read $fh 2] %c].[scan [read $fh 2] %c]"
puts "Subsystem version: [scan [read $fh 2] %c].[scan [read $fh 2] %c]"
seek $fh 4 current
puts "Size of image: [getdword $fh]"
puts "Size of headers: [getdword $fh]"
seek $fh 4 current
set tmp [scan [read $fh 2] %c]
if {[info exists ::subsystem($tmp)]} {
puts "Subsystem: $::subsystem($tmp)"
} else {
puts "Subsystem: Unidentified"
}
set tmp [scan [read $fh 2] %c]
if {$tmp == "0"} {
set flags "None"
} else {
set flags {}
foreach x [lsort -integer -decreasing [array names ::dllflags]] {
if {$tmp > $x} {
incr tmp -$x
lappend flags $::dllflags($x)
}
}
}
puts "DLL flags: [join $flags ", "]"
puts "Stack reserve size: [getdword $fh]"
puts "Stack commit size: [getdword $fh]"
puts "Heap reserve size: [getdword $fh]"
puts "Heap commit size: [getdword $fh]"
close $fh
}Output looks like this
readPEInfo tclkit.exe CPU: 80386 Object table entries: 3 Linked: Mon Mar 03 20:55:05 GMT 2003 Header size: 416 bytes 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 OS version: 4.0 Image version: 0.0 Subsystem version: 4.0 Size of image: 1777664 Size of headers: 4096 Subsystem: Windows GUI DLL flags: None Stack reserve size: 1048576 Stack commit size: 4096 Heap reserve size: 1048576 Heap commit size: 4096