Solved

Need to modify this script to scan all computers in AD not just a list of computers, and to allow an input folder  VBS

Posted on 2008-10-20
38
463 Views
Last Modified: 2012-06-22
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
' 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

Open in new window

0
Comment
Question by:neoptoent
  • 17
  • 15
  • 5
  • +1
38 Comments
 
LVL 7

Expert Comment

by:Hubasan
ID: 22760107
Here is the above script that is able to accept a text file for different accounts to look for and also scans entire AD(including all the servers you have there)

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

' 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
 
Do Until objTextFile.AtEndOfStream
	strAccount = objTextFile.Readline
	 
	On Error Resume Next
	' 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
	
	Do Until oRecordSet.EOF
		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 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
			'========================================================
		 
		End If
		oRecordSet.MoveNext
	Loop
 
Loop
' close object
objNewFIle.Close
objTextFile.close
MsgBox "Done"
 
Function Ping(strComputer)
Set oWMI = GetObject(_ 
    "winmgmts:\\.\root\cimv2")
Set colPings = oWMI.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

Open in new window

0
 
LVL 7

Expert Comment

by:Hubasan
ID: 22760823
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.
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

Open in new window

0
 
LVL 18

Expert Comment

by:exx1976
ID: 22768774
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="organizationUnit" or object.class="container" then
                      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
??
0
Netscaler Common Configuration How To guides

If you use NetScaler you will want to see these guides. The NetScaler How To Guides show administrators how to get NetScaler up and configured by providing instructions for common scenarios and some not so common ones.

 

Author Comment

by:neoptoent
ID: 22786323

I keep seeing a command window opening and closing with the c:\windows\system32\schtasks.cmd in the header...Is this being used to check teh scheduled tasks on the computers?
Additionally, is there any way to put in option to select whether to scan service OR scheuled tasks or both?


 
0
 

Author Comment

by:neoptoent
ID: 22786351
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
0
 
LVL 7

Expert Comment

by:Hubasan
ID: 22786417
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.
0
 
LVL 7

Expert Comment

by:Hubasan
ID: 22787868
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
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

Open in new window

0
 

Author Comment

by:neoptoent
ID: 22787957
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
 
 
0
 
LVL 7

Accepted Solution

by:
Hubasan earned 500 total points
ID: 22789237
I don't understand your last post?

Qoute : "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" End Quote.

This was your request so I gave you the ability to create a text file with ONE username per line to scan for on every computer from AD. So depending on the choice from the begining of the script, you will scan either all services for those users, all tasks for those users or BOTH all services and tasks for all those users that you place in your text file.

What is the problem?

I have attached the script below that removes the CMD window completely and uses the temp file on your PC to read the output of scheduled tasks. This is more HardDrive intensive and it may Fragment your drive faster than usually.
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
 
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 Function

Open in new window

0
 

Author Comment

by:neoptoent
ID: 22789680
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?

 
 
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22791717
Hi, I this should fulfill your requirements.

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

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22791729
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.
0
 

Author Comment

by:neoptoent
ID: 22795631
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?
0
 

Author Comment

by:neoptoent
ID: 22795775
let me try again
0
 
LVL 7

Expert Comment

by:Hubasan
ID: 22795785
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.
0
 

Author Comment

by:neoptoent
ID: 22795806
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
 
 
0
 

Author Comment

by:neoptoent
ID: 22795819
I meant i choose 2 for AD and 1 for services only
0
 
LVL 7

Expert Comment

by:Hubasan
ID: 22795888
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 Function

Open in new window

0
 

Author Comment

by:neoptoent
ID: 22796010
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.
0
 

Author Comment

by:neoptoent
ID: 22796040
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
0
 
LVL 7

Expert Comment

by:Hubasan
ID: 22796057
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.
0
 
LVL 7

Expert Comment

by:Hubasan
ID: 22796070
also please attach the listofusers.txt file that your're using, so I can take a look.

Thanks.
0
 

Author Comment

by:neoptoent
ID: 22796420
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
0
 
LVL 7

Expert Comment

by:Hubasan
ID: 22797466
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?
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22805626
Ah, hang on.....you're text file is called
listofAccounts.txt

In my script, did you change this line:
strAccountsFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "UserAccounts.txt"

to
strAccountsFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "listOfAccounts.txt"

so that the text file name matches?  Otherwise my code *will* return details for all accounts....

Regards,

Rob.
0
 
LVL 7

Expert Comment

by:Hubasan
ID: 22806034
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.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22809299
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.
0
 

Author Comment

by:neoptoent
ID: 22812135
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.
 
0
 

Author Comment

by:neoptoent
ID: 22813637
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?
0
 
LVL 7

Expert Comment

by:Hubasan
ID: 22814071
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?
0
 

Author Comment

by:neoptoent
ID: 22814174
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?
0
 
LVL 7

Expert Comment

by:Hubasan
ID: 22815407
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.

0
 

Author Comment

by:neoptoent
ID: 22825315

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
 
0
 
LVL 7

Expert Comment

by:Hubasan
ID: 22825525
Glad to hear you were able to make it work for you. Let us know what happens.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22827030
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.
0
 

Author Comment

by:neoptoent
ID: 22840273
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?
0
 
LVL 7

Expert Comment

by:Hubasan
ID: 22840362
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.
0
 

Author Closing Comment

by:neoptoent
ID: 31507855
Just amazing..
Thanks so much for the help
0

Featured Post

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Restoring deleted objects in Active Directory has been a standard feature in Active Directory for many years, yet some admins may not know what is available.
Is your Office 365 signature not working the way you want it to? Are signature updates taking up too much of your time? Let's run through the most common problems that an IT administrator can encounter when dealing with Office 365 email signatures.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This video shows how to use Hyena, from SystemTools Software, to bulk import 100 user accounts from an external text file. View in 1080p for best video quality.

777 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question