ดูคีย์ xp โดยไม่ต้องลงโปรแกรม

[dimistry]

Copy code นี่ไปวางที่ Notepad แล้ว save เป็นนามสกุล .vbs แล้วก็ run เลยมันจะโชว์ Windows Key ขึ้นมาให้
ป.ล เอาไปใช้ในทางที่ดีนะครับผม

On Error Resume Next

Set WshNetwork = Wscript.CreateObject("Wscript.Network")
Set objFSO = CreateObject("scripting.FileSystemObject")

Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE

strComputer = "."

'**********************************************************************************
'****************************** Windows key ************************************
'**********************************************************************************
'CONST HKEY_LOCAL_MACHINE = &H80000002
CONST SEARCH_KEY = "DigitalProductID"
'Dim arrSubKeys(4,1)
Dim foundKeys
Dim iValues, arrDPID
foundKeys = Array()
iValues = Array()
'arrSubKeys(0,0) = "Microsoft Windows Product Key"
'arrSubKeys(0,1) = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"

' <--------------- Open Registry Key and populate binary data into an array -------------------------->
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
oReg.GetBinaryValue HKLM , "SOFTWARE\Microsoft\Windows NT\CurrentVersion", SEARCH_KEY, arrDPIDBytes
If Not IsNull(arrDPIDBytes) Then
XPKEY = decodeKey(arrDPIDBytes, "Microsoft Windows Product Key")
'MsgBox x
Else
oReg.EnumKey HKLM , "SOFTWARE\Microsoft\Windows NT\CurrentVersion", arrGUIDKeys
If Not IsNull(arrGUIDKeys) Then
For Each GUIDKey In arrGUIDKeys
oReg.GetBinaryValue HKLM , "SOFTWARE\Microsoft\Windows NT\CurrentVersion" & "\" & GUIDKey, SEARCH_KEY, arrDPIDBytes
If Not IsNull(arrDPIDBytes) Then
call decodeKey(arrDPIDBytes, "Microsoft Windows Product Key")
End If
Next
End If
End If
' <----------------------------------------- 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
strKey= UBound(foundKeys)
decodeKey = foundKeys(strKey)

'Wscript.Echo strKey
Wscript.Echo decodeKey

End Function

'**********************************************************************************