'ProductKey.vbs - Windowsのプロダクトキー表示プログラム ' (c) 2017 onlyneat.com ' Windows XPなどのプロダクトキーを表示し、テキストファイルに保存する Const HKLM = &H80000002 Set WshShell = CreateObject("WScript.Shell") 'コンピュータ名を得る strComputerName = CreateObject("WScript.Network").ComputerName 'レジストリ Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion" '製品名 objReg.GetStringValue HKLM, strKeyPath, "ProductName", strProductName 'サービスパック objReg.GetStringValue HKLM, strKeyPath, "CSDVersion", strCSDVersion 'ビルド objReg.GetStringValue HKLM, strKeyPath, "BuildLab", strBuildLab 'プロダクトID objReg.GetStringValue HKLM, strKeyPath, "ProductId", strProductId 'プロダクトキー objReg.GetBinaryValue HKLM, strKeyPath, "DigitalProductId", Key strProductKey = ConvertToKey(key) 'インストール日時 objReg.GetDWordValue HKLM, strKeyPath, "InstallDate", InstallDate InstallDate = DateAdd("s", InstallDate, "1970-01-01 00:00:00") 'タイムゾーン objReg.GetDWordValue HKLM, "SYSTEM\CurrentControlSet\Control\TimeZoneInformation", "ActiveTimeBias", TZOffset InstallDate = DateAdd("n", - TZOffset, InstallDate) strInstallDate = FormatDateTime(InstallDate, vbGeneralDate) str = strProductName & vbCrLf If strCSDVersion<>"" Then str = strProductName & " " & strCSDVersion & vbCrLf End If str = str & "Computer Name: " & strComputerName & vbCrLf str = str & "InstallDate: " & strInstallDate & vbCrLf str = str & "BuildLab: " & strBuildLab & vbCrLf str = str & "ProductId: " & strProductId & vbCrLf str = str & "ProductKey: " & strProductKey & vbCrLf strMsg = str & vbCrLf & strComputerName & ".txt に保存しますか?" 'テキストファイルに保存する If MsgBox(strMsg, vbYesNo, "Product Key Viewer")=vbYes Then 'このスクリプトのあるフォルダに作る strFileName = Replace( WScript.ScriptFullName, WScript.ScriptName, strComputerName) & ".txt" Set fileText = CreateObject("Scripting.FileSystemObject").CreateTextFile(strFileName, True) fileText.WriteLine str fileText.Close End If Wscript.Quit ' DigitalProductId -> Product Key 変換 ' based on 『windows OS の各プロダクト ID 取得』 ' https://qiita.com/yuntas/items/cafa3c40eb635418b40d Function ConvertToKey(Key) Const KeyOffset = 52 i = 28 Chars = "BCDFGHJKMPQRTVWXY2346789" Do Cur = 0 x = 14 Do Cur = Cur * 256 Cur = Key(x + KeyOffset) + Cur Key(x + KeyOffset) = (Cur \ 24) And 255 Cur = Cur Mod 24 x = x -1 Loop While x >= 0 i = i -1 KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput If (((29 - i) Mod 6) = 0) And (i <> -1) Then i = i -1 KeyOutput = "-" & KeyOutput End If Loop While i >= 0 ConvertToKey = KeyOutput End Function