Windows and Office Product key

Technical level  :  Medium

Summary

To activate the windows and office a 25-digit code (key) (XXXXX-XXXXX-XXXXX-XXXXX-XXXXX) is requied format . To find out which key was used to activate the system, or there is a need to reinstall the system, and the key on the sticker erased, you can use this VBS script.

Details

Create a text document.

 

Copy the text of the script.

Const HKEY_LOCAL_MACHINE = &H80000002
WinKey = GetWinKey
OfficeKeys = GetOfficeKey("10.0") & GetOfficeKey("11.0") & GetOfficeKey("12.0") & GetOfficeKey("14.0") & GetOfficeKey("15.0")

If Msgbox(WinKey & vbnewline & vbnewline & OfficeKeys & vbnewline & "Save All Keys to ProductKeys.txt?", vbyesno, "Cosmic Boom") = vbyes then
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objTextFile = objFSO.CreateTextFile("ProductKeys.txt", True)
    objTextFile.Write WinKey & vbnewline & vbnewline & OfficeKeys
    objTextFile.Close
end if

Function GetOfficeKey(sVer)
    On Error Resume Next
    Dim arrSubKeys
    Set wshShell = WScript.CreateObject( "WScript.Shell" )
    sBit = wshShell.ExpandEnvironmentStrings("%ProgramFiles(x86)%")
    if sBit <> "%ProgramFiles(x86)%" then
   sBit = "Software\wow6432node"
    else
   sBit = "Software"
    end if
    Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    objReg.EnumKey HKEY_LOCAL_MACHINE, sBit & "\Microsoft\Office\" & sVer & "\Registration", arrSubKeys
    Set objReg = Nothing
    if IsNull(arrSubKeys) = False then
        For Each Subkey in arrSubKeys
       if lenb(other) < 1 then other = wshshell.RegRead("HKLM\" & sBit & "\Microsoft\Office\" & sVer & "\Registration\" & SubKey & "\ProductName")
       if ucase(right(SubKey, 7)) = "0FF1CE}" then
                Set wshshell = CreateObject("WScript.Shell")
           key = ConvertToKey(wshshell.RegRead("HKLM\" & sBit & "\Microsoft\Office\" & sVer & "\Registration\" & SubKey & "\DigitalProductID"))
      oem = ucase(mid(wshshell.RegRead("HKLM\" & sBit & "\Microsoft\Office\" & sVer & "\Registration\" & SubKey & "\ProductID"), 7, 3))
        edition = wshshell.RegRead("HKLM\" & sBit & "\Microsoft\Office\" & sVer & "\Registration\" & SubKey & "\ProductName")
      if err.number <> 0 then 
          edition = other
                   err.clear
      end if
           Set wshshell = Nothing
            if oem <> "OEM" then oem = "Retail"
           if lenb(final) > 1 then
          final = final & vbnewline & final
             else
               final = edition & " " & oem & ":  " & key 
                end if
       end if
        Next
   GetOfficeKey = final & vbnewline
    End If
End Function

Function GetWinKey()
    Set wshshell = CreateObject("WScript.Shell")
    edition = wshshell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName")
    oem = ucase(mid(wshshell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductID"), 7, 3))
    key = GetKey("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId")
    set wshshell = Nothing
    if oem <> "OEM" then oem = "Retail"
    GetWinKey = edition & " " & oem & ":  " & key
End Function

Function GetKey(sReg)
    Set wshshell = CreateObject("WScript.Shell")
    GetKey = ConvertToKey(wshshell.RegRead(sReg))
    Set wshshell = Nothing
End Function

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

Click File - Save As:


Select the file type: All files. Ask any file name, but be sure to specify the extension VBS . Click Save.

By clicking on the saved file opens with activation key windows .


Applies to: 

Windows XP, Vista, 7, 8, 8.1 , Office 2007 , Office 2010 , Office 2013

Source : Layout from Russian Wiki article by Дeньчик , VBS Script

|

Was this discussion helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this discussion?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this discussion?

Thanks for your feedback.

 

Discussion Info


Last updated June 10, 2021 Views 5,859 Applies to: