Remote username

I need help to modify the following VBScript to collect the remote username as well.

Thanks
Cheers

Dim wmiQuery, objWMIService, objPing, objStatus
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const intForAppending = 8
strPrinterTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZInputlist.txt"
strIPTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZOutputlist.txt"
Set objInput = objFSO.OpenTextFile(strPrinterTextFile, intForReading, False)
Set objOutput = objFSO.OpenTextFile(strIPTextFile, intForAppending, False)
While Not objInput.AtEndOfStream
   strcomputer = objInput.ReadLine
   Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
 ' Set objWMIService = GetObject("winmgmts:{impersonationlevel=impersonate}!\\" & strComputer & "\root\cimv2")
 ' Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
   Set objping = objWMIService.ExecQuery("Select * From Win32_PingStatus Where " & "Address = '" & strComputer & "'")
   for each objstatus in objping
       If IsNull(objStatus.StatusCode) Or objStatus.Statuscode <> 0 Then
           ResolveIP = strcomputer & " " & "Computer is Unreachable"
       Else
           ResolveIP = strcomputer & " " & objStatus.ProtocolAddress
       End If
       objoutput.WriteLine(resolveip)
   next
Wend
objInput.Close
objOutput.Close
wscript.echo "Job Completed"
Bianchi928Asked:
Who is Participating?
 
RobSampsonConnect With a Mentor Commented:
OK, that's quite strange, but anyways, this is 35075601 with the error checking.

Regards,

Rob.
strUsername = "domain\administrator"
strPassword = "password"

Const WbemAuthenticationLevelPktPrivacy = 6
Dim wmiQuery, objWMIService, objPing, objStatus
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const intForAppending = 8
strPrinterTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZInputlist.txt"
strIPTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZOutputlist.csv"
Set objInput = objFSO.OpenTextFile(strPrinterTextFile, intForReading, False)
Set objOutput = objFSO.OpenTextFile(strIPTextFile, intForAppending, True)
While Not objInput.AtEndOfStream
   strcomputer = objInput.ReadLine
   Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
   Set objping = objWMIService.ExecQuery("Select * From Win32_PingStatus Where " & "Address = '" & strComputer & "'")
   For Each objstatus In objPing
       If IsNull(objStatus.StatusCode) Or objStatus.Statuscode <> 0 Then
           objOutput.WriteLine strcomputer & ",offline"
       Else
		   Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
		   On Error Resume Next
		   Set objWMIService = objwbemLocator.ConnectServer(strComputer, "root\cimv2", strUsername, strPassword)
		   If Err.Number = 0 Then
			   Err.Clear
			   On Error GoTo 0
			   objWMIService.Security_.authenticationLevel = WbemAuthenticationLevelPktPrivacy
	           Set colComputer = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem")
	           strUser = ""
	           For Each objComputer in colComputer
	               strUser = objComputer.UserName
	           Next
	           objoutput.WriteLine strcomputer & "," & objStatus.ProtocolAddress & "," & strUser
	       Else
			   Err.Clear
			   On Error GoTo 0
	           objoutput.WriteLine strcomputer & "," & objStatus.ProtocolAddress & ",WMI ERROR"
	       End If
       End If
   Next
Wend
objInput.Close
objOutput.Close
wscript.echo "Job Completed"

Open in new window

0
 
ScottyworldCommented:
The following will display the username

Dim objNetwork
Set objNetwork = CreateObject("WScript.Network")
MsgBox objNetwork.UserName
0
 
ScottyworldCommented:
Sorry, to get it from the remote PC you'll need to add the following lines to your script

Set colComputer = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem")
For Each objComputer in colComputer
    msgbox ("Logged-on user: " & objComputer.UserName)
Next
0
Cloud Class® Course: C++ 11 Fundamentals

This course will introduce you to C++ 11 and teach you about syntax fundamentals.

 
Bianchi928Author Commented:

Where should I include it in my existing script ? Since I'm writing to an output file, I  want it to give me the username for one computer at a time
0
 
RobSampsonCommented:
Hi, I think this should work. I've plugged in Scottyworld's code for you.

Regards,

Rob.
Dim wmiQuery, objWMIService, objPing, objStatus
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const intForAppending = 8
strPrinterTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZInputlist.txt"
strIPTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZOutputlist.txt"
Set objInput = objFSO.OpenTextFile(strPrinterTextFile, intForReading, False)
Set objOutput = objFSO.OpenTextFile(strIPTextFile, intForAppending, False)
While Not objInput.AtEndOfStream
   strcomputer = objInput.ReadLine
   Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
 ' Set objWMIService = GetObject("winmgmts:{impersonationlevel=impersonate}!\\" & strComputer & "\root\cimv2")
 ' Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
   Set objping = objWMIService.ExecQuery("Select * From Win32_PingStatus Where " & "Address = '" & strComputer & "'")
   for each objstatus in objping
       If IsNull(objStatus.StatusCode) Or objStatus.Statuscode <> 0 Then
           ResolveIP = strcomputer & " " & "Computer is Unreachable"
       Else
           ResolveIP = strcomputer & " " & objStatus.ProtocolAddress
       End If
   Next
	Set colComputer = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem")
	strUser = ""
	For Each objComputer in colComputer
	    strUser = objComputer.UserName
	Next
	objoutput.WriteLine resolveip & "," & strUser
Wend
objInput.Close
objOutput.Close
wscript.echo "Job Completed"

Open in new window

0
 
Bianchi928Author Commented:
I tried the above script and it's giving me MY username instead of the remote username.

Cheers
0
 
RobSampsonCommented:
Oh, you've got some different objWMIService lines there.

Try this.

Regards,

Rob.
Dim wmiQuery, objWMIService, objPing, objStatus
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const intForAppending = 8
strPrinterTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZInputlist.txt"
strIPTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZOutputlist.txt"
Set objInput = objFSO.OpenTextFile(strPrinterTextFile, intForReading, False)
Set objOutput = objFSO.OpenTextFile(strIPTextFile, intForAppending, False)
While Not objInput.AtEndOfStream
   strcomputer = objInput.ReadLine
   Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
 ' Set objWMIService = GetObject("winmgmts:{impersonationlevel=impersonate}!\\" & strComputer & "\root\cimv2")
 ' Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
   Set objping = objWMIService.ExecQuery("Select * From Win32_PingStatus Where " & "Address = '" & strComputer & "'")
   for each objstatus in objping
       If IsNull(objStatus.StatusCode) Or objStatus.Statuscode <> 0 Then
           ResolveIP = strcomputer & " " & "Computer is Unreachable"
       Else
           ResolveIP = strcomputer & " " & objStatus.ProtocolAddress
       End If
   Next
Set objWMIService = GetObject("winmgmts:{impersonationlevel=impersonate}!\\" & strComputer & "\root\cimv2")
	Set colComputer = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem")
	strUser = ""
	For Each objComputer in colComputer
	    strUser = objComputer.UserName
	Next
	objoutput.WriteLine resolveip & "," & strUser
Wend
objInput.Close
objOutput.Close
wscript.echo "Job Completed"

Open in new window

0
 
Bianchi928Author Commented:
Now, I'm getting an error message on line 23

error.bmp
0
 
ScottyworldCommented:
yep, cheers Rob - I've just noticed that the extra line you put in (23) was commented out higher up, hence why I omitted it the first time!
0
 
RobSampsonCommented:
That means there might be a WMI error on that machine, or it's not contactable.  Try this.

Regards,

Rob.
Dim wmiQuery, objWMIService, objPing, objStatus
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const intForAppending = 8
strPrinterTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZInputlist.txt"
strIPTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZOutputlist.txt"
Set objInput = objFSO.OpenTextFile(strPrinterTextFile, intForReading, False)
Set objOutput = objFSO.OpenTextFile(strIPTextFile, intForAppending, False)
While Not objInput.AtEndOfStream
	strcomputer = objInput.ReadLine
	Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
	' Set objWMIService = GetObject("winmgmts:{impersonationlevel=impersonate}!\\" & strComputer & "\root\cimv2")
	' Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
	Set objping = objWMIService.ExecQuery("Select * From Win32_PingStatus Where " & "Address = '" & strComputer & "'")
	for each objstatus in objPing
		If IsNull(objStatus.StatusCode) Or objStatus.Statuscode <> 0 Then
			ResolveIP = strcomputer & " " & "Computer is Unreachable"
		Else
			ResolveIP = strcomputer & " " & objStatus.ProtocolAddress
		End If
	Next
	strUser = ""
	If InStr(ResolveIP, "Computer is Unreachable") = 0 Then
		strResult = TestWMIConnection(strcomputer, 10)
		If strResult = "success" Then
			Set objWMIService = GetObject("winmgmts:{impersonationlevel=impersonate}!\\" & strComputer & "\root\cimv2")
			Set colComputer = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem")
			For Each objComputer in colComputer
				strUser = objComputer.UserName
			Next
			objoutput.WriteLine resolveip & "," & strUser
		ElseIf strResult = "failed" Then
			objoutput.WriteLine resolveip & ",wmi failed"
		Else
			objoutput.WriteLine resolveip & ",wmi time out"
		End If
	Else
		objoutput.WriteLine resolveip & ",unreachable"
	End If
Wend
objInput.Close
objOutput.Close
wscript.echo "Job Completed"

Function TestWMIConnection(strComputer, intTimeOutInSeconds)
	' Function written by Rob Sampson - 12 Jan 2011
	' Experts-Exchange volunteer: http://www.experts-exchange.com/M_3820065.html
	' Return strings from this function are in lower case, and consist of:
	' "success": WMI Connection successful
	' "failed": WMI Connection failed
	' "time out": WMI Connection attempt timed out
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	strTempScript = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempWMITestToBeDeleted.vbs"
	Set objTempFile = objFSO.CreateTextFile(strTempScript, True)
	objTempFile.WriteLine "On Error Resume Next"
	objTempFile.WriteLine "Set objWMIService = GetObject(""winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2"")"
	objTempFile.WriteLine "If Err.Number = 0 Then"
	objTempFile.WriteLine vbTab & "WScript.StdOut.Write ""Success"""
	objTempFile.WriteLine "Else"
	objTempFile.WriteLine vbTab & "WScript.StdOut.Write ""Failed"""
	objTempFile.WriteLine "End If"
	objTempFile.Close
	Set objShell = CreateObject("WScript.Shell")
	Set objExec = objShell.Exec("wscript " & objFSO.GetFile(strTempScript).ShortPath)
	intSeconds = 0
	While objExec.Status = 0 And intSeconds <= intTimeOutInSeconds
		WScript.Sleep 1000
		intSeconds = intSeconds + 1
	Wend
	If objExec.Status = 1 Then
		strReturn = objExec.StdOut.ReadAll
	Else
		On Error Resume Next
		objExec.Terminate
		Err.Clear
		On Error GoTo 0
		strReturn = "Time Out"
	End If
	objFSO.DeleteFile strTempScript, True
	TestWMIConnection = LCase(strReturn)
End Function

Open in new window

0
 
ScottyworldCommented:
Bianchi928
Has the script read a line in the text file that contains a PC that either doesn't exist, or is switched off, or has no-one logged currently logged on?
0
 
Bianchi928Author Commented:
Something is horribly wrong there....Here's an extract of my output file. It can't be that all those with an IP address have a WMI failed

Cheers


6L28HAVJX9U12RU Failed,wmi failed
ACCOUNTS-01 10.25.2.4,wmi failed
ACCOUNTS02 Failed,wmi failed
AKRTRD1 Failed,wmi failed
AR 10.25.2.94,wmi failed
AR-3 Failed,wmi time out
AREC1 10.25.2.69,wmi failed
AREC2 10.25.2.79,wmi failed
AREC3 10.25.2.72,wmi failed
AREC4 10.25.2.33,wmi failed
AREC5 10.25.2.103,wmi failed
0
 
ScottyworldCommented:
are you running the script with an account that has admin rights to the remote PCs ?
e.g. domain admin ?
0
 
RobSampsonCommented:
It works fine for me.....perhaps the WMI time out is too short if you have slow links.  Try increasing the WMI time out interval:
            strResult = TestWMIConnection(strcomputer, 30)

But yeah, make sure you're running as a domain admin.

If it still has issues, and you know a machine is working, and doesn't have WMI problems, run just this against that machine and see what you get.
Set objWMIService = GetObject("winmgmts:{impersonationlevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colComputer = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem")
For Each objComputer in colComputer
    msgbox "Logged-on user: " & objComputer.UserName
Next

Open in new window


Regards,

Rob.
0
 
ScottyworldCommented:
If you're going to run Rob's mini-script above then don't forget to define strComputer at line 1, with the computer you want to specifically test/check

strComputer="ACCOUNTS02"
0
 
Bianchi928Author Commented:
Its definitely an admin rights issue. Where in your last short code can i pass in the domain and password ?
0
 
RobSampsonCommented:
Oh yeah, forgot strComputer...thanks Scotty.....

OK, so to do WMI calls with different credentials, use this.

Regards,

Rob.
strComputer = "remotepc"
strNamespace = "root\cimv2"
strUser = "domain\user"
strPass = "password"

Const WbemAuthenticationLevelPktPrivacy = 6
Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Set objWMIService = objwbemLocator.ConnectServer(strComputer, strNamespace, strUser, strPassword)
objWMIService.Security_.authenticationLevel = WbemAuthenticationLevelPktPrivacy

Set colComputer = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem")
For Each objComputer In colComputer
    MsgBox "Logged-on user: " & objComputer.UserName
Next

Open in new window

0
 
RobSampsonCommented:
To use that in the full script, try this.

Regards,

Rob.
strNamespace = "root\cimv2"
strUser = "domain\user"
strPass = "password"

Dim wmiQuery, objWMIService, objPing, objStatus
Const WbemAuthenticationLevelPktPrivacy = 6
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const intForAppending = 8
strPrinterTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZInputlist.txt"
strIPTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZOutputlist.txt"
Set objInput = objFSO.OpenTextFile(strPrinterTextFile, intForReading, False)
Set objOutput = objFSO.OpenTextFile(strIPTextFile, intForAppending, False)
While Not objInput.AtEndOfStream
	strcomputer = objInput.ReadLine
	Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
	' Set objWMIService = GetObject("winmgmts:{impersonationlevel=impersonate}!\\" & strComputer & "\root\cimv2")
	' Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
	Set objping = objWMIService.ExecQuery("Select * From Win32_PingStatus Where " & "Address = '" & strComputer & "'")
	for each objstatus in objPing
		If IsNull(objStatus.StatusCode) Or objStatus.Statuscode <> 0 Then
			ResolveIP = strcomputer & " " & "Computer is Unreachable"
		Else
			ResolveIP = strcomputer & " " & objStatus.ProtocolAddress
		End If
	Next
	strUser = ""
	If InStr(ResolveIP, "Computer is Unreachable") = 0 Then
		strResult = TestWMIConnection(strcomputer, 10)
		If strResult = "success" Then
			'Set objWMIService = GetObject("winmgmts:{impersonationlevel=impersonate}!\\" & strComputer & "\root\cimv2")
			Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
			Set objWMIService = objwbemLocator.ConnectServer(strComputer, strNamespace, strUser, strPassword)
			objWMIService.Security_.authenticationLevel = WbemAuthenticationLevelPktPrivacy
			Set colComputer = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem")
			For Each objComputer in colComputer
				strUser = objComputer.UserName
			Next
			objoutput.WriteLine resolveip & "," & strUser
		ElseIf strResult = "failed" Then
			objoutput.WriteLine resolveip & ",wmi failed"
		Else
			objoutput.WriteLine resolveip & ",wmi time out"
		End If
	Else
		objoutput.WriteLine resolveip & ",unreachable"
	End If
Wend
objInput.Close
objOutput.Close
wscript.echo "Job Completed"

Function TestWMIConnection(strComputer, intTimeOutInSeconds)
	' Function written by Rob Sampson - 12 Jan 2011
	' Experts-Exchange volunteer: http://www.experts-exchange.com/M_3820065.html
	' Return strings from this function are in lower case, and consist of:
	' "success": WMI Connection successful
	' "failed": WMI Connection failed
	' "time out": WMI Connection attempt timed out
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	strTempScript = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempWMITestToBeDeleted.vbs"
	Set objTempFile = objFSO.CreateTextFile(strTempScript, True)
	objTempFile.WriteLine "On Error Resume Next"
	objTempFile.WriteLine "Const WbemAuthenticationLevelPktPrivacy = 6"
	objTempFile.WriteLine "Set objWbemLocator = CreateObject(""WbemScripting.SWbemLocator"")"
	objTempFile.WriteLine "Set objWMIService = objwbemLocator.ConnectServer(" & strComputer & "," & strNamespace & "," & strUser & "," & strPassword & ")"
	objTempFile.WriteLine "objWMIService.Security_.authenticationLevel = WbemAuthenticationLevelPktPrivacy"
	objTempFile.WriteLine "If Err.Number = 0 Then"
	objTempFile.WriteLine vbTab & "WScript.StdOut.Write ""Success"""
	objTempFile.WriteLine "Else"
	objTempFile.WriteLine vbTab & "WScript.StdOut.Write ""Failed"""
	objTempFile.WriteLine "End If"
	objTempFile.Close
	Set objShell = CreateObject("WScript.Shell")
	Set objExec = objShell.Exec("wscript " & objFSO.GetFile(strTempScript).ShortPath)
	intSeconds = 0
	While objExec.Status = 0 And intSeconds <= intTimeOutInSeconds
		WScript.Sleep 1000
		intSeconds = intSeconds + 1
	Wend
	If objExec.Status = 1 Then
		strReturn = objExec.StdOut.ReadAll
	Else
		On Error Resume Next
		objExec.Terminate
		Err.Clear
		On Error GoTo 0
		strReturn = "Time Out"
	End If
	objFSO.DeleteFile strTempScript, True
	TestWMIConnection = LCase(strReturn)
End Function

Open in new window

0
 
Bianchi928Author Commented:
I'm testing and will get back to you Rob

Cheers
0
 
Bianchi928Author Commented:
Hi Rob,

The time difference didn't allow me to get back to you ASAP...I'm still having problems. I have done some changes and I will like you to check the coding below and also add the domain/user & password in the code.

Thanks
Cheers

Dim wmiQuery, objWMIService, objPing, objStatus
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const intForAppending = 8
strPrinterTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZInputlist.txt"
strIPTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZOutputlist.txt"
Set objInput = objFSO.OpenTextFile(strPrinterTextFile, intForReading, False)
Set objOutput = objFSO.OpenTextFile(strIPTextFile, intForAppending, False)
While Not objInput.AtEndOfStream
   strcomputer = objInput.ReadLine
   Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
   Set objping = objWMIService.ExecQuery("Select * From Win32_PingStatus Where " & "Address = '" & strComputer & "'")
   for each objstatus in objping
       If IsNull(objStatus.StatusCode) Or objStatus.Statuscode <> 0 Then
           ResolveIP = strcomputer & " " & "Failed"
       Else
           Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
           Set colComputer = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem")
           strUser = ""
           For Each objComputer in colComputer
               strUser = objComputer.UserName
           Next
           ResolveIP = strcomputer & " " & objStatus.ProtocolAddress & " " & struser
       End If
       objoutput.WriteLine resolveip
   Next
Wend
objInput.Close
objOutput.Close
wscript.echo "Job Completed"
0
 
RobSampsonCommented:
The code still works for me, and I have changed the output to CSV.  See what this gives you.

Regards,

Rob.
Dim wmiQuery, objWMIService, objPing, objStatus
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const intForAppending = 8
strPrinterTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZInputlist.txt"
strIPTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZOutputlist.csv"
Set objInput = objFSO.OpenTextFile(strPrinterTextFile, intForReading, False)
Set objOutput = objFSO.OpenTextFile(strIPTextFile, intForAppending, True)
While Not objInput.AtEndOfStream
   strcomputer = objInput.ReadLine
   Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
   Set objping = objWMIService.ExecQuery("Select * From Win32_PingStatus Where " & "Address = '" & strComputer & "'")
   For Each objstatus In objping
       If IsNull(objStatus.StatusCode) Or objStatus.Statuscode <> 0 Then
           objOutput.WriteLine strcomputer & ",offline"
       Else
           Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
           Set colComputer = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem")
           strUser = ""
           For Each objComputer in colComputer
               strUser = objComputer.UserName
           Next
           objoutput.WriteLine strcomputer & "," & objStatus.ProtocolAddress & "," & struser
       End If
   Next
Wend
objInput.Close
objOutput.Close
wscript.echo "Job Completed"

Open in new window

0
 
Bianchi928Author Commented:
It comes up with the attached error message. I'm having lots of problems with permissions.
Will you be able hard code the domain/user & password etc in the code. I'm sure it will work then

Somethig like that

strUser = "domain\user"
strPass = "password"

Thanks
Cheers
error1.bmp
0
 
RobSampsonCommented:
Oh sorry, I didn't realise you didn't have the alternate credentials in the latest script you posted.  Try this.

Regards,

Rob.
strUser = "domain\administrator"
strPassword = "password"

Const WbemAuthenticationLevelPktPrivacy = 6
Dim wmiQuery, objWMIService, objPing, objStatus
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const intForAppending = 8
strPrinterTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZInputlist.txt"
strIPTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZOutputlist.csv"
Set objInput = objFSO.OpenTextFile(strPrinterTextFile, intForReading, False)
Set objOutput = objFSO.OpenTextFile(strIPTextFile, intForAppending, True)
While Not objInput.AtEndOfStream
   strcomputer = objInput.ReadLine
   Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
   Set objping = objWMIService.ExecQuery("Select * From Win32_PingStatus Where " & "Address = '" & strComputer & "'")
   For Each objstatus In objPing
       If IsNull(objStatus.StatusCode) Or objStatus.Statuscode <> 0 Then
           objOutput.WriteLine strcomputer & ",offline"
       Else
		   Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
		   Set objWMIService = objwbemLocator.ConnectServer(strComputer, "root\cimv2", strUser, strPassword)
		   objWMIService.Security_.authenticationLevel = WbemAuthenticationLevelPktPrivacy
           Set colComputer = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem")
           strUser = ""
           For Each objComputer in colComputer
               strUser = objComputer.UserName
           Next
           objoutput.WriteLine strcomputer & "," & objStatus.ProtocolAddress & "," & struser
       End If
   Next
Wend
objInput.Close
objOutput.Close
wscript.echo "Job Completed"

Open in new window

0
 
ScottyworldCommented:
Nice one Rob! Works fine for me too now.
Can you just confirm for me.... in your script on 08/03/11 04:10 AM, ID: 35065314
Surely line 28 stops the credentials being passed though? - I assume you had that in there for local testing?
Not criticising, just trying to learn WMI credential passing!
0
 
RobSampsonCommented:
Oh your right!!!  strUser is reassigned for each computer that is checked.  This is fixed by user strUsername as the credentials passed.

Regards,

Rob.
strUsername = "domain\administrator"
strPassword = "password"

Const WbemAuthenticationLevelPktPrivacy = 6
Dim wmiQuery, objWMIService, objPing, objStatus
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const intForAppending = 8
strPrinterTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZInputlist.txt"
strIPTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZOutputlist.csv"
Set objInput = objFSO.OpenTextFile(strPrinterTextFile, intForReading, False)
Set objOutput = objFSO.OpenTextFile(strIPTextFile, intForAppending, True)
While Not objInput.AtEndOfStream
   strcomputer = objInput.ReadLine
   Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
   Set objping = objWMIService.ExecQuery("Select * From Win32_PingStatus Where " & "Address = '" & strComputer & "'")
   For Each objstatus In objPing
       If IsNull(objStatus.StatusCode) Or objStatus.Statuscode <> 0 Then
           objOutput.WriteLine strcomputer & ",offline"
       Else
		   Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
		   Set objWMIService = objwbemLocator.ConnectServer(strComputer, "root\cimv2", strUsername, strPassword)
		   objWMIService.Security_.authenticationLevel = WbemAuthenticationLevelPktPrivacy
           Set colComputer = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem")
           strUser = ""
           For Each objComputer in colComputer
               strUser = objComputer.UserName
           Next
           objoutput.WriteLine strcomputer & "," & objStatus.ProtocolAddress & "," & struser
       End If
   Next
Wend
objInput.Close
objOutput.Close
wscript.echo "Job Completed"

Open in new window

0
 
Bianchi928Author Commented:
Hi Rob !

Error Message attached
error2.bmp
0
 
RobSampsonCommented:
That is a WMI problem.  I'll have to add the WMI check back in....
0
 
Bianchi928Author Commented:
I forgot to mention that while testing on 5 computer in the input file..it failed on the last one and created a csv file for the succesful ones. Maybe you could get the code to carry on for those computer whose RPC server is unavailable. I will be happy with just that
0
 
RobSampsonCommented:
Try this.

Regards,

Rob.
strUsername = "domain\administrator"
strPassword = "password"

Const WbemAuthenticationLevelPktPrivacy = 6
Dim wmiQuery, objWMIService, objPing, objStatus
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const intForAppending = 8
strPrinterTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZInputlist.txt"
strIPTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZOutputlist.csv"
Set objInput = objFSO.OpenTextFile(strPrinterTextFile, intForReading, False)
Set objOutput = objFSO.OpenTextFile(strIPTextFile, intForAppending, True)
While Not objInput.AtEndOfStream
   strcomputer = objInput.ReadLine
   Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
   Set objping = objWMIService.ExecQuery("Select * From Win32_PingStatus Where " & "Address = '" & strComputer & "'")
   For Each objstatus In objPing
       If IsNull(objStatus.StatusCode) Or objStatus.Statuscode <> 0 Then
           objOutput.WriteLine strcomputer & ",offline"
       Else
		   strResult = TestWMIConnection(strcomputer, 30)
		   If strResult = "success" Then
			   Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
			   Set objWMIService = objwbemLocator.ConnectServer(strComputer, "root\cimv2", strUsername, strPassword)
			   objWMIService.Security_.authenticationLevel = WbemAuthenticationLevelPktPrivacy
	           Set colComputer = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem")
	           strUser = ""
	           For Each objComputer in colComputer
	               strUser = objComputer.UserName
	           Next
	           objoutput.WriteLine strcomputer & "," & objStatus.ProtocolAddress & "," & strUser
	       ElseIf strResult = "failed" Then
	           objoutput.WriteLine strcomputer & "," & objStatus.ProtocolAddress & ",wmi error"
	       Else
	           objoutput.WriteLine strcomputer & "," & objStatus.ProtocolAddress & ",wmi time out"
	       End If
       End If
   Next
Wend
objInput.Close
objOutput.Close
wscript.echo "Job Completed"

Function TestWMIConnection(strComputer, intTimeOutInSeconds)
	' Function written by Rob Sampson - 12 Jan 2011
	' Experts-Exchange volunteer: http://www.experts-exchange.com/M_3820065.html
	' Return strings from this function are in lower case, and consist of:
	' "success": WMI Connection successful
	' "failed": WMI Connection failed
	' "time out": WMI Connection attempt timed out
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	strTempScript = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempWMITestToBeDeleted.vbs"
	Set objTempFile = objFSO.CreateTextFile(strTempScript, True)
	objTempFile.WriteLine "On Error Resume Next"
	objTempFile.WriteLine "Const WbemAuthenticationLevelPktPrivacy = 6"
	objTempFile.WriteLine "Set objWbemLocator = CreateObject(""WbemScripting.SWbemLocator"")"
	objTempFile.WriteLine "Set objWMIService = objwbemLocator.ConnectServer(" & strComputer & "," & strNamespace & "," & strUser & "," & strPassword & ")"
	objTempFile.WriteLine "objWMIService.Security_.authenticationLevel = WbemAuthenticationLevelPktPrivacy"
	objTempFile.WriteLine "If Err.Number = 0 Then"
	objTempFile.WriteLine vbTab & "WScript.StdOut.Write ""Success"""
	objTempFile.WriteLine "Else"
	objTempFile.WriteLine vbTab & "WScript.StdOut.Write ""Failed"""
	objTempFile.WriteLine "End If"
	objTempFile.Close
	Set objShell = CreateObject("WScript.Shell")
	Set objExec = objShell.Exec("wscript " & objFSO.GetFile(strTempScript).ShortPath)
	intSeconds = 0
	While objExec.Status = 0 And intSeconds <= intTimeOutInSeconds
		WScript.Sleep 1000
		intSeconds = intSeconds + 1
	Wend
	If objExec.Status = 1 Then
		strReturn = objExec.StdOut.ReadAll
	Else
		On Error Resume Next
		objExec.Terminate
		Err.Clear
		On Error GoTo 0
		strReturn = "Time Out"
	End If
	objFSO.DeleteFile strTempScript, True
	TestWMIConnection = LCase(strReturn)
End Function

Open in new window

0
 
Bianchi928Author Commented:
Okay..Let's see

When I run 35075601, The result is in NZOutput1.csv attached file
When I run 35076521, The result is in NZOutput2.csv attached file
The WMI error doesn't seem right.
If it's going to be time consuming for you, I'm quite happy to go with 35075601. It would be good if you add a code to skip the RPC error and carry on with the next computer from the input file.

Thanks
Cheers

 NZOutput1.csv
NZOutput2.csv
0
 
RobSampsonCommented:
Crap.  Forgot to change one line in the latest code....can you please double check this one? If it still doesn't work, I'll change the error checking.

Rob.
strUsername = "domain\administrator"
strPassword = "password"

Const WbemAuthenticationLevelPktPrivacy = 6
Dim wmiQuery, objWMIService, objPing, objStatus
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const intForAppending = 8
strPrinterTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZInputlist.txt"
strIPTextFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\NZOutputlist.csv"
Set objInput = objFSO.OpenTextFile(strPrinterTextFile, intForReading, False)
Set objOutput = objFSO.OpenTextFile(strIPTextFile, intForAppending, True)
While Not objInput.AtEndOfStream
   strcomputer = objInput.ReadLine
   Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
   Set objping = objWMIService.ExecQuery("Select * From Win32_PingStatus Where " & "Address = '" & strComputer & "'")
   For Each objstatus In objPing
       If IsNull(objStatus.StatusCode) Or objStatus.Statuscode <> 0 Then
           objOutput.WriteLine strcomputer & ",offline"
       Else
		   strResult = TestWMIConnection(strcomputer, 30)
		   If strResult = "success" Then
			   Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
			   Set objWMIService = objwbemLocator.ConnectServer(strComputer, "root\cimv2", strUsername, strPassword)
			   objWMIService.Security_.authenticationLevel = WbemAuthenticationLevelPktPrivacy
	           Set colComputer = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem")
	           strUser = ""
	           For Each objComputer in colComputer
	               strUser = objComputer.UserName
	           Next
	           objoutput.WriteLine strcomputer & "," & objStatus.ProtocolAddress & "," & strUser
	       ElseIf strResult = "failed" Then
	           objoutput.WriteLine strcomputer & "," & objStatus.ProtocolAddress & ",wmi error"
	       Else
	           objoutput.WriteLine strcomputer & "," & objStatus.ProtocolAddress & ",wmi time out"
	       End If
       End If
   Next
Wend
objInput.Close
objOutput.Close
wscript.echo "Job Completed"

Function TestWMIConnection(strComputer, intTimeOutInSeconds)
	' Function written by Rob Sampson - 12 Jan 2011
	' Experts-Exchange volunteer: http://www.experts-exchange.com/M_3820065.html
	' Return strings from this function are in lower case, and consist of:
	' "success": WMI Connection successful
	' "failed": WMI Connection failed
	' "time out": WMI Connection attempt timed out
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	strTempScript = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempWMITestToBeDeleted.vbs"
	Set objTempFile = objFSO.CreateTextFile(strTempScript, True)
	objTempFile.WriteLine "On Error Resume Next"
	objTempFile.WriteLine "Const WbemAuthenticationLevelPktPrivacy = 6"
	objTempFile.WriteLine "Set objWbemLocator = CreateObject(""WbemScripting.SWbemLocator"")"
	objTempFile.WriteLine "Set objWMIService = objwbemLocator.ConnectServer(" & strComputer & "," & strNamespace & "," & strUserName & "," & strPassword & ")"
	objTempFile.WriteLine "objWMIService.Security_.authenticationLevel = WbemAuthenticationLevelPktPrivacy"
	objTempFile.WriteLine "If Err.Number = 0 Then"
	objTempFile.WriteLine vbTab & "WScript.StdOut.Write ""Success"""
	objTempFile.WriteLine "Else"
	objTempFile.WriteLine vbTab & "WScript.StdOut.Write ""Failed"""
	objTempFile.WriteLine "End If"
	objTempFile.Close
	Set objShell = CreateObject("WScript.Shell")
	Set objExec = objShell.Exec("wscript " & objFSO.GetFile(strTempScript).ShortPath)
	intSeconds = 0
	While objExec.Status = 0 And intSeconds <= intTimeOutInSeconds
		WScript.Sleep 1000
		intSeconds = intSeconds + 1
	Wend
	If objExec.Status = 1 Then
		strReturn = objExec.StdOut.ReadAll
	Else
		On Error Resume Next
		objExec.Terminate
		Err.Clear
		On Error GoTo 0
		strReturn = "Time Out"
	End If
	objFSO.DeleteFile strTempScript, True
	TestWMIConnection = LCase(strReturn)
End Function

Open in new window

0
 
Bianchi928Author Commented:
It's still showing these WMI error when it shouldn't. Let go with 35075601, just add the error ckecking code for RPC failure.

Thanks
Cheers
0
 
Bianchi928Author Commented:
Thanks so much for your help. All Good !!

Cheers
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.