Changer ma clé d'activation WINDOWS

'***************************************************************************
' 
' Script - ChangeKey.vbs
'
' Ce script vous autorisera à changer de clef sur XP /Vista /7
'
' Made by Ro20.
' 
'***************************************************************************

Dim objFS, objFile, objShell
Dim strXPKey, strSystemRoot

Set objFS = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

ON ERROR RESUME NEXT


'On récupère la clef actuelle
oldkey = GetKey(objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))


Dim VOL_PROD_KEY

if Wscript.arguments.count<1 then
VOL_PROD_KEY=InputBox("Instructions:" & vbCr & vbCr & "Ce script vous permettra de changer la clef actuelle de votre Windows." & vbCr & "ATTENTION les clefs OEM ne sont pas valables." & vbCr &  vbCr & "Entrez dans la case ci-dessous votre nouvelle clef: " & vbCr & "(clef actuelle inscrite par défaut) ","Changeur de clef Windows XP/Vista/7",oldkey)
if VOL_PROD_KEY="" then
Wscript.quit
end if
else
VOL_PROD_KEY = Wscript.arguments.Item(0)
end if

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

Newkey = GetKey(objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))


 Wscript.echo "L'inscription de la nouvelle clef " & Newkey & " à réussie..."
end if



if err <> 0 then
strMessage = "Erreur la nouvelle clef " & VOL_PROD_KEY & " est incorrecte !" & vbCr & vbCr & "Veuillez inscrire une clef qui soit valide s.v.p."& vbCr & vbCr & "L'ancienne clef " & oldkey & " n'a pas été modifiée."

result = Msgbox (strMessage,vbExclamation ,"Erreur clef incorrecte !")


' Inspect the return value.
If result = vbRetry Then
   Wscript.quit
 ' Show result using the Echo method.
Else 
    Err.Clear
    Wscript.quit
End If


end if

Next



'--------------------------------------------------------------------------

Function GetKey(rpk)
  Const rpkOffset=52:i=28
  szPossibleChars="BCDFGHJKMPQRTVWXY2346789"
  Do
    dwAccumulator=0 : j=14
    Do
      dwAccumulator=dwAccumulator*256
      dwAccumulator=rpk(j+rpkOffset)+dwAccumulator
      rpk(j+rpkOffset)=(dwAccumulator\24) and 255
      dwAccumulator=dwAccumulator Mod 24
      j=j-1
    Loop While j>=0
    i=i-1 : szProductKey=mid(szPossibleChars,dwAccumulator+1,1)&szProductKey
    if (((29-i) Mod 6)=0) and (i<>-1) then
      i=i-1 : szProductKey="-"&szProductKey
    End If
  Loop While i>=0
  GetKey=szProductKey
End Function