Key Management Service Product Discovery Module

Microsoft.KMS.Product.Discovery.DS (DataSourceModuleType)

The module responsible for discovery of a product using Key Management Service.

Element properties:

TypeDataSourceModuleType
IsolationAny
AccessibilityPublic
RunAsDefault
OutputTypeSystem.Discovery.Data

Member Modules:

ID Module Type TypeId RunAs 
DS DataSource Microsoft.Windows.TimedScript.DiscoveryProvider Default

Overrideable Parameters:

IDParameterTypeSelectorDisplay NameDescription
IntervalSecondsint$Config/IntervalSeconds$Frequency in secondsThe frequency in seconds for running discovery for a product using Key Management Service.
SyncTimestring$Config/SyncTime$
TimeoutSecondsint$Config/TimeoutSeconds$Timeout in secondsTimeout for the Key Management Service Product discovery module.

Source Code:

<DataSourceModuleType ID="Microsoft.KMS.Product.Discovery.DS" Accessibility="Public" Batching="false">
<Configuration>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="IntervalSeconds" type="xsd:integer"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="SyncTime" type="xsd:string"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="ComputerID" type="xsd:string"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="ComputerName" type="xsd:string"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="ImageName" type="xsd:string"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="TimeoutSeconds" type="xsd:int"/>
</Configuration>
<OverrideableParameters>
<OverrideableParameter ID="IntervalSeconds" Selector="$Config/IntervalSeconds$" ParameterType="int"/>
<OverrideableParameter ID="SyncTime" Selector="$Config/SyncTime$" ParameterType="string"/>
<OverrideableParameter ID="TimeoutSeconds" Selector="$Config/TimeoutSeconds$" ParameterType="int"/>
</OverrideableParameters>
<ModuleImplementation Isolation="Any">
<Composite>
<MemberModules>
<DataSource ID="DS" TypeID="Windows!Microsoft.Windows.TimedScript.DiscoveryProvider">
<IntervalSeconds>$Config/IntervalSeconds$</IntervalSeconds>
<SyncTime>$Config/SyncTime$</SyncTime>
<ScriptName>Microsoft.KMS.Product.Discovery.DS.vbs</ScriptName>
<Arguments>$MPElement$ $Target/Id$ $Config/ComputerID$ $Config/ComputerName$ $Config/ImageName$"</Arguments>
<ScriptBody><Script>
' Copyright (c) Microsoft Corporation. All rights reserved.
' Arguments:
' 0 - TargetComputer
' 1 - TargetComputerID
' 2 - SourceID
' 3 - ManagedEntityID
' 4 - ImageName
'
' This scripts discovers instances of the KMS Product class.
'
' This scripts uses WMI queries (WQL) to determine what level of supporting properties exist on the
' SoftwareLicensingProduct and SoftwareLicensingService WMI classes.
' Specifically we detect if these queries succeed/fail to determine support:
' SELECT KeyManagementServiceTotalRequests FROM SoftwareLicensingService
' SELECT KeyManagementServiceTotalRequests FROM SoftwareLicensingProduct
'

Option Explicit

Dim TargetComputer
Dim TargetComputerID
Dim SourceID
Dim ManagedEntityID
Dim ImageName

' it suppresses ThrowScriptErrorNoAbort only once. I need it for reading registry when registry key is not present
' and this is no error condition.
Dim g_bSuppressThrowScriptErrorNoAbort

Call Main()
'******************************************************************************
Class Error
Private m_lNumber
Private m_sSource
Private m_sDescription
Private m_sHelpContext
Private m_sHelpFile
Public Sub Save()
m_lNumber = Err.number
m_sSource = Err.Source
m_sDescription = Err.Description
m_sHelpContext = Err.HelpContext
m_sHelpFile = Err.helpfile
End Sub
Public Sub Raise()
Err.Raise m_lNumber, m_sSource, m_sDescription, m_sHelpFile, m_sHelpContext
End Sub
Public Sub Clear()
m_lNumber = 0
m_sSource = ""
m_sDescription = ""
m_sHelpContext = ""
m_sHelpFile = ""
End Sub
Public Default Property Get Number()
Number = m_lNumber
End Property
Public Property Get Source()
Source = m_sSource
End Property
Public Property Get Description()
Description = m_sDescription
End Property
Public Property Get HelpContext()
HelpContext = m_sHelpContext
End Property
Public Property Get HelpFile()
HelpFile = m_sHelpFile
End Property
End Class
'******************************************************************************
Class KMSProduct
Private m_sProductSkuId
Private m_sProductSkuName
Private m_sProductSkuDescription
Private m_lKMSCurrentCount
Private m_sLastActivity
Private m_lLastActivityYear
Private m_lLastActivityMonth
Private m_lLastActivityDay
Private m_lLastActivityHour
Private m_lLastActivityMinute
Private m_lTotalRequests
Private m_lIdleMinutes

Public Sub Init(ByVal SkuId)
Clear
m_sProductSkuId = SkuId
End Sub

Public Sub Clear()
m_sProductSkuId = ""
m_sProductSkuName = ""
m_sProductSkuDescription = ""
m_lKMSCurrentCount = 0
m_sLastActivity = Null
m_lLastActivityYear = Null
m_lLastActivityMonth = Null
m_lLastActivityDay = Null
m_lLastActivityHour = Null
m_lLastActivityMinute = Null
m_lTotalRequests = 0
m_lIdleMinutes = 0
End Sub

Public Sub SetLastActivity( _
ByVal sLastActivity, _
ByVal sLastActivityYear, _
ByVal sLastActivityMonth, _
ByVal sLastActivityDay, _
ByVal sLastActivityHour, _
ByVal sLastActivityMinute _
)
m_sLastActivity = sLastActivity
m_lLastActivityYear = CInt(sLastActivityYear)
m_lLastActivityMonth = CInt(sLastActivityMonth)
m_lLastActivityDay = CInt(sLastActivityDay)
m_lLastActivityHour = CInt(sLastActivityHour)
m_lLastActivityMinute = CInt(sLastActivityMinute)
End Sub

Public Sub CalculateIdleMinutes()
If IsNull(m_sLastActivity) Then
SetLastActivityToCurrentTime
Exit Sub
Else
Dim NowTime
NowTime = Now()
m_lIdleMinutes = DateDiff("n", m_sLastActivity, NowTime)
End If
End Sub

Public Sub SetLastActivityToCurrentTime()

Dim NowTime
NowTime = Now()

SetLastActivity NowTime, Year(NowTime), Month(NowTime), Day(NowTime), Hour(NowTime), Minute(NowTime)
m_lIdleMinutes = 0

End Sub


'
' Read-Only Properties
'
Public Property Get ProductSkuId()
ProductSkuId = m_sProductSkuId
End Property

Public Property Get LastActivity()
LastActivity = m_sLastActivity
End Property

Public Property Get LastActivityYear()
LastActivityYear = m_lLastActivityYear
End Property

Public Property Get LastActivityMonth()
LastActivityMonth = m_lLastActivityMonth
End Property

Public Property Get LastActivityDay()
LastActivityDay = m_lLastActivityDay
End Property

Public Property Get LastActivityHour()
LastActivityHour = m_lLastActivityHour
End Property

Public Property Get LastActivityMinute()
LastActivityMinute = m_lLastActivityMinute
End Property

Public Property Get IdleMinutes()
IdleMinutes = m_lIdleMinutes
End Property

'
' Read/Write Properties
'
Public Property Get ProductSkuName()
ProductSkuName = m_sProductSkuName
End Property

Public Property Let ProductSkuName(ByVal sSkuName)
m_sProductSkuName = sSkuName
End Property

Public Property Get ProductSkuDescription()
ProductSkuDescription = m_sProductSkuDescription
End Property

Public Property Let ProductSkuDescription(ByVal sSkuDescription)
m_sProductSkuDescription = sSkuDescription
End Property

Public Property Get KMSCurrentCount()
KMSCurrentCount= m_lKMSCurrentCount
End Property

Public Property Let KMSCurrentCount(ByVal lCount)
m_lKMSCurrentCount = lCount
End Property

Public Property Get TotalRequests()
TotalRequests = m_lTotalRequests
End Property

Public Property Let TotalRequests(ByVal lRequests)
m_lTotalRequests = lRequests
End Property

End Class
'******************************************************************************
Function MomCreateObject(ByVal sProgramId)
Dim oError
Set oError = New Error

On Error Resume Next
Set MomCreateObject = CreateObject(sProgramId)
oError.Save
On Error Goto 0

If oError.Number &lt;&gt; 0 Then ThrowScriptError "Unable to create automation object '" &amp; sProgramId &amp; "'", oError
End Function
'******************************************************************************
Function Quit()
WScript.Quit()
End Function

'******************************************************************************
Sub ThrowEmptyDiscoveryData()
Dim oAPI, oSQLDiscoveryData
Set oAPI = CreateObject("MOM.ScriptAPI")
set oSQLDiscoveryData = oAPI.CreateDiscoveryData(0, SourceId, ManagedEntityId)
Call oAPI.Return(oSQLDiscoveryData)

End Sub

'******************************************************************************
Function ThrowScriptErrorNoAbort(ByVal sMessage, ByVal oErr)
On Error Resume Next
If g_bSuppressThrowScriptErrorNoAbort = True Then
g_bSuppressThrowScriptErrorNoAbort = False
Else
Dim oAPITemp
Set oAPITemp = MOMCreateObject("MOM.ScriptAPI")
oAPITemp.LogScriptEvent "KMSProductDiscovery.vbs", 4001, 1, sMessage &amp; ". " &amp; oErr.m_sDescription
End if
End Function

'******************************************************************************
Function ThrowScriptError(Byval sMessage, ByVal oErr)
On Error Resume Next
ThrowScriptErrorNoAbort sMessage, oErr
Quit()
End Function
'******************************************************************************
Function WMIExecQueryRaw(ByVal sNamespace, ByVal sQuery)
'
' WMIExecQueryRaw :: Executes the WMI query and returns the result set.
'
'
Dim oWMI, oQuery, nInstanceCount
Dim e
Set e = New Error
On Error Resume Next
Set oWMI = GetObject(sNamespace)

e.Save
On Error Goto 0
If IsEmpty(oWMI) Then
WScript.Echo "Unable to open WMI Namespace '" &amp; sNamespace

ThrowScriptErrorNoAbort "Unable to open WMI Namespace '" &amp; sNamespace &amp; "'. Check to see if the WMI service is enabled and running, and ensure this WMI namespace exists.", e
ThrowEmptyDiscoveryData
End If

On Error Resume Next

Set oQuery = oWMI.ExecQuery(sQuery)
e.Save
On Error Goto 0
If IsEmpty(oQuery) Or e.Number &lt;&gt; 0 Then
ThrowScriptError "The Query '" &amp; sQuery &amp; "' returned an invalid result set. Please check to see if this is a valid WMI Query.", e
End If

Set WMIExecQueryRaw = oQuery

End Function


Function WMIExecQuery(ByVal sNamespace, ByVal sQuery)
'
' WMIExecQuery :: Executes the WMI query and returns the result set.
'
'
Dim oWMI, oQuery, nInstanceCount
Dim e
Set e = New Error
On Error Resume Next
Set oWMI = GetObject(sNamespace)

e.Save
On Error Goto 0
If IsEmpty(oWMI) Then
WScript.Echo "Unable to open WMI Namespace '" &amp; sNamespace

ThrowScriptErrorNoAbort "Unable to open WMI Namespace '" &amp; sNamespace &amp; "'. Check to see if the WMI service is enabled and running, and ensure this WMI namespace exists.", e
ThrowEmptyDiscoveryData
End If

On Error Resume Next

Set oQuery = oWMI.ExecQuery(sQuery)
e.Save
On Error Goto 0
If IsEmpty(oQuery) Or e.Number &lt;&gt; 0 Then
ThrowScriptError "The Query '" &amp; sQuery &amp; "' returned an invalid result set. Please check to see if this is a valid WMI Query.", e
End If

'Determine if we queried a valid WMI class - Count will return 0 or empty
On Error Resume Next
nInstanceCount = oQuery.Count
e.Save
On Error Goto 0
If e.Number &lt;&gt; 0 Then
ThrowScriptError "The Query '" &amp; sQuery &amp; "' did not return any valid instances. Please check to see if this is a valid WMI Query.", e
End If

Set WMIExecQuery = oQuery

End Function

Function WMIExecQuery2(ByVal sNamespace, ByVal sQuery)
'
' WMIExecQuery :: Executes the WMI query and returns the result set.
'
'
Dim oQuery, nInstanceCount
Dim e

Set oQuery = WMIExecQueryRaw(sNamespace, sQuery)

'Determine if we queried a valid WMI class - Count will return 0 or empty
Set e = New Error
On Error Resume Next
nInstanceCount = oQuery.Count
e.Save
On Error Goto 0
If e.Number &lt;&gt; 0 Then
ThrowScriptError "The Query '" &amp; sQuery &amp; "' did not return any valid instances. Please check to see if this is a valid WMI Query.", e
End If

Set WMIExecQuery = oQuery

End Function

Function IsValidWMIExecQuery(ByVal sNamespace, ByVal sQuery)
'
' IsValidWMIExecQuery :: Executes the WMI query and returns whether it was valid or not.
'
'
Dim oQuery, nInstanceCount
Dim e

Set oQuery = WMIExecQueryRaw(sNamespace, sQuery)

'Determine if we queried a valid WMI class - Count will return 0 or empty
Set e = New Error
On Error Resume Next
nInstanceCount = oQuery.Count
e.Save
On Error Goto 0
If e.Number &lt;&gt; 0 Then
IsValidWMIExecQuery = False
Else
IsValidWMIExecQuery = True
End If

End Function

'******************************************************************************

Function KMSServiceSupportsServiceTotalRequestsCount()

Dim sNamespace
sNamespace = "winmgmts://" &amp; TargetComputer &amp; "/root/cimv2"

KMSServiceSupportsServiceTotalRequestsCount = IsValidWMIExecQuery(sNamespace, "SELECT KeyManagementServiceTotalRequests FROM SoftwareLicensingService")

End Function

Function KMSServiceSupportsApplicationTotalRequestsCount()

Dim sNamespace
sNamespace = "winmgmts://" &amp; TargetComputer &amp; "/root/cimv2"

KMSServiceSupportsApplicationTotalRequestsCount = IsValidWMIExecQuery(sNamespace, "SELECT KeyManagementServiceTotalRequests FROM SoftwareLicensingProduct")

End Function

'******************************************************************************

Function CollectKMSProductsUsingProductObject()

Dim sNamespace

sNamespace = "winmgmts://" &amp; TargetComputer &amp; "/root/cimv2"

Dim oKMSProducts, oProduct
Set oKMSProducts = WMIExecQuery(sNamespace, "SELECT ID, Name, Description, KeyManagementServiceCurrentCount FROM SoftwareLicensingProduct WHERE PartialProductKey &lt;&gt; null AND Description LIKE '%KMS%' AND NOT Description LIKE '%KMSCLIENT%'")

If oKMSProducts.Count = 0 Then
CollectKMSProductsUsingProductObject = Null
Exit Function
End If

Dim arrKMSProducts()

ReDim arrKMSProducts(oKMSProducts.Count)
Dim iProduct

iProduct = 0
For Each oProduct in oKMSProducts

Dim oKMSProduct
Set oKMSProduct = New KMSProduct

oKMSProduct.Init oProduct.ID
oKMSProduct.ProductSkuName = oProduct.Name
oKmsProduct.ProductSkuDescription = oProduct.Description
oKMSProduct.KMSCurrentCount = oProduct.KeyManagementServiceCurrentCount

Set arrKMSProducts(iProduct) = oKMSProduct

iProduct = iProduct + 1

Next

CollectKMSProductsUsingProductObject = arrKMSProducts
End Function

Function CollectKMSProductsUsingServiceObject()

Dim sNamespace

sNamespace = "winmgmts://" &amp; TargetComputer &amp; "/root/cimv2"

Dim oKMSServices, oService
Dim KMSCurrentCount
Set oKMSServices = WMIExecQuery(sNamespace, "SELECT KeyManagementServiceCurrentCount FROM SoftwareLicensingService")

if oKMSServices.Count &lt;&gt; 1 Then
KmsProductDiscoveryUsingService = False
Exit Function
Else
For Each oService in oKMSServices
KMSCurrentCount = oService.KeyManagementServiceCurrentCount
Next
End If

Dim oKMSProducts, oProduct

Set oKMSProducts = WMIExecQuery(sNamespace, "SELECT ID, Name, Description FROM SoftwareLicensingProduct WHERE PartialProductKey &lt;&gt; null And Description LIKE '%KMS%' AND NOT Description LIKE '%KMSCLIENT%'")

if oKMSProducts.Count = 0 Then
CollectKMSProductsUsingServiceObject = Null
Exit Function
End If

Dim arrKMSProducts()

ReDim arrKMSProducts(oKMSProducts.Count)
Dim iProduct

iProduct = 0
For Each oProduct in oKMSProducts

Dim oKMSProduct
Set oKMSProduct = New KMSProduct

oKMSProduct.Init oProduct.ID
oKMSProduct.ProductSkuName = oProduct.Name
oKmsProduct.ProductSkuDescription = oProduct.Description
oKMSProduct.KMSCurrentCount = KMSCurrentCount

Set arrKMSProducts(iProduct) = oKMSProduct

iProduct = iProduct + 1

Next

CollectKMSProductsUsingServiceObject = arrKMSProducts
End Function

Function AddKmsProductInstancesToDiscovery(ByRef arrProducts, ByVal oDiscoveryData)
Dim oProduct, iProduct

For iProduct = LBound(arrProducts) To (UBound(arrProducts) - 1)
Set oProduct = arrProducts(iProduct)

Dim oInstance

Set oInstance = oDiscoveryData.CreateClassInstance("$MPElement[Name='Microsoft.KMS.Product']$")

With oInstance
.AddProperty "$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$", TargetComputerID
.AddProperty "$MPElement[Name='Microsoft.KMS.ServerRole']/ImageName$", ImageName
.AddProperty "$MPElement[Name='Microsoft.KMS.Product']/ProductSkuId$", oProduct.ProductSkuID
.AddProperty "$MPElement[Name='Microsoft.KMS.Product']/ProductSkuName$", oProduct.ProductSkuName
.AddProperty "$MPElement[Name='Microsoft.KMS.Product']/ProductSkuDescription$", oProduct.ProductSkuDescription
.AddProperty "$MPElement[Name='Microsoft.KMS.Product']/KMSCurrentCount$", oProduct.KMSCurrentCount
.AddProperty "$MPElement[Name="System!System.Entity"]/DisplayName$", TargetComputerID
End With

Call oDiscoveryData.AddInstance(oInstance)
Next

AddKmsProductInstancesToDiscovery = True

End Function

'******************************************************************************

Sub Main()

Dim oAPI
Set oAPI = MOMCreateObject("MOM.ScriptAPI")
Call oAPI.LogScriptEvent("Microsoft.KMS.Product.Discovery.DS.vbs", 4100, 0, "Starting discovery script.")

Dim oArgs
Set oArgs = WScript.Arguments
if oArgs.Count &lt;&gt; 5 Then
Call oAPI.LogScriptEvent("Microsoft.KMS.Product.Discovery.DS.vbs", 4100, 0, "LogScriptEvent script was called with fewer than 5 arguments and was not executed.")
Wscript.Quit -1
End If

SourceID = oArgs(0)
ManagedEntityId = oArgs(1)
TargetComputerID = oArgs(2)
TargetComputer = oArgs(3)
ImageName = oArgs(4)

Dim KMSVer
Dim oDiscoveryData
Dim arrProducts

set oDiscoveryData = oAPI.CreateDiscoveryData(0, SourceId, ManagedEntityId)

if KMSServiceSupportsApplicationTotalRequestsCount() = True Then
arrProducts = CollectKMSProductsUsingProductObject()
Else
if KMSServiceSupportsServiceTotalRequestsCount() = True Then
arrProducts = CollectKMSProductsUsingServiceObject()
Else
End If
End If

If Not IsNull(arrProducts) Then
Call AddKmsProductInstancesToDiscovery(arrProducts, oDiscoveryData)
End If

oAPI.Return(oDiscoveryData)

End Sub
</Script></ScriptBody>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
</DataSource>
</MemberModules>
<Composition>
<Node ID="DS"/>
</Composition>
</Composite>
</ModuleImplementation>
<OutputType>System!System.Discovery.Data</OutputType>
</DataSourceModuleType>