Need help on the code i have created for Ping tool on vb script.

[prayag2015]

hi Experts,
i am not so good on VB Script. I have created a ping tool in VB Script.
1. pings to Google .com with a greater Count saves the Output file
2. meanwhile opens that file, checks for String "Minimum and Percent"
3. if Found will Display the whole line Containing "Minimum and Percent" both
4. or else close all Files and Again search the same strings.


No output is Displayed in Msgbox . pl help with Code....


here is My code:



-----------------------------------------------------------------'

Option Explicit
Sub fnl()
Dim i
i = Shell("\windows\system32\cmd.exe", vbNormalFocus)
Dim objShell
Set objShell = CreateObject("WScript.Shell")
objShell.AppActivate "C:\Windows\system32\cmd.exe"
Application.Wait (Now + TimeValue("0:00:02"))
objShell.SendKeys "[/COLOR][COLOR=#417394]ping google.com -n 10 > D:\Report\percent.txt{ENTER}"
' Script to copy just certain lines from a text file.
' and place in another text file
' Experts Exchange Rob Sampson
' Version 1.1 - June 23 2009
' -----------------------------------------------------------------
Dim strFileName, strString1, strString2
Dim objFSO, objFile, strLine
Dim objOutputFile
strFileName = "D:\Report\percent.txt"
strString1 = "Packets"
strString2 = "Minimum"
[Set objFSO = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1
Set objFile = objFSO.OpenTextFile(strFileName, ForReading, False)
While Not objFile.AtEndOfStream
strLine = objFile.ReadLine
If InStr(strLine, strString1) > 0 And InStr(strLine, strString2) > 0 Then RunCode
Wend
objFile.Close
End Sub


Sub RunCode()
Dim pkt, rndtrip, myFile, text, textline
Dim Final As Integer
myFile = "D:\Report\percent.txt"
Final = FreeFile()
Open myFile For Input As #Final
Do Until EOF(Final)
Line Input #Final, textline
text = text & textline
Loop
Close #Final
pkt = Trim(Mid(text, InStr(text, "Packets") + 0, (InStrRev(text, "Losst") + 0) - (InStr(text, "Packets") + 1)))
rndtrip = Trim(Mid(text, InStr(text, "Minimum") + 0, (InStrRev(text, "ms") + 0) - (InStr(text, "Minimum") + 1)))
Call MsgBox("Percent : " & pkt & " Round-Trip : " & rndtrip & ".", vbOKOnly)
Dim objShell
Set objShell = CreateObject("WScript.Shell")
objShell.AppActivate "C:\Windows\system32\cmd.exe"
Application.Wait (Now + TimeValue("0:00:02"))
objShell.SendKeys "exit{ENTER}"
End Sub

[Leith Ross]

Hello prayag2015,

I have written 2 macros for you. The first will Pings the host computer "www.google.com" and saves the results to the file "D:\Report\percent.txt"

The second will read the contents of the file and display the statics you want in a message box.

' Written:  November 28, 2015
' Author:   Leith Ross

Sub PingSaveToFile(ByVal Host As String, ByVal FilePath As String)

    Dim Command     As String
    Dim ExePath     As String
        
        FilePath = Chr(34) & FilePath & Chr(34)
        
        ExePath = Environ("ComSpec")
        ExePath = Left(ExePath, InStrRev(ExePath, "\"))
        
        Command = ExePath & "cmd.exe /C " & " ping.exe -n 10 -w 100 " & Host & " > " & FilePath
        
        With CreateObject("WScript.Shell")
            .Run Command, vbHide, True
        End With
                   
End Sub

Sub RunCode()

    Dim Data()      As Byte
    Dim FilePath    As String
    Dim pkt         As String
    Dim rndtrip     As String
    Dim Text        As String
    
        FilePath = "D:\Report\percent.txt"
        
        Call PingSaveToFile("www.google.com", FilePath)
        
        Open FilePath For Binary Access Read As #1
            ReDim Data(LOF(1))
            Get #1, , Data
        Close #1
        
        Text = StrConv(Data, vbUnicode)
        
        pkt = Trim(Mid(Text, InStr(Text, "Packets") + 0, (InStrRev(Text, "Lost") + 0) - (InStr(Text, "Packets") + 1)))
        rndtrip = Trim(Mid(Text, InStr(Text, "Minimum") + 0, (InStrRev(Text, "ms") + 0) - (InStr(Text, "Minimum") + 1)))
        
        Call MsgBox("Percent : " & pkt & " Round-Trip : " & rndtrip & ".", vbOKOnly)
        
End Sub

[prayag2015]

Thanks Leith!!!

the code provided help me alot.


but i am working on this project, which I login in to router . ping to some IP, if i increase the packet size to 4, the O/p will be display result of Percent & roundtrip quicker as compared to packet count-100 which takes time. so need code so that Vb check the file real-time like "screening window" and if wherever it find the Percent & roundtrip on cmd windows it will send logout/exit/some my stuff to cmd and display in the MsgBox as earlier.


i need help on Vb checking the txt file real-time , if not found, close the file and again open for rechecking and so on or like "screening window" ..

pl help .

i will try to fit your code in this one
My original Code.


====================

Private Sub Runcode()

i = Shell("\windows\system32\cmd.exe", vbNormalFocus)

Application.Wait (Now + TimeValue("0:00:02"))
Dim server As Integer
Dim LocalHost As String
Dim SourceIP As String
Dim DestinationIP As String
Dim Number As String
Dim Size As String

Dim myFile As String, text As String, textline As String, pkt As String, rndtrip As String

LocalHost = XXX.XXX.XX      'Server Ip to telnet
SourceIP = XXX.XXX.XX       'Source IP
DestinationIP = XXX.XXX.XX  ' Destination IP
Number = XXX.XXX.XX         'packet number
Size = "1400"               'Packet size

UserName = XXX.XXX.XX       ' my Username
Password = XXX.XXX.XX       ' my password
 
Application.Wait (Now + TimeValue("0:00:02"))
 
SendKeys "telnet " & LocalHost & " 6000 -f D:\Report\PING.txt"
SendKeys "~"

Application.Wait (Now + TimeValue("0:00:02"))
SendKeys " LGI:OP=""" & UserName & """, PWD = """ & Password & """,DN=EMS; "

SendKeys "~"
Application.Wait (Now + TimeValue("0:00:02"))

SendKeys " PING IP: SRN=0, SN=14, SIPADDR=""" & SourceIP & """, DESTIP=""" & DestinationIP & """, CONTPING=NO, TIMES=" & Number & ", PKTSIZE=" & Size & "; "

Application.Wait (Now + TimeValue("0:10:02"))
' for short packet size also i have to wait around 10 mins

SendKeys "LGO:;"
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "~"
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "~"
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "Exit"
SendKeys "~"

myFile = "D:\Report\PING.txt"

Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop

Close #1
 
pkt = Trim(Mid(text, InStr(text, "Percent") + 0, (InStrRev(text, "Lost") + 0) - (InStr(text, "Percent") + 1)))
rndtrip = Trim(Mid(text, InStr(text, "round-trip") + 0, (InStrRev(text, "ms") + 0) - (InStr(text, "round-trip") + 1)))
 
Call MsgBox("Percent : " & pkt & " Round-Trip : " & rndtrip & ".", vbOKOnly)
 
End Sub

[Leith Ross]

Hello prayag2015,

I would really like to help you find a solution. The problem for me is I am not following what you want to do. Your latest macro is now using Telnet which your original macro did not have.

Using SendKeys and Wait statements is neither efficient nor reliable. If you are concerned about execution speed then you are on the wrong path.

As for reading the file in real-time, you would have to check the file at regular intervals to check if the data has changed. There are no events that fire when a text file is changed, created, or deleted. This constant checking would slow your code also.

[prayag2015]

hi,
below is the description of my code
1. I login in to my router using telnet and some Login commands as shown using sendkeys
2. ping to my gateway IP as destination IP
3. if i increase the packet size to 4, the telnet window will be display result of Percent & roundtrip in 4 sec
but if i increased packet count to 100 takes 50 sec
so for every count i have to wait till one minute.
4. vb code will read that txt file, check for Strings "percent & Roundtrip" and displays result inthe msgbox.


so i need code as u said Vb checks for the Strings, if not found , waits for certain interval and again checks
and then finally display in the MsgBox as earlier.

[prayag2015]

hi Leith,
My Project has been completed, VB searches for the string in txt file, if not found it will go in wait period for 7 Seconds. after that again call the Search func, if that string is found it will display the required data in the MsgBox and code ends.

but i need to add code for "Please wait for the Result....." to be running in Foreground, until the entire my VB code is running in background.

=====My Code=============

Sub Sfile()

Dim objFSO
Dim objShell

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")
Const FORREADING = 1
Const FORWRITING = 2
Const FORAPPENDING = 8
Dim sToSearch: sToSearch = "round-trip"
Dim sFileName: sFileName = "D:\Report\PING.txt"
Dim sContent, Found
If Not objFSO.FileExists(sFileName) Then
MsgBox "File Not Found"
WScript.Quit 0
End If
Set TxtFile = objFSO.OpenTextFile(sFileName, FORREADING)
sContent = TxtFile.ReadAll
If InStr(sContent, sToSearch) Then
Found = True
Call messagebox
End If

Set TxtFile = Nothing
If Not Found Then
Call waitnw
End If

End Sub


Sub messagebox()
Dim myFile As String, text As String, textline As String
Dim pkt
Dim rndtrip


myFile = "D:\Report\PING.txt"
Final = FreeFile()


Open myFile For Input As #Final


Do Until EOF(1)
Line Input #Final, textline
text = text & textline
Loop
Close #Final
pkt = Trim(Mid(text, InStr(text, "Percent") + 0, (InStrRev(text, "packet") + 0) - (InStr(text, "Percent") + 1)))
rndtrip = Trim(Mid(text, InStr(text, "round-trip") + 0, (InStrRev(text, "ms") + 0) - (InStr(text, "round-trip") + 1)))
Call MsgBox("Percent : " & pkt & vbCrLf & "Round-Trip : " & rndtrip & ".", vbOKOnly)

End Sub


Sub waitnw()
Dim dteWait
dteWait = DateAdd("s", 10, Now())
Do Until (Now() > dteWait)
Loop
Call Sfile
End Sub