Enumerating all services on all servers in a domain.

[cmwoodman]

OK,i have some code (that i got off another site so it is not mine ) that is susposed to enumerate all the servers on the domain, then go through and list all of the services on each server and drop them in to an excel doc. it appears to work. but closer examination shows that the for the first few servers it repeats all of the service information. I have addes a Set objsvr=nothing string but it is not changing anything any suggestions?

Here is the code:

Option Explicit
On error resume Next

Dim objXL
Dim objFS
Dim re
Dim MsgBoxTitle
Dim strDomain
Dim strServer
Dim objDomain
Dim Object
Dim Serverlist
Dim objComp
Dim x
Dim Servers
Dim sLines
Dim n
Dim strSrv
Dim objSrvr
Dim Service
Dim objSrvc
Dim Status
Dim Startup
Dim User
Dim intButton
Dim strDeps
Dim strDep

Set objFS = Wscript.CreateObject("Scripting.FileSystemObject")
Set objXL = WScript.CreateObject("Excel.Application")
Set re = new RegExp
MsgBoxTitle = "Service Query Script"

'BEGIN Main Script Body

'prompt for server name or all or workstation if you'd like
strDomain = InputBox("Which Domain are Server(s) in ?", MsgBoxTitle)
strServer = InputBox("Which server do you wish to query services on ? " & vbCRLF & chr(40) & "Use * to query all servers" & chr(41), MsgBoxTitle)

If strServer = "" Then
Wscript.Echo "No Server name provided, Service Query Script will Terminate"
Wscript.Quit
End If

'For those of us who use \\ in front of computer names
If Left(strServer,2) = "\\" Then
strServer = Mid(strServer,3)
End If

'Get all Servers
If strServer = "*" Then

'Define Domain as ADSI Object
Set objDomain = GetObject("WinNT://" & strDomain)

'Create a list of all Servers in the domain, not necessary but nice to have
Set ServerList = objFS.OpenTextFile("c:\temp\srvrlist.txt", 2, True)
For each Object in objDomain
If Object.class = "Server" Then
set objComp = CreateObject("dajNTADM.Computer")
x = objComp.IsComputerServer(Object.Name)
If x = 1 Then
If objFS.DriveExists("\\" & Object.Name & "\" & "C$") = true Then
ServerList.Writeline(Object.Name)
End If 'Online
End If 'Is Server
End If 'Is Computer
Next
ServerList.Close

'Open our List for Reading
Set ServerList = objFS.OpenTextFile("c:\temp\srvrlist.txt", 1, True)
Servers = ServerList.ReadAll

'create array from data in srvrlist.txt by split into lines
sLines = Split(Servers, vbCRLF)

'Layout Spreadsheet
setupXL()

'cycle through each server in domain
For n = 0 to (Ubound(sLines) - 1)
strSrv = sLines
objXL.Activecell.Value = "\\" & strSrv
objXL.Activecell.offset(0, 1).Activate
Set objSrvr = GetObject("WinNT://" & strDomain & "/" & strSrv)
objSrvr.Filter = Array("Service")
For each Service in objSrvr
GetServices()
Next

objXL.activecell.offset(2, -1).Activate
Next 'Server

objXL.Range("A1:A2000").Select
objXL.Selection.Font.Bold = True

ServerList.Close
Else

'Get One Server
strServer = UCASE(strServer)

'Check connection to Machine
If not objFS.DriveExists("\\" & strServer & "\" & "C$") = true Then
WScript.Echo ("Cannot establish connection with \\" & strServer & vbCRLF & "If this is a valid name, the machine may not be turned on" & vbCRLF & vbCRLF & "Service Query Script will Terminate")
WScript.Quit
End If

'Check if server
set objComp = CreateObject("dajNTADM.Computer")
x = objComp.IsComputerServer(strServer)
If x <> 1 Then

'Check if you want to query a non-server
If Ask("This Machine is not a Server, do you still want to query services?") Then
Wscript.Echo "Service Query Script will Terminate"
Wscript.Quit
Else
SingleServer()
objXL.Cells(1, 1).Value = "Computer"
End If 'If Ask
Else
SingleServer()
End If
End If 'If Single Server
objXL.Range("A1").Select
wscript.echo "Service Query Script Complete" & vbCRLF & vbCRLF & "Save spreadsheet to filename and location of your choice."
'END Main Script Body

'Define Functions Used

Function SingleServer()
setupXL()
strSrv = strServer
objXL.Activecell.Value = "\\" & strSrv
objXL.Activecell.offset(0, 1).Activate
Set objSrvr = GetObject("WinNT://" & strDomain & "/" & strSrv)
objSrvr.Filter = Array("Service")
For each Service in objSrvr
GetServices()
Next 'Service

objXL.Range("A1:A200").Select
objXL.Selection.Font.Bold = True
Set objSrvr.Filter = Nothing
Set objSrvc = Nothing
End Function

Function setupXL()
objXL.Visible = TRUE
objXL.WorkBooks.Add
objXL.Columns(1).ColumnWidth = 20
objXL.Columns(2).ColumnWidth = 50
objXL.Columns(3).ColumnWidth = 10
objXL.Columns(4).ColumnWidth = 10
objXL.Columns(5).ColumnWidth = 20
objXL.Columns(6).ColumnWidth = 35
objXL.Cells(1, 1).Value = "Server"
objXL.Cells(1, 2).Value = "Service"
objXL.Cells(1, 3).Value = "Status"
objXL.Cells(1, 4).Value = "Startup"
objXL.Cells(1, 5).Value = "Logging On As"
' objXL.Cells(2, 5).Value = (chr(40) & "I" & chr(41) & " = Interactive")
objXL.Cells(1, 6).Value = "Path"
objXL.Range("A1:Z1").Select
objXL.Selection.Font.Bold = True
objXL.ActiveSheet.range("A4").Activate
End Function

Function GetServices()
Set objSrvc = objSrvr.GetObject("Service", Service.Name)
If objSrvc.Status = 1 then
Status = "Stopped"
ElseIf objSrvc.Status = 4 then
Status = "Running"
Else Status = "Other"
End If
If objSrvc.StartType = 3 then
Startup = "Manual"
ElseIf objSrvc.StartType = 2 then
Startup = "Automatic"
ElseIf objSrvc.StartType = 4 then
Startup = "Disabled"
Else Startup = "Unknown"
End If
User = objSrvc.ServiceAccountName
re.Pattern = "\."
re.Global = True
If re.Test(User) = true Then
User = re.replace (User, strSrv)
End If
If User = "LocalSystem" Then
User = "System Account"
End If
' If Service.ServiceType > 100 Then
' User = (User & chr(40) & "I" & chr(41))
' End If

objXL.Activecell.Value = Service.DisplayName & chr(40) & Service.Name & chr(41)
objXL.Activecell.offset(0, 1) = Status
objXL.Activecell.offset(0, 2) = Startup
objXL.Activecell.offset(0, 3) = User
objXL.Activecell.offset(0, 4) = Service.Path
objXL.Activecell.offset(1, 0).Activate
End Function

Function Ask(strAction)
intButton = MsgBox(strAction, vbQuestion + vbYesNo, MsgBoxTitle)
Ask = intButton = vbNo
End Function