This article helps those who get the 0xc004d307 error when trying to rearm (reset the license) Office 2013 in a Virtual Desktop Infrastructure (VDI) and/or those trying to prep the master image for Microsoft Key Management (KMS) activation. (i.e.- Citrix, vmWare, etc.)
Issue
In a Windows environment, trying to rearm Office 2013 gets this error:
See Also
Problems installing Office 2021 Professional (windows 11) on new Laptop - Microsoft Q&AHow to Extend Office 2021/2019/2016 & Office 365 Trial Period | Windows OS HubPossible Cause
#1. The rearm count of Office has been exceeded.
#2. Office was reinstalled or previously upgraded and somehow got corrupted.
Solution #1. Uninstall/Install Office
The rearm count in Office has been exceeded. There is no way to fix this. Office needs to be uninstalled and then reinstalled so that you get your rearms back.
- Uninstall Office in Programs and Features
- Restart the OS
- Install Office
- Restart the OS
- Run the OSPPREARM.exe command again
You should now see:
Note: If Solution #1 doesn't work, try Solution #2.
Solution #2. Run the Office removal VBS
I opened a support case with Microsoft after Solution #1 didn't work. They told me that while uninstalling Office usually resets the rearms, sometimes every component isn't removed . This causes a problem when trying to rearm on the fresh install. Running the script (get code below) fully removes all components from Windows.
- Uninstall Office in Programs and Features
- Copy the script data (get code below) into a text file called script.vbs and save it to the C drive.
(Note: Make sure you see a script icon and not a text file icon. If you see a text file icon, you need to go into folder options, unhide known file extensions and then remove the .txt from the end of the file name. Make sure it only shows script.vbs) - Double click the script.vbs file to run it
- Restart the OS
- Install Office
- Restart the OS
- Run the OSPPREARM.exe command again
You should now see:
Office Removal VBS
NOTE: I make no promises and am not liable for any problems caused by using this script. It is exactly intact as the way that it was given to me by Microsoft. No modifications have been made. This only works for Office 2013. It does not work in 2016.
'=======================================================================================================' Name: OffScrub_O15msi.vbs' Author: Microsoft Customer Support Services' Copyright (c) 2011, 2012 Microsoft Corporation' Script to remove (scrub) Office 2013 MSI products' when a regular uninstall is no longer possible'=======================================================================================================Option ExplicitConst SCRIPTVERSION = "1.72"Const SCRIPTFILE = "OffScrub_O15msi.vbs"Const SCRIPTNAME = "OffScrub_O15msi"Const OVERSION = "15.0"Const OVERSIONMAJOR = "15"Const OREF = "Office15"Const OREGREF = "OFFICE15."Const ONAME = "Office 2013 MSI"Const OPACKAGE = "PackageRefs"Const OFFICEID = "000000FF1CE}"Const HKCR = &H80000000Const HKCU = &H80000001Const HKLM = &H80000002Const HKU = &H80000003Const FOR_WRITING = 2Const PRODLEN = 12Const COMPPERMANENT = "00000000000000000000000000000000"Const UNCOMPRESSED = 38Const SQUISHED = 20Const COMPRESSED = 32Const REG_ARP = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"Const VB_YES = 6Const MSIOPENDATABASEREADONLY = 0'=======================================================================================================Dim oFso, oMsi, oReg, oWShell, oWmiLocal, oShellAppDim ComputerItem, Item, LogStream, TmpKeyDim arrTmpSKUs, arrDeleteFiles, arrDeleteFolders, arrMseFolders, arrVersionDim dicKeepProd, dicKeepLis, dicApps, dicKeepFolder, dicDelRegKey, dicKeepRegDim dicInstalledSku, dicRemoveSku, dicKeepSku, dicSrv, dicCSuite, dicCSingleDim f64, fLegacyProductFoundDim sErr, sTmp, sSkuRemoveList, sDefault, sWinDir, sWICacheDir, sModeDim sAppData, sTemp, sScrubDir, sProgramFiles, sProgramFilesX86, sCommonProgramFilesDim sAllusersProfile, sOSinfo, sOSVersion, sCommonProgramFilesX86, sProfilesDirectoryDim sProgramData, sLocalAppData, sOInstallRootDim iVersionNT'======================================================================================================='Main'======================================================================================================='Configure defaultsDim sLogDir : sLogDir = ""Dim sMoveMessage: sMoveMessage = ""Dim fRemoveOse : fRemoveOse = FalseDim fRemoveOspp : fRemoveOspp = FalseDim fRemoveAll : fRemoveAll = FalseDim fRemoveCSuites : fRemoveCSuites = FalseDim fRemoveCSingle : fRemoveCSingle = FalseDim fRemoveSrv : fRemoveSrv = FalseDim fKeepUser : fKeepUser = True 'Default to keep per user settingsDim fSkipSD : fSkipSD = False 'Default to not Skip the Shortcut DetectionDim fDetectOnly : fDetectOnly = FalseDim fQuiet : fQuiet = FalseDim fBasic : fBasic = FalseDim fNoCancel : fNoCancel = FalseDim fNoElevate : fNoElevate = FalseDim fIsElevated : fIsElevated = FalseDim fTryReconcile : fTryReconcile = False'CAUTION! -> "fForce" will kill running applications which can result in data loss! <- CAUTIONDim fForce : fForce = False'CAUTION! -> "fForce" will kill running applications which can result in data loss! <- CAUTIONDim fLogInitialized : fLogInitialized = FalseDim fBypass_Stage1 : fBypass_Stage1 = True 'Component DetectionDim fBypass_Stage2 : fBypass_Stage2 = False 'SetupDim fBypass_Stage3 : fBypass_Stage3 = False 'MsiexecDim fBypass_Stage4 : fBypass_Stage4 = False 'CleanUpDim fRebootRequired : fRebootRequired = False'Create required objectsSet oWmiLocal = GetObject("winmgmts:{(Debug)}\\.\root\cimv2")Set oWShell = CreateObject("Wscript.Shell")Set oShellApp = CreateObject("Shell.Application")Set oFso = CreateObject("Scripting.FileSystemObject")Set oMsi = CreateObject("WindowsInstaller.Installer")Set oReg = GetObject("winmgmts:\\.\root\default:StdRegProv")'Get environment path infosAppData = oWShell.ExpandEnvironmentStrings("%appdata%")sLocalAppData = oWShell.ExpandEnvironmentStrings("%localappdata%")sTemp = oWShell.ExpandEnvironmentStrings("%temp%")sAllUsersProfile = oWShell.ExpandEnvironmentStrings("%allusersprofile%")RegReadValue HKLM, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList", "ProfilesDirectory", sProfilesDirectory, "REG_EXPAND_SZ"If NOT oFso.FolderExists(sProfilesDirectory) Then sProfilesDirectory = oFso.GetParentFolderName(oWShell.ExpandEnvironmentStrings("%userprofile%"))End IfsProgramFiles = 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 OSSet ComputerItem = oWmiLocal.ExecQuery("Select * from Win32_ComputerSystem")For Each Item In ComputerItemf64 = Instr(Left(Item.SystemType,3),"64") > 0If f64 Then Exit ForNextIf f64 Then sProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%programfiles(x86)%")If f64 Then sCommonProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%CommonProgramFiles(x86)%")'Get OS details and VersionNTSet ComputerItem =oWmiLocal.ExecQuery("Select * from Win32_OperatingSystem")For Each Item in ComputerItem sOSinfo = sOSinfo & Item.Caption sOSinfo = sOSinfo & Item.OtherTypeDescriptionsOSinfo = sOSinfo & ", " & "SP " & Item.ServicePackMajorVersionsOSinfo = sOSinfo & ", " & "Version: " & Item.VersionsOsVersion = Item.VersionsOSinfo = sOSinfo & ", " & "Codepage: " & Item.CodeSetsOSinfo = sOSinfo & ", " & "Country Code: " & Item.CountryCodesOSinfo = sOSinfo & ", " & "Language: " & Item.OSLanguageNext'Build the VersionNT numberarrVersion = Split(sOsVersion,Delimiter(sOsVersion))iVersionNt = CInt(arrVersion(0))*100 + CInt(arrVersion(1))fIsElevated = CheckRegPermissionsIf NOT fIsElevated AND NOT fNoElevate Then'Try to relaunch elevatedRelaunchElevated'Can't relaunch. Exit outIf UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C" ThenIf Not fLogInitialized Then CreateLogLog "Insufficient registry access permissions - exiting"End If'Undo temporary entries created in ARPTmpKeyCleanUpwscript.quit End If'Ensure CScript as engineIf Not UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C" Then RelaunchAsCScript'Create DictionariesSet 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 folderIf Not oFso.FolderExists(sScrubDir) Then oFso.CreateFolder sScrubDir'Set the default logging directorysLogDir = sScrubDir'Call the command line parserParseCmdLine'Get Office Install FolderIf NOT RegReadValue(HKLM,"SOFTWARE\Microsoft\Office\"&OVERSION&"\Common\InstallRoot","Path",sOInstallRoot,"REG_SZ") Then sOInstallRoot = sProgramFiles & "\Microsoft Office\"&OREFEnd If'Ensure integrity of WI metadata which could fail used APIs otherwiseEnsureValidWIMetadata HKCU,"Software\Classes\Installer\Products",COMPRESSEDEnsureValidWIMetadata HKCR,"Installer\Products",COMPRESSEDEnsureValidWIMetadata HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products",COMPRESSEDEnsureValidWIMetadata HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components",COMPRESSEDEnsureValidWIMetadata HKCR,"Installer\Components",COMPRESSED'Add initial known .exe files that might need to be closeddicApps.Add "communicator.exe", "communicator.exe"dicApps.Add "setup.exe", "setup.exe"Select Case OVERSIONMAJORCase "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 "15"Case ElseEnd Select'-------------------'Stage # 0 - Basics |'-------------------'Build a list with installed/registered Office productssTmp = "Stage # 0 " & chr(34) & "Basics" & chr(34) & " (" & Time & ")"Log vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLfFindInstalledOProductsIf 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 applicableValidateRemoveSkuList'Log detection resultsIf 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: " & sModeLog "Remove OSE service: " & fRemoveOse &vbCrLf'Log preview mode if applicableIf 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 installedCheckForLegacyProductsIf fLegacyProductFound Then Log "Found legacy Office products that will not be removed." Else Log "No legacy Office products found."'Cache .msi filesIf dicRemoveSku.Count > 0 Then CacheMsiFiles'Log Sku/Prod detection resultsLogSkuResults'UnPin ShortcutsIf NOT fSkipSD AND dicRemoveSku.Count > 0 ThenOn Error Resume NextLog " Searching for pinned shortcuts"CleanShortcuts sAllUsersProfile, False, TrueCleanShortcuts sProfilesDirectory, False, TrueOn Error Goto 0End If 'NOT SkipSD'--------------------------------'Stage # 1 - Component Detection |'--------------------------------sTmp = "Stage # 1 " & chr(34) & "Component Detection" & chr(34) & " (" & Time & ")"Log vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLfIf Not fBypass_Stage1 OR fForce Then'Build a list with files which are installed/registered to a product that's going to be removedLog "Prepare for CleanUp stages."Log "Identifying removable elements. This can take several minutes."ScanComponents ElseLog "Not running Component Detection in default removal."End If'End all running Office applicationsIf 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),"=") & vbCrLfIf Not fBypass_Stage2 ThenSetupExeRemovalElseLog "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),"=") & vbCrLfIf Not fBypass_Stage3 ThenMsiexecRemovalElseLog "Skipping Msiexec.exe because bypass was requested."End If'--------------------'Stage # 4 - CleanUp |'--------------------'Removal of files and registry settingssTmp = "Stage # 4 " & chr(34) & "CleanUp" & chr(34) & " (" & Time & ")"Log vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLfIf Not fBypass_Stage4 Then'Office Source EngineIf fRemoveOse Then RemoveOSE'Local Installation Source (MSOCache)WipeLIS'Obsolete filesIf fRemoveAll Then FileWipeAll Else FileWipeIndividualEnd If'Empty FoldersDeleteEmptyFolders'Restore Explorer if neededIf fForce OR fQuiet Then RestoreExplorer'Registry dataRegWipe'Wipe orphaned files from Windows Installer cacheMsiClearOrphanedFiles'Temporary .msi files in scrubcacheDeleteMsiScrubCache'Temporary filesDelScrubTmpElseLog "Skipping CleanUp because bypass was requested."End IfIf Not sMoveMessage = "" Then Log vbCrLf & "Please remove this folder after next reboot: " & sMoveMessage'THE ENDLog vbCrLf & "End removal: " & Now & vbCrLfLog vbCrLf & "For detailed logging please refer to the log in folder " &chr(34)&sScrubDir&chr(34)&vbCrLfIf fRebootRequired ThenLog vbCrLf & "A restart is required to complete the operation!"If NOT fQuiet ThenIf MsgBox("Do you want to reboot now?",vbYesNo,"Reboot Required") = VB_YES ThenDim colOS, oOSDim oWmiRebootSet oWmiReboot = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}!\\.\root\cimv2")Set colOS = oWmiReboot.ExecQuery ("Select * from Win32_OperatingSystem")For Each oOS in colOSoOS.Reboot()NextEnd IfEnd IfEnd IfIf NOT fQuiet ThenFor Each Item in Wscript.ArgumentsIf Item = "UAC" Then wscript.stdout.write "Press <Enter> to close this window"sTemp = wscript.stdin.read(1)End IfNext 'ArgumentEnd 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 FindInstalledOProductsDim ArpItem, FileDim sCurKey, sValue, sConfigName, sProdC, sCVHValueDim sProductCodeList, sProductCode Dim arrKeys, arrMultiSzValuesDim fSystemComponent0, fPackages, fDisplayVersion, fReturn, fCategorizedIf dicInstalledSku.Count > 0 Then Exit Sub 'Already done from InputBox prompt'Handle orphaned products to get them added to the detection scopeIf fTryReconcile ThenFor Each File in oFso.GetFolder(sWICacheDir).FilesIf Len(File.Name)>3 ThenSelect Case LCase(Right(File.Name,4))Case ".msi"sProductCode = ""sProductCode = GetMsiProductCode(File.Path)If InScope(sProductCode) ThenIf NOT RegKeyExists(HKLM,REG_ARP & sProductCode) Then'Ensure the orphaned item is getting removedIf Len(sSkuRemoveList) > 0 ThensSkuRemoveList = sSkuRemoveList & "," & GetProductID(Mid(sProductCode,11,4))ElsesSkuRemoveList = GetProductID(Mid(sProductCode,11,4))End If'Add to ScrubDiroFso.CopyFile File.Path,sScrubDir & "\" & prod & ".msi",True'Register the product with MSIMsiRegisterProduct File.PathEnd If 'NOT sProductCodeEnd If 'InScopeCase ElseEnd SelectEnd If '>3Next 'FileEnd If 'fTryReconcile'Locate standalone Office products that have no configuration product entry and create a'temporary configuration entryReDim arrTmpSKUs(-1)If RegEnumKey(HKLM,REG_ARP,arrKeys) ThenFor Each ArpItem in arrKeysIf InScope(ArpItem) ThensCurKey = 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"))) ThenRegReadValue 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 itemReDim Preserve arrTmpSKUs(UBound(arrTmpSKUs)+1)arrTmpSKUs(UBound(arrTmpSKUs)) = sConfigNameoReg.CreateKey HKLM,REG_ARP & sConfigNamearrMultiSzValues(0) = sConfigNameoReg.SetMultiStringValue HKLM,REG_ARP & sConfigName,OPACKAGE,arrMultiSzValuesarrMultiSzValues(0) = ArpItemoReg.SetStringValue HKLM, REG_ARP & sConfigName, "Comment", "Temporary OffScrub generated key. Please delete this key!"oReg.SetMultiStringValue HKLM,REG_ARP & sConfigName,"ProductCodes",arrMultiSzValuesoReg.SetStringValue HKLM,REG_ARP & sConfigName,"DisplayVersion",sValueoReg.SetStringValue HKLM,REG_ARP & sConfigName,"DisplayName",SCRIPTNAME & "_" & sConfigNameoReg.SetDWordValue HKLM,REG_ARP & sConfigName,"SystemComponent",0Else'Update the existing temporary ARP itemfReturn = RegReadValue(HKLM,REG_ARP&sConfigName,"ProductCodes",sProdC,"REG_MULTI_SZ")If NOT InStr(sProdC,ArpItem)>0 Then sProdC = sProdC & chr(34) & ArpItemoReg.SetMultiStringValue HKLM,REG_ARP & sConfigName,"ProductCodes",Split(sProdC,chr(34))End If 'RegKeyExistsEnd If 'fSystemComponent0End If 'InScopeNext 'ArpItemEnd If 'RegEnumKey'Find the configuration productsIf RegEnumKey(HKLM,REG_ARP,arrKeys) ThenFor Each ArpItem in arrKeyssCurKey = 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 ThenIf Len(sValue) > 1 ThenfDisplayVersion = (Left(sValue,2) = OVERSIONMAJOR)ElsefDisplayVersion = FalseEnd IfEnd IfIf (fSystemComponent0 AND fPackages AND fDisplayVersion) ThenIf 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, ServerIf RegReadValue(HKLM, REG_ARP & OREGREF & sConfigName, "ProductCodes", sProductCodeList, "REG_MULTI_SZ") ThenfCategorized = FalseFor Each sProductCode in Split(sProductCodeList,chr(34))If Len(sProductCode) = 38 ThenIf NOT Mid(sProductCode,11,1) = "0" Then'Server productIf NOT dicSrv.Exists(UCase(sConfigName)) Then dicSrv.Add UCase(sConfigName),sConfigNamefCategorized = TrueExit ForElseSelect Case Mid(sProductCode,11,4)'Client SuitesCase "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),sConfigNamefCategorized = TrueExit ForCase ElseEnd SelectEnd IfEnd If 'Len 38Next 'sProductCodeIf NOT fCategorized ThenIf NOT dicCSingle.Exists(UCase(sConfigName)) Then dicCSingle.Add UCase(sConfigName),sConfigNameEnd If 'fCategorizedEnd If 'RegReadValue "ProductCodes"End IfNext 'ArpItemEnd If 'RegEnumKeyEnd Sub 'FindInstalledOProducts'======================================================================================================='Check if there are Office products from previous versions on the computerSub CheckForLegacyProductsConst 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 defaultfLegacyProductFound = TrueFor Each Product in oMsi.ProductsIf Len(Product) = 38 Then'Handle O09 - O11 ProductsIf InStr(OLEGACY, UCase(Right(Product, 28)))>0 Then'Found legacy Office product. Keep flag in default and exitExit SubEnd IfIf UCase(Right(Product,PRODLEN)) = OFFICEID ThenSelect Case Mid(Product,4,2)Case "12", "14"'Found legacy Office product. Keep flag in default and exitExit SubCase ElseEnd SelectEnd IfEnd If '38Next 'ProductfLegacyProductFound = FalseEnd Sub 'CheckForLegacyProducts'======================================================================================================='Create clean list of Products to remove.'Strip off bad & empty contentsSub ValidateRemoveSkuListDim Sku, Key, sProductCode, sProductCodeListDim arrRemoveSKUsIf fRemoveAll Then'Remove all modeFor Each Key in dicInstalledSku.KeysdicRemoveSku.Add Key,dicInstalledSku.Item(Key)Next 'KeyElse'Remove individual products or preconfigured configurations mode'Ensure to have a string with no unexpected contentssSkuRemoveList = Replace(sSkuRemoveList,";",",")sSkuRemoveList = Replace(sSkuRemoveList," ","")sSkuRemoveList = Replace(sSkuRemoveList,Chr(34),"")While InStr(sSkuRemoveList,",,")>0sSkuRemoveList = Replace(sSkuRemoveList,",,",",")Wend'Prepare 'remove' and 'keep' dictionaries to determine what has to be removed'Initial pre-fill of 'keep' dicFor Each Key in dicInstalledSku.KeysdicKeepSku.Add Key,dicInstalledSku.Item(Key)Next 'Key'Determine contents of keep and remove dic'Individual productsarrRemoveSKUs = Split(UCase(sSkuRemoveList),",")For Each Sku in arrRemoveSKUsIf Sku = "OSE" Then fRemoveOse = TrueIf dicKeepSku.Exists(Sku) Then'A Sku to remove has been passed in'remove the item from the keep dicdicKeepSku.Remove(Sku)'Now add it to the remove dicIf NOT dicRemoveSku.Exists(Sku) Then dicRemoveSku.Add Sku,SkuEnd IfNext 'Sku'Client Suite CategoryIf fRemoveCSuites ThenFor Each Key in dicInstalledSku.KeysIf dicCSuite.Exists(Key) ThenIf dicKeepSku.Exists(Key) Then dicKeepSku.Remove(Key)If NOT dicRemoveSku.Exists(Key) Then dicRemoveSku.Add Key,KeyEnd IfNext 'KeyEnd If 'fRemoveCSuites'Client Single/Standalone CategoryIf fRemoveCSingle ThenFor Each Key in dicInstalledSku.KeysIf dicCSingle.Exists(Key) ThenIf dicKeepSku.Exists(Key) Then dicKeepSku.Remove(Key)If NOT dicRemoveSku.Exists(Key) Then dicRemoveSku.Add Key,KeyEnd IfNext 'KeyEnd If 'fRemoveCSingle'Server CategoryIf fRemoveSrv ThenFor Each Key in dicInstalledSku.KeysIf dicSrv.Exists(Key) ThenIf dicKeepSku.Exists(Key) Then dicKeepSku.Remove(Key)If NOT dicRemoveSku.Exists(Key) Then dicRemoveSku.Add Key,KeyEnd IfNext 'KeyEnd If 'fRemoveSrvIf NOT dicKeepSku.Count > 0 Then fRemoveAll = TrueEnd If 'fRemoveAll'Fill the KeepProd dicFor Each Sku in dicKeepSku.KeysIf RegReadValue(HKLM,REG_ARP & OREGREF & Sku,"ProductCodes",sProductCodeList,"REG_MULTI_SZ") ThenFor Each sProductCode in Split(sProductCodeList,chr(34))If Len(sProductCode) = 38 ThenIf NOT dicKeepProd.Exists(sProductCode) Then dicKeepProd.Add sProductCode,SkuEnd If '38Next 'sProductCod End IfNext 'SkuIf fRemoveAll OR fRemoveOse Then CheckRemoveOSEIf fRemoveAll OR fRemoveOspp Then CheckRemoveOsppEnd Sub 'ValidateRemoveSkuList'======================================================================================================='Check if OSE service can be scrubbedSub CheckRemoveOSEConst O11 = "6000-11D3-8CFE-0150048383C9}"Dim ProductIf fRemoveOse Then Exit SubFor Each Product in oMsi.ProductsIf Len(Product) = 38 ThenIf UCase(Right(Product,28)) = O11 Then 'Found Office 2003 Product. Set flag to not remove the OSE serviceExit SubEnd IfIf UCase(Right(Product,PRODLEN))=OFFICEID ThenSelect Case Mid(Product,4,2)Case "12","14","15","16","17"'Found another Office product. Set flag to keep the OSE serviceIf NOT Mid(Product,4,2) = OVERSIONMAJOR ThenfRemoveOse = FalseExit SubEnd IfCase ElseEnd SelectEnd IfEnd If '38Next 'ProductfRemoveOse = TrueEnd Sub 'CheckRemoveOSE'======================================================================================================='Check if OSPP service can be scrubbedSub CheckRemoveOSPPDim ProductIf NOT CInt(OVERSIONMAJOR) > 12 Then fRemoveOspp = FalseExit SubEnd IfIf fRemoveOspp Then Exit SubFor Each Product in oMsi.ProductsIf Len(Product) = 38 ThenIf UCase(Right(Product,PRODLEN))=OFFICEID ThenSelect Case Mid(Product,4,2)Case "14","15","16","17"'Found another Office product. Set flag to keep the OSPP serviceIf NOT Mid(Product,4,2) = OVERSIONMAJOR ThenfRemoveOspp = FalseExit SubEnd IfCase ElseEnd SelectEnd IfEnd If '38Next 'ProductfRemoveOspp = TrueEnd Sub 'CheckRemoveOSPP'======================================================================================================='Cache .msi files for products that will be removed in case they are needed for later file detectionSub CacheMsiFilesDim ProductDim sMsiFile'Non critical routine for failures.'Errors will be logged but must not fail the executionOn Error Resume NextLog " Cache .msi files to temporary Scrub folder"'Cache the filesFor Each Product in oMsi.Products'Ensure valid GUID lengthIf InScope(Product) ThenIf (fRemoveAll OR CheckDelete(Product))ThenCheckError "CacheMsiFiles"sMsiFile = oMsi.ProductInfo(Product,"LocalPackage") : CheckError "CacheMsiFiles"LogOnly " - " & Product & ".msi"If oFso.FileExists(sMsiFile) Then oFso.CopyFile sMsiFile,sScrubDir & "\" & Product & ".msi",TrueCheckError "CacheMsiFiles"End IfEnd If 'InScopeNext 'ProductErr.ClearEnd Sub 'CacheMsiFiles'======================================================================================================='Build a list of all files that will be deletedSub ScanComponentsConst MSIINSTALLSTATE_LOCAL = 3Dim FileList, RegList, ComponentID, CompClient, Record, qView, MsiDb, CompVerboseDim Processes, Process, Prop, prodDim sQuery, sSubKeyName, sPath, sFile, sMsiFile, sCompClient, sComponent, sCompRegDim fRemoveComponent, fAffectedComponent, fIsPermanent, fIsFile, fIsFolderDim i, iProgress, iCompCnt, iRemCntDim dicFLError, oDic, oFolderDic, dicCompPathDim hDefKey'LogfileSet FileList = oFso.OpenTextFile(sScrubDir & "\FileList.txt",FOR_WRITING,True,True)Set RegList = oFso.OpenTextFile(sScrubDir & "\RegList.txt",FOR_WRITING,True,True)Set CompVerbose = oFso.OpenTextFile(sScrubDir & "\CompVerbose.txt",FOR_WRITING,True,True)'FileListError dicSet 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 executionOn Error Resume NextiCompCnt = oMsi.Components.CountIf NOT Err = 0 Then'API failureLog "Error during components detection. Cannot complete this task."Err.ClearExit SubEnd If'Ensure to not divide by zeroIf iCompCnt = 0 Then iCompCnt = 1LogOnly " Scanning " & iCompCnt & " components"'Enum all ComponentsFor Each ComponentID In oMsi.ComponentsCompVerbose.WriteLine vbCrLf & "Checking Component: " & ComponentID'Progress bari = i + 1If iProgress < (i / iCompCnt) * 100 Then wscript.stdout.write "." : LogStream.Write "."iProgress = iProgress + 1If iProgress = 35 OR iProgress = 70 Then Log ""End If'Check if all ComponentClients will be removedsCompClient = ""iRemCnt = 0fIsPermanent = FalsefRemoveComponent = False 'Flag to track if the component will be completely removedfAffectedComponent = False 'Flag to track if some clients remain installed who have a none shared locationdicCompPath.RemoveAllErr.ClearFor Each CompClient In oMsi.ComponentClients(ComponentID)CompVerbose.Write " CompClient " & CompClient & "-> "If Err = 0 Then'Ensure valid guid lengthIf Len(CompClient) = 38 ThenfRemoveComponent = InScope(CompClient)If fRemoveComponent OR (CompClient = "{00000000-0000-0000-0000-000000000000}") ThensPath = ""sPath = LCase(oMsi.ComponentPath(CompClient,ComponentID))sPath = Replace(sPath,"?",":")'Scan for msidbComponentAttributesPermanent flagIf CompClient = "{00000000-0000-0000-0000-000000000000}" ThenfIsPermanent = TrueiRemCnt = iRemCnt + 1End IfIf fRemoveComponent Then fRemoveComponent = CheckDelete(CompClient)CompVerbose.Write "CheckDelete: " & fRemoveComponent & "; "If fRemoveComponent TheniRemCnt = iRemCnt + 1fAffectedComponent = True'Since the scope remains within one Office family the keypath for the component'is assumed to be identicalIf sCompClient = "" Then sCompClient = CompClient' flag the CompClient entry for removalsCompReg = "Installer\Components\"&GetCompressedGuid(ComponentID)&"\"&GetCompressedGuid(CompClient)If NOT dicDelRegKey.Exists(sCompReg) ThendicDelRegKey.Add sCompReg,HKCRRegList.WriteLine HiveString(HKCR)&"\"&sCompRegEnd IfsCompReg = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components\"&GetCompressedGuid(ComponentID)&"\"&GetCompressedGuid(CompClient)If NOT dicDelRegKey.Exists(sCompReg) ThendicDelRegKey.Add sCompReg,HKLMRegList.WriteLine HiveString(HKCR)&"\"&sCompRegEnd IfElseIf NOT dicCompPath.Exists(sPath) Then dicCompPath.Add sPath,CompClientEnd IfCompVerbose.WriteLine "AffectedComponent: " & fAffectedComponentCompVerbose.WriteLine " CompClient now set to: " & sCompClientElseCompVerbose.Write "InScope: " & fRemoveComponent & "; "End IfElseCompVerbose.WriteLine "Error: Invalid metadata"If NOT dicFLError.Exists("Error: Invalid metadata found. ComponentID: "&ComponentID &", ComponentClient: "&CompClient) Then _dicFLError.Add "Error: Invalid metadata found. ComponentID: "&ComponentID &", ComponentClient: "&CompClient, ComponentIDEnd If '38ElseCompVerbose.WriteLine "Error: " & Err.number & " " & Err.DescriptionErr.ClearEnd If 'Err = 0Next 'CompClient'Determine if the component resources go awaysPath = ""fRemoveComponent = fAffectedComponent AND (iRemCnt = oMsi.ComponentClients(ComponentID).Count)CompVerbose.WriteLine " Component goes away: " & fRemoveComponent' This caused unintentional removals' 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 IfIf fRemoveComponent Then'Check msidbComponentAttributesPermanent flagIf fIsPermanent AND NOT fForce Then fRemoveComponent = FalseCompVerbose.WriteLine " msidbComponentAttributesPermanent: " & NOT fRemoveComponentEnd IfIf fRemoveComponent ThenCompVerbose.WriteLine " RESULT: Component IN SCOPE for removal"fIsFile = False : fIsFolder = False'Component resources go away for this productErr.Clear'Add the component registration key to ensure removalsCompReg = "Installer\Components\"&GetCompressedGuid(ComponentID)&"\"If NOT dicDelRegKey.Exists(sCompReg) ThendicDelRegKey.Add sCompReg,HKCRRegList.WriteLine HiveString(HKCR)&"\"&sCompRegEnd IfsCompReg = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components\"&GetCompressedGuid(ComponentID)&"\"If NOT dicDelRegKey.Exists(sCompReg) ThendicDelRegKey.Add sCompReg,HKLMRegList.WriteLine HiveString(HKCR)&"\"&sCompRegEnd If'Get the component pathIf sPath = "" ThensPath = LCase(oMsi.ComponentPath(sCompClient,ComponentID))sPath = Replace(sPath,"?",":")End IfCompVerbose.WriteLine " Path: " & sPathIf Len(sPath) > 4 ThenIf Left(sPath,1) = "0" Then'Registry keypathSelect Case Left(sPath,2)Case "00"sPath = Mid(sPath,5)hDefKey = HKCRCase "01"sPath = Mid(sPath,5)hDefKey = HKCUCase "02","22"sPath = Mid(sPath,5)hDefKey = HKLMCase Else'End SelectIf NOT dicDelRegKey.Exists(sPath) ThendicDelRegKey.Add sPath,hDefKeyRegList.WriteLine HiveString(hDefKey)&"\"&sPathEnd IfElse'File or FolderIf oFso.FileExists(sPath) OR oFso.FolderExists(sPath) ThenIf Right(sPath,1) = "\" ThenfIsFolder = TrueCompVerbose.WriteLine " Folder check OK"ElsefIsFile = TrueCompVerbose.WriteLine " File check OK"End IfIf fIsFile Then sPath = oFso.GetFile(sPath).ParentFolderIf Not oFolderDic.Exists(sPath) ThenoFolderDic.Add sPath,sPathFileList.WriteLine sPath & vbTab & "(FOLDER)"End If'Get the .msi fileIf oFso.FileExists(sScrubDir & "\" & sCompClient & ".msi") ThensMsiFile = sScrubDir & "\" & sCompClient & ".msi"ElsesMsiFile = oMsi.ProductInfo(sCompClient,"LocalPackage")End IfCompVerbose.WriteLine " Set msi file to : " & sMsiFileIf Not Err = 0 ThenCompVerbose.WriteLine " Error: Failed to obtain .msi file for product " & sCompClientIf NOT dicFLError.Exists("Failed to obtain .msi file for product "&sCompClient) Then _dicFLError.Add "Failed to obtain .msi file for product "&sCompClient, ComponentIDErr.ClearEnd IfCompVerbose.Write " Open .msi file for reading returned: "Set MsiDb = oMsi.OpenDatabase(sMsiFile,MSIOPENDATABASEREADONLY)If Err = 0 ThenCompVerbose.WriteLine " SUCCESS"'Get the component name from the 'Component' tablesQuery = "SELECT `Component`,`ComponentId` FROM Component WHERE `ComponentId` = '" & ComponentID &"'"Set qView = MsiDb.OpenView(sQuery) : qView.ExecuteSet Record = qView.Fetch()If Not Record Is Nothing Then sComponent = Record.Stringdata(1)CompVerbose.WriteLine " Obtained ComponentId as: " & sComponent'Get filenames from the 'File' tablesQuery = "SELECT `Component_`,`FileName` FROM File WHERE `Component_` = '" & sComponent &"'"Set qView = MsiDb.OpenView(sQuery) : qView.ExecuteSet Record = qView.Fetch()Do Until Record Is Nothing'Read the filenamesFile = Record.StringData(2)If InStr(sFile,"|") > 0 Then sFile = Mid(sFile,InStr(sFile,"|")+1,Len(sFile))'sFile = sPath & "\" & sFileCompVerbose.WriteLine " File: " & sPath& "\" & sFileIf Not oDic.Exists(sPath & "\" & sFile) Then 'Exception handlerfAdd = TrueSelect Case UCase(sFile)Case "FPERSON.DLL"'Catch exception caused by changed .msi keypath authoring logic for smart tagsFor Each prod in oMsi.ProductsIf NOT Checkdelete(prod) ThenIf oMsi.FeatureState(prod, "MSTagPluginNamesFiles") = MSIINSTALLSTATE_LOCAL ThenfAdd = FalseExit ForEnd IfEnd IfNext 'prodCase ElseEnd SelectIf fAdd ThenCompVerbose.WriteLine " Added as new file to dictionary"oDic.Add sPath & "\" & sFile,sFileFileList.WriteLine sFile & vbTab & sPath & "\" & sFileIf Len(sFile)>4 ThensFile = LCase(sFile)If Right(sFile,4) = ".exe" ThenIf NOT dicApps.Exists(sFile) ThenSelect Case sFileCase "setup.exe","ose.exe","osppsvc.exe","explorer.exe"Case ElsedicApps.Add sFile,LCase(sPath) & "\" & sFileCompVerbose.WriteLine " Added to the list of processes that need to be closed."End SelectEnd If 'dicApps.ExistsEnd If '.exeEnd If 'Len > 4End If 'fAddEnd If 'oDic.ExistsSet Record = qView.Fetch()LoopSet Record = NothingqView.CloseSet qView = NothingElseCompVerbose.WriteLine " Error: Could not read from .msi file"If NOT dicFLError.Exists("Error: Could not read from .msi file: "&sMsiFile) Then _dicFLError.Add "Error: Could not read from .msi file: "&sMsiFile, ComponentIDErr.ClearEnd If 'Err = 0ElseCompVerbose.WriteLine " Error: File check FAILED"End If 'FileExists(sPath)End IfEnd If 'Len(sPath) > 4ElseCompVerbose.WriteLine " RESULT: Component NOT in scope for removal"If fAffectedComponent Then'Add the path to the 'Keep' dictionaryErr.ClearFor Each CompClient In oMsi.ComponentClients(ComponentID)'Get the component pathsPath = "" : sPath = LCase(oMsi.ComponentPath(CompClient,ComponentID))sPath = Replace(sPath,"?",":")If Len(sPath) > 4 ThenIf Left(sPath,1) = "0" Then'Registry keypathSelect Case Left(sPath,2)Case "00"sPath = Mid(sPath,5)hDefKey = HKCRCase "01"sPath = Mid(sPath,5)hDefKey = HKCUCase "02","22"sPath = Mid(sPath,5)hDefKey = HKLMCase Else'End SelectIf NOT dicKeepReg.Exists(LCase(sPath)) ThendicKeepReg.Add LCase(sPath),hDefKeyEnd IfElse'File keypathIf oFso.FileExists(sPath) ThenIf NOT dicKeepFolder.Exists(LCase(sPath)) Then dicKeepFolder.Add LCase(sPath)sPath = LCase(oFso.GetFile(sPath).ParentFolder) & "\"If NOT dicKeepFolder.Exists(sPath) Then AddKeepFolder sPathEnd If'Folder keypathIf oFso.FolderExists(sPath) Then AddKeepFolder sPathEnd If 'Is RegistryEnd If 'sPath > 4Next 'CompClientEnd If 'fAffectedComponentEnd If 'fRemoveComponentErr.ClearNext 'ComponentIDOn Error Goto 0Log " Done" & vbCrLfIf dicFLError.Count > 0 Then LogOnly Join(dicFLError.Keys,vbCrLf)If Not oFolderDic.Count = 0 Then arrDeleteFolders = oFolderDic.Keys Else Set arrDeleteFolders = NothingIf Not oDic.Count = 0 Then arrDeleteFiles = oDic.Keys Else Set arrDeleteFiles = NothingEnd Sub 'ScanComponents'======================================================================================================='Try to remove the products by calling setup.exeSub SetupExeRemovalDim OseService, Service, TextStreamDim iSetupCnt, RetValDim Sku, sConfigFile, sUninstallCmd, sCatalyst, sDll, sDisplayLevel, sNoCanceliSetupCnt = 0If Not dicRemoveSku.Count > 0 ThenLog " Nothing to remove for Setup.exe"Exit SubEnd If'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 SubFor Each Service in OseServiceIf (Service.StartMode = "Disabled") AND (Not Service.ChangeStartMode("Manual")=0) Then Exit SubIf (Not Service.StartName = "LocalSystem") AND (Service.Change( , , , , , , "LocalSystem", "")) Then Exit SubNext 'ServiceFor Each Sku in dicRemoveSku.KeysIf Sku="CLICK2RUN" Then'Already doneElse'Create an "unattended" config.xml file for uninstallIf fQuiet AND NOT fBasic 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 "<Configuration Product=""" & Sku & """>"TextStream.Writeline "<Display Level=""" & sDisplayLevel & """ CompletionNotice=""No"" SuppressModal=""Yes"" NoCancel=""" & sNoCancel & """ AcceptEula=""Yes"" />"TextStream.Writeline "<Logging Type=""Verbose"" Path=""" & sLogDir & """ Template=""Microsoft Office " & Sku & " Setup(*).txt"" />"TextStream.Writeline "<Setting Id=""MSIRESTARTMANAGERCONTROL"" Value=""Disable"" />"TextStream.Writeline "<Setting Id=""SETUP_REBOOT"" Value=""Never"" />"TextStream.Writeline "</Configuration>"TextStream.CloseSet TextStream = Nothing'Ensure path to setup.exe is valid to prevent errorssDll = ""If RegReadValue(HKLM,REG_ARP & OREGREF & Sku,"UninstallString",sCatalyst,"REG_SZ") ThenIf 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) ThensCatalyst = sCommonProgramFiles & "\" & OREF & "\Office Setup Controller\setup.exe"If NOT oFso.FileExists(sCatalyst) AND f64 ThensCatalyst = sCommonProgramFilesX86 & "" & OREF & "\Office Setup Controller\setup.exe"End IfEnd IfIf oFso.FileExists(sCatalyst) ThensUninstallCmd = Chr(34) & sCatalyst & Chr(34) & " /uninstall " & Sku & " /config " & Chr(34) & sScrubDir & "\config.xml" & Chr(34) & sDll iSetupCnt = iSetupCnt + 1Log " - Calling Setup.exe to remove " & Sku '& vbCrLf & sUninstallCmd If Not fDetectOnly Then On Error Resume Next' end other instances of setupEndCurrentInstalls' call uninstallRetVal = oWShell.Run(sUninstallCmd,0,True) : CheckError "SetupExeRemoval"Log " - Setup.exe returned: " & SetupRetVal(Retval) & " (" & RetVal & ")" & vbCrLffRebootRequired = fRebootRequired OR (RetVal = "3010")On Error Goto 0ElseLog " -> Removal suppressed in preview mode."End IfElseLog " Error: Office setup.exe appears to be missing"End If 'RetVal = 0) AND oFso.FileExistsEnd If 'RegReadValueEnd If Next 'SkuIf iSetupCnt = 0 Then Log " Nothing to remove for setup."End Sub 'SetupExeRemoval'======================================================================================================='Invoke msiexec to remove individual .MSI packagesSub MsiexecRemovalDim ProductDim iDim sCmd, sReturn, sMsiPropDim fRegWipefRegWipe = FalseSelect Case OVERSIONMAJORCase "11"sMsiProp = " REBOOT=ReallySuppress NOLOCALCACHEROLLBACK=1"Case "12"fRegWipe = TruesMsiProp = " REBOOT=ReallySuppress NOREMOVESPAWN=True"Case "14"fRegWipe = TruesMsiProp = " REBOOT=ReallySuppress NOREMOVESPAWN=True"Case "15"fRegWipe = TruesMsiProp = " REBOOT=ReallySuppress NOREMOVESPAWN=True"Case ElseEnd Select'Clear up ARP first to avoid possible custom action dependenciesIf fRegWipe Then RegWipeARP'Check MSI registered products'Office System does only support per machine installation so it's sufficient to use Installer.Productsi = 0'sMsiProp = " MSIRESTARTMANAGERCONTROL=Disable" & sMsiPropFor Each Product in oMsi.ProductsIf InScope(Product) ThenIf fRemoveAll OR CheckDelete(Product) Theni = i + 1 Log " Calling msiexec.exe to remove " & ProductsCmd = "msiexec.exe /x" & Product & sMsiPropIf fQuiet AND NOT fBasic Then sCmd = sCmd & " /q"ElsesCmd = sCmd & " /qb-"End IfsCmd = sCmd & " /l*v+ "&chr(34)&sLogDir&"\Uninstall_"&Product&".log"&chr(34)If NOT fDetectOnly Then ' end other instances of setupEndCurrentInstalls'Execute the uninstallLogOnly " - Calling msiexec with '"&sCmd&"'"sReturn = oWShell.Run(sCmd, 0, True)Log " - msiexec returned: " & SetupRetVal(sReturn) & " (" & sReturn & ")" & vbCrLffRebootRequired = fRebootRequired OR (sReturn = "3010") OR (sReturn = "1618")ElseLog " -> Removal suppressed in preview mode."LogOnly " -> Command: "&sCmdEnd IfEnd If 'CheckDeleteEnd If 'InScopeNext 'ProductIf i = 0 Then Log " Nothing to remove for msiexec"End Sub 'MsiexecRemoval'======================================================================================================='Remove the OSE (Office Source Engine) serviceSub RemoveOSEOn Error Resume NextLog vbCrLf & "OSE CleanUp"DeleteService "ose"'Delete the folderDeleteFolder sCommonProgramFiles & "\Microsoft Shared\Source Engine"'Delete the registrationRegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\ose\"End Sub 'RemoveOSE'======================================================================================================='File cleanup operations for the Local Installation Source (MSOCache)Sub WipeLISConst LISROOT = "MSOCache\All Users\"Dim LogicalDisks, Disk, Folder, SubFolder, MseFolder, File, FilesDim arrSubFoldersDim sFolderDim fRemoveFolderLog vbCrLf & "LIS CleanUp"'Search all hard disksSet LogicalDisks = oWmiLocal.ExecQuery("Select * From Win32_LogicalDisk WHERE DriveType=3")For Each Disk in LogicalDisksIf oFso.FolderExists(Disk.DeviceID & "\" & LISROOT) ThenSet Folder = oFso.GetFolder(Disk.DeviceID & "\" & LISROOT)For Each Subfolder in Folder.SubfoldersIf Len(Subfolder) > 37 ThenIf fRemoveAll Then If (Mid(Subfolder.Name,27,PRODLEN) = OFFICEID AND Mid(SubFolder.Name,4,2)=OVERSIONMAJOR) OR _LCase(Right(Subfolder.Name,7)) = OVERSIONMAJOR &".data" Then DeleteFolder Subfolder.PathElseIf (Mid(Subfolder.Name,27,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.PathEnd IfEnd If 'Len > 37Next 'SubfolderIf (Folder.Subfolders.Count = 0) AND (Folder.Files.Count = 0) Then sFolder = Folder.PathSet Folder = NothingSmartDeleteFolder sFolderEnd IfEnd If 'oFso.FolderExistsNext 'Disk'MSECacheIf EnumFolders(sProgramFiles,arrSubFolders) ThenFor Each SubFolder in arrSubFoldersIf UCase(Right(SubFolder,9))="\MSECACHE" ThenReDim arrMseFolders(-1)Set Folder = oFso.GetFolder(SubFolder)GetMseFolderStructure FolderFor Each MseFolder in arrMseFoldersIf oFso.FolderExists(MseFolder) ThenfRemoveFolder = FalseSet Folder = oFso.GetFolder(MseFolder)Set Files = Folder.FilesFor Each File in FilesIf (LCase(Right(File.Name,4))=".msi") ThenIf CheckDelete(ProductCode(File.Path)) Then fRemoveFolder = TrueExit ForEnd If 'CheckDeleteEnd IfNext 'FileSet Files = NothingSet Folder = NothingIf fRemoveFolder Then SmartDeleteFolder MseFolderEnd If 'oFso.FolderExists(MseFolder)Next 'MseFolderEnd IfNext 'SubFolderEnd If 'oFso.FolderExistsEnd Sub 'WipeLis'======================================================================================================='Wipe files and folders as documented in KB 928218Sub FileWipeAllDim sFolderDim Folder, SubfolderIf fForce OR fQuiet Then CloseOfficeApps'Handle other services.Select Case OVERSIONMAJORCase "11"Case "12"Case "14"DeleteService "odserv"DeleteService "Microsoft Office Groove Audit Service"DeleteService "Microsoft SharePoint Workspace Audit Service"Case "15"Case ElseEnd Select'User specific filesIf NOT fKeepUser Then'Delete files that should be backed up before deleting themCopyAndDeleteFile sAppdata & "\Microsoft\Templates\Normal.dotm"CopyAndDeleteFile sAppdata & "\Microsoft\Templates\Normalemail.dotm"sFolder = sAppdata & "\microsoft\document building blocks"If oFso.FolderExists(sFolder) Then Set Folder = oFso.GetFolder(sFolder)For Each Subfolder In Folder.SubfoldersIf oFso.FileExists(Subfolder & "\blocks.dotx") Then CopyAndDeleteFile Subfolder & "\blocks.dotx"Next 'SubfolderSet Folder = NothingEnd If 'oFso.FolderExists(sFolder)End If 'Run the individual filewipe from component detection firstFileWipeIndividual'Take care of the restDeleteFolder sOInstallRootDeleteFolder sCommonProgramFiles & "\Microsoft Shared\" & OREFDeleteFile sAllUsersProfile & "\Application Data\Microsoft\Office\Data\opa"&OVERSIONMAJOR&".dat"DeleteFile sAllUsersProfile & "\Application Data\Microsoft\Office\Data\opa"&OVERSIONMAJOR&".bak"DeleteFile sAllUsersProfile & "\Microsoft\Office\Data\opa"&OVERSIONMAJOR&".dat"DeleteFile sAllUsersProfile & "\Microsoft\Office\Data\opa"&OVERSIONMAJOR&".bak"If (fRemoveOspp OR fForce) AND CInt(OVERSIONMAJOR)>12 ThenDeleteService "osppsvc"DeleteFolder sCommonProgramFiles & "\Microsoft Shared\OfficeSoftwareProtectionPlatform"DeleteFolder sAllUsersProfile & "\Microsoft\OfficeSoftwareProtectionPlatform"End IfSelect Case OVERSIONMAJORCase "12"Case "14"DeleteFile oWShell.SpecialFolders("AllUsersStartup")&"\OfficeSAS.lnk"DeleteFile oWShell.SpecialFolders("Startup")&"\OneNote 2010 Screen Clipper and Launcher.lnk"Case "15"Case ElseEnd SelectEnd Sub 'FileWipeAll'======================================================================================================='Wipe individual files & folders related to SKU's that are no longer installedSub FileWipeIndividualDim LogicalDisks, Disk,scDim File, Files, XmlFile, scFiles, oFile, Folder, SubFolder, Processes, Process, itemDim sFile, sFolder, sPath, sConfigName, sContents, sProductCode, sLocalDrives,sScQueryDim sValue, sScRootsDim arrSubfolders, arrShortCutRootsDim fKeepFolder, fDeleteSCDim iRet,iCnt,iPosLog vbCrLf & "File CleanUp"If IsArray(arrDeleteFiles) ThenIf fForce OR fQuiet ThenLog " Doing Action: StopOSE"iRet = StopService("ose")Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name like 'ose%.exe'")For Each Process in ProcessesLogOnly " - Running process : " & Process.NameLog " -> Ending process: " & Process.NameiRet = Process.Terminate()Next 'ProcessLogOnly " End Action: StopOSE"CloseOfficeAppsEnd If'Wipe individual files detected earlierLogOnly " Removing left behind files"For Each sFile in arrDeleteFilesIf oFso.FileExists(sFile) Then DeleteFile sFileNext 'FileEnd If 'IsArray'Wipe Catalyst in commonfilessFolder = sCommonProgramFiles & "\microsoft shared\"&OREF&"\Office Setup Controller\"If EnumFolderNames(sFolder,arrSubFolders) ThenFor Each SubFolder in arrSubFolderssPath = sFolder & SubFolderIf InStr(SubFolder,".")>0 Then sConfigName = UCase(Left(SubFolder,InStr(SubFolder,".")-1))Else sConfigName = UCase(Subfolder)If GetFolderPath(sPath) ThenSet Folder = oFso.GetFolder(sPath)Set Files = Folder.FilesfKeepFolder = FalseFor Each File In FilesIf Len(File.Name)>3 ThenIf (LCase(Right(File.Name,4))=".xml") ThenIf Len(File.Name) >= Len(sConfigName) ThenIf (UCase(Left(File.Name,Len(sConfigName)))=sConfigName) ThenSet XmlFile = oFso.OpenTextFile(File,1)sContents = XmlFile.ReadAllSet XmlFile = NothingsProductCode = ""On Error Resume NextsProductCode = Mid(sContents,InStr(sContents,"ProductCode=")+Len("ProductCode=")+1,38)On Error Goto 0If Len(sProductCode) = 38 ThenIf CheckDelete(sProductCode) Then DeleteFile File.Path Else fKeepFolder = TrueEnd IfEnd If 'sConfigNameEnd If 'Len >=End If '.xmlEnd If 'Len(File.Name)>3Next 'FileSet Files = NothingSet Folder = NothingIf Not fKeepFolder Then DeleteFolder sPathEnd If 'GetFolderPathNext 'SubFolderEnd If 'EnumFolderNames'Wipe ShortcutsIf NOT fSkipSD ThenOn Error Resume NextLog " Searching for shortcuts"CleanShortcuts sAllUsersProfile, True, FalseCleanShortcuts sProfilesDirectory, True, FalseOn Error Goto 0End If 'NOT SkipSDErr.ClearEnd Sub 'FileWipeIndividual'======================================================================================================='-------------------------------------------------------------------------------' CleanShortcuts'' Recursively search all profile folders for Office shortcuts in scope '-------------------------------------------------------------------------------Sub CleanShortcuts (sFolder, fDelete, fUnPin)Dim oFolder, fld, file, sc, itemDim fDeleteSCSet oFolder = oFso.GetFolder(sFolder)' exclude system protected link foldersIf CBool(oFolder.Attributes AND 1024) Then Exit SubOn Error Resume NextFor Each fld In oFolder.SubFoldersIf Err <> 0 Then CheckError "CleanShortcuts: " & vbTab & sFolderElseCleanShortcuts fld.Path, fDelete, fUnPinEnd IfNextFor Each file In oFolder.FilesIf LCase(Right(file.Path, 4)) = ".lnk" Thenset sc = oWShell.CreateShortcut(file.Path)'Compare if the shortcut target is in the list of executables that will be removedIf Len(sc.TargetPath) > 0 ThenFor Each item in dicApps.ItemsIf LCase(sc.TargetPath) = item ThenfDeleteSC = TrueExit ForEnd IfNext 'itemEnd If'Handle Windows Installer shortcutsIf InStr(sc.TargetPath,"{") > 0 ThenIf Len(sc.TargetPath) >= InStr(sc.TargetPath,"{") + 37 ThenIf CheckDelete(Mid(sc.TargetPath, InStr(sc.TargetPath,"{"), 38)) Then fDeleteSC = TrueEnd IfEnd IfIf fDeleteSC Then If Not IsArray(arrDeleteFolders) Then ReDim arrDeleteFolders(0)sFolder = file.Drive & file.PathIf Not arrDeleteFolders(UBound(arrDeleteFolders)) = sFolder ThenReDim Preserve arrDeleteFolders(UBound(arrDeleteFolders) + 1)arrDeleteFolders(UBound(arrDeleteFolders)) = sFolderEnd IfIf fUnPin Then UnPin fileIf fDelete Then DeleteFile file.PathEnd If 'fDeleteSCEnd IfNextOn Error Goto 0End Sub 'CleanShortcuts'-------------------------------------------------------------------------------' UnPin'' Unpins a shortcut from the taskbar or start menu '-------------------------------------------------------------------------------Sub UnPin(file)Dim fldItem, verbOn Error Resume NextSet fldItem = oShellApp.NameSpace(file.ParentFolder.Path).ParseName(file.Name)For Each verb in fldItem.VerbsSelect Case Replace(verb, "&", "")Case "Unpin from Taskbar", "Von Taskleiste lösen", "Détacher du barre des tâches", "Détacher de la barre des tâches", "Desanclar de la barra de tareas", "Ta bort från Aktivitetsfältet", "??? ????????(K)", "?? ????? ??(K)", "????????? ?? ?????? ?????"verb.DoItCase "Unpin from Start Menu", "Vom Startmenü lösen", "Détacher du menu Démarrer", "Détacher de la menu Démarrer"If iVersionNT = 601 Then verb.DoItEnd SelectNextOn Error Goto 0End Sub'=======================================================================================================Sub DelScrubTmpOn Error Resume NextIf oFso.FolderExists(sScrubDir & "\ScrubTmp") Then oFso.DeleteFolder sScrubDir & "\ScrubTmp",TrueEnd Sub 'DelScrubTmp'======================================================================================================='Ensure there are no unexpected .msi files in the scrub folderSub DeleteMsiScrubCacheDim Folder, File, FilesLog vbCrLf & "ScrubCache CleanUp"Set Folder = oFso.GetFolder(sScrubDir) : CheckError "DeleteMsiScrubCache"Set Files = Folder.FilesFor Each File in FilesCheckError "DeleteMsiScrubCache"If LCase(Right(File.Name,4))=".msi" ThenCheckError "DeleteMsiScrubCache"DeleteFile File.Path : CheckError "DeleteMsiScrubCache"End IfNext 'FileEnd Sub 'DeleteMsiScrubCache'=======================================================================================================Sub MsiClearOrphanedFilesConst USERSIDEVERYONE = "s-1-1-0"Const MSIINSTALLCONTEXT_ALL = 7Const MSIPATCHSTATE_ALL = 15'Error handling inlinedOn Error Resume NextDim Patch, AllPatches, Product, AllProductsDim File, Files, FolderDim sFName, sLocalMsp, sLocalMsi, sPatchList, sMsiListSet Folder = oFso.GetFolder(sWinDir & "\Installer")Set Files = Folder.FilesLog vbCrLf & "Windows Installer cache CleanUp"'Get a complete list of patchesErr.ClearSet AllPatches = oMsi.PatchesEx("",USERSIDEVERYONE,MSIINSTALLCONTEXT_ALL,MSIPATCHSTATE_ALL)If Err <> 0 ThenCheckError "MsiClearOrphanedFiles (msp)"Else'Fill a comma separated stringlist with all .msp patchfilesFor Each Patch in AllPatchessLocalMsp = "" : sLocalMsp = LCase(Patch.Patchproperty("LocalPackage")) : CheckError "MsiClearOrphanedFiles (msp)"sPatchList = sPatchList & sLocalMsp & ","Next 'Patch'Delete all non referenced .msp files from %windir%\installerFor Each File in FilessFName = "" : sFName = LCase(File.Path)If LCase(Right(sFName,4)) = ".msp" ThenIf Not InStr(sPatchList,sFName) > 0 Then'While this is an orphaned file keep the scope of Office onlyIf InStr(UCase(MspTargets(File.Path)),OFFICEID)>0 Then DeleteFile File.PathEnd IfEnd If 'LCase(Right(sFName,4))Next 'FileEnd If 'Err=0'Get a complete list productsErr.ClearSet AllProducts = oMsi.ProductsEx("",USERSIDEVERYONE,MSIINSTALLCONTEXT_ALL)If Err <> 0 ThenCheckError "MsiClearOrphanedFiles (msi)"Else'Fill a comma separated stringlist with all .msi filesFor Each Product in AllProductssLocalMsi = "" : sLocalMsi = LCase(Product.InstallProperty("LocalPackage")) : CheckError "MsiClearOrphanedFiles (msi)"sMsiList = sMsiList & sLocalMsi & ","Next 'Product'Delete all non referenced .msi files from %windir%\installerFor Each File in FilessFName = "" : sFName = LCase(File.Path)If LCase(Right(sFName,4)) = ".msi" ThenIf Not InStr(sMsiList,sFName) > 0 Then'While this is an orphaned file keep the scope of Office onlyIf UCase(Right(ProductCode(File.Path),PRODLEN))=OFFICEID Then DeleteFile File.PathEnd IfEnd If 'LCase(Right(sFName,4)) = ".msi"Next 'FileEnd If 'Err=0End Sub 'MsiClearOrphanedFiles'=======================================================================================================Sub RegWipeDim Item, Name, Sku, keyDim hDefKey, sSubKeyName, sCurKey, value, sValue, sGuidDim fkeep, fSystemComponent0, fPackages, fDisplayVersionDim arrKeys, arrNames, arrTypes, arrMultiSzValues, arrMultiSzNewValuesDim arrTestNames,arrTestTypesDim i, iLoopCnt, iPosDim fDelRegLog vbCrLf & "Registry CleanUp"'Wipe registry data'User Profile settingsLog " - User Policies"RegDeleteKey HKCU,"Software\Policies\Microsoft\Office\" & OVERSION & "\"If NOT fKeepUser ThenRegDeleteKey HKCU,"Software\Microsoft\Office\" & OVERSION & "\"Log " - User Settings"End If 'fKeepUser'Computer specific settingsIf fRemoveAll ThenLog " - Machine Settings"RegDeleteKey HKLM,"SOFTWARE\Microsoft\Office\" & OVERSION & "\"If fRemoveOse OR fForce ThenRegDeleteKey HKLM,"SOFTWARE\Microsoft\Office Test\"RegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\Common\","LastAccessInstall", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\Common\","MID", FalseRegDeleteKey HKLM,"SOFTWARE\Microsoft\Office\Excel\Addins\Microsoft.PerformancePoint.Planning.Client.Excel\"RegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\InfoPath\Converters\Import\InfoPath.DesignerExcelImport\Versions\",OVERSION, FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\InfoPath\Converters\Import\InfoPath.DesignerWordImport\Versions\",OVERSION, FalseRegDeleteKey HKLM,"SOFTWARE\Microsoft\Office\Outlook\"RegDeleteKey HKLM,"SOFTWARE\Microsoft\Shared Tools\Text Converters\Export\MEWord12\"RegDeleteKey HKLM,"SOFTWARE\Microsoft\Shared Tools\Text Converters\Export\Word12\"RegDeleteKey HKLM,"SOFTWARE\Microsoft\Shared Tools\Text Converters\Export\Word97\"RegDeleteKey HKLM,"SOFTWARE\Microsoft\Shared Tools\Text Converters\Import\MEWord12\"RegDeleteKey HKLM,"SOFTWARE\Microsoft\Shared Tools\Text Converters\Import\Word12\"RegDeleteKey HKLM,"SOFTWARE\Microsoft\Shared Tools\Text Converters\Import\Word97\"RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Run\","GrooveMonitor", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Run\","LobiServer", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Run\","BCSSync", FalseRegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\Outlook\"End IfRegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\Common\OffDiag\Location\",OVERSIONMAJOR, FalseRegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows NT\CurrentVersion\Terminal Server\Install\Software\Microsoft\Office\" & OVERSION & "\"RegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\Common\OffDiag\Location\",OVERSIONMAJOR, FalseRegDeleteKey HKLM,"SOFTWARE\Microsoft\OfficeCustomizeWizard\" & OVERSION & "\"RegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows NT\CurrentVersion\Terminal Server\Install\SOFTWARE\Microsoft\OfficeCustomizeWizard\" & OVERSION & "\"Select Case OVERSIONMAJORCase "11"'Jet_ReplicationsValue = ""If RegReadValue(HKCR,"CLSID\{CC2C83A6-9BE4-11D0-98E7-00C04FC2CAF5}\InprocServer32","SystemDB",sValue,"REG_SZ") ThenIf Len(sValue) > Len(sOInstallRoot) ThenIf LCase(Left(sValue,Len(sOInstallRoot))) = LCase(sOInstallRoot) Then RegDeleteKey HKCR,"CLSID\{CC2C83A6-9BE4-11D0-98E7-00C04FC2CAF5}\InprocServer32\"End IfEnd IfCase "12"Case "14"RegDeleteKey HKLM,"SOFTWARE\Microsoft\OfficeSoftwareProtectionPlatform\"RegDeleteKey HKLM,"SOFTWARE\Microsoft\OfficeSoftwareProtectionPlatform_Test\"RegDeleteKey HKLM,"SOFTWARE\Microsoft\Office\Common\ActiveX Compatibility\{00024512-0000-0000-C000-000000000046}\"RegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\OneNote\Adapters\","{456B0D0E-49DD-4C95-8DB6-175F54DE69A3}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{42042206-2D85-11D3-8CFF-005004838597}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{993BE281-6695-4BA5-8A2A-7AACBFAAB69E}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{0006F045-0000-0000-C000-000000000046}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{C41662BB-1FA0-4CE0-8DC5-9B7F8279FF97}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{7CCA70DB-DE7A-4FB7-9B2B-52E2335A3B5A}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{506F4668-F13E-4AA1-BB04-B43203AB3CC0}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{D66DC78C-4F61-447F-942B-3FB6980118CF}", FalseRegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\{B4F3A835-0E21-4959-BA22-42B3008E02FF}\"'Groove Extensions RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellExecuteHooks\","{B5A7F190-DDA6-4420-B3BA-52453494E6CD}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{99FD978C-D287-4F50-827F-B2C658EDA8E7}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{AB5C5600-7E6E-4B06-9197-9ECEF74D31CC}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{920E6DB1-9907-4370-B3A0-BAFC03D81399}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{16F3DD56-1AF5-4347-846D-7C10C4192619}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{2916C86E-86A6-43FE-8112-43ABE6BF8DCC}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{72853161-30C5-4D22-B7F9-0BBC1D38A37E}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{6C467336-8281-4E60-8204-430CED96822D}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{2A541AE1-5BF6-4665-A8A3-CFA9672E4291}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{B5A7F190-DDA6-4420-B3BA-52453494E6CD}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{A449600E-1DC6-4232-B948-9BD794D62056}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{3D60EDA7-9AB4-4DA8-864C-D9B5F2E7281D}", FalseRegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{387E725D-DC16-4D76-B310-2C93ED4752A0}", FalseRegDeleteKey HKLM,"SOFTWARE\Classes\*\shellex\ContextMenuHandlers\XXX Groove GFS Context Menu Handler XXX\"RegDeleteKey HKLM,"SOFTWARE\Classes\AllFilesystemObjects\shellex\ContextMenuHandlers\XXX Groove GFS Context Menu Handler XXX\"RegDeleteKey HKLM,"SOFTWARE\Classes\Directory\shellex\ContextMenuHandlers\XXX Groove GFS Context Menu Handler XXX\"RegDeleteKey HKLM,"SOFTWARE\Classes\Folder\ShellEx\ContextMenuHandlers\XXX Groove GFS Context Menu Handler XXX\"RegDeleteKey HKLM,"SOFTWARE\Classes\Directory\Background\shellex\ContextMenuHandlers\XXX Groove GFS Context Menu Handler XXX\"RegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Groove Explorer Icon Overlay 1 (GFS Unread Stub)\"RegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Groove Explorer Icon Overlay 2 (GFS Stub)\"RegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Groove Explorer Icon Overlay 2.5 (GFS Unread Folder)\"RegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Groove Explorer Icon Overlay 3 (GFS Folder)\"RegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Groove Explorer Icon Overlay 4 (GFS Unread Mark)\"RegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\{72853161-30C5-4D22-B7F9-0BBC1D38A37E}\"Case 15Case ElseEnd Select'Win32AssembliesLog " - Win32Assemblies"If RegEnumKey(HKCR,"Installer\Win32Assemblies\",arrKeys) ThenFor Each Item in arrKeysIf InStr(UCase(Item),OREF)>0 Then RegDeleteKey HKCR,"Installer\Win32Assemblies\"&Item & "\"Next 'ItemEnd If 'RegEnumKey'Groove blocks reinstall if it locates groove.exe over this keyIf RegKeyExists(HKCR,"GrooveFile\Shell\Open\Command\") ThensValue = ""RegReadValue HKCR,"GrooveFile\Shell\Open\Command\","",sValue,"REG_SZ"If InStr(sValue,"\"&OREF&"\")>0 Then RegDeleteKey HKCR,"GrooveFile\"End If 'RegKeyExistsEnd If 'fRemoveAllSelect Case OVERSIONMAJORCase "11"For iLoopCnt = 1 to 3Select Case iLoopCntCase 1'CIW - HKCUsSubKeyName = "Software\Microsoft\OfficeCustomizeWizard\" & OVERSION & "\RegKeyPaths\"hDefKey = HKCUCase 2 'CIW - HKLMsSubKeyName = "SOFTWARE\Microsoft\OfficeCustomizeWizard\" & OVERSION & "\RegKeyPaths\"hDefKey = HKLMCase 3'Add/Remove ProgramssSubKeyName = REG_ARPhDefKey = HKLMEnd SelectIf RegEnumKey(hDefKey,sSubKeyName,arrKeys) ThenFor Each Item in arrKeys'OFFICEID idIf Len(Item)>37 ThensGuid = UCase(Left(Item,38))If Right(sGuid,PRODLEN)=OFFICEID ThenIf CheckDelete(sGuid) Then RegDeleteKey hDefKey, sSubKeyName & Item & "\"End IfEnd If 'Right(Item,PRODLEN)=OFFICEIDEnd If 'Len(Item)>37Next 'ItemIf iLoopCnt < 3 ThenIf RegEnumValues(hDefKey,sSubKeyName,arrNames,arrTypes) Theni = 0For Each Name in arrNamesIf RegReadValue(hDefKey,sSubKeyName,Name,sValue,arrTypes(i)) ThenIf sValue = sGuid Then RegDeleteValue hDefKey,sSubKeyName,Name, FalseEnd Ifi = i + 1NextEnd IfEnd IfEnd IfIf NOT RegEnumKey(hDefKey,sSubKeyName,arrKeys) Then RegDeleteKey hDefKey,"Software\Microsoft\OfficeCustomizeWizard\11.0\"If NOT RegEnumKey(hDefKey,"Software\Microsoft\OfficeCustomizeWizard\11.0\",arrKeys) Then RegDeleteKey hDefKey,"Software\Microsoft\OfficeCustomizeWizard\"Next 'iLoopCntCase "12"'Add/Remove ProgramsRegWipeARP Case "14"'Add/Remove ProgramsRegWipeARP Case ElseEnd Select'UpgradeCodes, WI config, WI global configFor iLoopCnt = 1 to 5Select Case iLoopCntCase 1Log " - HKLM UpgradeCodes"sSubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UpgradeCodes\"hDefKey = HKLMCase 2 Log " - HKCR UpgradeCodes"sSubKeyName = "Installer\UpgradeCodes\"hDefKey = HKCRCase 3Log " - HKLM Products"sSubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products\"hDefKey = HKLMCase 4 Log " - HKCR Features"sSubKeyName = "Installer\Features\"hDefKey = HKCRCase 5 Log " - HKCR Products"sSubKeyName = "Installer\Products\"hDefKey = HKCRCase ElsesSubKeyName = ""hDefKey = ""End SelectIf RegEnumKey(hDefKey,sSubKeyName,arrKeys) ThenFor Each Item in arrKeys'Ensure we have the expected length for a compressed GUIDIf Len(Item)=32 Then'Expand the GUIDsGuid = GetExpandedGuid(Item) 'Check if it's an Office keyIf InScope(sGuid) ThenIf fRemoveAll ThenRegDeleteKey hDefKey,sSubKeyName & Item & "\"ElseIf iLoopCnt < 3 Then'Enum all entriesRegEnumValues hDefKey,sSubKeyName & Item,arrNames,arrTypesIf IsArray(arrNames) Then'Delete entries within removal scopeFor Each Name in arrNamesIf Len(Name)=32 ThensGuid = GetExpandedGuid(Name)If CheckDelete(sGuid) Then RegDeleteValue hDefKey, sSubKeyName & Item & "\", Name, TrueElse'Invalid data -> delete the valueRegDeleteValue hDefKey, sSubKeyName & Item & "\", Name, TrueEnd IfNext 'NameEnd If 'IsArray(arrNames)'If all entries were removed - delete the keyRegEnumValues hDefKey,sSubKeyName & Item,arrNames,arrTypesIf Not IsArray(arrNames) Then RegDeleteKey hDefKey, sSubKeyName & Item & "\"Else 'iLoopCnt >= 3If CheckDelete(sGuid) Then RegDeleteKey hDefKey, sSubKeyName & Item & "\"End If 'iLoopCnt < 3End If 'fRemoveAllEnd If 'InScopeEnd If 'Len(Item)=32Next 'ItemEnd If 'RegEnumKeyNext 'iLoopCnt'ComponentsLog " - Global Components"sSubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components\"If RegEnumKey(HKLM,sSubKeyName,arrKeys) ThenFor Each Item in arrKeys'Ensure we have the expected length for a compressed GUIDIf Len(Item)=32 ThenIf RegEnumValues(HKLM,sSubKeyName & Item,arrNames,arrTypes) ThenIf IsArray(arrNames) ThenFor Each Name in arrNamesIf Len(Name)=32 ThensGuid = GetExpandedGuid(Name)If CheckDelete(sGuid) ThenRegDeleteValue HKLM, sSubKeyName & Item & "\", Name, False'Check if the key is now emptyIf NOT RegEnumValues(HKLM,sSubKeyName & Item,arrTestNames,arrTestTypes) ThenIf NOT dicDelRegKey.Exists(sSubKeyName&Item&"\") Then dicDelRegKey.Add sSubKeyName&Item&"\",HKCREnd IfEnd IfEnd If '32Next 'NameEnd If 'IsArrayEnd If 'RegEnumValuesEnd If '32Next 'ItemEnd If 'RegEnumKey'Published ComponentsLog " - Published Components"sSubKeyName = "Installer\Components\"If RegEnumKey(HKCR,sSubKeyName,arrKeys) ThenFor Each Item in arrKeys'Ensure we have the expected length for a compressed GUIDIf Len(Item)=32 ThenIf RegEnumValues(HKCR,sSubKeyName & Item,arrNames,arrTypes) ThenIf IsArray(arrNames) ThenFor Each Name in arrNamesIf RegReadValue (HKCR,sSubKeyName & Item, Name, sValue,"REG_MULTI_SZ") ThenarrMultiSzValues = Split(sValue,chr(34))If IsArray(arrMultiSzValues) Theni = -1ReDim arrMultiSzNewValues(-1)fDelReg = FalseFor Each value in arrMultiSzValuesIf Len(value) > 19 ThensGuid = ""If GetDecodedGuid(Left(value,SQUISHED),sGuid) ThenIf CheckDelete(sGuid) ThenfDelReg = TrueElsei = i + 1 ReDim Preserve arrMultiSzNewValues(i)arrMultiSzNewValues(i) = valueEnd If 'CheckDeleteEnd If 'decodeEnd If '19Next 'ValueIf NOT (i = -1) ThenIf NOT fDetectOnly Then If NOT UBound(arrMultiSzValues) = i Then oReg.SetMultiStringValue HKCR,sSubKeyName & Item,Name,arrMultiSzNewValuesEnd IfElseIf fDelReg ThenRegDeleteValue HKCR,sSubKeyName & Item & "\", Name, False'Check if the key is now emptyIf NOT RegEnumValues(HKCR,sSubKeyName & Item,arrTestNames,arrTestTypes) ThenIf NOT dicDelRegKey.Exists(sSubKeyName&Item&"\") Then dicDelRegKey.Add sSubKeyName&Item&"\",HKCREnd IfEnd If 'DelRegEnd IfEnd If 'IsArrayEnd IfNext 'NameEnd If 'IsArrayEnd If 'RegEnumValuesEnd If '32Next 'ItemEnd If 'RegEnumKey'DeliveryLog " - Delivery"hDefKey = HKLMsSubKeyName = "SOFTWARE\Microsoft\Office\Delivery\SourceEngine\Downloads\"If RegEnumKey(HKLM,sSubKeyName,arrKeys) ThenFor Each Item in arrKeysIf Len(Item) > 37 ThenIf fRemoveAll ThenIf (Mid(Item,27,PRODLEN)=OFFICEID AND Mid(Item,4,2)=OVERSIONMAJOR) OR _LCase(Right(Item,7))=OVERSIONMAJOR&".data" Then RegDeleteKey HKLM,sSubKeyName & Item & "\"ElseIf (Mid(Item,27,PRODLEN)=OFFICEID AND Mid(Item,4,2)=OVERSIONMAJOR) AND _CheckDelete(UCase(Left(Item,38))) Then RegDeleteKey HKLM,sSubKeyName & Item & "\"End IfEnd If '37Next 'ItemEnd If 'RegEnumKey'RegistrationLog " - HKLM Registration"hDefKey = HKLMsSubKeyName = "SOFTWARE\Microsoft\Office\"&OVERSION&"\Registration\"If RegEnumKey(HKLM,sSubKeyName,arrKeys) ThenFor Each Item in arrKeysIf Len(Item)>37 ThenIf CheckDelete(UCase(Left(Item,38))) Then RegDeleteKey HKLM,sSubKeyName & Item & "\"End IfNext 'ItemEnd If 'RegEnumKey'User PreconfigurationsLog " - HKLM User Preconfigurations"hDefKey = HKLMsSubKeyName = "SOFTWARE\Microsoft\Office\"&OVERSION&"\User Settings\"If RegEnumKey(HKLM,sSubKeyName,arrKeys) ThenFor Each Item in arrKeysIf Len(Item)>37 ThenIf CheckDelete(UCase(Left(Item,38))) Then RegDeleteKey HKLM,sSubKeyName & Item & "\"End IfNext 'ItemEnd If 'RegEnumKey'Known Keypath settingsLog " - Detcted KeyPath settings"For Each key in dicDelRegKey.KeysIf Right(key,1) = "\" ThenRegDeleteKey dicDelRegKey.Item(key),keyElseiPos = InStrRev(Key,"\")If iPos > 0 Then RegDeleteValue dicDelRegKey.Item(key), Left(key,iPos - 1), Mid(key,iPos+1), FalseEnd IfNext'Temporary entries in ARPTmpKeyCleanUpEnd Sub 'RegWipe'======================================================================================================='Clean up Add/Remove Programs registrySub RegWipeARPDim Item, Name, Sku, keyDim sSubKeyName, sCurKey, sValue, sGuidDim fkeep, fSystemComponent0, fPackages, fDisplayVersionDim arrKeys'Add/Remove ProgramssSubKeyName = REG_ARPIf RegEnumKey(HKLM,sSubKeyName,arrKeys) ThenFor Each Item in arrKeys'*0FF1CE*If Len(Item)>37 ThensGuid = UCase(Left(Item,38))If InScope(sGuid) ThenIf CheckDelete(sGuid) Then RegDeleteKey HKLM, sSubKeyName & ItemEnd If 'InScopeEnd If 'Len(Item)>37'Config entriessCurKey = sSubKeyName & Item & "\"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 AND Len(sValue) > 1 ThenfDisplayVersion = (Left(sValue,2) = OVERSIONMAJOR)End IfIf (fSystemComponent0 AND fPackages AND fDisplayVersion) ThenfKeep = FalseIf Not fRemoveAll ThenFor Each Sku in dicKeepSku.KeysIf UCase(Item) = OREGREF & Sku Thenfkeep = TrueExit ForEnd IfNext 'SkuEnd IfIf Not fkeep Then RegDeleteKey HKLM, sSubKeyName & ItemEnd IfNext 'ItemEnd If 'RegEnumKeyEnd Sub 'RegWipeARP'======================================================================================================='Clean up temporary registry keysSub TmpKeyCleanUpDim TmpKeyIf fLogInitialized Then Log " - temporary OffScrub registry entries"If IsArray(arrTmpSKUs) ThenFor Each TmpKey in arrTmpSKUsoReg.DeleteKey HKLM, REG_ARP & TmpKeyNext 'ItemEnd If 'IsArrayEnd Sub 'TmpKeyCleanUp'=======================================================================================================' Helper Functions'======================================================================================================='Create a log with the results of the SKU detectionSub LogSkuResultsDim SkuLog, SkuKey , pOn Error Resume Next 'Don't fail on loggingSet SkuLog = oFso.OpenTextFile(sScrubDir & "\SkuLog.txt",FOR_WRITING,True,True)SkuLog.WriteLine "Installed SKUs (All):"SkuLog.WriteLine "====================="For Each SkuKey in dicInstalledSku.KeysSkuLog.WriteLine " - " & SkuKeyNext 'KeySkuLog.WriteLine vbCrLf & "Server SKUs:"SkuLog.WriteLine "============"For Each SkuKey in dicSrv.KeysSkuLog.WriteLine " - " & SkuKeyNext 'KeySkuLog.WriteLine vbCrLf & "Client Suite SKUs:"SkuLog.WriteLine "=================="For Each SkuKey in dicCSuite.KeysSkuLog.WriteLine " - " & SkuKeyNext 'KeySkuLog.WriteLine vbCrLf & "Client Standalone SKUs:"SkuLog.WriteLine "======================="For Each SkuKey in dicCSingle.KeysSkuLog.WriteLine " - " & SkuKeyNext 'KeySkuLog.WriteLine vbCrLf & "Installed Products (All):"SkuLog.WriteLine "========================="For Each p in oMsi.ProductsIf InScope(p) ThenSkuLog.Write " - " & p & " - "SkuLog.Write oMsi.ProductInfo(p, "ProductName")SkuLog.WriteLine " "End IfNext 'ProductSkuLog.WriteLine vbCrLf & "***************************************************************************************************" & vbCrLfSkuLog.WriteLine vbCrLf & "SKUs to keep:"SkuLog.WriteLine "============="For Each SkuKey in dicKeepSku.KeysSkuLog.WriteLine " - " & SkuKeyNext 'KeySkuLog.WriteLine vbCrLf & "Products to keep:"SkuLog.WriteLine "================="For Each p in dicKeepProd.KeysSkuLog.Write " - " & p & " - "SkuLog.Write oMsi.ProductInfo(p, "ProductName")SkuLog.WriteLine " "Next 'KeySkuLog.WriteLine vbCrLf & "***************************************************************************************************" & vbCrLfSkuLog.WriteLine vbCrLf & "SKUs to remove:"SkuLog.WriteLine "==============="For Each SkuKey in dicRemoveSku.KeysSkuLog.WriteLine " - " & SkuKeyNext 'KeySkuLog.WriteLine vbCrLf & "Products to remove:"SkuLog.WriteLine "==================="For Each p in oMsi.ProductsIf InScope(p) ThenIf (fRemoveAll OR CheckDelete(p))ThenSkuLog.Write " - " & p & " - "SkuLog.Write oMsi.ProductInfo(p, "ProductName")SkuLog.WriteLine " "End IfEnd If 'InScopeNext 'ProductSkuLog.CloseSet SkuLog = NothingEnd Sub 'LogSkuResults'======================================================================================================='End all running instances of applications that will be removedSub CloseOfficeAppsDim Processes, Process, propDim fWaitDim iRetOn Error Resume NextfWait = FalseLog " Doing Action: CloseOfficeApps"Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process")For Each Process in ProcessesIf dicApps.Exists(LCase(Process.Name)) ThenLog " - End process " & Process.NameiRet = Process.Terminate()CheckError "CloseOfficeApps: " & "Process.Name"ElseFor Each prop in Process.Properties_If prop.Name = "ExecutablePath" Then If InStr(UCase(prop.Value), UCase(sOInstallRoot)) > 0 ThenLog = " - End process '" & Process.NameiRet = Process.Terminate()CheckError "CloseOfficeApps: " & "Process.Name"fWait = TrueEnd If End If 'ExcecutablePathNext 'propEnd IfNext 'ProcessIf fWait Thenwscript.sleep 10000End IfLogOnly " End Action: CloseOfficeApps"End Sub 'CloseOfficeApps'======================================================================================================='Ensure Windows Explorer is restarted if neededSub RestoreExplorerDim Processes, Result, oAT, DateTime, JobIDDim sCmd'Non critical routine. Don't fail on errorOn Error Resume Nextwscript.sleep 1000Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name='explorer.exe'")If Processes.Count < 1 Then oWShell.Run "explorer.exe"'To handle this in case of System context, schedule and run as interactive taskIf iVersionNT > 502 Then'Vista and lateroWShell.Run "SCHTASKS /Create /TN OffScrEx /TR explorer /SC ONCE /ST 12:00 /IT",0,TrueoWShell.Run "SCHTASKS /Run /TN OffScrEx", 0, TrueoWShell.Run "SCHTASKS /Delete /TN OffScrEx /F", 0, FalseElseSet oAT = oWmiLocal.Get("Win32_ScheduledJob")Set DateTime = CreateObject("WbemScripting.SWbemDateTime")DateTime.SetVarDate DateAdd("n",1,Now),TrueResult = oAT.Create("explorer.exe", DateTime.Value, , , , True, JobID)End If 'iVersionNTEnd IfEnd Sub 'RestoreExploer'======================================================================================================='Returns the delimiter for a passed in stringFunction Delimiter (sVersion)Dim iCnt, iAscDelimiter = " "For iCnt = 1 To Len(sVersion)iAsc = Asc(Mid(sVersion, iCnt, 1))If Not (iASC >= 48 And iASC <= 57) Then Delimiter = Mid(sVersion, iCnt, 1)Exit FunctionEnd IfNext 'iCntEnd Function'======================================================================================================='Check registry access permissions. Failure will terminate the scriptFunction CheckRegPermissionsConst KEY_QUERY_VALUE = &H0001Const KEY_SET_VALUE = &H0002Const KEY_CREATE_SUB_KEY = &H0004Const DELETE = &H00010000Dim sSubKeyNameDim fReturnCheckRegPermissions = TruesSubKeyName = "Software\Microsoft\Windows\"oReg.CheckAccess HKLM, sSubKeyName, KEY_QUERY_VALUE, fReturnIf Not fReturn Then CheckRegPermissions = FalseoReg.CheckAccess HKLM, sSubKeyName, KEY_SET_VALUE, fReturnIf Not fReturn Then CheckRegPermissions = FalseoReg.CheckAccess HKLM, sSubKeyName, KEY_CREATE_SUB_KEY, fReturnIf Not fReturn Then CheckRegPermissions = FalseoReg.CheckAccess HKLM, sSubKeyName, DELETE, fReturnIf Not fReturn Then CheckRegPermissions = FalseEnd Function 'CheckRegPermissions'======================================================================================================='Check if an Office product is still registered with a SKU that stays on the computerFunction CheckDelete(sProductCode)'Ensure valid GUID lengthIf NOT Len(sProductCode) = 38 ThenCheckDelete = FalseExit FunctionEnd If'If it's a non Office ProductCode exit with false right awayCheckDelete = InScope(sProductCode)If Not CheckDelete Then Exit FunctionIf dicKeepProd.Exists(UCase(sProductCode)) Then CheckDelete = FalseEnd Function 'CheckDelete'======================================================================================================='Check if ProductCode is in scopeFunction InScope(sProductCode)Dim fInScopeDim sProdfInScope = FalseIf Len(sProductCode) = 38 ThensProd = UCase(sProductCode)Select Case OVERSIONMAJORCase "11"If Right(sProd,PRODLEN)=OFFICEID Then InScope = TrueCase "12"If Right(sProd,PRODLEN)=OFFICEID AND Mid(sProd,4,2) = OVERSIONMAJOR Then fInScope = TrueCase "14"If Right(sProd,PRODLEN)=OFFICEID AND Mid(sProd,4,2) = OVERSIONMAJOR Then fInScope = TrueCase "15"If Right(sProd,PRODLEN)=OFFICEID AND Mid(sProd,4,2) = OVERSIONMAJOR Then Select Case Mid(sProd, 11, 4)Case "007E", "008F", "008C"' C2R products - keep themCase ElsefInScope = TrueEnd SelectEnd IfCase ElseEnd SelectEnd If '38InScope = fInScopeEnd Function 'InScope'======================================================================================================='Register an orphaned .msi product as installed for MSISub MsiRegisterProduct (sMsiFile)Dim sDisplayVersion, sCurKey, sDisplayName, sLang, sProductCode, sTmpKeyDim iCnt'Create a temporary keys to simulate an installed productsProductCode = ""sProductCode = GetMsiProductCode(sMsiFile)sDisplayVersion = GetMsiProductVersion(sMsiFile)If sDisplayVersion = "" Then sDisplayVersion = OVERSION & ".0000.0000"sDisplayName = GetMsiProductName(sMsiFile)If sDisplayName = "" Then sDisplayName = sProductCodeSelect Case OVERSIONMAJORCase "9","10","11"sLang = CInt("&h" & Mid(sProductCode,6,4))Case "12","14"sLang = CInt("&h" & Mid(sProductCode,16,4))Case ElseEnd SelectFor iCnt = 1 To 3Select Case iCntCase 1sCurKey = REG_ARP & sProductCodeoReg.CreateKey HKLM,sCurKeyCase 2sCurKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products\" & GetCompressedGuid(sProductCode)oReg.CreateKey HKLM,sCurKeyoReg.CreateKey HKLM,sCurKey & "\Features"oReg.CreateKey HKLM,sCurKey & "\InstallProperties"oReg.CreateKey HKLM,sCurKey & "\Patches"oReg.CreateKey HKLM,sCurKey & "\Usage"sCurKey = sCurKey & "\InstallProperties"oReg.SetStringValue HKLM,sCurKey,"LocalPackage",sMsiFileCase 3sCurKey = "Installer\Products\" & GetCompressedGuid(sProductCode)sTmpKey = sCurKeyoReg.CreateKey HKCR,sCurKeyoReg.SetDWordValue HKCR,sCurKey,"AdvertiseFlags",388oReg.SetDWordValue HKCR,sCurKey,"Assignment",1oReg.SetDWordValue HKCR,sCurKey,"AuthorizedLUAApp",0oReg.SetStringValue HKCR,sCurKey,"Clients",":"oReg.SetDWordValue HKCR,sCurKey,"DeploymentFlags",3oReg.SetDWordValue HKCR,sCurKey,"InstanceType",0oReg.SetDWordValue HKCR,sCurKey,"Language",sLangoReg.SetStringValue HKCR,sCurKey,"PackageCode",GetMsiPackageCode(sMsiFile)oReg.SetStringValue HKCR,sCurKey,"ProductName",sDisplayNameoReg.SetDWordValue HKCR,sCurKey,"VersionMinor",0sCurKey = sTmpKey & "\SourceList"oReg.CreateKey HKCR,sCurKeyoReg.SetExpandedStringValue HKCR,sCurKey,"LastUsedSource",sScrubDiroReg.SetStringValue HKCR,sCurKey,"PackageName",Mid(sMsiFile,InstrRev(sMsiFile,"\")+1)sCurKey = sTmpKey & "\SourceList\Media"oReg.CreateKey HKCR,sCurKeyoReg.SetStringValue HKCR,sCurKey,"1",OREF & ";1"oReg.SetStringValue HKCR,sCurKey,"DiskPrompt",sDisplayNamesCurKey = sTmpKey & "\SourceList\Net"oReg.CreateKey HKCR,sCurKeyoReg.SetExpandedStringValue HKCR,sCurKey,"1",sScrubDirCase ElseEnd SelectIf iCnt <3 ThenoReg.SetStringValue HKLM,sCurKey,"Comments",""oReg.SetStringValue HKLM,sCurKey,"Contact",""oReg.SetStringValue HKLM,sCurKey,"DisplayName",sDisplayNameoReg.SetStringValue HKLM,sCurKey,"DisplayVersion",sDisplayVersionoReg.SetDWordValue HKLM,sCurKey,"EstimatedSize",0oReg.SetStringValue HKLM,sCurKey,"HelpLink",""oReg.SetStringValue HKLM,sCurKey,"HelpTelephone",""oReg.SetStringValue HKLM,sCurKey,"InstallDate","20100101"If f64 ThenoReg.SetStringValue HKLM,sCurKey,"InstallLocation",sProgramFilesX86ElseoReg.SetStringValue HKLM,sCurKey,"InstallLocation",sProgramFilesEnd IfoReg.SetStringValue HKLM,sCurKey,"InstallSource",sScrubDiroReg.SetDWordValue HKLM,sCurKey,"Language",sLangoReg.SetExpandedStringValue HKLM,sCurKey,"ModifyPath","MsiExec.exe /X" & sProductCodeoReg.SetDWordValue HKLM,sCurKey,"NoModify",1oReg.SetStringValue HKLM,sCurKey,"Publisher","Microsoft Corporation"oReg.SetStringValue HKLM,sCurKey,"Readme",""oReg.SetStringValue HKLM,sCurKey,"Size",""oReg.SetDWordValue HKLM,sCurKey,"SystemComponent",0oReg.SetExpandedStringValue HKLM,sCurKey,"UninstallString","MsiExec.exe /X" & sProductCodeoReg.SetStringValue HKLM,sCurKey,"URLInfoAbout",""oReg.SetStringValue HKLM,sCurKey,"URLUpdateInfo",""oReg.SetDWordValue HKLM,sCurKey,"Version",0oReg.SetDWordValue HKLM,sCurKey,"VersionMajor",OVERSIONMAJORoReg.SetDWordValue HKLM,sCurKey,"VersionMinor",0oReg.SetDWordValue HKLM,sCurKey,"WindowsInstaller",1End If '< 3Next 'iCntEnd Sub 'MsiRegisterProduct'======================================================================================================='Obtain the ProductCode (GUID) from a .msi package'The function will open the .msi database and query the 'Property' table to retrieve the ProductCodeFunction GetMsiProductCode(sMsiFile)Dim MsiDb,RecordDim qViewOn Error Resume NextGetMsiProductCode = ""Set Record = NothingSet MsiDb = oMsi.OpenDatabase(sMsiFile,MSIOPENDATABASEREADONLY)Set qView = MsiDb.OpenView("SELECT `Value` FROM Property WHERE `Property` = 'ProductCode'")qView.ExecuteSet Record = qView.FetchGetMsiProductCode = Record.StringData(1)qView.CloseEnd Function 'GetMsiProductCode'======================================================================================================='Obtain the ProductVersion from a .msi package'The function will open the .msi database and query the 'Property' table to retrieve the ProductCodeFunction GetMsiProductVersion(sMsiFile)Dim MsiDb,RecordDim qViewOn Error Resume NextGetMsiProductVersion = ""Set Record = NothingSet MsiDb = oMsi.OpenDatabase(sMsiFile,MSIOPENDATABASEREADONLY)Set qView = MsiDb.OpenView("SELECT `Value` FROM Property WHERE `Property` = 'ProductVersion'")qView.ExecuteSet Record = qView.FetchGetMsiProductVersion = Record.StringData(1)qView.CloseEnd Function 'GetMsiProductVersion'======================================================================================================='Obtain the ProductVersion from a .msi package'The function will open the .msi database and query the 'Property' table to retrieve the ProductCodeFunction GetMsiProductName(sMsiFile)Dim MsiDb,RecordDim qViewOn Error Resume NextGetMsiProductName = ""Set Record = NothingSet MsiDb = oMsi.OpenDatabase(sMsiFile,MSIOPENDATABASEREADONLY)Set qView = MsiDb.OpenView("SELECT `Value` FROM Property WHERE `Property` = 'ProductName'")qView.ExecuteSet Record = qView.FetchGetMsiProductName = Record.StringData(1)qView.CloseEnd Function 'GetMsiProductVersion'======================================================================================================='Obtain the PackageCode (GUID) from a .msi package'The function will the .msi'S SummaryInformation streamFunction GetMsiPackageCode(sMsiFile)On Error Resume NextConst PID_REVNUMBER = 9GetMsiPackageCode = ""GetMsiPackageCode = GetCompressedGuid(oMsi.SummaryInformation(sMsiFile,MSIOPENDATABASEREADONLY).Property(PID_REVNUMBER))End Function 'GetMsiPackageCode'======================================================================================================='Returns a string with a list of ProductCodes from the summary information streamFunction MspTargets (sMspFile)Const MSIOPENDATABASEMODE_PATCHFILE = 32Const PID_TEMPLATE = 7Dim Msp'Non critical routine. Don't fail on errorOn Error Resume NextMspTargets = ""If oFso.FileExists(sMspFile) ThenSet Msp = Msi.OpenDatabase(WScript.Arguments(0),MSIOPENDATABASEMODE_PATCHFILE)If Err = 0 Then MspTargets = Msp.SummaryInformation.Property(PID_TEMPLATE)End If 'oFso.FileExists(sMspFile)End Function 'MspTargets'======================================================================================================='Return the ProductCode {GUID} from a .MSI packageFunction ProductCode(sMsi)Const MSIUILEVELNONE = 2 'No UIDim MsiSessionOn Error Resume Next'Non critical routine. Don't fail on errorIf oFso.FileExists(sMsi) ThenoMsi.UILevel = MSIUILEVELNONESet MsiSession = oMsi.OpenPackage(sMsi,1)ProductCode = MsiSession.ProductProperty("ProductCode")Set MsiSession = NothingElseProductCode = ""End If 'oFso.FileExists(sMsi)End Function 'ProductCode'=======================================================================================================Function GetExpandedGuid (sGuid)Dim i'Ensure valid lengthIf NOT Len(sGuid) = 32 Then Exit FunctionGetExpandedGuid = "{" & StrReverse(Mid(sGuid,1,8)) & "-" & _StrReverse(Mid(sGuid,9,4)) & "-" & _StrReverse(Mid(sGuid,13,4))& "-"For i = 17 To 20 If i Mod 2 Then GetExpandedGuid = GetExpandedGuid & mid(sGuid,(i + 1),1) Else GetExpandedGuid = GetExpandedGuid & mid(sGuid,(i - 1),1) End IfNextGetExpandedGuid = GetExpandedGuid & "-"For i = 21 To 32 If i Mod 2 Then GetExpandedGuid = GetExpandedGuid & mid(sGuid,(i + 1),1) Else GetExpandedGuid = GetExpandedGuid & mid(sGuid,(i - 1),1) End IfNextGetExpandedGuid = GetExpandedGuid & "}"End Function'======================================================================================================='Converts a GUID into the compressed formatFunction GetCompressedGuid (sGuid)Dim sCompGUIDDim i'Ensure Valid LengthIf NOT Len(sGuid) = 38 Then Exit FunctionsCompGUID = StrReverse(Mid(sGuid,2,8)) & _StrReverse(Mid(sGuid,11,4)) & _StrReverse(Mid(sGuid,16,4)) For i = 21 To 24 If i Mod 2 Then sCompGUID = sCompGUID & Mid(sGuid, (i + 1), 1) Else sCompGUID = sCompGUID & Mid(sGuid, (i - 1), 1) End IfNextFor i = 26 To 37 If i Mod 2 Then sCompGUID = sCompGUID & Mid(sGuid, (i - 1), 1) Else sCompGUID = sCompGUID & Mid(sGuid, (i + 1), 1) End IfNextGetCompressedGuid = sCompGUIDEnd Function'======================================================================================================='Unsquish GUIDFunction GetDecodedGuid(sEncGuid, sGuid)Dim sDecode, sTable, sHex, iChrDim arrTableDim i, iAsc, pow85, decCharDim lTotalDim fFailedfFailed = FalsesTable = "0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff," & _"0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff," & _"0xff,0x00,0xff,0xff,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0x0a,0x0b,0xff," & _"0x0c,0x0d,0x0e,0x0f,0x10,0x11,0x12,0x13,0x14,0x15,0xff,0xff,0xff,0x16,0xff,0x17," & _"0x18,0x19,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27," & _"0x28,0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f,0x30,0x31,0x32,0x33,0xff,0x34,0x35,0x36," & _"0x37,0x38,0x39,0x3a,0x3b,0x3c,0x3d,0x3e,0x3f,0x40,0x41,0x42,0x43,0x44,0x45,0x46," & _"0x47,0x48,0x49,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f,0x50,0x51,0x52,0xff,0x53,0x54,0xff"arrTable = Split(sTable,",")lTotal = 0 : pow85 = 1For i = 0 To 19fFailed = TrueIf i Mod 5 = 0 ThenlTotal = 0 : pow85 = 1End If ' i Mod 5 = 0iAsc = Asc(Mid(sEncGuid,i+1,1))sHex = arrTable(iAsc)If iAsc >=128 Then Exit ForIf sHex = "0xff" Then Exit ForiChr = CInt("&h"&Right(sHex,2))lTotal = lTotal + (iChr * pow85)If i Mod 5 = 4 Then sDecode = sDecode & DecToHex(lTotal)pow85 = pow85 * 85fFailed = FalseNext 'iIf NOT fFailed Then sGuid = "{"&Mid(sDecode,1,8)&"-"& _Mid(sDecode,13,4)&"-"& _Mid(sDecode,9,4)&"-"& _Mid(sDecode,23,2) & Mid(sDecode,21,2)&"-"& _Mid(sDecode,19,2) & Mid(sDecode,17,2) & Mid(sDecode,31,2) & Mid(sDecode,29,2) & Mid(sDecode,27,2) & Mid(sDecode,25,2) &"}"GetDecodedGuid = NOT fFailedEnd Function 'GetDecodedGuid'======================================================================================================='Convert a long decimal to hexFunction DecToHex(lDec)Dim sHexDim iLenDim lVal, lExpDim arrChrarrChr = Array("0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F")sHex = ""lVal = lDeclExp = 16^10While lExp >= 1If lVal >= lExp ThensHex = sHex & arrChr(Int(lVal / lExp))lVal = lVal - lExp * Int(lVal / lExp)ElsesHex = sHex & "0"If sHex = "0" Then sHex = ""End IflExp = lExp / 16WendiLen = 8 - Len(sHex)If iLen > 0 Then sHex = String(iLen,"0") & sHexDecToHex = sHexEnd Function'======================================================================================================='Ensures that only valid metadata entries exist to avoid API failuresSub EnsureValidWIMetadata (hDefKey,sKey,iValidLength)Dim arrKeysDim SubKeyIf Len(sKey) > 1 ThenIf Right(sKey,1) = "\" Then sKey = Left(sKey,Len(sKey)-1)End IfIf RegEnumKey(hDefKey,sKey,arrKeys) ThenFor Each SubKey in arrKeysIf NOT Len(SubKey) = iValidLength ThenRegDeleteKey hDefKey,sKey & "\" & SubKey & "\"End IfNext 'SubKeyEnd IfEnd Sub 'EnsureValidWIMetadata'======================================================================================================='Create a backup copy of the file in the ScrubDir then delete the fileSub CopyAndDeleteFile(sFile)Dim File'Error handling inlinedOn Error Resume NextIf oFso.FileExists(sFile) ThenSet File = oFso.GetFile(sFile)If Not oFso.FolderExists(sScrubDir & "\" & File.ParentFolder.Name) Then oFso.CreateFolder sScrubDir & "\" & File.ParentFolder.NameIf Not fDetectOnly ThenLogOnly " - Backing up file: " & sFileoFso.CopyFile sFile,sScrubDir & "\" & File.ParentFolder.Name & "\" & File.Name,True : CheckError "CopyAndDeleteFile"Set File = NothingDeleteFile(sFile)ElseLogOnly " - Simulate CopyAndDelete file: " & sFileEnd IfEnd If 'oFso.FileExistsEnd Sub 'CopyAndDeleteFile'======================================================================================================='Wrapper to delete a fileSub DeleteFile(sFile)Dim FileDim sFileName, sNewPathOn Error Resume NextIf dicKeepFolder.Exists(LCase(sFile)) ThenIf NOT fForce ThenLogOnly " - Disallowing the delete of still required keypath element: " & sFileExit SubElseLogOnly " - Enforced delete of still required keypath element: " & sFileLogOnly " Remaining applications will need a repair!"End IfEnd IfIf f64 ThenIf dicKeepFolder.Exists(LCase(Wow64Folder(sFile))) ThenIf NOT fForce ThenLogOnly " - Disallowing the delete of still required keypath element: " & sFileExit SubElseLogOnly " - Enforced delete of still required keypath element: " & sFileLogOnly " Remaining applications will need a repair!"End IfEnd IfEnd IfIf oFso.FileExists(sFile) ThenLogOnly " - Delete file: " & sFileIf Not fDetectOnly Then oFso.DeleteFile sFile,TrueIf Err <> 0 ThenCheckError "DeleteFile"If fForce Then'Try to move the file and delete from thereSet File = oFso.GetFile(sFile)sFileName = File.NamesNewPath = sScrubDir & "\ScrubTmp"Set File = NothingIf Not oFso.FolderExists(sNewPath) Then oFso.CreateFolder(sNewPath)'Move the fileLogOnly " - Move file to: " & sNewPath & "\" & sFileNameoFso.MoveFile sFile,sNewPath & "\" & sFileNameIf Err <> 0 Then CheckError "DeleteFile (move)"End If 'Err <> 0ElsefRebootRequired = TrueEnd If 'fForceEnd If 'Err <> 0End If 'oFso.FileExistsEnd Sub 'DeleteFile'======================================================================================================='64 bit aware wrapper to return the requested folder Function GetFolderPath(sPath)GetFolderPath = TrueIf oFso.FolderExists(sPath) Then Exit FunctionIf f64 AND oFso.FolderExists(Wow64Folder(sPath)) ThensPath = Wow64Folder(sPath)Exit FunctionEnd IfGetFolderPath = FalseEnd Function 'GetFolderPath'======================================================================================================='Enumerates subfolder names of a folder and returns True if subfolders existFunction EnumFolderNames (sFolder, arrSubFolders)Dim Folder, SubfolderDim sSubFoldersIf oFso.FolderExists(sFolder) ThenSet Folder = oFso.GetFolder(sFolder)For Each Subfolder in Folder.SubfolderssSubFolders = sSubFolders & Subfolder.Name & ","Next 'SubfolderEnd IfIf f64 AND oFso.FolderExists(Wow64Folder(sFolder)) ThenSet Folder = oFso.GetFolder(Wow64Folder(sFolder))For Each Subfolder in Folder.SubfolderssSubFolders = sSubFolders & Subfolder.Name & ","Next 'SubfolderEnd IfIf Len(sSubFolders)>0 Then arrSubFolders = RemoveDuplicates(Split(Left(sSubFolders,Len(sSubFolders)-1),","))EnumFolderNames = Len(sSubFolders)>0End Function 'EnumFolderNames'======================================================================================================='Enumerates subfolders of a folder and returns True if subfolders existFunction EnumFolders (sFolder, arrSubFolders)Dim Folder, SubfolderDim sSubFoldersIf oFso.FolderExists(sFolder) ThenSet Folder = oFso.GetFolder(sFolder)For Each Subfolder in Folder.SubfolderssSubFolders = sSubFolders & Subfolder.Path & ","Next 'SubfolderEnd IfIf f64 AND oFso.FolderExists(Wow64Folder(sFolder)) ThenSet Folder = oFso.GetFolder(Wow64Folder(sFolder))For Each Subfolder in Folder.SubfolderssSubFolders = sSubFolders & Subfolder.Path & ","Next 'SubfolderEnd IfIf Len(sSubFolders)>0 Then arrSubFolders = RemoveDuplicates(Split(Left(sSubFolders,Len(sSubFolders)-1),","))EnumFolders = Len(sSubFolders)>0End Function 'EnumFolders'=======================================================================================================Sub GetMseFolderStructure (Folder)Dim SubFolderFor Each SubFolder in Folder.SubFoldersReDim Preserve arrMseFolders(UBound(arrMseFolders)+1)arrMseFolders(UBound(arrMseFolders)) = SubFolder.PathGetMseFolderStructure SubFolderNext 'SubFolderEnd Sub 'GetMseFolderStructure'======================================================================================================='Wrapper to delete a folder Sub DeleteFolder(sFolder)Dim FolderDim sDelFolder, sFolderName, sNewPath'Ensure trailing "\"sFolder = sFolder & "\"While InStr(sFolder,"\\")>0sFolder = Replace(sFolder,"\\","\")WendIf dicKeepFolder.Exists(LCase(sFolder)) ThenIf NOT fForce ThenLogOnly " - Disallowing the delete of still required keypath element: " & sFolderExit SubElseLogOnly " - Enforced delete of still required keypath element: " & sFolderLogOnly " Remaining applications will need a repair!"End IfEnd IfIf f64 ThenIf dicKeepFolder.Exists(LCase(Wow64Folder(sFolder))) ThenIf NOT fForce ThenLogOnly " - Disallowing the delete of still required keypath element: " & sFolderExit SubElseLogOnly " - Enforced delete of still required keypath element: " & sFolderLogOnly " Remaining applications will need a repair!"End IfEnd IfEnd If'Strip trailing "\"If Len(sFolder) > 1 ThensFolder = Left(sFolder,Len(sFolder)-1)End IfOn Error Resume NextIf oFso.FolderExists(sFolder) Then sDelFolder = sFolderElseIf f64 AND oFso.FolderExists(Wow64Folder(sFolder)) Then sDelFolder = Wow64Folder(sFolder)ElseExit SubEnd IfIf Not fDetectOnly Then LogOnly " - Delete folder: " & sDelFolderoFso.DeleteFolder sDelFolder,TrueElseLogOnly " - Simulate delete folder: " & sDelFolderEnd IfIf Err <> 0 ThenCheckError "DeleteFolder"'Try to move the folder and delete from thereSet Folder = oFso.GetFolder(sDelFolder)sFolderName = Folder.NamesNewPath = sScrubDir & "\ScrubTmp"Set Folder = Nothing'Ensure we stay within the same driveIf Not oFso.FolderExists(sNewPath) Then oFso.CreateFolder(sNewPath)'Move the folderLogOnly " - Moving folder to: " & sNewPath & "\" & sFolderNameoFso.MoveFolder sFolder,sNewPath & "\" & sFolderNameIf Err <> 0 ThenCheckError "DeleteFolder (move)"End If 'Err <> 0End If 'Err <> 0End Sub 'DeleteFolder'======================================================================================================='Delete empty folder structuresSub DeleteEmptyFoldersDim FolderDim sFolder' cosmetic' task don't fail on errorOn Error Resume NextIf Not IsArray(arrDeleteFolders) Then Exit SubLog vbCrLf & "Empty Folder Cleanup"For Each sFolder in arrDeleteFoldersIf oFso.FolderExists(sFolder) ThenSet Folder = oFso.GetFolder(sFolder)If CBool(Folder.Attributes AND 1024) Then'exclude protected folderElseIf (Folder.Subfolders.Count = 0) AND (Folder.Files.Count = 0) Then Set Folder = NothingSmartDeleteFolder sFolderEnd IfEnd IfEnd IfNext 'sFolderCheckError "DeleteEmptyFolders"On Error Goto 0End Sub 'DeleteEmptyFolders'======================================================================================================='Wrapper to delete a folder and remove the empty parent folder structureSub SmartDeleteFolder(sFolder)If oFso.FolderExists(sFolder) Then If Not fDetectOnly ThenLogOnly " Request SmartDelete for folder: " & sFolderSmartDeleteFolderEx sFolderElseLogOnly " Simulate request SmartDelete for folder: " & sFolderEnd IfEnd IfIf f64 AND oFso.FolderExists(Wow64Folder(sFolder)) Then If Not fDetectOnly Then LogOnly "Request SmartDelete for folder: " & Wow64Folder(sFolder)SmartDeleteFolderEx Wow64Folder(sFolder)ElseLogOnly "Simulate request SmartDelete for folder: " & Wow64Folder(sFolder)End IfEnd IfEnd Sub 'SmartDeleteFolder'======================================================================================================='Executes the folder delete operationSub SmartDeleteFolderEx(sFolder)Dim FolderOn Error Resume NextDeleteFolder sFolder : CheckError "SmartDeleteFolderEx"On Error Goto 0Set Folder = oFso.GetFolder(oFso.GetParentFolderName(sFolder))If (Folder.Subfolders.Count = 0) AND (Folder.Files.Count = 0) Then SmartDeleteFolderEx(Folder.Path)End Sub 'SmartDeleteFolderEx'======================================================================================================='Adds the folder structure to the 'KeepFolder' dictionarySub AddKeepFolder(sPath)Dim Folder'Ensure trailing "\"sPath = LCase(sPath) & "\"While InStr(sPath,"\\")>0sPath = Replace(sPath,"\\","\")WendIf NOT dicKeepFolder.Exists (sPath) ThendicKeepFolder.Add sPath,sPathElseExit SubEnd IfsPath = LCase(oFso.GetParentFolderName(sPath)) & "\"If oFso.FolderExists(sPath) Then AddKeepFolder(sPath)End Sub'======================================================================================================='Handles additional folder-path operations on 64 bit environmentsFunction Wow64Folder(sFolder)If LCase(Left(sFolder,Len(sWinDir & "\System32"))) = LCase(sWinDir & "\System32") Then Wow64Folder = sWinDir & "\syswow64" & Right(sFolder,Len(sFolder)-Len(sSys32Dir))ElseIf LCase(Left(sFolder,Len(sProgramFiles))) = LCase(sProgramFiles) Then Wow64Folder = sProgramFilesX86 & Right(sFolder,Len(sFolder)-Len(sProgramFiles))ElseWow64Folder = "?" 'Return invalid string to ensure the folder cannot existEnd IfEnd Function 'Wow64Folder'=======================================================================================================Function HiveString(hDefKey)On Error Resume NextSelect Case hDefKeyCase HKCR : HiveString = "HKEY_CLASSES_ROOT"Case HKCU : HiveString = "HKEY_CURRENT_USER"Case HKLM : HiveString = "HKEY_LOCAL_MACHINE"Case HKU : HiveString = "HKEY_USERS"Case Else : HiveString = hDefKeyEnd SelectEnd Function'=======================================================================================================Function RegKeyExists(hDefKey,sSubKeyName)Dim arrKeysRegKeyExists = FalseIf oReg.EnumKey(hDefKey,sSubKeyName,arrKeys) = 0 Then RegKeyExists = TrueEnd Function'=======================================================================================================Function RegValExists(hDefKey,sSubKeyName,sName)Dim arrValueTypes, arrValueNamesDim iRegValExists = FalseIf Not RegKeyExists(hDefKey,sSubKeyName) Then Exit FunctionIf oReg.EnumValues(hDefKey,sSubKeyName,arrValueNames,arrValueTypes) = 0 AND IsArray(arrValueNames) ThenFor i = 0 To UBound(arrValueNames) If LCase(arrValueNames(i)) = Trim(LCase(sName)) Then RegValExists = TrueNext End If 'oReg.EnumValuesEnd Function'======================================================================================================='Read the value of a given registry entryFunction RegReadValue(hDefKey, sSubKeyName, sName, sValue, sType)Dim RetValDim ItemDim arrValuesSelect Case UCase(sType)Case "1","REG_SZ"RetVal = oReg.GetStringValue(hDefKey,sSubKeyName,sName,sValue)If Not RetVal = 0 AND f64 Then RetVal = oReg.GetStringValue(hDefKey,Wow64Key(hDefKey, sSubKeyName),sName,sValue)Case "2","REG_EXPAND_SZ"RetVal = oReg.GetExpandedStringValue(hDefKey,sSubKeyName,sName,sValue)If Not RetVal = 0 AND f64 Then RetVal = oReg.GetExpandedStringValue(hDefKey,Wow64Key(hDefKey, sSubKeyName),sName,sValue)Case "7","REG_MULTI_SZ"RetVal = oReg.GetMultiStringValue(hDefKey,sSubKeyName,sName,arrValues)If Not RetVal = 0 AND f64 Then RetVal = oReg.GetMultiStringValue(hDefKey,Wow64Key(hDefKey, sSubKeyName),sName,arrValues)If RetVal = 0 Then sValue = Join(arrValues,chr(34))Case "4","REG_DWORD"RetVal = oReg.GetDWORDValue(hDefKey,sSubKeyName,sName,sValue)If Not RetVal = 0 AND f64 Then RetVal = oReg.GetDWORDValue(hDefKey,Wow64Key(hDefKey, sSubKeyName),sName,sValue)End IfCase "3","REG_BINARY"RetVal = oReg.GetBinaryValue(hDefKey,sSubKeyName,sName,sValue)If Not RetVal = 0 AND f64 Then RetVal = oReg.GetBinaryValue(hDefKey,Wow64Key(hDefKey, sSubKeyName),sName,sValue)Case "11","REG_QWORD"RetVal = oReg.GetQWORDValue(hDefKey,sSubKeyName,sName,sValue)If Not RetVal = 0 AND f64 Then RetVal = oReg.GetQWORDValue(hDefKey,Wow64Key(hDefKey, sSubKeyName),sName,sValue)Case ElseRetVal = -1End Select 'sValueRegReadValue = (RetVal = 0)End Function 'RegReadValue'======================================================================================================='Enumerate a registry key to return all valuesFunction RegEnumValues(hDefKey,sSubKeyName,arrNames, arrTypes)Dim RetVal, RetVal64Dim arrNames32, arrNames64, arrTypes32, arrTypes64If f64 ThenRetVal = oReg.EnumValues(hDefKey,sSubKeyName,arrNames32,arrTypes32)RetVal64 = oReg.EnumValues(hDefKey,Wow64Key(hDefKey, sSubKeyName),arrNames64,arrTypes64)If (RetVal = 0) AND (Not RetVal64 = 0) AND IsArray(arrNames32) AND IsArray(arrTypes32) Then arrNames = arrNames32arrTypes = arrTypes32End IfIf (Not RetVal = 0) AND (RetVal64 = 0) AND IsArray(arrNames64) AND IsArray(arrTypes64) Then arrNames = arrNames64arrTypes = arrTypes64End IfIf (RetVal = 0) AND (RetVal64 = 0) AND IsArray(arrNames32) AND IsArray(arrNames64) AND IsArray(arrTypes32) AND IsArray(arrTypes64) Then arrNames = RemoveDuplicates(Split((Join(arrNames32,"\") & "\" & Join(arrNames64,"\")),"\"))arrTypes = RemoveDuplicates(Split((Join(arrTypes32,"\") & "\" & Join(arrTypes64,"\")),"\"))End IfElseRetVal = oReg.EnumValues(hDefKey,sSubKeyName,arrNames,arrTypes)End If 'f64RegEnumValues = ((RetVal = 0) OR (RetVal64 = 0)) AND IsArray(arrNames) AND IsArray(arrTypes)End Function 'RegEnumValues'======================================================================================================='Enumerate a registry key to return all subkeysFunction RegEnumKey(hDefKey,sSubKeyName,arrKeys)Dim RetVal, RetVal64Dim arrKeys32, arrKeys64If f64 ThenRetVal = oReg.EnumKey(hDefKey,sSubKeyName,arrKeys32)RetVal64 = oReg.EnumKey(hDefKey,Wow64Key(hDefKey, sSubKeyName),arrKeys64)If (RetVal = 0) AND (Not RetVal64 = 0) AND IsArray(arrKeys32) Then arrKeys = arrKeys32If (Not RetVal = 0) AND (RetVal64 = 0) AND IsArray(arrKeys64) Then arrKeys = arrKeys64If (RetVal = 0) AND (RetVal64 = 0) Then If IsArray(arrKeys32) AND IsArray (arrKeys64) Then arrKeys = RemoveDuplicates(Split((Join(arrKeys32,"\") & "\" & Join(arrKeys64,"\")),"\"))ElseIf IsArray(arrKeys64) ThenarrKeys = arrKeys64ElsearrKeys = arrKeys32End IfEnd IfElseRetVal = oReg.EnumKey(hDefKey,sSubKeyName,arrKeys)End If 'f64RegEnumKey = ((RetVal = 0) OR (RetVal64 = 0)) AND IsArray(arrKeys)End Function 'RegEnumKey'======================================================================================================='Wrapper around oReg.DeleteValue to handle 64 bitSub RegDeleteValue(hDefKey, sSubKeyName, sName, fRegMultiSZ)Dim sWow64Key, sValueDim iRetValIf dicKeepReg.Exists(LCase(sSubKeyName & sName)) ThenIf NOT fForce ThenLogOnly " - Disallowing the delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyName & sNameExit SubElseLogOnly " - Enforced delete of still required keypath element. Remaining applications will need a repair!"End IfEnd IfIf f64 ThenIf dicKeepReg.Exists(LCase(Wow64Key(hDefKey, sSubKeyName) & sName)) ThenIf NOT fForce ThenLogOnly " - Disallowing the delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyName & sNameExit SubElseLogOnly " - Enforced delete of still required keypath element. Remaining applications will need a repair!"End IfEnd IfEnd IfIf RegValExists(hDefKey,sSubKeyName,sName) ThenOn Error Resume NextIf RegReadValue(hDefKey,sSubKeyName,sName,sValue,"REG_MULTI_SZ") ThenLogOnly " - Disallowing unsafe delete of REG_MULTI_SZ: " & HiveString(hDefKey) & "\" & sSubKeyName & sNameExit SubEnd IfIf Not fDetectOnly Then LogOnly " - Delete registry value: " & HiveString(hDefKey) & "\" & sSubKeyName & " -> " & sNameiRetVal = 0iRetVal = oReg.DeleteValue(hDefKey, sSubKeyName, sName)CheckError "RegDeleteValue"If NOT (iRetVal=0) Then LogOnly " Delete failed. Return value: "&iRetValElseLogOnly " - Simulate delete registry value: " & HiveString(hDefKey) & "\" & sSubKeyName & " -> " & sNameEnd IfOn Error Goto 0End If 'RegValExistsIf f64 Then sWow64Key = Wow64Key(hDefKey, sSubKeyName)If RegValExists(hDefKey,sWow64Key,sName) ThenOn Error Resume NextIf RegReadValue(hDefKey,sSubKeyName,sName,sValue,"REG_MULTI_SZ") ThenLogOnly " - Disallowing unsafe delete of REG_MULTI_SZ: " & HiveString(hDefKey) & "\" & sSubKeyName & sNameExit SubEnd IfIf Not fDetectOnly Then LogOnly " - Delete registry value: " & HiveString(hDefKey) & "\" & sWow64Key & " -> " & sNameiRetVal = 0iRetVal = oReg.DeleteValue(hDefKey, sWow64Key, sName)CheckError "RegDeleteValue"If NOT (iRetVal=0) Then LogOnly " Delete failed. Return value: "&iRetValElseLogOnly " - Simulate delete registry value: " & HiveString(hDefKey) & "\" & sWow64Key & " -> " & sNameEnd IfOn Error Goto 0End If 'RegKeyExistsEnd IfEnd Sub 'RegDeleteValue'======================================================================================================='Wrappper around RegDeleteKeyEx to handle 64bit scenriosSub RegDeleteKey(hDefKey, sSubKeyName)Dim sWow64Key'Ensure trailing "\"sSubKeyName = sSubKeyName & "\"While InStr(sSubKeyName,"\\")>0sSubKeyName = Replace(sSubKeyName,"\\","\")WendIf dicKeepReg.Exists(LCase(sSubKeyName)) ThenIf NOT fForce ThenLogOnly " - Disallowing the delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyNameExit SubElseLogOnly " - Enforced delete of still required keypath element. Remaining applications will need a repair!"End IfEnd IfIf f64 ThenIf dicKeepReg.Exists(LCase(Wow64Key(hDefKey, sSubKeyName))) ThenIf NOT fForce ThenLogOnly " - Disallowing the delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyNameExit SubElseLogOnly " - Enforced delete of still required keypath element. Remaining applications will need a repair!"End IfEnd IfEnd IfIf Len(sSubKeyName) > 1 Then'Strip of trailing "\"sSubKeyName = Left(sSubKeyName,Len(sSubKeyName)-1)End IfIf RegKeyExists(hDefKey, sSubKeyName) ThenIf Not fDetectOnly ThenLogOnly " - Delete registry key: " & HiveString(hDefKey) & "\" & sSubKeyNameOn Error Resume NextRegDeleteKeyEx hDefKey, sSubKeyNameOn Error Goto 0ElseLogOnly " - Simulate delete registry key: " & HiveString(hDefKey) & "\" & sSubKeyNameEnd IfEnd If 'RegKeyExistsIf f64 Then sWow64Key = Wow64Key(hDefKey, sSubKeyName)If RegKeyExists(hDefKey,sWow64Key) ThenIf Not fDetectOnly ThenLogOnly " - Delete registry key: " & HiveString(hDefKey) & "\" & sWow64KeyOn Error Resume NextRegDeleteKeyEx hDefKey, sWow64KeyOn Error Goto 0ElseLogOnly " - Simulate delete registry key: " & HiveString(hDefKey) & "\" & sWow64KeyEnd IfEnd If 'RegKeyExistsEnd IfEnd Sub 'RegDeleteKey'======================================================================================================='Recursively delete a registry structureSub RegDeleteKeyEx(hDefKey, sSubKeyName) Dim arrSubkeysDim sSubkeyDim iRetValOn Error Resume NextoReg.EnumKey hDefKey, sSubKeyName, arrSubkeysIf IsArray(arrSubkeys) Then For Each sSubkey In arrSubkeys RegDeleteKeyEx hDefKey, sSubKeyName & "\" & sSubkey Next End If If Not fDetectOnly Then iRetVal = 0iRetVal = oReg.DeleteKey(hDefKey,sSubKeyName)If NOT (iRetVal=0) Then LogOnly " Delete failed. Return value: "&iRetValEnd IfEnd Sub 'RegDeleteKeyEx'======================================================================================================='Return the alternate regkey location on 64bit environmentFunction Wow64Key(hDefKey, sSubKeyName)Dim iPosSelect Case hDefKeyCase HKCUIf Left(sSubKeyName,17) = "Software\Classes\" ThenWow64Key = Left(sSubKeyName,17) & "Wow6432Node\" & Right(sSubKeyName,Len(sSubKeyName)-17)ElseiPos = InStr(sSubKeyName,"\")Wow64Key = Left(sSubKeyName,iPos) & "Wow6432Node\" & Right(sSubKeyName,Len(sSubKeyName)-iPos)End IfCase HKLMIf Left(sSubKeyName,17) = "Software\Classes\" ThenWow64Key = Left(sSubKeyName,17) & "Wow6432Node\" & Right(sSubKeyName,Len(sSubKeyName)-17)ElseiPos = InStr(sSubKeyName,"\")Wow64Key = Left(sSubKeyName,iPos) & "Wow6432Node\" & Right(sSubKeyName,Len(sSubKeyName)-iPos)End IfCase ElseWow64Key = "Wow6432Node\" & sSubKeyNameEnd Select 'hDefKeyEnd Function 'Wow64Key'======================================================================================================='Remove duplicate entries from a one dimensional arrayFunction RemoveDuplicates(Array)Dim ItemDim oDicSet oDic = CreateObject("Scripting.Dictionary")For Each Item in ArrayIf Not oDic.Exists(Item) Then oDic.Add Item,ItemNext 'ItemRemoveDuplicates = oDic.KeysEnd Function 'RemoveDuplicates'======================================================================================================='End running instances of setupSub EndCurrentInstalls ()Dim Processes, ProcessDim iRetSet Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name like '%setup%' OR Name like '%install%'")For Each Process in ProcessesLog " - End process " & Process.NameiRet = Process.Terminate()CheckError "EndCurrentInstalls: " & "Process.Name"Next 'ProcessStopService "msiserver"End Sub 'EndCurrentInstalls'======================================================================================================='Uses WMI to stop a serviceFunction StopService(sService)Dim Services, ServiceDim sQueryDim iRetOn Error Resume NextiRet = 0sQuery = "Select * From Win32_Service Where Name='" & sService & "'"Set Services = oWmiLocal.Execquery(sQuery)'Stop the serviceFor Each Service in ServicesIf UCase(Service.State) = "STARTED" Then iRet = Service.StopServiceIf UCase(Service.State) = "RUNNING" Then iRet = Service.StopServiceNext 'ServiceStopService = (iRet = 0)End Function 'StopService'======================================================================================================='Delete a serviceSub DeleteService(sService)Dim Services, Service, Processes, ProcessDim sQuery, sStatesDim iRetOn Error Resume NextsStates = "STARTED;RUNNING"sQuery = "Select * From Win32_Service Where Name='" & sService & "'"Set Services = oWmiLocal.Execquery(sQuery)'Stop and delete the serviceFor Each Service in ServicesLog " Found service " & sService & " in state " & Service.StateIf InStr(sStates,UCase(Service.State))>0 Then iRet = Service.StopService()'Ensure no more instances of the service are runningSet Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name='" & sService & ".exe'")For Each Process in ProcessesiRet = Process.Terminate()Next 'ProcessIf Not fDetectOnly Then Log " - Deleting Service -> " & sServiceiRet = Service.Delete()ElseLog " - Simulate deleting Service -> " & sServiceEnd IfNext 'ServiceSet Services = NothingErr.ClearEnd Sub 'DeleteService'======================================================================================================='Translation for setup.exe error codesFunction SetupRetVal(RetVal)Select Case RetValCase 0 : SetupRetVal = "Success"Case 30001,1 : SetupRetVal = "AbstractMethod"Case 30002,2 : SetupRetVal = "ApiProhibited"Case 30003,3 : SetupRetVal = "AlreadyImpersonatingAUser"Case 30004,4 : SetupRetVal = "AlreadyInitialized"Case 30005,5 : SetupRetVal = "ArgumentNullException"Case 30006,6 : SetupRetVal = "AssertionFailed"Case 30007,7 : SetupRetVal = "CABFileAddFailed"Case 30008,8 : SetupRetVal = "CommandFailed"Case 30009,9 : SetupRetVal = "ConcatenationFailed"Case 30010,10 : SetupRetVal = "CopyFailed"Case 30011,11 : SetupRetVal = "CreateEventFailed"Case 30012,12 : SetupRetVal = "CustomizationPatchNotFound"Case 30013,13 : SetupRetVal = "CustomizationPatchNotApplicable"Case 30014,14 : SetupRetVal = "DuplicateDefinition"Case 30015,15 : SetupRetVal = "ErrorCodeOnly - Passthrough for Win32 error"Case 30016,16 : SetupRetVal = "ExceptionNotThrown"Case 30017,17 : SetupRetVal = "FailedToImpersonateUser"Case 30018,18 : SetupRetVal = "FailedToInitializeFlexDataSource"Case 30019,19 : SetupRetVal = "FailedToStartClassFactories"Case 30020,20 : SetupRetVal = "FileNotFound"Case 30021,21 : SetupRetVal = "FileNotOpen"Case 30022,22 : SetupRetVal = "FlexDialogAlreadyInitialized"Case 30023,23 : SetupRetVal = "HResultOnly - Passthrough for HRESULT errors"Case 30024,24 : SetupRetVal = "HWNDNotFound"Case 30025,25 : SetupRetVal = "IncompatibleCacheAction"Case 30026,26 : SetupRetVal = "IncompleteProductAddOns"Case 30027,27 : SetupRetVal = "InstalledProductStateCorrupt"Case 30028,28 : SetupRetVal = "InsufficientBuffer"Case 30029,29 : SetupRetVal = "InvalidArgument"Case 30030,30 : SetupRetVal = "InvalidCDKey"Case 30031,31 : SetupRetVal = "InvalidColumnType"Case 30032,31 : SetupRetVal = "InvalidConfigAddLanguage"Case 30033,33 : SetupRetVal = "InvalidData"Case 30034,34 : SetupRetVal = "InvalidDirectory"Case 30035,35 : SetupRetVal = "InvalidFormat"Case 30036,36 : SetupRetVal = "InvalidInitialization"Case 30037,37 : SetupRetVal = "InvalidMethod"Case 30038,38 : SetupRetVal = "InvalidOperation"Case 30039,39 : SetupRetVal = "InvalidParameter"Case 30040,40 : SetupRetVal = "InvalidProductFromARP"Case 30041,41 : SetupRetVal = "InvalidProductInConfigXml"Case 30042,42 : SetupRetVal = "InvalidReference"Case 30043,43 : SetupRetVal = "InvalidRegistryValueType"Case 30044,44 : SetupRetVal = "InvalidXMLProperty"Case 30045,45 : SetupRetVal = "InvalidMetadataFile"Case 30046,46 : SetupRetVal = "LogNotInitialized"Case 30047,47 : SetupRetVal = "LogAlreadyInitialized"Case 30048,48 : SetupRetVal = "MissingXMLNode"Case 30049,49 : SetupRetVal = "MsiTableNotFound"Case 30050,50 : SetupRetVal = "MsiAPICallFailure"Case 30051,51 : SetupRetVal = "NodeNotOfTypeElement"Case 30052,52 : SetupRetVal = "NoMoreGraceBoots"Case 30053,53 : SetupRetVal = "NoProductsFound"Case 30054,54 : SetupRetVal = "NoSupportedCulture"Case 30055,55 : SetupRetVal = "NotYetImplemented"Case 30056,56 : SetupRetVal = "NotAvailableCulture"Case 30057,57 : SetupRetVal = "NotCustomizationPatch"Case 30058,58 : SetupRetVal = "NullReference"Case 30059,59 : SetupRetVal = "OCTPatchForbidden"Case 30060,60 : SetupRetVal = "OCTWrongMSIDll"Case 30061,61 : SetupRetVal = "OutOfBoundsIndex"Case 30062,62 : SetupRetVal = "OutOfDiskSpace"Case 30063,63 : SetupRetVal = "OutOfMemory"Case 30064,64 : SetupRetVal = "OutOfRange"Case 30065,65 : SetupRetVal = "PatchApplicationFailure"Case 30066,66 : SetupRetVal = "PreReqCheckFailure"Case 30067,67 : SetupRetVal = "ProcessAlreadyStarted"Case 30068,68 : SetupRetVal = "ProcessNotStarted"Case 30069,69 : SetupRetVal = "ProcessNotFinished"Case 30070,70 : SetupRetVal = "ProductAlreadyDefined"Case 30071,71 : SetupRetVal = "ResourceAlreadyTracked"Case 30072,72 : SetupRetVal = "ResourceNotFound"Case 30073,73 : SetupRetVal = "ResourceNotTracked"Case 30074,74 : SetupRetVal = "SQLAlreadyConnected"Case 30075,75 : SetupRetVal = "SQLFailedToAllocateHandle"Case 30076,76 : SetupRetVal = "SQLFailedToConnect"Case 30077,77 : SetupRetVal = "SQLFailedToExecuteStatement"Case 30078,78 : SetupRetVal = "SQLFailedToRetrieveData"Case 30079,79 : SetupRetVal = "SQLFailedToSetAttribute"Case 30080,80 : SetupRetVal = "StorageNotCreated"Case 30081,81 : SetupRetVal = "StreamNameTooLong"Case 30082,82 : SetupRetVal = "SystemError"Case 30083,83 : SetupRetVal = "ThreadAlreadyStarted"Case 30084,84 : SetupRetVal = "ThreadNotStarted"Case 30085,85 : SetupRetVal = "ThreadNotFinished"Case 30086,86 : SetupRetVal = "TooManyProducts"Case 30087,87 : SetupRetVal = "UnexpectedXMLNodeType"Case 30088,88 : SetupRetVal = "UnexpectedError"Case 30089,89 : SetupRetVal = "Unitialized"Case 30090,90 : SetupRetVal = "UserCancel"Case 30091,91 : SetupRetVal = "ExternalCommandFailed"Case 30092,92 : SetupRetVal = "SPDatabaseOverSize"Case 30093,93 : SetupRetVal = "IntegerTruncation"'msiexec return valuesCase 1259 : SetupRetVal = "APPHELP_BLOCK"Case 1601 : SetupRetVal = "INSTALL_SERVICE_FAILURE"Case 1602 : SetupRetVal = "INSTALL_USEREXIT"Case 1603 : SetupRetVal = "INSTALL_FAILURE"Case 1604 : SetupRetVal = "INSTALL_SUSPEND"Case 1605 : SetupRetVal = "UNKNOWN_PRODUCT"Case 1606 : SetupRetVal = "UNKNOWN_FEATURE"Case 1607 : SetupRetVal = "UNKNOWN_COMPONENT"Case 1608 : SetupRetVal = "UNKNOWN_PROPERTY"Case 1609 : SetupRetVal = "INVALID_HANDLE_STATE"Case 1610 : SetupRetVal = "BAD_CONFIGURATION"Case 1611 : SetupRetVal = "INDEX_ABSENT"Case 1612 : SetupRetVal = "INSTALL_SOURCE_ABSENT"Case 1613 : SetupRetVal = "INSTALL_PACKAGE_VERSION"Case 1614 : SetupRetVal = "PRODUCT_UNINSTALLED"Case 1615 : SetupRetVal = "BAD_QUERY_SYNTAX"Case 1616 : SetupRetVal = "INVALID_FIELD"Case 1618 : SetupRetVal = "INSTALL_ALREADY_RUNNING"Case 1619 : SetupRetVal = "INSTALL_PACKAGE_OPEN_FAILED"Case 1620 : SetupRetVal = "INSTALL_PACKAGE_INVALID"Case 1621 : SetupRetVal = "INSTALL_UI_FAILURE"Case 1622 : SetupRetVal = "INSTALL_LOG_FAILURE"Case 1623 : SetupRetVal = "INSTALL_LANGUAGE_UNSUPPORTED"Case 1624 : SetupRetVal = "INSTALL_TRANSFORM_FAILURE"Case 1625 : SetupRetVal = "INSTALL_PACKAGE_REJECTED"Case 1626 : SetupRetVal = "FUNCTION_NOT_CALLED"Case 1627 : SetupRetVal = "FUNCTION_FAILED"Case 1628 : SetupRetVal = "INVALID_TABLE"Case 1629 : SetupRetVal = "DATATYPE_MISMATCH"Case 1630 : SetupRetVal = "UNSUPPORTED_TYPE"Case 1631 : SetupRetVal = "CREATE_FAILED"Case 1632 : SetupRetVal = "INSTALL_TEMP_UNWRITABLE"Case 1633 : SetupRetVal = "INSTALL_PLATFORM_UNSUPPORTED"Case 1634 : SetupRetVal = "INSTALL_NOTUSED"Case 1635 : SetupRetVal = "PATCH_PACKAGE_OPEN_FAILED"Case 1636 : SetupRetVal = "PATCH_PACKAGE_INVALID"Case 1637 : SetupRetVal = "PATCH_PACKAGE_UNSUPPORTED"Case 1638 : SetupRetVal = "PRODUCT_VERSION"Case 1639 : SetupRetVal = "INVALID_COMMAND_LINE"Case 1640 : SetupRetVal = "INSTALL_REMOTE_DISALLOWED"Case 1641 : SetupRetVal = "SUCCESS_REBOOT_INITIATED"Case 1642 : SetupRetVal = "PATCH_TARGET_NOT_FOUND"Case 1643 : SetupRetVal = "PATCH_PACKAGE_REJECTED"Case 1644 : SetupRetVal = "INSTALL_TRANSFORM_REJECTED"Case 1645 : SetupRetVal = "INSTALL_REMOTE_PROHIBITED"Case 1646 : SetupRetVal = "PATCH_REMOVAL_UNSUPPORTED"Case 1647 : SetupRetVal = "UNKNOWN_PATCH"Case 1648 : SetupRetVal = "PATCH_NO_SEQUENCE"Case 1649 : SetupRetVal = "PATCH_REMOVAL_DISALLOWED"Case 1650 : SetupRetVal = "INVALID_PATCH_XML"Case 3010 : SetupRetVal = "SUCCESS_REBOOT_REQUIRED"Case Else : SetupRetVal = "Unknown Return Value"End SelectEnd Function 'SetupRetVal'=======================================================================================================Function GetProductID(sProdID)Dim sReturnSelect Case sProdIdCase "000F" : sReturn = "MONDO"Case "0010" : sReturn = "WEBFLDRS"Case "0011" : sReturn = "PROPLUS"Case "0012" : sReturn = "STANDARD"Case "0013" : sReturn = "BASIC"Case "0014" : sReturn = "PRO"Case "0015" : sReturn = "ACCESS"Case "0016" : sReturn = "EXCEL"Case "0017" : sReturn = "SharePointDesigner"Case "0018" : sReturn = "PowerPoint"Case "0019" : sReturn = "Publisher"Case "001A" : sReturn = "Outlook"Case "001B" : sReturn = "Word"Case "001C" : sReturn = "AccessRuntime"Case "001F" : sReturn = "Proof"Case "0020" : sReturn = "O2007CNV"Case "0021" : sReturn = "VisualWebDeveloper"Case "0026" : sReturn = "ExpressionWeb"Case "0029" : sReturn = "Excel"Case "002A" : sReturn = "Office64"Case "002B" : sReturn = "Word"Case "002C" : sReturn = "Proofing"Case "002E" : sReturn = "Ultimate"Case "002F" : sReturn = "HomeAndStudent"Case "0028" : sReturn = "IME"Case "0030" : sReturn = "Enterprise"Case "0031" : sReturn = "ProfessionalHybrid"Case "0033" : sReturn = "Personal"Case "0035" : sReturn = "ProfessionalHybrid"Case "0037" : sReturn = "PowerPoint"Case "003A" : sReturn = "PrjStd"Case "003B" : sReturn = "PrjPro"Case "003D" : sReturn = "SINGLEIMAGE"Case "0043" : sReturn = "OFFICE32"Case "0044" : sReturn = "InfoPath"Case "0045" : sReturn = "XWEB"Case "0048" : sReturn = "OLC"Case "0049" : sReturn = "ACADEMIC"Case "004A" : sReturn = "OWC11"Case "0051" : sReturn = "VISPRO"Case "0052" : sReturn = "VisView"Case "0053" : sReturn = "VisStd"Case "0054" : sReturn = "VisMUI"Case "0055" : sReturn = "VisMUI"Case "0057" : sReturn = "VISIO"Case "0061" : sReturn = "CLICK2RUN"Case "0062" : sReturn = "CLICK2RUN"Case "0066" : sReturn = "CLICK2RUN"Case "006C" : sReturn = "CLICK2RUN"Case "006D" : sReturn = "CLICK2RUN"Case "006E" : sReturn = "Shared"Case "006F" : sReturn = "OFFICE"Case "0070" : sReturn = "OOBE"Case "0074" : sReturn = "STARTER"Case "007A" : sReturn = "OLC" 'Outlook ConnectorCase "007C" : sReturn = "OSCFB" 'Outlook Social Connector for FaceBookCase "007D" : sReturn = "OSCWL" 'Outlook Social Connector for Windows Live MessengerCase "007F" : sReturn = "OLC" 'Outlook Social ConnectorCase "008A" : sReturn = "RecentDocs"Case "008B" : sReturn = "SmallBusinessBasics"Case "00A1" : sReturn = "ONENOTE"Case "00A3" : sReturn = "OneNoteHomeStudent"Case "00A7" : sReturn = "CPAO"Case "00A9" : sReturn = "InterConnect"Case "00AF" : sReturn = "PPtView"Case "00B0" : sReturn = "ExPdf"Case "00B1" : sReturn = "ExXps"Case "00B2" : sReturn = "ExPdfXps"Case "00B4" : sReturn = "PrjMUI"Case "00B5" : sReturn = "PrjtMUI"Case "00B9" : sReturn = "AER"Case "00BA" : sReturn = "Groove"Case "00CA" : sReturn = "SmallBusiness"Case "00E0" : sReturn = "Outlook"Case "00D1" : sReturn = "ACE"Case "0100" : sReturn = "OfficeMUI"Case "0101" : sReturn = "OfficeXMUI"Case "0103" : sReturn = "PTK"Case "0114" : sReturn = "GrooveSetupMetadata"Case "0115" : sReturn = "SharedSetupMetadata"Case "0116" : sReturn = "SharedSetupMetadata"Case "0117" : sReturn = "AccessSetupMetadata"Case "011A" : sReturn = "SendASmile"Case "011D" : sReturn = "ProPlusSubscription"Case "011F" : sReturn = "OLConnect"Case "0126" : sReturn = "WWLIBCXM"Case "1014" : sReturn = "STS"Case "1015" : sReturn = "WSSMUI"Case "1032" : sReturn = "PJSVRAPP"Case "104B" : sReturn = "SPS"Case "104E" : sReturn = "SPSMUI"Case "107F" : sReturn = "OSrv"Case "1080" : sReturn = "OSrv"Case "1088" : sReturn = "lpsrvwfe"Case "10D7" : sReturn = "IFS"Case "10D8" : sReturn = "IFSMUI"Case "10EB" : sReturn = "DLCAPP"Case "10F5" : sReturn = "XLSRVAPP"Case "10F6" : sReturn = "XlSrvWFE"Case "10F7" : sReturn = "DLC"Case "10F8" : sReturn = "SlSrvMui"Case "10FB" : sReturn = "OSrchWFE"Case "10FC" : sReturn = "OSRCHAPP"Case "10FD" : sReturn = "OSrchMUI"Case "1103" : sReturn = "DLC"Case "1104" : sReturn = "LHPSRV"Case "1105" : sReturn = "PIA"Case "1106" : sReturn = "GRVMGMTSRV"Case "1109" : sReturn = "GSERVERRELAY"Case "110D" : sReturn = "OSERVER"Case "110F" : sReturn = "PSERVER"Case "1110" : sReturn = "WSS"Case "1121" : sReturn = "SPSSDK"Case "1122" : sReturn = "SPSDev"Case "1163" : sReturn = "SCC" 'SharePoint Client ComponentsCase Else : sReturn = sProdIDEnd Select 'sProdIdGetProductID = sReturnEnd Function 'GetProductID'=======================================================================================================Sub Log (sLog)wscript.echo sLogLogStream.WriteLine sLogEnd Sub 'Log'=======================================================================================================Sub LogOnly (sLog)LogStream.WriteLine sLogEnd Sub 'Log'=======================================================================================================Sub CheckError(sModule)If Err <> 0 Then LogOnly " " & Now & " - " & sModule & " - Source: " & Err.Source & "; Err# (Hex): " & Hex( Err ) & _"; Err# (Dec): " & Err & "; Description : " & Err.DescriptionEnd If 'Err = 0Err.ClearEnd Sub'======================================================================================================='Command line parserSub ParseCmdLineDim iCnt, iArgCntDim arrArgumentsDim sArg0iArgCnt = Wscript.Arguments.CountIf iArgCnt > 0 ThenIf wscript.Arguments(0) = "UAC" ThenIf wscript.arguments.count = 1 Then iArgCnt = 0End IfEnd IfIf iArgCnt = 0 ThenSelect Case UCase(wscript.ScriptName)Case Else'Create the logCreateLogLog "No argument specified. Preparing user prompt" & vbCrLfFindInstalledOProductsIf dicInstalledSku.Count > 0 Then sDefault = Join(RemoveDuplicates(dicInstalledSku.Items),",") Else sDefault = "CLIENTALL"sDefault = InputBox("Enter a list of " & ONAME & " products to remove" & vbCrLf & vbCrLf & _"Examples:" & vbCrLf & _"CLIENTALL" & vbTab & "-> all Client products" & vbCrLf & _"SERVER" & vbTab & "-> all Server products" & vbCrLf & _"ALL" & vbTab & vbTab & "-> all Server & Client products" & vbCrLf & _"ProPlus,PrjPro" & vbTab & "-> ProPlus and Project" & vbCrLf &_"?" & vbTab & vbTab & "-> display Help", _SCRIPTFILE & " - " & ONAME & " remover", _sDefault)If IsEmpty(sDefault) Then 'User cancelledLog "User cancelled. CleanUp & Exit."'Undo temporary entries created in ARPTmpKeyCleanUpwscript.quit 1602End If 'IsEmpty(sDefault)Log "Answer from prompt: " & sDefault & vbCrLfsDefault = Trim(UCase(Trim(Replace(sDefault,Chr(34),""))))arrArguments = Split(Trim(sDefault)," ")If UBound(arrArguments) = -1 Then ReDim arrArguments(0)End SelectElseReDim arrArguments(iArgCnt-1)For iCnt = 0 To (iArgCnt-1)arrArguments(iCnt) = UCase(Wscript.Arguments(iCnt))Next 'iCntEnd If 'iArgCnt = 0'Handle the SKU listsArg0 = Replace(arrArguments(0),"/","")If Left(sArg0,1) = "-" Then sArg0 = Mid(sArg0,2)Select Case UCase(sArg0)Case "?"ShowSyntaxCase "ALL"fRemoveAll = TruefRemoveOse = FalseCase "CLIENTSUITES"fRemoveCSuites = TruefRemoveOse = FalseCase "CLIENTSTANDALONE"fRemoveCSingle = TruefRemoveOse = FalseCase "CLIENTALL"fRemoveCSuites = TruefRemoveCSingle = TruefRemoveOse = FalseCase "SERVER"fRemoveSrv = TruefRemoveOse = FalseCase "ALL,OSE"fRemoveAll = TruefRemoveOse = TrueCase ElsefRemoveAll = FalsefRemoveOse = FalsesSkuRemoveList = sArg0End SelectFor iCnt = 0 To UBound(arrArguments)Select Case arrArguments(iCnt)Case "?","/?","-?"ShowSyntaxCase "/B","/BYPASS"If UBound(arrArguments)>iCnt ThenIf InStr(arrArguments(iCnt+1),"1")>0 Then fBypass_Stage1 = TrueIf InStr(arrArguments(iCnt+1),"2")>0 Then fBypass_Stage2 = TrueIf InStr(arrArguments(iCnt+1),"3")>0 Then fBypass_Stage3 = TrueIf InStr(arrArguments(iCnt+1),"4")>0 Then fBypass_Stage4 = TrueEnd IfCase "/D","/DELETEUSERSETTINGS"fKeepUser = FalseCase "/FR","/FASTREMOVE"fBypass_Stage1 = TruefSkipSD = TrueCase "/F","/FORCE"fForce = TrueCase "/K","/KEEPUSERSETTINGS"fKeepUser = TrueCase "/L","/LOG"fLogInitialized = FalseIf UBound(arrArguments)>iCnt ThenIf oFso.FolderExists(arrArguments(iCnt+1)) Then sLogDir = arrArguments(iCnt+1)ElseOn Error Resume NextoFso.CreateFolder(arrArguments(iCnt+1))If Err <> 0 Then sLogDir = sScrubDir Else sLogDir = arrArguments(iCnt+1)End IfEnd IfCase "/N","/NOCANCEL"fNoCancel = TrueCase "/NE","/NOELEVATE"fNoElevate = TrueCase "/O","/OSE"fRemoveOse = TrueCase "/P","/PREVIEW","/DETECTONLY"fDetectOnly = TrueCase "/Q","/QUIET"fQuiet = TrueCase "/QB"fQuiet = TruefBasic = TrueCase "/QND"fBypass_Stage1 = TruefBypass_Stage2 = TruefBypass_Stage3 = TruefRemoveOse = TruefRemoveOspp = TruefRemoveAll = TruefSkipSD = TruefForce = TrueCase "/S","/SKIPSD","/SKIPSHORTCUTDETECTION"fSkipSD = TrueCase "/R","/RECONCILE"fTryReconcile = TrueCase ElseEnd SelectNext 'iCntIf Not fLogInitialized Then CreateLogEnd Sub 'ParseCmdLine'=======================================================================================================Sub CreateLogDim DateTimeDim sLogNameOn Error Resume Next'Create the log fileSet DateTime = CreateObject("WbemScripting.SWbemDateTime")DateTime.SetVarDate Now,TruesLogName = sLogDir & "\" & oWShell.ExpandEnvironmentStrings("%COMPUTERNAME%")sLogName = sLogName & "_" & Left(DateTime.Value,14)sLogName = sLogName & "_ScrubLog.txt"Err.ClearSet LogStream = oFso.CreateTextFile(sLogName,True,True)If Err <> 0 Then Err.ClearsLogDir = sScrubDirsLogName = sLogDir & "\" & oWShell.ExpandEnvironmentStrings("%COMPUTERNAME%")sLogName = sLogName & "_" & Left(DateTime.Value,14)sLogName = sLogName & "_ScrubLog.txt"Set LogStream = oFso.CreateTextFile(sLogName,True,True)End IfLog "Microsoft Customer Support Services - " & ONAME & " Removal Utility" & vbCrLf & vbCrLf & _"OffScrub Version: " & SCRIPTVERSION & vbCrLf & _"64 bit OS: " & f64LogOnly "OS Details: " & sOSinfo & vbCrLfLog "Start removal: " & Now & vbCrLffLogInitialized = TrueEnd Sub 'CreateLog'=======================================================================================================Sub RelaunchAsCScriptDim ArgumentDim sCmdLinesCmdLine = "cmd.exe /k " & WScript.Path & "\cscript.exe //NOLOGO " & Chr(34) & WScript.scriptFullName & Chr(34)If Wscript.Arguments.Count > 0 ThenFor Each Argument in Wscript.ArgumentssCmdLine = sCmdLine & " " & chr(34) & Argument & chr(34)Next 'ArgumentEnd IfoWShell.Run sCmdLine,1,FalseWscript.QuitEnd Sub 'RelaunchAsCScript'=======================================================================================================Sub RelaunchElevatedDim ArgumentDim sCmdLineDim oShellSet oShell = CreateObject("Shell.Application")sCmdLine = Chr(34) & WScript.scriptFullName & Chr(34)If Wscript.Arguments.Count > 0 ThenFor Each Argument in Wscript.ArgumentsSelect Case UCase(Argument)Case "/Q","/QUIET"'Don't try to relaunch in quiet modeExit SubCase "UAC"'Already tried elevated relaunchExit SubCase ElsesCmdLine = sCmdLine & " " & chr(34) & Argument & chr(34)End SelectNext 'ArgumentEnd IfoShell.ShellExecute "cscript.exe", sCmdLine & " /NoElevate UAC", "", "runas", 1Wscript.QuitEnd Sub 'RelaunchElevated'======================================================================================================='Show the expected syntax for the script usageSub ShowSyntaxTmpKeyCleanUpWscript.Echo sErr & vbCrLf & _SCRIPTFILE & " V " & SCRIPTVERSION & vbCrLf & _"Copyright (c) Microsoft Corporation. All Rights Reserved" & vbCrLf & vbCrLf & _SCRIPTFILE & " helps to remove " & ONAME & " Server & Client products" & vbCrLf & _"when a regular uninstall is no longer possible" & vbCrLf & vbCrLf & _"Usage:" & vbTab & SCRIPTFILE & " [List of config ProductIDs] [Options]" & vbCrLf & vbCrLf & _vbTab & "/? ' Displays this help"& vbCrLf &_vbTab & "/Force ' Enforces file removal. May cause data loss!" & vbCrLf &_vbTab & "/SkipShortcutDetection ' Does not search the local hard drives for shortcuts" & vbCrLf & _vbTab & "/Log [LogfolderPath] ' Custom folder for log files" & vbCrLf & _vbTab & "/NoCancel ' Setup.exe and Msiexec.exe have no Cancel button" & vbCrLf &_vbTab & "/OSE ' Forces removal of the Office Source Engine service" & vbCrLf &_vbTab & "/Quiet ' Setup.exe and Msiexec.exe run quiet with no UI" & vbCrLf &_vbTab & "/Preview ' Run this script to preview what would get removed"& vbCrLf & vbCrLf & _"Examples:"& vbCrLf & _vbTab & SCRIPTFILE & " CLIENTALL ' Remove all " & ONAME & " Client products" & vbCrLf &_vbTab & SCRIPTFILE & " SERVER ' Remove all " & ONAME & " Server products" & vbCrLf &_vbTab & SCRIPTFILE & " ALL ' Remove all " & ONAME & " Server & Client products" & vbCrLf &_vbTab & SCRIPTFILE & " ProPlus,PrjPro ' Remove ProPlus and Project" & vbCrLfWscript.QuitEnd Sub 'ShowSyntax'=======================================================================================================