asked on

How to stop teh dos black screen

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"

RobSampson

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

Bianchi928

ASKER

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

Bianchi928

ASKER

Forgot the output. I had to rename both files to txt
output.txt

RobSampson

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

Bianchi928

ASKER

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

RobSampson

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...

Bianchi928

ASKER

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

Bianchi928

ASKER

TempPing.txt

RobSampson

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

Bianchi928

ASKER

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.

Bianchi928

ASKER

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 ?

Bianchi928

ASKER

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

RobSampson

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

RobSampson

Remove these lines
strInputPath = "computers.txt"
strOutputPath = "results.txt"

they were my test lines.

Rob.

Bianchi928

ASKER

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

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

That's perfect...I will continue to look into this ping issue
Thanks mate
Cheers

Bianchi928

ASKER

You deserve more points for that
Cheers

RobSampson

No problem .Thanks for the grade.

Rob.