主要解决办法是卸载 Web Developer 和MUI
MS是这篇文章解决
http://support.microsoft.com/kb/290301/
下载对应office的版本,运行卸载。
旧版本的卸载工具(可能导致出错)
http://download.microsoft.com/download/e/9/d/e9d80355-7ab4-45b8-80e8-983a48d5e1bd/msicuu2.exe
还可以用MS的脚本,提示时输入ALL,这个脚本适合office2007
******************
'=======================================================================================================
' Name: OffScrub07.vbs
' Author: Microsoft Customer Support Services
' Copyright (c) 2008,2009,2010 Microsoft Corporation
' Script to remove (scrub) Office 2007 products
'=======================================================================================================
Option Explicit
Const SCRIPTVERSION = "1.36"
Const SCRIPTFILE = "OffScrub07.vbs"
Const SCRIPTNAME = "OffScrub07"
Const OVERSION = "12.0"
Const OVERSIONMAJOR = "12"
Const OREF = "Office12"
Const OREGREF = ""
Const ONAME = "Office 2007"
Const OPACKAGE = "PackageIds"
Const OFFICEID = "0000000FF1CE}"
Const HKCR = &H80000000
Const HKCU = &H80000001
Const HKLM = &H80000002
Const HKU = &H80000003
Const FOR_WRITING = 2
Const PRODLEN = 13
Const COMPPERMANENT = "00000000000000000000000000000000"
Const UNCOMPRESSED = 38
Const SQUISHED = 20
Const COMPRESSED = 32
Const REG_ARP = "SOFTWARE/Microsoft/Windows/CurrentVersion/Uninstall/"
Const VB_YES = 6
Const MSIOPENDATABASEREADONLY = 0
'=======================================================================================================
Dim oFso, oMsi, oReg, oWShell, oWmiLocal
Dim ComputerItem, Item, LogStream, TmpKey
Dim arrTmpSKUs, arrDeleteFiles, arrDeleteFolders, arrMseFolders
Dim dicKeepProd, dicKeepLis, dicApps, dicKeepFolder, dicDelRegKey, dicKeepReg
Dim dicInstalledSku, dicRemoveSku, dicKeepSku, dicSrv, dicCSuite, dicCSingle
Dim f64, fLegacyProductFound
Dim sErr, sTmp, sSkuRemoveList, sDefault, sWinDir, sWICacheDir, sMode
Dim sAppData, sTemp, sScrubDir, sProgramFiles, sProgramFilesX86, sCommonProgramFiles, sCommonProgramFilesX86
Dim sAllusersProfile
Dim sProgramData, sLocalAppData, sOInstallRoot
'=======================================================================================================
'Main
'=======================================================================================================
'Configure defaults
Dim sLogDir : sLogDir = ""
Dim sMoveMessage: sMoveMessage = ""
Dim fRemoveOse : fRemoveOse = False
Dim fRemoveOspp : fRemoveOspp = False
Dim fRemoveAll : fRemoveAll = False
Dim fRemoveC2R : fRemoveC2R = False
Dim fRemoveAppV : fRemoveAppV = False
Dim fRemoveCSuites : fRemoveCSuites = False
Dim fRemoveCSingle : fRemoveCSingle = False
Dim fRemoveSrv : fRemoveSrv = False
Dim fKeepUser : fKeepUser = True 'Default to keep per user settings
Dim fSkipSD : fSkipSD = False 'Default to not Skip the Shortcut Detection
Dim fDetectOnly : fDetectOnly = False
Dim fQuiet : fQuiet = False
Dim fNoCancel : fNoCancel = False
Dim fElevated : fElevated = False
Dim fTryReconcile : fTryReconcile = False
'CAUTION! -> "fForce" will kill running applications which can result in data loss! <- CAUTION
Dim fForce : fForce = False
'CAUTION! -> "fForce" will kill running applications which can result in data loss! <- CAUTION
Dim fLogInitialized : fLogInitialized = False
Dim fBypass_Stage1 : fBypass_Stage1 = False 'Component Detection
Dim fBypass_Stage2 : fBypass_Stage2 = False 'Setup
Dim fBypass_Stage3 : fBypass_Stage3 = False 'Msiexec
Dim fBypass_Stage4 : fBypass_Stage4 = False 'CleanUp
Dim fRebootRequired : fRebootRequired = False
'Create required objects
Set oWmiLocal = GetObject("winmgmts://./root/cimv2")
Set oWShell = CreateObject("Wscript.Shell")
Set oFso = CreateObject("Scripting.FileSystemObject")
Set oMsi = CreateObject("WindowsInstaller.Installer")
Set oReg = GetObject("winmgmts://./root/default:StdRegProv")
'Get environment path info
sAppData = oWShell.ExpandEnvironmentStrings("%appdata%")
sLocalAppData = oWShell.ExpandEnvironmentStrings("%localappdata%")
sTemp = oWShell.ExpandEnvironmentStrings("%temp%")
sAllUsersProfile = oWShell.ExpandEnvironmentStrings("%allusersprofile%")
sProgramFiles = oWShell.ExpandEnvironmentStrings("%programfiles%")
'Deferred until after architecture check
'sProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%programfiles(x86)%")
sCommonProgramFiles = oWShell.ExpandEnvironmentStrings("%commonprogramfiles%")
'Deferred until after architecture check
'sCommonProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%CommonProgramFiles(x86)%")
sProgramData = oWSHell.ExpandEnvironmentStrings("%programdata%")
sWinDir = oWShell.ExpandEnvironmentStrings("%windir%")
sWICacheDir = sWinDir & "/" & "Installer"
sScrubDir = sTemp & "/" & SCRIPTNAME
'Detect if we're running on a 64 bit OS
Set ComputerItem = oWmiLocal.ExecQuery("Select * from Win32_ComputerSystem")
For Each Item In ComputerItem
f64 = Instr(Left(Item.SystemType,3),"64") > 0
If f64 Then Exit For
Next
If f64 Then sProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%programfiles(x86)%")
If f64 Then sCommonProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%CommonProgramFiles(x86)%")
If NOT CheckRegPermissions Then
'Try to relaunch elevated
RelaunchElevated
'Can't relaunch. Exit out
If UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C" Then
If Not fLogInitialized Then CreateLog
Log "Insufficient registry access permissions - exiting"
End If
'Undo temporary entries created in ARP
TmpKeyCleanUp
wscript.quit
End If
'Ensure CScript as engine
If Not UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C" Then RelaunchAsCScript
'Create Dictionaries
Set dicKeepProd = CreateObject("Scripting.Dictionary")
Set dicInstalledSku = CreateObject("Scripting.Dictionary")
Set dicRemoveSku = CreateObject("Scripting.Dictionary")
Set dicKeepSku = CreateObject("Scripting.Dictionary")
Set dicKeepLis = CreateObject("Scripting.Dictionary")
Set dicKeepFolder = CreateObject("Scripting.Dictionary")
Set dicApps = CreateObject("Scripting.Dictionary")
Set dicDelRegKey = CreateObject("Scripting.Dictionary")
Set dicKeepReg = CreateObject("Scripting.Dictionary")
Set dicSrv = CreateObject("Scripting.Dictionary")
Set dicCSuite = CreateObject("Scripting.Dictionary")
Set dicCSingle = CreateObject("Scripting.Dictionary")
'Create the temp folder
If Not oFso.FolderExists(sScrubDir) Then oFso.CreateFolder sScrubDir
'Set the default logging directory
sLogDir = sScrubDir
'Call the command line parser
ParseCmdLine
'Get Office Install Folder
If NOT RegReadValue(HKLM,"SOFTWARE/Microsoft/Office/"&OVERSION&"/Common/InstallRoot","Path",sOInstallRoot,"REG_SZ") Then
sOInstallRoot = sProgramFiles & "/Microsoft Office/"&OREF
End If
'Ensure integrity of WI metadata which could fail used APIs otherwise
EnsureValidWIMetadata HKCU,"Software/Classes/Installer/Products",COMPRESSED
EnsureValidWIMetadata HKCR,"Installer/Products",COMPRESSED
EnsureValidWIMetadata HKLM,"SOFTWARE/Microsoft/Windows/CurrentVersion/Installer/UserData/S-1-5-18/Products",COMPRESSED
EnsureValidWIMetadata HKLM,"SOFTWARE/Microsoft/Windows/CurrentVersion/Installer/UserData/S-1-5-18/Components",COMPRESSED
EnsureValidWIMetadata HKCR,"Installer/Components",COMPRESSED
'Add initial known .exe files that might need to be closed
dicApps.Add "communicator.exe","communicator.exe"
Select Case OVERSIONMAJOR
Case "12"
Case "14"
dicApps.Add "bcssync.exe","bcssync.exe"
dicApps.Add "officesas.exe","officesas.exe"
dicApps.Add "officesasscheduler.exe","officesasscheduler.exe"
dicApps.Add "msosync.exe","msosync.exe"
dicApps.Add "onenotem.exe","onenotem.exe"
Case Else
End Select
'-------------------
'Stage # 0 - Basics |
'-------------------
'Build a list with installed/registered Office products
sTmp = "Stage # 0 " & chr(34) & "Basics" & chr(34) & " (" & Time & ")"
Log vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf
FindInstalledOProducts
If dicInstalledSku.Count > 0 Then Log "Found registered product(s): " & Join(RemoveDuplicates(dicInstalledSku.Items),",") &vbCrLf
'Validate the list of products we got from the command line if applicable
ValidateRemoveSkuList
'Log detection results
If dicRemoveSku.Count > 0 Then Log "Product(s) to be removed: " & Join(RemoveDuplicates(dicRemoveSku.Items),",")
sMode = "Selected " & ONAME & " products"
If Not dicRemoveSku.Count > 0 Then sMode = "Orphaned " & ONAME & " products"
If fRemoveAll Then sMode = "All " & ONAME & " products"
Log "Final removal mode: " & sMode
Log "Remove OSE service: " & fRemoveOse &vbCrLf
'Log preview mode if applicable
If fDetectOnly Then Log "*************************************************************************"
If fDetectOnly Then Log "* PREVIEW MODE *"
If fDetectOnly Then Log "* All uninstall and delete operations will only be logged not executed! *"
If fDetectOnly Then Log "*************************************************************************" & vbCrLf
'Check if there are legacy products installed
CheckForLegacyProducts
If fLegacyProductFound Then Log "Found legacy Office products that will not be removed." Else Log "No legacy Office products found."
'Cache .msi files
If dicRemoveSku.Count > 0 Then CacheMsiFiles
'Log Sku/Prod detection results
LogSkuResults
'--------------------------------
'Stage # 1 - Component Detection |
'--------------------------------
sTmp = "Stage # 1 " & chr(34) & "Component Detection" & chr(34) & " (" & Time & ")"
Log vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf
If Not fBypass_Stage1 Then
'Build a list with files which are installed/registered to a product that's going to be removed
Log "Prepare for CleanUp stages."
Log "Identifying removable elements. This can take several minutes."
ScanComponents
Else
Log "Skipping Component Detection because bypass was requested."
End If
'End all running Office applications
If fForce OR fQuiet Then CloseOfficeApps
'----------------------
'Stage # 2 - Setup.exe |
'----------------------
sTmp = "Stage # 2 " & chr(34) & "Setup.exe" & chr(34) & " (" & Time & ")"
Log vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf
If Not fBypass_Stage2 Then
SetupExeRemoval
Else
Log "Skipping Setup.exe because bypass was requested."
End If
'------------------------
'Stage # 3 - Msiexec.exe |
'------------------------
sTmp = "Stage # 3 " & chr(34) & "Msiexec.exe" & chr(34) & " (" & Time & ")"
Log vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf
If Not fBypass_Stage3 Then
MsiexecRemoval
Else
Log "Skipping Msiexec.exe because bypass was requested."
End If
'--------------------
'Stage # 4 - CleanUp |
'--------------------
'Removal of files and registry settings
sTmp = "Stage # 4 " & chr(34) & "CleanUp" & chr(34) & " (" & Time & ")"
Log vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf
If Not fBypass_Stage4 Then
'Office Source Engine
If fRemoveOse Then RemoveOSE
'Softgrid Service
If fRemoveAppV Then RemoveSG
'Local Installation Source (MSOCache)
WipeLIS
'Obsolete files
If fRemoveAll Then
FileWipeAll
Else
FileWipeIndividual
End If
'Empty Folders
DeleteEmptyFolders
'Restore Explorer if needed
If fForce Then RestoreExplorer
'Registry data
RegWipe
'Wipe orphaned files from Windows Installer cache
MsiClearOrphanedFiles
'Temporary .msi files in scrubcache
DeleteMsiScrubCache
'Temporary files
DelScrubTmp
Else
Log "Skipping CleanUp because bypass was requested."
End If
If Not sMoveMessage = "" Then Log vbCrLf & "Please remove this folder after next reboot: " & sMoveMessage
'THE END
Log vbCrLf & "End removal: " & Now & vbCrLf
Log vbCrLf & "For detailed logging please refer to the log in folder " &chr(34)&sScrubDir&chr(34)&vbCrLf
If fRebootRequired Then
Log vbCrLf & "A restart is required to complete the operation!"
If NOT fQuiet Then
If MsgBox("Do you want to reboot now?",vbYesNo,"Reboot Required") = VB_YES Then
Dim colOS, oOS
Dim oWmiReboot
Set oWmiReboot = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}!//./root/cimv2")
Set colOS = oWmiReboot.ExecQuery ("Select * from Win32_OperatingSystem")
For Each oOS in colOS
oOS.Reboot()
Next
End If
End If
End If
If NOT fQuiet Then
For Each Item in Wscript.Arguments
If Item = "UAC" Then
wscript.stdout.write "Press
sTemp = wscript.stdin.read(1)
End If
Next 'Argument
End If
'=======================================================================================================
'=======================================================================================================
'Stage 0 - 4 Subroutines
'=======================================================================================================
'Office configuration products are listed with their configuration product name in the "Uninstall" key
'To identify an Office configuration product all of these condiditions have to be met:
' - "SystemComponent" does not have a value of "1" (DWORD)
' - "OPACKAGE" (see constant declaration) entry exists and is not empty
' - "DisplayVersion" exists and the 2 leftmost digits are "OVERSIONMAJOR"
Sub FindInstalledOProducts
Dim ArpItem, File
Dim sCurKey, sValue, sConfigName, sProdC, sCVHValue
Dim sProductCodeList, sProductCode
Dim arrKeys, arrMultiSzValues
Dim fSystemComponent0, fPackages, fDisplayVersion, fReturn, fCategorized
If dicInstalledSku.Count > 0 Then Exit Sub 'Already done from InputBox prompt
'Handle orphaned products to get them added to the detection scope
If fTryReconcile Then
For Each File in oFso.GetFolder(sWICacheDir).Files
If Len(File.Name)>3 Then
Select Case LCase(Right(File.Name,4))
Case ".msi"
sProductCode = ""
sProductCode = GetMsiProductCode(File.Path)
If InScope(sProductCode) Then
If NOT RegKeyExists(HKLM,REG_ARP & sProductCode) Then
'Ensure the orphaned item is getting removed
If Len(sSkuRemoveList) > 0 Then
sSkuRemoveList = sSkuRemoveList & "," & GetProductID(Mid(sProductCode,11,4))
Else
sSkuRemoveList = GetProductID(Mid(sProductCode,11,4))
End If
'Add to ScrubDir
oFso.CopyFile File.Path,sScrubDir & "/" & prod & ".msi",True
'Register the product with MSI
MsiRegisterProduct(File.Path)
End If 'NOT sProductCode
End If 'InScope
Case Else
End Select
End If '>3
Next 'File
End If 'fTryReconcile
'Locate standalone Office products that have no configuration product entry and create a
'temporary configuration entry
ReDim arrTmpSKUs(-1)
If RegEnumKey(HKLM,REG_ARP,arrKeys) Then
For Each ArpItem in arrKeys
If InScope(ArpItem) Then
sCurKey = REG_ARP & ArpItem & "/"
fSystemComponent0 = Not (RegReadValue(HKLM,sCurKey,"SystemComponent",sValue,"REG_DWORD") AND (sValue = "1"))
If (fSystemComponent0 AND (NOT RegReadValue(HKLM,sCurKey,"CVH",sCVHValue,"REG_DWORD"))) Then
RegReadValue HKLM,sCurKey,"DisplayVersion",sValue,"REG_SZ"
Redim arrMultiSzValues(0)
'Logic changed to drop the LCID identifier
'sConfigName = GetProductID(Mid(ArpItem,11,4)) & "_" & CInt("&h" & Mid(ArpItem,16,4))
sConfigName = OREGREF & GetProductID(Mid(ArpItem,11,4))
If NOT RegKeyExists(HKLM,REG_ARP&sConfigName) Then
'Create a new ARP item
ReDim Preserve arrTmpSKUs(UBound(arrTmpSKUs)+1)
arrTmpSKUs(UBound(arrTmpSKUs)) = sConfigName
oReg.CreateKey HKLM,REG_ARP & sConfigName
arrMultiSzValues(0) = sConfigName
oReg.SetMultiStringValue HKLM,REG_ARP & sConfigName,OPACKAGE,arrMultiSzValues
arrMultiSzValues(0) = ArpItem
oReg.SetMultiStringValue HKLM,REG_ARP & sConfigName,"ProductCodes",arrMultiSzValues
oReg.SetStringValue HKLM,REG_ARP & sConfigName,"DisplayVersion",sValue
oReg.SetDWordValue HKLM,REG_ARP & sConfigName,"SystemComponent",0
Else
'Update the existing temporary ARP item
fReturn = RegReadValue(HKLM,REG_ARP&sConfigName,"ProductCodes",sProdC,"REG_MULTI_SZ")
If NOT InStr(sProdC,ArpItem)>0 Then sProdC = sProdC & chr(34) & ArpItem
oReg.SetMultiStringValue HKLM,REG_ARP & sConfigName,"ProductCodes",Split(sProdC,chr(34))
End If 'RegKeyExists
End If 'fSystemComponent0
End If 'InScope
Next 'ArpItem
End If 'RegEnumKey
'Find the configuration products
If RegEnumKey(HKLM,REG_ARP,arrKeys) Then
For Each ArpItem in arrKeys
sCurKey = REG_ARP & ArpItem & "/"
sValue = ""
fSystemComponent0 = NOT (RegReadValue(HKLM,sCurKey,"SystemComponent",sValue,"REG_DWORD") AND (sValue = "1"))
fPackages = RegReadValue(HKLM,sCurKey,OPACKAGE,sValue,"REG_MULTI_SZ")
fDisplayVersion = RegReadValue(HKLM,sCurKey,"DisplayVersion",sValue,"REG_SZ")
If fDisplayVersion Then
If Len(sValue) > 1 Then
fDisplayVersion = (Left(sValue,2) = OVERSIONMAJOR)
Else
fDisplayVersion = False
End If
End If
If (fSystemComponent0 AND fPackages AND fDisplayVersion) OR (fSystemComponent0 AND fDisplayVersion AND InStr(UCase(ArpItem),"CLICK2RUN")>0) Then
If InStr(ArpItem,".")>0 Then sConfigName = UCase(Mid(ArpItem,InStr(ArpItem,".")+1)) Else sConfigName = UCase(ArpItem)
If NOT dicInstalledSku.Exists(sConfigName) Then dicInstalledSku.Add sConfigName,sConfigName
'Categorize the SKU
'Three categories are available: ClientSuite, ClientSingleProduct, Server
If RegReadValue(HKLM,REG_ARP&OREGREF&sConfigName,"ProductCodes",sProductCodeList,"REG_MULTI_SZ") OR (sConfigName = "CLICK2RUN") Then
fCategorized = False
If sConfigName = "CLICK2RUN" Then sProductCodeList = "{90" & OVERSIONMAJOR & "0011-0062-0000-0000-0000000FF1CE}"
For Each sProductCode in Split(sProductCodeList,chr(34))
If Len(sProductCode) = 38 Then
If NOT Mid(sProductCode,11,1) = "0" Then
'Server product
If NOT dicSrv.Exists(UCase(sConfigName)) Then dicSrv.Add UCase(sConfigName),sConfigName
fCategorized = True
Exit For
Else
Select Case Mid(sProductCode,11,4)
'Client Suites
Case "000F","0011","0012","0013","0014","0015","0016","0017","0018","0019","001A","001B","0029","002B","002E","002F","0030","0031","0033","0035","0037","003D","0044","0049","0061","0062","0066","006C","006D","006F","0074","00A1","00A3","00A9","00BA","00CA","00E0","0100","0103","011A"
If NOT dicCSuite.Exists(UCase(sConfigName)) Then dicCSuite.Add UCase(sConfigName),sConfigName
fCategorized = True
Exit For
Case Else
End Select
End If
End If 'Len 38
Next 'sProductCode
If NOT fCategorized Then
If NOT dicCSingle.Exists(UCase(sConfigName)) Then dicCSingle.Add UCase(sConfigName),sConfigName
End If 'fCategorized
End If 'RegReadValue "ProductCodes"
End If
Next 'ArpItem
End If 'RegEnumKey
End Sub 'FindInstalledOProducts
'=======================================================================================================
'Check if there are Office products from previous versions on the computer
Sub CheckForLegacyProducts
Const OLEGACY = "78E1-11D2-B60F-006097C998E7}.6000-11D3-8CFE-0050048383C9}.6000-11D3-8CFE-0150048383C9}.BDCA-11D1-B7AE-00C04FB92F3D}.6D54-11D4-BEE3-00C04F990354}"
Dim Product
'Set safe default
fLegacyProductFound = True
For Each Product in oMsi.Products
If Len(Product) = 38 Then
'Handle O09 - O11 Products
If InStr(OLEGACY, UCase(Right(Product, 28)))>0 Then
'Found legacy Office product. Keep flag in default and exit
Exit Sub
End If
If UCase(Right(Product,PRODLEN))=OFFICEID Then
Select Case Mid(Product,4,2)
Case "12"
If CInt(OVERSIONMAJOR) > 12 Then
'Found legacy Office product. Keep flag in default and exit
Exit Sub
End If
Case Else
End Select
End If
End If '38
Next 'Product
fLegacyProductFound = False
End Sub 'CheckForLegacyProducts
'=======================================================================================================
'Create clean list of Products to remove.
'Strip off bad & empty contents
Sub ValidateRemoveSkuList
Dim Sku, Key, sProductCode, sProductCodeList
Dim arrRemoveSKUs
If fRemoveAll Then
'Remove all mode
For Each Key in dicInstalledSku.Keys
dicRemoveSku.Add Key,dicInstalledSku.Item(Key)
Next 'Key
Else
'Remove individual products or preconfigured configurations mode
'Ensure to have a string with no unexpected contents
sSkuRemoveList = Replace(sSkuRemoveList,";",",")
sSkuRemoveList = Replace(sSkuRemoveList," ","")
sSkuRemoveList = Replace(sSkuRemoveList,Chr(34),"")
While InStr(sSkuRemoveList,",,")>0
sSkuRemoveList = Replace(sSkuRemoveList,",,",",")
Wend
'Prepare 'remove' and 'keep' dictionaries to determine what has to be removed
'Initial pre-fill of 'keep' dic
For Each Key in dicInstalledSku.Keys
dicKeepSku.Add Key,dicInstalledSku.Item(Key)
Next 'Key
'Determine contents of keep and remove dic
'Individual products
arrRemoveSKUs = Split(UCase(sSkuRemoveList),",")
For Each Sku in arrRemoveSKUs
If Sku = "OSE" Then fRemoveOse = True
If Sku = "CLICK2RUN" Then fRemoveC2R = True
If dicKeepSku.Exists(Sku) Then
'A Sku to remove has been passed in
'remove the item from the keep dic
dicKeepSku.Remove(Sku)
'Now add it to the remove dic
If NOT dicRemoveSku.Exists(Sku) Then dicRemoveSku.Add Sku,Sku
End If
Next 'Sku
'Client Suite Category
If fRemoveCSuites Then
fRemoveC2R = True
For Each Key in dicInstalledSku.Keys
If dicCSuite.Exists(Key) Then
If dicKeepSku.Exists(Key) Then dicKeepSku.Remove(Key)
If NOT dicRemoveSku.Exists(Key) Then dicRemoveSku.Add Key,Key
End If
Next 'Key
End If 'fRemoveCSuites
'Client Single/Standalone Category
If fRemoveCSingle Then
For Each Key in dicInstalledSku.Keys
If dicCSingle.Exists(Key) Then
If dicKeepSku.Exists(Key) Then dicKeepSku.Remove(Key)
If NOT dicRemoveSku.Exists(Key) Then dicRemoveSku.Add Key,Key
End If
Next 'Key
End If 'fRemoveCSingle
'Server Category
If fRemoveSrv Then
For Each Key in dicInstalledSku.Keys
If dicSrv.Exists(Key) Then
If dicKeepSku.Exists(Key) Then dicKeepSku.Remove(Key)
If NOT dicRemoveSku.Exists(Key) Then dicRemoveSku.Add Key,Key
End If
Next 'Key
End If 'fRemoveSrv
If NOT dicKeepSku.Count > 0 Then fRemoveAll = True
End If 'fRemoveAll
'Fill the KeepProd dic
For Each Sku in dicKeepSku.Keys
If RegReadValue(HKLM,REG_ARP & OREGREF & Sku,"ProductCodes",sProductCodeList,"REG_MULTI_SZ") Then
For Each sProductCode in Split(sProductCodeList,chr(34))
If Len(sProductCode) = 38 Then
If NOT dicKeepProd.Exists(sProductCode) Then dicKeepProd.Add sProductCode,Sku
End If '38
Next 'sProductCod
End If
Next 'Sku
If fRemoveAll OR fRemoveOse Then CheckRemoveOSE
If fRemoveAll OR fRemoveOspp Then CheckRemoveOspp
If fRemoveAll OR fRemoveC2R Then CheckRemoveSG
End Sub 'ValidateRemoveSkuList
'=======================================================================================================
'Check if SoftGrid Client can be scrubbed
Sub CheckRemoveSG
Dim Key
Dim sPKey
Dim arrKeys
If NOT CInt(OVERSIONMAJOR) > 12 Then
fRemoveC2R = False
Exit Sub
End If
If fForce Then
fRemoveAppV = True
Exit Sub
End If
fRemoveAppV = False
If RegEnumKey (HKLM,"SOFTWARE/Microsoft/SoftGrid/4.5/Client/Applications",arrKeys) Then
For Each Key in arrKeys
If Len(Key)>15 Then
'Get Partial product Key
sPKey = Right(Key,16)
If Left(sPKey,4) = "90"&OVERSIONMAJOR Then
If NOT GetProductID(Mid(sPKey,5,4)) = "CLICK2RUN" Then Exit Sub
Else
Exit Sub
End If
Else
Exit Sub
End If
Next 'Key
End If
'If we got here it's only Click2Run apps
fRemoveAppV = True
End Sub 'CheckRemoveSG
'=======================================================================================================
'Check if OSE service can be scrubbed
Sub CheckRemoveOSE
Const O11 = "6000-11D3-8CFE-0150048383C9}"
Dim Product
If fRemoveOse Then Exit Sub
For Each Product in oMsi.Products
If Len(Product) = 38 Then
If UCase(Right(Product,28)) = O11 Then
'Found Office 2003 Product. Set flag to not remove the OSE service
Exit Sub
End If
If UCase(Right(Product,PRODLEN))=OFFICEID Then
Select Case Mid(Product,4,2)
Case "12","14","15","16","17"
'Found another Office product. Set flag to keep the OSE service
If NOT Mid(Product,4,2) = OVERSIONMAJOR Then
fRemoveOse = False
Exit Sub
End If
Case Else
End Select
End If
End If '38
Next 'Product
fRemoveOse = True
End Sub 'CheckRemoveOSE
'=======================================================================================================
'Check if OSPP service can be scrubbed
Sub CheckRemoveOSPP
Dim Product
If NOT CInt(OVERSIONMAJOR) > 12 Then
fRemoveOspp = False
Exit Sub
End If
If fRemoveOspp Then Exit Sub
For Each Product in oMsi.Products
If Len(Product) = 38 Then
If UCase(Right(Product,PRODLEN))=OFFICEID Then
Select Case Mid(Product,4,2)
Case "14","15","16","17"
'Found another Office product. Set flag to keep the OSPP service
If NOT Mid(Product,4,2) = OVERSIONMAJOR Then
fRemoveOspp = False
Exit Sub
End If
Case Else
End Select
End If
End If '38
Next 'Product
fRemoveOspp = True
End Sub 'CheckRemoveOSPP
'=======================================================================================================
'Cache .msi files for products that will be removed in case they are needed for later file detection
Sub CacheMsiFiles
Dim Product
Dim sMsiFile
'Non critical routine for failures.
'Errors will be logged but must not fail the execution
On Error Resume Next
Log " Cache .msi files to temporary Scrub folder"
'Cache the files
For Each Product in oMsi.Products
'Ensure valid GUID length
If InScope(Product) Then
If (fRemoveAll OR CheckDelete(Product))Then
CheckError "CacheMsiFiles"
sMsiFile = oMsi.ProductInfo(Product,"LocalPackage") : CheckError "CacheMsiFiles"
LogOnly " - " & Product & ".msi"
If oFso.FileExists(sMsiFile) Then oFso.CopyFile sMsiFile,sScrubDir & "/" & Product & ".msi",True
CheckError "CacheMsiFiles"
End If
End If 'InScope
Next 'Product
Err.Clear
End Sub 'CacheMsiFiles
'=======================================================================================================
'Build a list of all files that will be deleted
Sub ScanComponents
Const MSIINSTALLSTATE_LOCAL = 3
Dim FileList, RegList, ComponentID, CompClient, Record, qView, MsiDb
Dim Processes, Process, Prop, prod
Dim sQuery, sSubKeyName, sPath, sFile, sMsiFile, sCompClient, sComponent, sCompReg
Dim fRemoveComponent, fAffectedComponent, fIsPermanent
Dim i, iProgress, iCompCnt, iRemCnt
Dim dicFLError, oDic, oFolderDic, dicCompPath
Dim hDefKey
'Logfile
Set FileList = oFso.OpenTextFile(sScrubDir & "/FileList.txt",FOR_WRITING,True,True)
Set RegList = oFso.OpenTextFile(sScrubDir & "/RegList.txt",FOR_WRITING,True,True)
'FileListError dic
Set dicFLError = CreateObject("Scripting.Dictionary")
Set oDic = CreateObject("Scripting.Dictionary")
Set oFolderDic = CreateObject("Scripting.Dictionary")
Set dicCompPath = CreateObject("Scripting.Dictionary")
'Prevent that API errors fail script execution
On Error Resume Next
iCompCnt = oMsi.Components.Count
If NOT Err = 0 Then
'API failure
Log "Error during components detection. Cannot complete this task."
Err.Clear
Exit Sub
End If
'Ensure to not divide by zero
If iCompCnt = 0 Then iCompCnt = 1
LogOnly " Scanning " & iCompCnt & " components"
'Enum all Components
For Each ComponentID In oMsi.Components
'Progress bar
i = i + 1
If iProgress < (i / iCompCnt) * 100 Then
wscript.stdout.write "." : LogStream.Write "."
iProgress = iProgress + 1
If iProgress = 35 OR iProgress = 70 Then Log ""
End If
'Check if all ComponentClients will be removed
sCompClient = ""
iRemCnt = 0
fIsPermanent = False
fRemoveComponent = False 'Flag to track if the component will be completely removed
fAffectedComponent = False 'Flag to track if some clients remain installed who have a none shared location
dicCompPath.RemoveAll
For Each CompClient In oMsi.ComponentClients(ComponentID)
If Err = 0 Then
'Ensure valid guid length
If Len(CompClient) = 38 Then
sPath = ""
sPath = LCase(oMsi.ComponentPath(CompClient,ComponentID))
sPath = Replace(sPath,"?",":")
'Scan for msidbComponentAttributesPermanent flag
If CompClient = "{00000000-0000-0000-0000-000000000000}" Then
fIsPermanent = True
iRemCnt = iRemCnt + 1
End If
fRemoveComponent = InScope(CompClient)
If fRemoveComponent Then fRemoveComponent = CheckDelete(CompClient)
If fRemoveComponent Then
iRemCnt = iRemCnt + 1
fAffectedComponent = True
'Since the scope remains within one Office family the keypath for the component
'is assumed to be identical
If sCompClient = "" Then sCompClient = CompClient
Else
If NOT dicCompPath.Exists(sPath) Then dicCompPath.Add sPath,CompClient
End If
Else
If NOT dicFLError.Exists("Error: Invalid metadata found. ComponentID: "&ComponentID &", ComponentClient: "&CompClient) Then _
dicFLError.Add "Error: Invalid metadata found. ComponentID: "&ComponentID &", ComponentClient: "&CompClient, ComponentID
End If '38
Else
Err.Clear
End If 'Err = 0
Next 'CompClient
'Determine if the component resources go away
sPath = ""
fRemoveComponent = fAffectedComponent AND (iRemCnt = oMsi.ComponentClients(ComponentID).Count)
If NOT fRemoveComponent AND fAffectedComponent Then
'Flag as removable if component has a unique keypath
sPath = LCase(oMsi.ComponentPath(sCompClient,ComponentID))
sPath = Replace(sPath,"?",":")
fRemoveComponent = NOT dicCompPath.Exists(sPath)
End If
If fRemoveComponent Then
'Check msidbComponentAttributesPermanent flag
If fIsPermanent AND NOT fForce Then fRemoveComponent = False
End If
If fRemoveComponent Then
'Component resources go away for this product
Err.Clear
'Add the component registration key to ensure removal
sCompReg = "Installer/Components/"&GetCompressedGuid(ComponentID)&"/"
If NOT dicDelRegKey.Exists(sCompReg) Then
dicDelRegKey.Add sCompReg,HKCR
RegList.WriteLine HiveString(HKCR)&"/"&sCompReg
End If
sCompReg = "SOFTWARE/Microsoft/Windows/CurrentVersion/Installer/UserData/S-1-5-18/Components/"&GetCompressedGuid(ComponentID)&"/"
If NOT dicDelRegKey.Exists(sCompReg) Then
dicDelRegKey.Add sCompReg,HKLM
RegList.WriteLine Hi