1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
| ' GetDNSSpeed - multithreading demo - omen999 october 2017 - http://omen999.developpez.com/
' DNS tested : FreeDNS, Verisign, FDN, Comodo Secure DNS, OpenDNS, DNS Advantage, Norton ConnectSafe, OpenNIC
Class cTasks
Private oShell
Private aoExec()
Private IDTask
Private sText
Private Sub Class_Initialize()
Set oShell = CreateObject("WScript.Shell")
IDTask = 0
End Sub
Public Function Create(cmd)
ReDim Preserve aoExec(IDTask)
Set aoExec(IDTask) = oShell.Exec(cmd)
Create = IDTask
IDTask = IDTask + 1
End Function
Public Sub Terminate(id)
aoExec(id).Terminate
End Sub
Public Property Get IsRunning(id)
IsRunning = CBool(aoExec(id).Status - 1)
End Property
Public Property Get RetData(id)
Do While Not aoExec(id).StdOut.AtEndOfStream
sText = aoExec(id).StdOut.ReadLine()
If Instr(sText, "Moyenne") > 0 Then
RetData = Mid(sText,InStr(sText, "Moyenne")) & vbCrLf ' > xp
Exit Do
End If
Loop
If RetData = "" Then RetData = "pas de réponse" & vbCrLf
End Property
End Class
'************************* hack to hide windows exec (side effect: hide echo too)
If InStr(1, WScript.FullName, "wscript.exe", vbTextCompare) > 0 Then
With CreateObject("WScript.Shell")
WScript.Quit .Run("cscript.exe """ & WScript.ScriptFullName & """", 0, True)
End With
End If
'************************* end hack
Dim aDNS_IP,aDNS_Name
Dim oGetDSpeed
Dim sRep
aDNS_Name = Array("FreeDNS 1","FreeDNS 2","Verisign 1", "Verisign 2","FDN 1", "FDN 2",_
"Comodo Secure DNS 1", "Comodo Secure DNS 2","OpenDNS 1","OpenDNS 2",_
"DNS Advantage 1","DNS Advantage 2","Norton ConnectSafe 1","Norton ConnectSafe 2",_
"OpenNIC 1","OpenNIC 2")
aDNS_IP = Array("37.235.1.174","37.235.1.177",_
"64.6.64.6","64.6.65.6",_
"80.67.169.12","80.67.169.40",_
"8.26.56.26","8.20.247.20",_
"208.67.222.222","208.67.220.220",_
"156.154.70.1","156.154.71.1",_
"199.85.126.10","199.85.127.10",_
"50.116.40.226","50.116.23.211")
Set dTasksID = CreateObject("Scripting.Dictionary")
Set oGetDSpeed = New cTasks
For iPCount = 0 To 15
IDProc = oGetDSpeed.Create("cmd /c ping -w 1000 " & aDNS_IP(iPCount))
dTasksID.Add IDProc,True
Next
iTActive = 16
Do While iTActive > 0
For Each iTask In dTasksID
If (Not oGetDSpeed.IsRunning(iTask)) And dTasksID.Item(iTask) Then
sRep = sRep & aDNS_Name(iTask) & " - " & aDNS_IP(iTask) & " - " & oGetDSpeed.RetData(iTask)
dTasksID.Item(iTask) = False
iTActive = iTActive - 1
End If
Next
WScript.Sleep 300
Loop
If Len(sRep) > 1024 Then
Msgbox Left(sRep,1010) & " <ok> suite"
Msgbox Mid(sRep,1010)
Else
Msgbox sRep
End If |
