BoBka 14-11-07
I suppose it's better to parse EXE object table correctly. IMHO it's better than scanning through all undetermined content of other code and data object sections. Here is an example just to show how to get file version from exe or dll files. All files I tested answers version correctly.
NOTE: THIS IS AN EXAMPLE. THERE IS NO ERROR CHECKING, IT IS NOT OPTIMIZED AND IT IS INCOMPLETE but it works :)
USE IT AT YOUR OWN RISK. Sorry for my English. My Russian is much better :)
proc read_data { fn off len } {
set ret ""
if { ![catch {open $fn "r"} hfn] } {
fconfigure $hfn -encoding binary -translation binary
seek $hfn $off start
set ret [read $hfn $len]
close $hfn
}
return $ret
}
proc read_dw { fn off } {
binary scan [read_data $fn $off 4] "i" ret
return $ret
}
proc read_w { fn off } {
binary scan [read_data $fn $off 2] "s" ret
return $ret
}
proc GetExeVersion { fn } {
set pe_offs [read_dw $fn 0x3C]
set pe_size [expr [read_w $fn [expr $pe_offs + 0x14]] + 0x18]
set num_of_obj [read_w $fn [expr $pe_offs + 0x06]]
set obj_table_offs [expr $pe_offs + $pe_size]
## for each object
for {set i 0} {[expr $i < $num_of_obj]} {incr i} {
set obj_rec_offs [expr $obj_table_offs + $i*0x28]
## if object name is not ".rsrc" then go to next
set obj_name [string trim [read_data $fn [expr $obj_rec_offs + 0x00] 8] "\0"]
if {![string equal $obj_name ".rsrc"]} { continue }
# here we found .rsrc object
set obj_size [read_dw $fn [expr $obj_rec_offs + 0x10]]
set obj_offs [read_dw $fn [expr $obj_rec_offs + 0x14]]
set obj_rva [read_dw $fn [expr $obj_rec_offs + 0x0C]]
# enumerate resources in .rsrc
set dofs $obj_offs
set n1 [read_w $fn [expr $dofs + 0x0C]]
set n2 [read_w $fn [expr $dofs + 0x0E]]
## for each id entry_rec
for {set k 0} {[expr $k < $n2]} {incr k} {
## LEVEL 1 OF RESOURCE TREE ##
set rdo [expr $dofs + 0x10]
set k_offs [expr $rdo + $n1*8 + $k*8]
## looking for record where id = RT_VERSION
set res_id [read_dw $fn $k_offs]
if {[expr $res_id != 0x10]} { continue }
## this must be directory...
set res_offs [read_dw $fn [expr $k_offs + 4]]
if {![expr $res_offs & 0x80000000]} { return -1 }
## LEVEL 2 OF RESOURCE TREE ##
set dofs [expr ($res_offs & (0x80000000 ^ 0xFFFFFFFF))+ $obj_offs]
set n1 [read_w $fn [expr $dofs + 0x0C]]
set n2 [read_w $fn [expr $dofs + 0x0E]]
set rdo [expr $dofs + 0x10]
if { $n1 != 0 || $n2 != 1 } { return -2 }
set k_offs $rdo
set res_id [read_dw $fn $k_offs]
if {[expr $res_id != 0x01]} { return -3 }
## this must be directory...
set res_offs [read_dw $fn [expr $k_offs + 4]]
if {![expr $res_offs & 0x80000000]} { return -4 }
## LEVEL 3 OF RESOURCE TREE ##
set dofs [expr ($res_offs & (0x80000000 ^ 0xFFFFFFFF))+ $obj_offs]
set n1 [read_w $fn [expr $dofs + 0x0C]]
set n2 [read_w $fn [expr $dofs + 0x0E]]
set rdo [expr $dofs + 0x10]
if { $n1 != 0 || $n2 != 1 } { return -5 }
set k_offs $rdo
## this must NOT be directory...
set res_offs [read_dw $fn [expr $k_offs + 4]]
if {[expr $res_offs & 0x80000000]} { return -7 }
## LEVEL 4 OF RESOURCE TREE ##
set dofs [expr $res_offs + $obj_offs]
set inf_offs [expr [read_dw $fn $dofs] - $obj_rva + $obj_offs]
set inf_len [read_dw $fn [expr $dofs + 4]]
# here we can read version block and write it to file
# set info_block [read_data $fn $inf_offs $inf_len]
set mag_stamp [read_dw $fn [expr $inf_offs + 0x28]]
if {![string equal [format "%X" $mag_stamp] [format "%X" [expr 0xFEEF04BD]]]} {
# maybe we need to follow szKey in VS_VERSION_INFO and look for offset to dwSignature correctly?
# http://www.csn.ul.ie/~caolan/publink/winresdump/winresdump/doc/resfmt.txt
return -8
}
# whew... finaly we can read version
set v1 [read_dw $fn [expr $inf_offs + 0x30]]
set v2 [read_dw $fn [expr $inf_offs + 0x34]]
return [format "%d.%d.%d.%d" [expr ($v1 & 0xFFFF0000)>>16] [expr ($v1 & 0xFFFF)] [expr ($v2 & 0xFFFF0000)>>16] [expr ($v2 & 0xFFFF)]]
}
break
}
return 0
}# USAGE:
set fn {C:\WINDOWS\winhlp32.exe} # set fn {C:\WINDOWS\twain.dll}
puts [format ">%s<" [GetExeVersion $fn]
AF 24-07-2003
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 getFixedInfo {file array} {
set fh [open $file r]
fconfigure $fh -encoding unicode -eofchar {}
set data [read $fh]
set s [string first "VS_VERSION_INFO" $data]
if {$s < 0} {close $fh; error "no version information found"}
unset data
fconfigure $fh -encoding binary
seek $fh [expr {($s * 2) - 6}] start
seek $fh [expr {[tell $fh] % 4}] current
binary scan [read $fh 6] sss len vlen type
seek $fh 34 current
if {[getdword $fh] != 4277077181} {close $fh; error "version information corrupt"}
upvar $array ret
array set ret {}
seek $fh 4 current
binary scan [read $fh 8] ssss b a d c
set ret(FileVer) $a.$b.$c.$d
binary scan [read $fh 8] ssss b a d c
set ret(ProductVer) $a.$b.$c.$d
seek $fh 4 current
#binary scan [read $fh 4] B32 flagmask
set ret(Flags) [getdword $fh]
set ret(OS) [getdword $fh]
set ret(FileType) [getdword $fh]
set ret(FileSubType) [getdword $fh]
binary scan [read $fh 8] w ret(Date)
close $fh
}
proc getFixedInfo2 {file array} {
set fh [open $file r]
fconfigure $fh -encoding binary -eofchar {}
set data [read $fh]
set s [string first "VS_VERSION_INFO" $data]
if {$s < 0} {close $fh; error "no version information found"}
unset data
seek $fh [expr {$s - 6}] start
seek $fh [expr {[tell $fh] % 4}] current
seek $fh 22 current
if {[getdword $fh] != 4277077181} {close $fh; error "version information corrupt"}
upvar $array ret
array set ret {}
seek $fh [expr {[tell $fh] % 4}] current
binary scan [read $fh 8] ssss d c b a
set ret(FileVer) $a.$b.$c.$d
binary scan [read $fh 8] ssss d c b a
set ret(ProductVer) $a.$b.$c.$d
seek $fh 8 current
set ret(Flags) [getdword $fh]
set ret(OS) [getdword $fh]
set ret(FileType) [getdword $fh]
set ret(FileSubType) [getdword $fh]
binary scan [read $fh 8] w ret(Date)
close $fh
}
proc getStringInfo {file array} {
upvar $array ret
array set ret {}
set fh [open $file r]
fconfigure $fh -translation lf -encoding unicode -eofchar {}
set data [read $fh]
close $fh
if {[set s [string first "StringFileInfo\000" $data]] < 0} {error "no string information found"}
incr s -3
if {![regexp {(.)\000(.)StringFileInfo\000(.)\000(.)(....)(....)\000} [string range $data $s end] --> len type len2 type2 lang code]} {
error "string information corrupt"
}
array set ret [list Language $lang CodePage $code]
set len [expr [scan $len %c] / 2]
set len2 [expr [scan $len2 %c] / 2]
set data [string range $data $s [expr {$s + $len}]]
set s 30
while {$s < $len2} {
scan [string range $data $s end] %c%c%c slen vlen type
if {$slen == 0} return
set slen [expr {$slen / 2}]
set name [string range $data [expr {$s + 3}] [expr {$s + $slen - $vlen - 1}]]
set value [string range $data [expr {$s + $slen - $vlen}] [expr {$s + $slen - 2}]]
set s [expr {$s + $slen + ($slen % 2)}]
set ret([string trimright $name \000]) $value
}
}
proc getStringInfo2 {file array} {
upvar $array ret
array set ret {}
set fh [open $file r]
fconfigure $fh -encoding binary -eofchar {}
set data [read $fh]
if {[set s [string first "StringFileInfo\000" $data]] < 0} {close $fh; error "no string information found"}
seek $fh [expr {$s + 17}] start
set len [getword $fh]
seek $fh 2 current
array set ret [list Lang [read $fh 4] CodePage [read $fh 4]]
seek $fh 2 current
seek $fh [expr {[tell $fh] % 4}] current
set end [expr {$s + $len}]
while {[tell $fh] < $end} {
set slen [getword $fh]
set vlen [getword $fh]
set name [read $fh [expr {$slen - $vlen - 4}]]
set value [read $fh [expr {$vlen + ($slen % 2)}]]
seek $fh [expr {[tell $fh] % 4}] current
set ret([string trimright $name \000]) [string trimright $value \000]
}
}
proc writeStringInfo {file array} {
upvar $array val
set fh [open $file r+]
fconfigure $fh -translation lf -encoding unicode -eofchar {}
set data [read $fh]
set s [string first "StringFileInfo\000" $data]
if {$s < 0} { close $fh; error "no stringfileinfo found" }
if {![info exists val(CodePage)]} { set val(CodePage) 04b0 }
if {![info exists val(Language)]} { set val(Language) 0409 }
incr s -3
set len [scan [string index $data $s] %c]
seek $fh [expr {$s * 2}] start
puts -nonewline $fh [format "%c\000\001StringFileInfo\000%c\000\001%s%s\000" $len [expr {$len - 36}] $val(Language) $val(CodePage)]
unset val(CodePage) val(Language)
set olen $len
set len [expr {($len / 2) - 30}]
foreach x [array names val] {
set vlen [expr {[string length $val($x)] + 1}]
set nlen [string length $x]
set npad [expr {$nlen % 2}]
set tlen [expr {$vlen + $nlen + $npad + 4}]
set tpad [expr {$tlen % 2}]
if {($tlen + $tpad) > $len} { set error "too long" ; break }
puts -nonewline $fh [format "%c%c\001%s\000%s%s\000%s" [expr {$tlen * 2}] $vlen $x [string repeat \000 $npad] $val($x) [string repeat \000 $tpad]]
set len [expr {$len - $tlen - $tpad}]
}
puts -nonewline $fh [string repeat \000 $len]
puts -nonewline $fh [string range $data [expr {$s + ($olen / 2)}] end]
close $fh
if {[info exists error]} { error $error }
}
proc readFixedInfo {file} {
if {[catch {getFixedInfo $file results} err]} {
puts "Error reading fixed file information: $err"
return
}
puts "File version: $results(FileVer)"
puts "Product version: $results(ProductVer)"
set flags {}
foreach x [lsort -integer -decreasing [array names ::ffi_flags]] {
if {$results(Flags) > $x} {
incr results(Flags) -$x
lappend flags $::ffi_flags($x)
}
}
if {$flags == ""} { set flags None }
puts "Flags: [join $flags ", "]"
set blah {}
if {$results(OS) == 0} {
puts "OS: Unknown"
} else {
foreach x [lsort -integer -decreasing [array names ::ffi_os]] {
if {$results(OS) >= $x} {
incr results(OS) -$x
lappend blah $x
}
}
switch -exact -- [llength $blah] {
0 { puts "OS: Unidentified" }
1 { puts "OS: $::ffi_os([lindex $blah 0])" }
default { puts "OS: $::ffi_os([lindex $blah 1]) on $::ffi_os([lindex $blah 0])" }
}
}
if {[info exists ::ffi_type($results(FileType))]} {
puts "File Type: $::ffi_type($results(FileType))"
} else {
puts "File Type: Unidentified"
}
if {$results(FileType) != 3 && $results(FileType) != 4} {
} elseif {[info exists ::ffi_${ft}_subtype($results(FileSubType))]} {
puts "File SubType: [set ::ffi_${ft}_subtype($results(FileSubType))]"
} else {
puts "File SubType: Unidentified"
}
if {$results(Date) == 0} {
puts "Date: None"
} else {
puts "Date: [clock format $results(Date) -gmt 1]"
}
}
proc readStringInfo {file} {
if {[catch {getStringInfo $file results} err]} {
puts "Error reading string file information: $err"
return
}
foreach x [array names results] {
puts "$x: $results($x)"
}
}
array set ffi_os {
1 "Windows 16bit"
2 "Presentation Manager 16bit"
3 "Presentation Manager 32bit"
4 "Windows 32bit"
65536 DOS
131072 "OS/2 16bit"
196608 "OS/2 32bit"
262144 "Windows NT"
}
array set ffi_flags {
1 Debug
2 Prerelease
4 Patched
8 "Private Build"
16 "Info Inferred"
32 "Special Build"
}
array set ffi_type {
0 Unknown
1 Application
2 DLL
3 Driver
4 Font
5 VXD
7 "Static Library"
}
array set ffi_3_subtype {
0 Unknown
1 Printer
2 Keyboard
3 Language
4 Display
5 Mouse
6 Network
7 System
8 Installable
9 Sound
10 Communications
}
array set ffi_4_subtype {
0 Unknown
1 Raster
2 Vector
3 TrueType
}Usage:
The get* procs represent a programatic interface to the information. The read* procs output this information in a nice human readable format. The *2 procs exist because there are 2 slightly different types of files, the newer ones are unicode.
getFixedInfo returns array with the fixed file info
getFixedInfo2 returns array with the fixed file info
getStringInfo returns array with the string file info
getStringInfo2 returns array with the string file info
readFixedInfo prints the formatted/decoded fixed file info
readStringInfo prints the formatted/decoded string file info
writeStringInfo writes the info in an array to a files string file info
the output looks like this:
getFixedInfo tclkit.exe test parray test test(Date) = 0 test(FileSubType) = 0 test(FileType) = 2 test(FileVer) = 8.4.2.2 test(Flags) = 0 test(OS) = 4 test(ProductVer) = 8.4.2.2 getStringInfo tclkit.exe test parray test test(CodePage) = 04b0 test(CompanyName) = Equi4 Software test(FileDescription) = Tclkit, a standalone runtime for Tcl/Tk test(FileVersion) = 8.4.2 test(Language) = 0409 test(LegalCopyright) = Copyright © 1989-2003 by J.Ousterhout et al. test(OriginalFilename) = tclkit.exe test(ProductName) = Tclkit 8.4 for Windows test(ProductVersion) = 8.4.2 readFixedInfo tclkit.exe File version: 8.4.2.2 Product version: 8.4.2.2 Flags: None OS: Windows 32bit File Type: DLL Date: None
I support writing any stringinfo values to the file but here is a list of the ones normally used.
CodePage and Language are required but will default to 04b0 and 0409 respectively if not specified.
You can only write to files that already have a stringfileinfo block and you are limited to the same or less total length so as not to corrupt the file.
If this is too limiting, you will have to use windows tools to replace the versioninfo resource. Details are available on Custom Icons For Win32 Starpacks - The Real Story.
some relevant links
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dndebug/html/msdn_peeringpe.asp
Vince adds - this is great! I particularly like the code to adjust the version/name/etc of a tclkit. I do notice, however, that there seem to be two different 'File version' fields, one of which I can set, but the other of which I can't. Is that true?
AF replies - windows will display the fixedfileinfo version string if it exists instead of the stringfileinfo version string.
27jan04 jcw - If someone is interested in creating a command-line wrapper (at least for the key items), I'd be delighted to include it in the SDX utility to make it easier for developers to adjust it (see [L1 ]).
hanzl The above mentioned inclusion to SDX already happened, see SDX under Windows, Modifying executable resources, tclkit.inf