Digital Life for the Technology Voice

VBS script to get Windows XP CD KEY and save to Text File

March 12, 2007 · 2 Comments

Windows Visual Basic Scripting is a very powerful utility. Someone was working on a very nice script to get windows CD keys from computers using VBS. With my help we made it possible to retrieve and write the info to a file. Save the Code to a CDKEY.VBS file and run it. Soon ill have a working copy that includes Windows Vista. This script was made with the help of cRaSh~oVeRlOaD. Thanks man.

{Code}

DIM fso, WriteFile
Set fso = CreateObject(“Scripting.FileSystemObject”)
Set WriteFile = fso.CreateTextFile(“CDKEY.txt”, True)
Set WshShell = CreateObject(“wscript.Shell”)
Set WshNetwork = WScript.CreateObject(“WScript.Network”)
Set env = WshShell.environment(“Process”)
strComputer = env.Item(“Computername”)
Set objWMIService = GetObject(“winmgmts:\\” & strComputer & “\root\cimv2″)
Const HKEY_LOCAL_MACHINE = &H80000002
Const UnInstPath = “SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\”
Set oReg=GetObject(“winmgmts:{impersonationLevel=impersonate}!\\” &_
“.\root\default:StdRegProv”)
strDigitalProductId=”HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId”
strxpKey=GetKey(WshShell.RegRead(strDigitalProductId))
Set colItems = objWMIService.ExecQuery(“Select * from Win32_OperatingSystem”,,48)
For Each objItem in colItems
report = report & ” ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~” & vbCrLf
report = report & “        Microsoft Windows CD Key Finder (v1.0-Beta)”  & vbCrLf
report = report & ” ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~” & vbCrLf
report = report &  “- Edition: ” & objItem.Name & vbCrLf
report = report &  “- Build Number: ” & objItem.Version & vbCrLf
report = report &  “- Product/CD Key: “& strXPKey & vbCrLf
report = report &  “- Product ID:  “& objItem.SerialNumber & vbCrLf
WriteFile.WriteLine(“Edition:” & objItem.Name)
WriteFile.WriteLine(“Build Number:” & objItem.Version)
WriteFile.WriteLine(“Product/CD Key:” & strXPKey)
WriteFile.WriteLine(“Product ID:” & objItem.SerialNumber)
WriteFile.Close
Next
MsgBox report
Function GetKey(rpk)

Const rpkOffset=52:i=28
szPossibleChars=”BCDFGHJKMPQRTVWXY2346789″

Do ‘Rep1
dwAccumulator=0 : j=14
Do
dwAccumulator=dwAccumulator*256
dwAccumulator=rpk(j+rpkOffset)+dwAccumulator
rpk(j+rpkOffset)=(dwAccumulator\24) and 255
dwAccumulator=dwAccumulator Mod 24
j=j-1
Loop While j>=0
i=i-1 : szProductKey=mid(szPossibleChars,dwAccumulator+1,1)&szProductKey
if (((29-i) Mod 6)=0) and (i<>-1) then
i=i-1 : szProductKey=”-”&szProductKey
End If
Loop While i>=0 ‘Goto Rep1

GetKey=szProductKey
End Function
{Code}

Categories: Breaking News