VBScript to GetProductKey

Discussion in 'Scripting' started by egroups_megapics, Nov 30, 2015.

  1. egroups_megapics

    egroups_megapics MDL Member

    Aug 12, 2009
    121
    39
    10
    #1 egroups_megapics, Nov 30, 2015
    Last edited by a moderator: Apr 20, 2017
    Found VBS script to get current installed product key. I did some tweaking to get additional data like hostname and other details buildnumber and editionid.
    This script searched and tweaked was mainly to find what default keys are used for each edition of windows 10

    Execute this script as administrator and it will create a txt file with all information.

    I dont take credit of writing this script. if any member has better coding experience he can get it done in better way.
    attached script has extension txt remove .txt to get vbs or save the below code as vbs file.

    OFFTopic : This is Official Windows 90 Day Key

    Product Name: Windows 10 Enterprise Evaluation
    Product ID: 00329-20000-00001-AA384
    Installed Key: 7HBDQ-QNKVG-K4RBF-HMBY6-XXXXX

    Code:
    Option Explicit 
    
    Dim objshell,path,DigitalID, Result 
    Set objshell = CreateObject("WScript.Shell")
    'Set registry key path
    Path = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"
    'Registry key value
    DigitalID = objshell.RegRead(Path & "DigitalProductId")
    Dim wshShell,strRegValue,strHostName
    Set wshShell = CreateObject("WScript.Shell")
    strRegValue = "HKLM\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Hostname"
    strHostName = wshShell.RegRead (strRegValue)
    Dim ProductName,ProductID,ProductKey,ProductData,HostName,BuildLab,BuildLabEx,CurrentBuildNumber,EditionID
    'Get ProductName, ProductID, ProductKey
    ProductName = "Product Name: " & objshell.RegRead(Path & "ProductName")
    ProductID = "Product ID: " & objshell.RegRead(Path & "ProductID")
    ProductKey = "Installed Key: " & ConvertToKey(DigitalID) 
    BuildLab = "BuildLab: " & objshell.RegRead(Path & "BuildLab")
    BuildLabEx = "BuildLabEx: " & objshell.RegRead(Path & "BuildLabEx")
    CurrentBuildNumber = "CurrentBuildNumber: " & objshell.RegRead(Path & "CurrentBuildNumber")
    EditionID = "EditionID: " & objshell.RegRead(Path & "EditionID")
    HostName = "HostName: " & strHostName
    ProductData = ProductName  & vbNewLine & ProductID  & vbNewLine & ProductKey  & vbNewLine &  HostName& vbNewLine &  BuildLab & vbNewLine &  BuildLabEx & vbNewLine &  CurrentBuildNumber & vbNewLine &  EditionID
    'Show messbox if save to a file 
    If vbYes = MsgBox(ProductData  & vblf & vblf & "Save to a file?", vbYesNo + vbQuestion, "BackUp Windows Key Information") then
       Save ProductData 
    End If
    
    
    
    'Convert binary to chars
    Function ConvertToKey(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
        ConvertToKey = Mid(KeyOutput, 1, 5) & "-" & Mid(KeyOutput, 6, 5) & "-" & Mid(KeyOutput, 11, 5) & "-" & Mid(KeyOutput, 16, 5) & "-" & Mid(KeyOutput, 21, 5)
       
        
    End Function
    'Save data to a file
    Function Save(Data)
        Dim fso, fName, txt,objshell,UserName
        Set objshell = CreateObject("wscript.shell")
        'Get current user name 
        UserName = objshell.ExpandEnvironmentStrings("%UserName%") 
    Dim wshShell,strRegValue,strHostName
    Set wshShell = CreateObject("WScript.Shell")
    strRegValue = "HKLM\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Hostname"
    strHostName = wshShell.RegRead (strRegValue)
        'Create a text file on desktop 
        fName = "C:\Users\" & UserName & "\Desktop\WindowsKeyInfo_" & strHostName & ".txt"
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set txt = fso.CreateTextFile(fName)
        txt.Writeline Data
        txt.Close
    End Function
    
     

    Attached Files:

  2. Enthousiast

    Enthousiast MDL Tester

    Oct 30, 2009
    16,848
    21,186
    340
    You could just have used daz loader to readout keys :)
     
  3. egroups_megapics

    egroups_megapics MDL Member

    Aug 12, 2009
    121
    39
    10
    never tried it. thought daz loader was windows 7 only so never tried on windows 8 and above
     
  4. Enthousiast

    Enthousiast MDL Tester

    Oct 30, 2009
    16,848
    21,186
    340
    It's great for readout 8/10 keys and "build data" :)
     
  5. kaljukass

    kaljukass MDL Addicted

    Nov 26, 2012
    931
    315
    30
    #5 kaljukass, Nov 30, 2015
    Last edited by a moderator: Apr 20, 2017
    Good, but gives wrong key. This is not an activation key.
     
    Stop hovering to collapse... Click to collapse... Hover to expand... Click to expand...
  6. ruuu7

    ruuu7 MDL Junior Member

    Mar 7, 2015
    79
    14
    0
    Well, ofcourse not!