INFOSWINDOWSCLEV02.VBS

'*_____________________________________________________________________
'*
'* Retrouver la clé d'activation de Windows local
'* en claire séquence de 25 lettres et chiffres
'*
'* Une partie du code d’après l’auteur à cette adresse www.korben.info
'* Ajouter quelques modifications personnelles à se code
'*____________________________________________________________________
'*
'* Résultat de la conversion binaire de votre clé Windows
'* Le résultat de la conversion aboutit dans un fichier texte
'* Sous cette forme appelé Exemple: Clé Windows PC-DE-GÉRARD.txt
'*___________________________________________________________________
'*
'*
'strComputer = "."
'*
Set oShell = CreateObject("wscript.Shell")
Set env = oShell.environment("Process")
strComputer = env.Item("Computername")
'*
'* WMI Connexion à l'objet (strComputer)
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
'* WMI Query to the Win32_OperatingSystem
Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
'*
Dim Digits(24)
Digits(0) = "B": Digits(1) = "C": Digits(2) = "D": Digits(3) = "F":
Digits(4) = "G": Digits(5) = "H": Digits(6) = "J": Digits(7) = "K":
Digits(8) = "M": Digits(9) = "P": Digits(10) = "Q": Digits(11) = "R":
Digits(12) = "T": Digits(13) = "V": Digits(14) = "W": Digits(15) = "X":
Digits(16) = "Y": Digits(17) = "2": Digits(18) = "3": Digits(19) = "4":
Digits(20) = "6": Digits(21) = "7": Digits(22) = "8": Digits(23) = "9"
Dim HexBuf(100), HexDigitalPID(15)
'*
'* WMI Connexion à l'objet (strComputer)
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
'*
'* La clé du produit Windows codée en Binaire se trouve à l'adresse ci-dessous. Connexion à l'objet ("DigitalProductId")
'*
Const HKEY_LOCAL_MACHINE = &H80000002
objWMIService.GetBinaryValue &H80000002, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\", "DigitalProductId", HexBuf
'*
StartOffset = 52: EndOffset = 67
For I = StartOffset To EndOffset
HexDigitalPID(I - StartOffset) = HexBuf(I)
Next
'* Convertir la clé du produit Windows codée en Binaire en une clé d'activations
dLen = 29: sLen = 15
KEYSTRING = ""
For I = dLen - 1 To 0 Step -1
If ((I + 1) Mod 6) = 0 Then
KEYSTRING = KEYSTRING & "-"
Else
HN = 0
For N = (sLen - 1) To 0 Step -1
Value = ((HN * 2 ^ 8) Or HexDigitalPID(N))
HexDigitalPID(N) = Value \ 24
HN = (Value Mod 24)
Next
KEYSTRING = KEYSTRING & Digits(HN)
End If
Next
KEYSTRING2 = StrReverse(KEYSTRING)
'*
For Each objOperatingSystem In colOperatingSystems
MSG = ""
MSG = MSG & "____________________________________________________________________________________" & vbCrLf & vbCrLf
MSG = MSG & "    INFORMATIONS GÉNÉRALES DE WINDOWS INSTALLÉ SUR VOTRE SYSTÈME" & vbCrLf
MSG = MSG & "____________________________________________________________________________________" & vbCrLf & vbCrLf
MSG = MSG & "Système d'Exploitation : " & objOperatingSystem.Caption & " Version " & objOperatingSystem.Version & vbCrLf
SP = objOperatingSystem.ServicePackMajorVersion
SPMINV = objOperatingSystem.ServicePackMinorVersion
If (SP > 0) Then
MSG = MSG & "Le Service Pack " & SP & "." & SPMINV & " est installé." & vbCrLf
End If
MSG = MSG & "Cet OS est installé dans le répertoire  " & objOperatingSystem.WindowsDirectory & objOperatingSystem.BootDevice & vbCrLf
MSG = MSG & "Depuis cette date le : " & "( " & Claire(objOperatingSystem.InstallDate) & " )" & vbCrLf
'*
'* WMI Connexion à l'objet (strComputer)
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSettings = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
For Each objComputer In colSettings
MSG = MSG & "____________________________________________________________________________________" & vbCrLf & vbCrLf
MSG = MSG & "Convertir la clé du produit Windows codée en Binaire en une clé d'activations." & vbCrLf & vbCrLf
MSG = MSG & "          ( Voici le résultat de la conversion binaire de votre clé Windows )" & vbCrLf
MSG = MSG & "____________________________________________________________________________________" & vbCrLf & vbCrLf
MSG = MSG & "Nom de l'ordinateur : " & "( " & objComputer.Name & " )" & " est un " & objComputer.Model _
& " fabriqué par " & objComputer.Manufacturer & vbCrLf & vbCrLf
MSG = MSG & "Clé séquence de 25 lettres et chiffres : " & KEYSTRING2 & vbCrLf & vbCrLf
MSG = MSG & "Numéro de Série : " & objOperatingSystem.SerialNumber & vbCrLf
MSG = MSG & "____________________________________________________________________________________" & vbCrLf & vbCrLf
MSG = MSG & "Copyright © " & "( " & objComputer.Name & " - " & Claire(objOperatingSystem.InstallDate) & " )" & vbCrLf
MSG = MSG & vbCrLf & vbCrLf 
Next
Next
'*
'* Ici préparation et création du fichier texte
Set Fso = CreateObject("Scripting.FileSystemObject")
'* Détermine si le fichier texte existe déjà ou s'il doit être  créé
If Not Fso.FileExists("Clé Windows " & strComputer & ".txt") Then
Set BlocNotes = Fso.CreateTextFile("Clé Windows " & strComputer & ".txt", True)
Else
Set BlocNotes = Fso.OpenTextFile("Clé Windows " & strComputer & ".txt", 2, True)
End If
'*
'* Ici ont lit toutes les lignes MSG et ont les écrit ligne
'* par ligne dans un fichier texte avec le Bloc-notes.
'* Sous cette forme Exemple: Clé Windows PC-DE-GÉRARD.txt
'*
BlocNotes.write MSG
'*
'* Ici affichage de la console avec les résultats MSG lu
'*
Wscript.echo MSG
'*
Function Claire(Temps)
Debut = Left(Temps, 8)
An = Left(Debut, 4)
Mois = Mid(Debut, 5, 2)
Jour = Right(Debut, 2)
Claire = CStr(Jour) & "/" & CStr(Mois) & "/" & CStr(An)
End Function