[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.

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

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

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 [http://groups.google.com/groups?dq=&hl=en&lr=&ie=UTF-8&oe=UTF-8&threadm=64262059.0401262034.792f85b4%40posting.google.com]).
----
======
##############################

I supose its better to parse EXE object table correctly. IMHO its better than scan 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:
  IT IS AN EXAMPLE. HERE IS NO ERROR CHECKING, IT IS NOT OPTIMIZED AND IT IS INCOMPLETE but it works :)
  USE IT ON YOUR OWN RISC.

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

  set var [read_data $fn $off 4]
  scan $var "%c%c%c%c" a b c d

  scan [format "%.2X%.2X%.2X%.2X" $d $c $b $a] "%x" ret

  return $ret
}
########################################################


proc read_w { fn off } {

  set var [read_data $fn $off 2]
  
  scan $var "%c%c" a b
  scan [format "%.2X%.2X" $b $a] "%x" 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} {

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

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

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

          ##### 4 #####
          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 {[format "%X" $mag_stamp] ne [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
}

###############
#  U S A G E  #
###############

set fn {C:\WINDOWS\winhlp32.exe}
# or
# set fn {C:\WINDOWS\twain.dll}

puts [format ">%s<" [GetExeVersion $fn]]
======
----
!!!!!!
%| [Category Windows] |%
!!!!!!