Posted to tcl by patthoyts at Tue Apr 10 21:06:29 GMT 2007view raw
- # 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
- }