Solved

Remote username

Posted on 2011-03-07
33
552 Views
Last Modified: 2012-05-11
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"
0
Comment
Question by:Bianchi928
  • 13
  • 13
  • 7
33 Comments
 
LVL 9

Expert Comment

by:Scottyworld
ID: 35063857
The following will display the username

Dim objNetwork
Set objNetwork = CreateObject("WScript.Network")
MsgBox objNetwork.UserName
0
 
LVL 9

Expert Comment

by:Scottyworld
ID: 35063979
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
 

Author Comment

by:Bianchi928
ID: 35064021

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
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 65

Expert Comment

by:RobSampson
ID: 35064076
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
 

Author Comment

by:Bianchi928
ID: 35064118
I tried the above script and it's giving me MY username instead of the remote username.

Cheers
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35064193
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
 

Author Comment

by:Bianchi928
ID: 35064373
Now, I'm getting an error message on line 23

error.bmp
0
 
LVL 9

Expert Comment

by:Scottyworld
ID: 35064396
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 35064473
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
 
LVL 9

Expert Comment

by:Scottyworld
ID: 35064494
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
 

Author Comment

by:Bianchi928
ID: 35064719
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
 
LVL 9

Expert Comment

by:Scottyworld
ID: 35064733
are you running the script with an account that has admin rights to the remote PCs ?
e.g. domain admin ?
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35064913
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
 
LVL 9

Expert Comment

by:Scottyworld
ID: 35064957
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
 

Author Comment

by:Bianchi928
ID: 35065053
Its definitely an admin rights issue. Where in your last short code can i pass in the domain and password ?
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35065293
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 35065314
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
 

Author Comment

by:Bianchi928
ID: 35066974
I'm testing and will get back to you Rob

Cheers
0
 

Author Comment

by:Bianchi928
ID: 35074074
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 35075279
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
 

Author Comment

by:Bianchi928
ID: 35075380
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 35075442
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
 
LVL 9

Expert Comment

by:Scottyworld
ID: 35075506
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 35075601
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
 

Author Comment

by:Bianchi928
ID: 35076411
Hi Rob !

Error Message attached
error2.bmp
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35076491
That is a WMI problem.  I'll have to add the WMI check back in....
0
 

Author Comment

by:Bianchi928
ID: 35076518
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 35076521
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
 

Author Comment

by:Bianchi928
ID: 35076836
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 35077255
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
 

Author Comment

by:Bianchi928
ID: 35077476
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
 
LVL 65

Accepted Solution

by:
RobSampson earned 250 total points
ID: 35078298
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
 

Author Closing Comment

by:Bianchi928
ID: 35078791
Thanks so much for your help. All Good !!

Cheers
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Well hello again!  Glad to see you've made it this far without giving up.  In this, the fourth installment of my popular series, I'm going to cover functions and subroutines, what they are, and why they are useful.  Just in case you stumbled onto th…
With User Account Control (UAC) enabled in Windows 7, one needs to open an elevated Command Prompt in order to run scripts under administrative privileges. Although the elevated Command Prompt accomplishes the task, the question How to run as script…
This video shows how to quickly and easily add an email signature for all users on Exchange 2016. The resulting signature is applied on a server level by Exchange Online. The email signature template has been downloaded from: www.mail-signatures…
Email security requires an ever evolving service that stays up to date with counter-evolving threats. The Email Laundry perform Research and Development to ensure their email security service evolves faster than cyber criminals. We apply our Threat…

820 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