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

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}

About these ads

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

  1. This works for Windows XP and Vista

  2. thanks, this helped figure out our VLK in the office!

  3. Good Code,

    Very eficient!!

    Good job :)

  4. The most trying time when you are quitting is right after you
    put the last one down. However, if accidentally taken in by mouth,
    it can cause burning irritation of the skin. May be nonsmokers do not see the effectiveness but smokers can feel the real feast in shape of e cigarette usa.

  5. great job Works just fine ! Thx

  6. You can certainly see our enthusiasm within the article
    you write. The world hopes for more passionate writers like yyou
    who are not afraid to mention how they believe.
    Alll the time follow your heart.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s