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