Bonjour,

Une petite demo pour illustrer les possibilités méconnues et peu documentées du Vbscript : Le (faux) multithreading
Cet exemple est spécifiquement conçu pour exploiter en parallèle des utilitaires en ligne de commande
et affiche après 10 à 20 secondes les vitesses moyennes de 16 serveurs DNS bien connus.
Enjoy
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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