Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 723
  • Last Modified:

Ping in VB6

Baically I need the code for VB6 so that when you run the program (or click a button) it loads an IP address from a .txt file (only 1 ip address on line 1 of the text file) then continualy pings it and shows the results in maybe a text box or something.

Similar to running

ping 192.168.0.1 -t

in a cmd window.

Ideally it just needs to be the latency that is shown in the text box but if it showed the same as a cmd windows that would still be good.

As simple as possible please guys.
0
souldigital
Asked:
souldigital
  • 10
  • 6
1 Solution
 
GrahamSkanCommented:
That requires a number of API calls, and get quite complex, so here is a link to an earlier answer on this site:

http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_22047666.html
0
 
VBClassicGuyCommented:
Stealing code from the bottom of the link provided by GrahamSkan and modifying it a bit, try this (works for me):
Rem *** Get the IP address ***
h% = FreeFile
Open "YourFileName" For Input As #h%
Line Input #1, txt$
Close #h%
 
Sub Timer1_Timer
   Dim booAns As Boolean
   booAns = PingSilent(txt$)
End Sub
 
Function PingSilent(strComputer As String) As Boolean
 
  Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strComputer & "'")
           
  For Each objStatus In objPing
    If IsNull(objStatus.StatusCode) Or objStatus.StatusCode <> 0 Then
      PingSilent = False   'strComputer is Not reachable
    Else
      PingSilent = True    ' strComputer is Live
      Label1.Caption = CStr(objStatus.ResponseTime)
    End If
  Next
 
End Function
0
 
VBClassicGuyCommented:
Opps, "Line Input #1, txt$" should be "Line Input #h%, txt$".
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
VBClassicGuyCommented:

Or maybe this is better...
 

Rem *** Get the IP address ***
h% = FreeFile
Open "YourFileName" For Input As #h%
Line Input #1, txt$
Close #h%

Sub Timer1_Timer
  Dim booAns As Boolean
  booAns = PingSilent(txt$)
   If booAns Then
      Label1.Caption =  CStr(objStatus.ResponseTime)
   Else
      Label1.Caption =  ""
   Endif
End Sub

Function PingSilent(strComputer As String) As Boolean

  Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strComputer & "'")
           
 For Each objStatus In objPing
   If IsNull(objStatus.StatusCode) Or objStatus.StatusCode <> 0 Then
     PingSilent = False   'strComputer is Not reachable
   Else
     PingSilent = True    ' strComputer is Live
   End If
 Next

End Function  
0
 
VBClassicGuyCommented:

Sheesh, I get so negligent when I'm typing. THIS will work better...

Rem *** Get the IP address ***
h% = FreeFile
Open "YourFileName" For Input As #h%
Line Input #1, txt$
Close #h%

Sub Timer1_Timer
  Dim booAns As Boolean
  booAns = PingSilent(txt$, tim%)
   If booAns Then
      Label1.Caption =  CStr(tim%)
  Else
      Label1.Caption =  ""
   Endif
End Sub

Function PingSilent(strComputer As String, ms as Integer) As Boolean

 Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strComputer & "'")
         
 For Each objStatus In objPing
  If IsNull(objStatus.StatusCode) Or objStatus.StatusCode <> 0 Then
    PingSilent = False   'strComputer is Not reachable
  Else
    PingSilent = True    ' strComputer is Live
      ms = objStatus.ResponseTime
  End If
Next

End Function  
0
 
souldigitalAuthor Commented:
So would it be like this -

Private Sub Command1_Click()

Rem *** Get the IP address ***
h% = FreeFile
Open "C:/Test/ip.txt" For Input As #h%
Line Input #1, txt$
Close #h%

End Sub

Sub Timer1_Timer()
  Dim booAns As Boolean
  booAns = PingSilent(txt$)
   If booAns Then
      Label1.Caption = CStr(objStatus.ResponseTime)
  Else
      Label1.Caption = ""
   End If
End Sub

Function PingSilent(strComputer As String) As Boolean

 Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strComputer & "'")
         
 For Each objStatus In objPing
  If IsNull(objStatus.StatusCode) Or objStatus.StatusCode <> 0 Then
    PingSilent = False   'strComputer is Not reachable
  Else
    PingSilent = True    ' strComputer is Live
  End If
Next

End Function


Outputting to Label1?

Thanks for the quick responce guys.
0
 
souldigitalAuthor Commented:
Didn't see that last post will just give that a try now.
0
 
souldigitalAuthor Commented:
Please can you confirm this is correct -


Private Sub Command1_Click()

Rem *** Get the IP address ***
h% = FreeFile
Open "ip.txt" For Input As #h%
Line Input #1, txt$
Close #h%

End Sub

Sub Timer1_Timer()
  Dim booAns As Boolean
  booAns = PingSilent(txt$, tim%)
   If booAns Then
      Label1.Caption = CStr(tim%)
 Else
      Label1.Caption = ""
   End If
End Sub

Function PingSilent(strComputer As String, ms As Integer) As Boolean

Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strComputer & "'")
         
For Each objStatus In objPing
 If IsNull(objStatus.StatusCode) Or objStatus.StatusCode <> 0 Then
   PingSilent = False   'strComputer is Not reachable
 Else
   PingSilent = True    ' strComputer is Live
      ms = objStatus.ResponseTime
 End If
Next

End Function
0
 
VBClassicGuyCommented:
Looks good to me. And, you can output to a label, textbox, or whatever, just chage the code, such as:
Label1.Caption = CStr(tim%)
becomes...
Text1.Text = Cstr(tim%)
0
 
souldigitalAuthor Commented:
For some reason when I do

Open "C:\Test\ip.txt" For Input As #h%

It can't find the file but if I change it to

Open "C:\Test\ip.cfg" For Input As #h%

Its does not display an error but nothing appears in the Label
0
 
VBClassicGuyCommented:
Here is the code plus a compiled program...
IP-Test.ZIP
0
 
VBClassicGuyCommented:
Oh by the way, the "ip.txt" file needs to reside in the same folder as the compiled program. You can, of course, change the path in the program if need be.
0
 
VBClassicGuyCommented:

For those of you who want to see this...

Dim IPAdr$  'place in Declarations section of Form1 code

Private Sub Command1_Click()
   Timer1.Enabled = Not Timer1.Enabled
End Sub

Sub Timer1_Timer()
   Dim booAns As Boolean
   
   booAns = PingSilent(IPAdr$, tim%)
   If booAns Then
      Text1.Text = CStr(tim%)
   Else
      Text1.Text = "NO REPLY"
   End If
   
End Sub

Function PingSilent(strComputer As String, ms As Integer) As Boolean
   Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strComputer & "'")
         
   For Each objStatus In objPing
      If IsNull(objStatus.StatusCode) Or objStatus.StatusCode <> 0 Then
         PingSilent = False   'strComputer is Not reachable
      Else
         PingSilent = True    ' strComputer is Live
         ms = objStatus.ResponseTime
      End If
   Next
End Function

Private Sub Form_Load()
   Rem *** Get the IP address ***
   h% = FreeFile
   Open "ip.txt" For Input As #h%
   Line Input #1, IPAdr$
   Close #h%
End Sub

Recommendations: if you want to know if the program is polling or not, I would add "If Not Timer1.Enabled Then Text1.Text = "" to the bottom of the Private Sub Command1_Click() routine. That way, if the text box is blank, you'll know the IP address is not being looked for. Also, if the IP address in the ip.txt file changes dynamically, move the code in the Form_Load event to the Command1 routine. Then you can do something like:

Private Sub Command1_Click()
   
   If Not Timer1.Enabled Then
      Rem *** Get the IP address ***
      h% = FreeFile
      Open "ip.txt" For Input As #h%
      Line Input #1, IPAdr$
      Close #h%
      Timer1.Enabled= True
   Else
       Timer1.Enabled= False
      Text1.Text = "" 
   Endif

End Sub  
 

Image1.jpg
0
 
souldigitalAuthor Commented:
That works great thanks, just added it into my program with no problems! Is it possible to have 2 pings running at once? So it opens 2 files on startup then on click can run both?
0
 
VBClassicGuyCommented:
Sure. Here is revised code:

Dim IPAdr$()
Private Sub Command1_Click()
   If Timer1.Enabled = False Then
      Rem *** Get first IP address ***
      h% = FreeFile
      Open "ip1.txt" For Input As #h%
      Line Input #h%, IPAdr$(1)
      Close #h%
      lblIP(0).Caption = IPAdr$(1)
      Rem *** Get second IP address ***
      h% = FreeFile
      Open "ip2.txt" For Input As #h%
      Line Input #h%, IPAdr$(2)
      Close #h%
      lblIP(1).Caption = IPAdr$(2)
      Timer1.Enabled = True
   Else
      Timer1.Enabled = False
      Text1.Text = ""
      Text2.Text = ""
   End If
End Sub
Sub Timer1_Timer()
   Dim booAns As Boolean
   
   booAns = PingSilent(IPAdr$(1), tim%)
   If booAns Then
      Text1.Text = CStr(tim%)
   Else
      Text1.Text = "NO REPLY"
   End If
   
   booAns = PingSilent(IPAdr$(2), tim%)
   If booAns Then
      Text2.Text = CStr(tim%)
   Else
      Text2.Text = "NO REPLY"
   End If
   
End Sub
Function PingSilent(strComputer As String, ms As Integer) As Boolean
   Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strComputer & "'")
         
   For Each objStatus In objPing
      If IsNull(objStatus.StatusCode) Or objStatus.StatusCode <> 0 Then
         PingSilent = False   'strComputer is Not reachable
      Else
         PingSilent = True    ' strComputer is Live
         ms = objStatus.ResponseTime
      End If
   Next
End Function
Private Sub Form_Load()
   ReDim IPAdr$(1 To 2)
End Sub
 

TwoIPs.ZIP
Image1.jpg
0
 
VBClassicGuyCommented:
Opps, meant to include THIS picture...
 

Image1.jpg
0
 
souldigitalAuthor Commented:
Brilliant! Thanks for all you help! I am going to stick another question tonight/tomorrow regarding the retrieveal of a response when using a telnet command.

i.e -
Connect to a router (Working ok)
Login with password (Working ok)
Issue a command (Working ok)
Retrieve the routers responce to the above command alone (Needs Doing)
Logs Off (Working ok)
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 10
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now