AF 10-07-03


 proc readStringInfo {file array} {
    upvar $array ret
    array set ret {}
    set fh [open $file r]
    fconfigure $fh -encoding unicode -eofchar {}
    set data [read $fh]
    close $fh

    set s [string first "StringFileInfo\000" $data]
    if {$s < 0} return
    incr s -3

    if {![regexp {(.)\000(.)StringFileInfo\000(.)\000(.)(....)(....)\000} [string range $data $s end] --> len type len2 type2 lang code]} {
        return
    }
    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 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} return
    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" ; continue }
        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 }
 }

 if 0 {
 readStringInfo $argv test
 array set test [list FileDescription "HI! I'm a new file description"]
 writeStringInfo $argv test
 }

 readStringInfo $argv test

 parray test

----