asked on

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"

Scottyworld

The following will display the username

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

Scottyworld

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

Bianchi928

ASKER

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

RobSampson

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

Bianchi928

ASKER

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

Cheers

RobSampson

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

Bianchi928

ASKER

Now, I'm getting an error message on line 23

error.bmp

Scottyworld

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!

RobSampson

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

Scottyworld

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?

Bianchi928

ASKER

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

Scottyworld

are you running the script with an account that has admin rights to the remote PCs ?
e.g. domain admin ?

RobSampson

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.

Scottyworld

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"

Bianchi928

ASKER

Its definitely an admin rights issue. Where in your last short code can i pass in the domain and password ?

RobSampson

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

RobSampson

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

Bianchi928

ASKER

I'm testing and will get back to you Rob

Cheers

Bianchi928

ASKER

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"

RobSampson

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

Bianchi928

ASKER

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

RobSampson

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

Scottyworld

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!

RobSampson

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

Bianchi928

ASKER

Hi Rob !

Error Message attached
error2.bmp

RobSampson

That is a WMI problem. I'll have to add the WMI check back in....

Bianchi928

ASKER

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

RobSampson

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

Bianchi928

ASKER

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

RobSampson

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

Bianchi928

ASKER

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

ASKER CERTIFIED SOLUTION

RobSampson

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Bianchi928

ASKER

Thanks so much for your help. All Good !!

Cheers