VBScript version of MP Spy (MPGetPolicy.exe)
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