Solved

Remote username

Posted on 2011-03-07
33
522 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
 
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
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 
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

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Suggested Solutions

Over the years I have built up my own little library of code snippets that I refer to when programming or writing a script.  Many of these have come from the web or adaptations from snippets I find on the Web.  Periodically I add to them when I come…
This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

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

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

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now