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 ]).