Set WshShell = CreateObject("WScript.Shell")
MicroSoft = "HKLM\SOFTWARE\Microsoft"
DigitalProductIdWindows = MicroSoft & "\Windows NT\CurrentVersion\DigitalProductId"
On Error Resume Next
Set Word = CreateObject("Word.Application")
DigitalProductIdOffice = MicroSoft & "\Office\" & word.Version & "\Registration\" & _
    word.ProductCode & "\DigitalProductId"
If Err.Number = 0 Then
    Word.Quit
    OfficeKey = GetKey(WshShell.RegRead(DigitalProductIdOffice))
    WScript.Echo "Ключ MS Office: " & OfficeKey
Else
    WScript.Echo "Возможно, MS Office не установлен."
End If
On Error GoTo 0
 
WindowsKey = GetKey(WshShell.RegRead(DigitalProductIdWindows))
WScript.Echo "Ключ Windows: " & WindowsKey
 
Function GetKey(byval p)
    pc="BCDFGHJKMPQRTVWXY2346789"
    For i=0 To 28
        a=0
        For j=0 To 14 
            a=p(66-j)+a*256 
            p(66-j)=(a\24) And 255 
            a=a Mod 24
        Next
        ProductKey = Mid(pc,a+1,1) & ProductKey
        If (((i+2) Mod 6)=0) And (i<28) Then
            i=i+1
            ProductKey = "-" & ProductKey
        End If
    Next
    GetKey = ProductKey
End Function