[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

How to stop teh dos black screen

Posted on 2011-10-24
19
Medium Priority
?
483 Views
Last Modified: 2012-05-12
I have 2 questions.

1. How do I stop the black screen to display.
2. The script hangs up after a couple of records

dim strInputPath, strOutputPath, strStatus
dim objFSO, objTextIn, objTextOut

strInputPath  = "d:\input.dat"
strOutputPath = "d:\output.dat"

Set WshShell = WScript.CreateObject("WScript.Shell")
set objFSO = CreateObject("Scripting.FileSystemObject")
set objTextIn  = objFSO.OpenTextFile(strInputPath,1)
set objTextout = objFSO.CreateTextFile(strOutputPath,1)

objTextOut.WriteLine("Computer  Ip address")

Do until objTextIn.AtEndOfStream = True
    strcomputer = objTextIn.Readline
    on error resume next
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    If err.Number = 0 then
       Set WshExec = WshShell.Exec("ping -n 1 -w 1000 " & strcomputer)
       strPingResults = LCase(WshExec.StdOut.ReadAll)
       If InStr(strPingResults, "reply from") Then
          Start = InStr(strPingResults, "statistics")
          objTextOut.writeline strcomputer & "   " & mid(strPingResults, start + 15 , 14)  
       Else
          objTextOut.writeline strcomputer & "   " & "Ping Failed"
       End If
    End If
Loop
objtextin.close
objtextout.close
wscript.echo "Job Done"
0
Comment
Question by:Bianchi928
  • 11
  • 8
19 Comments
 
LVL 65

Expert Comment

by:RobSampson
ID: 37022143
Hi, the answer to both questions is to use another method for the ping results.  When you use the Exec method, you don't have any control over the window, so you see the DOS box.  If you use the Run method, you can hide the window, but we need to redirect the Ping output to a text file, and read the results from that file.

Regards,

Rob.
dim strInputPath, strOutputPath, strStatus
dim objFSO, objTextIn, objTextOut

strInputPath  = "d:\input.dat" 
strOutputPath = "d:\output.dat"

Set WshShell = WScript.CreateObject("WScript.Shell")
set objFSO = CreateObject("Scripting.FileSystemObject")
set objTextIn  = objFSO.OpenTextFile(strInputPath,1)
set objTextout = objFSO.CreateTextFile(strOutputPath,1)

objTextOut.WriteLine("Computer  Ip address")

Do until objTextIn.AtEndOfStream = True
	strcomputer = objTextIn.Readline
	strTempFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempPing.txt"
	wshShell.Run "cmd /c ping -n 1 -w 1000 " & strcomputer & " > """ & strTempFile & """", 0, True
	Set objFile = objFSO.OpenTextFile(strTempFile, 1, False)
	strPingResults = LCase(objFile.ReadAll)
	objFile.Close
	objFSO.DeleteFile strTempFile, True
	If InStr(strPingResults, "reply from") Then
		Start = InStr(strPingResults, "statistics")
		objTextOut.writeline strcomputer & "   " & mid(strPingResults, start + 15 , 14)  
	Else
		objTextOut.writeline strcomputer & "   " & "Ping Failed"
	End If
Loop
objtextin.close
objtextout.close
wscript.echo "Job Done"

Open in new window

0
 

Author Comment

by:Bianchi928
ID: 37022281
I see your point. Now, I've attached the input file and output file and the script hangs after 10 records or so. Doesn't matter which I sort teh input, it's always after 10 or so
input.txt
0
 

Author Comment

by:Bianchi928
ID: 37022284
Forgot the output. I had to rename both files to txt
output.txt
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 65

Expert Comment

by:RobSampson
ID: 37022302
OK, try this.  We'll make sure it's not trying to ping a blank line.

Rob.
dim strInputPath, strOutputPath, strStatus
dim objFSO, objTextIn, objTextOut

strInputPath  = "d:\input.dat" 
strOutputPath = "d:\output.dat"

Set WshShell = WScript.CreateObject("WScript.Shell")
set objFSO = CreateObject("Scripting.FileSystemObject")
set objTextIn  = objFSO.OpenTextFile(strInputPath,1)
set objTextout = objFSO.CreateTextFile(strOutputPath,1)

objTextOut.WriteLine("Computer  Ip address")

While Not objTextIn.AtEndOfStream
	strcomputer = Trim(objTextIn.Readline)
	If strComputer <> "" Then
		strTempFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempPing.txt"
		wshShell.Run "cmd /c ping -n 1 -w 1000 " & strcomputer & " > """ & strTempFile & """", 0, True
		Set objFile = objFSO.OpenTextFile(strTempFile, 1, False)
		strPingResults = LCase(objFile.ReadAll)
		objFile.Close
		objFSO.DeleteFile strTempFile, True
		If InStr(strPingResults, "reply from") Then
			Start = InStr(strPingResults, "statistics")
			objTextOut.writeline strcomputer & "   " & mid(strPingResults, start + 15 , 14)  
		Else
			objTextOut.writeline strcomputer & "   " & "Ping Failed"
		End If
	End If
Wend
objtextin.close
objtextout.close
wscript.echo "Job Done"

Open in new window

0
 

Author Comment

by:Bianchi928
ID: 37022340
No luck, it stopped at the same record again. The output is showing "Ping failed" for all records. That's not right because I can successfully ping a couple...

I also attached the tempfile for you...
TempPing.txt
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 37022349
If you change
            If InStr(strPingResults, "reply from") Then

to
            If InStr(strPingResults, "reply from") > 0 Then


does that help?  It's odd that the temp file shows the reply results, but it reports ping failed...
0
 

Author Comment

by:Bianchi928
ID: 37022391
Okay I've done this change

I've attached all 3 files that I'm using for testing
Input, output and tempping. Have a look at all three and you'll see a few funny things in the output file.
The last record in teh input is read and written to the tempping and that's where it stops.

 input.txt
output.txt
0
 

Author Comment

by:Bianchi928
ID: 37022395
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 37022425
If all you want is the IP Address, see if this helps.

Does it make any difference if you put that last machine at the top?

Rob.
dim strInputPath, strOutputPath, strStatus
dim objFSO, objTextIn, objTextOut

strInputPath  = "d:\input.dat"
strOutputPath = "d:\output.dat"

Set WshShell = WScript.CreateObject("WScript.Shell")
set objFSO = CreateObject("Scripting.FileSystemObject")
set objTextIn  = objFSO.OpenTextFile(strInputPath,1)
set objTextout = objFSO.CreateTextFile(strOutputPath,1)

objTextOut.WriteLine("Computer  Ip address")

While Not objTextIn.AtEndOfStream
	strcomputer = Trim(objTextIn.Readline)
	If strComputer <> "" Then
		strResult = ResolveIP(strComputer)
		If strResult <> "IP Address could not be resolved" Then
			objTextOut.writeline strcomputer & "   " & strResult
		Else
			objTextOut.writeline strcomputer & "   " & "Ping Failed"
		End If
	End If
Wend
objtextin.close
objtextout.close
wscript.echo "Job Done"

Function ResolveIP(computerName)
	Set objShell = CreateObject("WScript.Shell")
	strTempFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempPing.txt"
	objShell.Run "cmd /c ping -n 1 -w 1000 " & computerName & " > """ & strTempFile & """", 0, True
	Set objFile = objFSO.OpenTextFile(strTempFile, 1, False)
	strOutput = LCase(objFile.ReadAll)
	objFile.Close
	objFSO.DeleteFile strTempFile, True
	Set RegEx = New RegExp
	RegEx.Pattern = "\[(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\]"
	RegEx.Global = True
	If RegEx.Test(strOutput) Then
		ResolveIP = RegEx.Execute(strOutput)(0).Submatches(0)
	Else
		ResolveIP = "IP Address could not be resolved"
	End If
End Function

Open in new window

0
 

Author Comment

by:Bianchi928
ID: 37027468
Hey Rob !!

I've used the new script you sent and it's the same issue..this time it stopped on the first record and wen I look in the Task Manager I can see the wscript still running & cmd.exe and the ping.exe.
0
 

Author Comment

by:Bianchi928
ID: 37027534
Okay.. I have more feedback..as soon as I pskill ping.exe the script jumps to the next record. I ran a few more test and it seems that the wscript goes to sleep on any given record and as soon as I pskill ping.exe it jumps to next one and might go to sleep again until I pskill ping.ex eagain..

Does that make sense to you ?
0
 

Author Comment

by:Bianchi928
ID: 37027670
I guees if you help me how to kill the ping,exe without the black screen popping, it will solve my problem. All the script coding you gave me is just fine
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 37027980
I don't know why the shelling out to Ping would hang....that's very strange!

Killing it though isn't going to guarantee that you get the correct results either.  The information you are after....is it only the IP address?  We could try WMI to get that information....

See how this goes.

Regards,

Rob.
dim strInputPath, strOutputPath, strStatus
dim objFSO, objTextIn, objTextOut

strInputPath  = "d:\input.dat"
strOutputPath = "d:\output.dat"

strInputPath  = "computers.txt"
strOutputPath = "results.txt"

Set WshShell = WScript.CreateObject("WScript.Shell")
set objFSO = CreateObject("Scripting.FileSystemObject")
set objTextIn  = objFSO.OpenTextFile(strInputPath,1)
set objTextout = objFSO.CreateTextFile(strOutputPath,1)

objTextOut.WriteLine("Computer  Ip address")

While Not objTextIn.AtEndOfStream
	strcomputer = Trim(objTextIn.Readline)
	If strComputer <> "" Then
		If Ping(strcomputer) = True Then
			objTextOut.writeline strcomputer & "   " & GetIPAddress(strcomputer)
		Else
			objTextOut.writeline strcomputer & "   " & "Ping Failed"
		End If
	End If
Wend
objtextin.close
objtextout.close
wscript.echo "Job Done"

Function Ping(strComputer)
	strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & strComputer & "'"
    Set colPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery(strQuery)
	For Each objPingResult In colPingResults
		If Not IsObject(objPingResult) Then
			Ping = False
		ElseIf objPingResult.StatusCode = 0 Then
			Ping = True
		Else
			Ping = False
		End If
	Next
    Set colPingResults = Nothing
End Function

Function GetIPAddress(strComputer)
	Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
	Set colComputerIP = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration")
	strIPAddress = ""
	For Each IPConfig In colComputerIP
		If Not IsNull(IPConfig.IPAddress) Then 
			For intIPCount = LBound(IPConfig.IPAddress) To UBound(IPConfig.IPAddress)
				If IPConfig.IPAddress(intIPCount) <> "0.0.0.0" Then
					If strIPAddres = "" Then
						strIPAddress = IPConfig.IPAddress(intIPCount)
					Else
						strIPAddress = strIPAddress & "," & IPConfig.IPAddress(intIPCount)
					End If
				End If
			Next
		End If
	Next
	GetIPAddress = strIPAddress
End Function

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 37027986
Remove these lines
strInputPath  = "computers.txt"
strOutputPath = "results.txt"

they were my test lines.

Rob.
0
 

Author Comment

by:Bianchi928
ID: 37028060
Yes I use taht script inly to get the IP address. By killing the ping.exe it just work fine...So if it could be included in the loop, it should be alright.

I tested your new script and I get " The remote server machine does not exist or is unavailable :' Get Object
Line 44
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 37028201
OK, so a machine must have WMI issues.  Try this.

The thing about killing the ping process is that the Run command tries to wait for it to finish, so you can't run any other commands.  If you do want something to run sychronously to kill it after x seconds, you need to go back to the Exec method, which shows the black screen......

Rob.
dim strInputPath, strOutputPath, strStatus
dim objFSO, objTextIn, objTextOut

strInputPath  = "d:\input.dat"
strOutputPath = "d:\output.dat"

strInputPath  = "computers.txt"
strOutputPath = "results.txt"

Set WshShell = WScript.CreateObject("WScript.Shell")
set objFSO = CreateObject("Scripting.FileSystemObject")
set objTextIn  = objFSO.OpenTextFile(strInputPath,1)
set objTextout = objFSO.CreateTextFile(strOutputPath,1)

objTextOut.WriteLine("Computer  Ip address")

While Not objTextIn.AtEndOfStream
	strcomputer = Trim(objTextIn.Readline)
	If strComputer <> "" Then
		If Ping(strcomputer) = True Then
			objTextOut.writeline strcomputer & "   " & GetIPAddress(strcomputer)
		Else
			objTextOut.writeline strcomputer & "   " & "Ping Failed"
		End If
	End If
Wend
objtextin.close
objtextout.close
wscript.echo "Job Done"

Function Ping(strComputer)
	strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & strComputer & "'"
    Set colPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery(strQuery)
	For Each objPingResult In colPingResults
		If Not IsObject(objPingResult) Then
			Ping = False
		ElseIf objPingResult.StatusCode = 0 Then
			Ping = True
		Else
			Ping = False
		End If
	Next
    Set colPingResults = Nothing
End Function

Function GetIPAddress(strComputer)
	On Error Resume Next
	Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	Set colComputerIP = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration")
	If Err.Number = 0 Then
		strIPAddress = ""
		For Each IPConfig In colComputerIP
			If Not IsNull(IPConfig.IPAddress) Then 
				For intIPCount = LBound(IPConfig.IPAddress) To UBound(IPConfig.IPAddress)
					If IPConfig.IPAddress(intIPCount) <> "0.0.0.0" Then
						If strIPAddres = "" Then
							strIPAddress = IPConfig.IPAddress(intIPCount)
						Else
							strIPAddress = strIPAddress & "," & IPConfig.IPAddress(intIPCount)
						End If
					End If
				Next
			End If
		Next
	Else
		strIPAddress = "WMI Error " & Err.Number & ": " & Err.Description
	End If
	Err.Clear
	On Error GoTo 0
	GetIPAddress = strIPAddress
End Function

Open in new window

0
 

Author Comment

by:Bianchi928
ID: 37028239
That's perfect...I will continue to look into this ping issue
Thanks mate
Cheers

0
 

Author Closing Comment

by:Bianchi928
ID: 37028245
You deserve more points for that
Cheers
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 37028300
No problem .Thanks for the grade.

Rob.
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

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.

Question has a verified solution.

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

Not long ago I saw a question in the VB Script forum that I thought would not take much time. You can read that question (Question ID  (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28455246.html)28455246) Here (http…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
This Micro Tutorial will teach you how to add a cinematic look to any film or video out there. There are very few simple steps that you will follow to do so. This will be demonstrated using Adobe Premiere Pro CS6.
Whether it be Exchange Server Crash Issues, Dirty Shutdown Errors or Failed to mount error, Stellar Phoenix Mailbox Exchange Recovery has always got your back. With the help of its easy to understand user interface and 3 simple steps recovery proced…
Suggested Courses
Course of the Month19 days, 22 hours left to enroll

872 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