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 }