[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Modify VB Script to allow for terminal service session and file input

Posted on 2008-11-05
42
Medium Priority
?
967 Views
Last Modified: 2012-05-05
Hi
Hubasan wrote this amazing script for me to search for specific accounts in a Domain AD
I need this script to a little more.
1.  as well as searching for locally logged in users (console login) to also search for Terminal Services as well as RDP, and in the results specify what type it was....So locally logged on users should include console login, terminal services, and RDP and say in the results window what type  it was.
2. IF POSSIBLE currently I modify the listofaccounts.txt with the users i want to search for.. is it possible for this script to let me browse for the file I want to use for the input?
3. Allow scanning of workstations, servers or both instead of either or
4. IF POSSIBLE show a dialague window while scanning to show how many resources it will be searching and how far through (status)..so for example "Currently scanning  computer A 20 of 100 complete"
On Error Resume Next
 
Const ADS_SCOPE_SUBTREE = 2
Const FOR_READING = 1
Const cTitle = "Scan AD Computers"
 
sAccountsFile = "c:\listOfAccounts.txt"
 
'create objects
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oWS = CreateObject("wscript.shell")
 
Do
	sAction = InputBox("Please select the Type of scan: " & vbCrLf & vbCrLf &_
	"1 = Scan for Services." & vbCrLf &_
	"2 = Scan for Tasks." & vbCrLf &_
	"3 = Scan if Users logged in." & vbCrLf &_
	"4 = Scan if Users running processes. " & vbCrLf & vbCrLf &_
	"You can also combine multiple choices by putting coma sign in between," &_
	" example 1,4 ...etc" ,cTitle,"(Enter number here)")	
			
	If InStr(sAction, Chr(49)) Or InStr(sAction, Chr(50)) Or InStr(sAction, Chr(51)) Or InStr(sAction, Chr(52)) Then
		Exit Do
	Else	
		sRes = oWS.Popup("Sorry, you must enter a number(s) between 1 and 4 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 InStr(sAction, Chr(49)) Or InStr(sAction, Chr(50)) Or InStr(sAction, Chr(51)) Or InStr(sAction, Chr(52))
 
oWS.Popup "Be advised that this script can take a long time to run," & vbCrLf &_
					"so please be patient..." & vbCrLf & vbCrLf &_
					"You can monitor progress of the script by looking at the .csv files," & vbCrLf &_
					"that will be created in the same folder as the script.", ,cTitle, vbinformation
 
If InStr(sAction, Chr(49)) Then
	sServicesLog = "Services.csv"
	Set oServicesLog = oFS.CreateTextFile(sServicesLog, True)
	oServicesLog.WriteLine "Computer Name,Service Name,Caption,RunAs"
End If
If InStr(sAction, Chr(50)) Then
	sTasksLog = "Tasks.csv"
	Set oTasksLog = oFS.CreateTextFile(sTasksLog, True)
	oTasksLog.WriteLine "Computer Name,Task Name,Caption,RunAs"
End If
If InStr(sAction, Chr(51)) Then
	sUserLog = "UsersLoggedIn.csv"
	Set oUserLog = oFS.CreateTextFile(sUserLog, True)
	oUserLog.WriteLine "Computer Name,User Name,is Logged in?"
End If
If InStr(sAction, Chr(52)) Then
	sProcessesLog = "Processes.csv"
	Set oProcessesLog = oFS.CreateTextFile(sProcessesLog, True)
	oProcessesLog.WriteLine "Computer Name,User Name,Process Name"
End If
 
' 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
 
Do
	sTypeOfComputersToScan = InputBox("Please specify what type of Computers would you like to scan?" &_
	vbCrLf & "Example: type servers, or type workstations" &_
	vbCrLf & vbCrLf & "servers = will scan Windows 2000 and 2003 servers" &_
	vbCrLf & "workstations = will only scan for Windows XP", cTitle, "(Type of Computer to scan for, without quotes?)")	
 
	If Not sTypeOfComputersToScan = "servers" and Not sTypeOfComputersToScan = "workstations" Then
		sRes1 = oWS.Popup("Please enter ''servers'' or ''workstations'' without quotes to continue!" &_
		vbCrLf & vbCrLf & "Do you want to try again?", , cTitle, vbYesNo+vbExclamation)
		If sRes1 = vbno Then
			oWS.Popup "User canceled, Script exiting!", , cTitle, vbInformation
			WScript.Quit
		End If
	End If
Loop Until sTypeOfComputersToScan = "servers" Or sTypeOfComputersToScan = "workstations"
 
If sTypeOfComputersToScan = "servers" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
	& "Where objectClass='computer' and operatingSystemVersion = '5.0 (2195)' " _
	& "OR operatingSystemVersion = '5.2 (3790)'"
End If
 
If sTypeOfComputersToScan = "workstations" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
  & "Where objectClass='computer' and operatingSystemVersion = '5.1 (2600)'"
End If
 
oCommand.Properties("Page Size") = 5000
oCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
Set oRecordSet = oCommand.Execute
oRecordSet.MoveFirst
 
sProblemPCs = "ProblemPCs.csv"
Set oProblemPCs = oFS.CreateTextFile(sProblemPCs, True)
oProblemPCs.WriteLine "Computer Name, Status"
bProblemPCs = False
 
Do Until oRecordSet.EOF
	sIsOnline = Nothing
	sComputer = Empty
	sComputer = oRecordSet.Fields("Name").Value
	sComputer = UCase(sComputer)
	sIsOnline = Ping(sComputer)
	
	If IsNull(sIsOnline) Then
		bProblemPCs = True
		oProblemPCs.WriteLine sComputer & "," & "does NOT exist in Domain"
	ElseIf sIsOnline = 11010 Then
		bProblemPCs = True
		oProblemPCs.WriteLine sComputer & "," & "Computer OFF-Line"
	ElseIf sIsOnline = 0 Then
	
		Set oTextFile = Nothing
		Set oTextFile = oFS.OpenTextFile _
    (sAccountsFile, FOR_READING)
    
		Do Until oTextFile.AtEndOfStream
			sAccount = Empty
			sAccount = oTextFile.Readline
		
			If InStr(sAction, Chr(49)) Then
				CheckServices sComputer, sAccount
			End If
				
			If InStr(sAction, Chr(50)) Then
				CheckTasks sComputer, sAccount
			End If	
			If InStr(sAction, Chr(51)) Then
				sCurrentUser = GetCurrentUser(sComputer)
				If sCurrentUser = sAccount Then
					sUserStatus = "User is logged in"
					oUserLog.WriteLine sComputer & "," & sAccount & "," & sUserStatus
				Else
					sUserStatus = "User is NOT logged in"
					oUserLog.WriteLine sComputer & "," & sAccount & "," & sUserStatus
				End If
			End If
			If InStr(sAction, Chr(52)) Then
				GetProcesses sComputer,sAccount
			End if
		Loop
		'========================================================
	 
	End If
	oRecordSet.MoveNext
Loop
 
If Not bProblemPCs Then
	oFS.DeleteFile sProblemPCs,True
End If
 
oWS.Popup "Script completed!", , cTitle, vbInformation
 
Function GetProcesses(sComputer,sAccount)
	Set oWMI = GetObject("winmgmts:" _
	    & "{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
	
	Set colProcessList = oWMI.ExecQuery("Select * from Win32_Process")
	
	For Each oProcess in colProcessList
		colProperties = oProcess.GetOwner(sNameOfUser,sUserDomain)
		sPUser = sUserDomain & "\" & sNameOfUser
	  If sPUser = sAccount Then
	  	oProcessesLog.WriteLine sComputer & "," & sAccount & "," & oProcess.Name
		End If
	Next
	Set oWMI = Nothing
End Function
 
Function GetCurrentUser(sComputer)
	Set oWMI = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
	Set colComputer = oWMI.ExecQuery _
    ("Select * from Win32_ComputerSystem")
 
	For Each oComputer in colComputer
    GetCurrentUser = oComputer.UserName
	Next
End Function
 
Function CheckServices(sComputer, sAccount)
	Err.Clear	
	Set oWMI = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
	If Err.Number <> 0 Then    
    oProblemPCs.WriteLine sComputer & "," & "Failed to connect"
    Err.Clear
  Else
		If Trim(sAccount) = "" Then
			Set colServices = oWMI.ExecQuery("Select Name,Caption,StartName From Win32_Service")
		Else
			Set colServices = oWMI.ExecQuery("Select Name,Caption,StartName From Win32_Service WHERE StartName='" & Replace(sAccount, "\", "\\") & "'")
		End If
		
		For Each oService In colServices
			oServicesLog.WriteLine sComputer & "," & oService.Name & "," & oService.Caption & "," & oService.StartName
		Next
		
	End If
	Set oWMI = Nothing
End Function
 
Function CheckTasks(sComputer, sAccount)		
	sTmpFileName = oFS.GetTempName
	sTmpPath = oWS.ExpandEnvironmentStrings("%TEMP%")
	sTmpFile = sTmpPath & "\" & sTmpFileName
	
	Set oTmpFile = oFS.CreateTextFile(sTmpFile,True)
	oTmpFile.Close
	
	Set oShell = CreateObject("WScript.Shell")
	oShell.Run "cmd /c schtasks /query /s " & sComputer & " /v /fo csv /nh >" & sTmpFile, 0, True
 
	Set oText = oFS.OpenTextFile(sTmpFile, FOR_READING)
	sResults = oText.ReadAll
	
	
	If InStr(sResults, "no scheduled tasks") > 0 Then
 
	Else
		For Each strJob In Split(sResults, VbCrLf)
	  	If Trim(strJob) <> "" Then
	    	' Remove outside quotes, then split by ","
	      arrJob = Split(Mid(strJob, 2, Len(strJob) - 2), """,""")
	      If Trim(sAccount) = "" Then
	      	oTasksLog.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
	      ElseIf LCase(arrJob(18)) = LCase(sAccount) Then
	      	oTasksLog.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
	      End If
	      
	     End If
	   Next
	End If
	oText.Close	
	Set oText = Nothing
	oFS.DeleteFile sTmpFile,True
	sTmpFileName = Empty
	sTmpFile = Empty		
	Set oTmpFile = Nothing
End Function
 
Function Ping(sComputer)
Set oWMI = GetObject(_ 
    "winmgmts:\\.\root\cimv2")
Set colPings = oWMI.ExecQuery _
    ("Select * From Win32_PingStatus where Address = '" & sComputer & "'")
 
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
	Set oWMI = Nothing
End Function

Open in new window

0
Comment
Question by:neoptoent
  • 20
  • 19
40 Comments
 
LVL 65

Expert Comment

by:RobSampson
ID: 22889236
Hi, for point number one, the script will currently retrieve just one account, as you know.  From what I know, enumerating terminalserver sessions is difficult, because a session remains logged even when a user logs off.  I'll check this out later today, but your other two options are acheivable.

Regards,

Rob.
0
 

Author Comment

by:neoptoent
ID: 22889656
Rob,
Currently I use the listOfacounts.txt file and it shows me as many accounts as I want in there
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22892474
Hi, I've run out of time today to try the RDP sessions, but this is parts 2, 3, and 4 taken care of.

In terms of providing status, it tells you what it's currently up to, but it doesn't tell you how many there are in total....

Regards,

Rob.
On Error Resume Next
 
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
Const ADS_SCOPE_SUBTREE = 2
Const FOR_READING = 1
Const cTitle = "Scan AD Computers"
 
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Text Files (*.txt,*.log)|*.txt;*.log|All Files (*.*)|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "."
intResult = objDialog.ShowOpen
 
If intResult = 0 Then
	WScript.Echo "No file was selected."
	WScript.Quit
End If
 
'sAccountsFile = "c:\listOfAccounts.txt"
sAccountsFile = objDialog.FileName
 
'create objects
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oWS = CreateObject("wscript.shell")
 
Do
	sAction = InputBox("Please select the Type of scan: " & vbCrLf & vbCrLf &_
	"1 = Scan for Services." & vbCrLf &_
	"2 = Scan for Tasks." & vbCrLf &_
	"3 = Scan if Users logged in." & vbCrLf &_
	"4 = Scan if Users running processes. " & vbCrLf & vbCrLf &_
	"You can also combine multiple choices by putting coma sign in between," &_
	" example 1,4 ...etc" ,cTitle,"(Enter number here)")	
			
	If InStr(sAction, Chr(49)) Or InStr(sAction, Chr(50)) Or InStr(sAction, Chr(51)) Or InStr(sAction, Chr(52)) Then
		Exit Do
	Else	
		sRes = oWS.Popup("Sorry, you must enter a number(s) between 1 and 4 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 InStr(sAction, Chr(49)) Or InStr(sAction, Chr(50)) Or InStr(sAction, Chr(51)) Or InStr(sAction, Chr(52))
 
oWS.Popup "Be advised that this script can take a long time to run," & vbCrLf &_
					"so please be patient..." & vbCrLf & vbCrLf &_
					"You can monitor progress of the script by looking at the .csv files," & vbCrLf &_
					"that will be created in the same folder as the script.", ,cTitle, vbinformation
 
If InStr(sAction, Chr(49)) Then
	sServicesLog = "Services.csv"
	Set oServicesLog = oFS.CreateTextFile(sServicesLog, True)
	oServicesLog.WriteLine "Computer Name,Service Name,Caption,RunAs"
End If
If InStr(sAction, Chr(50)) Then
	sTasksLog = "Tasks.csv"
	Set oTasksLog = oFS.CreateTextFile(sTasksLog, True)
	oTasksLog.WriteLine "Computer Name,Task Name,Caption,RunAs"
End If
If InStr(sAction, Chr(51)) Then
	sUserLog = "UsersLoggedIn.csv"
	Set oUserLog = oFS.CreateTextFile(sUserLog, True)
	oUserLog.WriteLine "Computer Name,User Name,is Logged in?"
End If
If InStr(sAction, Chr(52)) Then
	sProcessesLog = "Processes.csv"
	Set oProcessesLog = oFS.CreateTextFile(sProcessesLog, True)
	oProcessesLog.WriteLine "Computer Name,User Name,Process Name"
End If
 
' 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
 
Do
	sTypeOfComputersToScan = InputBox("Please specify what type of Computers would you like to scan?" &_
	vbCrLf & "Example: type servers, or type workstations, or type both" &_
	vbCrLf & vbCrLf & "servers = will scan Windows 2000 and 2003 servers" &_
	vbCrLf & "workstations = will only scan for Windows XP", cTitle, "(Type of Computer to scan for, without quotes?)")	
 
	If sTypeOfComputersToScan <> "servers" and sTypeOfComputersToScan <> "workstations" and sTypeOfComputersToScan <> "both" Then
		sRes1 = oWS.Popup("Please enter ''servers'' or ''workstations'' or ''both'' without quotes to continue!" &_
		vbCrLf & vbCrLf & "Do you want to try again?", , cTitle, vbYesNo+vbExclamation)
		If sRes1 = vbno Then
			oWS.Popup "User canceled, Script exiting!", , cTitle, vbInformation
			WScript.Quit
		End If
	End If
Loop Until sTypeOfComputersToScan = "servers" Or sTypeOfComputersToScan = "workstations" Or sTypeOfComputersToScan = "both"
 
If sTypeOfComputersToScan = "servers" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
	& "Where objectClass='computer' and operatingSystemVersion = '5.0 (2195)' " _
	& "OR operatingSystemVersion = '5.2 (3790)'"
End If
 
If sTypeOfComputersToScan = "workstations" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
  & "Where objectClass='computer' and operatingSystemVersion = '5.1 (2600)'"
End If
 
If sTypeOfComputersToScan = "both" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
	& "Where objectClass='computer' and operatingSystemVersion = '5.0 (2195)' " _
	& "OR operatingSystemVersion = '5.2 (3790)' OR operatingSystemVersion = '5.1 (2600)'"
End If
 
oCommand.Properties("Page Size") = 5000
oCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
Set oRecordSet = oCommand.Execute
oRecordSet.MoveFirst
 
sProblemPCs = "ProblemPCs.csv"
Set oProblemPCs = oFS.CreateTextFile(sProblemPCs, True)
oProblemPCs.WriteLine "Computer Name, Status"
bProblemPCs = False
 
Do Until oRecordSet.EOF
	sIsOnline = Nothing
	sComputer = Empty
	sComputer = oRecordSet.Fields("Name").Value
	sComputer = UCase(sComputer)
	sIsOnline = Ping(sComputer)
	
	If IsNull(sIsOnline) Then
		bProblemPCs = True
		oProblemPCs.WriteLine sComputer & "," & "does NOT exist in Domain"
	ElseIf sIsOnline = 11010 Then
		bProblemPCs = True
		oProblemPCs.WriteLine sComputer & "," & "Computer OFF-Line"
	ElseIf sIsOnline = 0 Then
	
		Set oTextFile = Nothing
		Set oTextFile = oFS.OpenTextFile _
    (sAccountsFile, FOR_READING)
    
		Do Until oTextFile.AtEndOfStream
			sAccount = Empty
			sAccount = oTextFile.Readline
		
			If InStr(sAction, Chr(49)) Then
				WScript.Echo "Checking services on " & sComputer & " for " & sAccount
				CheckServices sComputer, sAccount
			End If
				
			If InStr(sAction, Chr(50)) Then
				WScript.Echo "Checking scheduled tasks on " & sComputer & " for " & sAccount
				CheckTasks sComputer, sAccount
			End If	
			If InStr(sAction, Chr(51)) Then
				WScript.Echo "Checking logged in user on " & sComputer
				sCurrentUser = GetCurrentUser(sComputer)
				If sCurrentUser = sAccount Then
					sUserStatus = "User is logged in"
					oUserLog.WriteLine sComputer & "," & sAccount & "," & sUserStatus
				Else
					sUserStatus = "User is NOT logged in"
					oUserLog.WriteLine sComputer & "," & sAccount & "," & sUserStatus
				End If
			End If
			If InStr(sAction, Chr(52)) Then
				WScript.Echo "Scanning " & sComputer & " for " & sAccount
				GetProcesses sComputer,sAccount
			End if
		Loop
		'========================================================
	 
	End If
	oRecordSet.MoveNext
Loop
 
If Not bProblemPCs Then
	oFS.DeleteFile sProblemPCs,True
End If
 
oWS.Popup "Script completed!", , cTitle, vbInformation
 
Function GetProcesses(sComputer,sAccount)
	Set oWMI = GetObject("winmgmts:" _
	    & "{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
	
	Set colProcessList = oWMI.ExecQuery("Select * from Win32_Process")
	
	For Each oProcess in colProcessList
		colProperties = oProcess.GetOwner(sNameOfUser,sUserDomain)
		sPUser = sUserDomain & "\" & sNameOfUser
	  If sPUser = sAccount Then
	  	oProcessesLog.WriteLine sComputer & "," & sAccount & "," & oProcess.Name
		End If
	Next
	Set oWMI = Nothing
End Function
 
Function GetCurrentUser(sComputer)
	Set oWMI = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
	Set colComputer = oWMI.ExecQuery _
    ("Select * from Win32_ComputerSystem")
 
	For Each oComputer in colComputer
    GetCurrentUser = oComputer.UserName
	Next
End Function
 
Function CheckServices(sComputer, sAccount)
	Err.Clear	
	Set oWMI = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
	If Err.Number <> 0 Then    
    oProblemPCs.WriteLine sComputer & "," & "Failed to connect"
    Err.Clear
  Else
		If Trim(sAccount) = "" Then
			Set colServices = oWMI.ExecQuery("Select Name,Caption,StartName From Win32_Service")
		Else
			Set colServices = oWMI.ExecQuery("Select Name,Caption,StartName From Win32_Service WHERE StartName='" & Replace(sAccount, "\", "\\") & "'")
		End If
		
		For Each oService In colServices
			oServicesLog.WriteLine sComputer & "," & oService.Name & "," & oService.Caption & "," & oService.StartName
		Next
		
	End If
	Set oWMI = Nothing
End Function
 
Function CheckTasks(sComputer, sAccount)		
	sTmpFileName = oFS.GetTempName
	sTmpPath = oWS.ExpandEnvironmentStrings("%TEMP%")
	sTmpFile = sTmpPath & "\" & sTmpFileName
	
	Set oTmpFile = oFS.CreateTextFile(sTmpFile,True)
	oTmpFile.Close
	
	Set oShell = CreateObject("WScript.Shell")
	oShell.Run "cmd /c schtasks /query /s " & sComputer & " /v /fo csv /nh >" & sTmpFile, 0, True
 
	Set oText = oFS.OpenTextFile(sTmpFile, FOR_READING)
	sResults = oText.ReadAll
	
	
	If InStr(sResults, "no scheduled tasks") > 0 Then
 
	Else
		For Each strJob In Split(sResults, VbCrLf)
	  	If Trim(strJob) <> "" Then
	    	' Remove outside quotes, then split by ","
	      arrJob = Split(Mid(strJob, 2, Len(strJob) - 2), """,""")
	      If Trim(sAccount) = "" Then
	      	oTasksLog.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
	      ElseIf LCase(arrJob(18)) = LCase(sAccount) Then
	      	oTasksLog.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
	      End If
	      
	     End If
	   Next
	End If
	oText.Close	
	Set oText = Nothing
	oFS.DeleteFile sTmpFile,True
	sTmpFileName = Empty
	sTmpFile = Empty		
	Set oTmpFile = Nothing
End Function
 
Function Ping(sComputer)
Set oWMI = GetObject(_ 
    "winmgmts:\\.\root\cimv2")
Set colPings = oWMI.ExecQuery _
    ("Select * From Win32_PingStatus where Address = '" & sComputer & "'")
 
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
	Set oWMI = Nothing
End Function

Open in new window

0
Creating Active Directory Users from a Text File

If your organization has a need to mass-create AD user accounts, watch this video to see how its done without the need for scripting or other unnecessary complexities.

 

Author Comment

by:neoptoent
ID: 22895070
Thanks so much for taking the time to do this.
It tell me scanning server a for workstation b in the cmd window ... is that correct?
 
Also do you think it will be able to get the ts and rdp? That is the most critical thing for me
 
thanks so much for  taking the time
0
 

Author Comment

by:neoptoent
ID: 22895550
so in the cmd window with the status.
 
I see .......seems like it is scannign machines over again..yet I only have 1 Id in the TXT i selected
scanning resourcea for resouceb
scanning resourcea for resoucec
 
Then I will see scanning
scanning resourcew for resouceb
scanning resourcew for resoucec
 
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22914504
Hi, yes, the output will show that it is up to scanning each PC, depending on which "task", out of the four, that it is up to. For example, I had one account in the text file, and selected to scan services, tasks, and loggin user, and this was my output:

Checking services on SERVERA for NT AUTHORITY/LocalService
Checking logged in user on SERVERA
Scanning SERVERA for NT AUTHORITY/LocalService
Checking services on SERVERB for NT AUTHORITY/LocalService
Checking logged in user on SERVERB
Scanning SERVERB for NT AUTHORITY/LocalService
Checking services on SERVERC for NT AUTHORITY/LocalService
Checking logged in user on SERVERC
Scanning SERVERC for NT AUTHORITY/LocalService

So, it told me which task of the 3, that it was up to per server.

I will check out the TS / RDP this week....

Regards,

Rob.
0
 

Author Comment

by:neoptoent
ID: 22921901
Right, I see when i am only scannign server it will show
scanning servera for nt Authority\local server
 
but when I scan both, I see scaning servera for workstationa
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22947411
Sorry mate....I've run out of time to check this out right now.  I'm about to be on holidays for a couple of weeks, so I'll return to this when I get back.....

Perhaps you could post in an older question of yours to ask Husaban to look at this for you....

Regards,

Rob.
0
 
LVL 7

Expert Comment

by:Hubasan
ID: 23009103
Hi neoptoent,

Sorry for not getting back to you, I had some major issues at work that needed my attention these past few weeks. I researched this issue where you need to query Terminal Services session of the user that is logged on, but I couldn't find any answers. I'm not sure if this is possible at all.
Sorry man. If you can have one of other experts to take a look at this maybe they can figure something out.
0
 

Author Comment

by:neoptoent
ID: 23012805
Thanks
 
You really dont think there is a way to get all the users logged on to the machine including the terminal services users?
Dont they have a session open that can be quered?
 
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 23136302
Hi, change strComputer = "." and run this code to see what information you get.  The thing I have noticed about this, is that even when a session is logged off, it is reported as active, until the server is rebooted....

Regards,

Rob.
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
strComputer = "."
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")  
Set colSessions = objWMI.ExecQuery("Select * from Win32_LogonSession Where LogonType = 2 OR LogonType = 10")
boolRemote = False
If colSessions.Count > 0 Then
	For Each objSession In colSessions
		If objSession.LogonType = 2 Then
			strResults = strResults & "Logon Type: Console" & VbCrLf
		Else
			strResults = strResults & "Logon Type: RDP/Terminal Server" & VbCrLf
		End If
		Set colList = objWMI.ExecQuery("Associators of {Win32_LogonSession.LogonId=" & objSession.LogonId & "} " _
			& "Where AssocClass=Win32_LoggedOnUser Role=Dependent")
		For Each objItem In colList
			strResults = strResults & "User: " & objItem.Name & VbCrLf
			strResults = strResults & "FullName: " & objItem.FullName & VbCrLf
			strResults = strResults & "Domain: " & objItem.Domain & VbCrLf
		Next
		strResults = strResults & "Session start time: " & objSession.StartTime
		strResults = strResults & VbCrLf & "==========================" & VbCrLf
 
		If objSession.LogonType = 10 Then boolRemote = True				
	Next
End If
WScript.Echo strResults

Open in new window

0
 

Author Comment

by:neoptoent
ID: 23139301
I get this:
 
New Text Document.vbs(22, 3) (null) : 0x8004100
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 23143642
OK, try this code....my feeling is that the server you tried to query did not return any session information...

Regards,

Rob.
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
strComputer = "."
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")  
Set colSessions = objWMI.ExecQuery("Select * from Win32_LogonSession Where LogonType = 2 OR LogonType = 10")
boolRemote = False
If colSessions.Count > 0 Then
	For Each objSession In colSessions
		If objSession.LogonType = 2 Then
			strResults = strResults & "Logon Type: Console" & VbCrLf
		Else
			strResults = strResults & "Logon Type: RDP/Terminal Server" & VbCrLf
		End If
		Set colList = objWMI.ExecQuery("Associators of {Win32_LogonSession.LogonId=" & objSession.LogonId & "} " _
			& "Where AssocClass=Win32_LoggedOnUser Role=Dependent")
		On Error Resume Next
		For Each objItem In colList
			strResults = strResults & "User: " & objItem.Name & VbCrLf
			strResults = strResults & "FullName: " & objItem.FullName & VbCrLf
			strResults = strResults & "Domain: " & objItem.Domain & VbCrLf
		Next
		If Err.Number <> 0 Then
			Err.Clear
			On Error GoTo 0
			strResults = strResults & VbCrLf & "No sessions were found on " & strComputer & VbCrLf
		Else
			On Error GoTo 0
		End If
		strResults = strResults & "Session start time: " & objSession.StartTime
		strResults = strResults & VbCrLf & "==========================" & VbCrLf
 
		If objSession.LogonType = 10 Then boolRemote = True				
	Next
End If
WScript.Echo strResults

Open in new window

0
 

Author Comment

by:neoptoent
ID: 23148364
I created a RDP session  with account bob1 to ServerA then ran that script
Here are the results: (as you can see it did not show that session)

Microsoft (R) Windows Script Host Version 5.6
Copyright (C) Microsoft Corporation 1996-2001. All rights reserved.
Logon Type: RDP/Terminal Server
No sessions were found on ServerA
Session start time: 20080827094716.018750-240
==========================
Logon Type: RDP/Terminal Server
No sessions were found on ServerA
Session start time: 20080731090833.234375-240
==========================
Logon Type: RDP/Terminal Server
No sessions were found on ServerA
Session start time: 20081203065905.826926-300
==========================
Logon Type: RDP/Terminal Server
No sessions were found on ServerA
Session start time: 20081125124427.941136-300
==========================
Logon Type: RDP/Terminal Server
No sessions were found on ServerA
Session start time: 20080916101540.569375-240
==========================
Logon Type: RDP/Terminal Server
No sessions were found on ServerA
Session start time: 20080723113459.531250-240
==========================
Logon Type: RDP/Terminal Server
No sessions were found on ServerA
Session start time: 20080722054718.218750-240
==========================
Logon Type: RDP/Terminal Server
No sessions were found on ServerA
Session start time: 20080619081025.531250-240
==========================
Logon Type: RDP/Terminal Server
No sessions were found on ServerA
Session start time: 20081209091537.377172-300
==========================
Logon Type: RDP/Terminal Server
No sessions were found on ServerA
Session start time: 20080825073908.863125-240
==========================
Logon Type: RDP/Terminal Server
No sessions were found on ServerA
Session start time: 20080728114420.578125-240
==========================
Logon Type: Console
No sessions were found on ServerA
Session start time: 20080703170635.796875-240
==========================
Logon Type: RDP/Terminal Server
No sessions were found on ServerA
Session start time: 20080804125947.671875-240
==========================
Logon Type: RDP/Terminal Server
No sessions were found on ServerA
Session start time: 20081211091330.246555-300
==========================
Logon Type: RDP/Terminal Server
No sessions were found on ServerA
Session start time: 20081208091334.054144-300
==========================
Logon Type: RDP/Terminal Server
No sessions were found on ServerA
Session start time: 20080908104057.097500-240
==========================
 
 
 
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 23154125
Hmmm, I think this means that the user information is not able to be determined.

Try the following script, it's probably more accurate.  Try connecting to a different server as well.

What OS is the server you're running this against?

Rob.
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
strComputer = "."
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")  
Set colSessions = objWMI.ExecQuery("Select * from Win32_LogonSession Where LogonType = 2 OR LogonType = 10")
boolRemote = False
If colSessions.Count > 0 Then
	For Each objSession In colSessions
		If objSession.LogonType = 2 Then
			strResults = strResults & "Logon Type: Console" & VbCrLf
		Else
			strResults = strResults & "Logon Type: RDP/Terminal Server" & VbCrLf
		End If
		Set colList = objWMI.ExecQuery("Associators of {Win32_LogonSession.LogonId=" & objSession.LogonId & "} " _
			& "Where AssocClass=Win32_LoggedOnUser Role=Dependent")
		On Error Resume Next
		For Each objItem In colList
			strResults = strResults & "User: " & objItem.Name & VbCrLf
			strResults = strResults & "FullName: " & objItem.FullName & VbCrLf
			strResults = strResults & "Domain: " & objItem.Domain & VbCrLf
		Next
		If Err.Number <> 0 Then
			Err.Clear
			On Error GoTo 0
			strResults = strResults & VbCrLf & "Unable to get user information for logon id " & objSession.LogonID & VbCrLf
		Else
			On Error GoTo 0
		End If
		strResults = strResults & "Session start time: " & objSession.StartTime
		strResults = strResults & VbCrLf & "==========================" & VbCrLf
 
		If objSession.LogonType = 10 Then boolRemote = True				
	Next
End If
WScript.Echo strResults

Open in new window

0
 

Author Comment

by:neoptoent
ID: 23157138
Ok so that will show me a long list of sessions (most that expired)  some rdp some console
Now how can we tie that to into the original script to just show the active ones?
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 23170726
Hi, I can't get WMI to filter this list.  On a terminal server, you should find a file called
C:\Windows\System32\QUser.exe

Copy that to your computer, then, at a DOS prompt, run
quser.exe /SERVER:TERMSERVPC

Where you change TERMSERVPC to the name of your terminal server.

If that's got better information, we'll just use VBScript to filter that output.

Regards,

Rob.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 23171161
With QUser.exe, run this code and see what results you get...

Regards,

Rob.
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
' Set these parameters as required
strComputer = "TERMINALSERVER"
strQUser = "C:\Temp\Citrix Command Line Tools\QUser.exe"
strOutputFile = "C:\Temp\Citrix Command Line Tools\Users.txt"
'---------------------------------
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Const intForReading = 1
strCommand = "cmd /c " & objFSO.GetFile(strQUser).ShortPath & " /SERVER:" & strComputer & " > """ & strOutputFile & """"
objShell.Run strCommand, 0, True
If objFSO.GetFile(strOutputFile).Size > 0 Then
	Set objOutputFile = objFSO.OpenTextFile(strOutputFile, intForReading, False)
	arrResults = Split(objOutputFile.ReadAll, VbCrLf)
	objOutputFile.Close
	Set objOutputFile = Nothing
	
	strResults = ""
	For Each strLine In arrResults
		If strResults = "" Then
			strResults = Trim(Mid(strLine, 2, 20))
		Else
			strResults = strResults & VbCrLf & Trim(Mid(strLine, 2, 20))
		End If
		strResults = strResults & "|" & Trim(Mid(strLine, 24, 17)) & "|" & Trim(Mid(strLine, 41, 4)) & "|" & Trim(Mid(strLine, 47, 5)) & "|" & Trim(Mid(strLine, 54, 10)) & "|" & Trim(Mid(strLine, 66))
	Next
	
	strResults = Replace(strResults, VbCrLf & "|||||", "")
	
	WScript.Echo strResults
Else
	WScript.Echo "No sessions were found on " & strComputer
End If

Open in new window

0
 

Author Comment

by:neoptoent
ID: 23173430
When just using quser it showed the correct info
when I ran the script above this is what I got
C:\Documents and Settings\me\Desktop\sampson.vbs(18, 1) Microsoft VBScri
pt runtime error: File not found
 
 
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 23177088
That would mean it can't find the file location defined by strQUser.  Did you change this line:
strQUser = "C:\Temp\Citrix Command Line Tools\QUser.exe"

so that it points to the exact location of the QUser.exe file?

Regards,

Rob.
0
 

Author Comment

by:neoptoent
ID: 23177600
Yes that worked!!!
Can this be tied to the original script above?
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 23180359
We should be able to do that....in the code that I provided in comment ID: 22892474
do you want the QUser results to be displayed from option 3: "3 = Scan if Users logged in."

Rob.
0
 

Author Comment

by:neoptoent
ID: 23183595
Yes, but in the results to have if noted that it is RDP
 
You are really really good at this
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 23191028
Hi, sorry about the delay.  I ended making a fifth choice instead.  It was easier that way.

So now you select option 5, type servers, and it will record the sessions to TerminalServicesUsers.csv

This should be the only line you need to change:
                  strQUser = "C:\Temp\Citrix Command Line Tools\QUser.exe"

Regards,

Rob.
On Error Resume Next
 
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
Const ADS_SCOPE_SUBTREE = 2
Const FOR_READING = 1
Const cTitle = "Scan AD Computers"
 
WScript.Echo "Please select a text file containing the user accounts to search for..."
 
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Text Files (*.txt,*.log)|*.txt;*.log|All Files (*.*)|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "."
intResult = objDialog.ShowOpen
 
If intResult = 0 Then
	WScript.Echo "No file was selected."
	WScript.Quit
End If
 
'sAccountsFile = "c:\listOfAccounts.txt"
sAccountsFile = objDialog.FileName
 
'create objects
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oWS = CreateObject("wscript.shell")
 
Do
	sAction = InputBox("Please select the Type of scan: " & vbCrLf & vbCrLf &_
	"1 = Scan for Services." & vbCrLf &_
	"2 = Scan for Tasks." & vbCrLf &_
	"3 = Scan if Users logged in." & vbCrLf &_
	"4 = Scan if Users running processes. " & vbCrLf &_
	"5 = List terminal services and console users." & VbCrLf & vbCrLf &_
	"You can also combine multiple choices by putting coma sign in between," &_
	" example 1,4 ...etc" ,cTitle,"(Enter number here)")	
			
	If InStr(sAction, Chr(49)) Or InStr(sAction, Chr(50)) Or InStr(sAction, Chr(51)) Or InStr(sAction, Chr(52)) Or InStr(sAction, Chr(53)) Then
		Exit Do
	Else	
		sRes = oWS.Popup("Sorry, you must enter a number(s) between 1 and 4 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 InStr(sAction, Chr(49)) Or InStr(sAction, Chr(50)) Or InStr(sAction, Chr(51)) Or InStr(sAction, Chr(52)) Or InStr(sAction, Chr(53))
 
oWS.Popup "Be advised that this script can take a long time to run," & vbCrLf &_
					"so please be patient..." & vbCrLf & vbCrLf &_
					"You can monitor progress of the script by looking at the .csv files," & vbCrLf &_
					"that will be created in the same folder as the script.", ,cTitle, vbinformation
 
If InStr(sAction, Chr(49)) Then
	sServicesLog = "Services.csv"
	Set oServicesLog = oFS.CreateTextFile(sServicesLog, True)
	oServicesLog.WriteLine "Computer Name,Service Name,Caption,RunAs"
End If
If InStr(sAction, Chr(50)) Then
	sTasksLog = "Tasks.csv"
	Set oTasksLog = oFS.CreateTextFile(sTasksLog, True)
	oTasksLog.WriteLine "Computer Name,Task Name,Caption,RunAs"
End If
If InStr(sAction, Chr(51)) Then
	sUserLog = "UsersLoggedIn.csv"
	Set oUserLog = oFS.CreateTextFile(sUserLog, True)
	oUserLog.WriteLine "Computer Name,User Name,is Logged in?"
End If
If InStr(sAction, Chr(52)) Then
	sProcessesLog = "Processes.csv"
	Set oProcessesLog = oFS.CreateTextFile(sProcessesLog, True)
	oProcessesLog.WriteLine "Computer Name,User Name,Process Name"
End If
If InStr(sAction, Chr(53)) Then
	sTSUsersLog = "TerminalServicesUsers.csv"
	Set oTSUsersLog = oFS.CreateTextFile(sTSUsersLog, True)
	oTSUsersLog.WriteLine """Computer"",""Username"",""Session Name"",""ID"",""State"",""Idle Time"",""Logon Time"""
End If
 
' 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
 
Do
	sTypeOfComputersToScan = InputBox("Please specify what type of Computers would you like to scan?" &_
	vbCrLf & "Example: type servers, or type workstations, or type both" &_
	vbCrLf & vbCrLf & "servers = will scan Windows 2000 and 2003 servers" &_
	vbCrLf & "workstations = will only scan for Windows XP", cTitle, "(Type of Computer to scan for, without quotes?)")	
 
	If sTypeOfComputersToScan <> "servers" and sTypeOfComputersToScan <> "workstations" and sTypeOfComputersToScan <> "both" Then
		sRes1 = oWS.Popup("Please enter ''servers'' or ''workstations'' or ''both'' without quotes to continue!" &_
		vbCrLf & vbCrLf & "Do you want to try again?", , cTitle, vbYesNo+vbExclamation)
		If sRes1 = vbno Then
			oWS.Popup "User canceled, Script exiting!", , cTitle, vbInformation
			WScript.Quit
		End If
	End If
Loop Until sTypeOfComputersToScan = "servers" Or sTypeOfComputersToScan = "workstations" Or sTypeOfComputersToScan = "both"
 
If sTypeOfComputersToScan = "servers" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
	& "Where objectClass='computer' and operatingSystemVersion = '5.0 (2195)' " _
	& "OR operatingSystemVersion = '5.2 (3790)'"
End If
 
If sTypeOfComputersToScan = "workstations" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
  & "Where objectClass='computer' and operatingSystemVersion = '5.1 (2600)'"
End If
 
If sTypeOfComputersToScan = "both" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
	& "Where objectClass='computer' and operatingSystemVersion = '5.0 (2195)' " _
	& "OR operatingSystemVersion = '5.2 (3790)' OR operatingSystemVersion = '5.1 (2600)'"
End If
 
oCommand.Properties("Page Size") = 5000
oCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
Set oRecordSet = oCommand.Execute
oRecordSet.MoveFirst
 
sProblemPCs = "ProblemPCs.csv"
Set oProblemPCs = oFS.CreateTextFile(sProblemPCs, True)
oProblemPCs.WriteLine "Computer Name, Status"
bProblemPCs = False
 
Do Until oRecordSet.EOF
	sIsOnline = Nothing
	sComputer = Empty
	sComputer = oRecordSet.Fields("Name").Value
	sComputer = UCase(sComputer)
	sIsOnline = Ping(sComputer)
	
	If IsNull(sIsOnline) Then
		bProblemPCs = True
		oProblemPCs.WriteLine sComputer & "," & "does NOT exist in Domain"
	ElseIf sIsOnline = 11010 Then
		bProblemPCs = True
		oProblemPCs.WriteLine sComputer & "," & "Computer OFF-Line"
	ElseIf sIsOnline = 0 Then
	
		Set oTextFile = Nothing
		Set oTextFile = oFS.OpenTextFile _
    (sAccountsFile, FOR_READING)
    
		Do Until oTextFile.AtEndOfStream
			sAccount = Empty
			sAccount = oTextFile.Readline
		
			If InStr(sAction, Chr(49)) Then
				WScript.Echo "Checking services on " & sComputer & " for " & sAccount
				CheckServices sComputer, sAccount
			End If
				
			If InStr(sAction, Chr(50)) Then
				WScript.Echo "Checking scheduled tasks on " & sComputer & " for " & sAccount
				CheckTasks sComputer, sAccount
			End If	
			If InStr(sAction, Chr(51)) Then
				WScript.Echo "Checking logged in user on " & sComputer
				sCurrentUser = GetCurrentUser(sComputer)
				If sCurrentUser = sAccount Then
					sUserStatus = "User is logged in"
					oUserLog.WriteLine sComputer & "," & sAccount & "," & sUserStatus
				Else
					sUserStatus = "User is NOT logged in"
					oUserLog.WriteLine sComputer & "," & sAccount & "," & sUserStatus
				End If
			End If
			If InStr(sAction, Chr(52)) Then
				WScript.Echo "Scanning " & sComputer & " for " & sAccount
				GetProcesses sComputer,sAccount
			End If
		Loop
		If InStr(sAction, Chr(53)) Then
			WScript.Echo "Scanning " & sComputer & " for terminal services or console sessions"
 
			' Set these parameters as required
			strComputer = sComputer
			strQUser = "C:\Temp\Citrix Command Line Tools\QUser.exe"
			strOutputFile = "TempOutputfile.txt"
			'---------------------------------
			 
			Set objFSO = CreateObject("Scripting.FileSystemObject")
			Set objShell = CreateObject("WScript.Shell")
			Const intForReading = 1
			strCommand = "cmd /c " & objFSO.GetFile(strQUser).ShortPath & " /SERVER:" & strComputer & " > """ & strOutputFile & """"
			objShell.Run strCommand, 0, True
			If objFSO.GetFile(strOutputFile).Size > 0 Then
				Set objOutputFile = objFSO.OpenTextFile(strOutputFile, intForReading, False)
				arrResults = Split(objOutputFile.ReadAll, VbCrLf)
				objOutputFile.Close
				Set objOutputFile = Nothing
				
				strResults = ""
				For Each strLine In arrResults
					If strResults = "" Then
						strResults = Trim(Mid(strLine, 2, 20))
					Else
						strResults = strResults & VbCrLf & Trim(Mid(strLine, 2, 20))
					End If
					strResults = strResults & "|" & Trim(Mid(strLine, 24, 17)) & "|" & Trim(Mid(strLine, 41, 4)) & "|" & Trim(Mid(strLine, 47, 5)) & "|" & Trim(Mid(strLine, 54, 10)) & "|" & Trim(Mid(strLine, 66))
				Next
				
				strResults = Replace(strResults, VbCrLf & "|||||", "")
				strResults = Replace(strResults, "USERNAME|SESSIONNAME|ID|STATE|IDLE TIME|LOGON TIME", "")
				arrResults = Array("")
				arrResults = Split(strResults, VbCrLf)
				For Each strLine In arrResults
					If strLine <> "" Then
						'WScript.Echo strResults
						oTSUsersLog.WriteLine """" & sComputer & """,""" & Replace(strLine, "|", """,""") & """"
					End If
				Next
			Else
				WScript.Echo "No sessions were found on " & strComputer
			End If
 
		End If
		'========================================================
	 
	End If
	oRecordSet.MoveNext
Loop
 
If Not bProblemPCs Then
	oFS.DeleteFile sProblemPCs,True
End If
 
oWS.Popup "Script completed!", , cTitle, vbInformation
 
Function GetProcesses(sComputer,sAccount)
	Set oWMI = GetObject("winmgmts:" _
	    & "{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
	
	Set colProcessList = oWMI.ExecQuery("Select * from Win32_Process")
	
	For Each oProcess in colProcessList
		colProperties = oProcess.GetOwner(sNameOfUser,sUserDomain)
		sPUser = sUserDomain & "\" & sNameOfUser
	  If sPUser = sAccount Then
	  	oProcessesLog.WriteLine sComputer & "," & sAccount & "," & oProcess.Name
		End If
	Next
	Set oWMI = Nothing
End Function
 
Function GetCurrentUser(sComputer)
	Set oWMI = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
	Set colComputer = oWMI.ExecQuery _
    ("Select * from Win32_ComputerSystem")
 
	For Each oComputer in colComputer
    GetCurrentUser = oComputer.UserName
	Next
End Function
 
Function CheckServices(sComputer, sAccount)
	Err.Clear	
	Set oWMI = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
	If Err.Number <> 0 Then    
    oProblemPCs.WriteLine sComputer & "," & "Failed to connect"
    Err.Clear
  Else
		If Trim(sAccount) = "" Then
			Set colServices = oWMI.ExecQuery("Select Name,Caption,StartName From Win32_Service")
		Else
			Set colServices = oWMI.ExecQuery("Select Name,Caption,StartName From Win32_Service WHERE StartName='" & Replace(sAccount, "\", "\\") & "'")
		End If
		
		For Each oService In colServices
			oServicesLog.WriteLine sComputer & "," & oService.Name & "," & oService.Caption & "," & oService.StartName
		Next
		
	End If
	Set oWMI = Nothing
End Function
 
Function CheckTasks(sComputer, sAccount)		
	sTmpFileName = oFS.GetTempName
	sTmpPath = oWS.ExpandEnvironmentStrings("%TEMP%")
	sTmpFile = sTmpPath & "\" & sTmpFileName
	
	Set oTmpFile = oFS.CreateTextFile(sTmpFile,True)
	oTmpFile.Close
	
	Set oShell = CreateObject("WScript.Shell")
	oShell.Run "cmd /c schtasks /query /s " & sComputer & " /v /fo csv /nh >" & sTmpFile, 0, True
 
	Set oText = oFS.OpenTextFile(sTmpFile, FOR_READING)
	sResults = oText.ReadAll
	
	
	If InStr(sResults, "no scheduled tasks") > 0 Then
 
	Else
		For Each strJob In Split(sResults, VbCrLf)
	  	If Trim(strJob) <> "" Then
	    	' Remove outside quotes, then split by ","
	      arrJob = Split(Mid(strJob, 2, Len(strJob) - 2), """,""")
	      If Trim(sAccount) = "" Then
	      	oTasksLog.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
	      ElseIf LCase(arrJob(18)) = LCase(sAccount) Then
	      	oTasksLog.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
	      End If
	      
	     End If
	   Next
	End If
	oText.Close	
	Set oText = Nothing
	oFS.DeleteFile sTmpFile,True
	sTmpFileName = Empty
	sTmpFile = Empty		
	Set oTmpFile = Nothing
End Function
 
Function Ping(sComputer)
Set oWMI = GetObject(_ 
    "winmgmts:\\.\root\cimv2")
Set colPings = oWMI.ExecQuery _
    ("Select * From Win32_PingStatus where Address = '" & sComputer & "'")
 
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
	Set oWMI = Nothing
End Function

Open in new window

0
 

Author Comment

by:neoptoent
ID: 23193760
Great.

I choose number 5 and select the file with the txt user i want to search for.. the results show ALL rdp and console logins, not just for the account in listofaccounts.txt file

Also is it possibel tos pipe the status results toa txt file so we dont need that cmd window up all the time showing the staus?
 
Thanks so much for the help
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 23210476
Try this for finding only those user accounts for the rdp and console sessions.

Piping the status to a text file could be done.....but you wouldn't get a live visual update of how it's going, and seeing as this script can take so long, that might not be a good idea....

But I can do that if you want....

Regards,

Rob.
On Error Resume Next
 
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
Const ADS_SCOPE_SUBTREE = 2
Const FOR_READING = 1
Const cTitle = "Scan AD Computers"
 
WScript.Echo "Please select a text file containing the user accounts to search for..."
 
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Text Files (*.txt,*.log)|*.txt;*.log|All Files (*.*)|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "."
intResult = objDialog.ShowOpen
 
If intResult = 0 Then
	WScript.Echo "No file was selected."
	WScript.Quit
End If
 
'sAccountsFile = "c:\listOfAccounts.txt"
sAccountsFile = objDialog.FileName
 
'create objects
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oWS = CreateObject("wscript.shell")
 
Do
	sAction = InputBox("Please select the Type of scan: " & vbCrLf & vbCrLf &_
	"1 = Scan for Services." & vbCrLf &_
	"2 = Scan for Tasks." & vbCrLf &_
	"3 = Scan if Users logged in." & vbCrLf &_
	"4 = Scan if Users running processes. " & vbCrLf &_
	"5 = List terminal services and console users." & VbCrLf & vbCrLf &_
	"You can also combine multiple choices by putting coma sign in between," &_
	" example 1,4 ...etc" ,cTitle,"(Enter number here)")	
			
	If InStr(sAction, Chr(49)) Or InStr(sAction, Chr(50)) Or InStr(sAction, Chr(51)) Or InStr(sAction, Chr(52)) Or InStr(sAction, Chr(53)) Then
		Exit Do
	Else	
		sRes = oWS.Popup("Sorry, you must enter a number(s) between 1 and 4 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 InStr(sAction, Chr(49)) Or InStr(sAction, Chr(50)) Or InStr(sAction, Chr(51)) Or InStr(sAction, Chr(52)) Or InStr(sAction, Chr(53))
 
oWS.Popup "Be advised that this script can take a long time to run," & vbCrLf &_
					"so please be patient..." & vbCrLf & vbCrLf &_
					"You can monitor progress of the script by looking at the .csv files," & vbCrLf &_
					"that will be created in the same folder as the script.", ,cTitle, vbinformation
 
If InStr(sAction, Chr(49)) Then
	sServicesLog = "Services.csv"
	Set oServicesLog = oFS.CreateTextFile(sServicesLog, True)
	oServicesLog.WriteLine "Computer Name,Service Name,Caption,RunAs"
End If
If InStr(sAction, Chr(50)) Then
	sTasksLog = "Tasks.csv"
	Set oTasksLog = oFS.CreateTextFile(sTasksLog, True)
	oTasksLog.WriteLine "Computer Name,Task Name,Caption,RunAs"
End If
If InStr(sAction, Chr(51)) Then
	sUserLog = "UsersLoggedIn.csv"
	Set oUserLog = oFS.CreateTextFile(sUserLog, True)
	oUserLog.WriteLine "Computer Name,User Name,is Logged in?"
End If
If InStr(sAction, Chr(52)) Then
	sProcessesLog = "Processes.csv"
	Set oProcessesLog = oFS.CreateTextFile(sProcessesLog, True)
	oProcessesLog.WriteLine "Computer Name,User Name,Process Name"
End If
If InStr(sAction, Chr(53)) Then
	sTSUsersLog = "TerminalServicesUsers.csv"
	Set oTSUsersLog = oFS.CreateTextFile(sTSUsersLog, True)
	oTSUsersLog.WriteLine """Computer"",""Username"",""Session Name"",""ID"",""State"",""Idle Time"",""Logon Time"""
End If
 
' 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
 
Do
	sTypeOfComputersToScan = InputBox("Please specify what type of Computers would you like to scan?" &_
	vbCrLf & "Example: type servers, or type workstations, or type both" &_
	vbCrLf & vbCrLf & "servers = will scan Windows 2000 and 2003 servers" &_
	vbCrLf & "workstations = will only scan for Windows XP", cTitle, "(Type of Computer to scan for, without quotes?)")	
 
	If sTypeOfComputersToScan <> "servers" and sTypeOfComputersToScan <> "workstations" and sTypeOfComputersToScan <> "both" Then
		sRes1 = oWS.Popup("Please enter ''servers'' or ''workstations'' or ''both'' without quotes to continue!" &_
		vbCrLf & vbCrLf & "Do you want to try again?", , cTitle, vbYesNo+vbExclamation)
		If sRes1 = vbno Then
			oWS.Popup "User canceled, Script exiting!", , cTitle, vbInformation
			WScript.Quit
		End If
	End If
Loop Until sTypeOfComputersToScan = "servers" Or sTypeOfComputersToScan = "workstations" Or sTypeOfComputersToScan = "both"
 
If sTypeOfComputersToScan = "servers" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
	& "Where objectClass='computer' and operatingSystemVersion = '5.0 (2195)' " _
	& "OR operatingSystemVersion = '5.2 (3790)'"
End If
 
If sTypeOfComputersToScan = "workstations" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
  & "Where objectClass='computer' and operatingSystemVersion = '5.1 (2600)'"
End If
 
If sTypeOfComputersToScan = "both" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
	& "Where objectClass='computer' and operatingSystemVersion = '5.0 (2195)' " _
	& "OR operatingSystemVersion = '5.2 (3790)' OR operatingSystemVersion = '5.1 (2600)'"
End If
 
oCommand.Properties("Page Size") = 5000
oCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
Set oRecordSet = oCommand.Execute
oRecordSet.MoveFirst
 
sProblemPCs = "ProblemPCs.csv"
Set oProblemPCs = oFS.CreateTextFile(sProblemPCs, True)
oProblemPCs.WriteLine "Computer Name, Status"
bProblemPCs = False
 
Do Until oRecordSet.EOF
	sIsOnline = Nothing
	sComputer = Empty
	sComputer = oRecordSet.Fields("Name").Value
	sComputer = UCase(sComputer)
	sIsOnline = Ping(sComputer)
	
	If IsNull(sIsOnline) Then
		bProblemPCs = True
		oProblemPCs.WriteLine sComputer & "," & "does NOT exist in Domain"
	ElseIf sIsOnline = 11010 Then
		bProblemPCs = True
		oProblemPCs.WriteLine sComputer & "," & "Computer OFF-Line"
	ElseIf sIsOnline = 0 Then
	
		Set oTextFile = Nothing
		Set oTextFile = oFS.OpenTextFile _
    (sAccountsFile, FOR_READING)
    
		Do Until oTextFile.AtEndOfStream
			sAccount = Empty
			sAccount = oTextFile.Readline
		
			If InStr(sAction, Chr(49)) Then
				WScript.Echo "Checking services on " & sComputer & " for " & sAccount
				CheckServices sComputer, sAccount
			End If
				
			If InStr(sAction, Chr(50)) Then
				WScript.Echo "Checking scheduled tasks on " & sComputer & " for " & sAccount
				CheckTasks sComputer, sAccount
			End If	
			If InStr(sAction, Chr(51)) Then
				WScript.Echo "Checking logged in user on " & sComputer
				sCurrentUser = GetCurrentUser(sComputer)
				If sCurrentUser = sAccount Then
					sUserStatus = "User is logged in"
					oUserLog.WriteLine sComputer & "," & sAccount & "," & sUserStatus
				Else
					sUserStatus = "User is NOT logged in"
					oUserLog.WriteLine sComputer & "," & sAccount & "," & sUserStatus
				End If
			End If
			If InStr(sAction, Chr(52)) Then
				WScript.Echo "Scanning " & sComputer & " for " & sAccount
				GetProcesses sComputer,sAccount
			End If
			'========================================================			
			If InStr(sAction, Chr(53)) Then
				WScript.Echo "Scanning " & sComputer & " for terminal services or console sessions of " & sAccount
	 
				' Set these parameters as required
				strComputer = sComputer
				strQUser = "C:\Temp\Citrix Command Line Tools\QUser.exe"
				strOutputFile = "TempOutputfile.txt"
				'---------------------------------
				 
				Set objFSO = CreateObject("Scripting.FileSystemObject")
				Set objShell = CreateObject("WScript.Shell")
				Const intForReading = 1
				strCommand = "cmd /c " & objFSO.GetFile(strQUser).ShortPath & " /SERVER:" & strComputer & " > """ & strOutputFile & """"
				objShell.Run strCommand, 0, True
				If objFSO.GetFile(strOutputFile).Size > 0 Then
					Set objOutputFile = objFSO.OpenTextFile(strOutputFile, intForReading, False)
					arrResults = Split(objOutputFile.ReadAll, VbCrLf)
					objOutputFile.Close
					Set objOutputFile = Nothing
					
					strResults = ""
					For Each strLine In arrResults
						If strResults = "" Then
							strResults = Trim(Mid(strLine, 2, 20))
						Else
							strResults = strResults & VbCrLf & Trim(Mid(strLine, 2, 20))
						End If
						strResults = strResults & "|" & Trim(Mid(strLine, 24, 17)) & "|" & Trim(Mid(strLine, 41, 4)) & "|" & Trim(Mid(strLine, 47, 5)) & "|" & Trim(Mid(strLine, 54, 10)) & "|" & Trim(Mid(strLine, 66))
					Next
					
					strResults = Replace(strResults, VbCrLf & "|||||", "")
					strResults = Replace(strResults, "USERNAME|SESSIONNAME|ID|STATE|IDLE TIME|LOGON TIME", "")
					arrResults = Array("")
					arrResults = Split(strResults, VbCrLf)
					For Each strLine In arrResults
						If strLine <> "" Then
							If LCase(Split(strLine, "|")(0)) = LCase(sAccount) Then
								'WScript.Echo strResults
								oTSUsersLog.WriteLine """" & sComputer & """,""" & Replace(strLine, "|", """,""") & """"
							End If
						End If
					Next
				Else
					WScript.Echo "No sessions were found on " & strComputer & " for " & sAccount
				End If
	 
			End If
			'========================================================
 
		Loop	 
	End If
	oRecordSet.MoveNext
Loop
 
If Not bProblemPCs Then
	oFS.DeleteFile sProblemPCs,True
End If
 
oWS.Popup "Script completed!", , cTitle, vbInformation
 
Function GetProcesses(sComputer,sAccount)
	Set oWMI = GetObject("winmgmts:" _
	    & "{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
	
	Set colProcessList = oWMI.ExecQuery("Select * from Win32_Process")
	
	For Each oProcess in colProcessList
		colProperties = oProcess.GetOwner(sNameOfUser,sUserDomain)
		sPUser = sUserDomain & "\" & sNameOfUser
	  If sPUser = sAccount Then
	  	oProcessesLog.WriteLine sComputer & "," & sAccount & "," & oProcess.Name
		End If
	Next
	Set oWMI = Nothing
End Function
 
Function GetCurrentUser(sComputer)
	Set oWMI = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
	Set colComputer = oWMI.ExecQuery _
    ("Select * from Win32_ComputerSystem")
 
	For Each oComputer in colComputer
    GetCurrentUser = oComputer.UserName
	Next
End Function
 
Function CheckServices(sComputer, sAccount)
	Err.Clear	
	Set oWMI = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
	If Err.Number <> 0 Then    
    oProblemPCs.WriteLine sComputer & "," & "Failed to connect"
    Err.Clear
  Else
		If Trim(sAccount) = "" Then
			Set colServices = oWMI.ExecQuery("Select Name,Caption,StartName From Win32_Service")
		Else
			Set colServices = oWMI.ExecQuery("Select Name,Caption,StartName From Win32_Service WHERE StartName='" & Replace(sAccount, "\", "\\") & "'")
		End If
		
		For Each oService In colServices
			oServicesLog.WriteLine sComputer & "," & oService.Name & "," & oService.Caption & "," & oService.StartName
		Next
		
	End If
	Set oWMI = Nothing
End Function
 
Function CheckTasks(sComputer, sAccount)		
	sTmpFileName = oFS.GetTempName
	sTmpPath = oWS.ExpandEnvironmentStrings("%TEMP%")
	sTmpFile = sTmpPath & "\" & sTmpFileName
	
	Set oTmpFile = oFS.CreateTextFile(sTmpFile,True)
	oTmpFile.Close
	
	Set oShell = CreateObject("WScript.Shell")
	oShell.Run "cmd /c schtasks /query /s " & sComputer & " /v /fo csv /nh >" & sTmpFile, 0, True
 
	Set oText = oFS.OpenTextFile(sTmpFile, FOR_READING)
	sResults = oText.ReadAll
	
	
	If InStr(sResults, "no scheduled tasks") > 0 Then
 
	Else
		For Each strJob In Split(sResults, VbCrLf)
	  	If Trim(strJob) <> "" Then
	    	' Remove outside quotes, then split by ","
	      arrJob = Split(Mid(strJob, 2, Len(strJob) - 2), """,""")
	      If Trim(sAccount) = "" Then
	      	oTasksLog.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
	      ElseIf LCase(arrJob(18)) = LCase(sAccount) Then
	      	oTasksLog.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
	      End If
	      
	     End If
	   Next
	End If
	oText.Close	
	Set oText = Nothing
	oFS.DeleteFile sTmpFile,True
	sTmpFileName = Empty
	sTmpFile = Empty		
	Set oTmpFile = Nothing
End Function
 
Function Ping(sComputer)
Set oWMI = GetObject(_ 
    "winmgmts:\\.\root\cimv2")
Set colPings = oWMI.ExecQuery _
    ("Select * From Win32_PingStatus where Address = '" & sComputer & "'")
 
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
	Set oWMI = Nothing
End Function

Open in new window

0
 

Author Comment

by:neoptoent
ID: 23212926
Rob,
Now it is not showing anythign in teh results. I logged on to a serving via rdp with id domaina\bob and then put that in the listofaccounts.txt
but nothing was found
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 23220161
Oh yeah, I don't think the domain is checked, try this and see if it checks just the user name.

Regards,

Rob.
On Error Resume Next
 
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
Const ADS_SCOPE_SUBTREE = 2
Const FOR_READING = 1
Const cTitle = "Scan AD Computers"
 
WScript.Echo "Please select a text file containing the user accounts to search for..."
 
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Text Files (*.txt,*.log)|*.txt;*.log|All Files (*.*)|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "."
intResult = objDialog.ShowOpen
 
If intResult = 0 Then
	WScript.Echo "No file was selected."
	WScript.Quit
End If
 
'sAccountsFile = "c:\listOfAccounts.txt"
sAccountsFile = objDialog.FileName
 
'create objects
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oWS = CreateObject("wscript.shell")
 
Do
	sAction = InputBox("Please select the Type of scan: " & vbCrLf & vbCrLf &_
	"1 = Scan for Services." & vbCrLf &_
	"2 = Scan for Tasks." & vbCrLf &_
	"3 = Scan if Users logged in." & vbCrLf &_
	"4 = Scan if Users running processes. " & vbCrLf &_
	"5 = List terminal services and console users." & VbCrLf & vbCrLf &_
	"You can also combine multiple choices by putting coma sign in between," &_
	" example 1,4 ...etc" ,cTitle,"(Enter number here)")	
			
	If InStr(sAction, Chr(49)) Or InStr(sAction, Chr(50)) Or InStr(sAction, Chr(51)) Or InStr(sAction, Chr(52)) Or InStr(sAction, Chr(53)) Then
		Exit Do
	Else	
		sRes = oWS.Popup("Sorry, you must enter a number(s) between 1 and 4 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 InStr(sAction, Chr(49)) Or InStr(sAction, Chr(50)) Or InStr(sAction, Chr(51)) Or InStr(sAction, Chr(52)) Or InStr(sAction, Chr(53))
 
oWS.Popup "Be advised that this script can take a long time to run," & vbCrLf &_
					"so please be patient..." & vbCrLf & vbCrLf &_
					"You can monitor progress of the script by looking at the .csv files," & vbCrLf &_
					"that will be created in the same folder as the script.", ,cTitle, vbinformation
 
If InStr(sAction, Chr(49)) Then
	sServicesLog = "Services.csv"
	Set oServicesLog = oFS.CreateTextFile(sServicesLog, True)
	oServicesLog.WriteLine "Computer Name,Service Name,Caption,RunAs"
End If
If InStr(sAction, Chr(50)) Then
	sTasksLog = "Tasks.csv"
	Set oTasksLog = oFS.CreateTextFile(sTasksLog, True)
	oTasksLog.WriteLine "Computer Name,Task Name,Caption,RunAs"
End If
If InStr(sAction, Chr(51)) Then
	sUserLog = "UsersLoggedIn.csv"
	Set oUserLog = oFS.CreateTextFile(sUserLog, True)
	oUserLog.WriteLine "Computer Name,User Name,is Logged in?"
End If
If InStr(sAction, Chr(52)) Then
	sProcessesLog = "Processes.csv"
	Set oProcessesLog = oFS.CreateTextFile(sProcessesLog, True)
	oProcessesLog.WriteLine "Computer Name,User Name,Process Name"
End If
If InStr(sAction, Chr(53)) Then
	sTSUsersLog = "TerminalServicesUsers.csv"
	Set oTSUsersLog = oFS.CreateTextFile(sTSUsersLog, True)
	oTSUsersLog.WriteLine """Computer"",""Username"",""Session Name"",""ID"",""State"",""Idle Time"",""Logon Time"""
End If
 
' 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
 
Do
	sTypeOfComputersToScan = InputBox("Please specify what type of Computers would you like to scan?" &_
	vbCrLf & "Example: type servers, or type workstations, or type both" &_
	vbCrLf & vbCrLf & "servers = will scan Windows 2000 and 2003 servers" &_
	vbCrLf & "workstations = will only scan for Windows XP", cTitle, "(Type of Computer to scan for, without quotes?)")	
 
	If sTypeOfComputersToScan <> "servers" and sTypeOfComputersToScan <> "workstations" and sTypeOfComputersToScan <> "both" Then
		sRes1 = oWS.Popup("Please enter ''servers'' or ''workstations'' or ''both'' without quotes to continue!" &_
		vbCrLf & vbCrLf & "Do you want to try again?", , cTitle, vbYesNo+vbExclamation)
		If sRes1 = vbno Then
			oWS.Popup "User canceled, Script exiting!", , cTitle, vbInformation
			WScript.Quit
		End If
	End If
Loop Until sTypeOfComputersToScan = "servers" Or sTypeOfComputersToScan = "workstations" Or sTypeOfComputersToScan = "both"
 
If sTypeOfComputersToScan = "servers" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
	& "Where objectClass='computer' and operatingSystemVersion = '5.0 (2195)' " _
	& "OR operatingSystemVersion = '5.2 (3790)'"
End If
 
If sTypeOfComputersToScan = "workstations" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
  & "Where objectClass='computer' and operatingSystemVersion = '5.1 (2600)'"
End If
 
If sTypeOfComputersToScan = "both" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
	& "Where objectClass='computer' and operatingSystemVersion = '5.0 (2195)' " _
	& "OR operatingSystemVersion = '5.2 (3790)' OR operatingSystemVersion = '5.1 (2600)'"
End If
 
oCommand.Properties("Page Size") = 5000
oCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
Set oRecordSet = oCommand.Execute
oRecordSet.MoveFirst
 
sProblemPCs = "ProblemPCs.csv"
Set oProblemPCs = oFS.CreateTextFile(sProblemPCs, True)
oProblemPCs.WriteLine "Computer Name, Status"
bProblemPCs = False
 
Do Until oRecordSet.EOF
	sIsOnline = Nothing
	sComputer = Empty
	sComputer = oRecordSet.Fields("Name").Value
	sComputer = UCase(sComputer)
	sIsOnline = Ping(sComputer)
	
	If IsNull(sIsOnline) Then
		bProblemPCs = True
		oProblemPCs.WriteLine sComputer & "," & "does NOT exist in Domain"
	ElseIf sIsOnline = 11010 Then
		bProblemPCs = True
		oProblemPCs.WriteLine sComputer & "," & "Computer OFF-Line"
	ElseIf sIsOnline = 0 Then
	
		Set oTextFile = Nothing
		Set oTextFile = oFS.OpenTextFile _
    (sAccountsFile, FOR_READING)
    
		Do Until oTextFile.AtEndOfStream
			sAccount = Empty
			sAccount = oTextFile.Readline
		
			If InStr(sAction, Chr(49)) Then
				WScript.Echo "Checking services on " & sComputer & " for " & sAccount
				CheckServices sComputer, sAccount
			End If
				
			If InStr(sAction, Chr(50)) Then
				WScript.Echo "Checking scheduled tasks on " & sComputer & " for " & sAccount
				CheckTasks sComputer, sAccount
			End If	
			If InStr(sAction, Chr(51)) Then
				WScript.Echo "Checking logged in user on " & sComputer
				sCurrentUser = GetCurrentUser(sComputer)
				If sCurrentUser = sAccount Then
					sUserStatus = "User is logged in"
					oUserLog.WriteLine sComputer & "," & sAccount & "," & sUserStatus
				Else
					sUserStatus = "User is NOT logged in"
					oUserLog.WriteLine sComputer & "," & sAccount & "," & sUserStatus
				End If
			End If
			If InStr(sAction, Chr(52)) Then
				WScript.Echo "Scanning " & sComputer & " for " & sAccount
				GetProcesses sComputer,sAccount
			End If
			'========================================================			
			If InStr(sAction, Chr(53)) Then
				WScript.Echo "Scanning " & sComputer & " for terminal services or console sessions of " & sAccount
	 
				' Set these parameters as required
				strComputer = sComputer
				strQUser = "C:\Temp\Citrix Command Line Tools\QUser.exe"
				strOutputFile = "TempOutputfile.txt"
				'---------------------------------
				 
				Set objFSO = CreateObject("Scripting.FileSystemObject")
				Set objShell = CreateObject("WScript.Shell")
				Const intForReading = 1
				strCommand = "cmd /c " & objFSO.GetFile(strQUser).ShortPath & " /SERVER:" & strComputer & " > """ & strOutputFile & """"
				objShell.Run strCommand, 0, True
				If objFSO.GetFile(strOutputFile).Size > 0 Then
					Set objOutputFile = objFSO.OpenTextFile(strOutputFile, intForReading, False)
					arrResults = Split(objOutputFile.ReadAll, VbCrLf)
					objOutputFile.Close
					Set objOutputFile = Nothing
					
					strResults = ""
					For Each strLine In arrResults
						If strResults = "" Then
							strResults = Trim(Mid(strLine, 2, 20))
						Else
							strResults = strResults & VbCrLf & Trim(Mid(strLine, 2, 20))
						End If
						strResults = strResults & "|" & Trim(Mid(strLine, 24, 17)) & "|" & Trim(Mid(strLine, 41, 4)) & "|" & Trim(Mid(strLine, 47, 5)) & "|" & Trim(Mid(strLine, 54, 10)) & "|" & Trim(Mid(strLine, 66))
					Next
					
					strResults = Replace(strResults, VbCrLf & "|||||", "")
					strResults = Replace(strResults, "USERNAME|SESSIONNAME|ID|STATE|IDLE TIME|LOGON TIME", "")
					arrResults = Array("")
					arrResults = Split(strResults, VbCrLf)
					For Each strLine In arrResults
						If strLine <> "" Then
							If InStr(sAccount, "\") > 0 Then sAccount = Split(sAccount, "\")(1)
							If LCase(Split(strLine, "|")(0)) = LCase(sAccount) Then
								'WScript.Echo strResults
								oTSUsersLog.WriteLine """" & sComputer & """,""" & Replace(strLine, "|", """,""") & """"
							End If
						End If
					Next
				Else
					WScript.Echo "No sessions were found on " & strComputer & " for " & sAccount
				End If
	 
			End If
			'========================================================
 
		Loop	 
	End If
	oRecordSet.MoveNext
Loop
 
If Not bProblemPCs Then
	oFS.DeleteFile sProblemPCs,True
End If
 
oWS.Popup "Script completed!", , cTitle, vbInformation
 
Function GetProcesses(sComputer,sAccount)
	Set oWMI = GetObject("winmgmts:" _
	    & "{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
	
	Set colProcessList = oWMI.ExecQuery("Select * from Win32_Process")
	
	For Each oProcess in colProcessList
		colProperties = oProcess.GetOwner(sNameOfUser,sUserDomain)
		sPUser = sUserDomain & "\" & sNameOfUser
	  If sPUser = sAccount Then
	  	oProcessesLog.WriteLine sComputer & "," & sAccount & "," & oProcess.Name
		End If
	Next
	Set oWMI = Nothing
End Function
 
Function GetCurrentUser(sComputer)
	Set oWMI = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
	Set colComputer = oWMI.ExecQuery _
    ("Select * from Win32_ComputerSystem")
 
	For Each oComputer in colComputer
    GetCurrentUser = oComputer.UserName
	Next
End Function
 
Function CheckServices(sComputer, sAccount)
	Err.Clear	
	Set oWMI = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
	If Err.Number <> 0 Then    
    oProblemPCs.WriteLine sComputer & "," & "Failed to connect"
    Err.Clear
  Else
		If Trim(sAccount) = "" Then
			Set colServices = oWMI.ExecQuery("Select Name,Caption,StartName From Win32_Service")
		Else
			Set colServices = oWMI.ExecQuery("Select Name,Caption,StartName From Win32_Service WHERE StartName='" & Replace(sAccount, "\", "\\") & "'")
		End If
		
		For Each oService In colServices
			oServicesLog.WriteLine sComputer & "," & oService.Name & "," & oService.Caption & "," & oService.StartName
		Next
		
	End If
	Set oWMI = Nothing
End Function
 
Function CheckTasks(sComputer, sAccount)		
	sTmpFileName = oFS.GetTempName
	sTmpPath = oWS.ExpandEnvironmentStrings("%TEMP%")
	sTmpFile = sTmpPath & "\" & sTmpFileName
	
	Set oTmpFile = oFS.CreateTextFile(sTmpFile,True)
	oTmpFile.Close
	
	Set oShell = CreateObject("WScript.Shell")
	oShell.Run "cmd /c schtasks /query /s " & sComputer & " /v /fo csv /nh >" & sTmpFile, 0, True
 
	Set oText = oFS.OpenTextFile(sTmpFile, FOR_READING)
	sResults = oText.ReadAll
	
	
	If InStr(sResults, "no scheduled tasks") > 0 Then
 
	Else
		For Each strJob In Split(sResults, VbCrLf)
	  	If Trim(strJob) <> "" Then
	    	' Remove outside quotes, then split by ","
	      arrJob = Split(Mid(strJob, 2, Len(strJob) - 2), """,""")
	      If Trim(sAccount) = "" Then
	      	oTasksLog.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
	      ElseIf LCase(arrJob(18)) = LCase(sAccount) Then
	      	oTasksLog.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
	      End If
	      
	     End If
	   Next
	End If
	oText.Close	
	Set oText = Nothing
	oFS.DeleteFile sTmpFile,True
	sTmpFileName = Empty
	sTmpFile = Empty		
	Set oTmpFile = Nothing
End Function
 
Function Ping(sComputer)
Set oWMI = GetObject(_ 
    "winmgmts:\\.\root\cimv2")
Set colPings = oWMI.ExecQuery _
    ("Select * From Win32_PingStatus where Address = '" & sComputer & "'")
 
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
	Set oWMI = Nothing
End Function

Open in new window

0
 

Author Comment

by:neoptoent
ID: 23240562
Hi,
 
Still nothing showing up
 
 
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 23253490
Hi, this code worked for me.

I have, logged into a terminal server, an account called MYDOMAIN\TestUser

In the UserAccounts.txt file that has my accounts to look for, I have
MYDOMAIN\TestUser

and, during the scan, when it get to that server, it adds the line to the TerminalServicesUsers.csv file.

Regards,

Rob.
On Error Resume Next
 
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
Const ADS_SCOPE_SUBTREE = 2
Const FOR_READING = 1
Const cTitle = "Scan AD Computers"
 
WScript.Echo "Please select a text file containing the user accounts to search for..."
 
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Text Files (*.txt,*.log)|*.txt;*.log|All Files (*.*)|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "."
intResult = objDialog.ShowOpen
 
If intResult = 0 Then
	WScript.Echo "No file was selected."
	WScript.Quit
End If
 
'sAccountsFile = "c:\listOfAccounts.txt"
sAccountsFile = objDialog.FileName
 
'create objects
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oWS = CreateObject("wscript.shell")
 
Do
	sAction = InputBox("Please select the Type of scan: " & vbCrLf & vbCrLf &_
	"1 = Scan for Services." & vbCrLf &_
	"2 = Scan for Tasks." & vbCrLf &_
	"3 = Scan if Users logged in." & vbCrLf &_
	"4 = Scan if Users running processes. " & vbCrLf &_
	"5 = List terminal services and console users." & VbCrLf & vbCrLf &_
	"You can also combine multiple choices by putting coma sign in between," &_
	" example 1,4 ...etc" ,cTitle,"(Enter number here)")	
			
	If InStr(sAction, Chr(49)) Or InStr(sAction, Chr(50)) Or InStr(sAction, Chr(51)) Or InStr(sAction, Chr(52)) Or InStr(sAction, Chr(53)) Then
		Exit Do
	Else	
		sRes = oWS.Popup("Sorry, you must enter a number(s) between 1 and 4 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 InStr(sAction, Chr(49)) Or InStr(sAction, Chr(50)) Or InStr(sAction, Chr(51)) Or InStr(sAction, Chr(52)) Or InStr(sAction, Chr(53))
 
oWS.Popup "Be advised that this script can take a long time to run," & vbCrLf &_
					"so please be patient..." & vbCrLf & vbCrLf &_
					"You can monitor progress of the script by looking at the .csv files," & vbCrLf &_
					"that will be created in the same folder as the script.", ,cTitle, vbinformation
 
If InStr(sAction, Chr(49)) Then
	sServicesLog = "Services.csv"
	Set oServicesLog = oFS.CreateTextFile(sServicesLog, True)
	oServicesLog.WriteLine "Computer Name,Service Name,Caption,RunAs"
End If
If InStr(sAction, Chr(50)) Then
	sTasksLog = "Tasks.csv"
	Set oTasksLog = oFS.CreateTextFile(sTasksLog, True)
	oTasksLog.WriteLine "Computer Name,Task Name,Caption,RunAs"
End If
If InStr(sAction, Chr(51)) Then
	sUserLog = "UsersLoggedIn.csv"
	Set oUserLog = oFS.CreateTextFile(sUserLog, True)
	oUserLog.WriteLine "Computer Name,User Name,is Logged in?"
End If
If InStr(sAction, Chr(52)) Then
	sProcessesLog = "Processes.csv"
	Set oProcessesLog = oFS.CreateTextFile(sProcessesLog, True)
	oProcessesLog.WriteLine "Computer Name,User Name,Process Name"
End If
If InStr(sAction, Chr(53)) Then
	sTSUsersLog = "TerminalServicesUsers.csv"
	Set oTSUsersLog = oFS.CreateTextFile(sTSUsersLog, True)
	oTSUsersLog.WriteLine """Computer"",""Username"",""Session Name"",""ID"",""State"",""Idle Time"",""Logon Time"""
End If
 
' 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
 
Do
	sTypeOfComputersToScan = InputBox("Please specify what type of Computers would you like to scan?" &_
	vbCrLf & "Example: type servers, or type workstations, or type both" &_
	vbCrLf & vbCrLf & "servers = will scan Windows 2000 and 2003 servers" &_
	vbCrLf & "workstations = will only scan for Windows XP", cTitle, "(Type of Computer to scan for, without quotes?)")	
 
	If sTypeOfComputersToScan <> "servers" and sTypeOfComputersToScan <> "workstations" and sTypeOfComputersToScan <> "both" Then
		sRes1 = oWS.Popup("Please enter ''servers'' or ''workstations'' or ''both'' without quotes to continue!" &_
		vbCrLf & vbCrLf & "Do you want to try again?", , cTitle, vbYesNo+vbExclamation)
		If sRes1 = vbno Then
			oWS.Popup "User canceled, Script exiting!", , cTitle, vbInformation
			WScript.Quit
		End If
	End If
Loop Until sTypeOfComputersToScan = "servers" Or sTypeOfComputersToScan = "workstations" Or sTypeOfComputersToScan = "both"
 
If sTypeOfComputersToScan = "servers" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
	& "Where objectClass='computer' and operatingSystemVersion = '5.0 (2195)' " _
	& "OR operatingSystemVersion = '5.2 (3790)'"
End If
 
If sTypeOfComputersToScan = "workstations" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
  & "Where objectClass='computer' and operatingSystemVersion = '5.1 (2600)'"
End If
 
If sTypeOfComputersToScan = "both" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
	& "Where objectClass='computer' and operatingSystemVersion = '5.0 (2195)' " _
	& "OR operatingSystemVersion = '5.2 (3790)' OR operatingSystemVersion = '5.1 (2600)'"
End If
 
oCommand.Properties("Page Size") = 5000
oCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
Set oRecordSet = oCommand.Execute
oRecordSet.MoveFirst
 
sProblemPCs = "ProblemPCs.csv"
Set oProblemPCs = oFS.CreateTextFile(sProblemPCs, True)
oProblemPCs.WriteLine "Computer Name, Status"
bProblemPCs = False
 
Do Until oRecordSet.EOF
	sIsOnline = Nothing
	sComputer = Empty
	sComputer = oRecordSet.Fields("Name").Value
	sComputer = UCase(sComputer)
	sIsOnline = Ping(sComputer)
	
	If IsNull(sIsOnline) Then
		bProblemPCs = True
		oProblemPCs.WriteLine sComputer & "," & "does NOT exist in Domain"
	ElseIf sIsOnline = 11010 Then
		bProblemPCs = True
		oProblemPCs.WriteLine sComputer & "," & "Computer OFF-Line"
	ElseIf sIsOnline = 0 Then
	
		Set oTextFile = Nothing
		Set oTextFile = oFS.OpenTextFile _
    (sAccountsFile, FOR_READING)
    
		Do Until oTextFile.AtEndOfStream
			sAccount = Empty
			sAccount = oTextFile.Readline
		
			If InStr(sAction, Chr(49)) Then
				WScript.Echo "Checking services on " & sComputer & " for " & sAccount
				CheckServices sComputer, sAccount
			End If
				
			If InStr(sAction, Chr(50)) Then
				WScript.Echo "Checking scheduled tasks on " & sComputer & " for " & sAccount
				CheckTasks sComputer, sAccount
			End If	
			If InStr(sAction, Chr(51)) Then
				WScript.Echo "Checking logged in user on " & sComputer
				sCurrentUser = GetCurrentUser(sComputer)
				If sCurrentUser = sAccount Then
					sUserStatus = "User is logged in"
					oUserLog.WriteLine sComputer & "," & sAccount & "," & sUserStatus
				Else
					sUserStatus = "User is NOT logged in"
					oUserLog.WriteLine sComputer & "," & sAccount & "," & sUserStatus
				End If
			End If
			If InStr(sAction, Chr(52)) Then
				WScript.Echo "Scanning " & sComputer & " for " & sAccount
				GetProcesses sComputer,sAccount
			End If
			'========================================================			
			If InStr(sAction, Chr(53)) Then
				WScript.Echo "Scanning " & sComputer & " for terminal services or console sessions of " & sAccount
	 
				' Set these parameters as required
				strComputer = sComputer
				strQUser = "C:\Temp\Citrix Command Line Tools\QUser.exe"
				strOutputFile = "TempOutputfile.txt"
				'---------------------------------
				 
				Set objFSO = CreateObject("Scripting.FileSystemObject")
				Set objShell = CreateObject("WScript.Shell")
				Const intForReading = 1
				strCommand = "cmd /c " & objFSO.GetFile(strQUser).ShortPath & " /SERVER:" & strComputer & " > """ & strOutputFile & """"
				objShell.Run strCommand, 0, True
				If objFSO.GetFile(strOutputFile).Size > 0 Then
					Set objOutputFile = objFSO.OpenTextFile(strOutputFile, intForReading, False)
					arrResults = Split(objOutputFile.ReadAll, VbCrLf)
					objOutputFile.Close
					Set objOutputFile = Nothing
					
					strResults = ""
					For Each strLine In arrResults
						If strResults = "" Then
							strResults = Trim(Mid(strLine, 2, 20))
						Else
							strResults = strResults & VbCrLf & Trim(Mid(strLine, 2, 20))
						End If
						strResults = strResults & "|" & Trim(Mid(strLine, 24, 17)) & "|" & Trim(Mid(strLine, 41, 4)) & "|" & Trim(Mid(strLine, 47, 5)) & "|" & Trim(Mid(strLine, 54, 10)) & "|" & Trim(Mid(strLine, 66))
					Next
					
					strResults = Replace(strResults, VbCrLf & "|||||", "")
					strResults = Replace(strResults, "USERNAME|SESSIONNAME|ID|STATE|IDLE TIME|LOGON TIME", "")
					arrResults = Array("")
					arrResults = Split(strResults, VbCrLf)
					For Each strLine In arrResults
						If strLine <> "" Then
							If InStr(sAccount, "\") > 0 Then sAccount = Split(sAccount, "\")(1)
							If LCase(Split(strLine, "|")(0)) = LCase(sAccount) Then
								'WScript.Echo strResults
								oTSUsersLog.WriteLine """" & sComputer & """,""" & Replace(strLine, "|", """,""") & """"
							End If
						End If
					Next
				Else
					WScript.Echo "No sessions were found on " & strComputer & " for " & sAccount
				End If
	 
			End If
			'========================================================
 
		Loop	 
	End If
	oRecordSet.MoveNext
Loop
 
If Not bProblemPCs Then
	oFS.DeleteFile sProblemPCs,True
End If
 
oWS.Popup "Script completed!", , cTitle, vbInformation
 
Function GetProcesses(sComputer,sAccount)
	Set oWMI = GetObject("winmgmts:" _
	    & "{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
	
	Set colProcessList = oWMI.ExecQuery("Select * from Win32_Process")
	
	For Each oProcess in colProcessList
		colProperties = oProcess.GetOwner(sNameOfUser,sUserDomain)
		sPUser = sUserDomain & "\" & sNameOfUser
	  If sPUser = sAccount Then
	  	oProcessesLog.WriteLine sComputer & "," & sAccount & "," & oProcess.Name
		End If
	Next
	Set oWMI = Nothing
End Function
 
Function GetCurrentUser(sComputer)
	Set oWMI = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
	Set colComputer = oWMI.ExecQuery _
    ("Select * from Win32_ComputerSystem")
 
	For Each oComputer in colComputer
    GetCurrentUser = oComputer.UserName
	Next
End Function
 
Function CheckServices(sComputer, sAccount)
	Err.Clear	
	Set oWMI = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
	If Err.Number <> 0 Then    
    oProblemPCs.WriteLine sComputer & "," & "Failed to connect"
    Err.Clear
  Else
		If Trim(sAccount) = "" Then
			Set colServices = oWMI.ExecQuery("Select Name,Caption,StartName From Win32_Service")
		Else
			Set colServices = oWMI.ExecQuery("Select Name,Caption,StartName From Win32_Service WHERE StartName='" & Replace(sAccount, "\", "\\") & "'")
		End If
		
		For Each oService In colServices
			oServicesLog.WriteLine sComputer & "," & oService.Name & "," & oService.Caption & "," & oService.StartName
		Next
		
	End If
	Set oWMI = Nothing
End Function
 
Function CheckTasks(sComputer, sAccount)		
	sTmpFileName = oFS.GetTempName
	sTmpPath = oWS.ExpandEnvironmentStrings("%TEMP%")
	sTmpFile = sTmpPath & "\" & sTmpFileName
	
	Set oTmpFile = oFS.CreateTextFile(sTmpFile,True)
	oTmpFile.Close
	
	Set oShell = CreateObject("WScript.Shell")
	oShell.Run "cmd /c schtasks /query /s " & sComputer & " /v /fo csv /nh >" & sTmpFile, 0, True
 
	Set oText = oFS.OpenTextFile(sTmpFile, FOR_READING)
	sResults = oText.ReadAll
	
	
	If InStr(sResults, "no scheduled tasks") > 0 Then
 
	Else
		For Each strJob In Split(sResults, VbCrLf)
	  	If Trim(strJob) <> "" Then
	    	' Remove outside quotes, then split by ","
	      arrJob = Split(Mid(strJob, 2, Len(strJob) - 2), """,""")
	      If Trim(sAccount) = "" Then
	      	oTasksLog.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
	      ElseIf LCase(arrJob(18)) = LCase(sAccount) Then
	      	oTasksLog.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
	      End If
	      
	     End If
	   Next
	End If
	oText.Close	
	Set oText = Nothing
	oFS.DeleteFile sTmpFile,True
	sTmpFileName = Empty
	sTmpFile = Empty		
	Set oTmpFile = Nothing
End Function
 
Function Ping(sComputer)
Set oWMI = GetObject(_ 
    "winmgmts:\\.\root\cimv2")
Set colPings = oWMI.ExecQuery _
    ("Select * From Win32_PingStatus where Address = '" & sComputer & "'")
 
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
	Set oWMI = Nothing
End Function

Open in new window

0
 

Author Comment

by:neoptoent
ID: 23256517
I dont get it
 
I put my domain\joe in the UserAccounts.txt.
I used RDP to login to servera
I see in cmd window is show
scanning server servera and no sesion for domain\joe
I dont get why it doesnt work
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 23258168
OK, can I get you to log someone into a terminalserver, then run
QUSER /SERVER:servera

from a DOS prompt?

Post the output of that command here.  You should have the user listed....

Regards,

Rob.
0
 

Author Comment

by:neoptoent
ID: 23269973
USERNAME              SESSIONNAME        ID  STATE   IDLE TIME  LOGON TIME
BOB         rdp-tcp#335         2  Active         48  12/18/2008 5:25
 AM
JOE        rdp-tcp#336         3  Active          .  12/24/2008 9:01
 
 
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 2000 total points
ID: 23276707
Gee, that's odd..I'm doing exactly the same thing....

Maybe try this.  I've made a full path to the QUser results when it runs it, instead of a relative path...

I have also changed the output text so that you get:
    No RDP or Console Sessions were found on SERVERA for DOMAIN\UserA
or you will get
    Session(s) found on SERVERA for DOMAIN\UserA. Writing to log file

so that you know if it found one, and you should expect that to be in the log file.

Don't forget to change
                        strQUser = "C:\Temp\Citrix Command Line Tools\QUser.exe"

Regards,

Rob.
On Error Resume Next
 
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
Const ADS_SCOPE_SUBTREE = 2
Const FOR_READING = 1
Const cTitle = "Scan AD Computers"
 
WScript.Echo "Please select a text file containing the user accounts to search for..."
 
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Text Files (*.txt,*.log)|*.txt;*.log|All Files (*.*)|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "."
intResult = objDialog.ShowOpen
 
If intResult = 0 Then
	WScript.Echo "No file was selected."
	WScript.Quit
End If
 
'sAccountsFile = "c:\listOfAccounts.txt"
sAccountsFile = objDialog.FileName
 
'create objects
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oWS = CreateObject("wscript.shell")
 
Do
	sAction = InputBox("Please select the Type of scan: " & vbCrLf & vbCrLf &_
	"1 = Scan for Services." & vbCrLf &_
	"2 = Scan for Tasks." & vbCrLf &_
	"3 = Scan if Users logged in." & vbCrLf &_
	"4 = Scan if Users running processes. " & vbCrLf &_
	"5 = List terminal services and console users." & VbCrLf & vbCrLf &_
	"You can also combine multiple choices by putting coma sign in between," &_
	" example 1,4 ...etc" ,cTitle,"(Enter number here)")	
			
	If InStr(sAction, Chr(49)) Or InStr(sAction, Chr(50)) Or InStr(sAction, Chr(51)) Or InStr(sAction, Chr(52)) Or InStr(sAction, Chr(53)) Then
		Exit Do
	Else	
		sRes = oWS.Popup("Sorry, you must enter a number(s) between 1 and 4 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 InStr(sAction, Chr(49)) Or InStr(sAction, Chr(50)) Or InStr(sAction, Chr(51)) Or InStr(sAction, Chr(52)) Or InStr(sAction, Chr(53))
 
oWS.Popup "Be advised that this script can take a long time to run," & vbCrLf &_
					"so please be patient..." & vbCrLf & vbCrLf &_
					"You can monitor progress of the script by looking at the .csv files," & vbCrLf &_
					"that will be created in the same folder as the script.", ,cTitle, vbinformation
 
If InStr(sAction, Chr(49)) Then
	sServicesLog = "Services.csv"
	Set oServicesLog = oFS.CreateTextFile(sServicesLog, True)
	oServicesLog.WriteLine "Computer Name,Service Name,Caption,RunAs"
End If
If InStr(sAction, Chr(50)) Then
	sTasksLog = "Tasks.csv"
	Set oTasksLog = oFS.CreateTextFile(sTasksLog, True)
	oTasksLog.WriteLine "Computer Name,Task Name,Caption,RunAs"
End If
If InStr(sAction, Chr(51)) Then
	sUserLog = "UsersLoggedIn.csv"
	Set oUserLog = oFS.CreateTextFile(sUserLog, True)
	oUserLog.WriteLine "Computer Name,User Name,is Logged in?"
End If
If InStr(sAction, Chr(52)) Then
	sProcessesLog = "Processes.csv"
	Set oProcessesLog = oFS.CreateTextFile(sProcessesLog, True)
	oProcessesLog.WriteLine "Computer Name,User Name,Process Name"
End If
If InStr(sAction, Chr(53)) Then
	sTSUsersLog = "TerminalServicesUsers.csv"
	Set oTSUsersLog = oFS.CreateTextFile(sTSUsersLog, True)
	oTSUsersLog.WriteLine """Computer"",""Username"",""Session Name"",""ID"",""State"",""Idle Time"",""Logon Time"""
End If
 
' 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
 
Do
	sTypeOfComputersToScan = InputBox("Please specify what type of Computers would you like to scan?" &_
	vbCrLf & "Example: type servers, or type workstations, or type both" &_
	vbCrLf & vbCrLf & "servers = will scan Windows 2000 and 2003 servers" &_
	vbCrLf & "workstations = will only scan for Windows XP", cTitle, "(Type of Computer to scan for, without quotes?)")	
 
	If sTypeOfComputersToScan <> "servers" and sTypeOfComputersToScan <> "workstations" and sTypeOfComputersToScan <> "both" Then
		sRes1 = oWS.Popup("Please enter ''servers'' or ''workstations'' or ''both'' without quotes to continue!" &_
		vbCrLf & vbCrLf & "Do you want to try again?", , cTitle, vbYesNo+vbExclamation)
		If sRes1 = vbno Then
			oWS.Popup "User canceled, Script exiting!", , cTitle, vbInformation
			WScript.Quit
		End If
	End If
Loop Until sTypeOfComputersToScan = "servers" Or sTypeOfComputersToScan = "workstations" Or sTypeOfComputersToScan = "both"
 
If sTypeOfComputersToScan = "servers" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
	& "Where objectClass='computer' and operatingSystemVersion = '5.0 (2195)' " _
	& "OR operatingSystemVersion = '5.2 (3790)'"
End If
 
If sTypeOfComputersToScan = "workstations" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
  & "Where objectClass='computer' and operatingSystemVersion = '5.1 (2600)'"
End If
 
If sTypeOfComputersToScan = "both" Then
	oCommand.CommandText = "Select Name, Location from '" & sADsPath & "' " _
	& "Where objectClass='computer' and operatingSystemVersion = '5.0 (2195)' " _
	& "OR operatingSystemVersion = '5.2 (3790)' OR operatingSystemVersion = '5.1 (2600)'"
End If
 
oCommand.Properties("Page Size") = 5000
oCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
Set oRecordSet = oCommand.Execute
oRecordSet.MoveFirst
 
sProblemPCs = "ProblemPCs.csv"
Set oProblemPCs = oFS.CreateTextFile(sProblemPCs, True)
oProblemPCs.WriteLine "Computer Name, Status"
bProblemPCs = False
 
Do Until oRecordSet.EOF
	sIsOnline = Nothing
	sComputer = Empty
	sComputer = oRecordSet.Fields("Name").Value
	sComputer = UCase(sComputer)
	sIsOnline = Ping(sComputer)
	
	If IsNull(sIsOnline) Then
		bProblemPCs = True
		oProblemPCs.WriteLine sComputer & "," & "does NOT exist in Domain"
	ElseIf sIsOnline = 11010 Then
		bProblemPCs = True
		oProblemPCs.WriteLine sComputer & "," & "Computer OFF-Line"
	ElseIf sIsOnline = 0 Then
	
		Set oTextFile = Nothing
		Set oTextFile = oFS.OpenTextFile _
    (sAccountsFile, FOR_READING)
    
		Do Until oTextFile.AtEndOfStream
			sAccount = Empty
			sAccount = oTextFile.Readline
		
			If InStr(sAction, Chr(49)) Then
				WScript.Echo "Checking services on " & sComputer & " for " & sAccount
				CheckServices sComputer, sAccount
			End If
				
			If InStr(sAction, Chr(50)) Then
				WScript.Echo "Checking scheduled tasks on " & sComputer & " for " & sAccount
				CheckTasks sComputer, sAccount
			End If	
			If InStr(sAction, Chr(51)) Then
				WScript.Echo "Checking logged in user on " & sComputer
				sCurrentUser = GetCurrentUser(sComputer)
				If sCurrentUser = sAccount Then
					sUserStatus = "User is logged in"
					oUserLog.WriteLine sComputer & "," & sAccount & "," & sUserStatus
				Else
					sUserStatus = "User is NOT logged in"
					oUserLog.WriteLine sComputer & "," & sAccount & "," & sUserStatus
				End If
			End If
			If InStr(sAction, Chr(52)) Then
				WScript.Echo "Scanning " & sComputer & " for " & sAccount
				GetProcesses sComputer,sAccount
			End If
			'========================================================			
			If InStr(sAction, Chr(53)) Then
				'WScript.Echo "Scanning " & sComputer & " for terminal services or console sessions of " & sAccount
	 
				' Set these parameters as required
				strComputer = sComputer
				strQUser = "C:\Temp\Citrix Command Line Tools\QUser.exe"
				strOutputFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempOutputfile.txt"
				'---------------------------------
				 
				Set objFSO = CreateObject("Scripting.FileSystemObject")
				Set objShell = CreateObject("WScript.Shell")
				Const intForReading = 1
				Set objTempFile = objFSO.CreateTextFile(strOutputFile, True)
				objTempFile.Close
				strOutputFile = objFSO.GetFile(strOutputFile).ShortPath
				strCommand = "cmd /c " & objFSO.GetFile(strQUser).ShortPath & " /SERVER:" & strComputer & " > " & strOutputFile
				objShell.Run strCommand, 0, True
				If objFSO.GetFile(strOutputFile).Size > 0 Then
					' Get just the user name. The Domain Name is not shown in the QUser output
					If InStr(sAccount, "\") > 0 Then
						sAccountToFind = Split(sAccount, "\")(1)
					Else
						sAccountToFind = sAccount
					End If
 
					Set objOutputFile = objFSO.OpenTextFile(strOutputFile, intForReading, False)
					arrResults = Split(objOutputFile.ReadAll, VbCrLf)
					objOutputFile.Close
					Set objOutputFile = Nothing
					
					strResults = ""
					For Each strLine In arrResults
						If strResults = "" Then
							strResults = Trim(Mid(strLine, 2, 20))
						Else
							strResults = strResults & VbCrLf & Trim(Mid(strLine, 2, 20))
						End If
						strResults = strResults & "|" & Trim(Mid(strLine, 24, 17)) & "|" & Trim(Mid(strLine, 41, 4)) & "|" & Trim(Mid(strLine, 47, 5)) & "|" & Trim(Mid(strLine, 54, 10)) & "|" & Trim(Mid(strLine, 66))
					Next
					
					strResults = Replace(strResults, VbCrLf & "|||||", "")
					strResults = Replace(strResults, "USERNAME|SESSIONNAME|ID|STATE|IDLE TIME|LOGON TIME", "")
					arrResults = Array("")
					arrResults = Split(strResults, VbCrLf)
					boolFound = False
					For Each strLine In arrResults
						If strLine <> "" Then
							If LCase(Split(strLine, "|")(0)) = LCase(sAccountToFind) Then
								'WScript.Echo strResults
								oTSUsersLog.WriteLine """" & sComputer & """,""" & Replace(strLine, "|", """,""") & """"
								boolFound = True
							End If
						End If
					Next
					If boolFound = False Then
						WScript.Echo "No RDP or Console sessions were found on " & strComputer & " for " & sAccount
					Else
						WScript.Echo "Session(s) found on " & strComputer & " for " & sAccount & ". Writing to log file"
					End If
				Else
					WScript.Echo "No RDP or Console sessions were found on " & strComputer & " for " & sAccount
				End If
	 
			End If
			'========================================================
 
		Loop	 
	End If
	oRecordSet.MoveNext
Loop
 
If Not bProblemPCs Then
	oFS.DeleteFile sProblemPCs,True
End If
 
oWS.Popup "Script completed!", , cTitle, vbInformation
 
Function GetProcesses(sComputer,sAccount)
	Set oWMI = GetObject("winmgmts:" _
	    & "{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
	
	Set colProcessList = oWMI.ExecQuery("Select * from Win32_Process")
	
	For Each oProcess in colProcessList
		colProperties = oProcess.GetOwner(sNameOfUser,sUserDomain)
		sPUser = sUserDomain & "\" & sNameOfUser
	  If sPUser = sAccount Then
	  	oProcessesLog.WriteLine sComputer & "," & sAccount & "," & oProcess.Name
		End If
	Next
	Set oWMI = Nothing
End Function
 
Function GetCurrentUser(sComputer)
	Set oWMI = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
	Set colComputer = oWMI.ExecQuery _
    ("Select * from Win32_ComputerSystem")
 
	For Each oComputer in colComputer
    GetCurrentUser = oComputer.UserName
	Next
End Function
 
Function CheckServices(sComputer, sAccount)
	Err.Clear	
	Set oWMI = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
	If Err.Number <> 0 Then    
    oProblemPCs.WriteLine sComputer & "," & "Failed to connect"
    Err.Clear
  Else
		If Trim(sAccount) = "" Then
			Set colServices = oWMI.ExecQuery("Select Name,Caption,StartName From Win32_Service")
		Else
			Set colServices = oWMI.ExecQuery("Select Name,Caption,StartName From Win32_Service WHERE StartName='" & Replace(sAccount, "\", "\\") & "'")
		End If
		
		For Each oService In colServices
			oServicesLog.WriteLine sComputer & "," & oService.Name & "," & oService.Caption & "," & oService.StartName
		Next
		
	End If
	Set oWMI = Nothing
End Function
 
Function CheckTasks(sComputer, sAccount)		
	sTmpFileName = oFS.GetTempName
	sTmpPath = oWS.ExpandEnvironmentStrings("%TEMP%")
	sTmpFile = sTmpPath & "\" & sTmpFileName
	
	Set oTmpFile = oFS.CreateTextFile(sTmpFile,True)
	oTmpFile.Close
	
	Set oShell = CreateObject("WScript.Shell")
	oShell.Run "cmd /c schtasks /query /s " & sComputer & " /v /fo csv /nh >" & sTmpFile, 0, True
 
	Set oText = oFS.OpenTextFile(sTmpFile, FOR_READING)
	sResults = oText.ReadAll
	
	
	If InStr(sResults, "no scheduled tasks") > 0 Then
 
	Else
		For Each strJob In Split(sResults, VbCrLf)
	  	If Trim(strJob) <> "" Then
	    	' Remove outside quotes, then split by ","
	      arrJob = Split(Mid(strJob, 2, Len(strJob) - 2), """,""")
	      If Trim(sAccount) = "" Then
	      	oTasksLog.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
	      ElseIf LCase(arrJob(18)) = LCase(sAccount) Then
	      	oTasksLog.WriteLine arrJob(0) & "," & arrJob(1) & "," & arrJob(8) & "," & arrJob(18)
	      End If
	      
	     End If
	   Next
	End If
	oText.Close	
	Set oText = Nothing
	oFS.DeleteFile sTmpFile,True
	sTmpFileName = Empty
	sTmpFile = Empty		
	Set oTmpFile = Nothing
End Function
 
Function Ping(sComputer)
Set oWMI = GetObject(_ 
    "winmgmts:\\.\root\cimv2")
Set colPings = oWMI.ExecQuery _
    ("Select * From Win32_PingStatus where Address = '" & sComputer & "'")
 
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
	Set oWMI = Nothing
End Function

Open in new window

0
 

Author Comment

by:neoptoent
ID: 23280696
THAT IS AWSOME Works amazingly
Got a question. If I want to search for a Local account instead of a domain account so for example "joe" instead of domaina\joe
is that possible witht this script  or will I need to post a new question for that?
Thanks so much and happy new year
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 23283148
OK, glad it works! LOL!

Yeah, when you select option 5, I'm pretty sure I wrote it so you can just put
JOE

in the UserAccounts.txt file that you select, and option 5 will still report on that.  As you can see by your QUser.exe output above, the domain is ignored, and not even shown, so putting just
JOE

should bring it up.  It seems unable to distinguish between a domain and local account....

Regards,

Rob.
0
 

Author Comment

by:neoptoent
ID: 23304260
THIS IS AWSOME
 
THANKS SO MUCH
0
 

Author Closing Comment

by:neoptoent
ID: 31513495
THIS IS AWSOME



THANKS SO MUCH
0
 

Author Comment

by:neoptoent
ID: 23304281
Rob,
 
Why does it say very good on top and not EXCELLENT for the grade. This deserves a 10
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 23310125
Ha ha, honestly, I don't know how the grading system works.....I thought you select ratings for criteria when you accept a solution, and it's based on that....perhaps it takes the time a question was open into account....doesn't really matter though....thanks for the grade.

Regards,

Rob.
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

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

Group policies can be applied selectively to specific devices with the help of groups. Utilising this, it is possible to phase-in group policies, over a period of time, by randomly adding non-members user or computers at a set interval, to a group f…
In the absence of a fully-fledged GPO Management product like AGPM, the script in this article will provide you with a simple way to watch the domain (or a select OU) for GPOs changes and automatically take backups when policies are added, removed o…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
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…
Suggested Courses

831 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