<html>
<head>
<title>Windows Key</title>
<HTA:APPLICATION
APPLICATIONNAME="Windows Key"
SCROLL="no"
SINGLEINSTANCE="yes"
WINDOWSTATE="normal"
contextMenu="no"
border="dialog"
/>
</head>
<script language="VBScript">
Function ConvertToKey(regKey)
Const KeyOffset = 52
isWin8 = (regKey(66) \ 6) And 1
regKey(66) = (regKey(66) And &HF7) Or ((isWin8 And 2) * 4)
j = 24
Chars = "BCDFGHJKMPQRTVWXY2346789"
Do
Cur = 0
y = 14
Do
Cur = Cur * 256
Cur = regKey(y + KeyOffset) + Cur
regKey(y + KeyOffset) = (Cur \ 24)
Cur = Cur Mod 24
y = y -1
Loop While y >= 0
j = j -1
winKeyOutput = Mid(Chars, Cur + 1, 1) & winKeyOutput
Last = Cur
Loop While j >= 0
If (isWin8 = 1) Then
keypart1 = Mid(winKeyOutput, 2, Last)
insert = "N"
winKeyOutput = Replace(winKeyOutput, keypart1, keypart1 & insert, 2, 1, 0)
If Last = 0 Then winKeyOutput = insert & winKeyOutput
End If
a = Mid(winKeyOutput, 1, 5)
b = Mid(winKeyOutput, 6, 5)
c = Mid(winKeyOutput, 11, 5)
d = Mid(winKeyOutput, 16, 5)
e = Mid(winKeyOutput, 21, 5)
ConvertToKey = a & "-" & b & "-" & c & "-" & d & "-" & e
End Function
Function GetRegValue(regKey, param, aType)
Set WshShell = CreateObject("WScript.Shell")
Set Exec = WshShell.Exec( "reg query """ & regKey & """ /v "¶m&" /reg:"& aType )
Set TextStream = Exec.StdOut
Str = ""
While Not TextStream.AtEndOfStream
Str = Str & Trim(TextStream.ReadLine()) & ";"
Wend
On Error Resume Next
Str = Split(Split(Str,";")(2)," ")(8)
If Err Then
GetRegValue = Null
Else
Dim Value
ReDim Value(Len(Str)\2)
Dim i
For i = 1 To Len(Str) Step 2
Value(i\2) = "&H" & Mid(Str,i,2)
Next
GetRegValue = Value
End If
End Function
Sub TestSub
window.resizeTo 330,130
Dim objReg, strIEVer, strWMIQuery, ProductName,DigitalProductId,ProductID,ProductKey
Const HKLM = &H80000002
strWMIQuery = "winmgmts:{impersonationLevel=impersonate}!//./root/default:StdRegProv"
regKey = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
Set objReg = GetObject( strWMIQuery )
objReg.GetStringValue HKLM, "SOFTWARE\Microsoft\Internet Explorer", "Version", strIEVer
objReg.GetStringValue HKLM, regKey, "ProductName", ProductName
regKey = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion"
DigitalProductId = GetRegValue(regKey,"DigitalProductId",32)
'ProductName = GetRegValue(regKey,"ProductName",32)
if VarType(DigitalProductId) = 1 Then
DigitalProductId = GetRegValue(regKey,"DigitalProductId",64)
'ProductName = GetRegValue(regKey,"ProductName",64)
End If
pKey.value = ConvertToKey(DigitalProductId)
pName.value = ProductName
End Sub
</script>
<body onLoad="TestSub()">
<input type="text" id="pKey" name="key_value" size="40">
<input type="text" id="pName" name="key_value" size="40">
</body>
</html>