afficher une fenêtre d'une barre de progression

Version imprimable

Bonjour tout le monde
et Bonjour Cachlab

J'aurais encore besoin ton votre aide pour mon scripte de sauvegarde :roll:

Je voudrais affichier une fenetre d'une barre de progression ou quelque chose qui tourne en indiquant que c'est en cours de sauvegarde, quand je clique sur sauvegarde.

J'ai trouvé un code de barre progression sur internet :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
<hta:application
	maximizebutton="no"
	contextmenu="no"
	selection="no"
	showintaskbar="no"
	scroll="no"
>
<title>Data Transfer</title>
<body bgcolor="silver" onLoad="resizeTo(900,90);moveTo(200,450)">
<script>
var c=0;
window.setInterval('if(c<=800){document.getElementById("loadbar").style.width=c;document.getElementById("p100").innerHTML=Math.round(c/8)+"%";c++}else{alert("Data Transfer Finished");window.close()}',3);
</script>
<div style="background-color:gray;width:800;border:inset thin"><div id="loadbar" style="background-color:green;border:outset thin">&nbsp;</div></div>
<center><font face="Microsoft sans serif"><div id="p100"></div></font></center>

Je voudrais intégrer une ligne de code dans mon scripte

Code:

1
2
var c=0;
window.setInterval('if(c<=800){document.getElementById("loadbar").style.width=c;document.getElementById("p100").innerHTML=Math.round(c/8)+"%";c++}else{alert("Data Transfer Finished");window.close()}',3);

Voici mon appli HTA

Code:

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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
 
<HTML><HEAD>
    <TITLE></TITLE>
    <HTA:APPLICATION
    APPLICATIONNAME="Sauvegarde Favoris"
    BORDER="THIN"
    BORDERSTYLE="NORMAL"
    ICON="Explorer.exe"
    INNERBORDER="NO"
    MAXIMIZEBUTTON="NO"
    MINIMIZEBUTTON="NO"
    SCROLL="NO"
    SELECTION="NO"
    SINGLEINSTANCE="YES"/></HEAD>
    <META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
    <BODY TOPMARGIN="1" LEFTMARGIN="1"><CENTER><DIV><SPAN ID="ONSCR"></SPAN></DIV></CENTER></BODY>
 
	<SCRIPT LANGUAGE="VBScript">
	call MenuPrincipal
 
	SUB InnerWindowSize(intWidth,intHeight)
    Self.ResizeTo intWidth,intHeight
    Self.ResizeTo intWidth+(intWidth-Document.Body.OffsetWidth),intHeight+(intHeight-Document.Body.OffsetHeight)
    Self.MoveTo (Screen.Width/2)-(intWidth/2),(Screen.Height/2)-(intHeight/2)
    END SUB
 
	Sub CenterWindow(x,y)
    window.resizeTo x, y
    iLeft = window.screen.availWidth/2 - x/2
    itop = window.screen.availHeight/2 - y/2
    window.moveTo ileft, itop
    End Sub
 
    SUB MenuPrincipal()
    Self.document.title = "Sauvegarde Favoris"
    CALL InnerWindowSize(675,400)
    ONSCR.InnerHTML="<table align=""center"" border=""1"" BGCOLOR=""#BBBFFF"" BORDERCOLOR=""#000000"">"_
	&"<tr><td><img src=""banniere.png""></td></tr></table>"_
    &"<TABLE WIDTH=""675"" HEIGHT=""278"" BORDER=""1"" BGCOLOR=""#BBBFFF"" BORDERCOLOR=""#000000"" CELLPADDING=""0"" CELLSPACING=""1"">"_
    &"<P><TR><TD><CENTER>"_
	&"<DIV ALIGN=""center"" STYLE=""font:12 pt arial; color:black"">"_
    &"Cliquer sur le bouton <B>""Sauvegarder Favoris""</B> pour lancer la sauvegarde des favoris de vos navigateurs Internet."_
	&"<BR>"_
	&"<BR><INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Sauvegarder Favoris"" LANGUAGE=""VBScript"" ONCLICK=""SauvIE()""><P>"_
	&"Cliquer sur le bouton <B>""Recuperer Favoris""</B> pour lancer la recuperation des favoris (sauvegarde prealable requise)."_
	&"<BR>"_
	&"<BR><INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Recuperer Favoris"" LANGUAGE=""VBScript"" ONCLICK=""recpIE()""><P>"_
	&"</DIV>"_
    &"</TD></CENTER></TR></TABLE>"
	END SUB
 
Sub SauvIE
 
call barprog
 
	Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
	Dim objShell : Set objShell = CreateObject("WScript.Shell")
	Dim objWMIService, objFolder, LectSauv, sUserProfile, sUserAppData, strComputer
	Dim SauvRep(2), DestRep(2)
  MsgBox "Attention pour le bon fonctionnement du script veuillez vous assurer que toutes les fenêtres navigateur internet soient fermées ",vbInformation,"Information"
' Destination de la sauvegarde
LectSauv = "P:"
RepSauv = LectSauv & "\Sauvegarde_Favoris"
'Test du lecteur réseau (ici P:) et arrêt du script si inexistant
If Not objFSO.DriveExists(LectSauv) Then MsgBox "Vous ne disposez pas de répertoire personnel, Veuillez contacter votre service Securité logique", vbInformation, "Information" : call MenuPrincipal : Exit Sub
'Test du répertoire principal de sauvegarde et création si besoin (ici P:\Sauvegarde)
If Not objFSO.FolderExists(RepSauv) Then objFolder = objFSO.CreateFolder(RepSauv)
 
'Recherche et kill des process IE et Firefox
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 
Set colProcessList = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = 'firefox.exe'")
For Each objProcess in colProcessList
ObjProcess.Terminate()
Next
 
'Définition des répertoires locaux (nom court) à rechercher
SauvRep(0) = "\Favoris"
SauvRep(1) = "\Favoris"
SauvRep(2) = "\Profiles"
 
'Création des noms des répertoires de sauvegarde (ex. P:\Sauvegarde\Favoris)
For i = 0 to 2
DestRep(i) = RepSauv & SauvRep(i)
Next
 
'Redéfinition des répertoires locaux (nom complets) à rechercher
sUserProfile = objShell.ExpandEnvironmentStrings("%USERPROFILE%")
sUserAppData = objShell.ExpandEnvironmentStrings("%APPDATA%")
 
SauvRep(0) = sUserProfile & SauvRep(0)
SauvRep(1) = sUserProfile & "\Favorites"
SauvRep(2) = sUserAppData & "\Mozilla\Firefox" & SauvRep(2)
 
'Boucle de traitement
For i = 0 to 2
if objFSO.FolderExists(SauvRep(i)) Then 'Si le répertoire local existe
	if Not objFSO.FolderExists(DestRep(i)) Then objFolder = objFSO.CreateFolder(DestRep(i)) 'Si le répertoire destination n'existe pas, on le crée
	objFSO.CopyFolder SauvRep(i) , DestRep(i), True ' et on lance la copie
end if
Next
 
call MenuPrincipal
 
End Sub
 
Sub recpIE
call barprog
	Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
	Dim objShell : Set objShell = CreateObject("WScript.Shell")
	Dim objWMIService, objFolder, LectSauv, sUserProfile, sUserAppData, strComputer
	Dim SauvRep(2), DestRep(2)
 MsgBox "Attention pour le bon fonctionnement du script veuillez vous assurer que toutes les fenêtres navigateur internet soient fermées ",vbInformation,"Information"
' Destination de la sauvegarde
LectSauv = "P:"
RepSauv = LectSauv & "\Sauvegarde_Favoris"
 
'Test du lecteur réseau (ici P:) et arrêt du script si inexistant
If Not objFSO.DriveExists(LectSauv) Then MsgBox "Vous ne disposez pas de répertoire personnel, Veuillez contacter votre service Securité logique", vbInformation, "Information" : call MenuPrincipal : Exit Sub
'Test du répertoire principal de sauvegarde et création si besoin (ici P:\Sauvegarde)
If Not objFSO.FolderExists(RepSauv) Then objFolder = objFSO.CreateFolder(RepSauv)
 
'Recherche et kill des process IE et Firefox
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 
Set colProcessList = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = 'firefox.exe'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
 
'Définition des répertoires locaux (nom court) à rechercher
SauvRep(0) = "\Favoris"
SauvRep(1) = "\Favoris"
SauvRep(2) = "\Profiles"
 
'Création des noms des répertoires de sauvegarde (ex. P:\Sauvegarde\Favoris)
For i = 0 to 2
DestRep(i) = RepSauv & SauvRep(i)
Next
 
'Redéfinition des répertoires locaux (nom complets) à rechercher
sUserProfile = objShell.ExpandEnvironmentStrings("%USERPROFILE%")
sUserAppData = objShell.ExpandEnvironmentStrings("%APPDATA%")
 
SauvRep(0) = sUserProfile & SauvRep(0)
SauvRep(1) = sUserProfile & "\Favorites"
SauvRep(2) = sUserAppData & "\Mozilla\Firefox" & SauvRep(2)
 
'Boucle de traitement
For i = 0 to 2
if objFSO.FolderExists(SauvRep(i)) Then 'Si le répertoire local existe
	if Not objFSO.FolderExists(DestRep(i)) Then objFolder = objFSO.CreateFolder(DestRep(i)) 'Si le répertoire destination n'existe pas, on le crée
	objFSO.CopyFolder DestRep(i) , SauvRep(i), True ' et on lance la copie
end if
Next
call MenuPrincipal
End Sub
 
    SUB barprog()
    Self.document.title = "Sauvegarde Favoris"
    CALL InnerWindowSize(802,90)
	ONSCR.InnerHTML="<br><div style=""bgcolor:silver;width:800;border:inset thin""><div id=""loadbar"" style=""background-color:green;border:outset thin"">&nbsp;</div></div>"_
	&"<center><font face=""Microsoft sans serif""><div id=""p100""></div></font></center>"_
	End Sub
 
</SCRIPT>

Je vous remercie d'avance !!! ;)

Salut Sovan !

Désolé, je ne fais pas dans la déco ! ;)
En plus je déteste les barres de progression !
(un vieu trauma Microsoft j'imagine !) :)

Perso je me contente d'un pop-up "Veuillez patientez ...".
Je t'explique quand même le principe :

Patientez.vbs
Code:

1 2 Set oSh = CreateObject("WScript.Shell") oSh.Popup ("Opération en cours !" & VbCrLf & VbCrLf & "Veuillez patienter ..."), 100000
Script_Principal.vbs
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 'Définition de variable Set oSh = CreateObject("WScript.Shell") '... 'Affichage de la fenêtre d'attente Set oExec = oSh.Exec ("WScript PATIENTEZ.vbs") '... 'Exécution du script '... 'Fermeture de la fenêtre d'attente oExec.Terminate 'Fin du script '...
++

04/09/2013, 14h42
hackoofr

:salut:
La solution de Cachlab est bonne et simple :king:
Tu peux aussi jeter un coup d’œil, si tu insistes à faire une barre de progression en HTA :lol:
c'est à toi alors, de l'adapter à ton HTA : http://www.developpez.net/forums/d13...r/#post7196377

Exemple de Barre de Progression en Vbscript + HTA

:salut:
Tu peux aussi tester cet exemple en Vbscript :king:

Code:

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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
'Exemple de Barre de Progression en Vbscript + HTA © Hackoo © 2013
Dim fso, f, f2, ts, ts2,Ligne,i
Set ws = CreateObject("wscript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(WScript.ScriptFullName)
Set ts = f.OpenAsTextStream(1, -2)
Set fread = Fso.OpenTextFile(f,1)
LireTout = fread.ReadAll
NbLigneTotal = fread.Line 
Temp = WS.ExpandEnvironmentStrings("%Temp%")
PathOutPutHTML = Temp & "\Barre.hta"
Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
fso.CreateTextFile Temp & "\loader.gif"
Set f2 = fso.GetFile(Temp & "\loader.gif")
Set ts2 = f2.OpenAsTextStream(2, -2)
for i=1 to NbLigneTotal - 1
    ts.skipline
Next
Do
    Ligne = ts.readline
    For i=2 to Len(Ligne) step 2
        ts2.write chr( "&h" & mid(Ligne,i,2))
    Next
loop until ts.AtEndOfStream
ts.Close
ts2.Close
fhta.WriteLine "<HTML>"
fhta.WriteLine "<HEAD>" 
fhta.WriteLine "<TITLE>Operation en cours Veuillez Patientez SVP . . . . . .</TITLE>" 
fhta.WriteLine "<HTA:APPLICATION"
fhta.WriteLine "ICON = ""dfrgui.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 "</HEAD>" 
fhta.WriteLine "<BODY><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN></DIV></CENTER></BODY></HTML>"
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 230,90"
fhta.WriteLine "    Self.document.bgColor = ""Orange"" "
fhta.WriteLine "    image = ""<center><img src= "& Temp & "\loader.gif></center>"" "
fhta.WriteLine "    ProgressBar.InnerHTML = image"
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>"
wscript.Sleep 100
Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
'***************************************************Programme Principal****************************************************************************
'==========================================================================
' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 2007
' NAME: PCData.vbs
' AUTHOR: David Taylor
' DATE  : 10/22/2008
' Modified by Hackoo on 04/09/2013
' Modification :- Adding Function WriteLog()
'               - Adding ProgressBar 
'==========================================================================
On Error Resume Next
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
arrComputers = Array(".")
Set ws = CreateObject("Wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
LogFile = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "log"
if fso.FileExists(LogFile) Then
    fso.DeleteFile LogFile
end if
For Each strComputer In arrComputers
    WriteLog "====================="
    WriteLog "Computer: " & strComputer
    WriteLog "====================="
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
    Set colItems = objWMIService.ExecQuery( _
    "SELECT * FROM Win32_OperatingSystem",,48) 
    For Each objItem In colItems
        WriteLog "Operating System: " & objItem.Caption & " Service Pack " & objItem.ServicePackMajorVersion
        WriteLog "Version: " & objItem.Version
        WriteLog "Operating System Install Date: : " & WMIDateStringToDate(objItem.InstallDate)
        WriteLog "Last Boot Up Time: " & WMIDateStringToDate(objItem.LastBootUpTime)
    Next
    Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colDiskDrives = objWMIService.ExecQuery _
    ("Select * from Win32_PerfFormattedData_PerfDisk_LogicalDisk Where " _
    & "Name <> '_Total'")
    For Each objDiskDrive in colDiskDrives
        WriteLog "Drive Name: " & objDiskDrive.Name
        WriteLog "Free Space in MB: " & objDiskDrive.FreeMegabytes
    Next
    Set colItems = objWMIService.ExecQuery( _
    "SELECT * FROM Win32_OperatingSystem",,48) 
    For Each objItem In colItems 
        WriteLog "Local Date Time: " & WMIDateStringToDate(objItem.LocalDateTime)
    Next
    Set colItems = objWMIService.ExecQuery( _
    "SELECT * FROM Win32_OperatingSystem",,48) 
    For Each objItem In colItems 
        WriteLog "Free Physical Memory: " & objItem.FreePhysicalMemory
    Next
    Set colItems = objWMIService.ExecQuery( _
    "SELECT * FROM Win32_OperatingSystem",,48) 
    For Each objItem In colItems 
        WriteLog "Free Space In Paging Files: " & objItem.FreeSpaceInPagingFiles
    Next
    Set colItems = objWMIService.ExecQuery( _
    "SELECT * FROM Win32_OperatingSystem",,48) 
    For Each objItem In colItems 
        WriteLog "Free Virtual Memory: " & objItem.FreeVirtualMemory
    Next
    Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
    Set colComputer = objWMIService.ExecQuery _
    ("Select * from Win32_ComputerSystem")
    For Each objComputer In colComputer
        WriteLog "Logged-on user: " & objComputer.UserName
    Next
    Set colItems = objWMIService.ExecQuery( _
    "SELECT * FROM Win32_NetworkLoginProfile",,48) 
    For Each objItem In colItems 
        WriteLog "Full Name: " & objItem.FullName
    Next     
Next
Set colItems = objWMIService.ExecQuery( _
"SELECT * FROM Win32_BIOS",,48) 
For Each objItem In colItems 
    WriteLog "==================================="
    WriteLog "BIOS Information"
    WriteLog "==================================="
    If isNull(objItem.BIOSVersion) Then
        WriteLog "BIOS Version: "
    Else
        WriteLog "BIOS Version: " & Join(objItem.BIOSVersion, ", ")
    End If
Next
 
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 
Set colAdapters = objWMIService.ExecQuery _
("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
 
n = 1
 
For Each objAdapter In colAdapters
    WriteLog "============================="
    WriteLog "Network Adapter Information " & n
    WriteLog "============================="
    WriteLog "  Description: " & objAdapter.Description
 
    WriteLog "  MAC address: " & objAdapter.MACAddress
    WriteLog "  Host name:              " & objAdapter.DNSHostName
    If Not IsNull(objAdapter.IPAddress) Then
        For i = 0 To UBound(objAdapter.IPAddress)
            WriteLog "  IP address:             " & objAdapter.IPAddress(i)
        Next
    End If
    If Not IsNull(objAdapter.IPSubnet) Then
        For i = 0 To UBound(objAdapter.IPSubnet)
            WriteLog "  Subnet:                 " & objAdapter.IPSubnet(i)
        Next
    End If
    If Not IsNull(objAdapter.DefaultIPGateway) Then
        For i = 0 To UBound(objAdapter.DefaultIPGateway)
            WriteLog "  Default gateway:        " & _
            objAdapter.DefaultIPGateway(i)
        Next
    End If
 
    WriteLog "  ---"
    WriteLog "  DNS"
    WriteLog "  ---"
    WriteLog "    DNS servers in search order:"
 
    If Not IsNull(objAdapter.DNSServerSearchOrder) Then
        For i = 0 To UBound(objAdapter.DNSServerSearchOrder)
            WriteLog "      " & objAdapter.DNSServerSearchOrder(i)
        Next
    End If
 
    WriteLog "    DNS domain: " & objAdapter.DNSDomain
 
    If Not IsNull(objAdapter.DNSDomainSuffixSearchOrder) Then
        For i = 0 To UBound(objAdapter.DNSDomainSuffixSearchOrder)
            WriteLog "    DNS suffix search list: " & _
            objAdapter.DNSDomainSuffixSearchOrder(i)
        Next
    End If
 
    WriteLog "  ----"
    WriteLog "  DHCP"
    WriteLog "  ----"
    WriteLog "    DHCP enabled:        " & objAdapter.DHCPEnabled
    WriteLog "    DHCP server:         " & objAdapter.DHCPServer
 
    If Not IsNull(objAdapter.DHCPLeaseObtained) Then
        utcLeaseObtained = objAdapter.DHCPLeaseObtained
        strLeaseObtained = WMIDateStringToDate(utcLeaseObtained)
    Else
        strLeaseObtained = ""
    End If
    WriteLog "    DHCP lease obtained: " & strLeaseObtained
 
    If Not IsNull(objAdapter.DHCPLeaseExpires) Then
        utcLeaseExpires = objAdapter.DHCPLeaseExpires
        strLeaseExpires = WMIDateStringToDate(utcLeaseExpires)
    Else
        strLeaseExpires = ""
    End If
    WriteLog "    DHCP lease expires:  " & strLeaseExpires
 
    WriteLog "  ----"
    WriteLog "  WINS"
    WriteLog "  ----"
    WriteLog "    Primary WINS server:   " & objAdapter.WINSPrimaryServer
    WriteLog "    Secondary WINS server: " & objAdapter.WINSSecondaryServer
    n = n + 1
Next
 
ws.run LogFile
 
Function WMIDateStringToDate(dtmDate)
'WriteLog dtm: 
    WMIDateStringToDate = CDate(Mid(dtmDate, 5, 2) & "/" & _
    Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) _
    & " " & Mid (dtmDate, 9, 2) & ":" & Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate,13, 2))
End Function
 
Sub WriteLog(strText)
    Dim fs,ts 
    Const ForAppending = 8
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ts = fs.OpenTextFile(Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "log", ForAppending, True)
    ts.WriteLine strText
    ts.Close
End Sub
'****************************************************Fin du Programme Principal***********************************************************************
'Fermeture de la fenêtre d'attente
oExec.Terminate
'47494638396180000F00F20000FFFFFFA2A9F6E9EBFCE2E4FBB9BFF8A2A9F600000000000021FF0B4E45545343415045322E30030100000021FE1A43726561746564207769746820616A61786C6F61642E696E666F0021F904090A0000002C0000000080000F000003E708B20BFEAC3D17C5A4F1AA7CABF61D3781A3089918B391AB5949A9FB96EC6B9DF58CCBB9DDF340D54E1823B68C365A107664FA744527B4798B56A94AE4343994FE9E57AE35EB5D86B7E86F590B5EBBCF6AB8992C67CFBB3EBA1EBF1FF3FF7E81587862838285886977878A760C039091031392919495930F98990E9B97959F92A1969A98A390A79C009B9EA5A0AEA2B0A49DA6B2A8B6AAADB4AFBBB1BDB3ABACBCC1C3BAC4BEC7C0C6CBB5BFB7CEB9CDC9C2A9D5B8D6D0D8D3D1C5D2CCC2CADEE2DDE4C8DFE6E3E8E5E0DAE7E1EBCFDBEDE9EFEAA2C3BF1AF8C9FAC8F917FB02FAE3077020A8040021F904090A0000002C0000000080000F000003FF08B40BFE22C607A5A0CE5EAC31E89CE581145949A318A24C5B6A5B06BF261C7FF3A9CA75CEEFB89EA6C5A0016D46944EF963068FBEA713B99C5405C4C635696D76A55FAAF7260693A3655B96C03D0BA1EF297A1E0FD32DEBB67ECB1FEFFD7D667F667981697772756E708C898D11858092828688768A83871A059C9D051403A1A203A0A3A1A5A6A8A3AAA2ACA70FA6AF0EB1A4B0B1AEB5B3B19E9DB8BEB6A9C0ABC2ADC4B200B4BFBAC1CBC3CDA2BC9CCAC8B7C6B9D4CCD8CEDAC5CFC7C9D6D3B4D19FE1E6DED7E0E8E2D5EBE7DCDFBBD1ECD9EAF0E9EDF7F4DBF6FDF2BCFBBAE97BE7AF5EBE82FC0EDE028821DB330F0EB941DCF6B021458916055664052001010021F904090A0000002C0000000080000F000003FF08B40BFEAC3D276A9DD40A0CF4C61E17829A58929699A257C44CAE948DF359AFF7F5787AFEF913DEAFC30BF2620458CC482336854C9B530ADD15ADCFAB0FA974457153701588A56AC33DF470ACE6429665F1994D9FDBB378B3C7EDE0ABBF697579728381777A1A7E7E8288848D86856B878E168A7064987F71908F9291809E1A05A3A40513A5A41303ABAC03AAADABAFB0B2ADB4ACB6B10FB0B90EBBAEBABBB803A8A3A7C4C2C8C0B3CAB5CCB7CEBC00BEC9BDC1D0C3C70FC4A6D7D4D2D6D5CBE1CDE3CFE5D1D3DDD7DBC6A8DEE9E7BFF1EFE0DFE2F6E4F8E6FAABECDAD9F3D4051CC84F5E417AF7E015F4E780E141810F092A9C588F62C260EE3064B4C5E10F5EB98EF93E62F0A80FE43E911C13000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C97422E70BF4BE9EC085A3576AE73791A05949D43BBDD613AADDBDEA368FF939D64F1834F542B4990CB21C1A9DA8E3B31885E26E2269957ABD2599156558DB25627766E0999CB5B6B9826F6C3C8FA0A76BF77D9B87EFCB785E4D0A83727E6C7F6F7D8B6A8D6948859174877A88969598949A58869D838C8F81A17C8EA2A61A05A9AA0513ABAAADAEAC0F03B4B50313B6B5B8B9B7B3BCBBB9C0B6C2BABEC1C6B6B1B20ECAB0AEC4B4D0BD0EBCD300D5D2D9C8C5D4BFDBB4CD0FE1CCB1DADDC7E7C3DFD6D8EBE6D7DEE9B5E300F4F4EDF2D1EEFBF9ECF1F0E800AAEB67AF9C3883FDDEE113C88DA1BE84FC1CFACB55F0D9418B10334A54F86F1AA1C78EBF305E4CC541A43C0E014F5E48C910E5C06D2E1B9E4C000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F102C1B9EEDE050A1F587667388D2959495835BD16F4AE23F9E4BAC3E3AC5D0E6812067D39DAEC66933533C622F2B8194651575595FACB0A944FC6D219834EA55B74F78C656BD7E9769C032E8BC33005D3DD9BF7E180567C44723C757A6488668A77835E846F827E907F92867B8C798787815C969F9EA16A49989BA5989DA3A285A0AAAE1D05B1B20513B3B2B5B6B40FB9BA0E03BFC00313C1C0C3C4C20FC7C8BEC7C6C4CEC1D0C0BCB8B6D5B3D7B7C9CDDBCFDDD1DFC5E1BFD2E4E3CB00CAD4BBB9D9B1EEBDE9DCCCDEF4E0F6E2F8E6FAE8CAE503EB1C04043070A0BF73FF12225CC8EF5FC176ECAC45C4C6505E3D8BF730E6D3B88F2B63BF791E1F4A140891E4488F0A1B563CA8B225CA9326DF5D804990A2340D17F1E1CCA8F3424E8D3B8B25000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7C85F7DA07766258929F99A2602561D5E45A902BDB8FB83AFAC8F7939E2008CC157FBAD92D5663C2384F0651373D21AD006175973D7693B8E86BE32443CD5223558DD5B2B9EE2BBCA76C9EEB625A7EEBFBB6BD717E736B721E786863878A61827D818F8091848D028B6596778C90939B7F9C922298697B76A3887A947C436F8EA0839E2205B2B30513B4B3B6B7B50FBABB0EBD1303C2C303C1C4C2C6C7C9C4CBC3CDC80FC7C2C0BCBAB9B7D7B4D9B8D1D2CFC5DDCAE1CCE3CEE5D00ED203D4BFD6D5D8EFDAF1DCE9DEE7E0F5E2F9E4FBE6FDE800D4B10330B0A0BB76F0FEE10B684FE1B787F7BE194C48F060458A03D5417418B12D23478513E52114799164C6860CF5A5E4B7D25F4B801A23521CE96B9E8699256BF6D3A072E7859E2D79B2DC99000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CAB1620F885C2189AE245962AB9795065C53056BF9C9D036BEAF4AC5F6F02240E1F40D94CC798289D32E8ED893C0A57466C557B756D4954A644BCC43569BB30CFBAE6B6BDDDD3571E07A9EF51F4992CDD15E73E6F7482817F75027853797C7A63668E8684419259709480888B8F6589699A6A91A16CA26E499FA78AA99E37A496AD83AF2005B3B40513B5B4B7B8B60FBBBC0EBEBAB81303C5C603C4C7C5C9CACCC7CEC6D0C5C1BDBBC2B5D7B9D5C3DBD80FCACBDFE0D2C8E2CDE6CFE8C6D4C0D6DDDAEDDCF1DEF3F000E0E50EF8E4FCEAE1FAE0D8011048D05DBD59D910FACB776FDCC27E00CF453C5650DE4083172D56A4D7503362C77413A33D1C19721AC68DF6502A3CF8EBA3C8920CF79174F98F26328BF534E0CCB8F29D4E8E2135780C7A61A84BA1CF12000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF697208ADA48866699A2E30662AFCBC1B3CC4C9544DF8FD9F63EC1242804FA86C19C0592C3359931A533FA74109147E3CA1AC49AA4D01A78A7B395C7E62537BBDE02AEDA5F7B84AE57D353F11D0D9F9FFC45805E747B8554877A883C82717F6F5D8D818F3E768A678689998B936E7D9C729F8E44959A97966A78619B9EAC908C8005B1B20513B3B2B5B6B40FB9BA0EBCB8B6C0B31303C5C603C4C7C5C9CACCC7CEC6BFBBB9C2B7D3C1D7C3D9D6BED40FCACBDFE0D0E10EE0C8E2CAD2DDD8ECDAEEDC00EBF2DEF0B1E4E8E6E3E9CFFCC6F8F302D6A3D78EE03B83F1E69DC3C7D05F3900E7041694789062C2810B1DE683B84F2E5F338D16EF6D1369AF174292274D2AECC8F1A3C77E2FFF6944A8A120BC9A076F5EB049F3824B7F1A7EC60CFA2C010021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D370924A995E6850A27BA8118FC8A333355524CE316848F2BD623287410812BDEEDE793299B3BA6CE06A51A8348D710BB4D4A6B39706F1A7E92C7E2A5ECD8D55E57D992395D2D7FE7F8FB97FD7603F87F41794E7A848651875681706D2571297D728588948A8395766B5C91908B7E44979693A28999986880A99B9E2505AEAF0513B0AFB2B3B10FB6B70EB9B5B3BDB0BFB40F03C4C50313C6C5C8C9C7C3CCBCB8B6C1AED3BA00D0BBD2D1BEDBC0CEC9CBE0DFC6E1C6D8D7DAD9DCEADEECC2EED4DDEFE8EB00CCCD0EF7E5CAE3C5E7FFE9E8B513380F60BD73FAFA11DBB750E100830321160C28311E3C6B09F3316388CF27DE338A200F868C387262BD8C1EC5695499925C3D771A5E128C3910E605993259AE6CB84F03B8040021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D378193609ADA895EAAB091AF1833636541760DDB37B6E78FD6CA217405853C9D2C89FB3997401F14562C09AD2DA694D69C7AB95B49B8371397C9D5630BABD29E95E07737EEAE47E5C4AB5AC53ED99F74777F5F66837169796B7B7E828D80858E8464866688009645949391818F9B9E70957A897C8B2605A8A90513AAA9ACADAB0FB0B10EB3AFADB7AAB9AEB2B01303C0C103BFC2C0C4C5B6BDB8CABACCBCB5BECEA8BBD3D2B400C90EC5C60FDBC3DDDBD9D8D1D0CBE5CDE7CFE3E6EBE8EDEAE2DEC7C2F3C1E2F7E4EFD5E9FBFAD7F8ECE26DABC74D5BB87C00DD258487B061C07CF2C015233860613F8BFF1C2AD4C8901B5D44831325D263974E03C97726DD95BC70B2A54A0021EB699898000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D3781A3F80828AAA56A2561E416BB16E496F36DE7BCC9A6931F8A86331177461D2CD963149D48A84328080A8F4BA98CC9D562B75E25F835AE4D85D6DF772D6637C9EE2E5C4C4DB3E2E1B7B9FC9CEBFB7B5F7527576D867F517E7281878B7640846A8D798E898C88598A945A83673F05A0A10513A2A1A4A5A30FA8A90EABA7A5AFA2B1A6AAA8B3A01303BABB03B9BCBAAEB5B0C2B2C4B4ADB6C6B8CAAC00C1C8C3D0C50EBFBABEBFCFCEC9D2C7DAD1DED3E0DDD9E4DBE2CBD4D5D7BCE5DFEDE1EFE3E6F1E8E7CDD5BD0FF8F4CDFCB7FDF302BA13180EDFBA5DFE98FD5BA8B021B77A09D3FD3A68ED1B370D16C5610C77F10C42C68F1C355E9838921780040021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D3781A308998EA0AA1BD99A9584B9B175D27189EF70FEACC09AAEC7630C8D37A212395BCA5E4C0070254C46ABCDAB2FFBC442BBDBAF8D3B964E05DE74585D04B7CB6C67F98C5EDBDF47B73C0FBFEF7F67715A78567A837F647C8A805382868F7D8489859188621374059A9B05139C9B9E9F9D0FA2A30EA5A19FA99CABA0A4A2AD9AB1A60003B6B703A8AFAABBACBDAEA7B0BFB2C3B4BAC1BCC8BECAC0B5B8B6C700D1D3C2CCC4D6C6D5D2DAD4C9DBDECFD0DCE3DEDDCBDFE7E6CDEAD7E8CDE1B9E4E9F2EBF4EDECD9E5F6B4F0F8B3FFC5006213E8EEDEBE09F0DC69F0C66CE1B98617182A8CF870622B87CD1C3C0390000021F904090A0000002C0000000080000F000003E708B40BFEAC3D17C9A4F1AA7CABF61D3781A3089918B391AB5949A9FB96EC6B9DF58CCBB9DDF340D54E1823B68C365A107664FA744527B4798B56A94AE4343994FE9E57AE35EB5D86B7E86F590B5EBBCF6AB8992C67CFBB3EBA1EBF1FF3FF7E81587862838285886977878A760C059091051392919495930F98990E9B97959F92A1969A98A390A79C009B9EA5A0AEA2B0A49DA6B2A8B6AAADB4AFBBB1BDB3ABACBCC1C3BAC4BEC7C0C6CBB5BFB7CEB9CDC9C2A9D5B8D6D0D8D3D1C5D2CCC2CADEE2DDE4C8DFE6E3E8E5E0DAE7E1EBCFDBEDE9EFEAA2C3BF1AF8C9FAC8F917FB02FAE3077020A804003B000000000000000000

:salut:
Voici un autre exemple d'une barre de progression avec adaptation d'un script anglais de recherche dans la base de registre :king:

Description du Script :

- Rechercher dans votre base de Registre et trouver tous les instances du mot saisi.
- Possibilité de sauvegarder le résultat de recherche avec WordPad.
- On peut aussi sauvegarder le fichier avec l'extension ".reg", pour l'utiliser afin de restaurer chaque changement de la base de registre que vous faites pour ces valeurs.

Code:

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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
'RegSrch.vbs Search Registry for input string and display results 
'Avec une barre de Progression en Vbscript + HTA ajouté par © Hackoo le 05/09/2013 
Option Explicit
Dim ws,fso,f,f2,ts,ts2,Ligne,i,Titre,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
Titre = "Recherche en cours ... Veuillez Patientez ..." 'Dans cette ligne vous pouvez modifier le titre de la barre de progression
Set ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(WScript.ScriptFullName)
Set ts = f.OpenAsTextStream(1,-2)
Set fread = Fso.OpenTextFile(f,1)
LireTout = fread.ReadAll
NbLigneTotal = fread.Line 
Temp = WS.ExpandEnvironmentStrings("%Temp%")
PathOutPutHTML = Temp & "\Barre.hta"
Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
fso.CreateTextFile Temp & "\loader.gif"
Set f2 = fso.GetFile(Temp & "\loader.gif")
Set ts2 = f2.OpenAsTextStream(2,-2)
for i=1 to NbLigneTotal - 1
	ts.skipline
Next
Do
	Ligne = ts.readline
	For i=2 to Len(Ligne) step 2
		ts2.write chr( "&h" & mid(Ligne,i,2))
	Next
loop until ts.AtEndOfStream
ts.Close
ts2.Close
fhta.WriteLine "<HTML>"
fhta.WriteLine "<HEAD>" 
fhta.WriteLine "<TITLE>"& Titre & "</TITLE>" 
fhta.WriteLine "<HTA:APPLICATION"
fhta.WriteLine "ICON = ""Regedit.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 "</HEAD>" 
fhta.WriteLine "<BODY><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN></DIV></CENTER></BODY></HTML>"
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 250,90"
fhta.WriteLine "    Self.document.bgColor = ""Orange"" "
fhta.WriteLine "    image = ""<center><img src= "& Temp & "\loader.gif></center>"" "
fhta.WriteLine "    ProgressBar.InnerHTML = image"
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>"
wscript.Sleep 100
'***************************************************Programme Principal****************************************************************************
'--------------------------------RegSrch---------------------------------------------------------------------------------------
'RegSrch.vbs - Search Registry for input string and display results.
'© Bill James - wgjames@mvps.org
' revised 20 Apr 2001 (parses regfile ~3X faster)
' revised 13 Dec 2001 (added Regedit command line switch for Win2K/WindXP)
'----------------------------------------------------------------------------------------------------------------------------------
Dim oWS : Set oWS = CreateObject("WScript.Shell")
Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim sSearchFor
sSearchFor = InputBox("Ce Programme va Rechercher dans votre base de Registre et trouver tous " & _
"les instances du mot saisi." & vbcrlf & vbcrlf & _
"Cette Recherche peut prendre plusieurs minutes, alors il faut être patient." & _
vbcrlf & vbcrlf & "Entrez le mot à rechercher " & _
"cliquer OK...", WScript.ScriptName & " " & Chr(169) & " Hackoo Crackoo")
If sSearchFor = "" Then Cleanup()
Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")'Lançer la barre de Progression
Dim StartTime : StartTime = Timer
Dim sRegTmp, sOutTmp, eRegLine, iCnt, sRegKey, aRegFileLines
sRegTmp = oWS.Environment("Process")("Temp") & "\RegTmp.tmp "
sOutTmp = oWS.Environment("Process")("Temp") & "\sOutTmp" & _
Hour(Now) & Minute(Now) & Second(Now) & ".tmp "
oWS.Run "regedit /e /a " & sRegTmp, , True '/a enables export as Ansi for WinXP
With oFSO.OpenTextFile(sOutTmp, 8, True)
	.WriteLine("REGEDIT4" & vbcrlf & "; " & WScript.ScriptName & " " & _
	Chr(169) & " Hackoo Crackoo" & vbcrlf & vbcrlf & "; Résultat de la Recherche pour le " & _
	"mot " & Chr(34) & sSearchFor & Chr(34) & " " & Now & _
	vbcrlf & vbcrlf & "; NOTE: Ce fichier va être supprimer si vous ne le sauvegarder pas avec " & _
	"WordPad." & vbcrlf & "; Vous avez intérêt de le sauvegarder vers un nouveau " & _
	"emplaçement si vous-voulez l'utiliser après." & vbcrlf & "; (si " & _
	"vous sauvegarder le fichier avec l'extension .reg , Vous Pouvez l'utiliser pour restaurer " & _
	"afin de restaurer chaque changement de la base de registre que vous faites pour ces valeurs..)" & vbcrlf)
'---------------------------------------------------------------------------------------------------------------------------------------------------------------
'ForReading 1 Ouvre un fichier en lecture seule. Vous ne pouvez écrire dans ce fichier.
'ForWriting 2 Ouvre un fichier en mode écriture. Si un fichier portant le même nom existe, son contenu antérieur est écrasé.
'ForAppending 8 Ouvre un fichier et écrit à  la fin de celui- ci.
'TristateUseDefault -2 Ouvre le fichier en utilisant le paramètre système par défaut.
'TristateTrue -1 Ouvre le fichier au format Unicode.
'TristateFalse 0 Ouvre le fichier au format ASCII.
'OpenAsTextStream(1, 0) donc est ouvert en lecture seule et au format ASCII
'-------------------------------------------------------------------------------------------------------------------------------------------------------------
	With oFSO.GetFile(sRegTmp)
		aRegFileLines = Split(.OpenAsTextStream(1,0).Read(.Size), vbcrlf)
	End With
'oWS.Run "WordPad " & sRegTmp, 3, True
	oFSO.DeleteFile(sRegTmp)
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------
'Exemple comment utiliser la Fonction Instr
'Dim SearchString, SearchChar, MyPos
'SearchString ="XXpXXpXXPXXP" ' Chaîne dans laquelle rechercher.
'SearchChar = "P" ' Recherche "P".
'MyPos = Instr(4, SearchString, SearchChar, 1) ' Comparaison textuelle commençant à  la position 4. Renvoie 6.
'MyPos = Instr(SearchString, SearchChar) ' La comparaison est binaire par défaut (le dernier argument est omis). Renvoie 9.
'MyPos = Instr(1, SearchString, "W") ' Comparaison binaire commençant à  la position 1. Renvoie 0 ("W" est introuvable).
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------
	For Each eRegLine in aRegFileLines
		If InStr(1, eRegLine, "[", 1) > 0 Then sRegKey = eRegLine
		If InStr(1, eRegLine, sSearchFor, 1) > 0 Then
			If sRegKey <> eRegLine Then
				.WriteLine(vbcrlf & sRegKey) & vbcrlf & eRegLine
			Else
				.WriteLine(vbcrlf & sRegKey)
			End If
			iCnt = iCnt + 1
		End If
	Next
	Erase aRegFileLines
	If iCnt < 1 Then
'Fermeture de la fenêtre d'attente (La barre de progression)
		oExec.Terminate
		oWS.Popup "Recherche complétée dans " & FormatNumber(Timer - StartTime, 0) & " seconds." & _
		vbcrlf & vbcrlf & "Pas instances de " & chr(34) & sSearchFor & chr(34) & _
		" Trouvé.",, WScript.ScriptName & " " & Chr(169) & " Hackoo Crackoo",48
		.Close
		oFSO.DeleteFile(sOutTmp)
		Cleanup()
	End If
	.Close
End With
'Fermeture de la fenêtre d'attente (La barre de progression)
oExec.Terminate
oWS.Popup "Recherche complétée dans " & FormatNumber(Timer - StartTime, 0) & " seconds." & _
vbcrlf & vbcrlf & iCnt & " instances de " & chr(34) & sSearchFor & chr(34) & _
" Trouvé." & vbcrlf & vbcrlf & "Cliquer sur OK pour ouvrir les Résultas dans WordPad.",, _
WScript.ScriptName & " " & Chr(169) & " Hackoo Crackoo",64
oWS.Run "WordPad " & sOutTmp, 3, True
oFSO.DeleteFile(sOutTmp) 
 
Sub Cleanup()
	Set oWS = Nothing
	Set oFSO = Nothing
	WScript.Quit
End Sub
'****************************************************Fin du Programme Principal***********************************************************************
'47494638396180000F00F20000FFFFFFA2A9F6E9EBFCE2E4FBB9BFF8A2A9F600000000000021FF0B4E45545343415045322E30030100000021FE1A43726561746564207769746820616A61786C6F61642E696E666F0021F904090A0000002C0000000080000F000003E708B20BFEAC3D17C5A4F1AA7CABF61D3781A3089918B391AB5949A9FB96EC6B9DF58CCBB9DDF340D54E1823B68C365A107664FA744527B4798B56A94AE4343994FE9E57AE35EB5D86B7E86F590B5EBBCF6AB8992C67CFBB3EBA1EBF1FF3FF7E81587862838285886977878A760C039091031392919495930F98990E9B97959F92A1969A98A390A79C009B9EA5A0AEA2B0A49DA6B2A8B6AAADB4AFBBB1BDB3ABACBCC1C3BAC4BEC7C0C6CBB5BFB7CEB9CDC9C2A9D5B8D6D0D8D3D1C5D2CCC2CADEE2DDE4C8DFE6E3E8E5E0DAE7E1EBCFDBEDE9EFEAA2C3BF1AF8C9FAC8F917FB02FAE3077020A8040021F904090A0000002C0000000080000F000003FF08B40BFE22C607A5A0CE5EAC31E89CE581145949A318A24C5B6A5B06BF261C7FF3A9CA75CEEFB89EA6C5A0016D46944EF963068FBEA713B99C5405C4C635696D76A55FAAF7260693A3655B96C03D0BA1EF297A1E0FD32DEBB67ECB1FEFFD7D667F667981697772756E708C898D11858092828688768A83871A059C9D051403A1A203A0A3A1A5A6A8A3AAA2ACA70FA6AF0EB1A4B0B1AEB5B3B19E9DB8BEB6A9C0ABC2ADC4B200B4BFBAC1CBC3CDA2BC9CCAC8B7C6B9D4CCD8CEDAC5CFC7C9D6D3B4D19FE1E6DED7E0E8E2D5EBE7DCDFBBD1ECD9EAF0E9EDF7F4DBF6FDF2BCFBBAE97BE7AF5EBE82FC0EDE028821DB330F0EB941DCF6B021458916055664052001010021F904090A0000002C0000000080000F000003FF08B40BFEAC3D276A9DD40A0CF4C61E17829A58929699A257C44CAE948DF359AFF7F5787AFEF913DEAFC30BF2620458CC482336854C9B530ADD15ADCFAB0FA974457153701588A56AC33DF470ACE6429665F1994D9FDBB378B3C7EDE0ABBF697579728381777A1A7E7E8288848D86856B878E168A7064987F71908F9291809E1A05A3A40513A5A41303ABAC03AAADABAFB0B2ADB4ACB6B10FB0B90EBBAEBABBB803A8A3A7C4C2C8C0B3CAB5CCB7CEBC00BEC9BDC1D0C3C70FC4A6D7D4D2D6D5CBE1CDE3CFE5D1D3DDD7DBC6A8DEE9E7BFF1EFE0DFE2F6E4F8E6FAABECDAD9F3D4051CC84F5E417AF7E015F4E780E141810F092A9C588F62C260EE3064B4C5E10F5EB98EF93E62F0A80FE43E911C13000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C97422E70BF4BE9EC085A3576AE73791A05949D43BBDD613AADDBDEA368FF939D64F1834F542B4990CB21C1A9DA8E3B31885E26E2269957ABD2599156558DB25627766E0999CB5B6B9826F6C3C8FA0A76BF77D9B87EFCB785E4D0A83727E6C7F6F7D8B6A8D6948859174877A88969598949A58869D838C8F81A17C8EA2A61A05A9AA0513ABAAADAEAC0F03B4B50313B6B5B8B9B7B3BCBBB9C0B6C2BABEC1C6B6B1B20ECAB0AEC4B4D0BD0EBCD300D5D2D9C8C5D4BFDBB4CD0FE1CCB1DADDC7E7C3DFD6D8EBE6D7DEE9B5E300F4F4EDF2D1EEFBF9ECF1F0E800AAEB67AF9C3883FDDEE113C88DA1BE84FC1CFACB55F0D9418B10334A54F86F1AA1C78EBF305E4CC541A43C0E014F5E48C910E5C06D2E1B9E4C000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F102C1B9EEDE050A1F587667388D2959495835BD16F4AE23F9E4BAC3E3AC5D0E6812067D39DAEC66933533C622F2B8194651575595FACB0A944FC6D219834EA55B74F78C656BD7E9769C032E8BC33005D3DD9BF7E180567C44723C757A6488668A77835E846F827E907F92867B8C798787815C969F9EA16A49989BA5989DA3A285A0AAAE1D05B1B20513B3B2B5B6B40FB9BA0E03BFC00313C1C0C3C4C20FC7C8BEC7C6C4CEC1D0C0BCB8B6D5B3D7B7C9CDDBCFDDD1DFC5E1BFD2E4E3CB00CAD4BBB9D9B1EEBDE9DCCCDEF4E0F6E2F8E6FAE8CAE503EB1C04043070A0BF73FF12225CC8EF5FC176ECAC45C4C6505E3D8BF730E6D3B88F2B63BF791E1F4A140891E4488F0A1B563CA8B225CA9326DF5D804990A2340D17F1E1CCA8F3424E8D3B8B25000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7C85F7DA07766258929F99A2602561D5E45A902BDB8FB83AFAC8F7939E2008CC157FBAD92D5663C2384F0651373D21AD006175973D7693B8E86BE32443CD5223558DD5B2B9EE2BBCA76C9EEB625A7EEBFBB6BD717E736B721E786863878A61827D818F8091848D028B6596778C90939B7F9C922298697B76A3887A947C436F8EA0839E2205B2B30513B4B3B6B7B50FBABB0EBD1303C2C303C1C4C2C6C7C9C4CBC3CDC80FC7C2C0BCBAB9B7D7B4D9B8D1D2CFC5DDCAE1CCE3CEE5D00ED203D4BFD6D5D8EFDAF1DCE9DEE7E0F5E2F9E4FBE6FDE800D4B10330B0A0BB76F0FEE10B684FE1B787F7BE194C48F060458A03D5417418B12D23478513E52114799164C6860CF5A5E4B7D25F4B801A23521CE96B9E8699256BF6D3A072E7859E2D79B2DC99000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CAB1620F885C2189AE245962AB9795065C53056BF9C9D036BEAF4AC5F6F02240E1F40D94CC798289D32E8ED893C0A57466C557B756D4954A644BCC43569BB30CFBAE6B6BDDDD3571E07A9EF51F4992CDD15E73E6F7482817F75027853797C7A63668E8684419259709480888B8F6589699A6A91A16CA26E499FA78AA99E37A496AD83AF2005B3B40513B5B4B7B8B60FBBBC0EBEBAB81303C5C603C4C7C5C9CACCC7CEC6D0C5C1BDBBC2B5D7B9D5C3DBD80FCACBDFE0D2C8E2CDE6CFE8C6D4C0D6DDDAEDDCF1DEF3F000E0E50EF8E4FCEAE1FAE0D8011048D05DBD59D910FACB776FDCC27E00CF453C5650DE4083172D56A4D7503362C77413A33D1C19721AC68DF6502A3CF8EBA3C8920CF79174F98F26328BF534E0CCB8F29D4E8E2135780C7A61A84BA1CF12000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF697208ADA48866699A2E30662AFCBC1B3CC4C9544DF8FD9F63EC1242804FA86C19C0592C3359931A533FA74109147E3CA1AC49AA4D01A78A7B395C7E62537BBDE02AEDA5F7B84AE57D353F11D0D9F9FFC45805E747B8554877A883C82717F6F5D8D818F3E768A678689998B936E7D9C729F8E44959A97966A78619B9EAC908C8005B1B20513B3B2B5B6B40FB9BA0EBCB8B6C0B31303C5C603C4C7C5C9CACCC7CEC6BFBBB9C2B7D3C1D7C3D9D6BED40FCACBDFE0D0E10EE0C8E2CAD2DDD8ECDAEEDC00EBF2DEF0B1E4E8E6E3E9CFFCC6F8F302D6A3D78EE03B83F1E69DC3C7D05F3900E7041694789062C2810B1DE683B84F2E5F338D16EF6D1369AF174292274D2AECC8F1A3C77E2FFF6944A8A120BC9A076F5EB049F3824B7F1A7EC60CFA2C010021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D370924A995E6850A27BA8118FC8A333355524CE316848F2BD623287410812BDEEDE793299B3BA6CE06A51A8348D710BB4D4A6B39706F1A7E92C7E2A5ECD8D55E57D992395D2D7FE7F8FB97FD7603F87F41794E7A848651875681706D2571297D728588948A8395766B5C91908B7E44979693A28999986880A99B9E2505AEAF0513B0AFB2B3B10FB6B70EB9B5B3BDB0BFB40F03C4C50313C6C5C8C9C7C3CCBCB8B6C1AED3BA00D0BBD2D1BEDBC0CEC9CBE0DFC6E1C6D8D7DAD9DCEADEECC2EED4DDEFE8EB00CCCD0EF7E5CAE3C5E7FFE9E8B513380F60BD73FAFA11DBB750E100830321160C28311E3C6B09F3316388CF27DE338A200F868C387262BD8C1EC5695499925C3D771A5E128C3910E605993259AE6CB84F03B8040021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D378193609ADA895EAAB091AF1833636541760DDB37B6E78FD6CA217405853C9D2C89FB3997401F14562C09AD2DA694D69C7AB95B49B8371397C9D5630BABD29E95E07737EEAE47E5C4AB5AC53ED99F74777F5F66837169796B7B7E828D80858E8464866688009645949391818F9B9E70957A897C8B2605A8A90513AAA9ACADAB0FB0B10EB3AFADB7AAB9AEB2B01303C0C103BFC2C0C4C5B6BDB8CABACCBCB5BECEA8BBD3D2B400C90EC5C60FDBC3DDDBD9D8D1D0CBE5CDE7CFE3E6EBE8EDEAE2DEC7C2F3C1E2F7E4EFD5E9FBFAD7F8ECE26DABC74D5BB87C00DD258487B061C07CF2C015233860613F8BFF1C2AD4C8901B5D44831325D263974E03C97726DD95BC70B2A54A0021EB699898000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D3781A3F80828AAA56A2561E416BB16E496F36DE7BCC9A6931F8A86331177461D2CD963149D48A84328080A8F4BA98CC9D562B75E25F835AE4D85D6DF772D6637C9EE2E5C4C4DB3E2E1B7B9FC9CEBFB7B5F7527576D867F517E7281878B7640846A8D798E898C88598A945A83673F05A0A10513A2A1A4A5A30FA8A90EABA7A5AFA2B1A6AAA8B3A01303BABB03B9BCBAAEB5B0C2B2C4B4ADB6C6B8CAAC00C1C8C3D0C50EBFBABEBFCFCEC9D2C7DAD1DED3E0DDD9E4DBE2CBD4D5D7BCE5DFEDE1EFE3E6F1E8E7CDD5BD0FF8F4CDFCB7FDF302BA13180EDFBA5DFE98FD5BA8B021B77A09D3FD3A68ED1B370D16C5610C77F10C42C68F1C355E9838921780040021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D3781A308998EA0AA1BD99A9584B9B175D27189EF70FEACC09AAEC7630C8D37A212395BCA5E4C0070254C46ABCDAB2FFBC442BBDBAF8D3B964E05DE74585D04B7CB6C67F98C5EDBDF47B73C0FBFEF7F67715A78567A837F647C8A805382868F7D8489859188621374059A9B05139C9B9E9F9D0FA2A30EA5A19FA99CABA0A4A2AD9AB1A60003B6B703A8AFAABBACBDAEA7B0BFB2C3B4BAC1BCC8BECAC0B5B8B6C700D1D3C2CCC4D6C6D5D2DAD4C9DBDECFD0DCE3DEDDCBDFE7E6CDEAD7E8CDE1B9E4E9F2EBF4EDECD9E5F6B4F0F8B3FFC5006213E8EEDEBE09F0DC69F0C66CE1B98617182A8CF870622B87CD1C3C0390000021F904090A0000002C0000000080000F000003E708B40BFEAC3D17C9A4F1AA7CABF61D3781A3089918B391AB5949A9FB96EC6B9DF58CCBB9DDF340D54E1823B68C365A107664FA744527B4798B56A94AE4343994FE9E57AE35EB5D86B7E86F590B5EBBCF6AB8992C67CFBB3EBA1EBF1FF3FF7E81587862838285886977878A760C059091051392919495930F98990E9B97959F92A1969A98A390A79C009B9EA5A0AEA2B0A49DA6B2A8B6AAADB4AFBBB1BDB3ABACBCC1C3BAC4BEC7C0C6CBB5BFB7CEB9CDC9C2A9D5B8D6D0D8D3D1C5D2CCC2CADEE2DDE4C8DFE6E3E8E5E0DAE7E1EBCFDBEDE9EFEAA2C3BF1AF8C9FAC8F917FB02FAE3077020A804003B000000000000000000

:salut:
Je crois que je vais recycler tous mes scripts et les mettre à jour avec cette Barre de Progression :king: :lol:
Voici une autre adaptation de cette barre avec le script : SearchFileByName.vbs

Code:

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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
'SearchFileByName.vbs © Hackoo Le 26/05/2011 :
'C'est un Vbscript pour rechercher des fichiers par leurs noms
'et générer le Résultat de recherche dans un Tableau en HTML en citant les informations
'sur ces fichiers tels que leurs Chemins ,la date de création,la date de modification,la Taille et leurs attributs 
'Mise à jour Le 29/05/2011 :
'Ajout et affichage des miniatures de diffrentes types d'images lors de la recherche
'Càd si la Recherche comporte des fichiers images elles seront affichées en miniatures
'Mise à jour le 05/09/2013 :
'Ajout d'une barre de Progression en Vbscript + HTA par © Hackoo 
Dim ws,fso,f,f2,ts,ts2,Ligne,i,Titre,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
Titre = "Recherche en cours ... Veuillez Patientez ..." 'Dans cette ligne vous pouvez modifier le titre de la barre de progression
Set ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(WScript.ScriptFullName)
Set ts = f.OpenAsTextStream(1,-2)
Set fread = Fso.OpenTextFile(f,1)
LireTout = fread.ReadAll
NbLigneTotal = fread.Line 
ImgBar = "Loader.gif"
Temp = WS.ExpandEnvironmentStrings("%Temp%")
PathOutPutHTML = Temp & "\Barre.hta"
Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
fso.CreateTextFile Temp & "\" & ImgBar
Set f2 = fso.GetFile(Temp & "\" & ImgBar)
Set ts2 = f2.OpenAsTextStream(2,-2)
for i=1 to NbLigneTotal - 1
    ts.skipline
Next
Do
    Ligne = ts.readline
    For i=2 to Len(Ligne) step 2
        ts2.write chr( "&h" & mid(Ligne,i,2))
    Next
loop until ts.AtEndOfStream
ts.Close
ts2.Close
fhta.WriteLine "<HTML>"
fhta.WriteLine "<HEAD>" 
fhta.WriteLine "<TITLE>"& Titre & "</TITLE>" 
fhta.WriteLine "<HTA:APPLICATION"
fhta.WriteLine "ICON = ""Regedit.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 "</HEAD>" 
fhta.WriteLine "<BODY><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN></DIV></CENTER></BODY></HTML>"
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 250,90"
fhta.WriteLine "    Self.document.bgColor = ""Orange"" "
fhta.WriteLine "    image = ""<center><img src= "& Temp & "\loader.gif></center>"" "
fhta.WriteLine "    ProgressBar.InnerHTML = image"
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>"
wscript.Sleep 100
'***************************************************Programme Principal****************************************************************************
Dim OutFile, sDrv, sFName, sReport, sFile, sTitle ,strHTML
sTitle = "Recherche des Fichiers Par leurs Noms"
Set fso = CreateObject("Scripting.FileSystemObject")
OutFile = "Recherche.html"
If fso.FileExists(OutFile) Then fso.DeleteFile(OutFile)
 
Set sReport = fso.OpenTextFile(OutFile, 8, True)
sDrv = InputBox("Entrez la lettre du lecteur à la recherche (lettre seulement)" & vbcrlf&_
"ou bien " & vbcrlf & "(Saisissez * pour rechercher dans toutes les lettres de lecteur local)", sTitle)
If sDrv = "" Then WScript.Quit
 
sFName = InputBox ("Entrez le nom du fichier à rechercher (sans extension)", sTitle)
If sFName = "" Then WScript.Quit
Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")'Lançer la barre de Progression
strHTML="<html><body text=white><style type='text/css'>"&_
"a:link {color: #F19105;}"&_
"a:visited {color: #F19105;}"&_
"a:active {color: #F19105;}"&_
"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_
"</style>"
 
strHTML=strHTML &"<center><h2><B> <font color=Red>[COUNT] </font>Fichiers Trouvés dont le Nom est <font color=red>"""& sFName &""" </font> sur le lecteur <font color=red>"& UCase(sDrv) & ":</B></font></h2></center>"&_
"<center><body bgcolor=#1234568><table border='3' cellpadding='1' style='border-collapse: collapse; font size:11pt' bordercolor='#CCCCCC' width='100%' id='Table1'></center>" & _
"<td><center><strong>Chemin :</strong></center></td>"&_
"<td><center><strong>Date de Création :</strong></center></td>"& _
"<td><center><strong>Date de Modification :</strong></center></td>"&_
"<td><center><strong>Taille :</strong></center></td>"&_
"<td><center><strong>Attributs:</strong></center></td>"
 
If sDrv = "*" Then
    Dim  d,dc,racine
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set dc = fso.Drives
    For Each d in dc
        racine = d.Driveletter & ":"
        If d.IsReady Then
            GetResults racine , sFName    
        End If
    Next
Else
    GetResults sDrv & ":", sFName
End If
sReport.WriteLine strHTML &"</table></body></html>"
'Fermeture de la fenêtre d'attente (La barre de progression)
oExec.Terminate
Wscript.CreateObject("WScript.Shell").Run OutFile
 
Sub GetResults(drv, fname)  
    Dim sWQL, oFile, sAttrib,sFilePath,size
    ext = Array("png","jpg","jpeg","gif","bmp","psd","tif")
    sWQL = "select * from cim_datafile where Drive='" & _
    drv & "' AND FileName = '" & fname & "'" 
    Results = 0
    For Each oFile In GetObject("winmgmts:").execquery(sWQL)
        Results = Results + 1
        sFile = oFile.Name
        Set f = fso.GetFile(sFile)
 
        SizeKo = Round(FormatNumber(f.Size)/(1024),1) & " Ko" 'Taille en Ko avec 1 chiffre après la Virgule
        SizeMo = Round(FormatNumber(f.Size)/(1048576),1) & " Mo" 'Taille en Mo avec 1 chiffre après la Virgule
        SizeGo = Round(FormatNumber(f.Size)/(1073741824),1) & " Go" 'Taille en Go avec 1 chiffre après la Virgule
 
        If f.size < 1024 Then 
            Size = f.size & " Octets"
        elseif f.size < 1048576 Then 
            Size = SizeKo
        elseif f.size < 1073741824 Then 
            Size = SizeMo
        else
            Size = SizeGo
        end if
        sFilePath = f.Path
        If oFile.Archive Then sAttrib = "Archive "
        If oFile.Compressed Then sAttrib = sAttrib & " Compressé "
        If oFile.Encrypted Then sAttrib = sAttrib & " Crypté "
        If oFile.Hidden Then sAttrib = sAttrib & " Caché "
        If oFile.System Then sAttrib = sAttrib & " Système "
        If oFile.Readable Then sAttrib = sAttrib & " Lecture "
        If oFile.Writeable Then sAttrib = sAttrib & " Ecriture "
 
        If UCase(ext(0)) = UCase(fso.GetExtensionName(oFile.Name)) or UCase(ext(1)) = UCase(fso.GetExtensionName(oFile.Name))or UCase(ext(2)) = UCase(fso.GetExtensionName(oFile.Name)) or UCase(ext(3)) = UCase(fso.GetExtensionName(oFile.Name)) or UCase(ext(4)) = UCase(fso.GetExtensionName(oFile.Name)) or UCase(ext(5)) = UCase(fso.GetExtensionName(oFile.Name)) or UCase(ext(6)) = UCase(fso.GetExtensionName(oFile.Name)) Then
 
            ImgFileName = oFile.Name
            strHTML=strHTML & "<tr><td><a target=_Blank href='"& sFilePath &"'>"&ImgFileName&"<br><img src='"& sFilePath &"' border=1 height=50 width=80></center></td><td><center>" & f.DateCreated & "</center></td>" & _
            "<td><center>" & f.DateLastModified & "</center></td><td><center>"& Size & "</center></td>"&_
            "<td><center>" & sAttrib & "</center></td></tr>"
        else
            strHTML=strHTML & "<tr><td><a target=_Blank href='" & sFilePath & "'>" & _
            sFilePath & "</a></td><td><center>" & f.DateCreated & "</center></td>" & _
            "<td><center>" & f.DateLastModified & "</center></td><td><center>"& Size & "</center></td>"&_
            "<td><center>" & sAttrib & "</center></td></tr>"
        end if
    Next
    strHTML = Replace(strHTML, "[COUNT]", Results)
End Sub 
'****************************************************Fin du Programme Principal***********************************************************************
'47494638396180000F00F20000FFFFFFA2A9F6E9EBFCE2E4FBB9BFF8A2A9F600000000000021FF0B4E45545343415045322E30030100000021FE1A43726561746564207769746820616A61786C6F61642E696E666F0021F904090A0000002C0000000080000F000003E708B20BFEAC3D17C5A4F1AA7CABF61D3781A3089918B391AB5949A9FB96EC6B9DF58CCBB9DDF340D54E1823B68C365A107664FA744527B4798B56A94AE4343994FE9E57AE35EB5D86B7E86F590B5EBBCF6AB8992C67CFBB3EBA1EBF1FF3FF7E81587862838285886977878A760C039091031392919495930F98990E9B97959F92A1969A98A390A79C009B9EA5A0AEA2B0A49DA6B2A8B6AAADB4AFBBB1BDB3ABACBCC1C3BAC4BEC7C0C6CBB5BFB7CEB9CDC9C2A9D5B8D6D0D8D3D1C5D2CCC2CADEE2DDE4C8DFE6E3E8E5E0DAE7E1EBCFDBEDE9EFEAA2C3BF1AF8C9FAC8F917FB02FAE3077020A8040021F904090A0000002C0000000080000F000003FF08B40BFE22C607A5A0CE5EAC31E89CE581145949A318A24C5B6A5B06BF261C7FF3A9CA75CEEFB89EA6C5A0016D46944EF963068FBEA713B99C5405C4C635696D76A55FAAF7260693A3655B96C03D0BA1EF297A1E0FD32DEBB67ECB1FEFFD7D667F667981697772756E708C898D11858092828688768A83871A059C9D051403A1A203A0A3A1A5A6A8A3AAA2ACA70FA6AF0EB1A4B0B1AEB5B3B19E9DB8BEB6A9C0ABC2ADC4B200B4BFBAC1CBC3CDA2BC9CCAC8B7C6B9D4CCD8CEDAC5CFC7C9D6D3B4D19FE1E6DED7E0E8E2D5EBE7DCDFBBD1ECD9EAF0E9EDF7F4DBF6FDF2BCFBBAE97BE7AF5EBE82FC0EDE028821DB330F0EB941DCF6B021458916055664052001010021F904090A0000002C0000000080000F000003FF08B40BFEAC3D276A9DD40A0CF4C61E17829A58929699A257C44CAE948DF359AFF7F5787AFEF913DEAFC30BF2620458CC482336854C9B530ADD15ADCFAB0FA974457153701588A56AC33DF470ACE6429665F1994D9FDBB378B3C7EDE0ABBF697579728381777A1A7E7E8288848D86856B878E168A7064987F71908F9291809E1A05A3A40513A5A41303ABAC03AAADABAFB0B2ADB4ACB6B10FB0B90EBBAEBABBB803A8A3A7C4C2C8C0B3CAB5CCB7CEBC00BEC9BDC1D0C3C70FC4A6D7D4D2D6D5CBE1CDE3CFE5D1D3DDD7DBC6A8DEE9E7BFF1EFE0DFE2F6E4F8E6FAABECDAD9F3D4051CC84F5E417AF7E015F4E780E141810F092A9C588F62C260EE3064B4C5E10F5EB98EF93E62F0A80FE43E911C13000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C97422E70BF4BE9EC085A3576AE73791A05949D43BBDD613AADDBDEA368FF939D64F1834F542B4990CB21C1A9DA8E3B31885E26E2269957ABD2599156558DB25627766E0999CB5B6B9826F6C3C8FA0A76BF77D9B87EFCB785E4D0A83727E6C7F6F7D8B6A8D6948859174877A88969598949A58869D838C8F81A17C8EA2A61A05A9AA0513ABAAADAEAC0F03B4B50313B6B5B8B9B7B3BCBBB9C0B6C2BABEC1C6B6B1B20ECAB0AEC4B4D0BD0EBCD300D5D2D9C8C5D4BFDBB4CD0FE1CCB1DADDC7E7C3DFD6D8EBE6D7DEE9B5E300F4F4EDF2D1EEFBF9ECF1F0E800AAEB67AF9C3883FDDEE113C88DA1BE84FC1CFACB55F0D9418B10334A54F86F1AA1C78EBF305E4CC541A43C0E014F5E48C910E5C06D2E1B9E4C000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F102C1B9EEDE050A1F587667388D2959495835BD16F4AE23F9E4BAC3E3AC5D0E6812067D39DAEC66933533C622F2B8194651575595FACB0A944FC6D219834EA55B74F78C656BD7E9769C032E8BC33005D3DD9BF7E180567C44723C757A6488668A77835E846F827E907F92867B8C798787815C969F9EA16A49989BA5989DA3A285A0AAAE1D05B1B20513B3B2B5B6B40FB9BA0E03BFC00313C1C0C3C4C20FC7C8BEC7C6C4CEC1D0C0BCB8B6D5B3D7B7C9CDDBCFDDD1DFC5E1BFD2E4E3CB00CAD4BBB9D9B1EEBDE9DCCCDEF4E0F6E2F8E6FAE8CAE503EB1C04043070A0BF73FF12225CC8EF5FC176ECAC45C4C6505E3D8BF730E6D3B88F2B63BF791E1F4A140891E4488F0A1B563CA8B225CA9326DF5D804990A2340D17F1E1CCA8F3424E8D3B8B25000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7C85F7DA07766258929F99A2602561D5E45A902BDB8FB83AFAC8F7939E2008CC157FBAD92D5663C2384F0651373D21AD006175973D7693B8E86BE32443CD5223558DD5B2B9EE2BBCA76C9EEB625A7EEBFBB6BD717E736B721E786863878A61827D818F8091848D028B6596778C90939B7F9C922298697B76A3887A947C436F8EA0839E2205B2B30513B4B3B6B7B50FBABB0EBD1303C2C303C1C4C2C6C7C9C4CBC3CDC80FC7C2C0BCBAB9B7D7B4D9B8D1D2CFC5DDCAE1CCE3CEE5D00ED203D4BFD6D5D8EFDAF1DCE9DEE7E0F5E2F9E4FBE6FDE800D4B10330B0A0BB76F0FEE10B684FE1B787F7BE194C48F060458A03D5417418B12D23478513E52114799164C6860CF5A5E4B7D25F4B801A23521CE96B9E8699256BF6D3A072E7859E2D79B2DC99000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CAB1620F885C2189AE245962AB9795065C53056BF9C9D036BEAF4AC5F6F02240E1F40D94CC798289D32E8ED893C0A57466C557B756D4954A644BCC43569BB30CFBAE6B6BDDDD3571E07A9EF51F4992CDD15E73E6F7482817F75027853797C7A63668E8684419259709480888B8F6589699A6A91A16CA26E499FA78AA99E37A496AD83AF2005B3B40513B5B4B7B8B60FBBBC0EBEBAB81303C5C603C4C7C5C9CACCC7CEC6D0C5C1BDBBC2B5D7B9D5C3DBD80FCACBDFE0D2C8E2CDE6CFE8C6D4C0D6DDDAEDDCF1DEF3F000E0E50EF8E4FCEAE1FAE0D8011048D05DBD59D910FACB776FDCC27E00CF453C5650DE4083172D56A4D7503362C77413A33D1C19721AC68DF6502A3CF8EBA3C8920CF79174F98F26328BF534E0CCB8F29D4E8E2135780C7A61A84BA1CF12000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF697208ADA48866699A2E30662AFCBC1B3CC4C9544DF8FD9F63EC1242804FA86C19C0592C3359931A533FA74109147E3CA1AC49AA4D01A78A7B395C7E62537BBDE02AEDA5F7B84AE57D353F11D0D9F9FFC45805E747B8554877A883C82717F6F5D8D818F3E768A678689998B936E7D9C729F8E44959A97966A78619B9EAC908C8005B1B20513B3B2B5B6B40FB9BA0EBCB8B6C0B31303C5C603C4C7C5C9CACCC7CEC6BFBBB9C2B7D3C1D7C3D9D6BED40FCACBDFE0D0E10EE0C8E2CAD2DDD8ECDAEEDC00EBF2DEF0B1E4E8E6E3E9CFFCC6F8F302D6A3D78EE03B83F1E69DC3C7D05F3900E7041694789062C2810B1DE683B84F2E5F338D16EF6D1369AF174292274D2AECC8F1A3C77E2FFF6944A8A120BC9A076F5EB049F3824B7F1A7EC60CFA2C010021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D370924A995E6850A27BA8118FC8A333355524CE316848F2BD623287410812BDEEDE793299B3BA6CE06A51A8348D710BB4D4A6B39706F1A7E92C7E2A5ECD8D55E57D992395D2D7FE7F8FB97FD7603F87F41794E7A848651875681706D2571297D728588948A8395766B5C91908B7E44979693A28999986880A99B9E2505AEAF0513B0AFB2B3B10FB6B70EB9B5B3BDB0BFB40F03C4C50313C6C5C8C9C7C3CCBCB8B6C1AED3BA00D0BBD2D1BEDBC0CEC9CBE0DFC6E1C6D8D7DAD9DCEADEECC2EED4DDEFE8EB00CCCD0EF7E5CAE3C5E7FFE9E8B513380F60BD73FAFA11DBB750E100830321160C28311E3C6B09F3316388CF27DE338A200F868C387262BD8C1EC5695499925C3D771A5E128C3910E605993259AE6CB84F03B8040021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D378193609ADA895EAAB091AF1833636541760DDB37B6E78FD6CA217405853C9D2C89FB3997401F14562C09AD2DA694D69C7AB95B49B8371397C9D5630BABD29E95E07737EEAE47E5C4AB5AC53ED99F74777F5F66837169796B7B7E828D80858E8464866688009645949391818F9B9E70957A897C8B2605A8A90513AAA9ACADAB0FB0B10EB3AFADB7AAB9AEB2B01303C0C103BFC2C0C4C5B6BDB8CABACCBCB5BECEA8BBD3D2B400C90EC5C60FDBC3DDDBD9D8D1D0CBE5CDE7CFE3E6EBE8EDEAE2DEC7C2F3C1E2F7E4EFD5E9FBFAD7F8ECE26DABC74D5BB87C00DD258487B061C07CF2C015233860613F8BFF1C2AD4C8901B5D44831325D263974E03C97726DD95BC70B2A54A0021EB699898000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D3781A3F80828AAA56A2561E416BB16E496F36DE7BCC9A6931F8A86331177461D2CD963149D48A84328080A8F4BA98CC9D562B75E25F835AE4D85D6DF772D6637C9EE2E5C4C4DB3E2E1B7B9FC9CEBFB7B5F7527576D867F517E7281878B7640846A8D798E898C88598A945A83673F05A0A10513A2A1A4A5A30FA8A90EABA7A5AFA2B1A6AAA8B3A01303BABB03B9BCBAAEB5B0C2B2C4B4ADB6C6B8CAAC00C1C8C3D0C50EBFBABEBFCFCEC9D2C7DAD1DED3E0DDD9E4DBE2CBD4D5D7BCE5DFEDE1EFE3E6F1E8E7CDD5BD0FF8F4CDFCB7FDF302BA13180EDFBA5DFE98FD5BA8B021B77A09D3FD3A68ED1B370D16C5610C77F10C42C68F1C355E9838921780040021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D3781A308998EA0AA1BD99A9584B9B175D27189EF70FEACC09AAEC7630C8D37A212395BCA5E4C0070254C46ABCDAB2FFBC442BBDBAF8D3B964E05DE74585D04B7CB6C67F98C5EDBDF47B73C0FBFEF7F67715A78567A837F647C8A805382868F7D8489859188621374059A9B05139C9B9E9F9D0FA2A30EA5A19FA99CABA0A4A2AD9AB1A60003B6B703A8AFAABBACBDAEA7B0BFB2C3B4BAC1BCC8BECAC0B5B8B6C700D1D3C2CCC4D6C6D5D2DAD4C9DBDECFD0DCE3DEDDCBDFE7E6CDEAD7E8CDE1B9E4E9F2EBF4EDECD9E5F6B4F0F8B3FFC5006213E8EEDEBE09F0DC69F0C66CE1B98617182A8CF870622B87CD1C3C0390000021F904090A0000002C0000000080000F000003E708B40BFEAC3D17C9A4F1AA7CABF61D3781A3089918B391AB5949A9FB96EC6B9DF58CCBB9DDF340D54E1823B68C365A107664FA744527B4798B56A94AE4343994FE9E57AE35EB5D86B7E86F590B5EBBCF6AB8992C67CFBB3EBA1EBF1FF3FF7E81587862838285886977878A760C059091051392919495930F98990E9B97959F92A1969A98A390A79C009B9EA5A0AEA2B0A49DA6B2A8B6AAADB4AFBBB1BDB3ABACBCC1C3BAC4BEC7C0C6CBB5BFB7CEB9CDC9C2A9D5B8D6D0D8D3D1C5D2CCC2CADEE2DDE4C8DFE6E3E8E5E0DAE7E1EBCFDBEDE9EFEAA2C3BF1AF8C9FAC8F917FB02FAE3077020A804003B000000000000000000

05/09/2013, 12h15
sovan

Oula ça me dépasse tes scripts, c'est un peu compliqué Hackoofr

Je suis juste un techniciens N2, je voulais créer une utilitaire pour facilité la vie :D

En tout cas merci Hackoofr , je vais essayer de bidouiller tout ça :mouarf:

Et merci Cachlab.

:salut:
Voila, j'ai voulu simplifier au maximum avec cet exemple : Détermination de l'itinéraire vers les URL(s) avec la commande DOS "Tracert" saisi par l'utilisateur dans l'InputBox animé par une barre de progression :king:

Code:

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
'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 
'*********************************Déclaration des variables globales*******************************
Option Explicit
Dim oExec,fso,ws,Temp
Set ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject") 
Temp = ws.ExpandEnvironmentStrings("%Temp%")
'**************************************************************************************************
'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
    MsgTitre = "Traceroute d'une URL © Hackoo © 2013"
    StrCommand = "Tracert"
    Argum = InputBox("Taper l'adresse d'une URL pour déterminer son itinéraire avec la commande DOS "& DblQuote("Tracert"),MsgTitre,"www.developpez.com")
    StrCommand = "Tracert"
    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 ..."
    Call CreateProgressBar(Titre)'Creation de barre de progression
    Call LancerProgressBar()'Lancement de la barre de progression
    Res = Ws.Run(Command,0,True)'Exécution de la Commande
    Call Formater(LogFile)'Pour formater et remplacer les caractères spéciaux unicode dans le LogFile
    Call FermerProgressBar()'Fermeture de barre de progression
    ws.popup "La TraceRoute vers "& DblQuote(Argum) &" est terminé ","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)
    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")
    Set f = fso.GetFile(WScript.ScriptFullName)
    Set ts = f.OpenAsTextStream(1,-2)
    Set fread = Fso.OpenTextFile(f,1)
    LireTout = fread.ReadAll
    NbLigneTotal = fread.Line 
    Temp = WS.ExpandEnvironmentStrings("%Temp%")
    PathOutPutHTML = Temp & "\Barre.hta"
    Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
    fso.CreateTextFile Temp & "\loader.gif"
    Set f2 = fso.GetFile(Temp & "\loader.gif")
    Set ts2 = f2.OpenAsTextStream(2,-2)
    for i=1 to NbLigneTotal - 1
        ts.skipline
    Next
    Do
        Ligne = ts.readline
        For i=2 to Len(Ligne) step 2
            ts2.write chr( "&h" & mid(Ligne,i,2))
        Next
    loop until ts.AtEndOfStream
    ts.Close
    ts2.Close
    fhta.WriteLine "<HTML>"
    fhta.WriteLine "<HEAD>" 
    fhta.WriteLine "<Title>" & Titre & "</Title>" 
    fhta.WriteLine "<HTA:APPLICATION"
    fhta.WriteLine "ICON = ""Cmd.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 "</HEAD>" 
    fhta.WriteLine "<BODY text=""white""><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN><span> Veuillez Patientez !</span></DIV></CENTER></BODY></HTML>"
    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 320,90"
    fhta.WriteLine "    Self.document.bgColor = ""Orange"" "
    fhta.WriteLine "    image = ""<center><img src= "& Temp & "\loader.gif></center>"" "
    fhta.WriteLine "    ProgressBar.InnerHTML = image"
    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>"
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
'************************************************************************************************
'47494638396180000F00F20000F3D9DDF15279F2BBC6F2B0BEF17492F1527900000000000021FF0B4E45545343415045322E30030100000021FE1A43726561746564207769746820616A61786C6F61642E696E666F0021F904090A0000002C0000000080000F000003E708B20BFEAC3D17C5A4F1AA7CABF61D3781A3089918B391AB5949A9FB96EC6B9DF58CCBB9DDF340D54E1823B68C365A107664FA744527B4798B56A94AE4343994FE9E57AE35EB5D86B7E86F590B5EBBCF6AB8992C67CFBB3EBA1EBF1FF3FF7E81587862838285886977878A760C039091031392919495930F98990E9B97959F92A1969A98A390A79C009B9EA5A0AEA2B0A49DA6B2A8B6AAADB4AFBBB1BDB3ABACBCC1C3BAC4BEC7C0C6CBB5BFB7CEB9CDC9C2A9D5B8D6D0D8D3D1C5D2CCC2CADEE2DDE4C8DFE6E3E8E5E0DAE7E1EBCFDBEDE9EFEAA2C3BF1AF8C9FAC8F917FB02FAE3077020A8040021F904090A0000002C0000000080000F000003FF08B40BFE22C607A5A0CE5EAC31E89CE581145949A318A24C5B6A5B06BF261C7FF3A9CA75CEEFB89EA6C5A0016D46944EF963068FBEA713B99C5405C4C635696D76A55FAAF7260693A3655B96C03D0BA1EF297A1E0FD32DEBB67ECB1FEFFD7D667F667981697772756E708C898D11858092828688768A83871A059C9D051403A1A203A0A3A1A5A6A8A3AAA2ACA70FA6AF0EB1A4B0B1AEB5B3B19E9DB8BEB6A9C0ABC2ADC4B200B4BFBAC1CBC3CDA2BC9CCAC8B7C6B9D4CCD8CEDAC5CFC7C9D6D3B4D19FE1E6DED7E0E8E2D5EBE7DCDFBBD1ECD9EAF0E9EDF7F4DBF6FDF2BCFBBAE97BE7AF5EBE82FC0EDE028821DB330F0EB941DCF6B021458916055664052001010021F904090A0000002C0000000080000F000003FF08B40BFEAC3D276A9DD40A0CF4C61E17829A58929699A257C44CAE948DF359AFF7F5787AFEF913DEAFC30BF2620458CC482336854C9B530ADD15ADCFAB0FA974457153701588A56AC33DF470ACE6429665F1994D9FDBB378B3C7EDE0ABBF697579728381777A1A7E7E8288848D86856B878E168A7064987F71908F9291809E1A05A3A40513A5A41303ABAC03AAADABAFB0B2ADB4ACB6B10FB0B90EBBAEBABBB803A8A3A7C4C2C8C0B3CAB5CCB7CEBC00BEC9BDC1D0C3C70FC4A6D7D4D2D6D5CBE1CDE3CFE5D1D3DDD7DBC6A8DEE9E7BFF1EFE0DFE2F6E4F8E6FAABECDAD9F3D4051CC84F5E417AF7E015F4E780E141810F092A9C588F62C260EE3064B4C5E10F5EB98EF93E62F0A80FE43E911C13000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C97422E70BF4BE9EC085A3576AE73791A05949D43BBDD613AADDBDEA368FF939D64F1834F542B4990CB21C1A9DA8E3B31885E26E2269957ABD2599156558DB25627766E0999CB5B6B9826F6C3C8FA0A76BF77D9B87EFCB785E4D0A83727E6C7F6F7D8B6A8D6948859174877A88969598949A58869D838C8F81A17C8EA2A61A05A9AA0513ABAAADAEAC0F03B4B50313B6B5B8B9B7B3BCBBB9C0B6C2BABEC1C6B6B1B20ECAB0AEC4B4D0BD0EBCD300D5D2D9C8C5D4BFDBB4CD0FE1CCB1DADDC7E7C3DFD6D8EBE6D7DEE9B5E300F4F4EDF2D1EEFBF9ECF1F0E800AAEB67AF9C3883FDDEE113C88DA1BE84FC1CFACB55F0D9418B10334A54F86F1AA1C78EBF305E4CC541A43C0E014F5E48C910E5C06D2E1B9E4C000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F102C1B9EEDE050A1F587667388D2959495835BD16F4AE23F9E4BAC3E3AC5D0E6812067D39DAEC66933533C622F2B8194651575595FACB0A944FC6D219834EA55B74F78C656BD7E9769C032E8BC33005D3DD9BF7E180567C44723C757A6488668A77835E846F827E907F92867B8C798787815C969F9EA16A49989BA5989DA3A285A0AAAE1D05B1B20513B3B2B5B6B40FB9BA0E03BFC00313C1C0C3C4C20FC7C8BEC7C6C4CEC1D0C0BCB8B6D5B3D7B7C9CDDBCFDDD1DFC5E1BFD2E4E3CB00CAD4BBB9D9B1EEBDE9DCCCDEF4E0F6E2F8E6FAE8CAE503EB1C04043070A0BF73FF12225CC8EF5FC176ECAC45C4C6505E3D8BF730E6D3B88F2B63BF791E1F4A140891E4488F0A1B563CA8B225CA9326DF5D804990A2340D17F1E1CCA8F3424E8D3B8B25000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7C85F7DA07766258929F99A2602561D5E45A902BDB8FB83AFAC8F7939E2008CC157FBAD92D5663C2384F0651373D21AD006175973D7693B8E86BE32443CD5223558DD5B2B9EE2BBCA76C9EEB625A7EEBFBB6BD717E736B721E786863878A61827D818F8091848D028B6596778C90939B7F9C922298697B76A3887A947C436F8EA0839E2205B2B30513B4B3B6B7B50FBABB0EBD1303C2C303C1C4C2C6C7C9C4CBC3CDC80FC7C2C0BCBAB9B7D7B4D9B8D1D2CFC5DDCAE1CCE3CEE5D00ED203D4BFD6D5D8EFDAF1DCE9DEE7E0F5E2F9E4FBE6FDE800D4B10330B0A0BB76F0FEE10B684FE1B787F7BE194C48F060458A03D5417418B12D23478513E52114799164C6860CF5A5E4B7D25F4B801A23521CE96B9E8699256BF6D3A072E7859E2D79B2DC99000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CAB1620F885C2189AE245962AB9795065C53056BF9C9D036BEAF4AC5F6F02240E1F40D94CC798289D32E8ED893C0A57466C557B756D4954A644BCC43569BB30CFBAE6B6BDDDD3571E07A9EF51F4992CDD15E73E6F7482817F75027853797C7A63668E8684419259709480888B8F6589699A6A91A16CA26E499FA78AA99E37A496AD83AF2005B3B40513B5B4B7B8B60FBBBC0EBEBAB81303C5C603C4C7C5C9CACCC7CEC6D0C5C1BDBBC2B5D7B9D5C3DBD80FCACBDFE0D2C8E2CDE6CFE8C6D4C0D6DDDAEDDCF1DEF3F000E0E50EF8E4FCEAE1FAE0D8011048D05DBD59D910FACB776FDCC27E00CF453C5650DE4083172D56A4D7503362C77413A33D1C19721AC68DF6502A3CF8EBA3C8920CF79174F98F26328BF534E0CCB8F29D4E8E2135780C7A61A84BA1CF12000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF697208ADA48866699A2E30662AFCBC1B3CC4C9544DF8FD9F63EC1242804FA86C19C0592C3359931A533FA74109147E3CA1AC49AA4D01A78A7B395C7E62537BBDE02AEDA5F7B84AE57D353F11D0D9F9FFC45805E747B8554877A883C82717F6F5D8D818F3E768A678689998B936E7D9C729F8E44959A97966A78619B9EAC908C8005B1B20513B3B2B5B6B40FB9BA0EBCB8B6C0B31303C5C603C4C7C5C9CACCC7CEC6BFBBB9C2B7D3C1D7C3D9D6BED40FCACBDFE0D0E10EE0C8E2CAD2DDD8ECDAEEDC00EBF2DEF0B1E4E8E6E3E9CFFCC6F8F302D6A3D78EE03B83F1E69DC3C7D05F3900E7041694789062C2810B1DE683B84F2E5F338D16EF6D1369AF174292274D2AECC8F1A3C77E2FFF6944A8A120BC9A076F5EB049F3824B7F1A7EC60CFA2C010021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D370924A995E6850A27BA8118FC8A333355524CE316848F2BD623287410812BDEEDE793299B3BA6CE06A51A8348D710BB4D4A6B39706F1A7E92C7E2A5ECD8D55E57D992395D2D7FE7F8FB97FD7603F87F41794E7A848651875681706D2571297D728588948A8395766B5C91908B7E44979693A28999986880A99B9E2505AEAF0513B0AFB2B3B10FB6B70EB9B5B3BDB0BFB40F03C4C50313C6C5C8C9C7C3CCBCB8B6C1AED3BA00D0BBD2D1BEDBC0CEC9CBE0DFC6E1C6D8D7DAD9DCEADEECC2EED4DDEFE8EB00CCCD0EF7E5CAE3C5E7FFE9E8B513380F60BD73FAFA11DBB750E100830321160C28311E3C6B09F3316388CF27DE338A200F868C387262BD8C1EC5695499925C3D771A5E128C3910E605993259AE6CB84F03B8040021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D378193609ADA895EAAB091AF1833636541760DDB37B6E78FD6CA217405853C9D2C89FB3997401F14562C09AD2DA694D69C7AB95B49B8371397C9D5630BABD29E95E07737EEAE47E5C4AB5AC53ED99F74777F5F66837169796B7B7E828D80858E8464866688009645949391818F9B9E70957A897C8B2605A8A90513AAA9ACADAB0FB0B10EB3AFADB7AAB9AEB2B01303C0C103BFC2C0C4C5B6BDB8CABACCBCB5BECEA8BBD3D2B400C90EC5C60FDBC3DDDBD9D8D1D0CBE5CDE7CFE3E6EBE8EDEAE2DEC7C2F3C1E2F7E4EFD5E9FBFAD7F8ECE26DABC74D5BB87C00DD258487B061C07CF2C015233860613F8BFF1C2AD4C8901B5D44831325D263974E03C97726DD95BC70B2A54A0021EB699898000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D3781A3F80828AAA56A2561E416BB16E496F36DE7BCC9A6931F8A86331177461D2CD963149D48A84328080A8F4BA98CC9D562B75E25F835AE4D85D6DF772D6637C9EE2E5C4C4DB3E2E1B7B9FC9CEBFB7B5F7527576D867F517E7281878B7640846A8D798E898C88598A945A83673F05A0A10513A2A1A4A5A30FA8A90EABA7A5AFA2B1A6AAA8B3A01303BABB03B9BCBAAEB5B0C2B2C4B4ADB6C6B8CAAC00C1C8C3D0C50EBFBABEBFCFCEC9D2C7DAD1DED3E0DDD9E4DBE2CBD4D5D7BCE5DFEDE1EFE3E6F1E8E7CDD5BD0FF8F4CDFCB7FDF302BA13180EDFBA5DFE98FD5BA8B021B77A09D3FD3A68ED1B370D16C5610C77F10C42C68F1C355E9838921780040021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D3781A308998EA0AA1BD99A9584B9B175D27189EF70FEACC09AAEC7630C8D37A212395BCA5E4C0070254C46ABCDAB2FFBC442BBDBAF8D3B964E05DE74585D04B7CB6C67F98C5EDBDF47B73C0FBFEF7F67715A78567A837F647C8A805382868F7D8489859188621374059A9B05139C9B9E9F9D0FA2A30EA5A19FA99CABA0A4A2AD9AB1A60003B6B703A8AFAABBACBDAEA7B0BFB2C3B4BAC1BCC8BECAC0B5B8B6C700D1D3C2CCC4D6C6D5D2DAD4C9DBDECFD0DCE3DEDDCBDFE7E6CDEAD7E8CDE1B9E4E9F2EBF4EDECD9E5F6B4F0F8B3FFC5006213E8EEDEBE09F0DC69F0C66CE1B98617182A8CF870622B87CD1C3C0390000021F904090A0000002C0000000080000F000003E708B40BFEAC3D17C9A4F1AA7CABF61D3781A3089918B391AB5949A9FB96EC6B9DF58CCBB9DDF340D54E1823B68C365A107664FA744527B4798B56A94AE4343994FE9E57AE35EB5D86B7E86F590B5EBBCF6AB8992C67CFBB3EBA1EBF1FF3FF7E81587862838285886977878A760C059091051392919495930F98990E9B97959F92A1969A98A390A79C009B9EA5A0AEA2B0A49DA6B2A8B6AAADB4AFBBB1BDB3ABACBCC1C3BAC4BEC7C0C6CBB5BFB7CEB9CDC9C2A9D5B8D6D0D8D3D1C5D2CCC2CADEE2DDE4C8DFE6E3E8E5E0DAE7E1EBCFDBEDE9EFEAA2C3BF1AF8C9FAC8F917FB02FAE3077020A804003B000000000000000000

:salut:
une petite mise à jour : Ajout d'un message d'attente animé par la balise <marquee>

Code:

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
'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 07/09/2013 : Ajout d'un message d'attente animé par la balise <marquee>
'*********************************Déclaration des variables globales*******************************
Option Explicit
Dim oExec,fso,ws,Temp
Set ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject") 
Temp = ws.ExpandEnvironmentStrings("%Temp%")
'**************************************************************************************************
'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
	MsgTitre = "Traceroute d'une URL © Hackoo © 2013"
	StrCommand = "Tracert"
	Argum = InputBox("Taper l'adresse d'une URL pour déterminer son itinéraire avec la commande DOS "& DblQuote("Tracert"),MsgTitre,"www.developpez.com")
	StrCommand = "Tracert"
	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 ..."
	MsgAttente = "Veuillez patientez !"
	Call CreateProgressBar(Titre,MsgAttente)'Creation de barre de progression
	Call LancerProgressBar()'Lancement de la barre de progression
	Res = Ws.Run(Command,0,True)'Exécution de la Commande
	Call Formater(LogFile)'Pour formater et remplacer les caractères spéciaux dans le LogFile
	Call FermerProgressBar()'Fermeture de barre de progression
	ws.popup "La TraceRoute vers "& DblQuote(Argum) &" est terminé ","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")
	Set f = fso.GetFile(WScript.ScriptFullName)
	Set ts = f.OpenAsTextStream(1,-2)
	Set fread = Fso.OpenTextFile(f,1)
	LireTout = fread.ReadAll
	NbLigneTotal = fread.Line 
	Temp = WS.ExpandEnvironmentStrings("%Temp%")
	PathOutPutHTML = Temp & "\Barre.hta"
	Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
	fso.CreateTextFile Temp & "\loader.gif"
	Set f2 = fso.GetFile(Temp & "\loader.gif")
	Set ts2 = f2.OpenAsTextStream(2,-2)
	for i=1 to NbLigneTotal - 1
		ts.skipline
	Next
	Do
		Ligne = ts.readline
		For i=2 to Len(Ligne) step 2
			ts2.write chr( "&h" & mid(Ligne,i,2))
		Next
	loop until ts.AtEndOfStream
	ts.Close
	ts2.Close
	fhta.WriteLine "<HTML>"
	fhta.WriteLine "<HEAD>" 
	fhta.WriteLine "<Title>" & Titre & "</Title>" 
	fhta.WriteLine "<HTA:APPLICATION"
	fhta.WriteLine "ICON = ""Cmd.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 "</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 &" "& Titre & "</font></marquee></span></DIV></CENTER></BODY></HTML>"
	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 320,90"
	fhta.WriteLine "    Self.document.bgColor = ""Orange"" "
	fhta.WriteLine "    image = ""<center><img src= "& Temp & "\loader.gif></center>"" "
	fhta.WriteLine "    ProgressBar.InnerHTML = image"
	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>"
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
'************************************************************************************************
'47494638396180000F00F20000F3D9DDF15279F2BBC6F2B0BEF17492F1527900000000000021FF0B4E45545343415045322E30030100000021FE1A43726561746564207769746820616A61786C6F61642E696E666F0021F904090A0000002C0000000080000F000003E708B20BFEAC3D17C5A4F1AA7CABF61D3781A3089918B391AB5949A9FB96EC6B9DF58CCBB9DDF340D54E1823B68C365A107664FA744527B4798B56A94AE4343994FE9E57AE35EB5D86B7E86F590B5EBBCF6AB8992C67CFBB3EBA1EBF1FF3FF7E81587862838285886977878A760C039091031392919495930F98990E9B97959F92A1969A98A390A79C009B9EA5A0AEA2B0A49DA6B2A8B6AAADB4AFBBB1BDB3ABACBCC1C3BAC4BEC7C0C6CBB5BFB7CEB9CDC9C2A9D5B8D6D0D8D3D1C5D2CCC2CADEE2DDE4C8DFE6E3E8E5E0DAE7E1EBCFDBEDE9EFEAA2C3BF1AF8C9FAC8F917FB02FAE3077020A8040021F904090A0000002C0000000080000F000003FF08B40BFE22C607A5A0CE5EAC31E89CE581145949A318A24C5B6A5B06BF261C7FF3A9CA75CEEFB89EA6C5A0016D46944EF963068FBEA713B99C5405C4C635696D76A55FAAF7260693A3655B96C03D0BA1EF297A1E0FD32DEBB67ECB1FEFFD7D667F667981697772756E708C898D11858092828688768A83871A059C9D051403A1A203A0A3A1A5A6A8A3AAA2ACA70FA6AF0EB1A4B0B1AEB5B3B19E9DB8BEB6A9C0ABC2ADC4B200B4BFBAC1CBC3CDA2BC9CCAC8B7C6B9D4CCD8CEDAC5CFC7C9D6D3B4D19FE1E6DED7E0E8E2D5EBE7DCDFBBD1ECD9EAF0E9EDF7F4DBF6FDF2BCFBBAE97BE7AF5EBE82FC0EDE028821DB330F0EB941DCF6B021458916055664052001010021F904090A0000002C0000000080000F000003FF08B40BFEAC3D276A9DD40A0CF4C61E17829A58929699A257C44CAE948DF359AFF7F5787AFEF913DEAFC30BF2620458CC482336854C9B530ADD15ADCFAB0FA974457153701588A56AC33DF470ACE6429665F1994D9FDBB378B3C7EDE0ABBF697579728381777A1A7E7E8288848D86856B878E168A7064987F71908F9291809E1A05A3A40513A5A41303ABAC03AAADABAFB0B2ADB4ACB6B10FB0B90EBBAEBABBB803A8A3A7C4C2C8C0B3CAB5CCB7CEBC00BEC9BDC1D0C3C70FC4A6D7D4D2D6D5CBE1CDE3CFE5D1D3DDD7DBC6A8DEE9E7BFF1EFE0DFE2F6E4F8E6FAABECDAD9F3D4051CC84F5E417AF7E015F4E780E141810F092A9C588F62C260EE3064B4C5E10F5EB98EF93E62F0A80FE43E911C13000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C97422E70BF4BE9EC085A3576AE73791A05949D43BBDD613AADDBDEA368FF939D64F1834F542B4990CB21C1A9DA8E3B31885E26E2269957ABD2599156558DB25627766E0999CB5B6B9826F6C3C8FA0A76BF77D9B87EFCB785E4D0A83727E6C7F6F7D8B6A8D6948859174877A88969598949A58869D838C8F81A17C8EA2A61A05A9AA0513ABAAADAEAC0F03B4B50313B6B5B8B9B7B3BCBBB9C0B6C2BABEC1C6B6B1B20ECAB0AEC4B4D0BD0EBCD300D5D2D9C8C5D4BFDBB4CD0FE1CCB1DADDC7E7C3DFD6D8EBE6D7DEE9B5E300F4F4EDF2D1EEFBF9ECF1F0E800AAEB67AF9C3883FDDEE113C88DA1BE84FC1CFACB55F0D9418B10334A54F86F1AA1C78EBF305E4CC541A43C0E014F5E48C910E5C06D2E1B9E4C000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F102C1B9EEDE050A1F587667388D2959495835BD16F4AE23F9E4BAC3E3AC5D0E6812067D39DAEC66933533C622F2B8194651575595FACB0A944FC6D219834EA55B74F78C656BD7E9769C032E8BC33005D3DD9BF7E180567C44723C757A6488668A77835E846F827E907F92867B8C798787815C969F9EA16A49989BA5989DA3A285A0AAAE1D05B1B20513B3B2B5B6B40FB9BA0E03BFC00313C1C0C3C4C20FC7C8BEC7C6C4CEC1D0C0BCB8B6D5B3D7B7C9CDDBCFDDD1DFC5E1BFD2E4E3CB00CAD4BBB9D9B1EEBDE9DCCCDEF4E0F6E2F8E6FAE8CAE503EB1C04043070A0BF73FF12225CC8EF5FC176ECAC45C4C6505E3D8BF730E6D3B88F2B63BF791E1F4A140891E4488F0A1B563CA8B225CA9326DF5D804990A2340D17F1E1CCA8F3424E8D3B8B25000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7C85F7DA07766258929F99A2602561D5E45A902BDB8FB83AFAC8F7939E2008CC157FBAD92D5663C2384F0651373D21AD006175973D7693B8E86BE32443CD5223558DD5B2B9EE2BBCA76C9EEB625A7EEBFBB6BD717E736B721E786863878A61827D818F8091848D028B6596778C90939B7F9C922298697B76A3887A947C436F8EA0839E2205B2B30513B4B3B6B7B50FBABB0EBD1303C2C303C1C4C2C6C7C9C4CBC3CDC80FC7C2C0BCBAB9B7D7B4D9B8D1D2CFC5DDCAE1CCE3CEE5D00ED203D4BFD6D5D8EFDAF1DCE9DEE7E0F5E2F9E4FBE6FDE800D4B10330B0A0BB76F0FEE10B684FE1B787F7BE194C48F060458A03D5417418B12D23478513E52114799164C6860CF5A5E4B7D25F4B801A23521CE96B9E8699256BF6D3A072E7859E2D79B2DC99000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CAB1620F885C2189AE245962AB9795065C53056BF9C9D036BEAF4AC5F6F02240E1F40D94CC798289D32E8ED893C0A57466C557B756D4954A644BCC43569BB30CFBAE6B6BDDDD3571E07A9EF51F4992CDD15E73E6F7482817F75027853797C7A63668E8684419259709480888B8F6589699A6A91A16CA26E499FA78AA99E37A496AD83AF2005B3B40513B5B4B7B8B60FBBBC0EBEBAB81303C5C603C4C7C5C9CACCC7CEC6D0C5C1BDBBC2B5D7B9D5C3DBD80FCACBDFE0D2C8E2CDE6CFE8C6D4C0D6DDDAEDDCF1DEF3F000E0E50EF8E4FCEAE1FAE0D8011048D05DBD59D910FACB776FDCC27E00CF453C5650DE4083172D56A4D7503362C77413A33D1C19721AC68DF6502A3CF8EBA3C8920CF79174F98F26328BF534E0CCB8F29D4E8E2135780C7A61A84BA1CF12000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF697208ADA48866699A2E30662AFCBC1B3CC4C9544DF8FD9F63EC1242804FA86C19C0592C3359931A533FA74109147E3CA1AC49AA4D01A78A7B395C7E62537BBDE02AEDA5F7B84AE57D353F11D0D9F9FFC45805E747B8554877A883C82717F6F5D8D818F3E768A678689998B936E7D9C729F8E44959A97966A78619B9EAC908C8005B1B20513B3B2B5B6B40FB9BA0EBCB8B6C0B31303C5C603C4C7C5C9CACCC7CEC6BFBBB9C2B7D3C1D7C3D9D6BED40FCACBDFE0D0E10EE0C8E2CAD2DDD8ECDAEEDC00EBF2DEF0B1E4E8E6E3E9CFFCC6F8F302D6A3D78EE03B83F1E69DC3C7D05F3900E7041694789062C2810B1DE683B84F2E5F338D16EF6D1369AF174292274D2AECC8F1A3C77E2FFF6944A8A120BC9A076F5EB049F3824B7F1A7EC60CFA2C010021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D370924A995E6850A27BA8118FC8A333355524CE316848F2BD623287410812BDEEDE793299B3BA6CE06A51A8348D710BB4D4A6B39706F1A7E92C7E2A5ECD8D55E57D992395D2D7FE7F8FB97FD7603F87F41794E7A848651875681706D2571297D728588948A8395766B5C91908B7E44979693A28999986880A99B9E2505AEAF0513B0AFB2B3B10FB6B70EB9B5B3BDB0BFB40F03C4C50313C6C5C8C9C7C3CCBCB8B6C1AED3BA00D0BBD2D1BEDBC0CEC9CBE0DFC6E1C6D8D7DAD9DCEADEECC2EED4DDEFE8EB00CCCD0EF7E5CAE3C5E7FFE9E8B513380F60BD73FAFA11DBB750E100830321160C28311E3C6B09F3316388CF27DE338A200F868C387262BD8C1EC5695499925C3D771A5E128C3910E605993259AE6CB84F03B8040021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D378193609ADA895EAAB091AF1833636541760DDB37B6E78FD6CA217405853C9D2C89FB3997401F14562C09AD2DA694D69C7AB95B49B8371397C9D5630BABD29E95E07737EEAE47E5C4AB5AC53ED99F74777F5F66837169796B7B7E828D80858E8464866688009645949391818F9B9E70957A897C8B2605A8A90513AAA9ACADAB0FB0B10EB3AFADB7AAB9AEB2B01303C0C103BFC2C0C4C5B6BDB8CABACCBCB5BECEA8BBD3D2B400C90EC5C60FDBC3DDDBD9D8D1D0CBE5CDE7CFE3E6EBE8EDEAE2DEC7C2F3C1E2F7E4EFD5E9FBFAD7F8ECE26DABC74D5BB87C00DD258487B061C07CF2C015233860613F8BFF1C2AD4C8901B5D44831325D263974E03C97726DD95BC70B2A54A0021EB699898000021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D3781A3F80828AAA56A2561E416BB16E496F36DE7BCC9A6931F8A86331177461D2CD963149D48A84328080A8F4BA98CC9D562B75E25F835AE4D85D6DF772D6637C9EE2E5C4C4DB3E2E1B7B9FC9CEBFB7B5F7527576D867F517E7281878B7640846A8D798E898C88598A945A83673F05A0A10513A2A1A4A5A30FA8A90EABA7A5AFA2B1A6AAA8B3A01303BABB03B9BCBAAEB5B0C2B2C4B4ADB6C6B8CAAC00C1C8C3D0C50EBFBABEBFCFCEC9D2C7DAD1DED3E0DDD9E4DBE2CBD4D5D7BCE5DFEDE1EFE3E6F1E8E7CDD5BD0FF8F4CDFCB7FDF302BA13180EDFBA5DFE98FD5BA8B021B77A09D3FD3A68ED1B370D16C5610C77F10C42C68F1C355E9838921780040021F904090A0000002C0000000080000F000003FF08B40BFEAC3D17C9A4F1AA7CABF61D3781A308998EA0AA1BD99A9584B9B175D27189EF70FEACC09AAEC7630C8D37A212395BCA5E4C0070254C46ABCDAB2FFBC442BBDBAF8D3B964E05DE74585D04B7CB6C67F98C5EDBDF47B73C0FBFEF7F67715A78567A837F647C8A805382868F7D8489859188621374059A9B05139C9B9E9F9D0FA2A30EA5A19FA99CABA0A4A2AD9AB1A60003B6B703A8AFAABBACBDAEA7B0BFB2C3B4BAC1BCC8BECAC0B5B8B6C700D1D3C2CCC4D6C6D5D2DAD4C9DBDECFD0DCE3DEDDCBDFE7E6CDEAD7E8CDE1B9E4E9F2EBF4EDECD9E5F6B4F0F8B3FFC5006213E8EEDEBE09F0DC69F0C66CE1B98617182A8CF870622B87CD1C3C0390000021F904090A0000002C0000000080000F000003E708B40BFEAC3D17C9A4F1AA7CABF61D3781A3089918B391AB5949A9FB96EC6B9DF58CCBB9DDF340D54E1823B68C365A107664FA744527B4798B56A94AE4343994FE9E57AE35EB5D86B7E86F590B5EBBCF6AB8992C67CFBB3EBA1EBF1FF3FF7E81587862838285886977878A760C059091051392919495930F98990E9B97959F92A1969A98A390A79C009B9EA5A0AEA2B0A49DA6B2A8B6AAADB4AFBBB1BDB3ABACBCC1C3BAC4BEC7C0C6CBB5BFB7CEB9CDC9C2A9D5B8D6D0D8D3D1C5D2CCC2CADEE2DDE4C8DFE6E3E8E5E0DAE7E1EBCFDBEDE9EFEAA2C3BF1AF8C9FAC8F917FB02FAE3077020A804003B000000000000000000