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 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 -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 -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
 }

----

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.

output:

 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 values to the file but here is a list of the ones normally used.

Comments
CompanyName
FileDescription
FileVersion
InternalName
LegalCopyright
LegalTrademarks
OriginalFilename
PrivateBuild
ProductName 
ProductVersion
SpecialBuild

in addition i use CodePage and Language

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.

----

some relevant links

http://msdn.microsoft.com/library/en-us/winui/winui/windowsuserinterface/resources/versioninformation/versioninformationreference/versioninformationstructures/stringfileinfo.asp

http://msdn.microsoft.com/library/en-us/winui/winui/windowsuserinterface/resources/versioninformation/versioninformationreference/versioninformationstructures/stringtable.asp

http://msdn.microsoft.com/library/en-us/winui/winui/windowsuserinterface/resources/versioninformation/versioninformationreference/versioninformationstructures/string.asp