Esistono diversi tool di terze parti che permettono il recupero del product key del sistema operativo e di altre applicazioni, tra questi segnalo l'ottimo ProduKey della NirSoft (www.nirsoft.net) scaricabile gratuitamente ed eseguibile senza alcuna installazione.
In questo articolo verrà mostrato come recuperare il product key di Windows tramite uno script VBS.
Il Product Key di Windows è una sequenza di 25 caratteri (lettere e numeri) divisi in 5 gruppi da 5 caratteri ognuno. I caratteri utilizzati all'interno di un product key sono BCDFGHJKMPQRTVWXY2346789 mentre non vengono utilizzati i caratteri AEILNOSUZ015. Il product key è memorizzato all'interno del registro di sistema e codificato in un valore DWORD all'interno della chiave HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId.
Nella decodifica del valore DWORD DigitalProductId bisogna fare attenzione alla versione di Windows infatti, a partire da Windows 8, il metodo di codifica del product key è cambiato.
Lo script che ho creato visualizza le informazioni relative al nome del prodotto, il Product ID e il Product Key permettendo, inoltre, di salvare le informazioni trovate all'interno di un file di testo (.txt).
Di seguito il sorgente dello script VBS
Option Explicit
Dim strComputer, objWMIService, objItem, Caption, colItems
Dim ProductName,ProductID,ProductKey,ProductInfo, Version, Win8Version, WinOlderVersion
Win8Version = "6.2 6.3"
WinOlderVersion ="6.1 6.0 5.2 5.1 5.0"
'Di seguito i valori della stringa CurrentVersion presente all'interno della chiave HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion che indica la versione di Windows
'Windows 8.1 6.3
'Windows Server 2012 R2 6.3
'Windows 8 6.2
'Windows Server 2012 6.2
'Windows 7 6.1
'Windows Server 2008 R2 6.1
'Windows Server 2008 6.0
'Windows Vista 6.0
'Windows Server 2003 R2 5.2
'Windows Server 2003 5.2
'Windows XP 64-Bit Edition 5.2
'Windows XP 5.1
'Windows 2000 5.0
'Crea oggetto wscript.shell
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48)
' in Caption memorizzo la Versione di Windows
For Each objItem in colItems
Caption = objItem.Caption
Next
Dim objshell,path,DigitalID, Result
Set objshell = CreateObject("WScript.Shell")
'Recupero le informazioni dalle chiavi di registro"
DigitalID = objshell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId")
ProductName = "Product Name: " & objshell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName")
ProductID = "Product ID: " & objshell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductID")
Version= objshell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion")
If InStr(Win8Version,Version) Then
'Windows 8 o Windows 8.1
ProductKey = "Product Key: " & GetKeyWindows8(DigitalID)
Else
If InStr(WinOlderVersion,Version) Then
' Windows 7 o antecedente
ProductKey = "Product Key: " & GetKeyWindows7(DigitalID)
Else
msgBox "Versione di Windows non supportata." & vblf &"Il presente Script è stato testato per versioni di Windows comprese tra Windows 2000 e Windows 8.1" , vbOKOnly+vbCritical, "Versione Windows non supportata"
ProductKey ="Product Key: Non Rilevato"
End If
End If
ProductInfo = ProductName & vbNewLine & ProductID & vbNewLine & ProductKey
'Mostra i dati e chiedi se si intende salvare in un file
If vbYes = MsgBox(ProductInfo & vblf & vblf & "Vuoi salvare le informazioni in un file?", vbYesNo + vbQuestion, "Windows Product Key") then
Save ProductInfo
End If
'Convert i valori binari della chiave "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId" in caratteri per Windows 8
Function GetKeyWindows8(Key)
Const KeyOffset = 52
Dim isWin8, Maps, i, j, Current, KeyOutput, Last, keypart1, insert
'Check if OS is Windows 8
isWin8 = (Key(66) \ 6) And 1
Key(66) = (Key(66) And &HF7) Or ((isWin8 And 2) * 4)
i = 24
Maps = "BCDFGHJKMPQRTVWXY2346789"
Do
Current= 0
j = 14
Do
Current = Current* 256
Current = Key(j + KeyOffset) + Current
Key(j + KeyOffset) = (Current \ 24)
Current=Current Mod 24
j = j -1
Loop While j >= 0
i = i -1
KeyOutput = Mid(Maps,Current+ 1, 1) & KeyOutput
Last = Current
Loop While i >= 0
keypart1 = Mid(KeyOutput, 2, Last)
insert = "N"
KeyOutput = Replace(KeyOutput, keypart1, keypart1 & insert, 2, 1, 0)
If Last = 0 Then KeyOutput = insert & KeyOutput
GetKeyWindows8 = Mid(KeyOutput, 1, 5) & "-" & Mid(KeyOutput, 6, 5) & "-" & Mid(KeyOutput, 11, 5) & "-" & Mid(KeyOutput, 16, 5) & "-" & Mid(KeyOutput, 21, 5)
End Function
'Converte i valori binari della chiave "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId" in caratteri per Windows 7
Function GetKeyWindows7(ProductID)
Const KeyOffset = 52
Dim i, Cur, x, Maps
i = 0
Maps = "BCDFGHJKMPQRTVWXY2346789"
Do
Cur = 0
x = 14
i=i+1
Do
Cur = Cur * 256
Cur = ProductID(x + KeyOffset) + Cur
ProductID(x + KeyOffset) = (Cur \ 24) And 255
Cur = Cur Mod 24
x = x -1
Loop While x >= 0
if (i Mod 6) = 0 Then
ProductKey = "-" & ProductKey
i = i + 1
End If
ProductKey = Mid(Maps, Cur + 1, 1) & ProductKey
Loop While i < 29
GetKeyWindows7 = ProductKey
End Function
'Salva i dati in un file
Function Save(Data)
Dim fso, fName, txt,objshell,UserName
Set objshell = CreateObject("wscript.shell")
'Crea un file di testo con nome WindowsKeyInfo.txt, nello stesso percorso del vbs, contenente le informazioni
fName = "WindowsKeyInfo.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set txt = fso.CreateTextFile(fName)
txt.Writeline Data
txt.Close
End Function
Per chi volesse scaricare il file VBS può utilizzare il link di seguito
DOWNLOAD
