PureBasic Forums - English

Code: Select all

' WMI Script - ChangeVLKey.vbs
'
' This script changes the product key on the computer
'
'***************************************************************************

ON ERROR RESUME NEXT


if Wscript.arguments.count<1 then
   Wscript.echo "Script can't run without VolumeProductKey argument"
   Wscript.echo "Correct usage: Cscript ChangeVLKey.vbs ABCDE-FGHIJ-KLMNO-PRSTU-WYQZX"
   Wscript.quit
end if

Dim VOL_PROD_KEY
VOL_PROD_KEY = Wscript.arguments.Item(0)
VOL_PROD_KEY = Replace(VOL_PROD_KEY,"-","") 'remove hyphens if any

for each Obj in GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf ("win32_WindowsProductActivation")

   result = Obj.SetProductKey (VOL_PROD_KEY)

   if err <> 0 then
      WScript.Echo Err.Description, "0x" & Hex(Err.Number)
      Err.Clear
   end if

Next

Code: Select all

Option Explicit

'////////////////////////////////////////////////////////////////////////////
'Windows Product Key and Activation Reset
'Portions of this script were modified from the 
'Microsoft provided script which can be found at:
'http://support.microsoft.com/Default.aspx?kbid=328874
'////////////////////////////////////////////////////////////////////////////

Const CSDKey = "HKLM\SYSTEM\CurrentControlSet\Control\Windows\CSDVersion"
Const WinVerKey = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName"

Dim objShell
Dim intActions, vRetVal, strProdKey

'Create Objects
Set objShell = CreateObject("WScript.Shell")

'Set Run-Time Environment
intActions = 0

'Verify Platform
vRetVal = GetData(WinVerKey, "Unknown")
If vRetVal <> "Microsoft Windows XP" Then CleanEnv -1

'Verify new Product Key
If WScript.Arguments.Count = 0 Then
	strProdKey = InputBox("Enter New Product Key:" & vbCr & _
		"(like: ABCDE-FGHIJ-KLMNO-PRSTU-WYQZX)", "Change Product Key")
	If Trim(strProdKey) = "" Then CleanEnv -2
Else
	strProdKey = WScript.Arguments.Item(0)
End If
strProdKey = UCase(Trim(Replace(strProdKey, "-", "")))
If Len(strProdKey) <> 25 Then CleanEnv -2

'Verify Service Pack Level
vRetVal = GetData(CSDKey, -1)

'Reset Product Key
'Delete SP1 and greater registry information
If vRetVal => 256 Then DelOOBEKey

'Use WMI to reactivate
SetProductKey

'Exit
CleanEnv intActions
'----------------------------------------------------------
Sub CleanEnv(intExitCode)
	On Error Resume Next
	
	Set objShell = Nothing
	
	WScript.Quit intExitCode
End Sub

Function GetData(strRegKey, vDefault)
	Dim vReturn
	
	On Error Resume Next
	vReturn = objShell.RegRead(strRegKey)
	If Err.number <> 0 Then
		Err.Clear
		GetData = vDefault
	Else
		GetData = vReturn
	End If
End Function

Sub DelOOBEKey()
	On Error Resume Next
	
	objShell.RegDelete "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\WPAEvents\OOBETimer"
	If Err.number <> 0 Then Err.Clear
End Sub

Sub SetProductKey()
	Dim objProd, vResult
	
	For Each objProd In GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf ("win32_WindowsProductActivation")
		vResult = objProd.SetProductKey(strProdKey)
	
		If Err.Number <> 0 Then
			intActions = Err.Number
			Err.Clear
		End If
	
	Next
	
	Set objProd = Nothing
End Sub

'*************************************************
'Return Values:
'
'	-1		=	Incorrect Windows Version
'	-2		=	Incorrect Product Key or No Product Key supplied
'	 0		= 	Script completed as expected
'	##		= 	WMI Error.  Task failed.
'*************************************************