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
461 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
 

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

Join & Write a Comment

When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
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…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

760 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now