Office 2007打开文档提示安装Web Developer和MUI解决

主要解决办法是卸载 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 to close this window"
            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

你可能感兴趣的:(行业的足迹,office,web,文档,each,delete,function)