<WriteActionModuleType ID="Microsoft.Windows.DHCPServer.Library.WriteAction.PerformanceData" Accessibility="Internal" RunAs="Microsoft.Windows.DHCPServer.Library.ActionAccount" Batching="false">
<Configuration>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="TimeoutSeconds" type="xsd:integer"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="Server" type="xsd:string"/>
</Configuration>
<OverrideableParameters>
<OverrideableParameter ID="TimeoutSeconds" Selector="$Config/TimeoutSeconds$" ParameterType="int"/>
</OverrideableParameters>
<ModuleImplementation>
<Composite>
<MemberModules>
<WriteAction TypeID="Windows!Microsoft.Windows.ScriptWriteAction" ID="Script">
<ScriptName>DHCPCollectAllPerfData.vbs</ScriptName>
<Arguments>"$Config/Server$"</Arguments>
<ScriptBody><Script>' Copyright (c) Microsoft Corporation. All rights reserved.
' Microsoft Windows DHCP Server Library Scope Collecting Values
'
' Returns a property bag containing the number of free, inuse, and pending IP addresses in the specified scope / superscope.
'
' Parameters - TargetComputer The FQDN of the computer targeted by the script.
Const NETSH_PATH = "%SystemRoot%\system32\netsh.exe"
Dim oAPI, oShell
Dim oScope2008
Dim m_sNetshPath
Dim sOutput, sOutput2, sError, sCommand, aSubMatches, ierrCode
Dim bFailed, oReturnAllFlag, objSuperScopes
Dim oArgs, oDiscoveryData, oInst, SourceID, ManagedEntityId, TargetComputer
Dim oPropertyBag, sInvalidParams , sName, sSubnet
Dim boolOnlyDisabled
Dim IsSuperscope,iPending,iInuse,iFree
Dim oWMI
Dim OSVersion
Dim rc
Dim sOutput3, sOutput4, aSubMatches2
Dim boolIPV6Scope
Dim strIPV6InstanceName
Dim fso
Dim strLogFile
Dim DHCP2008_MIB_COUNT_REGEX
DHCP2008_MIB_COUNT_REGEX = Array( _
"\r\n" & _
".*\r\n" & _
"\t.*\r\n" & _
"\t.*\r\n" & _
"\t.*\r\n" & _
"\t.*\r\n" & _
"\t.*\r\n" & _
"\t.*\r\n" & _
"\t.*\r\n" & _
"\t.*\r\n" & _
"\t.*\r\n" &_
"\t.*\r\n" &_
"\t.*\r\n" _
)
'New
Dim DHCP2003_SCOPE_INFO_HEADER_REGEX
DHCP2003_SCOPE_INFO_HEADER_REGEX = Array( _
"\r\n" & _
"==============================================================================\r\n" & _
".*\r\n" & _
"==============================================================================\r\n" & _
"\r\n" _
)
Dim DHCP2008_v6scope2_MIB_COUNT_REGEX
DHCP2008_v6scope2_MIB_COUNT_REGEX = Array( _
"\r\n" & _
".*\r\n" & _
"\t.*\r\n" & _
"\t.*\r\n" & _
"\t.*\r\n" & _
"\t.*\r\n" & _
"\t.*\r\n" & _
"\t.*\r\n" & _
"\t.*\r\n" & _
"\t.*\r\n" & _
"\t.*\r\n" & _
"\t.*\r\n" & _
"\t.*\r\n" _
)
Class DHCPScopes
Private m_oScopes
Private m_oSuperScopes
Private m_oV6Scopes
Public oPropertyBag
Private objSupScopes
Private Sub Class_Initialize()
set m_oScopes = CreateObject("Scripting.Dictionary")
set m_oSuperScopes = CreateObject("Scripting.Dictionary")
set m_oV6Scopes = CreateObject("Scripting.Dictionary")
CollectData
End Sub
Public Function GetScopes
Set GetScopes = m_oScopes
End Function
Public Function GetSuperScopes
Set GetSuperScopes = m_oSuperScopes
End Function
Public Function GetV6Scopes
Set GetV6Scopes = m_oV6Scopes
End Function
Private Sub CollectData()
Dim Superscopename
Dim oScope
boolIPV6Scope = false
Set oWMI = GetObject("winmgmts:\\" & TargetComputer & "\root\default:StdRegProv")
rc = oWMI.GetStringValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion", "CurrentVersion", OSVersion)
sOutput = ExecuteCmd("dhcp server show superscope", NETSH_PATH, true)
sOutput2 = ExecuteCmd("dhcp server show scope", NETSH_PATH, true)
If LCase(sOutput) = "error" Then
ThrowErrorAndExit "Error-netsh dhcp server show superscope failed."
End If
Do While GetSubMatches(DHCP2008_SUPERSCOPE_REGEX, sOutput, sOutput, aSubMatches)
Superscopename = aSubMatches(0)
If Not(LCase(Superscopename) = "(null)") Then
Set objSupScopes = new SuperScope
objSupScopes.AddData Superscopename,0,0,0,0
Set m_oSuperScopes.Item(objSupScopes.Superscopename) = objSupScopes
End If
Do While GetSubMatches(DHCP2008_SUPERSCOPE_MEMBER_REGEX, sOutput, sOutput, aSubMatches)
Set oScope =new Scope
oScope.Initialize Superscopename,aSubMatches(1),aSubMatches(0), False
Set m_oScopes.Item(oScope.Subnet) = oScope
Loop
Loop
' Set enabled attribute for all scopes.
Dim i, boolEnabled
If GetSubMatches(DHCP2003_SCOPE_INFO_HEADER_REGEX, sOutput2, sOutput2, aSubMatches2) Then
Do While GetSubMatches(DHCP2003_SCOPE_INFO_REGEX, sOutput2, sOutput2, aSubMatches2)
If m_oScopes.Exists(Trim(aSubMatches2(0))) Then
boolEnabled = CBool(Trim(aSubMatches2(2))= "Active")
Set oScope = m_oScopes.Item(Trim(aSubMatches2(0)))
oScope.SetEnabled(boolEnabled)
End If
Loop
End If
' now calc free,inuse,pending using dhcp show all.
Dim tempsubnet,tempfree,tempinuse,temppend
Dim strScopeInfo, tempenabled
sOutput=ExecuteCmd("dhcp server show mibinfo", NETSH_PATH, True)
If LCase(sOutput) = "error" Then
ThrowErrorAndExit "Error-netsh dhcp server show all failed."
End If
If GetSubMatches(DHCP2008_MIB_COUNT_REGEX, sOutput, sOutput, aSubMatches) Then
Do While GetSubMatches(DHCP2008_SCOPE_REGEX, sOutput, sOutput, aSubMatches)
tempsubnet=aSubMatches(0)
tempfree=aSubMatches(2)
tempinuse=aSubMatches(1)
temppend=aSubMatches(3)
If m_oScopes.Exists(tempsubnet) Then
Set oScope = m_oScopes.Item(tempsubnet)
If Not(oScope.superscopename = "(null)") Then
m_oSuperScopes.Item(oscope.superscopename).SetFree CInt(m_oSuperScopes.Item(oscope.superscopename).Free ) + CInt(tempfree)
m_oSuperScopes.Item(oscope.superscopename).SetInUse CInt(m_oSuperScopes.Item(oscope.superscopename).InUse) + CInt(tempinuse)
m_oSuperScopes.Item(oscope.superscopename).SetPend CInt(m_oSuperScopes.Item(oscope.superscopename).Pend) + CInt(temppend)
' Mark that this SuperScope has disabled scopes
If oScope.Enabled = False Then
m_oSuperScopes.Item(oscope.superscopename).SetIncludeDisabled 1
End If
End If
oScope.AddData tempfree, tempinuse, temppend
End If
Loop
End If
If (osVersion = WIN2008VERSION) Then
'Getting IPV6 Scopes Data
sOutput3 = ExecuteCmd("dhcp server v6 show scope", NETSH_PATH, True)
sOutput4 = ExecuteCmd("dhcp server v6 show mibinfo", NETSH_PATH, True)
If (GetSubMatches(DHCP2008_v6scope_REGEX, sOutput3, sOutput3, aSubMatches2)) Then
Do While GetSubMatches(DHCP2008_v6scope2_REGEX, sOutput3, sOutput3, aSubMatches2)
tempsubnet=Trim(aSubMatches2(0))
strIPV6InstanceName = Trim(aSubMatches2(2))
Set oScope = new Scope
oScope.Initialize "", strIPV6InstanceName, tempsubnet, CBool(Trim(aSubMatches2(1))= "Active")
Set m_oV6Scopes.Item(oScope.Subnet) = oScope
Loop
End If
If GetSubMatches(DHCP2008_v6scope2_MIB_COUNT_REGEX, sOutput4, sOutput4, aSubMatches) Then
Do While GetSubMatches(DHCP2008_V6SCOPE2_MIB_REGEX, sOutput4, sOutput4, aSubMatches)
tempsubnet=Trim(aSubMatches(0))
tempfree = aSubMatches(2)
tempinuse=aSubMatches(1)
temppend=aSubMatches(3)
If m_oV6Scopes.Exists(tempsubnet) Then
Set oScope = m_oV6Scopes.Item(tempsubnet)
oScope.AddData tempfree, tempinuse, temppend
End If
Loop
End If
End If
End Sub
End Class
Public Sub AddData(insuperscopename, infree, ininuse, inpend, inincludedisabled)
mssuperscopename=insuperscopename
msfree=infree
msinuse=ininuse
mspend=inpend
msincludedisabled=inincludedisabled
End Sub
Public Property Get Superscopename
SuperscopeName = mssuperscopename
End Property
Public Property Get IncludeDisabled
IncludeDisabled = msincludedisabled
End Property
Public Property Get Free
Free = msfree
End Property
Public Property Get InUse
InUse = msinuse
End Property
Public Property Get Pend
Pend = mspend
End Property
Public Sub SetIncludeDisabled(inincludedisabled)
msincludedisabled = inincludedisabled
End Sub
Public Sub SetFree(infree)
msfree = infree
End Sub
Public Sub SetInUse(ininuse)
msinuse = ininuse
End Sub
Public Sub SetPend(inpend)
mspend = inpend
End Sub
End Class
Public Sub Initialize(insuperscopename,inscopename,insubnet,inenabled)
If Len(RTrim(inscopename)) > 21 Then
inscopename = Left(RTrim(inscopename),21)
End If
msuperscopename=insuperscopename
mscopename=inscopename
msubnet=insubnet
menabled=inenabled
End Sub
Public Sub AddData(infree, ininuse, inpend)
mfree=infree
minuse=ininuse
mpend=inpend
End Sub
Public Property Get Superscopename
SuperscopeName = msuperscopename
End Property
Public Property Get Scopename
Scopename = mscopename
End Property
Public Property Get Subnet
Subnet = msubnet
End Property
Public Property Get Enabled
Enabled = menabled
End Property
Public Property Get Free
Free = mfree
End Property
Public Property Get InUse
InUse = minuse
End Property
Public Property Get Pend
Pend = mpend
End Property
Public Sub SetEnabled(inenabled)
menabled = inenabled
End Sub
End Class
Sub ThrowErrorAndExit(Message)
Call oAPI.LogScriptEvent(DHCP_SCRIPTNAME, DHCP_ERROREVENTNUMBER, SCOM_ERROR, Message)
WScript.Quit
End Sub
Sub Trace(Message)
Call oAPI.LogScriptEvent(DHCP_SCRIPTNAME, DHCP_TRACEEVENTNUMBER, SCOM_INFORMATIONAL, Message)
End Sub
Function ExecuteCmd(strOptionToUse, strCmdToUse, boolReadOutput)
Dim ncControlcommand
Dim strExecOut
Dim strOutputFile, strErrrOutputFile, strGuid
strGuid = GetGUID()
strOutputFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "Data-" + strGUID + ".txt")
strErrrOutputFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "Error-" + strGUID + ".txt")
ncControlcommand = "cmd.exe /C """ & QuoteWrap(strCmdToUse) & " " & strOptionToUse & " > " & QuoteWrap(strOutputFile) & " 2> " & QuoteWrap(strErrrOutputFile) & " " & """"
If boolReadOutput Then
strExecOut = RunCmd(ncControlcommand,strOutputFile, strErrrOutputFile, true)
Else
strExecOut = RunCmd(ncControlcommand,strOutputFile, strErrrOutputFile, false)
End If
ExecuteCmd = strExecOut
End Function
Function GetGUID()
Dim TypeLib, tg
Set TypeLib = CreateObject("Scriptlet.TypeLib")
tg = TypeLib.Guid
Set TypeLib = Nothing
GetGUID = left(tg, len(tg)-2)
End Function
Function RunCmd(CmdString, strOutputFile, strErrrOutputFile, boolGetOutPut)
Dim oExec
Dim output
Dim strOutPut
Dim objFile1, objFile2
Dim strStdOut, strStdErr
Dim ret
ret = oShell.Run(CmdString, 0, boolGetOutPut)
WScript.Sleep(100)
'Get StdOut and StdErr
strStdOut = ""
strStdErr = ""
Set objFile1 = fso.OpenTextFile(strOutputFile)
If Not(objFile1.AtEndOfStream) Then
strStdOut = objFile1.readAll()
End If
objFile1.close()
fso.DeleteFile strOutputFile,true
Set objFile1 = Nothing
Set objFile2 = fso.OpenTextFile(strErrrOutputFile)
If Not(objFile2.AtEndOfStream) Then
strStdErr = objFile2.readAll()
End If
objFile2.close()
fso.DeleteFile strErrrOutputFile,true
Set objFile2 = Nothing
If ret <> 0 Then
Call oAPI.LogScriptEvent(DHCP_SCRIPTNAME, DHCP_ERROREVENTNUMBER, SCOM_ERROR, "Command """ & CmdString & """ failed with the following output:" & VbCrLf & strStdOut & VbCrLf & strStdErr)
End If
If boolGetOutPut Then
strOutPut = strStdOut
Else
strOutPut = "1"
End If
If strStdErr <> "" Then
strOutPut = "Error: " & strStdErr
End If
RunCmd = strOutPut
End Function
Function QuoteWrap(myString)
If (myString <> "") And (left(mySTring,1) <> Chr(34)) And (Right(myString,1) <> Chr(34)) Then
QuoteWrap = Chr(34) & myString & Chr(34)
Else
QuoteWrap = myString
End If
End Function
Function GetSubMatches(ByVal aRegexes, ByVal sText, ByRef sRemainingText, ByRef aCapturedSubMatches)
Dim oRegex
Set oRegex = New RegExp
oRegex.Global = False
Dim oMatches
Dim oMatch
Dim sPattern
Dim aSubMatches()
aCapturedSubMatches = aSubMatches
GetSubMatches = False
Dim i
Dim lSubMatchCount
lSubMatchCount = 0
sRemainingText = sText
For i = 0 To UBound(aRegexes)
sPattern = aRegexes(i)
oRegex.Pattern = "^" & sPattern
Set oMatches = oRegex.Execute(sRemainingText)
If oMatches.Count <> 1 Then
sRemainingText = sText
Exit Function
End If
Set oMatch = oMatches(0)
sRemainingText = Mid(sRemainingText, oMatch.Length + 1)
If i Mod 2 = 1 Then
lSubMatchCount = lSubMatchCount + 1
ReDim Preserve aSubMatches(lSubMatchCount - 1)
aSubMatches(lSubMatchCount - 1) = oMatch.Value
End If
Next
GetSubMatches = True
aCapturedSubMatches = aSubMatches
End Function
Call Main()
Sub Main()
boolOnlyDisabled = true
bFailed = False
IsSuperScope=false
iPending=0
iInuse=0
iFree=0
Set oShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set oArgs = WScript.Arguments
Set oAPI = CreateObject("MOM.ScriptAPI")
' If the script is called without the required arguments, create an information event and Then quit.
If oArgs.Count <> 1 Then
ThrowErrorAndExit "Usage: " & DHCP_SCRIPTNAME & "<target computer FQDN>"
End If
TargetComputer = oArgs(0) ' The FQDN of the computer targeted by the script.
Dim oDHCP, ScopeColl, objSuper, objScope, strScopeInfo, strSuperScopeInfo, tempenabled
Set oDHCP = New DHCPScopes ' this calculates the values
' Write all data to the registry. GetScriptStateKeyPath returns a 'safe' registry path to write data to.
' Registry key is ACL'ed with 'Creator Owner' meaning if you create it you alone (plus Admins) can read it.
Dim sRegPath, sRegData
sRegPath = "HKLM\" & oAPI.GetScriptStateKeyPath("DHCP") & "\ScopePerfData"
' Write Scopes
For Each objScope In oDHCP.GetScopes.items()
If objScope.Enabled = True Then
tempenabled = "0"
Else
tempenabled = "1"
End If
strScopeInfo = objScope.Subnet & vbTab & CStr(objScope.Free) & vbTab & CStr(objScope.InUse) & vbTab & CStr(objScope.Pend) & vbTab & tempenabled
sRegData = sRegData & strScopeInfo & vbCrLf
Next
' Write SuperScopes
For Each objSuper In oDHCP.GetSuperScopes.items()
strSuperScopeInfo = objSuper.Superscopename & vbTab & objSuper.Free & vbTab & objSuper.InUse & vbTab & objSuper.Pend & vbTab & objSuper.IncludeDisabled
sRegData = sRegData & strSuperScopeInfo & vbCrLf
Next
' Write V6Scopes
For Each objScope In oDHCP.GetV6Scopes.items()
If objScope.Enabled = True Then
tempenabled = "0"
Else
tempenabled = "1"
End If
strScopeInfo = objScope.Subnet & vbTab & CStr(objScope.Free) & vbTab & CStr(objScope.InUse) & vbTab & CStr(objScope.Pend) & vbTab & tempenabled
sRegData = sRegData & strScopeInfo & vbCrLf
Next
Call oShell.RegWrite(sRegPath, sRegData)
Set oPropertyBag = oAPI.CreateTypedPropertyBag(SCOM_PB_EVENT)
oPropertyBag.AddValue "RegistryKey", sRegPath
oPropertyBag.AddValue "Error", Err.Description
oAPi.AddItem(oPropertyBag)
oAPi.ReturnItems
End Sub </Script></ScriptBody>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
</WriteAction>
</MemberModules>
<Composition>
<Node ID="Script"/>
</Composition>
</Composite>
</ModuleImplementation>
<OutputType>System!System.CommandOutput</OutputType>
<InputType>System!System.BaseData</InputType>
</WriteActionModuleType>
Home
ENU 
Show References: