License and Proof of Registration Please.

Ya know, Sometimes it's important to know what the original license key for your version of Windows or MSOffice is. For example, you may find yourself needing to conduct an audit to make sure your company is compliant with their Microsoft EULA. You may find yourself needing to identify invalid installations of Windows in your environment. Conversely, you may endeavor to bolster the economy by starting a pirated software clearinghouse. Our economy rests on the shoulders of the small business man, after all.

And if I can provide you with a tool to help make your job easier, then I'm humbled to be of service. The following bit of code will enumerate, decrypt, and provide to you the raw license key for the version of windows or office that you have installed on your server.

'------------------------------
'Begin license auditing code to be used for only legal and ethical purposes-
'Never for nefarious or naughty endeavors. You cheeky monkey.
'-----------------------------

Dim objFS, objShell
Dim strXPKey

Set objShell = CreateObject("WScript.Shell")

strXPKey = objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName")
If Len(strXPKey) > 0 Then

InputBox vbcrlf & "Your Windows Product Key is " & vbcrlf & vbcrlf & vbcrlf & vbcrlf & vbcrlf & "(Use Ctrl + C to copy IP Address to Clipboard)", "Get XP Product Key", GetKey(objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))



'// Begin MSOffice Code
'// NOTE: Replace the above code block with this one to enumerate MSOffice Keys.
'// The script has not been tested with both options enabled.
'//

InputBox vbcrlf & "Your Office Product Key is " & vbcrlf & vbcrlf & vbcrlf & vbcrlf & vbcrlf & "(Use Ctrl + C to copy IP Address to Clipboard)", "Get XP Product Key", GetKey(objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\11.0\Registration\{90110409-6000-11D3-8CFE-0150048383C9}\DigitalProductId"))

'//
'// End MS Office Code

End If

'// Here's the money shot.

Function GetKey(rpk)
Const rpkOffset=52:i=28
szPossibleChars="BCDFGHJKMPQRTVWXY2346789"
Do
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
GetKey=szProductKey
End Function