Selasa, 01 Mei 2012

Nyontek Serial Number Windows dan Office 2007

kali ini saya akan share cara nyontek serial number windows dan office 2007 menggunakan notepad.. sekalian belajar ngetik lah.. hehe yang mao copas aja script di bawah ini menggunakan notepad,, jika sudah, simpan (save as) isi nama dengan format .vbs ,, contoh : ngintip.vbs ,, save as type : all files ... jika sudah taro file ini di komputer sasaran kemudian klik 2x,, serial number akan terlihat.. selamat mencobaaaa :)


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"

 arrSubKeys(2,0) = "Microsoft Office XP"

 arrSubKeys(2,1) = "SOFTWARE\Microsoft\Office\10.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"

 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

 MsgBox("Selesai")

 Function decodeKey(iValues, strProduct)

 Dim arrDPID

 arrDPID = Array()

 For i = 52 to 66

 ReDim Preserve arrDPID( UBound(arrDPID) + 1 )

 arrDPID( UBound(arrDPID) ) = iValues(i)

 Next

 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")

 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) MsgBox strProduct & vbNewLine & vbNewLine & foundKeys(strKey)

 End Function

Tidak ada komentar: