Solved

Ping in VB6

Posted on 2010-08-13
17
703 Views
Last Modified: 2012-05-10
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
Comment
Question by:souldigital
  • 10
  • 6
17 Comments
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 33431607
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
 
LVL 14

Expert Comment

by:VBClassicGuy
ID: 33431933
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
 
LVL 14

Expert Comment

by:VBClassicGuy
ID: 33431942
Opps, "Line Input #1, txt$" should be "Line Input #h%, txt$".
0
 
LVL 14

Expert Comment

by:VBClassicGuy
ID: 33431993

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
 
LVL 14

Expert Comment

by:VBClassicGuy
ID: 33432038

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
 

Author Comment

by:souldigital
ID: 33432205
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
 

Author Comment

by:souldigital
ID: 33432214
Didn't see that last post will just give that a try now.
0
 

Author Comment

by:souldigital
ID: 33432315
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
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
LVL 14

Expert Comment

by:VBClassicGuy
ID: 33432741
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
 

Author Comment

by:souldigital
ID: 33432865
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
 
LVL 14

Expert Comment

by:VBClassicGuy
ID: 33432904
Here is the code plus a compiled program...
IP-Test.ZIP
0
 
LVL 14

Expert Comment

by:VBClassicGuy
ID: 33432948
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
 
LVL 14

Expert Comment

by:VBClassicGuy
ID: 33433230

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
 

Author Comment

by:souldigital
ID: 33433324
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
 
LVL 14

Expert Comment

by:VBClassicGuy
ID: 33433514
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
 
LVL 14

Accepted Solution

by:
VBClassicGuy earned 500 total points
ID: 33433523
Opps, meant to include THIS picture...
 

Image1.jpg
0
 

Author Comment

by:souldigital
ID: 33433674
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

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
JavaScript can be used in a browser to change parts of a webpage dynamically. It begins with the following pattern: If condition W is true, do thing X to target Y after event Z. Below are some tips and tricks to help you get started with JavaScript …
The viewer will learn the basics of jQuery, including how to invoke it on a web page. Reference your jQuery libraries: (CODE) Include your new external js/jQuery file: (CODE) Write your first lines of code to setup your site for jQuery.: (CODE)
The viewer will learn the basics of jQuery including how to code hide show and toggles. Reference your jQuery libraries: (CODE) Include your new external js/jQuery file: (CODE) Write your first lines of code to setup your site for jQuery…

708 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

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now