Accueil > > > PING SUR UN INTERVALLE D'ADRESSE IP
PING SUR UN INTERVALLE D'ADRESSE IP
Information sur la source
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
- 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
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.
Sources du même auteur
Sources de la même categorie
Commentaires et avis
|
Derniers Blogs
[WP7] DYNAMICALLY CHANGE STARTUP PAGE[WP7] DYNAMICALLY CHANGE STARTUP PAGE par KooKiz
Let's say that you want to allow the user to customize the startup page of your application. You can easily change the startup page by editing the 'NavigationPage' attribute in the manifest file. But the manifest cannot be modified once the applicatio...
Cliquez pour lire la suite de l'article par KooKiz SESSION SILVERLIGHT 5 3D : SLIDES ET DEMOSSESSION SILVERLIGHT 5 3D : SLIDES ET DEMOS par Groc
Durant les techdays, j'ai eu le plaisir d'animer une session sur Silverlight 5 et la 3D avec Simon Ferquel. Comme promis, voici nos slides et mes démos (celles avec le viper BSG) ici et là. Pour mémoire, les démos utilisent toutes le viper BSG...
Cliquez pour lire la suite de l'article par Groc [TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES[TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES par gpommier
Suite à la session que j'ai présenté sur WebMatrix 2, vous pouvez trouver les slides ici, ainsi que les démos en packages nuget : démos1 et démos2 J'en profite pour remercier chaleureusement tous ceux qui sont venus très nombreux à cette sess...
Cliquez pour lire la suite de l'article par gpommier [SHAREPOINT] LES SESSIONS TECHDAYS 2012.[SHAREPOINT] LES SESSIONS TECHDAYS 2012. par Patrick Guimonet
Voici donc pour ceux qui n'ont pas pu venir, ou ceux qui n'ont pas pu toutes les suivre la liste des sessions SharePoint aux TechDays 2012, que je mettrais à jour dès que les liens des vidéo seront disponibles. Ou ici : http...
Cliquez pour lire la suite de l'article par Patrick Guimonet TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3 par ROMELARD Fabrice
Speaker: Bernard Ourghanlian Cette session est comme chaque jour transmise en live par BrainSonic, et j'ai donc suivi cette troisième pleinière par ce moyen sur mon iPad . Elle est dédiée comme chaque année à la mise en perspective de l'é...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Forum
LISTER KEYS.KEYLISTER KEYS.KEY par Onin42
Cliquez pour lire la suite par Onin42
Logiciels
Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System Easy-Planning (1.0.0.1)EASY-PLANNING (1.0.0.1)Basé sur les mêmes principes que MyPlanning, Easy-Planning permet de créer des plannings sous la ... Cliquez pour télécharger Easy-Planning
|