Soyez le premier à donner votre avis sur cette source.
Vue 5 511 fois - Téléchargée 704 fois
'Fonction Ping : Private Sub ping(Optional nPing As Integer) On Error Resume Next If nPing <= 1 Then nPing = 1 Dim stradr As String If optIP.Value Then stradr = ip(0) & "." & ip(1) & "." & ip(2) & "." & ip(3) Else stradr = dns.Text End If Dim path As String path = "c:\ping" & Int(Rnd() * 10000) Shell "cmd /C ping " & stradr & " -n " & nPing & " > " & path, vbHide info.Caption = "Waiting " & (nPing + 2) & " sec for results..." & vbCrLf Wait (nPing + 2) * 1000 'attrendre 4sec les résultats info = "Analysing results..." 'test de réussite ou d'échec : Dim Result As String Result = searchParam(path, "sur", False, " ", " ") If Result = "" Then GoTo erreur Moy = Val(searchParam(path, "Moyenne", False, "= ", "ms")) Min = Val(searchParam(path, "Minimum", False, "= ", "ms")) Max = Val(searchParam(path, "Maximum", False, "= ", "ms")) 'bon, d'accord, c'est un peu redondant, on utilise 4 fois searchParam qui ouvre 4 fois le fichier, mais au moins c rapide à coder et suffisament efficace... results.Caption = "Résultats sur " & nPing & " tests d'échos (en ms) :" & vbCrLf & Min & " < " & Moy & " < " & Max If optDNS.Value Then 'récupère l'IP realDNS = searchParam(path, "sur", False, " ", " ") dns.Text = realDNS realIP = searchParam(path, "[", False, "", "]") Dim ch As String, j As Integer, no As Integer j = 0 no = 0 ip(0).Text = "": ip(1).Text = "": ip(2).Text = "": ip(3).Text = "" Do Until j >= Len(realIP) j = j + 1 ch = Mid(realIP, j, 1) If ch <> "." Then ip(no).Text = ip(no).Text & ch Else no = no + 1 End If Loop End If info = "Echo test finished at " & Time Kill path 'supprime fichier path GoTo fin erreur: info = "Echec de ping : aucun serveur n'a été trouvé" 'info, c'est un label fin: End Sub '/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ 'Fonction searchParam 'elle ouvre et analyse le fichier... Public Function searchParam(filePath As String, paramTitle As String, Optional multi As Boolean, Optional sepStr As String, Optional lastCar1 As String, Optional lastCar2 As String) As String 'sepStr : la chaine présentant la valeur du parametre cherché. ex: 'Adresse IP . . . . . . . . : 127.0.0.1 'ici, sepStr = ": " 'lastCar1 : le caractère suivant la valeur du parametre. ex: 'Adresse IP . . . . . . . . : 127.0.0.1 'ici, lastStr1 = chr(10) et lastStr2 = chr(13) (===> vbcrlf) 'multi : défini si il faut chercher plusieurs parametres ou un seul If lastCar1 = "" Then lastCar1 = Chr(10) If lastCar2 = "" Then lastCar2 = Chr(13) lastCar1 = Left(lastCar1, 1) lastCar2 = Left(lastCar2, 1) 'on ne garde que la premiere lettre If paramTitle = "" Then GoTo fin Dim noFile As Integer, intNoEssai As Integer, intNoEssai2 As Integer noFile = FreeFile() testExists: Wait 250 intNoEssai = intNoEssai + 1 If intNoEssai > 80 Then GoTo fin 'attend max. 20 secondes (20 = 80 * 0.25) If Dir$(filePath) = "" Then GoTo testExists Open filePath For Input As noFile If LOF(noFile) = 0 Then intNoEssai2 = intNoEssai2 + 1 Close noFile Wait 1000 If intNoEssai > 60 Then GoTo fin 'attend max. 60 secondes GoTo testExists End If Do Until EOF(noFile) Dim cache As String Dim Octet As String 'cherche le titre du param Do While cache <> paramTitle 'recherche : "Adresse IP" If EOF(noFile) Then GoTo endLoop Octet = Input(1, noFile) cache = cache & Octet If Len(cache) > Len(paramTitle) Then cache = Right(cache, Len(paramTitle)) Loop cache = "" Octet = "" 'saute le sepStr If sepStr <> "" Then Do While cache <> sepStr If EOF(noFile) Then GoTo endLoop Octet = Input(1, noFile) cache = cache & Octet If Len(cache) > Len(sepStr) Then cache = Right(cache, Len(sepStr)) Loop End If cache = "" Octet = "" 'récupère la valeur Do While Octet <> lastCar1 And Octet <> lastCar2 If EOF(noFile) Then GoTo endLoop Octet = Input(1, noFile) If Octet <> lastCar1 And Octet <> lastCar2 Then _ cache = cache & Octet Loop If searchParam = "" Then searchParam = searchParam & cache Else searchParam = searchParam & vbCrLf & cache End If If Not multi Then GoTo fin endLoop: Loop fin: Close noFile End Function '/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ 'Un petit plus : passer d'une case ip à une autre (la suivante) en enfonçant le bouton "." 'Ceci pour taper facilement une ip (127. >> change de case 0. >>change 0. >>...) Private Sub ip_KeyPress(Index As Integer, KeyAscii As Integer) If KeyAscii < 48 Or KeyAscii > 57 Then 'pas des nombres If KeyAscii = 46 And Index <= 3 Then 'point ip(Index + 1).SetFocus ip(Index + 1).Text = "" End If If KeyAscii <> 8 Then _ KeyAscii = 0 End If End Sub
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.