' ---------------------------------------------------------- ' Script de suppression des dossiers de désinstallation de ' hotfixes sous Windows 2000, XP, 2003 ... ' ' Syntaxe: delUninstall ' ' ' JC BELLAMY © 2003-2005 ' Mises à jour : ' 16/08/2005 : ajout de la suppression des fichiers log ' 11/03/2008 : ajout d'affichage de la date des dossiers ' ---------------------------------------------------------- On error resume next Const SW_HIDE=0 Const SW_SHOWNORMAL=1 ColorBack="""#FFFFD8""" BGProgressON="blue" BGProgressOFF=ColorBack Const HKEY_CURRENT_USER = &H80000001 const HKEY_LOCAL_MACHINE = &H80000002 Const REG_SZ = 1 Const REG_EXPAND_SZ = 2 Const REG_BINARY = 3 Const REG_DWORD = 4 Const REG_MULTI_SZ = 7 Dim shell,fso,oIE,NbHF,HFFolders(),HFKeys(),HFarticle() Set shell = WScript.CreateObject("WScript.Shell") Set fso = WScript.CreateObject("Scripting.FileSystemObject") shell.Popup "Veuillez patienter quelques instants ...",3,"Recherche des dossiers de correctif et service pack",64 ' Autoriser le contenu actif à s'exécuter dans les fichiers de la zone Ordinateur local LockDown="HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_LOCALMACHINE_LOCKDOWN\" Keysec1=LockDown & "iexplore.exe" Oldvalue1=shell.RegRead(Keysec1) If Err.Number<>0 Then Err.Clear Oldvalue1=1 End If shell.RegWrite Keysec1,0,"REG_DWORD" Keysec2=LockDown & "Settings\LOCALMACHINE_CD_UNLOCK" Oldvalue2=shell.RegRead(Keysec2) If Err.Number<>0 Then Err.Clear Oldvalue2=0 End If shell.RegWrite Keysec2,1,"REG_DWORD" ficInit = GetPath() & "deluninstall.html" Titre="Suppression des dossiers de désinstallation de hotfixes" Set ts = fso.CreateTextFile(ficInit, True) ts.writeline header ts.writeline ScriptBtn Windir=shell.ExpandEnvironmentStrings("%systemroot%") Key="HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" LastKey="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Applets\Regedit\LastKey" ts.writeline "Dossier système : " & Windir & "" ts.writeline "
" ts.writeline "" ts.writeline "" ts.writeline "" ts.writeline "" set fWindir=fso.GetFolder(Windir) set collf=fWindir.SubFolders Index=0 For each subf in collf fName=subf.Name fDate=subf.DateCreated Sdate=Cadrage(Day(fDate)) & "/" & Cadrage(Month(fDate)) & "/" & Year(fDate) lName=len(fName) Uninst=false Suffixe="" If InStr(1,fName,"$",vbTextCompare)=1 then Suffixe=GetKeyFromFolder(fName) If Suffixe<>"" Then Index=Index+1 redim preserve HFFolders(Index),HFKeys(Index),HFarticle(Index) NumArticle="" HFFolders(Index-1)=fName HFKeys(Index-1)=Suffixe ts.writeline "" HelpLink=Shell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" & Suffixe & "\HelpLink") If Err.number=0 Then p=InstrRev(HelpLink,"=") If p>0 Then NumArticle=Mid(HelpLink,p) ts.writeline "" else Err.Clear ts.writeline "" End If HFarticle(Index-1)=NumArticle ts.writeline "" ts.writeline "" ts.writeline "" ts.writeline "" end if Next NbHF=Index ts.writeline "
Suppr.Lien MSDNDossierDateClef BDR
Tout (dé)selectionner" ts.writeline " " ts.writeline " " ts.writeline " 
" ts.writeline "MSDN " & Numarticle & " " & fName & "" & SDate & "" & Suffixe & "
" ts.writeline "" ts.writeline "" ts.writeline "
" ts.writeline ProgressBar ts.writeline "JCB © 2008" ts.writeline "" ts.close codeRet=RunIE(640,480) If coderet<=0 Then If coderet=0 Then oIE.Quit wscript.quit end if NbDel=0 For i = 1 To NbHF Action=eval("oIE.document.strategyForm.CB" & i & ".checked") Taux=i*100/NbHF If Action Then NbDel=NbDel+1 fso.DeleteFolder Windir & "\" & HFFolders(i-1),true LogFile= Windir & "\" & HFKeys(i-1) & ".log" If fso.FileExists(LogFile) Then fso.DeleteFile LogFile,true shell.RegDelete Key & HFKeys(i-1) & "\" msgerr="" If err.number<>0 Then msgerr=" Erreur suppression" err.clear End If SetProgress "Suppr." & HFarticle(i-1) & msgerr,taux else SetProgress "      ",Taux End If Next oIE.Quit If NbDel>1 Then pluriel="s" else pluriel="" wscript.echo NbDel & " désinstallation" & pluriel & " de hotfixes supprimée" & pluriel ' Restauration état shell.RegWrite Keysec1,OldValue1,"REG_DWORD" shell.RegWrite Keysec2,OldValue2,"REG_DWORD" Wscript.quit '-------------------------------------------------------------------- Function RunIE(W,H) RunIE=1 ' Ouverture d'Internet Explorer Set oIE = WScript.CreateObject("InternetExplorer.Application") Do While (oIE.Busy) WScript.Sleep 100 Loop oIE.navigate ficInit oIE.Height = H oIE.Width = W oIE.MenuBar = 0 oIE.ToolBar = 0 oIE.StatusBar = 1 oIE.Top=(oIE.Document.ParentWindow.Screen.Height-oIE.Height)/2 oIE.Left=(oIE.Document.ParentWindow.Screen.Width-oIE.Width)/2 oIE.Visible = 2 shell.AppActivate Titre ' Attente d'action sur le bouton ou fermeture de la fenêtre Do WScript.Sleep 100 Selection=oIE.Document.Script.CheckSelect() If Selection<>0 Then oIE.Document.Script.ResetSelect If oIE.document.strategyForm.allselect.checked Then StrFlag="true" else StrFlag="false" For i = 1 To NbHF execute("oIE.document.strategyForm.CB" & i & ".checked=""" & StrFlag & """") Next End If FlagParam=oIE.Document.Script.CheckParam() If FlagParam<>0 Then param=oIE.Document.Script.GetParam() oIE.Document.Script.ResetParam typeobj=left(param,1) path=mid(param,2) Select Case typeobj Case "1" Shell.run "explorer /n,/root," & Windir & "\" & path & "\",1 Case "2" Shell.RegWrite LastKey, Key & path oIE.Visible = 0 shell.Run "REGEDIT",1,true oIE.Visible = 1 End Select End If Check=oIE.Document.Script.CheckVal() Loop While (Check = 0) ' Si on ferme directement IE sans passer par un bouton, ' cela provoque une erreur qui est détectée et alors ' on quitte le script If Err <> 0 Then RunIE=-1 Err.Clear else If Check=-1 Then RunIE=0 end if End Function '-------------------------------------------------------------------- ' Fonction de récupération du répertoire courant Function GetPath() Dim path path = WScript.ScriptFullName GetPath = Left(path, InStrRev(path, "\")) End Function '-------------------------------------------------------------------- Function Header s="" s=s & "" & Titre & "" & VBCRLF s=s & "" header=s End Function '-------------------------------------------------------------------- Function ScriptBtn s="" ScriptBtn=s End Function '-------------------------------------------------------------------- Function ProgressBar s=s & "" & VBCRLF s=s & "
" & VBCRLF s=s & "" & VBCRLF s=s & "" & VBCRLF For indl = 1 To 20 s=s & "" & VBCRLF Next s=s & "
    
" & VBCRLF s=s & "
      
" & VBCRLF ProgressBar=s End Function '-------------------------------------------------------------------- Sub SetProgress(lib,taux) set objLib=oIE.Document.All("lib") set objTab=oIE.Document.All("tabprog") objTab.border="1" k=int(taux/5) objLib.innerhtml=lib for numc= 1 to 20 set objCell=oIE.Document.All("c" & numc) if numc<=k then className="progressON" else className="progressOFF" objCell.className=className next End Sub '-------------------------------------------------------------------- Function GetKeyFromFolder(folder) GetKeyFromFolder="" Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall" oReg.EnumKey HKEY_LOCAL_MACHINE,strKeyPath,arrSubKeys trouve=false For Each subkey In arrSubKeys oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & subkey,"UninstallString",UninstallString If InStr(1,UninstallString,Folder,vbTextCompare)>0 Then trouve=true GetKeyFromFolder=subkey exit function End If Next End Function '-------------------------------------------------------------------- Function Cadrage(n) If n<=9 Then Cadrage="0" & CStr(n) Else Cadrage= CStr(n) End Function '--------------------------------------------------------------------