如何偵測查詢 Windows / Office 軟體啟用序號註冊碼教學?

如何偵測查詢 Windows / Office 軟體啟用序號註冊碼教學?

最近組裝了新電腦,才想到 Windows 與 Office 軟體序號不知道丟到哪,網路爬文後發現到可以用名為 ProduKey 軟體抓到目前電腦註冊碼,若有安全疑慮則可善用寫 .vbs 指令來快速取得,至於詳盡微軟程式啟用偵測查詢方法就來看教學文吧 ~

 

軟體使用教學:

 

首先把 ProduKey 軟體下載抓回來 (如為 64 位元系統請下載 for x64 檔案),解壓縮後順便將中文語系檔放在同個目錄,接著點選「ProduKey.exe」程式。

 

資訊名稱:ProduKey
軟體下載:網址 & 中文化檔案
官方網站:http://www.nirsoft.net/utils/product_cd_key_viewer.html

 

如何偵測查詢 Windows / Office 軟體啟用序號註冊碼教學?

 

開啟 ProduKey 視窗自動列出已安裝 MS 軟體序號,可善用右鍵來複製保存起來,

 

如何偵測查詢 Windows / Office 軟體啟用序號註冊碼教學?

 

支援系統及軟體版本:

 

Microsoft Windows 98/ME
Microsoft Windows 2000
Microsoft Windows NT
Microsoft Windows XP
Microsoft Windows Vista
Microsoft Windows Server 2003
Microsoft Windows 7 (Doesn’t work with Microsoft Volume Licensing)
Microsoft Windows 8 (Doesn’t work with Microsoft Volume Licensing)
Microsoft Windows 10 (Doesn’t work with all types of licenses)
Microsoft Office 2000 (Only ProductID is displayed)
Microsoft Office 2003
Microsoft Office 2007
Microsoft Office 2010
Microsoft SQL Server 2000
Microsoft SQL Server 2005
Microsoft Exchange Server 2000
Microsoft Exchange Server 2003
Visual Studio
部分 Adobe 與 Autodesk 軟體。
 
注意:少數防毒軟體會誤報為惡意程式,如果不放心可參考下方教學。

 

免裝軟體教學:

 

在國外網站找到可使用 VBScript 指令讀取 Windows 序號,如此一來就不用下載與安裝任何軟體,將下方方程式碼複製起來貼到記事本然後儲存為 .vbs 檔(如:GetWindowsKey.vbs),放在桌面點滑鼠兩下就會跳出序號並直接顯示,可在該視窗搭配 Ctrl + C 來直接複製。

 

Set WshShell = CreateObject("WScript.Shell")
MsgBox ConvertToKey(WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))
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

 

如何偵測查詢 Windows / Office 軟體啟用序號註冊碼教學?

如何偵測查詢 Windows / Office 軟體啟用序號註冊碼教學?

 

至於 Office 指令檔如下:儲存為 .vbs 檔(如:GetOfficeKey.vbs)

 

Const HKLM = &H80000002
wscript.echo "View Product Keys | Microsoft Products" & vbCrLf
'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,9,2) & ":" & mid(InsDate,11,2) & ":" & mid(InsDate,13,2)
NewDate = NewDate & " " & mid(InsDate,7,2) & "/" & mid(InsDate,5,2) & "/" & mid(InsDate,1,4)

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
                WriteData "Product", strOfficeEdition
                WriteData "Key", DecodeProductKey(arrProductID,intKeyOffset) & vbCrLf
                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
        wscript.echo "Product: " & Caption & Version & " (" & OSArchitecture & ")"
        wscript.echo "Installation Date: " & NewDate
        WriteData "Key", strWinKey
        Exit Sub
    End If
    strWinKey = CheckWindowsKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion","DigitalProductId4",808)
    If strWinKey <> "" Then
        wscript.echo "Product: " & Caption & Version & " (" & OSArchitecture & ")"
        wscript.echo "Installation Date: " & NewDate
        WriteData "Key", strWinKey
        Exit Sub
    End If
    strWinKey = CheckWindowsKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion\DefaultProductKey","DigitalProductId",52)
    If strWinKey <> "" Then
        wscript.echo "Product: " & Caption & Version & " (" & OSArchitecture & ")"
        wscript.echo "Installation Date: " & NewDate
        WriteData "Key", strWinKey
        Exit Sub
    End If
    strWinKey = CheckWindowsKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion\DefaultProductKey","DigitalProductId4",808)
    If strWinKey <> "" Then
        wscript.echo "Product: " & Caption & Version & " (" & OSArchitecture & ")"
        wscript.echo "Installation Date: " & NewDate
        WriteData "Key", 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

Sub WriteData(strProperty,strValue)
    WScript.Echo strProperty & ": " & Trim(strValue)
    'Set objShell = CreateObject("WScript.Shell")
    'strKey = "HKLM\SOFTWARE\CentraStage\Custom\" & strProperty
    'objShell.RegWrite strKey,Trim(strValue),"REG_SZ"
    'Set objShell = Nothing

End Sub

 

如何偵測查詢 Windows / Office 軟體啟用序號註冊碼教學?

如何偵測查詢 Windows / Office 軟體啟用序號註冊碼教學?

 

Avatar for 史密斯先生

史密斯先生

同時身兼站長與網管,校長兼撞鐘一職,史密斯是個熱愛科技三吸阿宅,常在 PTT 批踢踢與歐美鄉民集散地 reddit 走跳,並且對 VPN & 翻牆跳板連線資訊特別感興趣,希望藉由「跳板俱樂部 VPN Club」平台讓大家掌握最即時又快速的網路動態。

留言板