'***************************************************************************
'
' Windows XP,Vista,7 CD-Key Changer v1.2
' This script can change the product key on:
' Windows XP SP1-SP3, Windows Vista and Windows 7.
'
'***************************************************************************

'-> Check for administrative rights.
 Dim Wmi :Set Wmi = GetObject("winmgmts:\\.\root\cimv2")
 Dim A, Obj, R
 Set reg = GetObject("winmgmts://./root/default:StdRegProv")
   rc = reg.GetStringValue(&h80000003, "S-1-5-19\Environment", "TEMP", val)
  If rc = 5 Then
  If WScript.Arguments.Count = 0 Then
   CreateObject("Shell.Application").ShellExecute "wscript.exe" _
    , Chr(34) & WScript.ScriptFullName & Chr(34) & " /relaunch", "", "runas", 1
   WScript.Quit 0
  Else
   Msgbox "Cannot acquire admin privileges.",4128,"Admin Access denied"
   WScript.Quit 1
  End If
  Else
'-> Run code here when administrative rights.
   Input()
   ConfirmChange(A)
  End If
   Function Input()
    Input=InputBox( _
     "Type In The New Key In This Format G0NO6-12345-54321-ABCDE-ZYXWV.","Windows XP,Vista,7 CD-Key Changer")
    If Len(Input) = 29 Then A = Input
     If Not Len(Input) = 29 Then
      If MsgBox( _
      "Does Not Appear To Have 29 Characters : " & Len(Input) & vbCrLf & _
      "Would You Like To Redo Your Input, Yes To Redo," & vbCrLf & _
      "No To Exit And Do Nothing?",4132,"Redo or Quit") = 6 Then
      Input()
     Else
      WScript.Quit
     End If
    End If
   End Function
   Function ConfirmChange(K)
    Dim Os
    If MsgBox( _
     "Did you want to continue with changing the OS Product Key?" & vbCrLf & _
     "Yes to continue and change the OS Product Key, No to exit" & vbCrLf & _
     "and make no changes to the OS Product Key",4132,"Continue or Stop") = 6 Then
     For Each Obj In Wmi.ExecQuery("SELECT * FROM win32_OperatingSystem")
       Os = Obj.Caption
      Next
      If InStr(1,Os,"XP",1) Then OsX(Replace(K,"-",""))
      If InStr(1,Os,"7",1) Or InStr(1,Os,"Vista",1)Then V7(K)
    Else
     WScript.Quit
    End If
   End Function
   Function OsX(K)
    On Error Resume Next
     For Each Obj In Wmi.ExecQuery("SELECT * FROM win32_WindowsProductActivation")
      R = Obj.SetProductKey(K)
      If Err = 0 Then MsgBox "Key Has Been Change",4128,"Success"
      If Err <> 0 Then MsgBox "An Error entering the new OS Product Key" & vbCrLf & _
      "Key Enter : " & K & vbCrLf & "Verify that this is the correct or valid" & vbCrLf & _
      "OS Product Key.",4128,"Key Error"
     Next
   End Function
   Function V7(K)
    For Each Obj In Wmi.ExecQuery("SELECT * FROM SoftwareLicensingService")
     R = Obj.InstallProductKey(K)
     If Err = 0 Then MsgBox "Key Has Been Change",4128,"Success"
     If Err <> 0 Then MsgBox "An Error entering the new OS Product Key" & vbCrLf & _
      "Key Enter : " & K & vbCrLf & "Verify that this is the correct or valid" & vbCrLf & _
      "OS Product Key.",4128,"Key Error"
    Next
   End Function