Ping sur un intervalle d'adresse ip

Télécharger le projet
Commenter

Description

Ce petit utilitaire conçue pour les besoins de mon travail fait partie d'une plus grande application. Il teste les connections reseaux pour un interval de 2 adresses IP, et presantant les resultats dans une liste avec la reponse du ping (Timeout, Succes en X ms) et le nom de l'hote en cas de succes.

Vous reconnettrez certain code copier sur ce site, et que je remercie leur auteurs.

Source / Exemple : 


Public r As Integer
Public g As String
Public R1 As Integer
Public suc As Integer

Private Sub Command1_Click()
Dim T, d As String
Dim x As Integer
Dim A1, A2, A3 As Long

test = " Debut du Ping sur l'interval [" & d & " - " & T & "]."
x = 1
suc = 0
Call Ini_Pbar  ' Initialisez la valeur max de la bar de progression (incomplet)
Call Ini_Liste ' ReInitialisez la MsFlexGrid en cas de reexecution
If test_ip Then
i = Text1
j = Text2
k = Text3
l = Text4
T = Text5 & "." & Text6 & "." & Text7 & "." & Text8
d = i & "." & j & "." & k & "." & l
test = "Debut du Ping sur l'interval [" & d & " - " & T & "]."
refor:
                
                d = i & "." & j & "." & k & "." & l
                test = " Pinging " & d
                Me.Refresh
                list2.TextMatrix(x, 0) = d
                DoEvents
                If r = 1 Then GoTo termine
                test = " Attente de la reponse de " & d
                Me.Refresh
                list2.TextMatrix(x, 2) = EasyPing(d)
                DoEvents
                If list2.TextMatrix(x, 2) <> "Timeout" Then suc = suc + 1
                If r = 1 Then GoTo termine
                If d = T Then GoTo termine1
                If l = 255 Then
                l = 0
                k = k + 1
                Else
                l = l + 1
                End If
                If k = 256 Then
                k = 0
                j = j + 1
                End If
                If j = 256 Then
                j = 0
                i = i + 1
                End If
                list2.AddItem ""
                x = x + 1
                DoEvents
                If r = 1 Then GoTo termine
                
GoTo refor
R1 = x - 1
termine1:
    Call Getnom ' retrouver les noms de hote
termine:
test = " Fin Du Traitement " & g
R1 = x - 1
End If
End Sub

Private Sub Command2_Click()
'Enregistrement du resultat dans un fichier
Load enrg
End Sub

Private Sub Command3_Click()
' Buton STOP
r = 1
g = " : traitement stopper par l'utilisateur"
End Sub

Private Sub Form_Load()
'Initialisation du socket + paramettres + redimentionnement
r = 0
g = ""
R1 = 1
fic = 1
If SocketsInitialize() Then
Else
' GROS probleme système!
   MsgBox "Windows Sockets for 32 bit Windows ne répond pas.", vbCritical
End If
list2.Width = 8700
list2.ColWidth(0) = 2000
list2.ColWidth(1) = 4500
list2.ColWidth(2) = 1800
list2.TextMatrix(0, 0) = "Adresse IP"
list2.TextMatrix(0, 1) = "Nom de l'HOTE"
list2.TextMatrix(0, 2) = "Reponse"
Command3.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
r = 1
fic = 0
Unload Me
End Sub

Public Function test_ip() As Boolean
'Traitement des erreurs de saisie au niveaux des adresses IP
'Renvoi True ou False
test_ip = False
If Text1 > Text5 Then
test = " Verifier les adesses : erreur T1 et T5 "
Exit Function
End If
If Text8 < Text4 And (Text7 < Text3 Or Text7 = Text3) Then
test = " Verifier les adresses : erreur T3 et T7 "
Exit Function
End If
If Text7 < Text3 And (Text6 < Text2 Or Text6 = Text2) Then
test = " Verifier les adresses : erreur T2 et T6 "
Exit Function
End If
If Text6 < txet2 And (Text5 < Text1 Or Text5 = Text1) Then
test = " Verifier les adresses : erreur T1 et T5 "
Exit Function
End If
If Text1 > 255 Then
test = "Verifier les adesses : erreur T1"
Exit Function
End If
If Text2 > 255 Then
test = "Verifier les adesses : erreur T2"
Exit Function
End If
If Text3 > 255 Then
test = "Verifier les adesses : erreur T3"
Exit Function
End If
If Text4 > 255 Then
test = "Verifier les adesses : erreur T4"
Exit Function
End If
If Text5 > 255 Then
test = "Verifier les adesses : erreur T5"
Exit Function
End If
If Text6 > 255 Then
test = "Verifier les adesses : erreur T6"
Exit Function
End If
If Text7 > 255 Then
test = "Verifier les adesses : erreur T7"
Exit Function
End If
If Text8 > 255 Then
test = "Verifier les adesses : erreur T8"
Exit Function
End If
Command3.Enabled = True
test_ip = True
End Function

Public Sub Ini_Liste()
' ReInitialisez la MsFlexGrid en cas de reexecution
If R1 > 1 Then
For O = R1 To 1 Step -1
list2.RemoveItem (O)
Next
End If
list2.TextMatrix(1, 0) = ""
list2.TextMatrix(1, 1) = ""
list2.TextMatrix(1, 2) = ""
Command3.Enabled = True
End Sub

Public Sub Getnom()
' retrouver les noms de hote

For F = 1 To R1 + 1
If list2.TextMatrix(F, 2) <> "Timeout" Then
test = " Resolution du nom de l'hote pour l'IP " & list2.TextMatrix(F, 0)
Me.Refresh

list2.TextMatrix(F, 1) = fGetHostName(list2.TextMatrix(F, 0))
DoEvents
If r = 1 Then Exit For
End If
Next
End Sub

Public Sub Ini_Pbar()
' Initialisez la valeur max de la bar de progression

End Sub

Conclusion :


2 adresses IP sans les points dans 4 case pour chaqu'une (8 cases a remplir).

Merci de me soumettre vos suggestions.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (raef1234)