' *************************************** ' * Réparation du registre * ' * et purge de infcache.1 * ' * pour les problèmes de pilotes * ' * génériques sous XP * ' * Version 1.1 * ' *************************************** ' * Version 1.1 : ajout de la configuration du service Plug and Play en automatique * ' * (réglage d'origine Windows XP) Option Explicit Dim fso, Shell, WinVerXP, strPath, strOrigPath, strAppPath, Msg, windir, nominfcache Set Shell = WScript.CreateObject("WScript.Shell") Set fso = WScript.CreateObject("Scripting.FileSystemObject") 'On error goto 0 'pour déboguage On Error Resume Next ' Vérification : XP ou pas XP ? WinVerXP = shell.regread("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName") if not right(WinVerXP ,2) = "XP" then msg="----- Correctif USB -----" & VBCRLF & VBCRLF msg=msg & "Windows XP non détecté" & VBCRLF & VBCRLF msg=msg & "( " & WinVerXP & " )" & VBCRLF & VBCRLF msg=msg & "Opération annulée" & VBCRLF msg=msg & "-----------------------------------" & VBCRLF msgbox msg,16 wscript.quit end if Msg = "Correctif pour les installations de pilotes génériques sous Windows XP" Msg = Msg & VbCrLf & "(pilotes génériques non trouvés ou anomalies)" & VbCrLf & VbCrLf ' ***********Lire et corriger la première valeur DevicePath************* strPath = Shell.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\DevicePath") If Err.Number <> 0 Then strPath = "%SystemRoot%\inf" strOrigPath = "" else strOrigPath = strPath end if ' Vérifier DevicePath strAppPath = "%SystemRoot%\inf" strPath = AddToPath(strAppPath, strPath) 'Si la clé a changé, la modifier. If strPath <> strOrigPath Then Shell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\DevicePath", strPath, "REG_EXPAND_SZ" 'MsgBox "-" & strPath & "-" 'pour déboguage If Err.Number <> 0 Then WScript.quit Msg = Msg & "DevicePath modifié :" & vbCrLf & strPath & VbCrLf Else Msg = Msg & "DevicePath correct. Aucune modification effectuée." & VbCrLf End If Msg = Msg & VbCrLf ' ***********Lire et corriger la deuxième valeur DriverCachePath************* strPath = Shell.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Setup\DriverCachePath") If Err.Number <> 0 Then strPath = "%SystemRoot%\Driver Cache" strOrigPath = "" else strOrigPath = strPath end if ' Vérifier DriverCachePath strAppPath = "%SystemRoot%\Driver Cache" strPath = AddToPath(strAppPath, strPath) 'Si la clé a changé, la modifier. If strPath <> strOrigPath Then Shell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Setup\DriverCachePath", strPath, "REG_EXPAND_SZ" 'MsgBox "-" & strPath & "-" 'pour déboguage If Err.Number <> 0 Then WScript.quit Msg = Msg & "DriverCachePath modifié :" & vbCrLf & strPath & VbCrLf Else Msg = Msg & "DriverCachePath correct. Aucune modification effectuée." & VbCrLf End If Msg = Msg & VbCrLf ' ***********Effacer INFCACHE.1************* windir=shell.ExpandEnvironmentStrings("%windir%") nominfcache=windir & "\inf\infcache.1" if fso.FileExists(nominfcache) then 'MsgBox nominfcache 'pour déboguage fso.DeleteFile nominfcache, true If Err.Number <> 0 Then Msg = Msg & "INFCACHE.1 non effacé." & vbcrlf Msg = Msg & "Erreur N° " & Err.Number & " - " & Err.description & vbcrlf else Msg = Msg & "INFCACHE.1 effacé." end if else Msg = Msg & nominfcache & " non trouvé" end if ' ***********Vérifier le service PnP************* shell.Exec("sc config PlugPlay start= auto") Msg = Msg & VbCrLf & VbCrLf & "Supprimez les périphériques USB en anomalie" & VbCrLf Msg = Msg & "dans le gestionnaire de périphériques, puis" & VbCrLf Msg = Msg & "redémarrez votre ordinateur" & VbCrLf & VbCrLf Msg = Msg & "~WoupiMania~ 2006" & VbCrLf MsgBox Msg,64 shell.run("devmgmt.msc") Set fso = Nothing Set shell = Nothing ' ******************** Fonction de contrôle ********************** Function AddToPath ( sAdd, sPath ) Dim CheckFlag, ArrSplit, i CheckFlag = false if left(sPath, 1) = ";" then sPath = right(sPath, len(sPath) - 1) ArrSplit = split(sPath,";") sPath = "" for i = 0 to Ubound(ArrSplit) if (i > 0) and (len(trim(ArrSplit(i))) > 0) then sPath = sPath & ";" ArrSplit(i) = trim(ArrSplit(i)) if ArrSplit(i) = sAdd then CheckFlag = true sPath = sPath & ArrSplit(i) next If not checkFlag Then AddToPath = sPath & ";" & sAdd Else AddToPath = sPath End If End Function