'------------------------------ ' SOURCEPATH ET PILOTES OUBLIÉS '------------------------------ ' Déclaration variables '---------------------- Dim MonSysFic, MonShell Dim chemin, dest, cab, retcod, i, encore, erreur, titre, bout, ico Dim msg(6) Dim vxd(6, 2) ' Initialisation variables '------------------------- titre = "Sourcepath et pilotes oubliés" 'chemin = "Unité:\Chemin\Répertoire" encore = True ico = 16 dest = "C:\Windows\System" msg(1) = "Aucune action effectuée" msg(2) = "Mise à jour registre impossible, aucune action effectuée" msg(3) = "Répertoire non trouvé" msg(4) = "Ce répertoire ne contient pas les fichiers cab nécessaires" msg(5) = "Saisissez le nom du répertoire contenant les fichiers cab de Windows avec son chemin d'accès complet" msg(6) = "Chisissez le répertoire contenant les fichiers cab de Windows" vxd(0, 0) = "vcomm.vxd" vxd(1, 0) = "Vdd.vxd" vxd(2, 0) = "Vflatd.vxd" vxd(3, 0) = "Vdmad.vxd" vxd(4, 0) = "Vmouse.vxd" vxd(5, 0) = "Configmg.vxd" vxd(6, 0) = "Ntkern.vxd" vxd(0, 1) = "win98_50.cab" vxd(1, 1) = "win98_50.cab" vxd(2, 1) = "win98_50.cab" vxd(3, 1) = "win98_50.cab" vxd(4, 1) = "win98_51.cab" vxd(5, 1) = "win98_50.cab" vxd(6, 1) = "win98_50.cab" ' Instanciation objets '--------------------- Set MonSysFic = Wscript.CreateObject("Scripting.FileSystemObject") Set MonShell = Wscript.CreateObject("Wscript.Shell") ' Sélection répertoire '--------------------- chemin = SelRep(msg(6)) ' Boucle de saisie '------------------------------- Do While encore chemin = InputBox(msg(5), titre, chemin) If Len(chemin) = 0 Then retcod = 1 Exit Do End If If MonSysFic.FolderExists(chemin) Then cab = True For i = 0 To 6 If Not MonSysFic.FileExists(chemin & "\" & vxd(i, 1)) Then cab = False Exit For End If Next If cab = True Then action encore = False Else bout = MonShell.Popup(msg(4), , titre, ico) End If Else bout = MonShell.Popup(msg(3), , titre, ico) End If Loop ' Épilogue '--------- If retcod < 1 Then ico = 64 bout = MonShell.Popup(msg(retcod), , titre, ico) Set MonSysFic = Nothing Set MonShell = Nothing ' Procédure action '----------------- Sub action() On Error Resume Next MonShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Setup\Sourcepath", chemin, "REG_SZ" If Err.Number = 0 Then MonShell.CurrentDirectory = chemin For i = 0 To 6 If Not MonSysFic.FileExists(dest & "\" & vxd(i, 0)) Then erreur = MonShell.Run("C:\Windows\Command.com /C extract /L " _ & dest & " " & vxd(i, 1) & " " & vxd(i, 0), 0, True) If erreur = 0 Then vxd(i, 2) = "extrait" Else vxd(i, 2) = "extraction impossible" End If Else vxd(i, 2) = "déjà présent" End If Next msg(0) = "Registre mis à jour" & vbCrLf For i = 0 To 6 msg(0) = msg(0) & vbCrLf & rpad(vxd(i, 0), 12) & vbTab & vxd(i, 2) Next retcod = 0 Else retcod = 2 End If End Sub ' Fonction rpad '-------------- Function rpad(chaine, nb) rpad = chaine & String(nb - Len(chaine), " ") End Function ' Fonction sélection répertoire '------------------------------ Function SelRep(invite) Dim sh, fol, fs, lngView, chemin Set sh = CreateObject("Shell.Application") chemin = "" Set fol = sh.BrowseForFolder(&O0, "", &H201) On Error Resume Next chemin = fol.ParentFolder.ParseName(fol.Title).Path If chemin = "" Then chemin = fol.Title Set fol = fol.ParentFolder chemin = MonSysFic.BuildPath(fol.ParentFolder.ParseName(fol.Title).Path, chemin) End If Set fol = Nothing Set sh = Nothing SelRep = chemin End Function