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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
| 'Détermination de l'itinéraire vers les URL(s) saisi par l'utilisateur dans l'InputBox avec la commande DOS "Tracert" animé par une barre de progression
'Date de Création le 06/09/2013 © Hackoo
'Mise à jour le 04/05/2014 : Ajout d'un message d'attente animé par la balise <marquee>
'*********************************Déclaration des variables globales*******************************
Option Explicit
Dim oExec,fso,ws,Temp,Voice,Copyright,Title
Copyright = " Hackoo © 2014"
Set ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
Set Voice = CreateObject("SAPI.SpVoice")
'**************************************************************************************************
'Appel au programme principal ou on peut intégrer la barre de progression
Call MonProgramme()
'**************************************************************************************************
Sub MonProgramme()
Dim Command,Command2,Res,LogFile,StrCommand,Argum,startlog,MsgTitre,Titre,MsgAttente,StartTime,DurationTime
MsgTitre = "Traceroute d'une URL © Hackoo © 2014"
StrCommand = "Tracert"
Argum = InputBox("Taper l'adresse d'une URL pour déterminer son itinéraire avec la commande DOS "& DblQuote("Tracert"),MsgTitre,"www.stackoverflow.com")
LogFile = StrCommand & "Log.txt"
If fso.FileExists(LogFile) Then fso.DeleteFile LogFile
Command = "Cmd /c "& StrCommand & " " & Argum &" >> "&LogFile&""
Titre = "La traceroute vers "& DblQuote(Argum) &" est en cours..."
Title = Titre + Copyright
MsgAttente = Titre
Call CreateProgressBar(Titre,MsgAttente)'Creation de barre de progression
Voice.Speak "Please Wait a While !"
Call LancerProgressBar()'Lancement de la barre de progression
StartTime = Timer'Début du Compteur Timer
Res = Ws.Run(Command,0,True)'Exécution de la Commande
DurationTime = FormatNumber(Timer - StartTime, 0) & " seconds."'La durée de l'exécution du script
Call Formater(LogFile)'Pour formater et remplacer les caractères spéciaux unicode dans le LogFile
Call FermerProgressBar()'Fermeture de barre de progression
Voice.Speak "Process of TraceRoute finished in "& DurationTime &" !"
ws.popup "La TraceRoute vers "& DblQuote(Argum) &" est terminée dans "& vbcr & DurationTime,"2",MsgTitre,64
ws.popup Formater(LogFile),"5",MsgTitre,64
Command2 = "Cmd /c Start "&LogFile&""
startlog = Ws.Run(Command2,0,False)
End Sub
'****************************************************************************************************
Sub CreateProgressBar(Titre,MsgAttente)
Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
Set ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Temp = WS.ExpandEnvironmentStrings("%Temp%")
PathOutPutHTML = Temp & "\Barre.hta"
Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
fhta.WriteLine "<HTML>"
fhta.WriteLine "<HEAD>"
fhta.WriteLine "<Title> " & Title & "</Title>"
fhta.WriteLine "<HTA:APPLICATION"
fhta.WriteLine "ICON = ""magnify.exe"" "
fhta.WriteLine "BORDER=""THIN"" "
fhta.WriteLine "INNERBORDER=""NO"" "
fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
fhta.WriteLine "SCROLL=""NO"" "
fhta.WriteLine "SYSMENU=""NO"" "
fhta.WriteLine "SELECTION=""NO"" "
fhta.WriteLine "SINGLEINSTANCE=""YES"">"
fhta.WriteLine "<style type=""text/css"">"
fhta.WriteLine "div {left: 2%; top: 50%;}"
fhta.WriteLine "marquee { height: 25px; width: 450px;}"
fhta.WriteLine "marquee span {height: 20px; width: 20px; background: Red;float: left;}"
fhta.WriteLine ".handle-0 { filter: alpha(opacity=20); -moz-opacity: 0.20; }"
fhta.WriteLine ".handle-1 { filter: alpha(opacity=40); -moz-opacity: 0.40; }"
fhta.WriteLine ".handle-2 { filter: alpha(opacity=60); -moz-opacity: 0.60; }"
fhta.WriteLine ".handle-3 { filter: alpha(opacity=80); -moz-opacity: 0.80; }"
fhta.WriteLine ".handle-4 { filter: alpha(opacity=100); -moz-opacity: 1; }"
fhta.WriteLine "</style>"
fhta.WriteLine "</HEAD>"
fhta.WriteLine "<BODY text=""white""><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN>"
fhta.WriteLine "<span><marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee></span></DIV></CENTER></BODY></HTML>"
fhta.WriteLine "<div>"
fhta.WriteLine "<marquee direction=""right"" scrollamount=""10"" BEHAVIOR=ALTERNATE>"
fhta.WriteLine "<span class=""handle-0""></span>"
fhta.WriteLine "<span class=""handle-1""></span>"
fhta.WriteLine "<span class=""handle-2""></span>"
fhta.WriteLine "<span class=""handle-3""></span>"
fhta.WriteLine "<span class=""handle-4""></span>"
fhta.WriteLine "</marquee>"
fhta.WriteLine "</div>"
fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
fhta.WriteLine "Sub window_onload()"
fhta.WriteLine " CenterWindow 480,110"
fhta.WriteLine " Self.document.bgColor = ""DarkOrange"" "
fhta.WriteLine " End Sub"
fhta.WriteLine " Sub CenterWindow(x,y)"
fhta.WriteLine " Dim iLeft,itop"
fhta.WriteLine " window.resizeTo x,y"
fhta.WriteLine " iLeft = window.screen.availWidth/2 - x/2"
fhta.WriteLine " itop = window.screen.availHeight/2 - y/2"
fhta.WriteLine " window.moveTo ileft,itop"
fhta.WriteLine "End Sub"
fhta.WriteLine "</script>"
fhta.close
End Sub
'**********************************************************************************************
Sub LancerProgressBar()
Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub FermerProgressBar()
oExec.Terminate
End Sub
'**********************************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
'Fonction pour formater et remplacer les caractères spéciaux unicode dans le LogFile
Function Formater(File)
Dim fso,fRead,fWrite,Text
Set fso = CreateObject("Scripting.FileSystemObject")
Set fRead = fso.OpenTextFile(File,1)
Text = fRead.ReadAll
fRead.Close
Set fWrite = fso.OpenTextFile(File,2,True)
Text = Replace(Text,"‚","é")
Text = Replace(Text,"ے"," ")
Text = Replace(Text,"ˆ","ê")
Text = Replace(Text,"‡","ç")
Text = Replace(Text,"“","ô")
Text = Replace(Text,"…","à")
Text = Replace(Text,"ٹ","è")
Text = Replace(Text,"ƒ","â")
Text = Replace(Text,"?"," ")
fWrite.WriteLine Text
Formater = Text
End Function
'*********************************************************************************************** |
Progress bar dans un HTA
Répondre avec citation
Ne pas oublier le tag 
si satisfait.
Voter pour toute réponse satisfaisante avec 
pour encourager les intervenants.
Partager