Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
'SVCQUERY.VBS
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
Set ServerList = ""
'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("\\servername\Library\IT Library\Server Documentation\Server and Service info\serverlist.txt", 2, True)
For each Object in objDomain
If Object.Class = "Computer" 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("\\servername\Library\IT Library\Server Documentation\Server and Service info\serverlist.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(n)
Set objSrvr = ""
' 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:A4000").Select
objXL.Selection.Font.Bold = True
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 = "\\" & strSrv
objXL.Activecell.offset(0, 1).Activate
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, -1).Activate
End Function
Function Ask(strAction)
intButton = MsgBox(strAction, vbQuestion + vbYesNo, MsgBoxTitle)
Ask = intButton = vbNo
End Function