Public Content

SMS Client Status HTA

This is an HTA that will help you see a bunch of information about a client in one handy place.

GetClientRecord

This will show you all information about the SMS client record in the SMS database.

alt

If you have duplicate client records in the SMS database you will get something like the picture below. If you have duplicate records, delete them both so SMS can create things properly. Make sure that you force heartbeat discovery from the client after you delete the records.

alt

CompareGroups

This will query Active Directory for a list of all groups that the computer is a member of. It will then query SMS for the group membership information that is has for that SMS client record and compare the two sets of information to show you any differences. If there are any differences, they should get picked up by SMS the next time that Group Discovery runs (check the “GetClientRecord” results to see when that will be)

alt

I just added the “G999-MATTBTEST – MBTEST” group to my computer and SMS hasn’t had time to discover that new group membership yet…

alt

GetAdverts

This will show you all of the advertisements that SMS thinks the client should get. It will also query the computer itself to see what advertisements it thinks it should get.

alt

GetCollections

This will show you all Collections that the client is a member of.

alt

Click "Read More" to see the code

SMS Check Client Status

  Option Explicit
 
  Dim strSMSServer, strSMSSite, sUserName, sPassword
  Dim SWBemlocator, objWMIService
  Dim DataListServer, DataListClient
 
  Const adBSTR = 8, adVarChar = 200, adDouble = 5, MaxCharacters = 255
 
  strSMSServer = "stl-ic-sms1"
  strSMSSite = "009"
  sUserName = ""
  sPassword = ""
 
  Const sTDOpen = "<p><span size="2" _mce_style="font-size: x-small;" style="font-size: x-small;">"
  Const sTDClose = "</span></p>"
 
 
  Set SWBemlocator = CreateObject("WbemScripting.SWbemLocator")
  Set objWMIService = SWBemlocator.ConnectServer(strSMSServer, "\root\sms\site_" & strSMSSite, sUserName, sPassword)
 
  Sub GetCollections
    Dim SWBemlocator, objWMISMS, strQuery
    Dim colItems, objItem
    Dim strClientName, strOutput
    Dim DataList
 
    Set DataList = CreateObject("ADOR.Recordset")
    DataList.Fields.Append "CollectionName", adVarChar, MaxCharacters
    DataList.Fields.Append "CollectionID", adVarChar, MaxCharacters
    DataList.Fields.Append "LastRefreshTime", adVarChar, MaxCharacters
    DataList.Open
 
    strOutput = ""
    Logging.InnerHTML = ""
    strClientName = ClientName.Value
 
    Logging.InnerHTML = strClientName
 
    Set SWBemlocator = CreateObject("WbemScripting.SWBemlocator")
    Set objWMISMS = SWBemlocator.ConnectServer(strSMSServer, "\root\sms\site_" & strSMSSite, sUserName, sPassword)
 
    'WScript.Echo strQuery
    
 
    strQuery = "SELECT COL.Name, COL.CollectionID, COL.LastRefreshTime, COL.LastMemberChangeTime" & _
      " FROM SMS_FullCollectionMembership FCM" & _
      " INNER JOIN SMS_Collection COL ON FCM.CollectionID = COL.CollectionID" & _
      " WHERE FCM.Name = '" & strClientName & "'"  'w007-4355xbwxmr'"
    
    Logging.InnerHTML = Logging.InnerHTML & "
" & strQuery
 
    Set colItems = objWMISMS.ExecQuery(strQuery,,48)
    For Each objItem In colItems
      DataList.AddNew
      DataList("CollectionName").Value = CStr(objItem.Name)
      DataList("CollectionID").Value = CStr(objItem.CollectionID)
      DataList("LastRefreshTime").Value = CStr(objItem.LastRefreshTime)
      DataList.Update
    Next
 
    If DataList.RecordCount  0 Then
      DataList.Sort = "CollectionName ASC" ' Use DESC/ASC to specify sort order. 
      DataList.MoveFirst
    End If
 
    Do Until DataList.EOF
      Dim sCollectionName, sCollectionID, sLastRefreshTime
      sCollectionName = DataList.Fields.Item("CollectionName")
      sCollectionID = DataList.Fields.Item("CollectionID")
      sLastRefreshTime = DataList.Fields.Item("LastRefreshTime")
      strOutput = strOutput & "" & sTDOpen & sCollectionName & sTDClose & sTDOpen & sCollectionID & sTDClose & sTDOpen & sLastRefreshTime & sTDClose & ""
      DataList.MoveNext
    Loop
 
    strOutput = "" & strOutput
    strOutput = strOutput & "<table border="1"><tbody><tr><td>Name</td><td>CollectionID</td><td>LastRefreshTime</td></tr></tbody></table>"
 
    Logging.InnerHTML = strOutput
 
 
  End Sub
 
 
  Sub GetAdverts
    Dim strClientName, strOutput
    Dim objDictAdvertOK, objDictAdvertUser, objDictAdvertMissing, objDictItem
 
    strOutput = ""
    Logging.InnerHTML = ""
    strClientName = ClientName.Value
 
    Logging.InnerHTML = strClientName
 
    Set objDictAdvertOK = CreateObject("Scripting.Dictionary")
    Set objDictAdvertUser = CreateObject("Scripting.Dictionary")
    Set objDictAdvertMissing = CreateObject("Scripting.Dictionary")
 
 
    Set DataListServer = GetServerAdverts(strClientName)
    Set DataListClient = GetClientAdverts(strClientName)
 
    Do Until DataListClient.EOF
      Dim sClientAdvertID
      sClientAdvertID = DataListClient.Fields.Item("AdvertisementID")
      'WScript.Echo "ClientAdvert: " & sClientAdvertID
      'strAdvCheckQuery = "Select * from 
      'DataListServer.Filter = "(AdvertisementID='" & sClientAdvertID & "')"
      'If DataListServer.RecordCount < 1 Then WScript.Echo DataListServer.RecordCount
      DataListClient.MoveNext
    Loop
 
 
    DataListServer.Sort = "AdvertisementName ASC" ' Use DESC/ASC to specify sort order. 
    
    Do Until DataListServer.EOF
      Dim sServerAdvertID, sServerAdvertName
      sServerAdvertID = DataListServer.Fields.Item("AdvertisementID")
      sServerAdvertName = DataListServer.Fields.Item("AdvertisementName")
      'strOutput = strOutput & "ServerAdvert: " & sServerAdvertID & vbTab & sServerAdvertName & "
"
      'Filter the client list and make sure we have a match
      DataListClient.Filter = "(AdvertisementID='" & sServerAdvertID & "')"
      If DataListClient.RecordCount < 1 Then
        If CheckProgramFlags(sServerAdvertID) = False Then
          'strOutput = strOutput & "Client is missing Advert: " & sServerAdvertID & vbTab & sServerAdvertName & "
"
          If objDictAdvertMissing.Exists(sServerAdvertID)  True Then objDictAdvertMissing.Add sServerAdvertID, sServerAdvertName
          'objDictAdvertMissing.Add sServerAdvertID, sServerAdvertName
          'WScript.Echo DataListClient.RecordCount
        Else
          'strOutput = strOutput & "Advert is per-user so we can't audit: " & sServerAdvertID & vbTab & sServerAdvertName & "
"
          If objDictAdvertUser.Exists(sServerAdvertID)  True Then objDictAdvertUser.Add sServerAdvertID, sServerAdvertName
          'objDictAdvertUser.Add sServerAdvertID, sServerAdvertName
        End If
      Else
        If objDictAdvertOK.Exists(sServerAdvertID)  True Then objDictAdvertOK.Add sServerAdvertID, sServerAdvertName
        'objDictAdvertOK.Add sServerAdvertID, sServerAdvertName
      End If
      DataListServer.MoveNext
    Loop
 
    For Each objDictItem In objDictAdvertMissing.Keys
      'strOutput = strOutput & "MISSING: " & objDictItem & vbTab & objDictAdvertMissing.Item(objDictItem) & "
"
      strOutput = strOutput & "" & sTDOpen & "MISSING" & sTDClose & sTDOpen & objDictItem  & sTDClose & sTDOpen & objDictAdvertMissing.Item(objDictItem) & sTDClose & ""
    Next
    For Each objDictItem In objDictAdvertUser.Keys
      'strOutput = strOutput & "USER: " & objDictItem & vbTab & objDictAdvertUser.Item(objDictItem) & "
"
      strOutput = strOutput & "" & sTDOpen & "PER-USER" & sTDClose & sTDOpen & objDictItem  & sTDClose & sTDOpen & objDictAdvertUser.Item(objDictItem) & sTDClose & ""
    Next
    For Each objDictItem In objDictAdvertOK.Keys
      'strOutput = strOutput & "OK: " & objDictItem & vbTab & objDictAdvertOK.Item(objDictItem) & "
"
      strOutput = strOutput & "" & sTDOpen & "OK" & sTDClose & sTDOpen & objDictItem  & sTDClose & sTDOpen & objDictAdvertOK.Item(objDictItem) & sTDClose & ""
    Next
 
    'Logging.InnerHTML = strOutput
    strOutput = "" & strOutput
    strOutput = strOutput & "<table border="1"><tbody><tr><td>STATUS</td><td>AdvertID</td><td>AdvertName</td></tr></tbody></table>"
 
    Logging.InnerHTML = strOutput
 
  End Sub
 
 
  Function GetServerAdverts(ByVal strClientName)
 
    Dim strQuery, SWBemlocator, objWMISMS, colItems, objItem
    Dim DataList
 
    Set DataList = CreateObject("ADOR.Recordset")
    DataList.Fields.Append "AdvertisementID", adVarChar, MaxCharacters
    'DataListServer.Fields.Append "PackageName", adVarChar, MaxCharacters
    DataList.Fields.Append "AdvertisementName", adVarChar, MaxCharacters
    'DataListServer.Fields.Append "SourcePath", adVarChar, MaxCharacters
    DataList.Open
 
    strQuery = "Select ADV.AdvertisementID, ADV.AdvertisementName " & _
      "from sms_advertisement ADV " & _
      "JOIN SMS_ClientAdvertisementStatus STAT on STAT.AdvertisementID = ADV.AdvertisementID " & _
      "JOIN SMS_R_System SYS ON STAT.ResourceID=SYS.ResourceID " & _
      "where (SYS.netbiosname='" & strClientName & "') "'  & _
      '"AND (STAT.LastState  13)"
  
  '    "JOIN SMS_Package PKG ON ADV.PackageID = PKG.PackageID " & _
 
  
     'strQuery = "Select AdvertisementID, AdvertisementName, CollectionID, STAT.LastStatusMessageIDName " & _
     strQuery = "Select AdvertisementID, AdvertisementName " & _
       "from sms_advertisement ADV " & _
       "INNER JOIN SMS_ClientAdvertisementStatus STAT on STAT.AdvertisementID = ADV.AdvertisementID " & _
       "INNER JOIN SMS_R_System SYS ON STAT.ResourceID=SYS.ResourceID " & _
       "where (SYS.netbiosname='" & strClientName & "') "' & _
       '"AND STAT.LastAcceptanceStatusTime Is Not Null"  'Is this ok to add? Will it only remove the proper "old" records?
  '     '"AND (STAT.LastState  13)"
  '     "INNER JOIN SMS_Collection COL ON ADV.CollectionID = COL.CollectionID " & _
 
    
    'strQuery = "Select * From SMS_R_System where NetBiosName='w009-0281'"
    'strQuery = "Select ResourceID From SMS_R_System"
      
    Set SWBemlocator = CreateObject("WbemScripting.SWBemlocator")
    Set objWMISMS = SWBemlocator.ConnectServer(strSMSServer, "\root\sms\site_" & strSMSSite, sUserName, sPassword)
 
    'WScript.Echo strQuery
    
    Set colItems = objWMISMS.ExecQuery(strQuery,,48)
'    WScript.Echo strQuery
    'WScript.Echo colItems.Count
    For Each objItem In colItems
      'Call CheckProgramFlags(oSWDist.PRG_ProgramName, oSWDist.PKG_PackageID)
      'If CheckProgramFlags(objItem.AdvertisementID) = False Then
        'WScript.Echo objItem.AdvertisementID & vbTab & objItem.AdvertisementName & vbTab & objItem.CollectionID
        DataList.AddNew
        DataList("AdvertisementID").Value = CStr(objItem.AdvertisementID)
        DataList("AdvertisementName").Value = CStr(objItem.AdvertisementName)
        'DataList("PackageName").Value = CStr(objItem.Name)
        'DataList("SourcePath").Value = CStr(objItem.PkgSourcePath)
        DataList.Update
 
        'WScript.Echo objItem.ResourceID
      'End If
    
    Next
 
    If DataList.RecordCount  0 Then
      DataList.Sort = "AdvertisementID ASC" ' Use DESC/ASC to specify sort order. 
      DataList.MoveFirst
    End If
 
    Set GetServerAdverts = DataList
 
  End Function
 
  Function GetClientAdverts(ByVal strClientName)
    '***Get Client info***
    Dim DataList
    Dim objWMIClient, colSWDist, oSWDist
 
    Set DataList = CreateObject("ADOR.Recordset")
    DataList.Fields.Append "AdvertisementID", adVarChar, MaxCharacters
    'DataList.Fields.Append "PackageName", adVarChar, MaxCharacters
    'DataList.Fields.Append "AdvertisementName", adVarChar, MaxCharacters
    DataList.Open
 
    On Error Resume Next
    'Err.Clear
    Set objWMIClient = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
      strClientName & "\root\ccm\Policy\Machine\ActualConfig")
    If Err.Number = 0 Then
      Err.Clear
      On Error Goto 0
 
      Set colSWDist = objWMIClient.ExecQuery("Select * from CCM_SoftwareDistribution")
      'WScript.Echo " - Package Name" & vbTab & "Program Name" & vbTab & "Active Time"
      For Each oSWDist in colSWDist
        DataList.AddNew
        DataList("AdvertisementID").Value = CStr(oSWDist.ADV_AdvertisementID)
        DataList.Update
        'WScript.Echo oSWDist.ADV_AdvertisementID' & vbTab & oSW.PKG_Name & vbTab & oSW.PRG_ProgramName & vbTab & oSW.ADV_ActiveTime
      Next
 
      DataList.Sort = "AdvertisementID ASC" ' Use DESC/ASC to specify sort order. 
      If DataList.EOF  True And DataList.BOF  True Then
        DataList.MoveFirst
      End If
    Else
      MsgBox("Cannot connect to client to check adverts")
    End If
 
    Set GetClientAdverts = DataList
 
  End Function
 
  'Function CheckProgramFlags(strProgramName, strPackageID)
  Function CheckProgramFlags(strAdvertID)
    Dim SWBemlocator, objWMISMS
    Dim strAdvertQuery, colAdvert, objAdvert
    Dim strProgramName, strPackageID
    Dim strProgQuery, colPrograms, objProgram
 
    Const RUNFOREACHUSER = &H10000
 
    CheckProgramFlags = False
 
    Set SWBemlocator = CreateObject("WbemScripting.SWBemlocator")
    Set objWMISMS = SWBemlocator.ConnectServer(strSMSServer, "\root\sms\site_" & strSMSSite, sUserName, sPassword)
 
    strAdvertQuery = "Select * From SMS_Advertisement where AdvertisementID='" & strAdvertID & "'"
    Set colAdvert = objWMISMS.ExecQuery(strAdvertQuery,,48)
    For Each objAdvert In colAdvert
      strProgramName = objAdvert.ProgramName
      strPackageID = objAdvert.PackageID
    Next
 
    strProgQuery = "Select ProgramName, PackageID, ProgramFlags  from SMS_Program where ProgramName = '" & strProgramName & "' AND PackageID = '" & strPackageID & "'"
    Set colPrograms = objWMISMS.ExecQuery(strProgQuery,,48)
    For Each objProgram In colPrograms
      'WScript.Echo objProgram.ProgramFlags & vbTab & objProgram.ProgramName & vbTab & objProgram.PackageID
      'WScript.Echo vbTab & (objProgram.ProgramFlags And RUNFOREACHUSER) '32768 &H00008000
      If (objProgram.ProgramFlags And RUNFOREACHUSER) > 0 Then
        'WScript.Echo "PER USER"
        CheckProgramFlags = True
      End If
    Next
 
 
  End Function
 
 
  Sub GetClientRecord '(strClientName)
    Dim strClientName, strOutput, colItems, objItem, strOUName, intClientCount
 
    strOutput = ""
    Logging.InnerHTML = ""
    strClientName = ClientName.Value
 
    Logging.InnerHTML = strClientName
 
    Set colItems = objWMIService.ExecQuery("Select * from SMS_R_System where Name ='" & strClientName & "'",,48)
 
    intClientCount = 0
    For Each objItem In colItems
 
      Dim intAgentNum, propValue
 
      intClientCount = intClientCount + 1
      strOutput = strOutput & "" & sTDOpen & "Name" & sTDClose & sTDOpen & objItem.Name & sTDClose & ""
      strOutput = strOutput & "" & sTDOpen & "Active" & sTDClose & sTDOpen & objItem.Active & sTDClose & ""
      strOutput = strOutput & "" & sTDOpen & "ADSiteName" & sTDClose & sTDOpen & objItem.ADSiteName & sTDClose & ""
       For Each propValue In objItem.AgentName
         Dim dtmAgentDate
        dtmAgentDate = WMIToNormalDate(objItem.AgentTime(intAgentNum))
        strOutput = strOutput & "" & sTDOpen & "AgentName" & sTDClose & sTDOpen & propValue & sTDClose & sTDOpen & dtmAgentDate & sTDClose & ""
        intAgentNum = intAgentNum + 1
       Next
       'For Each propValue In objItem.AgentSite
       '  strOutput = strOutput & "AgentSite: " & propValue & ""
       'Next
       'For Each propValue In objItem.AgentTime
       '  'strOutput = strOutput & "AgentTime" & propValue & ""
      '  strOutput = strOutput & "" & sTDOpen & "AgentTime" & sTDClose & sTDOpen & propValue & sTDClose & ""
       'Next
      strOutput = strOutput & "" & sTDOpen & "Client" & sTDClose & sTDOpen & objItem.Client & sTDClose & ""
      strOutput = strOutput & "" & sTDOpen & "ClientType" & sTDClose & sTDOpen & objItem.ClientType & sTDClose & ""
      strOutput = strOutput & "" & sTDOpen & "ClientVersion" & sTDClose & sTDOpen & objItem.ClientVersion & sTDClose & ""
      'strOutput = strOutput & "CPUType" & objItem.CPUType & ""
      'strOutput = strOutput & "" & sTDOpen & "CPUType" & sTDClose & sTDOpen & objItem.CPUType & sTDClose & ""
      strOutput = strOutput & "" & sTDOpen & "CreationDate" & sTDClose & sTDOpen & WMIToNormalDate(objItem.CreationDate) & sTDClose & ""
      strOutput = strOutput & "" & sTDOpen & "Decommissioned" & sTDClose & sTDOpen & objItem.Decommissioned & sTDClose & ""
       'strOutput = strOutput & "HardwareID" & objItem.HardwareID & ""
      'strOutput = strOutput & "" & sTDOpen & "HardwareID" & sTDClose & sTDOpen & objItem.HardwareID & sTDClose & ""
      For Each propValue In objItem.IPAddresses
        strOutput = strOutput & "" & sTDOpen & "IPAddresses" & sTDClose & sTDOpen & propValue & sTDClose & ""
      Next
      For Each propValue In objItem.IPSubnets
        strOutput = strOutput & "" & sTDOpen & "IPSubnets" & sTDClose & sTDOpen & propValue & sTDClose & ""
      Next
       'For Each propValue In objItem.IPXAddresses
      '  strOutput = strOutput &  "IPXAddresses: " & propValue & ""
      'Next
       'For Each propValue In objItem.IPXNetworkNumbers
      '  strOutput = strOutput &  "IPXNetworkNumbers: " & propValue & ""
      'Next
      'strOutput = strOutput & "LastLogonUserDomain: " & objItem.LastLogonUserDomain & ""
      strOutput = strOutput & "" & sTDOpen & "LastLogonUserName" & sTDClose & sTDOpen & objItem.LastLogonUserName & sTDClose & ""
      For Each propValue In objItem.MACAddresses
        strOutput = strOutput & "" & sTDOpen & "MACAddresses" & sTDClose & sTDOpen & propValue & sTDClose & ""
      Next
       strOutput = strOutput & "" & sTDOpen & "NetbiosName" & sTDClose & sTDOpen & objItem.NetbiosName & sTDClose & ""
       strOutput = strOutput & "" & sTDOpen & "Obsolete" & sTDClose & sTDOpen & objItem.Obsolete & sTDClose & ""
      'strOutput = strOutput & "OperatingSystemNameandVersion: " & objItem.OperatingSystemNameandVersion & ""
      'strOutput = strOutput & "PreviousSMSUUID: " & objItem.PreviousSMSUUID & ""
      'strOutput = strOutput & "ResourceDomainORWorkgroup: " & objItem.ResourceDomainORWorkgroup & ""
       strOutput = strOutput & "" & sTDOpen & "ResourceId" & sTDClose & sTDOpen & objItem.ResourceId & sTDClose & ""
       'For Each propValue In objItem.ResourceNames
       '  strOutput = strOutput & "ResourceNames: " & propValue & ""
       'Next
      'strOutput = strOutput & "ResourceType: " & objItem.ResourceType & ""
      'For Each propValue In objItem.SMSAssignedSites
      '  strOutput = strOutput & "SMSAssignedSites: " & propValue & ""
      'Next
      'For Each propValue In objItem.SMSInstalledSites
       '  strOutput = strOutput & "SMSInstalledSites: " & propValue & ""
      'Next
       strOutput = strOutput & "" & sTDOpen & "SMSUniqueIdentifier" & sTDClose & sTDOpen & objItem.SMSUniqueIdentifier & sTDClose & ""
      'strOutput = strOutput & "SMSUUIDChangeDate: " & objItem.SMSUUIDChangeDate & ""
      'strOutput = strOutput & "SNMPCommunityName: " & objItem.SNMPCommunityName & ""
       'For Each propValue In objItem.SystemContainerName
      '  strOutput = strOutput & "SystemContainerName: " & propValue
       'Next
       For Each propValue In objItem.SystemGroupName
         strOutput = strOutput & "" & sTDOpen & "SystemGroupName" & sTDClose & sTDOpen & propValue & sTDClose & ""
       Next
       For Each propValue In objItem.SystemOUName
         'strOutput = strOutput & "SystemOUName: " & propValue & ""
         strOUName = propValue
       Next
       strOutput = strOutput & "" & sTDOpen & "OU" & sTDClose & sTDOpen & strOUName & sTDClose & ""
       For Each propValue In objItem.SystemRoles
        strOutput = strOutput & "" & sTDOpen & "SystemRoles" & sTDClose & sTDOpen & propValue & sTDClose & ""
       Next
 
    Next
 
    If intClientCount > 1 Then
      strOutput = strOutput & "<span color="red" _mce_style="color: red;" style="color: red;"><big><b>" & intClientCount & " records found!! Delete them and let them get recreated.</b></big></span>
 
 
" 
    End If
 
    'Get timestamps for SMS AD Group Discovery from the SMS Primary
    strOutput = strOutput & GetGroupDiscInfo
 
    strOutput = "" & strOutput
    strOutput = strOutput & "<table border="1"><tbody><tr><td>Attribute</td><td>Value</td></tr></tbody></table>"
    Logging.InnerHTML = strOutput
  End Sub
 
  Function GetGroupDiscInfo
    Dim colQueryComponentResults, objComponent, strHTML
 
    Set colQueryComponentResults=objWMIService.ExecQuery("SELECT * FROM SMS_ComponentSummarizer" & _
      " WHERE ComponentName='SMS_AD_SYSTEM_GROUP_DISCOVERY_AGENT'" & _
      " And TallyInterval='0001128000100008'")
      '0001128000100008 = Today only - google TallyInterval for others
    For Each objComponent In colQueryComponentResults
      Dim objSWbemDateTime, strLastStarted, dtmLastStarted, dtmLastContacted
      Dim strNextScheduledTime, dtmNextScheduledTime, intState, strState
      Set objSWbemDateTime = CreateObject("WbemScripting.SWbemDateTime")
      dtmLastStarted = WMIToNormalDate(objComponent.LastStarted)
 
      dtmNextScheduledTime = WMIToNormalDate(objComponent.NextScheduledTime)
      dtmLastContacted = WMIToNormalDate(objComponent.LastContacted)
 
'       intState = objComponent.State  'Not accurate....
'       Select Case intState
'         Case 0
'           strState = "Stopped"
'         Case 1
'           strState = "Running"
'         Case Else
'           strState = "UNKNOWN"
'       End Select
      
      strHTML = strHTML & "
Group Discovery Status on the SMS Primary
" & _
        "LastStarted: " & dtmLastStarted & "
" & _
        "NextScheduledTime: " & dtmNextScheduledTime & "
" & _
        "LastContacted (if this is after LastStarted, it will be the time it last finished: " & dtmLastContacted & "
"
        '"State: " & strState & "
" & _
 
    Next
 
    GetGroupDiscInfo = strHTML
 
  End Function
 
  Sub CompareGroups
    Dim strOutput, strClientName
    Dim objDictSMSGroups, objDictADGroups, oADGroup
    Dim colItems, objItem, propValue
    Dim strCompDN, arrGroupList, strGroup
 
    strOutput = ""
    Logging.InnerHTML = ""
    strClientName = ClientName.Value
 
    Logging.InnerHTML = strClientName
 
    Set objDictSMSGroups = CreateObject("Scripting.Dictionary")
    Set objDictADGroups = CreateObject("Scripting.Dictionary")
 
    Set colItems = objWMIService.ExecQuery("Select * from SMS_R_System where Name ='" & strClientName & "'",,48)
    
    'Get Groups from SMS
    For Each objItem In colItems
       For Each propValue In objItem.SystemGroupName
         If objDictSMSGroups.Exists(UCase(propValue))  True Then objDictSMSGroups.Add UCase(propValue), Null
       Next
    Next
 
    'Get Groups from AD
    strCompDN = GetObjDN(strClientName & "$", "computer")
    arrGroupList = LoadGroups(strCompDN)
    If VarType(arrGroupList)  0 Then
      For Each strGroup In arrGroupList
        objDictADGroups.Add UCase("DS\" & strGroup), Null
      Next
    Else
      strOutput = strOutput & "NO GROUPS FOUND IN AD"
    End If
 
    'Compare each group
    For Each oADGroup In objDictADGroups.Keys
      If objDictSMSGroups.Exists(oADGroup) Then
        strOutput = strOutput & "OK---" & oADGroup & "
"
      Else
        strOutput = strOutput & "MISSING---" & oADGroup & "
"
      End IF
    Next
 
    Logging.InnerHTML = strOutput
 
  End Sub
 
  Function LoadGroups(strObjectDN)
    ' Subroutine to populate dictionary object with group memberships.
    ' objUser is the user or computer object, with global scope.
    ' objGroupList is a dictionary object, with global scope.
    
      Dim arrbytGroups, j, arrstrGroupSids(), objGroup
    Dim i, objuser
    ReDim arrGroups(0)
 
    i = 0
    Set objuser = GetObject("LDAP://" & strObjectDN)
    'WScript.Echo objuser.name
    
    'Set objGroupList = CreateObject("Scripting.Dictionary")
      'objGroupList.CompareMode = vbTextCompare
    
      objUser.GetInfoEx Array("tokenGroups"), 0
      arrbytGroups = objUser.Get("tokenGroups")
      If TypeName(arrbytGroups) = "Byte()" Then
        ReDim arrstrGroupSids(0)
        arrstrGroupSids(0) = OctetToHexStr(arrbytGroups)
        Set objGroup = GetObject("LDAP://")
        'objGroupList(objGroup.sAMAccountName) = True
      'arrGroups(i) = objGroup.sAMAccountName
      i = i + 1
      ReDim Preserve arrGroups(i)
        Set objGroup = Nothing
        Exit Function
      End If
 
      If UBound(arrbytGroups) = -1 Then
        Exit Function
      End If
 
      ReDim arrstrGroupSids(UBound(arrbytGroups))
    For j = 0 To UBound(arrbytGroups)
        arrstrGroupSids(j) = OctetToHexStr(arrbytGroups(j))
        Set objGroup = GetObject("LDAP://")
      'WScript.Echo objGroup.sAMAccountName
      arrGroups(i) = objGroup.sAMAccountName
      If i  UBound(arrbytGroups) Then  'dont resize the array after we get the last record
        i = i + 1
        ReDim Preserve arrGroups(i)
      End If
    Next
    Set objGroup = Nothing
 
    LoadGroups = arrGroups
 
  End Function
 
  Function GetObjDN(sObjShortName, sObjType)
    'This function queries AD for a user by SAMAccountName and returns the distinguishedName for it
    '(DN is used for LDAP binds...)
  
    Dim sDomainADsPath, sProperties, strCmdTxt
    Dim sUser, sPassword
    Dim oCon, oCmd, oRecordSet
    Dim intRecordCount
 
    sDomainADsPath = "LDAP://" & ADRoot
 
    Set oCon = CreateObject("ADODB.Connection")
    oCon.Provider = "ADsDSOObject"
    oCon.Open "ADProvider", sUser, sPassword
    Set oCmd = CreateObject("ADODB.Command")
    Set oCmd.ActiveConnection = oCon
 
    'sProperties = "name,ADsPath,description,mail,memberof"
    sProperties = "distinguishedname"
    strCmdTxt = ";(&(objectCategory=" & sObjType & ")(SamAccountName=" & sObjShortName & "));" & sProperties & ";subtree"
    'WScript.Echo strCmdTxt
    oCmd.CommandText = strCmdTxt
    oCmd.Properties("Page Size") = 100
    On Error Resume Next
    Set oRecordSet = oCmd.Execute
    On Error goto 0
 
    intRecordCount = oRecordSet.RecordCount
    If intRecordCount = 1 Then
      oRecordSet.MoveFirst
      While Not oRecordSet.EOF
 
        Dim strObjDN, arrObjDN, strDNPart, intDNPart, intOUDNEntry
        'Get the object's distinguishedname
        strObjDN = oRecordSet.Fields("distinguishedname")
        oRecordSet.MoveNext
      Wend
      GetObjDN = strObjDN
    End If
 
  End Function  ' End of GetObjDN Function

  Function ADRoot()
 
    Dim oRootDSE
    On Error Resume Next
    Set oRootDSE = GetObject("LDAP://RootDSE")
    If Err.Number  0  Then
      ADRoot = "DC=DS,DC=AD,DC=SSMHC,DC=com"
    Else
      ADRoot = oRootDSE.Get("defaultNamingContext")
    End If
  End Function
 
  Function OctetToHexStr(arrbytOctet)
  ' Function to convert OctetString (byte array) to Hex string.
  
    Dim k
    OctetToHexStr = ""
    For k = 1 To Lenb(arrbytOctet)
      OctetToHexStr = OctetToHexStr _
        & Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)
    Next
  End Function
 
  Function WMIToNormalDate(strWMIDate)
    On Error Resume Next
    Dim objSWbemDateTime, dtmNormalDate
    Set objSWbemDateTime = CreateObject("WbemScripting.SWbemDateTime")
    objSWbemDateTime.Value = Replace(strWMIDate, "***", "000")
    dtmNormalDate = objSWbemDateTime.GetVarDate(False)
    WMIToNormalDate = dtmNormalDate
    On Error Goto 0
  End Function

// -->
 
 
 
 
 
 
 
 
 
  <table border="1" rules="none" frame="box">
 
    <tbody><tr>
      <td>Client Name</td>
      <td><input type="text" name="ClientName" size="21" /></td>
      <td></td>
      <td></td>
    </tr>
    <tr>
      <td><input type="button" value="GetClientRecord" name="GetClientRecord" /></td>
      <td><input type="button" value="CompareGroups" name="CompareGroups" /></td>
      <td><input type="button" value="GetAdverts" name="GetAdverts" /></td>
      <td><input type="button" value="GetCollections" name="GetCollections" /></td>
    </tr>
 
 
 
  </tbody></table>
 
 
 
 
  <span id="Logging" </span>

Main Menu

Weblinks

Some of our Favorite Blogs

SMS Client Status HTA