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

  1. # Constructed from the algorithm posted at
  2. # http://geekswithblogs.net/willemf/archive/2006/04/23/76125.aspx
  3. # http://www.chuckdelong.us/MSProdKey.html
  4. #
  5. # Reads your product key from the registry
  6.  
  7. package require registry
  8. package require base64
  9. package require base32
  10.  
  11. proc string'reverse str {
  12. set res {}
  13. set i [string length $str]
  14. while {$i > 0} {append res [string index $str [incr i -1]]}
  15. set res
  16. }
  17.  
  18. proc DecodeKeyData {data} {
  19. 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}
  20. set r ""
  21. binary scan $data @52c15 bytes_tmp
  22. set bytes {}
  23. foreach b $bytes_tmp {
  24. lappend bytes [expr {$b & 0xff}]
  25. }
  26. set i [llength $bytes]
  27. for {set i 28} {$i >= 0} {incr i -1} {
  28. if {(($i + 1) % 6) == 0} { append r - ; continue}
  29. set hn 0
  30. for {set n 14} {$n >= 0} {incr n -1} {
  31. set v [expr {($hn << 8) | [lindex $bytes $n]}]
  32. lset bytes $n [expr {$v / 24}]
  33. set hn [expr {$v % 24}]
  34. }
  35. append r [lindex $Map $hn]
  36. }
  37. return [string'reverse $r]
  38. }
  39.  
  40. proc Main {} {
  41. set path {HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion}
  42. set data [registry get $path DigitalProductId]
  43. puts [DecodeKeyData $data]
  44. return 0
  45. }
  46.  
  47. if {!$tcl_interactive} {
  48. set r [catch [linsert $argv 0 Main] err]
  49. if {$r} {puts $::errorCode}
  50. exit $r
  51. }