VBScript version of MP Spy (MPGetPolicy.exe)

Article
02/07/2006

MP Spy (MPGetPolicy.exe) is a tool included in the SMS 2003 Toolkit 2 that is used to view the current policies available on a particular SMS 2003 Management Point. This tool can come in handy when troubleshooting why a client isn't reporting something, running an advertisement, etc... The problem with the tool is that it has no method of exporting this valuable information.

Attached is a VBScript that is meant to run on an SMS Site server. This script queries the database to get a list of policies, queries the SMS Provider to get a list of MPs for that particular site, then queries the MP through IIS to dump the actual policies to a log file.

 'Script Name: GetSMSPolicies.vbs
'Script Author: Rslaten
'Script Purpose: Collect SMS 2003 MP Policy data
'Script Creation Date: 11/03/2005
'Script Version: 1.1
'Revision History

'Ver    Date        Person    Description
'-----------------------------------------------------------------------------------------
'1.0    11/07/2005    rslaten    Released Script for testing
'1.1    02/07/2006    rslaten    Forced refresh of SCF in case MP had changed

                                  'and allowed 0 parameters to be passed to script

'Other Information
'This script gets policies from an SMS site server and MP
'The first argument passed should be the path to the log file directory

'Set globals
Dim LogFile, SCRIPT_NAME, MyLog
SCRIPT_NAME = "SMS2003Policies"

'Call to start program
Main

Sub Main
    'On Error Resume Next
    Dim smsProviderPath, smsSQLServer, smsDBName, aDBPolicies, aMPs

    'Initialize Logging
    GetCommandLineArguments
    Set MyLog = New Logging
    MyLog.LogThisWTime "Log File Path: " & LogFile
    
    'Get provider path
    smsProviderPath = GetSMSNameSpace
    
    'Get SQL database server
    smsSQLServer = GetSQLServer
    
    'Get SQL database name
    smsDBName = GetSMSDatabaseName
    
    'Query DB for policies
    aDBPolicies = GetPoliciesFromDB(smsSQLServer, smsDBName)
    
    'Query SMS Provider for MP(s)
    aMPs = GetMPs(smsProviderPath)
    
    'Query MPs for policies
    For each MP in aMPs
        GetSMSMPPolicies MP, aDBPolicies
    Next
    
    'Done
    Bailout
End Sub

'Connect to MP and log policies
Sub GetSMSMPPolicies(sMP, aPolicies)
    On Error Resume Next
    Dim objXMLHttp, oPolicy, newVar, sPolID, sPolVer, sNewVer
    Dim sHttpString, sHTML
    MyLog.LogThisWTime "Connecting to MP: " & sMP
    Set objXMLHttp = CreateObject("Msxml2.ServerXMLHTTP")
    For each oPolicy in aPolicies
        newVar = Split(oPolicy,",")
        sPolID = newVar(0)
        sPolVer = newVar(1)
        sNewVer = Replace(sPolVer,".","_")
        sHttpString = "https://" & sMP & "/SMS_MP/.sms_pol?" & sPolID & "." &sNewVer
        MyLog.LogThis "Policy ID = " &sPolID
        MyLog.LogThis "Version = "&sPolVer
        MyLog.LogThis "URL = " &sHttpString
        MyLog.LogThis ""
        objXMLHttp.open "GET", sHttpString, False
        objXMLHttp.send
        sHTML = objXMLHTTP.ResponseText
        MyLog.LogThis sHTML
        MyLog.LogThis ""
        MyLog.LogThis ""
    Next
    Set objXMLHttp = Nothing
End Sub

'Query SMS Provider for default MP
Function GetMPs(sSMSProv)
    On Error Resume Next
    Dim refWMI, colSysRes, sQry, aMPs(), sSiteCode, sRes
    Dim start, finish, tempMP, i
    sSiteCode = Right(sSMSProv, 3)
    Set refWMI = GetObject("winMgmts:" & sSMSProv)
    If Err.number <> 0 Then
        MyLog.LogThisWTime "Unable to connect to SMS Provider: " & sSMSProv
        MyLog.LogThisWTime "Error = " & Err.number & " - " & Err.Description
        Bailout
    End If
    'Refesh site control file in case MP list has changed
    sQry = "select * from SMS_SiteControlFile where FileType = 1 and SiteCode = '" &sSiteCode& "'"
    Set colSysRes = refWMI.ExecQuery(sQry)
    If Err.number <> 0 Then
        MyLog.LogThisWTime "Unable to query SMS Provider: " & sSMSProv
        MyLog.LogThisWTime "Query: " & sQry
        MyLog.LogThisWTime "Error = " & Err.number & " - " & Err.Description
        Bailout
    End If
    For each SCI in colSysRes
        SCI.Refresh
    Next
    Set colSysRes = Nothing
    'Query provider for MPs
    sQry = "select * from sms_sci_sysresuse where SiteCode = '" &sSiteCode& "'"
    Set colSysRes = refWMI.ExecQuery(sQry)
    If Err.number <> 0 Then
        MyLog.LogThisWTime "Unable to query SMS Provider: " & sSMSProv
        MyLog.LogThisWTime "Query: " & sQry
        MyLog.LogThisWTime "Error = " & Err.number & " - " & Err.Description
        Bailout
    End If
    For each sRes in colSysRes
        If sRes.RoleName = "SMS Management Point" Then
            start = InStr(sRes.NALPath,"=\\") + 3
            finish = InStr(sRes.NALPath,"]MSWNET") - 2
            tempMP = mid(sRes.NALPath,start,finish-start)
            ReDim Preserve aMPs(i)
            aMPs(i) = tempMP
            i = i + 1
        End If
    Next
    Set colSysRes = Nothing
    Set refWMI = Nothing
    GetMPs = aMPs
End Function

'Queries SQL database and retrieves policies from DB
Function GetPoliciesFromDB(sSrv,sDb)
    On Error Resume Next
    Dim objConn, objRS, sSQL, sConnStr, i
    Dim aGroups()
    sSQL = "select * from policy"
    sConnStr = "DRIVER={SQL Server};SERVER=" & sSrv & ";DATABASE=" & sDb & ";UID=;PWD=;TRUSTED"
    Set objConn = CreateObject("ADODB.Connection")
    objConn.Open sConnStr
    If Err.number <> 0 Then
        MyLog.LogThisWTime "Unable to connect to " & sSrv & " - " & sDb
        MyLog.LogThisWTime "Connection String = " & sConnStr
        MyLog.LogThisWTime "Error = " & Err.number & " - " & Err.Description
        Bailout
    End If
    Set objRS = CreateObject("ADODB.Recordset")
    Set objRS.ActiveConnection = objConn
    objRS.Open sSQL
    i = -1
    If Not objRS Is Nothing Then
        While Not objRS.EOF
            i = i + 1
            ReDim Preserve aGroups(i)
            aGroups(i) = objRS(0)&","&objRS(1)&","&objRS(2)
            objRS.MoveNext
        Wend
    End If
    objRS.Close
    Set objRS = Nothing
    objConn.Close
    Set objConn = Nothing
    GetPoliciesFromDB = aGroups
End Function

'Gets SMS SQL Server name from site server's registry
Function GetSQLServer
    On Error Resume Next
    Dim objFSO, objShell, sRegKey, sSQLServer
    sRegKey = "HKLM\SOFTWARE\Microsoft\SMS\SQL Server\Server"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("WScript.Shell")
    sSQLServer = objShell.RegRead(sRegKey)
    If Err.number <> 0 Then
        MyLog.LogThisWTime "Error reading registry key: " &sRegKey
        MyLog.LogThisWTime "Error = " & Err.number & " - " & Err.Description
        Bailout
    End If
    Set objShell = Nothing
    Set objFSO = Nothing
    GetSQLServer = sSQLServer    
End Function

'Gets SMS Database Name from site server's registry
Function GetSMSDatabaseName
    On Error Resume Next
    Dim objFSO, objShell, sRegKey, sSQLDB
    sRegKey = "HKLM\SOFTWARE\Microsoft\SMS\SQL Server\Database Name"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("WScript.Shell")
    sSQLDB = objShell.RegRead(sRegKey)
    If Err.number <> 0 Then
        MyLog.LogThisWTime "Error reading registry key: " &sRegKey
        MyLog.LogThisWTime "Error = " & Err.number & " - " & Err.Description
        Bailout
    End If
    Set objShell = Nothing
    Set objFSO = Nothing
    GetSMSDatabaseName = sSQLDB
End Function

'Gets the SMS WMI Provider namespace in case of remote provider
Function GetSMSNameSpace()
    On Error Resume Next
    Dim colNameSpaceQuery, refitem, refWMI
    Set refWMI = GetObject("winMgmts:\root\sms")
    If Err.number <> 0 Then
        MyLog.LogThisWTime "Error connecting to SMS namespace on local machine: winmgmts:\\root\sms"
        MyLog.LogThisWTime "Error = " & Err.number & " - " & Err.Description
        Bailout
    End If
    Set colNameSpaceQuery = refWMI.ExecQuery("select * from SMS_ProviderLocation")
    For Each refitem in colNameSpaceQuery
        MyLog.LogThisWTime "SMS Provider Namespace Path: " & refitem.NamespacePath
        GetSMSNameSpace = refitem.NamespacePath
    Next
    Set colNameSpaceQuery = Nothing
    Set refitem = Nothing
    Set refWMI = Nothing
End Function

'Gets Command line args
Sub GetCommandLineArguments
    On Error Resume Next
    Dim counter
    Dim WSHShell
    'This sets the LogFile global
    LogFile = WScript.Arguments(0)
    If Err.number <> 0 Then
        Set WSHShell = WScript.CreateObject("Wscript.Shell")
        LogFile = WSHShell.CurrentDirectory
        Set WSHShell = Nothing
    End If
    
    If Right(LogFile, 1) = "\" Then
        LogFile = Left(LogFile, Len(LogFile) - 1)
    End If
    'Add component log name
    LogFile = LogFile & "\" & SCRIPT_NAME & ".log"
    For Each arg in WScript.Arguments
        If counter <> 0 Then
            'Grab any other parameters here
        End If
        counter = counter + 1
    Next
End Sub

'Logging Class
Class Logging
    Private m_LogFile, m_objFSO, m_objLogFile, m_objTextStream
    
    Private Sub Class_Initialize() 'Constructor
        m_LogFile = LogFile 'Set member variable to value of global here
        Set m_objFSO = CreateObject("Scripting.FileSystemObject")
        If(Not(m_objFSO.FileExists(m_LogFile))) Then
            m_objFSO.CreateTextFile m_LogFile
        End If
        Set m_objLogFile = m_objFSO.GetFile(m_LogFile)
        Set m_objTextStream = m_objLogFile.OpenAsTextStream(8,0)
    End Sub
    
    Public Sub LogThis(text)
        m_objTextStream.WriteLine text
    End Sub
    
    Public Sub LogThisWTime(text)
        m_objTextStream.WriteLine "["&Now&"]" & "     " &text
    End Sub
    
    Private Sub Class_Terminate 'Destructor
        m_objTextStream.Close()
        Set m_objFSO = Nothing
        Set m_objLogFile = Nothing
        Set m_objTextStream = Nothing
    End Sub
End Class

'Routine for quiting script
Sub Bailout
    Set MyLog = Nothing
    WScript.Quit
End Sub

GetSMSPolicies.zip

VBScript version of MP Spy (MPGetPolicy.exe)

Additional resources