vbs=r''' '======================================================================================================= ' Name: OffScrub10.vbs ' Author: Microsoft Customer Support Services ' Copyright (c) 2009,2010 Microsoft Corporation ' Script to remove (scrub) Office 2010 products '======================================================================================================= Option Explicit Const SCRIPTVERSION = "1.36_fixit" Const SCRIPTFILE = "OffScrub10.vbs" Const SCRIPTNAME = "OffScrub10" Const RETVALFILE = "ScrubRetValFile.txt" Const OVERSION = "14.0" Const OVERSIONMAJOR = "14" Const OREF = "Office14" Const OREGREF = "OFFICE14." Const ONAME = "Office 2010" Const OPACKAGE = "PackageRefs" 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 Const ERROR_SUCCESS = 0 'Bit #1. 0 indicates Success. Script completed successfully Const ERROR_FAIL = 1 'Bit #1. Failure bit. Indicates an overall script failure. 'RESERVED bit! Returned when process is killed from task manager Const ERROR_REBOOT_REQUIRED = 2 'Bit #2. Reboot bit. If set a reboot is required Const ERROR_USERCANCEL = 4 'Bit #3. User Cancel bit. Controlled cancel from script UI Const ERROR_STAGE1 = 8 'Bit #4. Informational. Error in stage 1. Cleanup operation might leave some files behind Const ERROR_STAGE2 = 16 'Bit #5. Informational. Application removal with 'Setup.exe' is no longer possible Const ERROR_STAGE3 = 32 'Bit #6. Informational. Indicates integrity of Windows Installer metadata is in a bad state Const ERROR_STAGE4 = 64 'Bit #7. Critical script error. Script could not apply the intended cleanup operations Const ERROR_ELEVATION_USERDECLINED = 128 'Bit #8. Critical script error. User declined to allow mandatory script elevation Const ERROR_ELEVATION = 256 'Bit #9. Critical script error. The attempt to elevate the process did not succeed Const ERROR_SCRIPTINIT = 512 'Bit #10. Critical script error. Initialization failed Const ERROR_RELAUNCH = 1024'Bit #11. Critical script error. This is a temporary value and must not be the final return code Const ERROR_UNKNOWN = 2048'Bit #12 Critical script error. Script did not complete in a well defined state Const ERROR_ALL = 4095'Full BitMask Const ERROR_USER_ABORT = &HC000013A 'RESERVED. Dec -1073741510. Critical error. Returned when user aborts with + or closes the cmd window Const ERROR_INSTALL_FAILURE = 1603 Const INVALID_COMMAND_LINE = 1639 Const INSTALL_ALREADY_RUNNING = 1618 Const ERROR_SUCCESS_CONFIG_COMPLETE = 1728 Const ERROR_SUCCESS_REBOOT_REQUIRED = 3010 '======================================================================================================= 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,sProgramData,sLocalAppData,sOInstallRoot '======================================================================================================= 'Main '======================================================================================================= 'Configure defaults Dim iError : iError = ERROR_SUCCESS 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 = True 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 'Create the temp folder If Not oFso.FolderExists(sScrubDir) Then oFso.CreateFolder sScrubDir 'Set the default logging directory sLogDir = sScrubDir '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)%") 'Update error flag SetError ERROR_SCRIPTINIT If NOT CheckRegPermissions Then 'Try to relaunch elevated RelaunchElevated 'Can't relaunch. Exit out SetError ERROR_ELEVATION 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 ' update cached error SetRetVal iError Wscript.Quit iError End If ' clear error flags ClearError ERROR_ELEVATION ClearError ERROR_SCRIPTINIT 'Ensure CScript as engine If Not UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C" Then RelaunchAsCScript ' set retval for file based logic. Needs to be kept on 'user abort' SetRetVal ERROR_USER_ABORT '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") '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 'Init complete. Reset the return value ClearError ERROR_SCRIPTINIT '-------------------------------- '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 ' update cached error and quit SetRetVal iError wscript.quit iError '======================================================================================================= '======================================================================================================= '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." SetError ERROR_STAGE1 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 HiveString(HKCR)&"\"&sCompReg End If 'Get the component path If sPath = "" Then sPath = LCase(oMsi.ComponentPath(sCompClient,ComponentID)) sPath = Replace(sPath,"?",":") End If If Len(sPath) > 4 Then If Left(sPath,1) = "0" Then 'Registry keypath Select Case Left(sPath,2) Case "00" sPath = Mid(sPath,5) hDefKey = HKCR Case "01" sPath = Mid(sPath,5) hDefKey = HKCU Case "02","22" sPath = Mid(sPath,5) hDefKey = HKLM Case Else ' End Select If NOT dicDelRegKey.Exists(sPath) Then dicDelRegKey.Add sPath,hDefKey RegList.WriteLine HiveString(hDefKey)&"\"&sPath End If Else 'File If oFso.FileExists(sPath) Then sPath = oFso.GetFile(sPath).ParentFolder If Not oFolderDic.Exists(sPath) Then oFolderDic.Add sPath,sPath 'Get the .msi file If oFso.FileExists(sScrubDir & "\" & sCompClient & ".msi") Then sMsiFile = sScrubDir & "\" & sCompClient & ".msi" Else sMsiFile = oMsi.ProductInfo(sCompClient,"LocalPackage") End If If Not Err = 0 Then If NOT dicFLError.Exists("Failed to obtain .msi file for product "&sCompClient) Then _ dicFLError.Add "Failed to obtain .msi file for product "&sCompClient, ComponentID Err.Clear End If Set MsiDb = oMsi.OpenDatabase(sMsiFile,MSIOPENDATABASEREADONLY) If Err = 0 Then 'Get the component name from the 'Component' table sQuery = "SELECT `Component`,`ComponentId` FROM Component WHERE `ComponentId` = '" & ComponentID &"'" Set qView = MsiDb.OpenView(sQuery) : qView.Execute Set Record = qView.Fetch() If Not Record Is Nothing Then sComponent = Record.Stringdata(1) 'Get filenames from the 'File' table sQuery = "SELECT `Component_`,`FileName` FROM File WHERE `Component_` = '" & sComponent &"'" Set qView = MsiDb.OpenView(sQuery) : qView.Execute Set Record = qView.Fetch() Do Until Record Is Nothing 'Read the filename sFile = Record.StringData(2) If InStr(sFile,"|") > 0 Then sFile = Mid(sFile,InStr(sFile,"|")+1,Len(sFile)) 'sFile = sPath & "\" & sFile If Not oDic.Exists(sPath & "\" & sFile) Then 'Exception handler fAdd = True Select Case UCase(sFile) Case "FPERSON.DLL" For Each prod in oMsi.Products If NOT Checkdelete(prod) Then If oMsi.FeatureState(prod, "MSTagPluginNamesFiles") = MSIINSTALLSTATE_LOCAL Then fAdd = False Exit For End If End If Next 'prod Case Else End Select If fAdd Then oDic.Add sPath & "\" & sFile,sFile FileList.WriteLine sFile If Len(sFile)>4 Then sFile = LCase(sFile) If Right(sFile,4) = ".exe" Then If NOT dicApps.Exists(sFile) Then Select Case sFile Case "setup.exe","ose.exe","osppsvc.exe","explorer.exe","cvhsvc.exe","sftvsa.exe","sftlist.exe","sftplay.exe","sftvol.exe","sftfs.exe" Case Else dicApps.Add sFile,LCase(sPath) & "\" & sFile End Select End If 'dicApps.Exists End If '.exe End If 'Len > 4 End If 'fAdd End If 'oDic.Exists Set Record = qView.Fetch() Loop Set Record = Nothing qView.Close Set qView = Nothing Else If NOT dicFLError.Exists("Error: Could not read from .msi file: "&sMsiFile) Then _ dicFLError.Add "Error: Could not read from .msi file: "&sMsiFile, ComponentID Err.Clear End If 'Err = 0 End If 'FileExists(sPath) End If End If 'Len(sPath) > 4 Else 'Add the path to the 'Keep' dictionary Err.Clear For Each CompClient In oMsi.ComponentClients(ComponentID) 'Get the component path sPath = "" : sPath = LCase(oMsi.ComponentPath(CompClient,ComponentID)) sPath = Replace(sPath,"?",":") If Len(sPath) > 4 Then If Left(sPath,1) = "0" Then 'Registry keypath Select Case Left(sPath,2) Case "00" sPath = Mid(sPath,5) hDefKey = HKCR Case "01" sPath = Mid(sPath,5) hDefKey = HKCU Case "02","22" sPath = Mid(sPath,5) hDefKey = HKLM Case Else ' End Select If NOT dicKeepReg.Exists(LCase(sPath)) Then dicKeepReg.Add LCase(sPath),hDefKey End If Else 'File keypath If oFso.FileExists(sPath) Then If NOT dicKeepFolder.Exists(LCase(sPath)) Then dicKeepFolder.Add LCase(sPath) sPath = LCase(oFso.GetFile(sPath).ParentFolder) & "\" If NOT dicKeepFolder.Exists(sPath) Then AddKeepFolder sPath End If 'Folder keypath If oFso.FolderExists(sPath) Then AddKeepFolder sPath End If 'Is Registry End If 'sPath > 4 Next 'CompClient End If 'fRemoveComponent Next 'ComponentID Err.Clear On Error Goto 0 'Click2Run detection If C2RInstalled Then 'Add executables that might need to be closed If NOT dicApps.Exists("cvh.exe") Then dicApps.Add "cvh.exe","cvh.exe" If NOT dicApps.Exists("officevirt.exe") Then dicApps.Add "officevirt.exe","officevirt.exe" Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process") For Each Process in Processes For Each Prop in Process.Properties_ If Prop.Name = "ExecutablePath" Then If Len(Prop.Value) > 2 Then If UCase(Left(Prop.Value,2)) = "Q:" Then If NOT dicApps.Exists(LCase(Process.Name)) Then dicApps.Add LCase(Process.Name),Process.Name End If 'Q: End If '>2 End If 'ExcecutablePath Next 'Prop Next 'Process End If 'C2RInstalled Log " Done" & vbCrLf If dicFLError.Count > 0 Then LogOnly Join(dicFLError.Keys,vbCrLf) If Not oFolderDic.Count = 0 Then arrDeleteFolders = oFolderDic.Keys Else Set arrDeleteFolders = Nothing If Not oDic.Count = 0 Then arrDeleteFiles = oDic.Keys Else Set arrDeleteFiles = Nothing End Sub 'ScanComponents '======================================================================================================= 'Detect if Click2Run products are installed on the client Function C2RInstalled Dim Key, sPKey, sValue, VProd Dim arrKeys If RegEnumKey (HKLM,REG_ARP,arrKeys) Then For Each Key in arrKeys If InScope(Key)=38 Then If RegReadValue(HKLM,REG_ARP&"\"&Key,"CVH",sValue,"REG_DWORD") Then If sValue = "1" Then C2RInstalled = True Exit Function End If End If End If Next 'Key End If 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 GetProductID(Mid(sPKey,5,4)) = "CLICK2RUN" Then C2RInstalled = True Exit Function End If End If End If Next 'Key End If End Function 'C2RInstalled '======================================================================================================= 'Try to remove the products by calling setup.exe Sub SetupExeRemoval Dim OseService, Service, TextStream Dim iSetupCnt, RetVal Dim Sku, sConfigFile, sUninstallCmd, sCatalyst, sCVHBS, sDll, sDisplayLevel, sNoCancel iSetupCnt = 0 If Not dicRemoveSku.Count > 0 Then Log " Nothing to remove for Setup.exe" Exit Sub End If For Each Sku in dicRemoveSku.Keys If Sku="CLICK2RUN" Then 'Reset Softgrid ResetSG If f64 Then sCVHBS = sCommonProgramFilesX86 & "\Microsoft Shared\Virtualization Handler\CVHBS.exe" Else sCVHBS = sCommonProgramFiles & "\Microsoft Shared\Virtualization Handler\CVHBS.exe" End If If oFso.FileExists(sCVHBS) Then CvhbsDialogHandler sUninstallCmd = Chr(34) & sCVHBS & Chr(34) & " /removesilent" iSetupCnt = iSetupCnt + 1 Log " - Calling CVHBS.exe to remove " & Sku If Not fDetectOnly Then On Error Resume Next RetVal = oWShell.Run(sUninstallCmd,0,True) : CheckError "CVHBSRemoval" fRebootRequired = True SetError ERROR_REBOOT_REQUIRED Log " - CVHBS.exe returned: " & SetupRetVal(Retval) & " (" & RetVal & ")" & vbCrLf On Error Goto 0 Else Log " -> Removal suppressed in preview mode." End If Else Log "Error: Office Click-to-Run CVHBS.exe appears to be missing" End If 'oFso.FileExists 'Make sure that C2R keys are gone to unblock the msiexec task End If 'Sku = Click2run Next 'Sku 'Ensure that the OSE service is *installed, *not disabled, *running under System context. 'If validation fails exit out of this sub. Set OseService = oWmiLocal.Execquery("Select * From Win32_Service Where Name like 'ose%'") If OseService.Count = 0 Then Exit Sub For Each Service in OseService If (Service.StartMode = "Disabled") AND (Not Service.ChangeStartMode("Manual")=0) Then Exit Sub If (Not Service.StartName = "LocalSystem") AND (Service.Change( , , , , , , "LocalSystem", "")) Then Exit Sub Next 'Service For Each Sku in dicRemoveSku.Keys If Sku="CLICK2RUN" Then 'Already done Else 'Create an "unattended" config.xml file for uninstall If fQuiet Then sDisplayLevel = "None" Else sDisplayLevel="Basic" If fNoCancel Then sNoCancel="Yes" Else sNoCancel="No" Set TextStream = oFso.OpenTextFile(sScrubDir & "\config.xml",FOR_WRITING,True,True) TextStream.Writeline "" TextStream.Writeline "" TextStream.Writeline "" TextStream.Writeline "" TextStream.Writeline "" TextStream.Close Set TextStream = Nothing 'Ensure path to setup.exe is valid to prevent errors sDll = "" If RegReadValue(HKLM,REG_ARP & OREGREF & Sku,"UninstallString",sCatalyst,"REG_SZ") Then If InStr(LCase(sCatalyst),"/dll")>0 Then sDll = Right(sCatalyst,Len(sCatalyst)-InStr(LCase(sCatalyst),"/dll")+2) If InStr(sCatalyst,"/")>0 Then sCatalyst = Left(sCatalyst,InStr(sCatalyst,"/")-1) sCatalyst = Trim(Replace(sCatalyst,Chr(34),"")) If NOT oFso.FileExists(sCatalyst) Then sCatalyst = sCommonProgramFiles & "\" & OREF & "\Office Setup Controller\setup.exe" If NOT oFso.FileExists(sCatalyst) AND f64 Then sCatalyst = sCommonProgramFilesX86 & "" & OREF & "\Office Setup Controller\setup.exe" End If End If If oFso.FileExists(sCatalyst) Then sUninstallCmd = Chr(34) & sCatalyst & Chr(34) & " /uninstall " & Sku & " /config " & Chr(34) & sScrubDir & "\config.xml" & Chr(34) & sDll iSetupCnt = iSetupCnt + 1 Log " - Calling Setup.exe to remove " & Sku '& vbCrLf & sUninstallCmd If Not fDetectOnly Then On Error Resume Next RetVal = oWShell.Run(sUninstallCmd,0,True) : CheckError "SetupExeRemoval" Log " - Setup.exe returned: " & SetupRetVal(Retval) & " (" & RetVal & ")" & vbCrLf fRebootRequired = fRebootRequired OR (RetVal = "3010") If fRebootRequired Then SetError ERROR_REBOOT_REQUIRED Select Case CInt(RetVal) Case ERROR_SUCCESS,ERROR_SUCCESS_CONFIG_COMPLETE,ERROR_SUCCESS_REBOOT_REQUIRED 'success no action required Case Else SetError ERROR_STAGE2 End Select On Error Goto 0 Else Log " -> Removal suppressed in preview mode." End If Else Log " Error: Office setup.exe appears to be missing" SetError ERROR_STAGE2 End If 'RetVal = 0) AND oFso.FileExists End If 'RegReadValue End If 'C2R Next 'Sku If iSetupCnt = 0 Then Log " Nothing to remove for setup." End Sub 'SetupExeRemoval '======================================================================================================= 'Invoke msiexec to remove individual .MSI packages Sub MsiexecRemoval Dim Product Dim i Dim sCmd, sReturn, sMsiProp Dim fRegWipe, fC2RRegWipe fRegWipe = False fC2RRegWipe = False Select Case OVERSIONMAJOR Case "11" sMsiProp = " REBOOT=ReallySuppress NOLOCALCACHEROLLBACK=1" Case "12" fRegWipe = True sMsiProp = " REBOOT=ReallySuppress NOREMOVESPAWN=True" Case "14" fRegWipe = True sMsiProp = " REBOOT=ReallySuppress NOREMOVESPAWN=True" fC2RRegWipe = True Case Else End Select 'Clear up ARP first to avoid possible custom action dependencies If fRegWipe Then RegWipeARP 'Check MSI registered products 'Office System does only support per machine installation so it's sufficient to use Installer.Products i = 0 For Each Product in oMsi.Products If InScope(Product) Then If fRemoveAll OR CheckDelete(Product) Then i = i + 1 Log " Calling msiexec.exe to remove " & Product sCmd = "msiexec.exe /x" & Product & sMsiProp If fC2RRegWipe Then 'Need to clear out C2R registration first If Mid(Product,11,3)="006" Then RegWipeC2R End If If fQuiet Then sCmd = sCmd & " /q" Else sCmd = sCmd & " /qb-" End If sCmd = sCmd & " /l*v+ "&chr(34)&sLogDir&"\Uninstall_"&Product&".log"&chr(34) If NOT fDetectOnly Then LogOnly " - Calling msiexec with '"&sCmd&"'" 'Execute the patch uninstall sReturn = oWShell.Run(sCmd, 0, True) Log " - msiexec returned: " & SetupRetVal(sReturn) & " (" & sReturn & ")" & vbCrLf fRebootRequired = fRebootRequired OR (sReturn = "3010") If fRebootRequired Then SetError ERROR_REBOOT_REQUIRED Select Case CInt(sReturn) Case ERROR_SUCCESS,ERROR_SUCCESS_CONFIG_COMPLETE,ERROR_SUCCESS_REBOOT_REQUIRED 'success no action required Case Else SetError ERROR_STAGE3 End Select Else Log " -> Removal suppressed in preview mode." LogOnly " -> Command: "&sCmd End If End If 'CheckDelete End If 'InScope Next 'Product If i = 0 Then Log " Nothing to remove for msiexec" End Sub 'MsiexecRemoval '======================================================================================================= 'Remove the OSE (Office Source Engine) service Sub RemoveOSE On Error Resume Next Log vbCrLf & " OSE CleanUp" DeleteService "ose" 'Delete the folder DeleteFolder sCommonProgramFiles & "\Microsoft Shared\Source Engine" 'Delete the registration RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\ose\" End Sub 'RemoveOSE '======================================================================================================= 'Remove the Softgrid services (App-V and Click2Run) Sub RemoveSG On Error Resume Next Log " Softgrid CleanUp" DeleteService("cvhsvc") DeleteService("SftList") DeleteService("SftPlay") DeleteService("SftVol") DeleteService("SftFs") DeleteService("SftVsa") 'Delete the folder DeleteFolder sAppdata & "\SoftGrid Client" DeleteFolder sLocalAppData & "\SoftGrid Client" DeleteFolder sProgramData & "\Microsoft\Application Virtualization Client\SoftGrid Client" DeleteFolder sProgramData & "\Microsoft\Application Virtualization Client" DeleteFolder sProgramfiles & "\Microsoft\Microsoft Application Virtualization Client" DeleteFolder sProgramfiles & "\Microsoft Application Virtualization Client" 'Delete the registration RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\cvhsvc" RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\sftfs" RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\sftlist" RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\sftplay" RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\sftredir" RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\sftvol" RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\sftvsa" RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\sftfs" RegDeleteKey HKLM,"SOFTWARE\Microsoft\SoftGrid\4.5" RegDeleteKey HKCU,"Software\Microsoft\SoftGrid\4.5\Client\AppFS" RegDeleteKey HKCU,"Software\Microsoft\SoftGrid\4.5\Client\Applications" RegDeleteKey HKCU,"Software\Microsoft\SoftGrid\4.5\Client\FileExtensions" RegDeleteKey HKCU,"Software\Microsoft\SoftGrid\4.5\Client\FileTypes" RegDeleteKey HKCU,"Software\Microsoft\SoftGrid\4.5\Client\UserInfo" 'C2R places custom permissions on these regkeys which prevent them from getting deleted 'RegDeleteKey HKCU,"Software\Microsoft\SoftGrid\4.5\Client\Network" 'RegDeleteKey HKCU,"Software\Microsoft\SoftGrid\4.5\Client\Packages" 'RegDeleteKey HKCU,"Software\Microsoft\SoftGrid\4.5\Client" 'RegDeleteKey HKCU,"Software\Microsoft\SoftGrid\4.5" End Sub 'RemoveSG '======================================================================================================= 'Stops all Softgrid services and virtual applications Sub ResetSG Dim Processes, Process Dim fWait Dim iRet On Error Resume Next fWait = False Log " Doing Action: ResetSG" 'Close all running (virtualized) Office applications 'OfficeVirt.exe needs to be shut down first Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name like 'officevirt%.exe'") For Each Process in Processes Log " - End process " & Process.Name iRet = Process.Terminate() CheckError "ResetSG: " & "Process.Name" fWait = True Next 'Process 'Shut down CVH.exe Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name='cvh.exe'") For Each Process in Processes Log " - End process " & Process.Name iRet = Process.Terminate() CheckError "ResetSG: " & "Process.Name" Next 'Process 'Close running instances Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process") For Each Process in Processes If dicApps.Exists(LCase(Process.Name)) Then Log " - End process " & Process.Name iRet = Process.Terminate() CheckError "CloseOfficeApps: " & "Process.Name" End If Next 'Process If fWait Then wscript.sleep 10000 'Stop all SoftGrid services iRet = StopService("cvhsvc") iRet = StopService("SftList") iRet = StopService("SftPlay") iRet = StopService("SftVol") iRet = StopService("SftFs") iRet = StopService("SftVsa") End Sub 'ResetSG '======================================================================================================= 'File cleanup operations for the Local Installation Source (MSOCache) Sub WipeLIS Const LISROOT = "MSOCache\All Users\" Dim LogicalDisks, Disk, Folder, SubFolder, MseFolder, File, Files Dim arrSubFolders Dim sFolder Dim fRemoveFolder Log vbCrLf & " LIS CleanUp" 'Search all hard disks Set LogicalDisks = oWmiLocal.ExecQuery("Select * From Win32_LogicalDisk WHERE DriveType=3") For Each Disk in LogicalDisks If oFso.FolderExists(Disk.DeviceID & "\" & LISROOT) Then Set Folder = oFso.GetFolder(Disk.DeviceID & "\" & LISROOT) For Each Subfolder in Folder.Subfolders If Len(Subfolder) > 37 Then If fRemoveAll Then If (Mid(Subfolder.Name,26,PRODLEN) = OFFICEID AND Mid(SubFolder.Name,4,2)=OVERSIONMAJOR) OR _ LCase(Right(Subfolder.Name,7)) = OVERSIONMAJOR &".data" Then DeleteFolder Subfolder.Path Else If (Mid(Subfolder.Name,26,PRODLEN) = OFFICEID AND Mid(SubFolder.Name,4,2)=OVERSIONMAJOR) AND _ CheckDelete(UCase(Left(Subfolder.Name,38))) AND _ UCase(Right(Subfolder,1))= UCase(Left(Disk.DeviceID,1))Then DeleteFolder Subfolder.Path End If End If 'Len > 37 Next 'Subfolder If (Folder.Subfolders.Count = 0) AND (Folder.Files.Count = 0) Then sFolder = Folder.Path Set Folder = Nothing SmartDeleteFolder sFolder End If End If 'oFso.FolderExists Next 'Disk 'MSECache If EnumFolders(sProgramFiles,arrSubFolders) Then For Each SubFolder in arrSubFolders If UCase(Right(SubFolder,9))="\MSECACHE" Then ReDim arrMseFolders(-1) Set Folder = oFso.GetFolder(SubFolder) GetMseFolderStructure Folder For Each MseFolder in arrMseFolders If oFso.FolderExists(MseFolder) Then fRemoveFolder = False Set Folder = oFso.GetFolder(MseFolder) Set Files = Folder.Files For Each File in Files If (LCase(Right(File.Name,4))=".msi") Then If CheckDelete(ProductCode(File.Path)) Then fRemoveFolder = True Exit For End If 'CheckDelete End If Next 'File Set Files = Nothing