Option Explicit
Dim Salir As Boolean
Dim ContadorIP As Integer
Private Sub Btn_Agregar_Click()
    ' Si la IP es valida se añade a la lista
    If ValidarIP(Text1.Text) Then Lst_IP.AddItem Text1.Text
    Text1.Text = ""
    Btn_Agregar.Enabled = False
End Sub
Private Sub Btn_Eliminar_Click()
    ' Se elimina la IP seleccionada en la lista
    Lst_IP.RemoveItem Lst_IP.ListIndex
    Btn_Eliminar.Enabled = False
End Sub
Private Sub Form_Load()
    ' se muestra el formulario
    Me.Show
    
    Do
        ' Si hay alguna IP se realiza el Ping
        If Lst_IP.ListCount > 0 Then
            ComprobarPing ContadorIP, Lst_IP.List(ContadorIP)
            ContadorIP = ContadorIP + 1
            If ContadorIP > Lst_IP.ListCount - 1 Then
                ' Cuando se ha dado toda la vuelta a las direcciones se espera un momento
                ' y se continua
                ContadorIP = 0
                EsperaTicks 600
                Picture1.Cls
            End If
        Else
            DoEvents
        End If
    Loop Until Salir
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Salir = True
    DoEvents
    End
End Sub
Private Sub Lst_IP_Click()
    Btn_Eliminar.Enabled = True
End Sub
Private Sub Text1_Change()
    Btn_Agregar.Enabled = True
End Sub
Function ValidarIP(ByVal IPaValidar As String) As Boolean
    On Error GoTo Error_ValidarIP
    Dim ByteIP As String, FinValidar As Boolean, cIP As Integer, cIPBis As Integer
    
    If Not IsNumeric(IPaValidar) Then Exit Function
    ValidarIP = True
    cIP = 1
    FinValidar = False
    Do
        cIPBis = InStr(cIP, IPaValidar, ".")
        If cIPBis = 0 Then
            cIPBis = Len(IPaValidar) + 1
            FinValidar = True
        End If
        
        ' Le restamos la posición inicial para obtener el número
        ByteIP = Mid(IPaValidar, cIP, cIPBis - cIP)
        If ByteIP < 0 Or ByteIP > 256 Then ValidarIP = False
        cIP = cIPBis + 1
    Loop Until FinValidar
Exit Function
Error_ValidarIP:
    ValidarIP = False
End Function
Sub ComprobarPing(Indice As Integer, Direccion As String)
    Dim EnvioICMP As ICMP_ECHO_REPLY, Estado As String
    
    Ping Direccion, "Ping", EnvioICMP
    If IP_SUCCESS = EnvioICMP.status Then
        ' Si ha sido correcto
        Picture1.ForeColor = &H0
    Else
        ' Si ha fallado
        Picture1.ForeColor = &HFF
    End If
    ' Se muestra en la lista
    Picture1.Print Direccion & vbTab & EnvioICMP.RoundTripTime & " ms" & vbTab & _
           DescripcionCodigoRespuesta(EnvioICMP.status)
End Sub
Sub EsperaTicks(ByVal TicksEsperando As Long)
    ' Hace una pausa de N ticks (milisegundos)
    Dim TicksIniciales As Long
    TicksIniciales = GetTickCount
    Do While TicksIniciales + TicksEsperando > GetTickCount And Not Salir
        DoEvents
    Loop
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
    ' Cuando pulsa enter se añade automáticamente
    If KeyAscii = 13 Then Btn_Agregar_Click
End Sub