Need to modify this script to scan all computers in AD not just a list of computers, and to allow an input folder VBS
Hi,
Rob Samson wrote me this great script to scan for services with a specific user in mind.
Currently we need to modify this script to allow for us to put a list of all users we want to scan for, instead of just modifying line 9. this way we can scan for more than one username per scan.
Additionally
We want to modify this to scan all AD instead of just the xls spreadsheet computers.xls
Thanks
Rob Samson wrote me this great script to scan for services with a specific user in mind.
Currently we need to modify this script to allow for us to put a list of all users we want to scan for, instead of just modifying line 9. this way we can scan for more than one username per scan.
Additionally
We want to modify this to scan all AD instead of just the xls spreadsheet computers.xls
Thanks
' declare constant variables
Const FOR_READING = 1 ' declair OpenTextFile variables
Const FOR_WRITE = 2 ' declair OpenTextFile variables
Const FOR_APPENDING = 8 ' declair OpenTextFile variables
Const xlup = -4162
strOutputFile = "Services.csv"
strInputFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "Computers.xls"
strAccount = "NT AUTHORITY\LocalService"
'create objects
Set objFSO = CreateObject("Scripting.FileSystemObject") ' create FSO object
Set objNewFile = objFSO.CreateTextFile(strOutputFile, True) ' create output file
'table headers
objNewFile.WriteLine "Computer Name,Service Name,Caption,RunAs" ' create csv table headers
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
Set objWB = objExcel.Workbooks.Open(strInputFile, False, False)
Set objSheet = objWB.Sheets(1)
On Error Resume Next
' loop all computers
For intRow = 2 To objSheet.Cells(65536, 1).End(xlUp).Row
strComputer = Trim(objSheet.Cells(intRow, 1).Value)
'list services & log-on-as
If Ping(strComputer) = True Then
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
If Err.Number <> 0 Then
'MsgBox "Error connecting to " & strComputer
objNewFile.WriteLine strComputer & "," & "Failed to connect"
Err.Clear
Else
If Trim(strAccount) = "" Then
Set colServices = objWMIService.ExecQuery("Select Name,Caption,StartName From Win32_Service")
Else
Set colServices = objWMIService.ExecQuery("Select Name,Caption,StartName From Win32_Service WHERE StartName='" & Replace(strAccount, "\", "\\") & "'")
End If
For Each objService In colServices
objNewFile.WriteLine strComputer & "," & objService.Name & "," & objService.Caption & "," & objService.StartName
Next
End If
Else
'MsgBox strComputer & " could not be pinged."
objNewFile.WriteLine strComputer & "," & "Failed to ping"
End If
Next
'========= Now get scheduled task information ===========
Set objShell = CreateObject("WScript.Shell")
Set objExec = objShell.Exec("schtasks /s " & strComputer & " /query /v /fo csv /nh")
While objExec.Status
WScript.Sleep 100
Wend
strResults = objExec.StdOut.ReadAll
If InStr(strResults, "no scheduled tasks") > 0 Then
'MsgBox "There are no scheduled tasks on this computer"
Else
For Each strJob In Split(strResults, VbCrLf)
If Trim(strJob) <> "" Then
' Remove outside quotes, then split by ","
arrJob = Split(Mid(strJob, 2, Len(strJob) - 2), """,""")
If Trim(strAccount) = "" Then
objNewFile.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
ElseIf LCase(arrJob(18)) = LCase(strAccount) Then
objNewFile.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
End If
'MsgBox Join(arrJob, VbCrLf)
'MsgBox arrJob(18)
End If
Next
End If
'========================================================
' close object
objNewFIle.Close
objWB.Close False
objExcel.Quit
MsgBox "Done"
Function Ping(strComputer)
Dim objShell, boolCode
Set objShell = CreateObject("WScript.Shell")
boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
If boolCode = 0 Then
Ping = True
Else
Ping = False
End If
end function
Hi neoptoent,
I have attached little more optimized version of the script.
Previous version used only one account and then scanned entire AD, then took the next account and then scanned entire AD again. After I ran it couple of times I realized that this is not really efficient so I shuffled the things around a bit and the script will now work like this:
It will first connect to the PC and then scan the text file for all the accounts and while connected to ONE PC will go through the entire collection of accounts from the txt file of accounts you provide.
This way only ONE connection per ONE AD computer will be done untill all accounts are done.
This is lot more efficient for the network and should be faster as well.
Also, previous version contained the AD Scan filter for XP Service Pack 2 computers ONLY. I have removed that filter (Used it during the testing) and now it will scan Entire AD, servers and workstations.
I have attached little more optimized version of the script.
Previous version used only one account and then scanned entire AD, then took the next account and then scanned entire AD again. After I ran it couple of times I realized that this is not really efficient so I shuffled the things around a bit and the script will now work like this:
It will first connect to the PC and then scan the text file for all the accounts and while connected to ONE PC will go through the entire collection of accounts from the txt file of accounts you provide.
This way only ONE connection per ONE AD computer will be done untill all accounts are done.
This is lot more efficient for the network and should be faster as well.
Also, previous version contained the AD Scan filter for XP Service Pack 2 computers ONLY. I have removed that filter (Used it during the testing) and now it will scan Entire AD, servers and workstations.
On Error Resume Next
' declare constant variables
Const ADS_SCOPE_SUBTREE = 2
Const FOR_READING = 1 ' declair OpenTextFile variables
Const FOR_WRITE = 2 ' declair OpenTextFile variables
Const FOR_APPENDING = 8 ' declair OpenTextFile variables
Const xlup = -4162
strOutputFile = "Services.csv"
'strAccount = "NT AUTHORITY\LocalService"
'create objects
Set objFSO = CreateObject("Scripting.FileSystemObject") ' create FSO object
Set objNewFile = objFSO.CreateTextFile(strOutputFile, True) ' create output file
Set objTextFile = objFSO.OpenTextFile _
("c:\listOfAccounts.txt", FOR_READING)
'table headers
objNewFile.WriteLine "Computer Name,Service Name,Caption,RunAs" ' create csv table headers
' loop all computers
Set oRootDSE = GetObject("LDAP://rootDSE")
sADsPath = "LDAP://" & oRootDSE.Get("defaultNamingContext")
Set oDomain = GetObject(sADsPath)
Set oConnection = CreateObject("ADODB.Connection")
Set oCommand = CreateObject("ADODB.Command")
oConnection.Provider = "ADsDSOObject"
oConnection.Open "Active Directory Provider"
Set oCOmmand.ActiveConnection = oConnection
oCommand.CommandText = _
"Select Name, Location from '" & sADsPath & "' " _
& "Where objectClass='computer'"
oCommand.Properties("Page Size") = 5000
oCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set oRecordSet = oCommand.Execute
oRecordSet.MoveFirst
Do Until oRecordSet.EOF
sIsOnline = Nothing
strComputer = Empty
strComputer = oRecordSet.Fields("Name").Value
strComputer = UCase(strComputer)
sIsOnline = Ping(strComputer)
If IsNull(sIsOnline) Then
objNewFile.WriteLine strComputer & "," & "does NOT exist in Domain"
ElseIf sIsOnline = 11010 Then
objNewFile.WriteLine strComputer & "," & " Computer OFF-Line"
ElseIf sIsOnline = 0 Then
Set objTextFile = Nothing
Set objTextFile = objFSO.OpenTextFile _
("c:\listOfAccounts.txt", FOR_READING)
Do Until objTextFile.AtEndOfStream
strAccount = Empty
strAccount = objTextFile.Readline
Err.Clear
Set objWMIService = Nothing
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
If Err.Number <> 0 Then
'MsgBox "Error connecting to " & strComputer
objNewFile.WriteLine strComputer & "," & "Failed to connect"
Err.Clear
Else
If Trim(strAccount) = "" Then
Set colServices = objWMIService.ExecQuery("Select Name,Caption,StartName From Win32_Service")
Else
Set colServices = objWMIService.ExecQuery("Select Name,Caption,StartName From Win32_Service WHERE StartName='" & Replace(strAccount, "\", "\\") & "'")
End If
For Each objService In colServices
objNewFile.WriteLine strComputer & "," & objService.Name & "," & objService.Caption & "," & objService.StartName
Next
End If
'========= Now get scheduled task information ===========
Set objShell = CreateObject("WScript.Shell")
Set objExec = objShell.Exec("schtasks /s " & strComputer & " /query /v /fo csv /nh")
While objExec.Status
WScript.Sleep 100
Wend
strResults = objExec.StdOut.ReadAll
If InStr(strResults, "no scheduled tasks") > 0 Then
'MsgBox "There are no scheduled tasks on this computer"
Else
For Each strJob In Split(strResults, VbCrLf)
If Trim(strJob) <> "" Then
' Remove outside quotes, then split by ","
arrJob = Split(Mid(strJob, 2, Len(strJob) - 2), """,""")
If Trim(strAccount) = "" Then
objNewFile.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
ElseIf LCase(arrJob(18)) = LCase(strAccount) Then
objNewFile.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
End If
'MsgBox Join(arrJob, VbCrLf)
'MsgBox arrJob(18)
End If
Next
End If
Loop
'========================================================
End If
oRecordSet.MoveNext
Loop
' close object
objNewFIle.Close
objTextFile.close
MsgBox "Done"
Function Ping(strComputer)
Set objWMIService = GetObject(_
"winmgmts:\\.\root\cimv2")
Set colPings = objWMIService.ExecQuery _
("Select * From Win32_PingStatus where Address = '" & strComputer & "'")
For Each oStatus in colPings
Ping = oStatus.StatusCode
Next
'StatusCode
' Data type: uint32
' Access type: Read-only
' Ping command status codes.
' Value Meaning
' 0 Success
' Null Could not find host
' 11001 Buffer Too Small
' 11002 Destination Net Unreachable
' 11003 Destination Host Unreachable
' 11004 Destination Protocol Unreachable
' 11005 Destination Port Unreachable
' 11006 No Resources
' 11007 Bad Option
' 11008 Hardware Error
' 11009 Packet Too Big
' 11010 Request Timed Out
' 11011 Bad Request
' 11012 Bad Route
' 11013 TimeToLive Expired Transit
' 11014 TimeToLive Expired Reassembly
' 11015 Parameter Problem
' 11016 Source Quench
' 11017 Option Too Big
' 11018 Bad Destination
' 11032 Negotiating IPSEC
' 11050 General Failure
End Function
I'm confused.. The title says "computers", the text says users.. Which is it, and what exactly are you trying to accomplish?
You can just use a recursive function to walk AD and do something like this:
function check(OUDN)
set OU = getobject("LDAP://" & OUDN)
for each object in OU
if object.class="computer" then
do something
elseif object.class="organization
check(object.adspath)
end if
next
end function
Granted, that's just rough code off the top of my head, but the theory is sound.. And if you wanted to avoid DCs, then you could just say to ignore object.name="Domain Controllers"...
HTH,
exx
??
You can just use a recursive function to walk AD and do something like this:
function check(OUDN)
set OU = getobject("LDAP://" & OUDN)
for each object in OU
if object.class="computer" then
do something
elseif object.class="organization
check(object.adspath)
end if
next
end function
Granted, that's just rough code off the top of my head, but the theory is sound.. And if you wanted to avoid DCs, then you could just say to ignore object.name="Domain Controllers"...
HTH,
exx
??
ASKER
I keep seeing a command window opening and closing with the c:\windows\system32\schtas
Additionally, is there any way to put in option to select whether to scan service OR scheuled tasks or both?
ASKER
exx1976,
As you can see from the script the user section refers to the user account listed in the service, and the computers refer to the computers/resources being scanned
As you can see from the script the user section refers to the user account listed in the service, and the computers refer to the computers/resources being scanned
Hi neoptoent,
Yes that window popping up is doing so for every PC it scans. I know it's a little irritating, but that was not my code, I just added the options to scan entire AD and to search for multiple accounts.
I will modify the script shortly to include choosing the options for what exactly to scan. I'll post here once it's done.
Yes that window popping up is doing so for every PC it scans. I know it's a little irritating, but that was not my code, I just added the options to scan entire AD and to search for multiple accounts.
I will modify the script shortly to include choosing the options for what exactly to scan. I'll post here once it's done.
Ok here is the script that will prompt you to choose a type of scan you want to do:
Three different choices
1 = Scan ONLY Services
2 = Scan ONLY Tasks
3 = Scan BOTH Services and Tasks
Three different choices
1 = Scan ONLY Services
2 = Scan ONLY Tasks
3 = Scan BOTH Services and Tasks
On Error Resume Next
' declare constant variables
Const ADS_SCOPE_SUBTREE = 2
Const FOR_READING = 1 ' declair OpenTextFile variables
Const FOR_WRITE = 2 ' declair OpenTextFile variables
Const FOR_APPENDING = 8 ' declair OpenTextFile variables
Const xlup = -4162
Const cTitle = "Scan AD Computers"
strOutputFile = "Services.csv"
'strAccount = "NT AUTHORITY\LocalService"
'create objects
Set objFSO = CreateObject("Scripting.FileSystemObject") ' create FSO object
Set objNewFile = objFSO.CreateTextFile(strOutputFile, True) ' create output file
Set oWS = CreateObject("wscript.shell")
Set objTextFile = objFSO.OpenTextFile _
("c:\listOfAccounts.txt", FOR_READING)
'table headers
Do
sAction = InputBox("Please select the Type of scan: " & vbCrLf & vbCrLf &_
"1 = Scan ONLY Services." & vbCrLf &_
"2 = Scan ONLY Tasks." & vbCrLf &_
"3 = Scan BOTH Services and Tasks." ,cTitle,"(Enter number here)")
If Not (sAction = Chr(49) Or sAction = Chr(50) Or sAction = Chr(51)) Then
sRes = oWS.Popup("Sorry, you must enter a number between 1 and 3 to continue." &_
" Do you wish to try again?", ,cTitle,vbExclamation+vbYesNo)
If sRes = vbNo Then
oWS.Popup "User canceled, Exiting script!", , cTitle, vbInformation
WScript.Quit
End If
End If
Loop Until (sAction = Chr(49) Or sAction = Chr(50) Or sAction = Chr(51))
' loop all computers
Set oRootDSE = GetObject("LDAP://rootDSE")
sADsPath = "LDAP://" & oRootDSE.Get("defaultNamingContext")
Set oDomain = GetObject(sADsPath)
Set oConnection = CreateObject("ADODB.Connection")
Set oCommand = CreateObject("ADODB.Command")
oConnection.Provider = "ADsDSOObject"
oConnection.Open "Active Directory Provider"
Set oCOmmand.ActiveConnection = oConnection
oCommand.CommandText = _
"Select Name, Location from '" & sADsPath & "' " _
& "Where objectClass='computer'"
oCommand.Properties("Page Size") = 5000
oCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set oRecordSet = oCommand.Execute
oRecordSet.MoveFirst
Do Until oRecordSet.EOF
sIsOnline = Nothing
strComputer = Empty
strComputer = oRecordSet.Fields("Name").Value
strComputer = UCase(strComputer)
sIsOnline = Ping(strComputer)
If IsNull(sIsOnline) Then
objNewFile.WriteLine strComputer & "," & "does NOT exist in Domain"
ElseIf sIsOnline = 11010 Then
objNewFile.WriteLine strComputer & "," & " Computer OFF-Line"
ElseIf sIsOnline = 0 Then
Set objTextFile = Nothing
Set objTextFile = objFSO.OpenTextFile _
("c:\listOfAccounts.txt", FOR_READING)
Do Until objTextFile.AtEndOfStream
If sAction = Chr(49) Then
objNewFile.WriteLine "Computer Name,Service Name,Caption,RunAs" ' create csv table headers
strAccount = Empty
strAccount = objTextFile.Readline
Err.Clear
Set objWMIService = Nothing
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
If Err.Number <> 0 Then
'MsgBox "Error connecting to " & strComputer
objNewFile.WriteLine strComputer & "," & "Failed to connect"
Err.Clear
Else
If Trim(strAccount) = "" Then
Set colServices = objWMIService.ExecQuery("Select Name,Caption,StartName From Win32_Service")
Else
Set colServices = objWMIService.ExecQuery("Select Name,Caption,StartName From Win32_Service WHERE StartName='" & Replace(strAccount, "\", "\\") & "'")
End If
For Each objService In colServices
objNewFile.WriteLine strComputer & "," & objService.Name & "," & objService.Caption & "," & objService.StartName
Next
End If
ElseIf sAction = Chr(50) Then
objNewFile.WriteLine "Computer Name,Task Name,Caption,RunAs" ' create csv table headers
strAccount = Empty
strAccount = objTextFile.Readline
'========= Now get scheduled task information ===========
Set objShell = CreateObject("WScript.Shell")
Set objExec = objShell.Exec("schtasks /query /s " & strComputer & " /v /fo csv /nh")
' While objExec.Status
' WScript.Sleep 100
' Wend
strResults = objExec.StdOut.ReadAll
If InStr(strResults, "no scheduled tasks") > 0 Then
'MsgBox "There are no scheduled tasks on this computer"
Else
For Each strJob In Split(strResults, VbCrLf)
If Trim(strJob) <> "" Then
' Remove outside quotes, then split by ","
arrJob = Split(Mid(strJob, 2, Len(strJob) - 2), """,""")
If Trim(strAccount) = "" Then
objNewFile.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
ElseIf LCase(arrJob(18)) = LCase(strAccount) Then
objNewFile.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
End If
'MsgBox Join(arrJob, VbCrLf)
'MsgBox arrJob(18)
End If
Next
End If
ElseIf sAction = Chr(51) Then
objNewFile.WriteLine "Computer Name,Service/Task Name,Caption,RunAs" ' create csv table headers
strAccount = Empty
strAccount = objTextFile.Readline
Err.Clear
Set objWMIService = Nothing
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
If Err.Number <> 0 Then
'MsgBox "Error connecting to " & strComputer
objNewFile.WriteLine strComputer & "," & "Failed to connect"
Err.Clear
Else
If Trim(strAccount) = "" Then
Set colServices = objWMIService.ExecQuery("Select Name,Caption,StartName From Win32_Service")
Else
Set colServices = objWMIService.ExecQuery("Select Name,Caption,StartName From Win32_Service WHERE StartName='" & Replace(strAccount, "\", "\\") & "'")
End If
For Each objService In colServices
objNewFile.WriteLine strComputer & "," & objService.Name & "," & objService.Caption & "," & objService.StartName
Next
End If
'========= Now get scheduled task information ===========
Set objShell = CreateObject("WScript.Shell")
Set objExec = objShell.Exec("schtasks /query /s " & strComputer & " /v /fo csv /nh")
While objExec.Status
WScript.Sleep 100
Wend
strResults = objExec.StdOut.ReadAll
If InStr(strResults, "no scheduled tasks") > 0 Then
'MsgBox "There are no scheduled tasks on this computer"
Else
For Each strJob In Split(strResults, VbCrLf)
If Trim(strJob) <> "" Then
' Remove outside quotes, then split by ","
arrJob = Split(Mid(strJob, 2, Len(strJob) - 2), """,""")
If Trim(strAccount) = "" Then
objNewFile.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
ElseIf LCase(arrJob(18)) = LCase(strAccount) Then
objNewFile.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
End If
'MsgBox Join(arrJob, VbCrLf)
'MsgBox arrJob(18)
End If
Next
End If
End If
Loop
'========================================================
End If
oRecordSet.MoveNext
Loop
' close object
objNewFIle.Close
objTextFile.close
MsgBox "Done"
Function Ping(strComputer)
Set objWMIService = GetObject(_
"winmgmts:\\.\root\cimv2")
Set colPings = objWMIService.ExecQuery _
("Select * From Win32_PingStatus where Address = '" & strComputer & "'")
For Each oStatus in colPings
Ping = oStatus.StatusCode
Next
'StatusCode
' Data type: uint32
' Access type: Read-only
' Ping command status codes.
' Value Meaning
' 0 Success
' Null Could not find host
' 11001 Buffer Too Small
' 11002 Destination Net Unreachable
' 11003 Destination Host Unreachable
' 11004 Destination Protocol Unreachable
' 11005 Destination Port Unreachable
' 11006 No Resources
' 11007 Bad Option
' 11008 Hardware Error
' 11009 Packet Too Big
' 11010 Request Timed Out
' 11011 Bad Request
' 11012 Bad Route
' 11013 TimeToLive Expired Transit
' 11014 TimeToLive Expired Reassembly
' 11015 Parameter Problem
' 11016 Source Quench
' 11017 Option Too Big
' 11018 Bad Destination
' 11032 Negotiating IPSEC
' 11050 General Failure
End Function
ASKER
Is there any way to get rid of that popup of teh cmd window...It does not let me work while running it
Addtionally, I created the txt file and put in 3 names, but in the output it did EVERY service and the account being used to run it, not just the one i specified.
Thanks for the help and quick reponses
Addtionally, I created the txt file and put in 3 names, but in the output it did EVERY service and the account being used to run it, not just the one i specified.
Thanks for the help and quick reponses
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Let me try to clarify what I was saying.
I created a file c:\listOfAccounts.txt and put three different usernames to look for
dominname\michael
domainname\bob
domainname\joe
I ran the VB script and then in the results it showed me all the running services on each computer and teh assocaiated name with it
so for example this would be a line of teh results
servera Dhcp DHCP Client NT AUTHORITY\NetworkService
but authority\networkservice was not one of the name i put to look for
Did this help clarify?
I created a file c:\listOfAccounts.txt and put three different usernames to look for
dominname\michael
domainname\bob
domainname\joe
I ran the VB script and then in the results it showed me all the running services on each computer and teh assocaiated name with it
so for example this would be a line of teh results
servera Dhcp DHCP Client NT AUTHORITY\NetworkService
but authority\networkservice was not one of the name i put to look for
Did this help clarify?
Hi, I this should fulfill your requirements.
Regards,
Rob.
Regards,
Rob.
' declare constant variables
Const FOR_READING = 1 ' declair OpenTextFile variables
Const FOR_WRITE = 2 ' declair OpenTextFile variables
Const FOR_APPENDING = 8 ' declair OpenTextFile variables
Const xlup = -4162
strOutputFile = "Services.csv"
strComputersFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "Computers.xls"
strAccountsFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "UserAccounts.txt"
strComputerSource = InputBox("Please select the source for the computer list: " & vbCrLf & vbCrLf & _
"1 = from " & strComputersFile & vbCrLf & _
"2 = from Active Directory (Entire AD)", "Select Scan Type","(Enter number here)")
If strComputerSource <> "1" And strComputerSource <> "2" Then
MsgBox "Invalid source selected. Script will not run."
WScript.Quit
End If
strAction = InputBox("Please select the Type of scan: " & vbCrLf & vbCrLf & _
"1 = Scan ONLY Services." & vbCrLf & _
"2 = Scan ONLY Tasks." & vbCrLf & _
"3 = Scan BOTH Services and Tasks.", "Select Scan Type","(Enter number here)")
If strAction <> "1" And strAction <> "2" And strAction <> "3" Then
MsgBox "Invalid type selected. Script will not run."
WScript.Quit
End If
'create objects
Set objFSO = CreateObject("Scripting.FileSystemObject") ' create FSO object
Set objNewFile = objFSO.CreateTextFile(strOutputFile, True) ' create output file
' read user accounts
strAccountsQuery = ""
strAccountsList = ""
If objFSO.FileExists(strAccountsFile) = True Then
Set objAccountsFile = objFSO.OpenTextFile(strAccountsFile, FOR_READING, False)
While Not objAccountsFile.AtEndOfStream
strLine = Trim(objAccountsFile.ReadLine)
If strLine <> "" Then
If strAccountsQuery = "" Then
strAccountsQuery = " WHERE StartName = '" & Replace(strLine, "\", "\\") & "'"
strAccountsList = strLine
Else
strAccountsQuery = strAccountsQuery & " OR StartName = '" & Replace(strLine, "\", "\\") & "'"
strAccountsList = strAccountsList & ";" & strLine
End If
End If
Wend
objAccountsFile.Close
Set objAccountsFile = Nothing
End If
If strAccountsList <> "" Then arrAccountsList = Split(strAccountsList, ";")
'table headers
objNewFile.WriteLine "Computer Name,Service Name,Caption,RunAs" ' create csv table headers
If strComputerSource = "1" Then
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
Set objWB = objExcel.Workbooks.Open(strComputersFile, False, False)
Set objSheet = objWB.Sheets(1)
' loop all computers
For intRow = 2 To objSheet.Cells(65536, 1).End(xlUp).Row
strComputer = Trim(objSheet.Cells(intRow, 1).Value)
'list services & log-on-as
If strAction = "1" Or strAction = "3" Then
ScanComputerServices strComputer
End If
If strAction = "2" Or strAction = "3" Then
ScanScheduledTasks strComputer
End If
Next
objWB.Close False
objExcel.Quit
ElseIf strComputerSource = "2" Then
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSName = "LDAP://" & objRootDSE.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
Const ADS_SCOPE_SUBTREE = 2
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = _
"Select Name from '" & strDNSName & "' WHERE objectClass='computer'"
Set objRecordSet = objCommand.Execute
While Not objRecordSet.EOF
strComputer = objRecordSet.Fields("name").Value
If strComputer = "D09790RING" Then
If strAction = "1" Or strAction = "3" Then
ScanComputerServices strComputer
End If
If strAction = "2" Or strAction = "3" Then
ScanScheduledTasks strComputer
End If
End If
objRecordSet.MoveNext
Wend
objRecordSet.Close
objConnection.Close
Set objRecordSet = Nothing
Set objConnection = Nothing
End If
' close object
objNewFile.Close
MsgBox "Done"
Function Ping(strComputer)
Dim objShell, boolCode
Set objShell = CreateObject("WScript.Shell")
boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
If boolCode = 0 Then
Ping = True
Else
Ping = False
End If
End Function
Sub ScanComputerServices(strComputer)
If Ping(strComputer) = True Then
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
If Err.Number <> 0 Then
'MsgBox "Error connecting to " & strComputer
objNewFile.WriteLine strComputer & "," & "Failed to connect"
Err.Clear
Else
If Trim(strAccountsQuery) = "" Then
Set colServices = objWMIService.ExecQuery("Select Name,Caption,StartName From Win32_Service")
Else
Set colServices = objWMIService.ExecQuery("Select Name,Caption,StartName From Win32_Service" & strAccountsQuery)
End If
For Each objService In colServices
objNewFile.WriteLine strComputer & "," & objService.Name & "," & objService.Caption & "," & objService.StartName
Next
End If
Else
'MsgBox strComputer & " could not be pinged."
objNewFile.WriteLine strComputer & "," & "Failed to ping"
End If
End Sub
Sub ScanScheduledTasks(strComputer)
Set objShell = CreateObject("WScript.Shell")
strTempFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "SchTasks.txt"
'"cmd /c schtasks /s D09790RING /query /v /fo csv /nh > ""C:\Temp\Temp\Test Script\SchTasks.txt"""
objShell.Run "cmd /c schtasks /s " & strComputer & " /query /v /fo csv /nh > """ & strTempFile & """", 0, True
Set objSchTasks = objFSO.OpenTextFile(strTempFile, FOR_READING, False)
strResults = objSchTasks.ReadAll
objSchTasks.Close
Set objSchTasks = Nothing
objFSO.DeleteFile strTempFile, True
If InStr(strResults, "no scheduled tasks") > 0 Then
'MsgBox "There are no scheduled tasks on this computer"
Else
For Each strJob In Split(strResults, VbCrLf)
If Trim(strJob) <> "" Then
' Remove outside quotes, then split by ","
arrJob = Split(Mid(strJob, 2, Len(strJob) - 2), """,""")
If Trim(strAccountsList) = "" Then
objNewFile.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
Else
For Each strAccount In arrAccountsList
If LCase(arrJob(18)) = LCase(strAccount) Then objNewFile.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
Next
End If
'MsgBox Join(arrJob, VbCrLf)
'MsgBox arrJob(18)
End If
Next
End If
End Sub
Oh, the file you specify for strAccountsFile is just a text file, with one account name per line.
The scheduled task box no longer shows up either.
There is no progress indication, so if you're checking the entire AD, it could take a long time!
Regards,
Rob.
The scheduled task box no longer shows up either.
There is no progress indication, so if you're checking the entire AD, it could take a long time!
Regards,
Rob.
ASKER
I created it as a text file.
the problem is in the services.xls it is showing me every service running on the servers, not ONLY the services that are being run with the accounts specified in the txt file
Make sense?
the problem is in the services.xls it is showing me every service running on the servers, not ONLY the services that are being run with the accounts specified in the txt file
Make sense?
ASKER
let me try again
Hi neoptoent,
Sorry for delayed response, I understand your problem, however I'm confused. I have tested this script in my corporate environment and I get proper results with accounts that are in the text file. I have used multiple different accounts to test services and tasks and both returned expected results.
Let me know what are your results.
Sorry for delayed response, I understand your problem, however I'm confused. I have tested this script in my corporate environment and I get proper results with accounts that are in the text file. I have used multiple different accounts to test services and tasks and both returned expected results.
Let me know what are your results.
ASKER
ok when I choose 1 for ad and services only, it takes about 3 seconds, pops up a box done, and there is nothing in the services.xls besides the headers
ASKER
I meant i choose 2 for AD and 1 for services only
This means that you are not getting connected to your domain at all. Here is the script that just connects to workstations and not the servers, try this and let me know what you get.
On Error Resume Next
' declare constant variables
Const ADS_SCOPE_SUBTREE = 2
Const FOR_READING = 1 ' declair OpenTextFile variables
Const FOR_WRITE = 2 ' declair OpenTextFile variables
Const FOR_APPENDING = 8 ' declair OpenTextFile variables
Const xlup = -4162
Const cTitle = "Scan AD Computers"
strOutputFile = "Services.csv"
'strAccount = "NT AUTHORITY\LocalService"
'create objects
Set objFSO = CreateObject("Scripting.FileSystemObject") ' create FSO object
Set objNewFile = objFSO.CreateTextFile(strOutputFile, True) ' create output file
Set oWS = CreateObject("wscript.shell")
Set objTextFile = objFSO.OpenTextFile _
("c:\listOfAccounts.txt", FOR_READING)
'table headers
Do
sAction = InputBox("Please select the Type of scan: " & vbCrLf & vbCrLf &_
"1 = Scan ONLY Services." & vbCrLf &_
"2 = Scan ONLY Tasks." & vbCrLf &_
"3 = Scan BOTH Services and Tasks." ,cTitle,"(Enter number here)")
If Not (sAction = Chr(49) Or sAction = Chr(50) Or sAction = Chr(51)) Then
sRes = oWS.Popup("Sorry, you must enter a number between 1 and 3 to continue." &_
" Do you wish to try again?", ,cTitle,vbExclamation+vbYesNo)
If sRes = vbNo Then
oWS.Popup "User canceled, Exiting script!", , cTitle, vbInformation
WScript.Quit
End If
End If
Loop Until (sAction = Chr(49) Or sAction = Chr(50) Or sAction = Chr(51))
' loop all computers
Set oRootDSE = GetObject("LDAP://rootDSE")
sADsPath = "LDAP://" & oRootDSE.Get("defaultNamingContext")
Set oDomain = GetObject(sADsPath)
Set oConnection = CreateObject("ADODB.Connection")
Set oCommand = CreateObject("ADODB.Command")
oConnection.Provider = "ADsDSOObject"
oConnection.Open "Active Directory Provider"
Set oCOmmand.ActiveConnection = oConnection
oCommand.CommandText = _
"Select Name, Location from '" & sADsPath & "' " _
& "Where objectClass='computer' and operatingSystemVersion = '5.1 (2600)'"
oCommand.Properties("Page Size") = 5000
oCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set oRecordSet = oCommand.Execute
oRecordSet.MoveFirst
objNewFile.WriteLine "Computer Name,Service/Task Name,Caption,RunAs" ' create csv table headers
Do Until oRecordSet.EOF
sIsOnline = Nothing
strComputer = Empty
strComputer = oRecordSet.Fields("Name").Value
strComputer = UCase(strComputer)
sIsOnline = Ping(strComputer)
If IsNull(sIsOnline) Then
objNewFile.WriteLine strComputer & "," & "does NOT exist in Domain"
ElseIf sIsOnline = 11010 Then
objNewFile.WriteLine strComputer & "," & " Computer OFF-Line"
ElseIf sIsOnline = 0 Then
Set objTextFile = Nothing
Set objTextFile = objFSO.OpenTextFile _
("c:\listOfAccounts.txt", FOR_READING)
Do Until objTextFile.AtEndOfStream
If sAction = Chr(49) Then
strAccount = Empty
strAccount = objTextFile.Readline
Err.Clear
Set objWMIService = Nothing
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
If Err.Number <> 0 Then
'MsgBox "Error connecting to " & strComputer
objNewFile.WriteLine strComputer & "," & "Failed to connect"
Err.Clear
Else
If Trim(strAccount) = "" Then
Set colServices = objWMIService.ExecQuery("Select Name,Caption,StartName From Win32_Service")
Else
Set colServices = objWMIService.ExecQuery("Select Name,Caption,StartName From Win32_Service WHERE StartName='" & Replace(strAccount, "\", "\\") & "'")
End If
For Each objService In colServices
objNewFile.WriteLine strComputer & "," & objService.Name & "," & objService.Caption & "," & objService.StartName
Next
End If
ElseIf sAction = Chr(50) Then
sTmpFileName = Empty
sTmpFile = Empty
sTmpFileName = objFSO.GetTempName
sTmpPath = oWS.ExpandEnvironmentStrings("%TEMP%")
sTmpFile = sTmpPath & "\" & sTmpFileName
Set oTmpFile = objFSO.CreateTextFile(sTmpFile,True)
oTmpFile.Close
strAccount = Empty
strAccount = objTextFile.Readline
'========= Now get scheduled task information ===========
Set objShell = CreateObject("WScript.Shell")
objShell.Run "cmd /c schtasks /query /s " & strComputer & " /v /fo csv /nh >" & sTmpFile, 0, True
' While objExec.Status
' WScript.Sleep 100
' Wend
Set oText = objFSO.OpenTextFile(sTmpFile, 1)
strResults = oText.ReadAll
If InStr(strResults, "no scheduled tasks") > 0 Then
'MsgBox "There are no scheduled tasks on this computer"
Else
For Each strJob In Split(strResults, VbCrLf)
If Trim(strJob) <> "" Then
' Remove outside quotes, then split by ","
arrJob = Split(Mid(strJob, 2, Len(strJob) - 2), """,""")
If Trim(strAccount) = "" Then
objNewFile.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
ElseIf LCase(arrJob(18)) = LCase(strAccount) Then
objNewFile.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
End If
'MsgBox Join(arrJob, VbCrLf)
'MsgBox arrJob(18)
End If
Next
End If
oText.Close
Set oText = Nothing
objFSO.DeleteFile sTmpFile,True
Set oTmpFile = Nothing
ElseIf sAction = Chr(51) Then
strAccount = Empty
strAccount = objTextFile.Readline
Err.Clear
Set objWMIService = Nothing
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
If Err.Number <> 0 Then
'MsgBox "Error connecting to " & strComputer
objNewFile.WriteLine strComputer & "," & "Failed to connect"
Err.Clear
Else
If Trim(strAccount) = "" Then
Set colServices = objWMIService.ExecQuery("Select Name,Caption,StartName From Win32_Service")
Else
Set colServices = objWMIService.ExecQuery("Select Name,Caption,StartName From Win32_Service WHERE StartName='" & Replace(strAccount, "\", "\\") & "'")
End If
For Each objService In colServices
objNewFile.WriteLine strComputer & "," & objService.Name & "," & objService.Caption & "," & objService.StartName
Next
End If
sTmpFileName = Empty
sTmpFile = Empty
sTmpFileName = objFSO.GetTempName
sTmpPath = oWS.ExpandEnvironmentStrings("%TEMP%")
sTmpFile = sTmpPath & "\" & sTmpFileName
Set oTmpFile = objFSO.CreateTextFile(sTmpFile,True)
oTmpFile.Close
strAccount = Empty
strAccount = objTextFile.Readline
'========= Now get scheduled task information ===========
Set objShell = CreateObject("WScript.Shell")
objShell.Run "cmd /c schtasks /query /s " & strComputer & " /v /fo csv /nh >" & sTmpFile, 0, True
' While objExec.Status
' WScript.Sleep 100
' Wend
Set oText = objFSO.OpenTextFile(sTmpFile, 1)
strResults = oText.ReadAll
If InStr(strResults, "no scheduled tasks") > 0 Then
'MsgBox "There are no scheduled tasks on this computer"
Else
For Each strJob In Split(strResults, VbCrLf)
If Trim(strJob) <> "" Then
' Remove outside quotes, then split by ","
arrJob = Split(Mid(strJob, 2, Len(strJob) - 2), """,""")
If Trim(strAccount) = "" Then
objNewFile.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
ElseIf LCase(arrJob(18)) = LCase(strAccount) Then
objNewFile.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
End If
'MsgBox Join(arrJob, VbCrLf)
'MsgBox arrJob(18)
End If
Next
End If
oText.Close
Set oText = Nothing
objFSO.DeleteFile sTmpFile,True
Set oTmpFile = Nothing
End if
Loop
'========================================================
End If
oRecordSet.MoveNext
Loop
' close object
objNewFIle.Close
objTextFile.close
MsgBox "Done"
Function Ping(strComputer)
Set objWMIService = GetObject(_
"winmgmts:\\.\root\cimv2")
Set colPings = objWMIService.ExecQuery _
("Select * From Win32_PingStatus where Address = '" & strComputer & "'")
For Each oStatus in colPings
Ping = oStatus.StatusCode
Next
'StatusCode
' Data type: uint32
' Access type: Read-only
' Ping command status codes.
' Value Meaning
' 0 Success
' Null Could not find host
' 11001 Buffer Too Small
' 11002 Destination Net Unreachable
' 11003 Destination Host Unreachable
' 11004 Destination Protocol Unreachable
' 11005 Destination Port Unreachable
' 11006 No Resources
' 11007 Bad Option
' 11008 Hardware Error
' 11009 Packet Too Big
' 11010 Request Timed Out
' 11011 Bad Request
' 11012 Bad Route
' 11013 TimeToLive Expired Transit
' 11014 TimeToLive Expired Reassembly
' 11015 Parameter Problem
' 11016 Source Quench
' 11017 Option Too Big
' 11018 Bad Destination
' 11032 Negotiating IPSEC
' 11050 General Failure
End FunctionASKER
I have another script currently running that is going through AD for teh locally l0gged on users, So UI know it is not a problem with connecting to AD.
ASKER
WhenI ran the one u just gave me, it is working. in the results it is showing ALL services again not just the ones I want to look for though
can you please attach the results file here so I can take a look at it....start the script, leave it running for several minutes and then attach the results file, please.
also please attach the listofusers.txt file that your're using, so I can take a look.
Thanks.
Thanks.
ASKER
I am attaching both
I have changed the domain name to not publicize this info.
Additionally I had to change the csv to xls for the upload
services.xls
listofAccounts.txt
I have changed the domain name to not publicize this info.
Additionally I had to change the csv to xls for the upload
services.xls
listofAccounts.txt
The file "listofAccounts.txt" you have attached is the actual file you used with the script (save the change for domain name), and the Services.xls is a result?
If that is the case then I"m really puzzled here. I have tested this script multiple times now, and even if I enter nonexisting accounts in "listofAccounts.txt" i just get a bunch of "failed to connect, Does NOT exist in Domain...etc" computers, but never the list of ALL services from the PC's...
Rob, you have any ideas why this is happening to him?
If that is the case then I"m really puzzled here. I have tested this script multiple times now, and even if I enter nonexisting accounts in "listofAccounts.txt" i just get a bunch of "failed to connect, Does NOT exist in Domain...etc" computers, but never the list of ALL services from the PC's...
Rob, you have any ideas why this is happening to him?
Ah, hang on.....you're text file is called
listofAccounts.txt
In my script, did you change this line:
strAccountsFile = Replace(WScript.ScriptFull
to
strAccountsFile = Replace(WScript.ScriptFull
so that the text file name matches? Otherwise my code *will* return details for all accounts....
Regards,
Rob.
listofAccounts.txt
In my script, did you change this line:
strAccountsFile = Replace(WScript.ScriptFull
to
strAccountsFile = Replace(WScript.ScriptFull
so that the text file name matches? Otherwise my code *will* return details for all accounts....
Regards,
Rob.
Yeah, I have set strAccounts to objTextFile.Readline, so that it reads every line while connected to PC's from AD. And the text file that is pointing to is, listOfAccounts.txt.
With my script, I read the text file of accounts before connecting to any computers, and build the query string, like
"Select Name,Caption,StartName From Win32_Service WHERE StartName = 'NT AUTHORITY\LocalService' OR StartName = 'MYDOMAIN\Administrator'"
so that it only execute one query per PC for the services list....
Regards,
Rob.
"Select Name,Caption,StartName From Win32_Service WHERE StartName = 'NT AUTHORITY\LocalService' OR StartName = 'MYDOMAIN\Administrator'"
so that it only execute one query per PC for the services list....
Regards,
Rob.
ASKER
When I use Robs code, It execute Ichoose services only, and AD and 3 seconds later it says done, with no data in the output.
ASKER
Hubason,
As you saw when I use your for just workstations it is giving me all accounts,
Can the txt file somehow not be getting read?
As you saw when I use your for just workstations it is giving me all accounts,
Can the txt file somehow not be getting read?
Yeah I was testing for that and no it's not possible, since if the txt file was not read, you would not see ANY entries in your excel file. I have tested this script on 2 different domains and both worked fine. Can you work with what you have and then filter the results in the excel file?
ASKER
the problem is we are looking for very specific info on the scan, Robs scan works for getting me one users, so I really could wish there was a way to get your working.
does it matter that line 12 lists a user account?
does it matter that line 12 lists a user account?
No because it's commented out with an apostrophe. You can even delete it if you want, i'm sure you'll get the same results.
Can you explain in detail EXACTLY what kind of information are you looking for from your Network Computers? Maybe I can re-write this script for you? But again, I don't see how this script I gave you (and Rob wrote) would not work since It works for me without no problem?
Rob, would it be a problem for you to do a breif test on my last script just to see if you can get proper information from it? Thanks. I don't care about points here, I just want to help the guy.
Can you explain in detail EXACTLY what kind of information are you looking for from your Network Computers? Maybe I can re-write this script for you? But again, I don't see how this script I gave you (and Rob wrote) would not work since It works for me without no problem?
Rob, would it be a problem for you to do a breif test on my last script just to see if you can get proper information from it? Thanks. I don't care about points here, I just want to help the guy.
ASKER
I think it is working, i was able to use it with one username in the file, and now I am running it with multiple and will let you now the results
Glad to hear you were able to make it work for you. Let us know what happens.
Oh NO!!! I just realised in my code that I left in a computer name matching condition for the AD test! It only runs on one computer, which you won't have!! Sorry.
In my code at comment ID 22791717, see lines 100 and 107...comment both out. They do this
If strComputer = "D09790RING" Then
and that's not going to work for you! You could, on the other hand, just change that to a test computer name in your own domain....
Regards,
Rob.
In my code at comment ID 22791717, see lines 100 and 107...comment both out. They do this
If strComputer = "D09790RING" Then
and that's not going to work for you! You could, on the other hand, just change that to a test computer name in your own domain....
Regards,
Rob.
ASKER
Hubasons is working for me.
Hubason,
If I want to close this out award u the point then open a new question:
Adding to your code, check if the users in the txt file are currently locally logged on, or running all processes, how can I make sure you see it? Also do you think that is possible?
Hubason,
If I want to close this out award u the point then open a new question:
Adding to your code, check if the users in the txt file are currently locally logged on, or running all processes, how can I make sure you see it? Also do you think that is possible?
Wow finally, I'm glad it worked out for you.
As for your next question, you don't have to worry about that man, I'm not the only helper here. There are many experts monitoring this section of EE. You just post your question and if not me, somebody here who is a lot better than me will most likely respond. This is a great site to get help and you will be taken care of.
Besides I will monitor the VBScripting section today so don't worry, just post your question.
Good luck.
As for your next question, you don't have to worry about that man, I'm not the only helper here. There are many experts monitoring this section of EE. You just post your question and if not me, somebody here who is a lot better than me will most likely respond. This is a great site to get help and you will be taken care of.
Besides I will monitor the VBScripting section today so don't worry, just post your question.
Good luck.
ASKER
Just amazing..
Thanks so much for the help
Thanks so much for the help
It works in this order:
It will take only ONE Account name from the TEXT file you supply and then scan ALL AD computers for that specific Account name (Example would be "NT AUTHORITY\LocalService")
Text file that contains these account names will have to have ONE account name per line.
Then the script will take the other name and so forth.
I have not changed the logging routines at all so all of this would be written in the same log file.
Also I have replaced the existing PING function with one that is a lot more efficient and faster, and is not relying on external program like CMD.exe to get the PING status.
So test it out and let me know if it works for you
Open in new window