getkeys

<head>
 <title>Microsoft Product Key Retrieval</title>
 <hta:application
  applicationname="MSKeyRetrieval"
  caption="MSKeyRetrieval"
  contextmenu="no"
  maximizebutton="no"
  minimizebutton="yes"
  navigable="yes"
  showintaskbar="yes"
  singleinstance="yes"
  sysmenu="yes"
 >
 </head>
 <script language="VBScript">
 Const HKEY_LOCAL_MACHINE = &H80000002
 Const SEARCH_KEY = "DigitalProductID"
 Dim foundKeys
 Dim iValues
 Dim arrDPID
 Dim strHTML
 Dim arrSubKeys(4,1)
 foundKeys = Array()
 iValues = Array()
 arrSubKeys(0,0) = "Microsoft Windows"
 arrSubKeys(0,1) = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
 arrSubKeys(2,0) = "Microsoft Office 2010"
 arrSubKeys(2,1) = "SOFTWARE\Microsoft\Office\14.0\Registration"
 arrSubKeys(1,0) = "Microsoft Office 2003"
 arrSubKeys(1,1) = "SOFTWARE\Microsoft\Office\11.0\Registration"
 arrSubKeys(3,0) = "Microsoft Office 2007"
 arrSubKeys(3,1) = "SOFTWARE\Microsoft\Office\12.0\Registration"
 arrSubKeys(4,0) = "Microsoft Exchange Product Key"
 arrSubKeys(4,1) = "SOFTWARE\Microsoft\Exchange\Setup"
 Sub window_onload
  ' <--------------- Set window Size --------------->
         strComputer = "."
         Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
         Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
         For Each objItem in colItems
             intHorizontal = objItem.ScreenWidth
             intVertical = objItem.ScreenHeight
         Next
         intLeft = (intHorizontal - 500) / 2
         intTop = (intVertical - 600) / 2
         window.resizeTo 500,600
  '       window.moveTo intLeft, intTop

  ' <--------------- Open Registry Key and populate binary data into an array -------------------------->
  strComputer = "."
  Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
  For x = LBound(arrSubKeys, 1) To UBound(arrSubKeys, 1)
   oReg.GetBinaryValue HKEY_LOCAL_MACHINE, arrSubKeys(x,1), SEARCH_KEY, arrDPIDBytes
   If Not IsNull(arrDPIDBytes) Then
    call decodeKey(arrDPIDBytes, arrSubKeys(x,0))
   Else
    oReg.EnumKey HKEY_LOCAL_MACHINE, arrSubKeys(x,1), arrGUIDKeys
    If Not IsNull(arrGUIDKeys) Then
     For Each GUIDKey In arrGUIDKeys
      oReg.GetBinaryValue HKEY_LOCAL_MACHINE, arrSubKeys(x,1) & "\" & GUIDKey, SEARCH_KEY, arrDPIDBytes
      If Not IsNull(arrDPIDBytes) Then
       call decodeKey(arrDPIDBytes, arrSubKeys(x,0))
      End If
     Next
    End If
   End If
  Next
  If IsNull(foundkeys) Then
   DataArea.InnerHTML = "No Keys Found"
  Else
   DataArea.InnerHTML = strHTML
  End If
 End Sub
 ' <----------------------- Return the Product Key ------------------------>
 Function decodeKey(iValues, strProduct)
  Dim arrDPID
  arrDPID = Array()

  ' <--------------- extract bytes 52-66 of the DPID -------------------------->
  For i = 52 to 66
   ReDim Preserve arrDPID( UBound(arrDPID) + 1 )
   arrDPID( UBound(arrDPID) ) = iValues(i)
  Next
  ' <--------------- Create an array to hold the valid characters for a microsoft Product Key -------------------------->
  Dim arrChars
  arrChars = Array("B","C","D","F","G","H","J","K","M","P","Q","R","T","V","W","X","Y","2","3","4","6","7","8","9")

  ' <--------------- The clever bit !!! (decode the base24 encoded binary data)-------------------------->
  For i = 24 To 0 Step -1
   k = 0
   For j = 14 To 0 Step -1
    k = k * 256 Xor arrDPID(j)
    arrDPID(j) = Int(k / 24)
    k = k Mod 24
   Next
   strProductKey = arrChars(k) & strProductKey
   If i Mod 5 = 0 And i <> 0 Then strProductKey = "-" & strProductKey
  Next
  ReDim Preserve foundKeys( UBound(foundKeys) + 1 )
  foundKeys( UBound(foundKeys) ) = strProductKey
  If strProduct = "Microsoft Windows" Then
   strComputer = "."
   Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
   Set colOperatingSystems = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")
   For Each objOperatingSystem in colOperatingSystems
    strOS = objOperatingSystem.Caption
   Next
   strHTML = strHTML & "<h3>" & strOS & "</h3>" & _
     "<h4>" & strProductKey & "</h4><br /><hr /><br />"
  Else
   strHTML = strHTML & "<h3>" & strProduct & "</h3>" & _
     "<h4>" & strProductKey & "</h4><br /><hr /><br />"
  End If
 End Function

 </script>
 <body>
 <div id="header" style="color:#ffffff; height:100px; text-align:center; font-family:Tahoma;
   filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#0011aa', EndColorStr='#ffffff')">
   <br /><h2>Retrieved Microsoft Product Keys</h2>
 </div><hr />
 <span id="DataArea"></span>
 <br />
 <div id="Print" style="text-align:center;"><input type="button" value="Print" Onclick="print()" ;></div>
 </body>
 </html>