Un petit VbScript pour changer la clef XP /Vista /7
et qui vous donne en plus la clef actuelle.
Recopier le code ci-dessous et sauvegarder comme ChangeKey.vbs
'***************************************************************************
'
' 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
