Posted to tcl by patthoyts at Tue Apr 10 21:06:29 GMT 2007view pretty

# Constructed from the algorithm posted at
#   http://geekswithblogs.net/willemf/archive/2006/04/23/76125.aspx
#   http://www.chuckdelong.us/MSProdKey.html
#
# Reads your product key from the registry

package require registry
package require base64
package require base32

proc string'reverse str {
    set res {}
    set i [string length $str]
    while {$i > 0} {append res [string index $str [incr i -1]]}
    set res
}

proc DecodeKeyData {data} {
    variable Map {B C D F G H J K M P Q R T V W X Y 2 3 4 6 7 8 9}
    set r ""
    binary scan $data @52c15 bytes_tmp
    set bytes {}
    foreach b $bytes_tmp {
        lappend bytes [expr {$b & 0xff}]
    }
    set i [llength $bytes]
    for {set i 28} {$i >= 0} {incr i -1} {
        if {(($i + 1) % 6) == 0} { append r - ; continue}
        set hn 0
        for {set n 14} {$n >= 0} {incr n -1} {
            set v [expr {($hn << 8) | [lindex $bytes $n]}]
            lset bytes $n [expr {$v / 24}]
            set hn [expr {$v % 24}]
        }
        append r [lindex $Map $hn]
    }
    return [string'reverse $r]
}

proc Main {} {
    set path {HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion}
    set data [registry get $path DigitalProductId]
    puts [DecodeKeyData $data]
    return 0
}

if {!$tcl_interactive} {
    set r [catch [linsert $argv 0 Main] err]
    if {$r} {puts $::errorCode}
    exit $r
}