IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBScript Discussion :

afficher une fenêtre d'une barre de progression


Sujet :

VBScript

  1. #1
    Membre régulier
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    Novembre 2012
    Messages
    54
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Val de Marne (Île de France)

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Finance

    Informations forums :
    Inscription : Novembre 2012
    Messages : 54
    Points : 76
    Points
    76
    Par défaut afficher une fenêtre d'une barre de progression
    Bonjour tout le monde
    et Bonjour Cachlab

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

    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    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 !!!

  2. #2
    Membre averti
    Homme Profil pro
    Administrateur systèmes et réseaux
    Inscrit en
    Novembre 2011
    Messages
    163
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux
    Secteur : High Tech - Opérateur de télécommunications

    Informations forums :
    Inscription : Novembre 2011
    Messages : 163
    Points : 304
    Points
    304
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    Set oSh = CreateObject("WScript.Shell")
    oSh.Popup ("Opération en cours !" & VbCrLf & VbCrLf & "Veuillez patienter ..."), 100000
    Script_Principal.vbs
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    '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
    '...
    ++

  3. #3
    Expert éminent
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 839
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 48
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 839
    Points : 9 222
    Points
    9 222
    Par défaut

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

  4. #4
    Expert éminent
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 839
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 48
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 839
    Points : 9 222
    Points
    9 222
    Par défaut Exemple de Barre de Progression en Vbscript + HTA

    Tu peux aussi tester cet exemple en Vbscript
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    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

  5. #5
    Expert éminent
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 839
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 48
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 839
    Points : 9 222
    Points
    9 222
    Par défaut

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

    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    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

  6. #6
    Expert éminent
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 839
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 48
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 839
    Points : 9 222
    Points
    9 222
    Par défaut

    Je crois que je vais recycler tous mes scripts et les mettre à jour avec cette Barre de Progression
    Voici une autre adaptation de cette barre avec le script : SearchFileByName.vbs
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    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

  7. #7
    Membre régulier
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    Novembre 2012
    Messages
    54
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Val de Marne (Île de France)

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Finance

    Informations forums :
    Inscription : Novembre 2012
    Messages : 54
    Points : 76
    Points
    76
    Par défaut
    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

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

    Et merci Cachlab.

  8. #8
    Expert éminent
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 839
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 48
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 839
    Points : 9 222
    Points
    9 222
    Par défaut

    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
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    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

  9. #9
    Expert éminent
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 839
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 48
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 839
    Points : 9 222
    Points
    9 222
    Par défaut

    une petite mise à jour : Ajout d'un message d'attente animé par la balise <marquee>
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    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

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 2
    Dernier message: 16/03/2015, 21h19
  2. Réponses: 1
    Dernier message: 22/04/2012, 12h59
  3. Réponses: 5
    Dernier message: 15/09/2011, 22h53
  4. [XL-2007] Afficher une checkbox dans une feuille si une checkbox d'une autre feuille est cochée
    Par JessieCoutas dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 18/08/2009, 13h35
  5. [XL-2003] Afficher les résultats d'une macro dans une fenêtre popup
    Par sphyncks dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 18/06/2009, 09h39

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo