Visualiser vos clés Windows

Accueil / Systèmes d'exploitation et logiciels

Répondre

Actualiser

Rechercher

S'inscrire ou s'identifier

FAQ

Pages : 1

Par PIERRE02
Le 15/03/2015 à 13:18:08

Inscription : le 08/02/2012

Visualiser vos clés Windows

Nul besoin d'utiliser un quelconque programme ...
Il vous suffira de créer un petit fichier avec par exemple ce nom : Clés_Windows.vbs
et qui contiendra ce texte :

* Attention si vous avez des problèmes remplacer l' EMOTICON JAUNE par le caractère parenthèse fermante *

Vous pourrez vous amuser à le modifier ...

--------------
Const HKLM = &H80000002
'Install Date
Computer = "."
Set objWMIService = GetObject("winmgmts:\\" & Computer & "\root\cimv2" )
Set Obj = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem"

dim InsDate
For Each item in Obj
InsDate = item.InstallDate
' Gather Operating System Information
Caption = Item.Caption
OSArchitecture = Item.OSArchitecture
CSDVersion = Item.CSDVersion
Version = Item.Version
Next
dim NewDate
NewDate = mid(InsDate,7,2) & "/" & mid(InsDate,5,2) & "/" & mid(InsDate,1,4)
NewDate = NewDate & " " & mid(InsDate,9,2) & ":" & mid(InsDate,11,2) & ":" & mid(InsDate,13,2)
QueryWindowsProductKeys()
'wscript.echo 'vbCrLf & "Office Keys" & vbCrLf
QueryOfficeProductKeys()
Function DecodeProductKey(arrKey, intKeyOffset)
If Not IsArray(arrKey) Then Exit Function
intIsWin8 = BitShiftRight(arrKey(intKeyOffset + 14),3) And 1
arrKey(intKeyOffset + 14) = arrKey(intKeyOffset + 14) And 247 Or BitShiftLeft(intIsWin8 And 2,2)
i = 24
strChars = "BCDFGHJKMPQRTVWXY2346789"
strKeyOutput = ""
While i > -1
intCur = 0
intX = 14
While intX > -1
intCur = BitShiftLeft(intCur,8)
intCur = arrKey(intX + intKeyOffset) + intCur
arrKey(intX + intKeyOffset) = Int(intCur / 24)
intCur = intCur Mod 24
intX = intX - 1
Wend
i = i - 1
strKeyOutput = Mid(strChars,intCur + 1,1) & strKeyOutput
intLast = intCur
Wend
If intIsWin8 = 1 Then
strKeyOutput = Mid(strKeyOutput,2,intLast) & "N" & Right(strKeyOutput,Len(strKeyOutput) - (intLast + 1))
End If
strKeyGUIDOutput = Mid(strKeyOutput,1,5) & "-" & Mid(strKeyOutput,6,5) & "-" & Mid(strKeyOutput,11,5) & "-" & Mid(strKeyOutput,16,5) & "-" & Mid(strKeyOutput,21,5)
DecodeProductKey = strKeyGUIDOutput
End Function
Function RegReadBinary(strRegPath,strRegValue)
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv"

objReg.GetBinaryValue HKLM,strRegPath,strRegValue,arrRegBinaryData
RegReadBinary = arrRegBinaryData
Set objReg = Nothing
End Function
Function BitShiftLeft(intValue,intShift)
BitShiftLeft = intValue * 2 ^ intShift
End Function
Function BitShiftRight(intValue,intShift)
BitShiftRight = Int(intValue / (2 ^ intShift))
End Function
Function QueryOfficeProductKeys()
strBaseKey = "SOFTWARE\"
strOfficeKey = strBaseKey & "Microsoft\Office"
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv"

objReg.EnumKey HKLM, strOfficeKey, arrOfficeVersionSubKeys
intProductCount = 1
If IsArray(arrOfficeVersionSubKeys) Then
For Each strOfficeVersionKey In arrOfficeVersionSubKeys
Select Case strOfficeVersionKey
Case "11.0"
CheckOfficeKey strOfficeKey & "\11.0\Registration",52,intProductCount
Case "12.0"
CheckOfficeKey strOfficeKey & "\12.0\Registration",52,intProductCount
Case "14.0"
CheckOfficeKey strOfficeKey & "\14.0\Registration",808,intProductCount
Case "15.0"
CheckOfficeKey strOfficeKey & "\15.0\Registration",808,intProductCount
End Select
Next
End If
strBaseKey = "SOFTWARE\Wow6432Node\"
strOfficeKey = strBaseKey & "Microsoft\Office"
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv"

objReg.EnumKey HKLM, strOfficeKey, arrOfficeVersionSubKeys
intProductCount = 1
If IsArray(arrOfficeVersionSubKeys) Then
For Each strOfficeVersionKey In arrOfficeVersionSubKeys
Select Case strOfficeVersionKey
Case "11.0"
CheckOfficeKey strOfficeKey & "\11.0\Registration",52,intProductCount
Case "12.0"
CheckOfficeKey strOfficeKey & "\12.0\Registration",52,intProductCount
Case "14.0"
CheckOfficeKey strOfficeKey & "\14.0\Registration",808,intProductCount
Case "15.0"
CheckOfficeKey strOfficeKey & "\15.0\Registration",808,intProductCount
End Select
Next
End If
End Function
'Office Product Key
Sub CheckOfficeKey(strRegPath,intKeyOffset,intProductCount)
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv"

objReg.EnumKey HKLM, strRegPath, arrOfficeRegistrations
If IsArray(arrOfficeRegistrations) Then
For Each strOfficeRegistration In arrOfficeRegistrations
objReg.GetStringValue HKLM,strRegPath & "\" & strOfficeRegistration,"ConvertToEdition",strOfficeEdition
objReg.GetBinaryValue HKLM,strRegPath & "\" & strOfficeRegistration,"DigitalProductID",arrProductID
If strOfficeEdition <> "" And IsArray(arrProductID) Then
msgbox "Produit : " & strOfficeEdition & Chr(10) & vbCrLf & "Clé : " & DecodeProductKey(arrProductID,intKeyOffset)
intProductCount = intProductCount +1
End If
Next
End If
End Sub
'Windows Product Key
Sub QueryWindowsProductKeys()
strWinKey = CheckWindowsKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion","DigitalProductId",52)
If strWinKey <> "" Then
msgbox "Produit : " & Caption & vbCrLf & "Version : " & Version & " (" & OSArchitecture & "

" & vbCrLf & Chr(10) & _
"Date de l'installation : " & NewDate & vbCrLf & Chr(10) & _
"Clé : " & strWinKey
Exit Sub
End If
strWinKey = CheckWindowsKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion","DigitalProductId4",808)
If strWinKey <> "" Then
msgbox "Produit : " & Caption & " " & Version & " (" & OSArchitecture & "

" & vbCrLf & Chr(10) & _
"Date de l'installation : " & NewDate & vbCrLf & Chr(10) & _
"Clé : " & strWinKey
Exit Sub
End If
strWinKey = CheckWindowsKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion\DefaultProductClé","DigitalProductId",52)
If strWinKey <> "" Then
msgbox "Produit : " & Caption & " " & Version & " (" & OSArchitecture & "

" & vbCrLf & Chr(10) & _
"Date de l'installation : " & NewDate & vbCrLf & Chr(10) & _
"Clé : " & strWinKey
Exit Sub
End If
strWinKey = CheckWindowsKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion\DefaultProductClé","DigitalProductId4",808)
If strWinKey <> "" Then
msgbox "Produit : " & Caption & " " & Version & " (" & OSArchitecture & "

" & vbCrLf & Chr(10) & _
"Date de l'installation : " & NewDate & vbCrLf & Chr(10) & _
"Clé : " & strWinKey
Exit Sub
End If
End Sub
Function CheckWindowsKey(strRegPath,strRegValue,intKeyOffset)
strWinKey = DecodeProductKey(RegReadBinary(strRegPath,strRegValue),intKeyOffset)
If strWinKey <> "BBBBB-BBBBB-BBBBB-BBBBB-BBBBB" And strWinKey <> "" Then
CheckWindowsKey = strWinKey
Else
CheckWindowsKey = ""
End If
End Function
Function RegReadBinary(strRegPath,strRegValue)
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv"

objReg.GetBinaryValue HKLM,strRegPath,strRegValue,arrRegBinaryData
RegReadBinary = arrRegBinaryData
Set objReg = Nothing
End Function
Function OsArch()
Set objShell = WScript.CreateObject("WScript.Shell"

If objShell.ExpandEnvironmentStrings("%ProgramFiles(x86)%"

= "%ProgramFiles(x86)%" Then
OsArch = "x86"
Else
OsArch = "x64"
End If
Set objShell = Nothing
End Function

Pages : 1

Retour sur le forum Systèmes d'exploitation et logiciels

Identification

Nom d'utilisateur

Mot de passe

Recevez vos identifiants par e-mail si vous les avez oubliés.

Inscrivez-vous si vous n'êtes pas encore membre de TousLesDrivers.com.

Répondre au message Visualiser vos clés Windows

Message

Insérer des smileys

Plus de smileys

Lien N°1 / Lien N°2 / Puce / Gras / Italique / Souligné / Barré

Merci de lire la FAQ avant d'ajouter un message.