This is the MS Office 2016 scrubber script…with the “echos” removed. When the echos are removed, no cscript window appears. It allows you to wrap it up in a script or package, without having to use “cscript.exe scrubber.vbs.” Just call to the script using wscript.exe or cscript.exe.
The window you don’t want to see
'======================================================================================================= ' Name: OffScrub_O16msi.vbs ' Author: Microsoft Customer Support Services ' Copyright (c) 2015 Microsoft Corporation ' Script to remove (scrub) Office 2016 MSI products ' when a regular uninstall is no longer possible '======================================================================================================= 'Option Explicit on error resume next Dim sDefault '======================================================================================================= '[INI] Section for script behavior customizations 'Pre-configure the SKU's to remove. 'Only for use without command line parameters 'Example: sDefault = "CLIENTALL" sDefault = "" 'DO NOT CUSTOMIZE BELOW THIS LINE! '======================================================================================================= Const SCRIPTVERSION = "1.91" Const SCRIPTFILE = "OffScrub_O16msi.vbs" Const SCRIPTNAME = "OffScrub_O16msi" Const OVERSION = "16.0" Const OVERSIONMAJOR = "16" Const OREF = "Office16" Const OREGREF = "OFFICE16." Const ONAME = "Office 2016 MSI" Const OPACKAGE = "PackageRefs" Const OFFICEID = "000000FF1CE}" Const HKCR = &H80000000 Const HKCU = &H80000001 Const HKLM = &H80000002 Const HKU = &H80000003 Const FOR_WRITING = 2 Const PRODLEN = 12 Const COMPPERMANENT = "00000000000000000000000000000000" Const UNCOMPRESSED = 38 Const SQUISHED = 20 Const COMPRESSED = 32 Const REG_ARP = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" Const VB_YES = 6 Const MSIOPENDATABASEREADONLY = 0 Const LYNC_ALL = "{4A2C120F-307B-4400-B239-F29ADB54D3C6}{5CFD6599-10E5-4CF0-B6E1-BF39D30A64F8}{5CFD6599-10E5-4CF0-B6E1-BF39D30A64F8}{BF3AC8BA-1A0F-42AD-8B65-4250617AF682}{3475BF22-3564-4EF3-A633-C5F3F4582392}{263BA91B-7782-4EEB-A4FC-7BD554CAF1F3}{AA256AE1-6B6A-48E6-9957-B38F92CA614B}{D79732A1-BB17-4789-AE75-69D61261E305}{C7B887F2-07CA-4903-93A2-9B4E16E4EABD}{81BE0B17-563B-45D4-B198-5721E6C665CD}{11298539-8073-4D54-B6A0-88D4FA512E5C}{C192041D-2861-4E02-9F43-4041858A58F1}{7023C711-0E65-471E-8048-12C455968841}{58A013B1-1613-4978-881A-FCA43710C84A}{7FD6C049-9777-4B51-91FF-B19D79ADF439}{D3001D99-675B-44DF-A8EB-A7BB6F864DB7}{0C5EA724-8649-47FA-B505-75B35390378D}{13DE0C92-2AE4-48D0-8CC8-58D5E327BDCB}{E7EC16E6-C220-41C0-9C91-5E7702B8EC86}{1B10C75C-70E1-460E-B07B-D7DFF365D80F}{331977BC-B246-46B4-8829-1D52F41C8C7B}{D8255EF2-0BB2-4AF1-A662-5EBACD179475}{DD069437-C92B-4C1C-A992-14F6C7E12C2C}{E9E30DB3-8D72-43A0-B1B8-A6F8261D20D6}{545B7E32-E254-40E1-8935-91C61E3D02C2}{70409E9E-AFAE-4C05-AE57-F83B89819434}{1D6E3225-753D-41AD-A2C4-68684700F592}{217AA75D-82C0-4C49-9252-A0E6F9661688}{5AB81CD4-7C78-420C-AAAC-855C4BADBDDD}{AA595672-6515-4961-B81F-485F86627C76}{C9F2C38C-21F0-4687-8C7D-51AA02CE8C98}{DD80DED6-700D-4CC5-B2A9-C64A1AD155B9}{88257193-EC61-4152-8AB1-A5FB4BE638D7}{7D9109C3-58A9-4AFD-A1D3-47E7D811726E}{71C6D199-5B8E-41E7-BA36-D99F66E0072E}{1CFE7869-777D-4563-8161-2C75ED95B621}{FE25DDB2-5766-4A9E-86D2-2B709CC8F65D}{621F7793-1C51-45BA-899F-41557946B0E3}{B31017AA-FBF8-4003-8785-EC789C2AE0C2}{11849FBC-C416-4742-8279-17C3A2C85F72}{4F380D4B-A84D-45C7-AF58-59EA2AEDF35A}{81BE0B17-563B-45D4-B198-5721E6C665CD}" '======================================================================================================= Dim oFso, oMsi, oReg, oWShell, oWmiLocal, oShellApp Dim ComputerItem, Item, LogStream, TmpKey Dim arrTmpSKUs, arrDeleteFiles, arrDeleteFolders, arrMseFolders, arrVersion Dim dictinaryKeepProd, dictinaryKeepLis, dicApps, dictinaryKeepFolder, dicDelRegKey, dictinaryKeepReg Dim dicInstalledSku, dicRemoveSku, dictinaryKeepSku, dicSrv, dicCSuite, dicCSingle Dim f64, fLegacyProductFound, fCScript Dim sErr, sTmp, sSkuRemoveList, sWinDir, sWICacheDir, sMode Dim sAppData, sTemp, sScrubDir, sProgramFiles, sProgramFilesX86, sCommonProgramFiles Dim sAllusersProfile, sOSinfo, sOSVersion, sCommonProgramFilesX86, sProfilesDirectory Dim sProgramData, sLocalAppData, sOInstallRoot, sScriptDir Dim iVersionNT '======================================================================================================= 'Main '======================================================================================================= 'Configure defaults Dim sLogDir : sLogDir = "" Dim sMoveMessage: sMoveMessage = "" Dim fRemoveOse : fRemoveOse = False Dim fRemoveOspp : fRemoveOspp = False Dim fRemoveAll : fRemoveAll = False Dim fRemoveC2R : fRemoveC2R = False Dim fRemoveAppV : fRemoveAppV = False Dim fRemoveCSuites : fRemoveCSuites = False Dim fRemoveCSingle : fRemoveCSingle = False Dim fRemoveSrv : fRemoveSrv = False Dim fRemoveLync : fRemoveLync = False Dim fKeepUser : fKeepUser = True 'Default to keep per user settings Dim fSkipSD : fSkipSD = False 'Default to not Skip the Shortcut Detection Dim fKeepSG : fKeepSG = False 'Default to not override the SoftGrid detection Dim fDetectOnly : fDetectOnly = False Dim fQuiet : fQuiet = True Dim fBasic : fBasic = False Dim fNoCancel : fNoCancel = False Dim fPassive : fPassive = True Dim fNoReboot : fNoReboot = True 'Default to offer reboot prompt if needed Dim fNoElevate : fNoElevate = False Dim fElevated : fElevated = False Dim fTryReconcile : fTryReconcile = False Dim fC2rInstalled : fC2rInstalled = False 'CAUTION! -> "fForce" will kill running applications which can result in data loss! <- CAUTION Dim fForce : fForce = False 'CAUTION! -> "fForce" will kill running applications which can result in data loss! <- CAUTION Dim fLogInitialized : fLogInitialized = False Dim fBypass_Stage1 : fBypass_Stage1 = True 'Component Detection Dim fBypass_Stage2 : fBypass_Stage2 = False 'Setup Dim fBypass_Stage3 : fBypass_Stage3 = False 'Msiexec Dim fBypass_Stage4 : fBypass_Stage4 = False 'CleanUp Dim fRebootRequired : fRebootRequired = False 'Create required objects Set oWmiLocal = GetObject("winmgmts:{(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 info sAppData = 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 If sProgramFiles = oWShell.ExpandEnvironmentStrings("%programfiles%") 'Deferred until after architecture check 'sProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%programfiles(x86)%") sCommonProgramFiles = oWShell.ExpandEnvironmentStrings("%commonprogramfiles%") 'Deferred until after architecture check 'sCommonProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%CommonProgramFiles(x86)%") sProgramData = oWSHell.ExpandEnvironmentStrings("%programdata%") sWinDir = oWShell.ExpandEnvironmentStrings("%windir%") sWICacheDir = sWinDir & "\" & "Installer" sScrubDir = sTemp & "\" & SCRIPTNAME sScriptDir = wscript.ScriptFullName sScriptDir = Left(sScriptDir, InStrRev(sScriptDir, "\")) ' Get current script host fCScript = UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C" 'Detect if we're running on a 64 bit OS Set ComputerItem = oWmiLocal.ExecQuery("Select * from Win32_ComputerSystem") For Each Item In ComputerItem f64 = Instr(Left(Item.SystemType,3),"64") > 0 If f64 Then Exit For Next If f64 Then sProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%programfiles(x86)%") If f64 Then sCommonProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%CommonProgramFiles(x86)%") 'Get OS details and VersionNT Set ComputerItem = oWmiLocal.ExecQuery("Select * from Win32_OperatingSystem") For Each Item in ComputerItem sOSinfo = sOSinfo & Item.Caption sOSinfo = sOSinfo & Item.OtherTypeDescription sOSinfo = sOSinfo & ", " & "SP " & Item.ServicePackMajorVersion sOSinfo = sOSinfo & ", " & "Version: " & Item.Version sOsVersion = Item.Version sOSinfo = sOSinfo & ", " & "Codepage: " & Item.CodeSet sOSinfo = sOSinfo & ", " & "Country Code: " & Item.CountryCode sOSinfo = sOSinfo & ", " & "Language: " & Item.OSLanguage Next 'Build the VersionNT number arrVersion = Split(sOsVersion, Delimiter(sOsVersion)) iVersionNt = CInt(arrVersion (0)) * 100 + CInt(arrVersion (1)) 'Check if we're running as 32 bit process on a 64 bit OS If InStr(LCase(wscript.path), "syswow64") > 0 Then RelaunchAs64Host fElevated = CheckRegPermissions If NOT fElevated AND NOT fNoElevate Then 'Try to relaunch elevated RelaunchElevated 'Can't relaunch. Exit out If UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C" Then If Not fLogInitialized Then CreateLog Log "Insufficient registry access permissions - exiting" End If 'Undo temporary entries created in ARP TmpKeyCleanUp wscript.quit 3 End If 'Create Dictionaries Set dictinaryKeepProd = CreateObject("Scripting.Dictionary") Set dicInstalledSku = CreateObject("Scripting.Dictionary") Set dicRemoveSku = CreateObject("Scripting.Dictionary") Set dictinaryKeepSku = CreateObject("Scripting.Dictionary") Set dictinaryKeepLis = CreateObject("Scripting.Dictionary") Set dictinaryKeepFolder = CreateObject("Scripting.Dictionary") Set dicApps = CreateObject("Scripting.Dictionary") Set dicDelRegKey = CreateObject("Scripting.Dictionary") Set dictinaryKeepReg = CreateObject("Scripting.Dictionary") Set dicSrv = CreateObject("Scripting.Dictionary") Set dicCSuite = CreateObject("Scripting.Dictionary") Set dicCSingle = CreateObject("Scripting.Dictionary") 'Create the temp folder If Not oFso.FolderExists(sScrubDir) Then oFso.CreateFolder sScrubDir 'Set the default logging directory sLogDir = sScrubDir 'Call the command line parser ParseCmdLine 'Ensure CScript as engine If NOT fCScript AND NOT fQuiet Then RelaunchAsCScript 'Get Office Install Folder If NOT RegReadValue(HKLM,"SOFTWARE\Microsoft\Office\"&OVERSION&"\Common\InstallRoot","Path",sOInstallRoot,"REG_SZ") Then sOInstallRoot = sProgramFiles & "\Microsoft Office\"&OREF End If 'Ensure integrity of WI metadata which could fail used APIs otherwise EnsureValidWIMetadata HKCU,"Software\Classes\Installer\Products",COMPRESSED EnsureValidWIMetadata HKCR,"Installer\Products",COMPRESSED EnsureValidWIMetadata HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products",COMPRESSED EnsureValidWIMetadata HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components",COMPRESSED EnsureValidWIMetadata HKCR,"Installer\Components",COMPRESSED 'Add initial known .exe files that might need to be closed dicApps.Add "communicator.exe", "communicator.exe" dicApps.Add "setup.exe", "setup.exe" Select Case OVERSIONMAJOR Case "12" Case "14" dicApps.Add "bcssync.exe","bcssync.exe" dicApps.Add "officesas.exe","officesas.exe" dicApps.Add "officesasscheduler.exe","officesasscheduler.exe" dicApps.Add "msosync.exe","msosync.exe" dicApps.Add "onenotem.exe","onenotem.exe" Case "15" Case "16" dicApps.Add "msosync.exe","msosync.exe" dicApps.Add "onenotem.exe","onenotem.exe" Case Else End Select '------------------- 'Stage # 0 - Basics | '------------------- 'Build a list with installed/registered Office products sTmp = "Stage # 0 " & chr(34) & "Basics" & chr(34) & " (" & Time & ")" Log vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf FindInstalledOProducts If dicInstalledSku.Count > 0 Then Log "Found registered product(s): " & Join(RemoveDuplicates(dicInstalledSku.Items),",") &vbCrLf 'Validate the list of products we got from the command line if applicable ValidateRemoveSkuList 'Log detection results If dicRemoveSku.Count > 0 Then Log "Product(s) to be removed: " & Join(RemoveDuplicates(dicRemoveSku.Items),",") sMode = "Selected " & ONAME & " products" If NOT dicRemoveSku.Count > 0 Then sMode = "Orphaned " & ONAME & " products" If fRemoveAll Then sMode = "All " & ONAME & " products" Log "Final removal mode: " & sMode Log "Remove OSE service: " & fRemoveOse &vbCrLf 'Log preview mode if applicable If fDetectOnly Then Log "*************************************************************************" If fDetectOnly Then Log "* PREVIEW MODE *" If fDetectOnly Then Log "* All uninstall and delete operations will only be logged not executed! *" If fDetectOnly Then Log "*************************************************************************" & vbCrLf 'Check if there are legacy products installed CheckForLegacyProducts If fLegacyProductFound Then Log "Found legacy Office products that will not be removed." Else Log "No legacy Office products found." 'Cache .msi files If dicRemoveSku.Count > 0 Then CacheMsiFiles 'Log Sku/Prod detection results LogSkuResults 'UnPin Shortcuts If NOT fSkipSD AND dicRemoveSku.Count > 0 Then On Error Resume Next Log " Searching for pinned shortcuts" CleanShortcuts sAllUsersProfile, False, True CleanShortcuts sProfilesDirectory, False, True On Error Goto 0 End If 'NOT SkipSD '-------------------------------- 'Stage # 1 - Component Detection | '-------------------------------- sTmp = "Stage # 1 " & chr(34) & "Component Detection" & chr(34) & " (" & Time & ")" Log vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf If Not fBypass_Stage1 OR fForce Then 'Build a list with files which are installed/registered to a product that's going to be removed Log "Prepare for CleanUp stages." Log "Identifying removable elements. This can take several minutes." ScanComponents Else Log "Not running Component Detection in default removal." End If 'End all running Office applications If fForce OR fQuiet OR fPassive Then CloseOfficeApps '---------------------- 'Stage # 2 - Setup.exe | '---------------------- sTmp = "Stage # 2 " & chr(34) & "Setup.exe" & chr(34) & " (" & Time & ")" Log vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf If Not fBypass_Stage2 Then SetupExeRemoval Else Log "Skipping Setup.exe because bypass was requested." End If '------------------------ 'Stage # 3 - Msiexec.exe | '------------------------ sTmp = "Stage # 3 " & chr(34) & "Msiexec.exe" & chr(34) & " (" & Time & ")" Log vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf If Not fBypass_Stage3 Then MsiexecRemoval Else Log "Skipping Msiexec.exe because bypass was requested." End If '-------------------- 'Stage # 4 - CleanUp | '-------------------- 'Removal of files and registry settings sTmp = "Stage # 4 " & chr(34) & "CleanUp" & chr(34) & " (" & Time & ")" Log vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf If Not fBypass_Stage4 Then 'Office Source Engine If fRemoveOse Then RemoveOSE 'Local Installation Source (MSOCache) WipeLIS 'Obsolete files If fRemoveAll Then FileWipeAll Else FileWipeIndividual End If 'Empty Folders DeleteEmptyFolders 'Restore Explorer if needed If fForce OR fQuiet OR fPassive Then RestoreExplorer 'Registry data RegWipe 'Wipe orphaned files from Windows Installer cache MsiClearOrphanedFiles 'Temporary .msi files in scrubcache DeleteMsiScrubCache 'Temporary files DelScrubTmp Else Log "Skipping CleanUp because bypass was requested." End If If Not sMoveMessage = "" Then Log vbCrLf & "Please remove this folder after next reboot: " & sMoveMessage 'THE END Log vbCrLf & "End removal: " & Now & vbCrLf Log vbCrLf & "For detailed logging please refer to the log in folder " &chr(34)&sScrubDir&chr(34)&vbCrLf If fRebootRequired Then Log vbCrLf & "A restart is required to complete the operation!" If NOT fQuiet Then If MsgBox("Do you want to reboot now?",vbYesNo,"Reboot Required") = VB_YES Then Dim colOS, oOS Dim oWmiReboot Set oWmiReboot = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}!\\.\root\cimv2") Set colOS = oWmiReboot.ExecQuery ("Select * from Win32_OperatingSystem") For Each oOS in colOS 'oOS.Reboot() Next End If End If End If If NOT fQuiet Then For Each Item in Wscript.Arguments If Item = "UAC" Then 'wscript.stdout.write "Press <Enter> to close this window" sTemp = wscript.stdin.read(1) End If Next 'Argument End If '======================================================================================================= '======================================================================================================= 'Stage 0 - 4 Subroutines '======================================================================================================= 'Office configuration products are listed with their configuration product name in the "Uninstall" key 'To identify an Office configuration product all of these condiditions have to be met: ' - "SystemComponent" does not have a value of "1" (DWORD) ' - "OPACKAGE" (see constant declaration) entry exists and is not empty ' - "DisplayVersion" exists and the 2 leftmost digits are "OVERSIONMAJOR" Sub FindInstalledOProducts Dim ArpItem, File Dim sCurKey, sValue, sConfigName, sProdC, sCVHValue Dim sProductCodeList, sProductCode Dim arrKeys, arrMultiSzValues Dim fSystemComponent0, fPackages, fDisplayVersion, fReturn, fCategorized If dicInstalledSku.Count > 0 Then Exit Sub 'Already done from InputBox prompt 'Handle orphaned products to get them added to the detection scope If fTryReconcile Then For Each File in oFso.GetFolder(sWICacheDir).Files If Len(File.Name)>3 Then Select Case LCase(Right(File.Name,4)) Case ".msi" sProductCode = "" sProductCode = GetMsiProductCode(File.Path) If InScope(sProductCode) Then If NOT RegKeyExists(HKLM,REG_ARP & sProductCode) Then 'Ensure the orphaned item is getting removed If Len(sSkuRemoveList) > 0 Then sSkuRemoveList = sSkuRemoveList & "," & GetProductID(Mid(sProductCode,11,4)) Else sSkuRemoveList = GetProductID(Mid(sProductCode,11,4)) End If 'Add to ScrubDir oFso.CopyFile File.Path,sScrubDir & "\" & sProductCode & ".msi",True 'Register the product with MSI MsiRegisterProduct File.Path End If 'NOT sProductCode End If 'InScope Case Else End Select End If '>3 Next 'File End If 'fTryReconcile 'Locate standalone Office products that have no configuration product entry and create a 'temporary configuration entry ReDim arrTmpSKUs(-1) If RegEnumKey(HKLM,REG_ARP,arrKeys) Then For Each ArpItem in arrKeys If InScope(ArpItem) Then sCurKey = REG_ARP & ArpItem & "\" fSystemComponent0 = Not (RegReadValue(HKLM,sCurKey,"SystemComponent",sValue,"REG_DWORD") AND (sValue = "1")) If (fSystemComponent0 AND (NOT RegReadValue(HKLM,sCurKey,"CVH",sCVHValue,"REG_DWORD"))) Then RegReadValue HKLM,sCurKey,"DisplayVersion",sValue,"REG_SZ" Redim arrMultiSzValues(0) 'Logic changed to drop the LCID identifier 'sConfigName = GetProductID(Mid(ArpItem,11,4)) & "_" & CInt("&h" & Mid(ArpItem,16,4)) sConfigName = OREGREF & GetProductID(Mid(ArpItem,11,4)) If NOT RegKeyExists(HKLM,REG_ARP&sConfigName) Then 'Create a new ARP item ReDim Preserve arrTmpSKUs(UBound(arrTmpSKUs)+1) arrTmpSKUs(UBound(arrTmpSKUs)) = sConfigName oReg.CreateKey HKLM,REG_ARP & sConfigName arrMultiSzValues(0) = sConfigName oReg.SetMultiStringValue HKLM,REG_ARP & sConfigName,OPACKAGE,arrMultiSzValues arrMultiSzValues(0) = ArpItem oReg.SetStringValue HKLM, REG_ARP & sConfigName, "Comment", "Temporary OffScrub generated key. Please delete this key!" oReg.SetMultiStringValue HKLM,REG_ARP & sConfigName,"ProductCodes",arrMultiSzValues oReg.SetStringValue HKLM,REG_ARP & sConfigName,"DisplayVersion",sValue oReg.SetStringValue HKLM,REG_ARP & sConfigName,"DisplayName",SCRIPTNAME & "_" & sConfigName oReg.SetDWordValue HKLM,REG_ARP & sConfigName,"SystemComponent",0 Else 'Update the existing temporary ARP item fReturn = RegReadValue(HKLM,REG_ARP&sConfigName,"ProductCodes",sProdC,"REG_MULTI_SZ") If NOT InStr(sProdC,ArpItem)>0 Then sProdC = sProdC & chr(34) & ArpItem oReg.SetMultiStringValue HKLM,REG_ARP & sConfigName,"ProductCodes",Split(sProdC,chr(34)) End If 'RegKeyExists End If 'fSystemComponent0 End If 'InScope Next 'ArpItem End If 'RegEnumKey 'Find the configuration products If RegEnumKey(HKLM,REG_ARP,arrKeys) Then For Each ArpItem in arrKeys sCurKey = REG_ARP & ArpItem & "\" sValue = "" fSystemComponent0 = NOT (RegReadValue(HKLM,sCurKey,"SystemComponent",sValue,"REG_DWORD") AND (sValue = "1")) fPackages = RegReadValue(HKLM,sCurKey,OPACKAGE,sValue,"REG_MULTI_SZ") fDisplayVersion = RegReadValue(HKLM,sCurKey,"DisplayVersion",sValue,"REG_SZ") If fDisplayVersion Then If Len(sValue) > 1 Then fDisplayVersion = (Left(sValue,2) = OVERSIONMAJOR) Else fDisplayVersion = False End If End If If (fSystemComponent0 AND fPackages AND fDisplayVersion) Then If InStr(ArpItem,".")>0 Then sConfigName = UCase(Mid(ArpItem,InStr(ArpItem,".")+1)) Else sConfigName = UCase(ArpItem) If NOT dicInstalledSku.Exists(sConfigName) Then dicInstalledSku.Add sConfigName,sConfigName 'Categorize the SKU 'Four categories are available: ClientSuite, ClientSingleProduct, Server, C2R If RegReadValue(HKLM, REG_ARP & OREGREF & sConfigName, "ProductCodes", sProductCodeList, "REG_MULTI_SZ") Then fCategorized = False For Each sProductCode in Split(sProductCodeList,chr(34)) If Len(sProductCode) = 38 Then If Mid(sProductCode,11,1) = "1" Then 'Server product If NOT dicSrv.Exists(UCase(sConfigName)) Then dicSrv.Add UCase(sConfigName),sConfigName fCategorized = True Exit For Else Select Case Mid(sProductCode,11,4) 'Client Suites Case "000F","0011","0012","0013","0014","0015","0016","0017","0018","0019","001A","001B","0029","002B","002E","002F","0030","0031","0033","0035","0037","003D","0044","0049","0061","0062","0066","006C","006D","006F","0074","00A1","00A3","00A9","00BA","00CA","00E0","0100","0103","011A" If NOT dicCSuite.Exists(UCase(sConfigName)) Then dicCSuite.Add UCase(sConfigName), sConfigName fCategorized = True Exit For Case "007E", "008F", "008C", "24E1", "237A" If NOT dictinaryKeepProd.Exists(sProductCode) Then dictinaryKeepProd.Add sProductCode, sConfigName fC2rInstalled = True Case Else End Select End If End If 'Len 38 Next 'sProductCode If NOT fCategorized Then If NOT dicCSingle.Exists(UCase(sConfigName)) Then dicCSingle.Add UCase(sConfigName),sConfigName End If 'fCategorized End If 'RegReadValue "ProductCodes" End If Next 'ArpItem End If 'RegEnumKey End Sub 'FindInstalledOProducts '======================================================================================================= 'Check if there are Office products from previous versions on the computer Sub CheckForLegacyProducts Const OLEGACY = "78E1-11D2-B60F-006097C998E7}.6000-11D3-8CFE-0050048383C9}.6000-11D3-8CFE-0150048383C9}.BDCA-11D1-B7AE-00C04FB92F3D}.6D54-11D4-BEE3-00C04F990354}" Dim Product 'Set safe default fLegacyProductFound = True For Each Product in oMsi.Products If Len(Product) = 38 Then 'Handle O09 - O11 Products If InStr(OLEGACY, UCase(Right(Product, 28))) > 0 Then 'Found legacy Office product. Keep flag in default and exit Exit Sub End If If UCase(Right(Product,PRODLEN)) = OFFICEID Then Select Case Mid(Product,4,2) Case "12", "14", "15" 'Found legacy Office product. Keep flag in default and exit Exit Sub Case Else End Select End If End If '38 Next 'Product fLegacyProductFound = False End Sub 'CheckForLegacyProducts '======================================================================================================= 'Create clean list of Products to remove. 'Strip off bad & empty contents Sub ValidateRemoveSkuList Dim Sku, Key, sProductCode, sProductCodeList Dim arrRemoveSKUs If fRemoveAll Then 'Remove all mode For Each Key in dicInstalledSku.Keys dicRemoveSku.Add Key,dicInstalledSku.Item(Key) Next 'Key Else 'Remove individual products or preconfigured configurations mode 'Ensure to have a string with no unexpected contents sSkuRemoveList = Replace(sSkuRemoveList,";",",") sSkuRemoveList = Replace(sSkuRemoveList," ","") sSkuRemoveList = Replace(sSkuRemoveList,Chr(34),"") While InStr(sSkuRemoveList,",,")>0 sSkuRemoveList = Replace(sSkuRemoveList,",,",",") Wend 'Prepare 'remove' and 'keep' dictionaries to determine what has to be removed 'Initial pre-fill of 'keep' dic For Each Key in dicInstalledSku.Keys dictinaryKeepSku.Add Key,dicInstalledSku.Item(Key) Next 'Key 'Determine contents of keep and remove dic 'Individual products arrRemoveSKUs = Split(UCase(sSkuRemoveList),",") For Each Sku in arrRemoveSKUs If Sku = "OSE" Then fRemoveOse = True If dictinaryKeepSku.Exists(Sku) Then 'A Sku to remove has been passed in 'remove the item from the keep dic dictinaryKeepSku.Remove(Sku) 'Now add it to the remove dic If NOT dicRemoveSku.Exists(Sku) Then dicRemoveSku.Add Sku,Sku End If Next 'Sku 'Client Suite Category If fRemoveCSuites Then For Each Key in dicInstalledSku.Keys If dicCSuite.Exists(Key) Then If dictinaryKeepSku.Exists(Key) Then dictinaryKeepSku.Remove(Key) If NOT dicRemoveSku.Exists(Key) Then dicRemoveSku.Add Key,Key End If Next 'Key End If 'fRemoveCSuites 'Client Single/Standalone Category If fRemoveCSingle Then For Each Key in dicInstalledSku.Keys If dicCSingle.Exists(Key) Then If dictinaryKeepSku.Exists(Key) Then dictinaryKeepSku.Remove(Key) If NOT dicRemoveSku.Exists(Key) Then dicRemoveSku.Add Key,Key End If Next 'Key End If 'fRemoveCSingle 'Server Category If fRemoveSrv Then For Each Key in dicInstalledSku.Keys If dicSrv.Exists(Key) Then If dictinaryKeepSku.Exists(Key) Then dictinaryKeepSku.Remove(Key) If NOT dicRemoveSku.Exists(Key) Then dicRemoveSku.Add Key,Key End If Next 'Key End If 'fRemoveSrv If NOT dictinaryKeepSku.Count > 0 Then fRemoveAll = True End If 'fRemoveAll 'Fill the KeepProd dic For Each Sku in dictinaryKeepSku.Keys If RegReadValue(HKLM, REG_ARP & OREGREF & Sku, "ProductCodes", sProductCodeList, "REG_MULTI_SZ") Then For Each sProductCode in Split(sProductCodeList, chr(34)) If Len(sProductCode) = 38 Then If NOT dictinaryKeepProd.Exists(sProductCode) Then dictinaryKeepProd.Add sProductCode, Sku ' also add the UpgradeCode If Not dictinaryKeepProd.Exists(GetUpgradeCode(sProductCode)) Then dictinaryKeepProd.Add GetUpgradeCode(sProductCode), Sku & "_UpgradeCode" End If End If '38 Next 'sProductCode End If Next 'Sku If fRemoveAll OR fRemoveOse Then CheckRemoveOSE If fRemoveAll OR fRemoveOspp Then CheckRemoveOspp End Sub 'ValidateRemoveSkuList '======================================================================================================= 'Check if OSE service can be scrubbed Sub CheckRemoveOSE Const O11 = "6000-11D3-8CFE-0150048383C9}" Dim Product If fRemoveOse Then Exit Sub For Each Product in oMsi.Products If Len(Product) = 38 Then If UCase(Right(Product,28)) = O11 Then 'Found Office 2003 Product. Set flag to not remove the OSE service Exit Sub End If If UCase(Right(Product,PRODLEN))=OFFICEID Then Select Case Mid(Product,4,2) Case "12","14","15","16","17" 'Found another Office product. Set flag to keep the OSE service If NOT Mid(Product,4,2) = OVERSIONMAJOR Then fRemoveOse = False Exit Sub End If Case Else End Select End If End If '38 Next 'Product fRemoveOse = True End Sub 'CheckRemoveOSE '======================================================================================================= 'Check if OSPP service can be scrubbed Sub CheckRemoveOSPP Dim Product If NOT CInt(OVERSIONMAJOR) > 12 Then fRemoveOspp = False Exit Sub End If If fRemoveOspp Then Exit Sub If fC2rInstalled Then fRemoveOspp = False Exit Sub End If For Each Product in oMsi.Products If Len(Product) = 38 Then If UCase(Right(Product,PRODLEN))=OFFICEID Then Select Case Mid(Product,4,2) Case "14","15","16","17" 'Found another Office product. Set flag to keep the OSPP service If NOT Mid(Product,4,2) = OVERSIONMAJOR Then fRemoveOspp = False Exit Sub End If Case Else End Select End If End If '38 Next 'Product fRemoveOspp = True End Sub 'CheckRemoveOSPP '======================================================================================================= 'Cache .msi files for products that will be removed in case they are needed for later file detection Sub CacheMsiFiles Dim Product Dim sMsiFile 'Non critical routine for failures. 'Errors will be logged but must not fail the execution On Error Resume Next Log " Cache .msi files to temporary Scrub folder" 'Cache the files For Each Product in oMsi.Products 'Ensure valid GUID length If CheckDeleteEx(Product) Then CheckError "CacheMsiFiles" sMsiFile = oMsi.ProductInfo(Product,"LocalPackage") : CheckError "CacheMsiFiles" LogOnly " - " & Product & ".msi" If oFso.FileExists(sMsiFile) Then oFso.CopyFile sMsiFile,sScrubDir & "\" & Product & ".msi",True CheckError "CacheMsiFiles" End If 'InScope Next 'Product Err.Clear End Sub 'CacheMsiFiles '======================================================================================================= 'Build a list of all files that will be deleted Sub ScanComponents Const MSIINSTALLSTATE_LOCAL = 3 Dim FileList, RegList, ComponentID, CompClient, Record, qView, MsiDb, CompVerbose Dim Processes, Process, Prop, prod Dim sQuery, sSubKeyName, sPath, sFile, sMsiFile, sCompClient, sComponent, sCompReg Dim fRemoveComponent, fAffectedComponent, fIsPermanent, fIsFile, fIsFolder Dim i, iProgress, iCompCnt, iRemCnt Dim dicFLError, oDic, oFolderDic, dicCompPath Dim hDefKey 'Logfile Set FileList = oFso.OpenTextFile(sScrubDir & "\FileList.txt",FOR_WRITING,True,True) Set RegList = oFso.OpenTextFile(sScrubDir & "\RegList.txt",FOR_WRITING,True,True) Set CompVerbose = oFso.OpenTextFile(sScrubDir & "\CompVerbose.txt",FOR_WRITING,True,True) 'FileListError dic Set dicFLError = CreateObject("Scripting.Dictionary") Set oDic = CreateObject("Scripting.Dictionary") Set oFolderDic = CreateObject("Scripting.Dictionary") Set dicCompPath = CreateObject("Scripting.Dictionary") 'Prevent that API errors fail script execution On Error Resume Next iCompCnt = oMsi.Components.Count If NOT Err = 0 Then 'API failure Log "Error during components detection. Cannot complete this task." Err.Clear Exit Sub End If 'Ensure to not divide by zero If iCompCnt = 0 Then iCompCnt = 1 LogOnly " Scanning " & iCompCnt & " components" 'Enum all Components For Each ComponentID In oMsi.Components CompVerbose.WriteLine vbCrLf & "Checking Component: " & ComponentID 'Progress bar i = i + 1 If iProgress < (i / iCompCnt) * 100 Then If fCScript Then var="1"'wscript.stdout.write "." : LogStream.Write "." iProgress = iProgress + 1 If iProgress = 35 OR iProgress = 70 Then Log "" End If 'Check if all ComponentClients will be removed sCompClient = "" iRemCnt = 0 fIsPermanent = False fRemoveComponent = False 'Flag to track if the component will be completely removed fAffectedComponent = False 'Flag to track if some clients remain installed who have a none shared location dicCompPath.RemoveAll Err.Clear For Each CompClient In oMsi.ComponentClients(ComponentID) CompVerbose.Write " CompClient " & CompClient & "-> " If Err = 0 Then 'Ensure valid guid length If Len(CompClient) = 38 Then fRemoveComponent = InScope(CompClient) If fRemoveComponent OR (CompClient = "{00000000-0000-0000-0000-000000000000}") Then sPath = "" sPath = LCase(oMsi.ComponentPath(CompClient,ComponentID)) sPath = Replace(sPath,"?",":") 'Scan for msidbComponentAttributesPermanent flag If CompClient = "{00000000-0000-0000-0000-000000000000}" Then fIsPermanent = True iRemCnt = iRemCnt + 1 End If If fRemoveComponent Then fRemoveComponent = CheckDelete(CompClient) CompVerbose.Write "CheckDelete: " & fRemoveComponent & "; " If fRemoveComponent Then iRemCnt = iRemCnt + 1 fAffectedComponent = True 'Since the scope remains within one Office family the keypath for the component 'is assumed to be identical If sCompClient = "" Then sCompClient = CompClient ' flag the CompClient entry for removal sCompReg = "Installer\Components\"&GetCompressedGuid(ComponentID)&"\"&GetCompressedGuid(CompClient) If NOT dicDelRegKey.Exists(sCompReg) Then dicDelRegKey.Add sCompReg,HKCR RegList.WriteLine HiveString(HKCR)&"\"&sCompReg End If sCompReg = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components\"&GetCompressedGuid(ComponentID)&"\"&GetCompressedGuid(CompClient) If NOT dicDelRegKey.Exists(sCompReg) Then dicDelRegKey.Add sCompReg,HKLM RegList.WriteLine HiveString(HKCR)&"\"&sCompReg End If Else If NOT dicCompPath.Exists(sPath) Then dicCompPath.Add sPath,CompClient End If CompVerbose.WriteLine "AffectedComponent: " & fAffectedComponent CompVerbose.WriteLine " CompClient now set to: " & sCompClient Else CompVerbose.Write "InScope: " & fRemoveComponent & "; " End If Else CompVerbose.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, ComponentID End If '38 Else CompVerbose.WriteLine "Error: " & Err.number & " " & Err.Description Err.Clear End If 'Err = 0 Next 'CompClient 'Determine if the component resources go away sPath = "" 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 If If fRemoveComponent Then 'Check msidbComponentAttributesPermanent flag If fIsPermanent AND NOT fForce Then fRemoveComponent = False CompVerbose.WriteLine " msidbComponentAttributesPermanent: " & NOT fRemoveComponent End If If fRemoveComponent Then CompVerbose.WriteLine " RESULT: Component IN SCOPE for removal" fIsFile = False : fIsFolder = False 'Component resources go away for this product Err.Clear 'Add the component registration key to ensure removal sCompReg = "Installer\Components\"&GetCompressedGuid(ComponentID)&"\" If NOT dicDelRegKey.Exists(sCompReg) Then dicDelRegKey.Add sCompReg,HKCR RegList.WriteLine HiveString(HKCR)&"\"&sCompReg End If sCompReg = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components\"&GetCompressedGuid(ComponentID)&"\" If NOT dicDelRegKey.Exists(sCompReg) Then dicDelRegKey.Add sCompReg,HKLM RegList.WriteLine HiveString(HKCR)&"\"&sCompReg End If 'Get the component path If sPath = "" Then sPath = LCase(oMsi.ComponentPath(sCompClient,ComponentID)) sPath = Replace(sPath,"?",":") End If CompVerbose.WriteLine " Path: " & sPath If Len(sPath) > 4 Then If Left(sPath,1) = "0" Then 'Registry keypath Select Case Left(sPath,2) Case "00" sPath = Mid(sPath,5) hDefKey = HKCR Case "01" sPath = Mid(sPath,5) hDefKey = HKCU Case "02","22" sPath = Mid(sPath,5) hDefKey = HKLM Case Else ' End Select 'Go for the safe way and just reset the default entry 'compared to deleting the whole key If Right(sPath,1) = "\" Then sPath = sPath & "(Default)" If NOT dicDelRegKey.Exists(sPath) Then dicDelRegKey.Add sPath,hDefKey RegList.WriteLine HiveString(hDefKey)&"\"&sPath End If Else 'File or Folder If oFso.FileExists(sPath) OR oFso.FolderExists(sPath) Then If Right(sPath,1) = "\" Then fIsFolder = True CompVerbose.WriteLine " Folder check OK" Else fIsFile = True CompVerbose.WriteLine " File check OK" End If If fIsFile Then sPath = oFso.GetFile(sPath).ParentFolder If Not oFolderDic.Exists(sPath) Then oFolderDic.Add sPath,sPath FileList.WriteLine sPath & vbTab & "(FOLDER)" End If 'Get the .msi file If oFso.FileExists(sScrubDir & "\" & sCompClient & ".msi") Then sMsiFile = sScrubDir & "\" & sCompClient & ".msi" Else sMsiFile = oMsi.ProductInfo(sCompClient,"LocalPackage") End If CompVerbose.WriteLine " Set msi file to : " & sMsiFile If Not Err = 0 Then CompVerbose.WriteLine " Error: Failed to obtain .msi file for product " & sCompClient If NOT dicFLError.Exists("Failed to obtain .msi file for product "&sCompClient) Then _ dicFLError.Add "Failed to obtain .msi file for product "&sCompClient, ComponentID Err.Clear End If CompVerbose.Write " Open .msi file for reading returned: " Set MsiDb = oMsi.OpenDatabase(sMsiFile,MSIOPENDATABASEREADONLY) If Err = 0 Then CompVerbose.WriteLine " SUCCESS" 'Get the component name from the 'Component' table sQuery = "SELECT `Component`,`ComponentId` FROM Component WHERE `ComponentId` = '" & ComponentID &"'" Set qView = MsiDb.OpenView(sQuery) : qView.Execute Set Record = qView.Fetch() If Not Record Is Nothing Then sComponent = Record.Stringdata(1) CompVerbose.WriteLine " Obtained ComponentId as: " & sComponent 'Get filenames from the 'File' table sQuery = "SELECT `Component_`,`FileName` FROM File WHERE `Component_` = '" & sComponent &"'" Set qView = MsiDb.OpenView(sQuery) : qView.Execute Set Record = qView.Fetch() Do Until Record Is Nothing 'Read the filename sFile = Record.StringData(2) If InStr(sFile,"|") > 0 Then sFile = Mid(sFile,InStr(sFile,"|")+1,Len(sFile)) 'sFile = sPath & "\" & sFile CompVerbose.WriteLine " File: " & sPath& "\" & sFile If Not oDic.Exists(sPath & "\" & sFile) Then 'Exception handler fAdd = True Select Case UCase(sFile) Case "FPERSON.DLL" 'Catch exception caused by changed .msi keypath authoring logic for smart tags For Each prod in oMsi.Products If NOT Checkdelete(prod) Then If oMsi.FeatureState(prod, "MSTagPluginNamesFiles") = MSIINSTALLSTATE_LOCAL Then fAdd = False Exit For End If End If Next 'prod Case Else End Select If fAdd Then CompVerbose.WriteLine " Added as new file to dictionary" oDic.Add sPath & "\" & sFile,sFile FileList.WriteLine sFile & vbTab & sPath & "\" & sFile If Len(sFile)>4 Then sFile = LCase(sFile) If Right(sFile,4) = ".exe" Then If NOT dicApps.Exists(sFile) Then Select Case sFile Case "setup.exe","ose.exe","osppsvc.exe","explorer.exe" Case Else dicApps.Add sFile,LCase(sPath) & "\" & sFile CompVerbose.WriteLine " Added to the list of processes that need to be closed." End Select End If 'dicApps.Exists End If '.exe End If 'Len > 4 End If 'fAdd End If 'oDic.Exists Set Record = qView.Fetch() Loop Set Record = Nothing qView.Close Set qView = Nothing Else CompVerbose.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, ComponentID Err.Clear End If 'Err = 0 Else CompVerbose.WriteLine " Error: File check FAILED" End If 'FileExists(sPath) End If End If 'Len(sPath) > 4 Else CompVerbose.WriteLine " RESULT: Component NOT in scope for removal" If fAffectedComponent Then 'Add the path to the 'Keep' dictionary Err.Clear For Each CompClient In oMsi.ComponentClients(ComponentID) 'Get the component path sPath = "" : sPath = LCase(oMsi.ComponentPath(CompClient,ComponentID)) sPath = Replace(sPath,"?",":") If Len(sPath) > 4 Then If Left(sPath,1) = "0" Then 'Registry keypath Select Case Left(sPath,2) Case "00" sPath = Mid(sPath,5) hDefKey = HKCR Case "01" sPath = Mid(sPath,5) hDefKey = HKCU Case "02","22" sPath = Mid(sPath,5) hDefKey = HKLM Case Else ' End Select If NOT dictinaryKeepReg.Exists(LCase(sPath)) Then dictinaryKeepReg.Add LCase(sPath),hDefKey End If Else 'File keypath If oFso.FileExists(sPath) Then If NOT dictinaryKeepFolder.Exists(LCase(sPath)) Then dictinaryKeepFolder.Add LCase(sPath) sPath = LCase(oFso.GetFile(sPath).ParentFolder) & "\" If NOT dictinaryKeepFolder.Exists(sPath) Then AddKeepFolder sPath End If 'Folder keypath If oFso.FolderExists(sPath) Then AddKeepFolder sPath End If 'Is Registry End If 'sPath > 4 Next 'CompClient End If 'fAffectedComponent End If 'fRemoveComponent Err.Clear Next 'ComponentID On Error Goto 0 Log " Done" & vbCrLf If dicFLError.Count > 0 Then LogOnly Join(dicFLError.Keys,vbCrLf) If Not oFolderDic.Count = 0 Then arrDeleteFolders = oFolderDic.Keys Else Set arrDeleteFolders = Nothing If Not oDic.Count = 0 Then arrDeleteFiles = oDic.Keys Else Set arrDeleteFiles = Nothing End Sub 'ScanComponents '======================================================================================================= 'Try to remove the products by calling setup.exe Sub SetupExeRemoval Dim OseService, Service, TextStream Dim iSetupCnt, RetVal Dim Sku, sConfigFile, sUninstallCmd, sCatalyst, sDll, sDisplayLevel, sNoCancel iSetupCnt = 0 If Not dicRemoveSku.Count > 0 Then Log " Nothing to remove for Setup.exe" Exit Sub End 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 Sub For Each Service in OseService If (Service.StartMode = "Disabled") AND (Not Service.ChangeStartMode("Manual")=0) Then Exit Sub If (Not Service.StartName = "LocalSystem") AND (Service.Change( , , , , , , "LocalSystem", "")) Then Exit Sub Next 'Service For Each Sku in dicRemoveSku.Keys If Sku="CLICK2RUN" Then 'Already done Else 'Create an "unattended" config.xml file for uninstall If fQuiet Then sDisplayLevel = "None" Else sDisplayLevel="Basic" If fNoCancel Then sNoCancel="Yes" Else sNoCancel="No" Set TextStream = oFso.OpenTextFile(sScrubDir & "\config.xml",FOR_WRITING,True,True) TextStream.Writeline "<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.Close Set TextStream = Nothing 'Ensure path to setup.exe is valid to prevent errors sDll = "" If RegReadValue(HKLM,REG_ARP & OREGREF & Sku,"UninstallString",sCatalyst,"REG_SZ") Then If InStr(LCase(sCatalyst),"/dll")>0 Then sDll = Right(sCatalyst,Len(sCatalyst)-InStr(LCase(sCatalyst),"/dll")+2) If InStr(sCatalyst,"/")>0 Then sCatalyst = Left(sCatalyst,InStr(sCatalyst,"/")-1) sCatalyst = Trim(Replace(sCatalyst,Chr(34),"")) If NOT oFso.FileExists(sCatalyst) Then sCatalyst = sCommonProgramFiles & "\" & OREF & "\Office Setup Controller\setup.exe" If NOT oFso.FileExists(sCatalyst) AND f64 Then sCatalyst = sCommonProgramFilesX86 & "" & OREF & "\Office Setup Controller\setup.exe" End If End If If oFso.FileExists(sCatalyst) Then sUninstallCmd = Chr(34) & sCatalyst & Chr(34) & " /uninstall " & Sku & " /config " & Chr(34) & sScrubDir & "\config.xml" & Chr(34) & sDll iSetupCnt = iSetupCnt + 1 Log " - Calling Setup.exe to remove " & Sku '& vbCrLf & sUninstallCmd If Not fDetectOnly Then On Error Resume Next ' end other instances of setup EndCurrentInstalls ' call uninstall RetVal = oWShell.Run(sUninstallCmd,0,True) : CheckError "SetupExeRemoval" Log " - Setup.exe returned: " & SetupRetVal(Retval) & " (" & RetVal & ")" & vbCrLf fRebootRequired = fRebootRequired OR (RetVal = "3010") On Error Goto 0 Else Log " -> Removal suppressed in preview mode." End If Else Log " Error: Office setup.exe appears to be missing" End If 'RetVal = 0) AND oFso.FileExists End If 'RegReadValue End If Next 'Sku If iSetupCnt = 0 Then Log " Nothing to remove for setup." End Sub 'SetupExeRemoval '======================================================================================================= 'Invoke msiexec to remove individual .MSI packages Sub MsiexecRemoval Dim Product Dim i Dim sCmd, sReturn, sMsiProp Dim fRegWipe fRegWipe = False Select Case OVERSIONMAJOR Case "11" sMsiProp = " REBOOT=ReallySuppress NOLOCALCACHEROLLBACK=1" Case "12", "14", "15", "16" fRegWipe = True sMsiProp = " REBOOT=ReallySuppress NOREMOVESPAWN=True" Case Else End Select 'Clear up ARP first to avoid possible custom action dependencies If fRegWipe Then RegWipeARP 'Check MSI registered products 'Office System does only support per machine installation so it's sufficient to use Installer.Products i = 0 sMsiProp = " MSIRESTARTMANAGERCONTROL=Disable" & sMsiProp For Each Product in oMsi.Products If CheckDeleteEx(Product) Then i = i + 1 Log " Calling msiexec.exe to remove " & Product sCmd = "msiexec.exe /x" & Product & sMsiProp If fQuiet AND NOT fBasic Then sCmd = sCmd & " /q" Else sCmd = sCmd & " /qb-" End If sCmd = sCmd & " /l*v+ "&chr(34)&sLogDir&"\Uninstall_"&Product&".log"&chr(34) If NOT fDetectOnly Then ' end other instances of setup EndCurrentInstalls 'Execute the uninstall LogOnly " - Calling msiexec with '"&sCmd&"'" sReturn = oWShell.Run(sCmd, 0, True) Log " - msiexec returned: " & SetupRetVal(sReturn) & " (" & sReturn & ")" & vbCrLf fRebootRequired = fRebootRequired OR (sReturn = "3010") OR (sReturn = "1618") Else Log " -> Removal suppressed in preview mode." LogOnly " -> Command: "&sCmd End If End If 'InScope Next 'Product If i = 0 Then Log " Nothing to remove for msiexec" End Sub 'MsiexecRemoval '======================================================================================================= 'Remove the OSE (Office Source Engine) service Sub RemoveOSE On Error Resume Next Log vbCrLf & "OSE CleanUp" DeleteService "ose" 'Delete the folder DeleteFolder sCommonProgramFiles & "\Microsoft Shared\Source Engine" 'Delete the registration RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\ose\" End Sub 'RemoveOSE '======================================================================================================= 'File cleanup operations for the Local Installation Source (MSOCache) Sub WipeLIS Const LISROOT = "MSOCache\All Users\" Dim LogicalDisks, Disk, Folder, SubFolder, MseFolder, File, Files Dim arrSubFolders Dim sFolder Dim fRemoveFolder Log vbCrLf & "LIS CleanUp" 'Search all hard disks Set LogicalDisks = oWmiLocal.ExecQuery("Select * From Win32_LogicalDisk WHERE DriveType=3") For Each Disk in LogicalDisks If oFso.FolderExists(Disk.DeviceID & "\" & LISROOT) Then Set Folder = oFso.GetFolder(Disk.DeviceID & "\" & LISROOT) For Each Subfolder in Folder.Subfolders If Len(Subfolder) > 37 Then If fRemoveAll Then If (Mid(Subfolder.Name,27,PRODLEN) = OFFICEID AND Mid(SubFolder.Name,4,2)=OVERSIONMAJOR) OR _ LCase(Right(Subfolder.Name,7)) = OVERSIONMAJOR &".data" Then DeleteFolder Subfolder.Path Else If (Mid(Subfolder.Name,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.Path End If End If 'Len > 37 Next 'Subfolder If (Folder.Subfolders.Count = 0) AND (Folder.Files.Count = 0) Then sFolder = Folder.Path Set Folder = Nothing SmartDeleteFolder sFolder End If End If 'oFso.FolderExists Next 'Disk 'MSECache If EnumFolders(sProgramFiles,arrSubFolders) Then For Each SubFolder in arrSubFolders If UCase(Right(SubFolder,9))="\MSECACHE" Then ReDim arrMseFolders(-1) Set Folder = oFso.GetFolder(SubFolder) GetMseFolderStructure Folder For Each MseFolder in arrMseFolders If oFso.FolderExists(MseFolder) Then fRemoveFolder = False Set Folder = oFso.GetFolder(MseFolder) Set Files = Folder.Files For Each File in Files If (LCase(Right(File.Name,4))=".msi") Then If CheckDelete(ProductCode(File.Path)) Then fRemoveFolder = True Exit For End If 'CheckDelete End If Next 'File Set Files = Nothing Set Folder = Nothing If fRemoveFolder Then SmartDeleteFolder MseFolder End If 'oFso.FolderExists(MseFolder) Next 'MseFolder End If Next 'SubFolder End If 'oFso.FolderExists End Sub 'WipeLis '======================================================================================================= 'Wipe files and folders as documented in KB 928218 Sub FileWipeAll Dim sFolder Dim Folder, Subfolder If fForce OR fQuiet OR fPassive Then CloseOfficeApps 'Handle other services. Select Case OVERSIONMAJOR Case "11" Case "12" Case "14" DeleteService "odserv" DeleteService "Microsoft Office Groove Audit Service" DeleteService "Microsoft SharePoint Workspace Audit Service" Case "15", "16" Case Else End Select 'User specific files If NOT fKeepUser Then 'Delete files that should be backed up before deleting them CopyAndDeleteFile 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.Subfolders If oFso.FileExists(Subfolder & "\blocks.dotx") Then CopyAndDeleteFile Subfolder & "\blocks.dotx" Next 'Subfolder Set Folder = Nothing End If 'oFso.FolderExists(sFolder) End If 'Run the individual filewipe from component detection first FileWipeIndividual If fC2rInstalled AND NOT fForce Then Exit Sub 'Take care of the rest DeleteFolder sOInstallRoot DeleteFolder sCommonProgramFiles & "\Microsoft Shared\" & OREF DeleteFile 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 Then DeleteService "osppsvc" DeleteFolder sCommonProgramFiles & "\Microsoft Shared\OfficeSoftwareProtectionPlatform" DeleteFolder sAllUsersProfile & "\Microsoft\OfficeSoftwareProtectionPlatform" End If Select Case OVERSIONMAJOR Case "12" Case "14" DeleteFile oWShell.SpecialFolders("AllUsersStartup")&"\OfficeSAS.lnk" DeleteFile oWShell.SpecialFolders("Startup")&"\OneNote 2010 Screen Clipper and Launcher.lnk" Case "15", "16" Case Else End Select DeleteEmptyFolder sCommonProgramFiles & "\Microsoft Shared\" & OREF DeleteEmptyFolder sCommonProgramFiles & "\Microsoft Shared\" DeleteEmptyFolder sProgramFiles & "\Microsoft Office\" & OREF DeleteEmptyFolder sProgramFiles & "\Microsoft Office\" End Sub 'FileWipeAll '======================================================================================================= 'Wipe individual files & folders related to SKU's that are no longer installed Sub FileWipeIndividual Dim LogicalDisks, Disk,sc Dim File, Files, XmlFile, scFiles, oFile, Folder, SubFolder, Processes, Process, item Dim sFile, sFolder, sPath, sConfigName, sContents, sProductCode, sLocalDrives,sScQuery Dim sValue, sScRoots Dim arrSubfolders, arrShortCutRoots Dim fKeepFolder, fDeleteSC Dim iRet,iCnt,iPos Log vbCrLf & "File CleanUp" If IsArray(arrDeleteFiles) Then If fForce OR fQuiet Then Log " Doing Action: StopOSE" iRet = StopService("ose") Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name like 'ose%.exe'") For Each Process in Processes LogOnly " - Running process : " & Process.Name Log " -> Ending process: " & Process.Name iRet = Process.Terminate() Next 'Process LogOnly " End Action: StopOSE" CloseOfficeApps End If 'Wipe individual files detected earlier LogOnly " Removing left behind files" For Each sFile in arrDeleteFiles If oFso.FileExists(sFile) Then DeleteFile sFile Next 'File End If 'IsArray 'Wipe Catalyst in commonfiles sFolder = sCommonProgramFiles & "\microsoft shared\"&OREF&"\Office Setup Controller\" If EnumFolderNames(sFolder,arrSubFolders) Then For Each SubFolder in arrSubFolders sPath = sFolder & SubFolder If InStr(SubFolder, ".") > 0 Then sConfigName = UCase(Left(SubFolder, InStr(SubFolder, ".") - 1)) Else sConfigName = UCase(Subfolder) If GetFolderPath(sPath) Then Set Folder = oFso.GetFolder(sPath) Set Files = Folder.Files fKeepFolder = False For Each File In Files If Len(File.Name)>3 Then If (LCase(Right(File.Name,4))=".xml") Then If Len(File.Name) >= Len(sConfigName) Then If (UCase(Left(File.Name,Len(sConfigName)))=sConfigName) Then Set XmlFile = oFso.OpenTextFile(File,1) sContents = XmlFile.ReadAll Set XmlFile = Nothing sProductCode = "" On Error Resume Next sProductCode = Mid(sContents,InStr(sContents,"ProductCode=")+Len("ProductCode=")+1,38) On Error Goto 0 If Len(sProductCode) = 38 Then If CheckDelete(sProductCode) Then DeleteFile File.Path Else fKeepFolder = True End If End If 'sConfigName End If 'Len >= End If '.xml End If 'Len(File.Name)>3 Next 'File Set Files = Nothing Set Folder = Nothing If Not fKeepFolder Then DeleteFolder sPath End If 'GetFolderPath Next 'SubFolder End If 'EnumFolderNames 'Wipe Shortcuts If NOT fSkipSD Then On Error Resume Next Log " Searching for shortcuts" CleanShortcuts sAllUsersProfile, True, False CleanShortcuts sProfilesDirectory, True, False On Error Goto 0 End If 'NOT SkipSD Err.Clear End Sub 'FileWipeIndividual '======================================================================================================= '------------------------------------------------------------------------------- ' CleanShortcuts ' ' Recursively search all profile folders for Office shortcuts in scope '------------------------------------------------------------------------------- Sub CleanShortcuts (sFolder, fDelete, fUnPin) Dim oFolder, fld, file, sc, item Dim fDeleteSC Set oFolder = oFso.GetFolder(sFolder) ' exclude system protected link folders If CBool(oFolder.Attributes AND 1024) Then Exit Sub On Error Resume Next For Each fld In oFolder.SubFolders If Err <> 0 Then CheckError "CleanShortcuts: " & vbTab & sFolder Else CleanShortcuts fld.Path, fDelete, fUnPin End If Next For Each file In oFolder.Files If LCase(Right(file.Path, 4)) = ".lnk" Then fDeleteSC = False LogOnly " check file: " & file.Path set sc = oWShell.CreateShortcut(file.Path) If Err <> 0 Then CheckError "CleanShortcutsSC: " & vbTab & sFolder Else 'Compare if the shortcut target is in the list of executables that will be removed 'LogOnly " - SC.TargetPath: " & sc.TargetPath If Len(sc.TargetPath) > 0 Then If InStr(sc.TargetPath,"{") > 0 Then 'Handle Windows Installer shortcuts If Len(sc.TargetPath) >= InStr(sc.TargetPath,"{") + 37 Then If CheckDelete(Mid(sc.TargetPath, InStr(sc.TargetPath,"{"), 38)) Then fDeleteSC = True End If Else 'Handle regular shortcuts If NOT fBypass_Stage1 Then ' Compare against results from component scan For Each item in dicApps.Items If LCase(sc.TargetPath) = item Then LogOnly " - removing shortcut per match from component detection: " & file.Path fDeleteSC = True Exit For End If Next 'item Else End If If NOT oFso.FileExists(sc.TargetPath) Then ' Shortcut target does not exist If InStr (sc.TargetPath, OREF) > 0 Then LogOnly " - removing Office shortcut with non-existent target: " & file.Path & " - " & sc.TargetPath fDeleteSC = True Else 'LogOnly " - keep orphaned SC as target is not in scope: " & sc.TargetPath End If Else 'LogOnly " - keep SC as shortcut target does still exist: " & sc.TargetPath End If End If End If End If If fDeleteSC Then If Not IsArray(arrDeleteFolders) Then ReDim arrDeleteFolders(0) sFolder = file.Drive & file.Path If Not arrDeleteFolders(UBound(arrDeleteFolders)) = sFolder Then ReDim Preserve arrDeleteFolders(UBound(arrDeleteFolders) + 1) arrDeleteFolders(UBound(arrDeleteFolders)) = sFolder End If If fUnPin Then UnPin file If fDelete Then If fBypass_Stage1 Then UnPin file DeleteFile file.Path End If fDeleteSC = False End If 'fDeleteSC End If Next On Error Goto 0 End Sub 'CleanShortcuts '------------------------------------------------------------------------------- ' UnPin ' ' Unpins a shortcut from the taskbar or start menu '------------------------------------------------------------------------------- Sub UnPin(file) Dim fldItem, verb On Error Resume Next Set fldItem = oShellApp.NameSpace(file.ParentFolder.Path).ParseName(file.Name) For Each verb in fldItem.Verbs Select 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.DoIt Case "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.DoIt End Select Next On Error Goto 0 End Sub '======================================================================================================= Sub DelScrubTmp On Error Resume Next If oFso.FolderExists(sScrubDir & "\ScrubTmp") Then oFso.DeleteFolder sScrubDir & "\ScrubTmp",True End Sub 'DelScrubTmp '======================================================================================================= 'Ensure there are no unexpected .msi files in the scrub folder Sub DeleteMsiScrubCache Dim Folder, File, Files Log vbCrLf & "ScrubCache CleanUp" Set Folder = oFso.GetFolder(sScrubDir) : CheckError "DeleteMsiScrubCache" Set Files = Folder.Files For Each File in Files CheckError "DeleteMsiScrubCache" If LCase(Right(File.Name,4))=".msi" Then CheckError "DeleteMsiScrubCache" DeleteFile File.Path : CheckError "DeleteMsiScrubCache" End If Next 'File End Sub 'DeleteMsiScrubCache '======================================================================================================= Sub MsiClearOrphanedFiles Const USERSIDEVERYONE = "s-1-1-0" Const MSIINSTALLCONTEXT_ALL = 7 Const MSIPATCHSTATE_ALL = 15 'Error handling inlined On Error Resume Next Dim Patch, AllPatches, Product, AllProducts Dim File, Files, Folder Dim sFName, sLocalMsp, sLocalMsi, sPatchList, sMsiList Set Folder = oFso.GetFolder(sWinDir & "\Installer") Set Files = Folder.Files Log vbCrLf & "Windows Installer cache CleanUp" 'Get a complete list of patches Err.Clear Set AllPatches = oMsi.PatchesEx("",USERSIDEVERYONE,MSIINSTALLCONTEXT_ALL,MSIPATCHSTATE_ALL) If Err <> 0 Then CheckError "MsiClearOrphanedFiles (msp)" Else 'Fill a comma separated stringlist with all .msp patchfiles For Each Patch in AllPatches sLocalMsp = "" : sLocalMsp = LCase(Patch.Patchproperty("LocalPackage")) : CheckError "MsiClearOrphanedFiles (msp)" sPatchList = sPatchList & sLocalMsp & "," Next 'Patch 'Delete all non referenced .msp files from %windir%\installer For Each File in Files sFName = "" : sFName = LCase(File.Path) If LCase(Right(sFName,4)) = ".msp" Then If Not InStr(sPatchList,sFName) > 0 Then 'While this is an orphaned file keep the scope of Office only If InStr(UCase(MspTargets(File.Path)),OFFICEID)>0 Then DeleteFile File.Path End If End If 'LCase(Right(sFName,4)) Next 'File End If 'Err=0 'Get a complete list products Err.Clear Set AllProducts = oMsi.ProductsEx("",USERSIDEVERYONE,MSIINSTALLCONTEXT_ALL) If Err <> 0 Then CheckError "MsiClearOrphanedFiles (msi)" Else 'Fill a comma separated stringlist with all .msi files For Each Product in AllProducts sLocalMsi = "" : sLocalMsi = LCase(Product.InstallProperty("LocalPackage")) : CheckError "MsiClearOrphanedFiles (msi)" sMsiList = sMsiList & sLocalMsi & "," Next 'Product 'Delete all non referenced .msi files from %windir%\installer For Each File in Files sFName = "" : sFName = LCase(File.Path) If LCase(Right(sFName,4)) = ".msi" Then If Not InStr(sMsiList,sFName) > 0 Then 'While this is an orphaned file keep the scope of Office only If UCase(Right(ProductCode(File.Path),PRODLEN))=OFFICEID Then DeleteFile File.Path End If End If 'LCase(Right(sFName,4)) = ".msi" Next 'File End If 'Err=0 End Sub 'MsiClearOrphanedFiles '======================================================================================================= Sub RegWipe Dim Item, Name, Sku, key Dim hDefKey, sSubKeyName, sCurKey, value, sValue, sGuid Dim fkeep, fSystemComponent0, fPackages, fDisplayVersion Dim arrKeys, arrNames, arrTypes, arrMultiSzValues, arrMultiSzNewValues Dim arrTestNames, arrTestTypes Dim i, iLoopCnt, iPos Dim fDelReg Log vbCrLf & "Registry CleanUp" 'Wipe registry data 'User Profile settings Log " - User Policies" RegDeleteKey HKCU,"Software\Policies\Microsoft\Office\" & OVERSION & "\" If NOT fKeepUser Then RegDeleteKey HKCU,"Software\Microsoft\Office\" & OVERSION & "\" Log " - User Settings" End If 'fKeepUser 'Computer specific settings If (fRemoveAll AND NOT fC2rInstalled) OR (fRemoveAll AND fForce) Then Log " - Machine Settings" RegDeleteKey HKLM,"SOFTWARE\Microsoft\Office\" & OVERSION & "\" If fRemoveOse OR fForce Then RegDeleteKey HKLM,"SOFTWARE\Microsoft\Office Test\" RegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\Common\","LastAccessInstall", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\Common\","MID", False RegDeleteKey HKLM,"SOFTWARE\Microsoft\Office\Excel\Addins\Microsoft.PerformancePoint.Planning.Client.Excel\" RegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\InfoPath\Converters\Import\InfoPath.DesignerExcelImport\Versions\",OVERSION, False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\InfoPath\Converters\Import\InfoPath.DesignerWordImport\Versions\",OVERSION, False RegDeleteKey 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", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Run\","LobiServer", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Run\","BCSSync", False RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\Outlook\" End If RegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\Common\OffDiag\Location\",OVERSIONMAJOR, False RegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows NT\CurrentVersion\Terminal Server\Install\Software\Microsoft\Office\" & OVERSION & "\" RegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\Common\OffDiag\Location\",OVERSIONMAJOR, False RegDeleteKey HKLM,"SOFTWARE\Microsoft\OfficeCustomizeWizard\" & OVERSION & "\" RegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows NT\CurrentVersion\Terminal Server\Install\SOFTWARE\Microsoft\OfficeCustomizeWizard\" & OVERSION & "\" Select Case OVERSIONMAJOR Case "11" 'Jet_Replication sValue = "" If RegReadValue(HKCR,"CLSID\{CC2C83A6-9BE4-11D0-98E7-00C04FC2CAF5}\InprocServer32","SystemDB",sValue,"REG_SZ") Then If Len(sValue) > Len(sOInstallRoot) Then If LCase(Left(sValue,Len(sOInstallRoot))) = LCase(sOInstallRoot) Then RegDeleteKey HKCR,"CLSID\{CC2C83A6-9BE4-11D0-98E7-00C04FC2CAF5}\InprocServer32\" End If End If Case "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}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{42042206-2D85-11D3-8CFF-005004838597}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{993BE281-6695-4BA5-8A2A-7AACBFAAB69E}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{0006F045-0000-0000-C000-000000000046}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{C41662BB-1FA0-4CE0-8DC5-9B7F8279FF97}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{7CCA70DB-DE7A-4FB7-9B2B-52E2335A3B5A}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{506F4668-F13E-4AA1-BB04-B43203AB3CC0}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{D66DC78C-4F61-447F-942B-3FB6980118CF}", False RegDeleteKey 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}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{99FD978C-D287-4F50-827F-B2C658EDA8E7}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{AB5C5600-7E6E-4B06-9197-9ECEF74D31CC}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{920E6DB1-9907-4370-B3A0-BAFC03D81399}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{16F3DD56-1AF5-4347-846D-7C10C4192619}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{2916C86E-86A6-43FE-8112-43ABE6BF8DCC}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{72853161-30C5-4D22-B7F9-0BBC1D38A37E}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{6C467336-8281-4E60-8204-430CED96822D}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{2A541AE1-5BF6-4665-A8A3-CFA9672E4291}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{B5A7F190-DDA6-4420-B3BA-52453494E6CD}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{A449600E-1DC6-4232-B948-9BD794D62056}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{3D60EDA7-9AB4-4DA8-864C-D9B5F2E7281D}", False RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{387E725D-DC16-4D76-B310-2C93ED4752A0}", False RegDeleteKey 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 15 Case 16 Case Else End Select 'Win32Assemblies Log " - Win32Assemblies" If RegEnumKey(HKCR,"Installer\Win32Assemblies\",arrKeys) Then For Each Item in arrKeys If InStr(UCase(Item),OREF)>0 Then RegDeleteKey HKCR,"Installer\Win32Assemblies\"&Item & "\" Next 'Item End If 'RegEnumKey 'Groove blocks reinstall if it locates groove.exe over this key If RegKeyExists(HKCR,"GrooveFile\Shell\Open\Command\") Then sValue = "" RegReadValue HKCR,"GrooveFile\Shell\Open\Command\","",sValue,"REG_SZ" If InStr(sValue,"\"&OREF&"\")>0 Then RegDeleteKey HKCR,"GrooveFile\" End If 'RegKeyExists End If 'fRemoveAll Select Case OVERSIONMAJOR Case "11" For iLoopCnt = 1 to 3 Select Case iLoopCnt Case 1 'CIW - HKCU sSubKeyName = "Software\Microsoft\OfficeCustomizeWizard\" & OVERSION & "\RegKeyPaths\" hDefKey = HKCU Case 2 'CIW - HKLM sSubKeyName = "SOFTWARE\Microsoft\OfficeCustomizeWizard\" & OVERSION & "\RegKeyPaths\" hDefKey = HKLM Case 3 'Add/Remove Programs sSubKeyName = REG_ARP hDefKey = HKLM End Select If RegEnumKey(hDefKey,sSubKeyName,arrKeys) Then For Each Item in arrKeys 'OFFICEID id If Len(Item)>37 Then sGuid = UCase(Left(Item,38)) If Right(sGuid,PRODLEN)=OFFICEID Then If CheckDelete(sGuid) Then RegDeleteKey hDefKey, sSubKeyName & Item & "\" End If End If 'Right(Item,PRODLEN)=OFFICEID End If 'Len(Item)>37 Next 'Item If iLoopCnt < 3 Then If RegEnumValues(hDefKey,sSubKeyName,arrNames,arrTypes) Then i = 0 For Each Name in arrNames If RegReadValue(hDefKey,sSubKeyName,Name,sValue,arrTypes(i)) Then If sValue = sGuid Then RegDeleteValue hDefKey,sSubKeyName,Name, False End If i = i + 1 Next End If End If End If If 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 'iLoopCnt Case "12" 'Add/Remove Programs RegWipeARP Case "14" 'Add/Remove Programs RegWipeARP Case Else End Select 'UpgradeCodes, WI config, WI global config For iLoopCnt = 1 to 5 Select Case iLoopCnt Case 1 Log " - HKLM UpgradeCodes" sSubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UpgradeCodes\" hDefKey = HKLM Case 2 Log " - HKCR UpgradeCodes" sSubKeyName = "Installer\UpgradeCodes\" hDefKey = HKCR Case 3 Log " - HKLM Products" sSubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products\" hDefKey = HKLM Case 4 Log " - HKCR Features" sSubKeyName = "Installer\Features\" hDefKey = HKCR Case 5 Log " - HKCR Products" sSubKeyName = "Installer\Products\" hDefKey = HKCR Case Else sSubKeyName = "" hDefKey = "" End Select If RegEnumKey(hDefKey,sSubKeyName,arrKeys) Then For Each Item in arrKeys 'Ensure we have the expected length for a compressed GUID If Len(Item)=32 Then 'Expand the GUID sGuid = GetExpandedGuid(Item) 'Check if it's an Office key If CheckDeleteEx (sGuid) Then RegDeleteKey hDefKey,sSubKeyName & Item & "\" Else If iLoopCnt < 3 Then 'Enum all entries RegEnumValues hDefKey,sSubKeyName & Item,arrNames,arrTypes If IsArray(arrNames) Then 'Delete entries within removal scope For Each Name in arrNames If Len(Name)=32 Then sGuid = GetExpandedGuid(Name) If CheckDelete(sGuid) Then RegDeleteValue hDefKey, sSubKeyName & Item & "\", Name, True Else 'Invalid data -> delete the value RegDeleteValue hDefKey, sSubKeyName & Item & "\", Name, True End If Next 'Name End If 'IsArray(arrNames) 'If all entries were removed - delete the key RegEnumValues hDefKey,sSubKeyName & Item,arrNames,arrTypes If Not IsArray(arrNames) Then RegDeleteKey hDefKey, sSubKeyName & Item & "\" Else 'iLoopCnt >= 3 If CheckDelete(sGuid) Then RegDeleteKey hDefKey, sSubKeyName & Item & "\" End If 'iLoopCnt < 3 End If 'fRemoveAll End If 'Len(Item)=32 Next 'Item End If 'RegEnumKey Next 'iLoopCnt 'Components Log " - Global Components" sSubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components\" If RegEnumKey(HKLM,sSubKeyName,arrKeys) Then For Each Item in arrKeys 'Ensure we have the expected length for a compressed GUID If Len(Item)=32 Then If RegEnumValues(HKLM,sSubKeyName & Item,arrNames,arrTypes) Then If IsArray(arrNames) Then For Each Name in arrNames If Len(Name)=32 Then sGuid = GetExpandedGuid(Name) If CheckDelete(sGuid) Then RegDeleteValue HKLM, sSubKeyName & Item & "\", Name, False 'Check if the key is now empty If NOT RegEnumValues(HKLM,sSubKeyName & Item,arrTestNames,arrTestTypes) Then If NOT dicDelRegKey.Exists(sSubKeyName&Item&"\") Then dicDelRegKey.Add sSubKeyName&Item&"\",HKCR End If End If End If '32 Next 'Name End If 'IsArray End If 'RegEnumValues End If '32 Next 'Item End If 'RegEnumKey 'Published Components Log " - Published Components" sSubKeyName = "Installer\Components\" If RegEnumKey(HKCR,sSubKeyName,arrKeys) Then For Each Item in arrKeys 'Ensure we have the expected length for a compressed GUID If Len(Item)=32 Then If RegEnumValues(HKCR,sSubKeyName & Item,arrNames,arrTypes) Then If IsArray(arrNames) Then For Each Name in arrNames If RegReadValue (HKCR,sSubKeyName & Item, Name, sValue,"REG_MULTI_SZ") Then arrMultiSzValues = Split(sValue,chr(34)) If IsArray(arrMultiSzValues) Then i = -1 ReDim arrMultiSzNewValues(-1) fDelReg = False For Each value in arrMultiSzValues If Len(value) > 19 Then sGuid = "" If GetDecodedGuid(Left(value,SQUISHED),sGuid) Then If CheckDelete(sGuid) Then fDelReg = True Else i = i + 1 ReDim Preserve arrMultiSzNewValues(i) arrMultiSzNewValues(i) = value End If 'CheckDelete End If 'decode End If '19 Next 'Value If NOT (i = -1) Then If NOT fDetectOnly Then If NOT UBound(arrMultiSzValues) = i Then oReg.SetMultiStringValue HKCR,sSubKeyName & Item,Name,arrMultiSzNewValues End If Else If fDelReg Then RegDeleteValue HKCR,sSubKeyName & Item & "\", Name, False 'Check if the key is now empty If NOT RegEnumValues(HKCR,sSubKeyName & Item,arrTestNames,arrTestTypes) Then If NOT dicDelRegKey.Exists(sSubKeyName&Item&"\") Then dicDelRegKey.Add sSubKeyName&Item&"\",HKCR End If End If 'DelReg End If End If 'IsArray End If Next 'Name End If 'IsArray End If 'RegEnumValues End If '32 Next 'Item End If 'RegEnumKey 'Delivery Log " - Delivery" hDefKey = HKLM sSubKeyName = "SOFTWARE\Microsoft\Office\Delivery\SourceEngine\Downloads\" If RegEnumKey(HKLM,sSubKeyName,arrKeys) Then For Each Item in arrKeys If Len(Item) > 37 Then If fRemoveAll Then If (Mid(Item,27,PRODLEN)=OFFICEID AND Mid(Item,4,2)=OVERSIONMAJOR) OR _ LCase(Right(Item,7))=OVERSIONMAJOR&".data" Then RegDeleteKey HKLM,sSubKeyName & Item & "\" Else If (Mid(Item,27,PRODLEN)=OFFICEID AND Mid(Item,4,2)=OVERSIONMAJOR) AND _ CheckDelete(UCase(Left(Item,38))) Then RegDeleteKey HKLM,sSubKeyName & Item & "\" End If End If '37 Next 'Item End If 'RegEnumKey 'Registration Log " - HKLM Registration" hDefKey = HKLM sSubKeyName = "SOFTWARE\Microsoft\Office\"&OVERSION&"\Registration\" If RegEnumKey(HKLM,sSubKeyName,arrKeys) Then For Each Item in arrKeys If Len(Item)>37 Then If CheckDelete(UCase(Left(Item,38))) Then RegDeleteKey HKLM,sSubKeyName & Item & "\" End If Next 'Item End If 'RegEnumKey 'User Preconfigurations Log " - HKLM User Preconfigurations" hDefKey = HKLM sSubKeyName = "SOFTWARE\Microsoft\Office\"&OVERSION&"\User Settings\" If RegEnumKey(HKLM,sSubKeyName,arrKeys) Then For Each Item in arrKeys If Len(Item)>37 Then If CheckDelete(UCase(Left(Item,38))) Then RegDeleteKey HKLM,sSubKeyName & Item & "\" End If Next 'Item End If 'RegEnumKey 'Known Keypath settings Log " - Detcted KeyPath settings" For Each key in dicDelRegKey.Keys If Right(key,1) = "\" Then RegDeleteKey dicDelRegKey.Item(key),key Else iPos = InStrRev(Key,"\") If iPos > 0 Then RegDeleteValue dicDelRegKey.Item(key), Left(key,iPos - 1), Mid(key,iPos+1), False End If Next 'Temporary entries in ARP TmpKeyCleanUp End Sub 'RegWipe '======================================================================================================= 'Clean up Add/Remove Programs registry Sub RegWipeARP Dim Item, Name, Sku, key Dim sSubKeyName, sCurKey, sValue, sGuid Dim fkeep, fSystemComponent0, fPackages, fDisplayVersion Dim arrKeys 'Add/Remove Programs sSubKeyName = REG_ARP If RegEnumKey(HKLM,sSubKeyName,arrKeys) Then For Each Item in arrKeys '*0FF1CE* If Len(Item)>37 Then sGuid = UCase(Left(Item,38)) If CheckDeleteEx(sGuid) Then RegDeleteKey HKLM, sSubKeyName & Item End If 'Len(Item)>37 'Config entries sCurKey = 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 Then fDisplayVersion = (Left(sValue,2) = OVERSIONMAJOR) End If If (fSystemComponent0 AND fPackages AND fDisplayVersion) Then fKeep = False If Not fRemoveAll Then For Each Sku in dictinaryKeepSku.Keys If UCase(Item) = OREGREF & Sku Then fkeep = True Exit For End If Next 'Sku End If If Not fkeep Then RegDeleteKey HKLM, sSubKeyName & Item End If Next 'Item End If 'RegEnumKey End Sub 'RegWipeARP '======================================================================================================= 'Clean up temporary registry keys Sub TmpKeyCleanUp Dim TmpKey If fLogInitialized Then Log " - temporary OffScrub registry entries" If IsArray(arrTmpSKUs) Then For Each TmpKey in arrTmpSKUs oReg.DeleteKey HKLM, REG_ARP & TmpKey Next 'Item End If 'IsArray End Sub 'TmpKeyCleanUp '======================================================================================================= ' Helper Functions '======================================================================================================= 'Create a log with the results of the SKU detection Sub LogSkuResults Dim SkuLog, SkuKey , p On Error Resume Next 'Don't fail on logging Set SkuLog = oFso.OpenTextFile(sScrubDir & "\SkuLog.txt",FOR_WRITING,True,True) SkuLog.WriteLine "Installed SKUs (All):" SkuLog.WriteLine "=====================" For Each SkuKey in dicInstalledSku.Keys SkuLog.WriteLine " - " & SkuKey Next 'Key SkuLog.WriteLine vbCrLf & "Server SKUs:" SkuLog.WriteLine "============" For Each SkuKey in dicSrv.Keys SkuLog.WriteLine " - " & SkuKey Next 'Key SkuLog.WriteLine vbCrLf & "Client Suite SKUs:" SkuLog.WriteLine "==================" For Each SkuKey in dicCSuite.Keys SkuLog.WriteLine " - " & SkuKey Next 'Key SkuLog.WriteLine vbCrLf & "Client Standalone SKUs:" SkuLog.WriteLine "=======================" For Each SkuKey in dicCSingle.Keys SkuLog.WriteLine " - " & SkuKey Next 'Key SkuLog.WriteLine vbCrLf & "Installed Products (All):" SkuLog.WriteLine "=========================" For Each p in oMsi.Products If InScope(p) Then SkuLog.Write " - " & p & " - " SkuLog.Write oMsi.ProductInfo(p, "ProductName") SkuLog.WriteLine " " End If Next 'Product SkuLog.WriteLine vbCrLf & "***************************************************************************************************" & vbCrLf SkuLog.WriteLine vbCrLf & "SKUs to keep:" SkuLog.WriteLine "=============" For Each SkuKey in dictinaryKeepSku.Keys SkuLog.WriteLine " - " & SkuKey Next 'Key SkuLog.WriteLine vbCrLf & "Products to keep:" SkuLog.WriteLine "=================" For Each p in dictinaryKeepProd.Keys SkuLog.Write " - " & p & " - " SkuLog.Write oMsi.ProductInfo(p, "ProductName") SkuLog.WriteLine " " Next 'Key SkuLog.WriteLine vbCrLf & "***************************************************************************************************" & vbCrLf SkuLog.WriteLine vbCrLf & "SKUs to remove:" SkuLog.WriteLine "===============" For Each SkuKey in dicRemoveSku.Keys SkuLog.WriteLine " - " & SkuKey Next 'Key SkuLog.WriteLine vbCrLf & "Products to remove:" SkuLog.WriteLine "===================" For Each p in oMsi.Products If CheckDeleteEx(p) Then SkuLog.Write " - " & p & " - " SkuLog.Write oMsi.ProductInfo(p, "ProductName") SkuLog.WriteLine " " End If 'InScope Next 'Product SkuLog.Close Set SkuLog = Nothing End Sub 'LogSkuResults '======================================================================================================= 'End all running instances of applications that will be removed Sub CloseOfficeApps Dim Processes, Process, prop Dim fWait Dim iRet On Error Resume Next fWait = False Log " Doing Action: CloseOfficeApps" Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process") For Each Process in Processes If dicApps.Exists(LCase(Process.Name)) Then Log " - End process " & Process.Name iRet = Process.Terminate() CheckError "CloseOfficeApps: " & "Process.Name" Else For Each prop in Process.Properties_ If prop.Name = "ExecutablePath" Then If InStr(UCase(prop.Value), UCase(sOInstallRoot)) > 0 Then Log " - End process '" & Process.Name iRet = Process.Terminate() CheckError "CloseOfficeApps: " & "Process.Name" fWait = True End If End If 'ExcecutablePath Next 'prop End If Next 'Process If fWait Then wscript.sleep 10000 End If LogOnly " End Action: CloseOfficeApps" End Sub 'CloseOfficeApps '======================================================================================================= 'Ensure Windows Explorer is restarted if needed Sub RestoreExplorer Dim Processes, Result, oAT, DateTime, JobID Dim sCmd 'Non critical routine. Don't fail on error On Error Resume Next wscript.sleep 1000 Set 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 task If iVersionNT > 502 Then 'Vista and later oWShell.Run "SCHTASKS /Create /TN OffScrEx /TR explorer /SC ONCE /ST 12:00 /IT",0,True oWShell.Run "SCHTASKS /Run /TN OffScrEx", 0, True oWShell.Run "SCHTASKS /Delete /TN OffScrEx /F", 0, False Else Set oAT = oWmiLocal.Get("Win32_ScheduledJob") Set DateTime = CreateObject("WbemScripting.SWbemDateTime") DateTime.SetVarDate DateAdd("n",1,Now),True Result = oAT.Create("explorer.exe", DateTime.Value, , , , True, JobID) End If 'iVersionNT End If End Sub 'RestoreExploer '======================================================================================================= 'Returns the delimiter for a passed in string Function Delimiter (sVersion) Dim iCnt, iAsc Delimiter = " " 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 Function End If Next 'iCnt End Function '======================================================================================================= 'Check registry access permissions. Failure will terminate the script Function CheckRegPermissions Const KEY_QUERY_VALUE = &H0001 Const KEY_SET_VALUE = &H0002 Const KEY_CREATE_SUB_KEY = &H0004 Const DELETE = &H00010000 Dim sSubKeyName Dim fReturn CheckRegPermissions = True sSubKeyName = "Software\Microsoft\Windows\" oReg.CheckAccess HKLM, sSubKeyName, KEY_QUERY_VALUE, fReturn If Not fReturn Then CheckRegPermissions = False oReg.CheckAccess HKLM, sSubKeyName, KEY_SET_VALUE, fReturn If Not fReturn Then CheckRegPermissions = False oReg.CheckAccess HKLM, sSubKeyName, KEY_CREATE_SUB_KEY, fReturn If Not fReturn Then CheckRegPermissions = False oReg.CheckAccess HKLM, sSubKeyName, DELETE, fReturn If Not fReturn Then CheckRegPermissions = False End Function 'CheckRegPermissions '======================================================================================================= 'Check if a product will be removed Function CheckDeleteEx (sProductCode) CheckDeleteEx = False If CheckDelete (sProductCode) Then CheckDeleteEx = True Exit Function End If If (fRemoveAll AND NOT fC2rInstalled) OR (fRemoveAll AND fForce) Then CheckDeleteEx = InScope(sProductCode) AND NOT dictinaryKeepProd.Exists(UCase(sProductCode)) End If End Function 'CheckDelete '======================================================================================================= 'Check if an Office product is still registered with a SKU that stays on the computer Function CheckDelete (sProductCode) 'Ensure valid GUID length If NOT Len(sProductCode) = 38 Then CheckDelete = False Exit Function End If 'If it's a non Office ProductCode exit with false right away CheckDelete = InScope(sProductCode) If Not CheckDelete Then Exit Function If dictinaryKeepProd.Exists(UCase(sProductCode)) Then CheckDelete = False End Function 'CheckDelete '======================================================================================================= 'Check if ProductCode is in scope Function InScope(sProductCode) Dim fInScope Dim sProd fInScope = False If Len(sProductCode) = 38 Then sProd = UCase(sProductCode) Select Case OVERSIONMAJOR Case "11" If Right(sProd, PRODLEN) = OFFICEID Then fInScope = True Case "12" If Right(sProd, PRODLEN) = OFFICEID AND Mid(sProd, 4, 2) = OVERSIONMAJOR Then fInScope = True Case "14" If Right(sProd, PRODLEN) = OFFICEID AND Mid(sProd, 4, 2) = OVERSIONMAJOR Then fInScope = True Case "15", "16" If Right(sProd, PRODLEN) = OFFICEID AND Mid(sProd, 4, 2) = OVERSIONMAJOR Then Select Case Mid(sProd, 11, 4) Case "007E", "008F", "008C", "24E1", "237A" ' C2R products - keep them Case Else fInScope = True End Select End If Case Else End Select End If '38 InScope = fInScope End Function 'InScope '======================================================================================================= 'Register an orphaned .msi product as installed for MSI Sub MsiRegisterProduct (sMsiFile) Dim sDisplayVersion, sCurKey, sDisplayName, sLang, sProductCode, sTmpKey Dim iCnt 'Create a temporary keys to simulate an installed product sProductCode = "" sProductCode = GetMsiProductCode(sMsiFile) sDisplayVersion = GetMsiProductVersion(sMsiFile) If sDisplayVersion = "" Then sDisplayVersion = OVERSION & ".0000.0000" sDisplayName = GetMsiProductName(sMsiFile) If sDisplayName = "" Then sDisplayName = sProductCode Select Case OVERSIONMAJOR Case "9","10","11" sLang = CInt("&h" & Mid(sProductCode,6,4)) Case "12","14" sLang = CInt("&h" & Mid(sProductCode,16,4)) Case Else End Select For iCnt = 1 To 3 Select Case iCnt Case 1 sCurKey = REG_ARP & sProductCode oReg.CreateKey HKLM,sCurKey Case 2 sCurKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products\" & GetCompressedGuid(sProductCode) oReg.CreateKey HKLM,sCurKey oReg.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",sMsiFile Case 3 sCurKey = "Installer\Products\" & GetCompressedGuid(sProductCode) sTmpKey = sCurKey oReg.CreateKey HKCR,sCurKey oReg.SetDWordValue HKCR,sCurKey,"AdvertiseFlags",388 oReg.SetDWordValue HKCR,sCurKey,"Assignment",1 oReg.SetDWordValue HKCR,sCurKey,"AuthorizedLUAApp",0 oReg.SetStringValue HKCR,sCurKey,"Clients",":" oReg.SetDWordValue HKCR,sCurKey,"DeploymentFlags",3 oReg.SetDWordValue HKCR,sCurKey,"InstanceType",0 oReg.SetDWordValue HKCR,sCurKey,"Language",sLang oReg.SetStringValue HKCR,sCurKey,"PackageCode",GetMsiPackageCode(sMsiFile) oReg.SetStringValue HKCR,sCurKey,"ProductName",sDisplayName oReg.SetDWordValue HKCR,sCurKey,"VersionMinor",0 sCurKey = sTmpKey & "\SourceList" oReg.CreateKey HKCR,sCurKey oReg.SetExpandedStringValue HKCR,sCurKey,"LastUsedSource",sScrubDir oReg.SetStringValue HKCR,sCurKey,"PackageName",Mid(sMsiFile,InstrRev(sMsiFile,"\")+1) sCurKey = sTmpKey & "\SourceList\Media" oReg.CreateKey HKCR,sCurKey oReg.SetStringValue HKCR,sCurKey,"1",OREF & ";1" oReg.SetStringValue HKCR,sCurKey,"DiskPrompt",sDisplayName sCurKey = sTmpKey & "\SourceList\Net" oReg.CreateKey HKCR,sCurKey oReg.SetExpandedStringValue HKCR,sCurKey,"1",sScrubDir Case Else End Select If iCnt <3 Then oReg.SetStringValue HKLM,sCurKey,"Comments","" oReg.SetStringValue HKLM,sCurKey,"Contact","" oReg.SetStringValue HKLM,sCurKey,"DisplayName",sDisplayName oReg.SetStringValue HKLM,sCurKey,"DisplayVersion",sDisplayVersion oReg.SetDWordValue HKLM,sCurKey,"EstimatedSize",0 oReg.SetStringValue HKLM,sCurKey,"HelpLink","" oReg.SetStringValue HKLM,sCurKey,"HelpTelephone","" oReg.SetStringValue HKLM,sCurKey,"InstallDate","20100101" If f64 Then oReg.SetStringValue HKLM,sCurKey,"InstallLocation",sProgramFilesX86 Else oReg.SetStringValue HKLM,sCurKey,"InstallLocation",sProgramFiles End If oReg.SetStringValue HKLM,sCurKey,"InstallSource",sScrubDir oReg.SetDWordValue HKLM,sCurKey,"Language",sLang oReg.SetExpandedStringValue HKLM,sCurKey,"ModifyPath","MsiExec.exe /X" & sProductCode oReg.SetDWordValue HKLM,sCurKey,"NoModify",1 oReg.SetStringValue HKLM,sCurKey,"Publisher","Microsoft Corporation" oReg.SetStringValue HKLM,sCurKey,"Readme","" oReg.SetStringValue HKLM,sCurKey,"Size","" oReg.SetDWordValue HKLM,sCurKey,"SystemComponent",0 oReg.SetExpandedStringValue HKLM,sCurKey,"UninstallString","MsiExec.exe /X" & sProductCode oReg.SetStringValue HKLM,sCurKey,"URLInfoAbout","" oReg.SetStringValue HKLM,sCurKey,"URLUpdateInfo","" oReg.SetDWordValue HKLM,sCurKey,"Version",0 oReg.SetDWordValue HKLM,sCurKey,"VersionMajor",OVERSIONMAJOR oReg.SetDWordValue HKLM,sCurKey,"VersionMinor",0 oReg.SetDWordValue HKLM,sCurKey,"WindowsInstaller",1 End If '< 3 Next 'iCnt End 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 ProductCode Function GetMsiProductCode(sMsiFile) Dim MsiDb,Record Dim qView On Error Resume Next GetMsiProductCode = "" Set Record = Nothing Set MsiDb = oMsi.OpenDatabase(sMsiFile,MSIOPENDATABASEREADONLY) Set qView = MsiDb.OpenView("SELECT `Value` FROM Property WHERE `Property` = 'ProductCode'") qView.Execute Set Record = qView.Fetch GetMsiProductCode = Record.StringData(1) qView.Close End Function 'GetMsiProductCode '======================================================================================================= 'Obtain the ProductVersion from a .msi package 'The function will open the .msi database and query the 'Property' table to retrieve the ProductCode Function GetMsiProductVersion(sMsiFile) Dim MsiDb,Record Dim qView On Error Resume Next GetMsiProductVersion = "" Set Record = Nothing Set MsiDb = oMsi.OpenDatabase(sMsiFile,MSIOPENDATABASEREADONLY) Set qView = MsiDb.OpenView("SELECT `Value` FROM Property WHERE `Property` = 'ProductVersion'") qView.Execute Set Record = qView.Fetch GetMsiProductVersion = Record.StringData(1) qView.Close End Function 'GetMsiProductVersion '======================================================================================================= 'Obtain the ProductVersion from a .msi package 'The function will open the .msi database and query the 'Property' table to retrieve the ProductCode Function GetMsiProductName(sMsiFile) Dim MsiDb,Record Dim qView On Error Resume Next GetMsiProductName = "" Set Record = Nothing Set MsiDb = oMsi.OpenDatabase(sMsiFile,MSIOPENDATABASEREADONLY) Set qView = MsiDb.OpenView("SELECT `Value` FROM Property WHERE `Property` = 'ProductName'") qView.Execute Set Record = qView.Fetch GetMsiProductName = Record.StringData(1) qView.Close End Function 'GetMsiProductVersion '======================================================================================================= 'Obtain the PackageCode (GUID) from a .msi package 'The function will the .msi'S SummaryInformation stream Function GetMsiPackageCode(sMsiFile) On Error Resume Next Const PID_REVNUMBER = 9 GetMsiPackageCode = "" GetMsiPackageCode = GetCompressedGuid(oMsi.SummaryInformation(sMsiFile,MSIOPENDATABASEREADONLY).Property(PID_REVNUMBER)) End Function 'GetMsiPackageCode '======================================================================================================= 'Returns a string with a list of ProductCodes from the summary information stream Function MspTargets (sMspFile) Const MSIOPENDATABASEMODE_PATCHFILE = 32 Const PID_TEMPLATE = 7 Dim Msp 'Non critical routine. Don't fail on error On Error Resume Next MspTargets = "" If oFso.FileExists(sMspFile) Then Set 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 package Function ProductCode(sMsi) Const MSIUILEVELNONE = 2 'No UI Dim MsiSession On Error Resume Next 'Non critical routine. Don't fail on error If oFso.FileExists(sMsi) Then oMsi.UILevel = MSIUILEVELNONE Set MsiSession = oMsi.OpenPackage(sMsi,1) ProductCode = MsiSession.ProductProperty("ProductCode") Set MsiSession = Nothing Else ProductCode = "" End If 'oFso.FileExists(sMsi) End Function 'ProductCode '======================================================================================================= Function GetUpgradeCode(sGuid) 'Ensure Valid Length If NOT Len(sGuid) = 38 Then Exit Function GetUpgradeCode = "{00" & Mid(sGuid, 4, 2) & "0000-" & Mid(sGuid, 11, 4) & "-0000-" & Mid(sGuid, 21, 1) & "000-" & Mid(sGuid, 26, 1) & "000000FF1CE}" End Function 'GetUpgradeCode '======================================================================================================= Function GetExpandedGuid (sGuid) Dim i 'Ensure valid length If NOT Len(sGuid) = 32 Then Exit Function GetExpandedGuid = "{" & 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 If Next GetExpandedGuid = 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 If Next GetExpandedGuid = GetExpandedGuid & "}" End Function '======================================================================================================= 'Converts a GUID into the compressed format Function GetCompressedGuid (sGuid) Dim sCompGUID Dim i 'Ensure Valid Length If NOT Len(sGuid) = 38 Then Exit Function sCompGUID = 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 If Next For 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 If Next GetCompressedGuid = sCompGUID End Function '======================================================================================================= 'Unsquish GUID Function GetDecodedGuid(sEncGuid, sGuid) Dim sDecode, sTable, sHex, iChr Dim arrTable Dim i, iAsc, pow85, decChar Dim lTotal Dim fFailed fFailed = False sTable = "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 = 1 For i = 0 To 19 fFailed = True If i Mod 5 = 0 Then lTotal = 0 : pow85 = 1 End If ' i Mod 5 = 0 iAsc = Asc(Mid(sEncGuid,i+1,1)) sHex = arrTable(iAsc) If iAsc >=128 Then Exit For If sHex = "0xff" Then Exit For iChr = CInt("&h"&Right(sHex,2)) lTotal = lTotal + (iChr * pow85) If i Mod 5 = 4 Then sDecode = sDecode & DecToHex(lTotal) pow85 = pow85 * 85 fFailed = False Next 'i If 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 fFailed End Function 'GetDecodedGuid '======================================================================================================= 'Convert a long decimal to hex Function DecToHex(lDec) Dim sHex Dim iLen Dim lVal, lExp Dim arrChr arrChr = Array("0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F") sHex = "" lVal = lDec lExp = 16^10 While lExp >= 1 If lVal >= lExp Then sHex = sHex & arrChr(Int(lVal / lExp)) lVal = lVal - lExp * Int(lVal / lExp) Else sHex = sHex & "0" If sHex = "0" Then sHex = "" End If lExp = lExp / 16 Wend iLen = 8 - Len(sHex) If iLen > 0 Then sHex = String(iLen,"0") & sHex DecToHex = sHex End Function '======================================================================================================= 'Ensures that only valid metadata entries exist to avoid API failures Sub EnsureValidWIMetadata (hDefKey,sKey,iValidLength) Dim arrKeys Dim SubKey If Len(sKey) > 1 Then If Right(sKey,1) = "\" Then sKey = Left(sKey,Len(sKey)-1) End If If RegEnumKey(hDefKey,sKey,arrKeys) Then For Each SubKey in arrKeys If NOT Len(SubKey) = iValidLength Then RegDeleteKey hDefKey,sKey & "\" & SubKey & "\" End If Next 'SubKey End If End Sub 'EnsureValidWIMetadata '======================================================================================================= '------------------------------------------------------------------------------- ' CleanOSPP ' ' Clean out licenses from the Office Software Protection Platform '------------------------------------------------------------------------------- Sub CleanOSPP Dim oProductInstances, pi Dim sCleanOSPP, sCmd, sRetVal CONST OfficeAppId = "0ff1ce15-a989-479d-af46-f275c6370663" 'Office 2013/2016 sCleanOSPP = "x64\CleanOSPP.exe" If Not f64 Then sCleanOSPP = "x86\CleanOSPP.exe" If oFso.FileExists(sScriptDir & sCleanOSPP) Then sCmd = sScriptDir & sCleanOSPP Log " Running: " & sCmd On Error Resume Next sRetVal = oWShell.Run(sCmd, 0, True) Log " Return value: " & sRetVal On Error Goto 0 Exit Sub End If On Error Resume Next ' Initialize the software protection platform object with a filter on Office 2013/2016 products If iVersionNT > 601 Then Set oProductInstances = oWmiLocal.ExecQuery("SELECT ID, ApplicationId, PartialProductKey, Name, ProductKeyID FROM SoftwareLicensingProduct WHERE ApplicationId = '" & OfficeAppId & "' " & "AND PartialProductKey <> NULL") Else Set oProductInstances = oWmiLocal.ExecQuery("SELECT ID, ApplicationId, PartialProductKey, Name, ProductKeyID FROM OfficeSoftwareProtectionProduct WHERE ApplicationId = '" & OfficeAppId & "' " & "AND PartialProductKey <> NULL") End If ' Remove all licenses For Each pi in oProductInstances If NOT IsNull(pi) Then pi.UninstallProductKey( pi.ProductKeyID) End If Next 'pi End Sub 'CleanOSPP '======================================================================================================= 'Create a backup copy of the file in the ScrubDir then delete the file Sub CopyAndDeleteFile(sFile) Dim File 'Error handling inlined On Error Resume Next If oFso.FileExists(sFile) Then Set File = oFso.GetFile(sFile) If Not oFso.FolderExists(sScrubDir & "\" & File.ParentFolder.Name) Then oFso.CreateFolder sScrubDir & "\" & File.ParentFolder.Name If Not fDetectOnly Then LogOnly " - Backing up file: " & sFile oFso.CopyFile sFile,sScrubDir & "\" & File.ParentFolder.Name & "\" & File.Name,True : CheckError "CopyAndDeleteFile" Set File = Nothing DeleteFile(sFile) Else LogOnly " - Simulate CopyAndDelete file: " & sFile End If End If 'oFso.FileExists End Sub 'CopyAndDeleteFile '======================================================================================================= 'Wrapper to delete a file Sub DeleteFile(sFile) Dim File Dim sFileName, sNewPath On Error Resume Next If dictinaryKeepFolder.Exists(LCase(sFile)) Then If NOT fForce Then LogOnly " - Disallowing the delete of still required keypath element: " & sFile Exit Sub Else LogOnly " - Enforced delete of still required keypath element: " & sFile LogOnly " Remaining applications will need a repair!" End If End If If f64 Then If dictinaryKeepFolder.Exists(LCase(Wow64Folder(sFile))) Then If NOT fForce Then LogOnly " - Disallowing the delete of still required keypath element: " & sFile Exit Sub Else LogOnly " - Enforced delete of still required keypath element: " & sFile LogOnly " Remaining applications will need a repair!" End If End If End If If oFso.FileExists(sFile) Then LogOnly " - Delete file: " & sFile If Not fDetectOnly Then oFso.DeleteFile sFile,True If Err <> 0 Then CheckError "DeleteFile" If fForce Then 'Try to move the file and delete from there Set File = oFso.GetFile(sFile) sFileName = File.Name sNewPath = sScrubDir & "\ScrubTmp" Set File = Nothing If Not oFso.FolderExists(sNewPath) Then oFso.CreateFolder(sNewPath) 'Move the file LogOnly " - Move file to: " & sNewPath & "\" & sFileName oFso.MoveFile sFile,sNewPath & "\" & sFileName If Err <> 0 Then CheckError "DeleteFile (move)" End If 'Err <> 0 Else fRebootRequired = True End If 'fForce End If 'Err <> 0 End If 'oFso.FileExists End Sub 'DeleteFile '======================================================================================================= '64 bit aware wrapper to return the requested folder Function GetFolderPath(sPath) GetFolderPath = True If oFso.FolderExists(sPath) Then Exit Function If f64 AND oFso.FolderExists(Wow64Folder(sPath)) Then sPath = Wow64Folder(sPath) Exit Function End If GetFolderPath = False End Function 'GetFolderPath '======================================================================================================= 'Enumerates subfolder names of a folder and returns True if subfolders exist Function EnumFolderNames (sFolder, arrSubFolders) Dim Folder, Subfolder Dim sSubFolders If oFso.FolderExists(sFolder) Then Set Folder = oFso.GetFolder(sFolder) For Each Subfolder in Folder.Subfolders sSubFolders = sSubFolders & Subfolder.Name & "," Next 'Subfolder End If If f64 AND oFso.FolderExists(Wow64Folder(sFolder)) Then Set Folder = oFso.GetFolder(Wow64Folder(sFolder)) For Each Subfolder in Folder.Subfolders sSubFolders = sSubFolders & Subfolder.Name & "," Next 'Subfolder End If If Len(sSubFolders)>0 Then arrSubFolders = RemoveDuplicates(Split(Left(sSubFolders,Len(sSubFolders)-1),",")) EnumFolderNames = Len(sSubFolders)>0 End Function 'EnumFolderNames '======================================================================================================= 'Enumerates subfolders of a folder and returns True if subfolders exist Function EnumFolders (sFolder, arrSubFolders) Dim Folder, Subfolder Dim sSubFolders If oFso.FolderExists(sFolder) Then Set Folder = oFso.GetFolder(sFolder) For Each Subfolder in Folder.Subfolders sSubFolders = sSubFolders & Subfolder.Path & "," Next 'Subfolder End If If f64 AND oFso.FolderExists(Wow64Folder(sFolder)) Then Set Folder = oFso.GetFolder(Wow64Folder(sFolder)) For Each Subfolder in Folder.Subfolders sSubFolders = sSubFolders & Subfolder.Path & "," Next 'Subfolder End If If Len(sSubFolders)>0 Then arrSubFolders = RemoveDuplicates(Split(Left(sSubFolders,Len(sSubFolders)-1),",")) EnumFolders = Len(sSubFolders)>0 End Function 'EnumFolders '======================================================================================================= Sub GetMseFolderStructure (Folder) Dim SubFolder For Each SubFolder in Folder.SubFolders ReDim Preserve arrMseFolders(UBound(arrMseFolders)+1) arrMseFolders(UBound(arrMseFolders)) = SubFolder.Path GetMseFolderStructure SubFolder Next 'SubFolder End Sub 'GetMseFolderStructure '======================================================================================================= 'Wrapper to delete a folder Sub DeleteFolder(sFolder) Dim Folder Dim sDelFolder, sFolderName, sNewPath 'Ensure trailing "\" sFolder = sFolder & "\" While InStr(sFolder,"\\")>0 sFolder = Replace(sFolder,"\\","\") Wend If dictinaryKeepFolder.Exists(LCase(sFolder)) Then If NOT fForce Then LogOnly " - Disallowing the delete of still required keypath element: " & sFolder Exit Sub Else LogOnly " - Enforced delete of still required keypath element: " & sFolder LogOnly " Remaining applications will need a repair!" End If End If If f64 Then If dictinaryKeepFolder.Exists(LCase(Wow64Folder(sFolder))) Then If NOT fForce Then LogOnly " - Disallowing the delete of still required keypath element: " & sFolder Exit Sub Else LogOnly " - Enforced delete of still required keypath element: " & sFolder LogOnly " Remaining applications will need a repair!" End If End If End If 'Strip trailing "\" If Len(sFolder) > 1 Then sFolder = Left(sFolder,Len(sFolder)-1) End If On Error Resume Next If oFso.FolderExists(sFolder) Then sDelFolder = sFolder ElseIf f64 AND oFso.FolderExists(Wow64Folder(sFolder)) Then sDelFolder = Wow64Folder(sFolder) Else Exit Sub End If If Not fDetectOnly Then LogOnly " - Delete folder: " & sDelFolder oFso.DeleteFolder sDelFolder,True Else LogOnly " - Simulate delete folder: " & sDelFolder End If If Err <> 0 Then CheckError "DeleteFolder" 'Try to move the folder and delete from there Set Folder = oFso.GetFolder(sDelFolder) sFolderName = Folder.Name sNewPath = sScrubDir & "\ScrubTmp" Set Folder = Nothing 'Ensure we stay within the same drive If Not oFso.FolderExists(sNewPath) Then oFso.CreateFolder(sNewPath) 'Move the folder LogOnly " - Moving folder to: " & sNewPath & "\" & sFolderName oFso.MoveFolder sFolder,sNewPath & "\" & sFolderName If Err <> 0 Then CheckError "DeleteFolder (move)" End If 'Err <> 0 End If 'Err <> 0 End Sub 'DeleteFolder '======================================================================================================= 'Delete empty folder structures Sub DeleteEmptyFolders Dim Folder Dim sFolder ' cosmetic' task don't fail on error On Error Resume Next If Not IsArray(arrDeleteFolders) Then Exit Sub Log vbCrLf & "Empty Folder Cleanup" For Each sFolder in arrDeleteFolders If oFso.FolderExists(sFolder) Then Set Folder = oFso.GetFolder(sFolder) If CBool(Folder.Attributes AND 1024) Then 'exclude protected folder Else If (Folder.Subfolders.Count = 0) AND (Folder.Files.Count = 0) Then Set Folder = Nothing SmartDeleteFolder sFolder End If End If End If Next 'sFolder CheckError "DeleteEmptyFolders" On Error Goto 0 End Sub 'DeleteEmptyFolders '======================================================================================================= 'Delete indivdual empty folder structures Sub DeleteEmptyFolder (sFolder) Dim Folder ' cosmetic' task don't fail on error On Error Resume Next If oFso.FolderExists(sFolder) Then Set Folder = oFso.GetFolder(sFolder) If CBool(Folder.Attributes AND 1024) Then 'exclude protected folder Else If (Folder.Subfolders.Count = 0) AND (Folder.Files.Count = 0) Then Set Folder = Nothing SmartDeleteFolder sFolder End If End If End If CheckError "DeleteEmptyFolder" On Error Goto 0 End Sub 'DeleteEmptyFolder '======================================================================================================= 'Wrapper to delete a folder and remove the empty parent folder structure Sub SmartDeleteFolder(sFolder) If oFso.FolderExists(sFolder) Then If Not fDetectOnly Then LogOnly " Request SmartDelete for folder: " & sFolder SmartDeleteFolderEx sFolder Else LogOnly " Simulate request SmartDelete for folder: " & sFolder End If End If If f64 AND oFso.FolderExists(Wow64Folder(sFolder)) Then If Not fDetectOnly Then LogOnly "Request SmartDelete for folder: " & Wow64Folder(sFolder) SmartDeleteFolderEx Wow64Folder(sFolder) Else LogOnly "Simulate request SmartDelete for folder: " & Wow64Folder(sFolder) End If End If End Sub 'SmartDeleteFolder '======================================================================================================= 'Executes the folder delete operation Sub SmartDeleteFolderEx(sFolder) Dim Folder On Error Resume Next DeleteFolder sFolder : CheckError "SmartDeleteFolderEx" On Error Goto 0 Set 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' dictionary Sub AddKeepFolder(sPath) Dim Folder 'Ensure trailing "\" sPath = LCase(sPath) & "\" While InStr(sPath,"\\")>0 sPath = Replace(sPath,"\\","\") Wend If NOT dictinaryKeepFolder.Exists (sPath) Then dictinaryKeepFolder.Add sPath,sPath Else Exit Sub End If sPath = LCase(oFso.GetParentFolderName(sPath)) & "\" If oFso.FolderExists(sPath) Then AddKeepFolder(sPath) End Sub '======================================================================================================= 'Handles additional folder-path operations on 64 bit environments Function 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)) Else Wow64Folder = "?" 'Return invalid string to ensure the folder cannot exist End If End Function 'Wow64Folder '======================================================================================================= Function HiveString(hDefKey) On Error Resume Next Select Case hDefKey Case 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 = hDefKey End Select End Function '======================================================================================================= Function RegKeyExists(hDefKey,sSubKeyName) Dim arrKeys RegKeyExists = False If oReg.EnumKey(hDefKey,sSubKeyName,arrKeys) = 0 Then RegKeyExists = True End Function '======================================================================================================= Function RegValExists(hDefKey,sSubKeyName,sName) Dim arrValueTypes, arrValueNames Dim i RegValExists = False If Not RegKeyExists(hDefKey,sSubKeyName) Then Exit Function If sName = "" Then RegValExists = True Exit Function End If If oReg.EnumValues(hDefKey,sSubKeyName,arrValueNames,arrValueTypes) = 0 AND IsArray(arrValueNames) Then For i = 0 To UBound(arrValueNames) If LCase(arrValueNames(i)) = Trim(LCase(sName)) Then RegValExists = True Next End If 'oReg.EnumValues End Function '======================================================================================================= 'Read the value of a given registry entry Function RegReadValue(hDefKey, sSubKeyName, sName, sValue, sType) Dim RetVal Dim Item Dim arrValues Select 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 If Case "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 Else RetVal = -1 End Select 'sValue RegReadValue = (RetVal = 0) End Function 'RegReadValue '======================================================================================================= 'Enumerate a registry key to return all values Function RegEnumValues(hDefKey,sSubKeyName,arrNames, arrTypes) Dim RetVal, RetVal64 Dim arrNames32, arrNames64, arrTypes32, arrTypes64 If f64 Then RetVal = 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 = arrNames32 arrTypes = arrTypes32 End If If (Not RetVal = 0) AND (RetVal64 = 0) AND IsArray(arrNames64) AND IsArray(arrTypes64) Then arrNames = arrNames64 arrTypes = arrTypes64 End If If (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 If Else RetVal = oReg.EnumValues(hDefKey,sSubKeyName,arrNames,arrTypes) End If 'f64 RegEnumValues = ((RetVal = 0) OR (RetVal64 = 0)) AND IsArray(arrNames) AND IsArray(arrTypes) End Function 'RegEnumValues '======================================================================================================= 'Enumerate a registry key to return all subkeys Function RegEnumKey(hDefKey,sSubKeyName,arrKeys) Dim RetVal, RetVal64 Dim arrKeys32, arrKeys64 If f64 Then RetVal = 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 = arrKeys32 If (Not RetVal = 0) AND (RetVal64 = 0) AND IsArray(arrKeys64) Then arrKeys = arrKeys64 If (RetVal = 0) AND (RetVal64 = 0) Then If IsArray(arrKeys32) AND IsArray (arrKeys64) Then arrKeys = RemoveDuplicates(Split((Join(arrKeys32,"\") & "\" & Join(arrKeys64,"\")),"\")) ElseIf IsArray(arrKeys64) Then arrKeys = arrKeys64 Else arrKeys = arrKeys32 End If End If Else RetVal = oReg.EnumKey(hDefKey,sSubKeyName,arrKeys) End If 'f64 RegEnumKey = ((RetVal = 0) OR (RetVal64 = 0)) AND IsArray(arrKeys) End Function 'RegEnumKey '======================================================================================================= 'Wrapper around oReg.DeleteValue to handle 64 bit Sub RegDeleteValue(hDefKey, sSubKeyName, sName, fRegMultiSZ) Dim sWow64Key,sRealName Dim iRetVal sRealName = sName If UCase(sName) = "(DEFAULT)" Then sRealName = "" If dictinaryKeepReg.Exists(LCase(sSubKeyName & sName)) Then If NOT fForce Then LogOnly " - Disallowing the delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyName & sName Exit Sub Else LogOnly " - Enforced delete of still required keypath element. Remaining applications will need a repair!" End If End If If f64 Then If dictinaryKeepReg.Exists(LCase(Wow64Key(hDefKey, sSubKeyName) & sName)) Then If NOT fForce Then LogOnly " - Disallowing the delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyName & sName Exit Sub Else LogOnly " - Enforced delete of still required keypath element. Remaining applications will need a repair!" End If End If End If If RegValExists(hDefKey,sSubKeyName,sRealName) Then On Error Resume Next If RegReadValue(hDefKey,sSubKeyName,sName,sValue,"REG_MULTI_SZ") Then LogOnly " - Disallowing unsafe delete of REG_MULTI_SZ: " & HiveString(hDefKey) & "\" & sSubKeyName & sName Exit Sub End If If Not fDetectOnly Then LogOnly " - Delete registry value: " & HiveString(hDefKey) & "\" & sSubKeyName & " -> " & sName iRetVal = 0 iRetVal = oReg.DeleteValue(hDefKey, sSubKeyName, sRealName) CheckError "RegDeleteValue" If NOT (iRetVal=0) Then LogOnly " Delete failed. Return value: "&iRetVal Else LogOnly " - Simulate delete registry value: " & HiveString(hDefKey) & "\" & sSubKeyName & " -> " & sName End If On Error Goto 0 End If 'RegValExists If f64 Then sWow64Key = Wow64Key(hDefKey, sSubKeyName) If RegValExists(hDefKey,sWow64Key,sRealName) Then On Error Resume Next If RegReadValue(hDefKey,sSubKeyName,sName,sValue,"REG_MULTI_SZ") Then LogOnly " - Disallowing unsafe delete of REG_MULTI_SZ: " & HiveString(hDefKey) & "\" & sSubKeyName & sName Exit Sub End If If Not fDetectOnly Then LogOnly " - Delete registry value: " & HiveString(hDefKey) & "\" & sWow64Key & " -> " & sName iRetVal = 0 iRetVal = oReg.DeleteValue(hDefKey, sWow64Key, sRealName) CheckError "RegDeleteValue" If NOT (iRetVal=0) Then LogOnly " Delete failed. Return value: "&iRetVal Else LogOnly " - Simulate delete registry value: " & HiveString(hDefKey) & "\" & sWow64Key & " -> " & sName End If On Error Goto 0 End If 'RegKeyExists End If End Sub 'RegDeleteValue '======================================================================================================= 'Wrappper around RegDeleteKeyEx to handle 64bit scenrios Sub RegDeleteKey(hDefKey, sSubKeyName) Dim sWow64Key 'Ensure trailing "\" sSubKeyName = sSubKeyName & "\" While InStr(sSubKeyName,"\\")>0 sSubKeyName = Replace(sSubKeyName,"\\","\") Wend If dictinaryKeepReg.Exists(LCase(sSubKeyName)) Then If NOT fForce Then LogOnly " - Disallowing the delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyName Exit Sub Else LogOnly " - Enforced delete of still required keypath element. Remaining applications will need a repair!" End If End If If f64 Then If dictinaryKeepReg.Exists(LCase(Wow64Key(hDefKey, sSubKeyName))) Then If NOT fForce Then LogOnly " - Disallowing the delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyName Exit Sub Else LogOnly " - Enforced delete of still required keypath element. Remaining applications will need a repair!" End If End If End If If Len(sSubKeyName) > 1 Then 'Strip of trailing "\" sSubKeyName = Left(sSubKeyName,Len(sSubKeyName)-1) End If If RegKeyExists(hDefKey, sSubKeyName) Then If Not fDetectOnly Then LogOnly " - Delete registry key: " & HiveString(hDefKey) & "\" & sSubKeyName On Error Resume Next RegDeleteKeyEx hDefKey, sSubKeyName On Error Goto 0 Else LogOnly " - Simulate delete registry key: " & HiveString(hDefKey) & "\" & sSubKeyName End If End If 'RegKeyExists If f64 Then sWow64Key = Wow64Key(hDefKey, sSubKeyName) If RegKeyExists(hDefKey,sWow64Key) Then If Not fDetectOnly Then LogOnly " - Delete registry key: " & HiveString(hDefKey) & "\" & sWow64Key On Error Resume Next RegDeleteKeyEx hDefKey, sWow64Key On Error Goto 0 Else LogOnly " - Simulate delete registry key: " & HiveString(hDefKey) & "\" & sWow64Key End If End If 'RegKeyExists End If End Sub 'RegDeleteKey '======================================================================================================= 'Recursively delete a registry structure Sub RegDeleteKeyEx(hDefKey, sSubKeyName) Dim arrSubkeys Dim sSubkey Dim iRetVal On Error Resume Next oReg.EnumKey hDefKey, sSubKeyName, arrSubkeys If IsArray(arrSubkeys) Then For Each sSubkey In arrSubkeys RegDeleteKeyEx hDefKey, sSubKeyName & "\" & sSubkey Next End If If Not fDetectOnly Then iRetVal = 0 iRetVal = oReg.DeleteKey(hDefKey,sSubKeyName) If NOT (iRetVal=0) Then LogOnly " Delete failed. Return value: "&iRetVal End If End Sub 'RegDeleteKeyEx '======================================================================================================= 'Return the alternate regkey location on 64bit environment Function Wow64Key(hDefKey, sSubKeyName) Dim iPos Select Case hDefKey Case HKCU If Left(sSubKeyName,17) = "Software\Classes\" Then Wow64Key = Left(sSubKeyName,17) & "Wow6432Node\" & Right(sSubKeyName,Len(sSubKeyName)-17) Else iPos = InStr(sSubKeyName,"\") Wow64Key = Left(sSubKeyName,iPos) & "Wow6432Node\" & Right(sSubKeyName,Len(sSubKeyName)-iPos) End If Case HKLM If Left(sSubKeyName,17) = "Software\Classes\" Then Wow64Key = Left(sSubKeyName,17) & "Wow6432Node\" & Right(sSubKeyName,Len(sSubKeyName)-17) Else iPos = InStr(sSubKeyName,"\") Wow64Key = Left(sSubKeyName,iPos) & "Wow6432Node\" & Right(sSubKeyName,Len(sSubKeyName)-iPos) End If Case Else Wow64Key = "Wow6432Node\" & sSubKeyName End Select 'hDefKey End Function 'Wow64Key '======================================================================================================= 'Remove duplicate entries from a one dimensional array Function RemoveDuplicates(Array) Dim Item Dim oDic Set oDic = CreateObject("Scripting.Dictionary") For Each Item in Array If Not oDic.Exists(Item) Then oDic.Add Item,Item Next 'Item RemoveDuplicates = oDic.Keys End Function 'RemoveDuplicates '======================================================================================================= 'End running instances of setup Sub EndCurrentInstalls () Dim Processes, Process Dim iRet Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name like '%setup%' OR Name like '%install%'") For Each Process in Processes Log " - End process " & Process.Name iRet = Process.Terminate() CheckError "EndCurrentInstalls: " & "Process.Name" Next 'Process StopService "msiserver" End Sub 'EndCurrentInstalls '======================================================================================================= 'Uses WMI to stop a service Function StopService(sService) Dim Services, Service Dim sQuery Dim iRet On Error Resume Next iRet = 0 sQuery = "Select * From Win32_Service Where Name='" & sService & "'" Set Services = oWmiLocal.Execquery(sQuery) 'Stop the service For Each Service in Services If UCase(Service.State) = "STARTED" Then iRet = Service.StopService If UCase(Service.State) = "RUNNING" Then iRet = Service.StopService Next 'Service StopService = (iRet = 0) End Function 'StopService '======================================================================================================= 'Delete a service Sub DeleteService(sService) Dim Services, Service, Processes, Process Dim sQuery, sStates Dim iRet On Error Resume Next sStates = "STARTED;RUNNING" sQuery = "Select * From Win32_Service Where Name='" & sService & "'" Set Services = oWmiLocal.Execquery(sQuery) 'Stop and delete the service For Each Service in Services Log " Found service " & sService & " in state " & Service.State If InStr(sStates,UCase(Service.State))>0 Then iRet = Service.StopService() 'Ensure no more instances of the service are running Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name='" & sService & ".exe'") For Each Process in Processes iRet = Process.Terminate() Next 'Process If Not fDetectOnly Then Log " - Deleting Service -> " & sService iRet = Service.Delete() Else Log " - Simulate deleting Service -> " & sService End If Next 'Service Set Services = Nothing Err.Clear End Sub 'DeleteService '======================================================================================================= 'Translation for setup.exe error codes Function SetupRetVal(RetVal) Select Case RetVal Case 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 values Case 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 Select End Function 'SetupRetVal '======================================================================================================= Function GetProductID(sProdID) Dim sReturn Select Case sProdId Case "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 "0038" : sReturn = "OlTimeZoneTool" 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 Connector Case "007C" : sReturn = "OSCFB" 'Outlook Social Connector for FaceBook Case "007D" : sReturn = "OSCWL" 'Outlook Social Connector for Windows Live Messenger Case "007F" : sReturn = "OLC" 'Outlook Social Connector Case "008A" : sReturn = "RecentDocs" Case "008B" : sReturn = "SmallBusinessBasics" Case "00A1" : sReturn = "ONENOTE" Case "00A3" : sReturn = "OneNoteHomeStudent" Case "00A4" : sReturn = "OWC11" 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 Components Case Else : sReturn = sProdID End Select 'sProdId GetProductID = sReturn End Function 'GetProductID '======================================================================================================= Sub Log (sLog) If NOT fQuiet AND fCScript Then Var="1"'wscript.echo sLog LogStream.WriteLine sLog End Sub 'Log '======================================================================================================= Sub LogOnly (sLog) LogStream.WriteLine sLog End Sub 'Log '======================================================================================================= Sub CheckError(sModule) If Err <> 0 Then LogOnly " " & Now & " - " & sModule & " - Source: " & Err.Source & "; Err# (Hex): " & Hex( Err ) & _ "; Err# (Dec): " & Err & "; Description : " & Err.Description End If 'Err = 0 Err.Clear End Sub '======================================================================================================= 'Command line parser Sub ParseCmdLine Dim iCnt, iArgCnt Dim arrArguments Dim sArg0 iArgCnt = Wscript.Arguments.Count If iArgCnt > 1 Then If wscript.Arguments(1) = "UAC" Then If wscript.arguments.count = 2 Then iArgCnt = 0 End If End If If iArgCnt = 0 Then If sDefault = "" Then 'Create the log CreateLog Log "No argument specified. Preparing user prompt" & vbCrLf FindInstalledOProducts If 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 cancelled Log "User cancelled. CleanUp & Exit." 'Undo temporary entries created in ARP TmpKeyCleanUp wscript.quit 1602 End If 'IsEmpty(sDefault) Log "Answer from prompt: " & sDefault & vbCrLf End If sDefault = Trim(UCase(Trim(Replace(sDefault,Chr(34),"")))) arrArguments = Split(Trim(sDefault)," ") If UBound(arrArguments) = -1 Then ReDim arrArguments(0) Else ReDim arrArguments(iArgCnt-1) For iCnt = 0 To (iArgCnt-1) arrArguments(iCnt) = UCase(Wscript.Arguments(iCnt)) Next 'iCnt End If 'iArgCnt = 0 'Handle the SKU list sArg0 = Replace(arrArguments(0),"/","") If Left(sArg0,1) = "-" Then sArg0 = Mid(sArg0,2) Select Case UCase(sArg0) Case "?" ShowSyntax Case "ALL" fRemoveAll = True fRemoveOse = False Case "CLIENTSUITES" fRemoveCSuites = True fRemoveOse = False Case "CLIENTSTANDALONE" fRemoveCSingle = True fRemoveOse = False Case "CLIENTALL" fRemoveCSuites = True fRemoveCSingle = True fRemoveOse = False Case "SERVER" fRemoveSrv = True fRemoveOse = False Case "ALL,OSE" fRemoveAll = True fRemoveOse = True Case Else fRemoveAll = False fRemoveOse = False sSkuRemoveList = sArg0 End Select For iCnt = 0 To UBound(arrArguments) Select Case arrArguments(iCnt) Case "?","/?","-?" ShowSyntax Case "/B","/BYPASS" If UBound(arrArguments) > iCnt Then If InStr(arrArguments(iCnt + 1), "1") > 0 Then fBypass_Stage1 = True If InStr(arrArguments(iCnt + 1), "2") > 0 Then fBypass_Stage2 = True If InStr(arrArguments(iCnt + 1), "3") > 0 Then fBypass_Stage3 = True If InStr(arrArguments(iCnt + 1), "4") > 0 Then fBypass_Stage4 = True End If Case "/D","/DELETEUSERSETTINGS" fKeepUser = False Case "/FR","/FASTREMOVE" fBypass_Stage1 = True fSkipSD = True Case "/F","/FORCE" fForce = True Case "/K","/KEEPUSERSETTINGS" fKeepUser = True Case "/KEEPSG", "/KEEPSOFTGRID" fKeepSG = True Case "/KEEPLYNC" fRemoveLync = False Case "/REMOVELYNC" fRemoveLync = True Case "/L","/LOG" fLogInitialized = False If UBound(arrArguments) > iCnt Then If oFso.FolderExists(arrArguments(iCnt + 1)) Then sLogDir = arrArguments(iCnt + 1) Else On Error Resume Next oFso.CreateFolder(arrArguments(iCnt + 1)) If Err <> 0 Then sLogDir = sScrubDir Else sLogDir = arrArguments(iCnt + 1) End If End If Case "/NOCANCEL" fNoCancel = True Case "/NOREBOOT" fNoReboot = True Case "/NE","/NOELEVATE" fNoElevate = True Case "/O","/OSE" fRemoveOse = True Case "/P","/PREVIEW","/DETECTONLY" fDetectOnly = True Case "/PASSIVE", "/QB-" fPassive = True Case "/Q","/QUIET" fQuiet = True Case "/QB" fQuiet = True fBasic = True Case "/QND" fBypass_Stage1 = True fBypass_Stage2 = True fBypass_Stage3 = True fRemoveOse = True fRemoveOspp = True fRemoveAll = True fSkipSD = True fForce = True Case "/R", "/RECONCILE" fTryReconcile = True Case "/REMOVEOSPP" , "/CLEANOSPP" fRemoveOspp = True Case "/S", "/SKIPSD", "/SKIPSHORTCUTDETECTION" fSkipSD = True Case "/SC", "/SCANCOMPONENTS" fBypass_Stage1 = False Case Else End Select Next 'iCnt If Not fLogInitialized Then CreateLog End Sub 'ParseCmdLine '======================================================================================================= Sub CreateLog Dim DateTime Dim sLogName On Error Resume Next 'Create the log file Set DateTime = CreateObject("WbemScripting.SWbemDateTime") DateTime.SetVarDate Now,True sLogName = sLogDir & "\" & oWShell.ExpandEnvironmentStrings("%COMPUTERNAME%") sLogName = sLogName & "_" & Left(DateTime.Value,14) sLogName = sLogName & "_ScrubLog.txt" Err.Clear Set LogStream = oFso.CreateTextFile(sLogName,True,True) If Err <> 0 Then Err.Clear sLogDir = sScrubDir sLogName = sLogDir & "\" & oWShell.ExpandEnvironmentStrings("%COMPUTERNAME%") sLogName = sLogName & "_" & Left(DateTime.Value,14) sLogName = sLogName & "_ScrubLog.txt" Set LogStream = oFso.CreateTextFile(sLogName,True,True) End If Log "Microsoft Customer Support Services - " & ONAME & " Removal Utility" & vbCrLf & vbCrLf & _ "OffScrub Version: " & SCRIPTVERSION & vbCrLf & _ "64 bit OS: " & f64 LogOnly "OS Details: " & sOSinfo & vbCrLf Log "Start removal: " & Now & vbCrLf fLogInitialized = True End Sub 'CreateLog '======================================================================================================= '------------------------------------------------------------------------------- ' RelaunchAs64Host ' ' Relaunch self with 64 bit WScript host '------------------------------------------------------------------------------- Sub RelaunchAs64Host Dim Argument, sCmd sCmd = Replace (LCase(wscript.Path), "syswow64", "sysnative") & "\cscript.exe " & Chr(34) & WScript.scriptFullName & Chr(34) If fQuiet AND NOT fCScript Then sCmd = Replace (sCmd, "\cscript.exe", "\wscript.exe") If Wscript.Arguments.Count > 0 Then For Each Argument in Wscript.Arguments sCmd = sCmd & " " & chr(34) & Argument & chr(34) Next 'Argument Else If Not sDefault = "" Then sCmd = sCmd & " " & chr(34) & sDefault & chr(34) End If sCmd = sCmd & " /ChangedHostBitness" Wscript.Quit oWShell.Run(sCmd, 1, True) End Sub 'RelaunchAs64Host '======================================================================================================= Sub RelaunchAsCScript Dim Argument Dim sCmdLine sCmdLine = "cmd.exe /c " & WScript.Path & "\cscript.exe //NOLOGO " & Chr(34) & WScript.scriptFullName & Chr(34) If Wscript.Arguments.Count > 0 Then For Each Argument in Wscript.Arguments sCmdLine = sCmdLine & " " & chr(34) & Argument & chr(34) Next 'Argument End If Wscript.Quit oWShell.Run(sCmdLine, 1, True) End Sub 'RelaunchAsCScript '======================================================================================================= Sub RelaunchElevated Dim Argument Dim sCmdLine Dim oShell Set oShell = CreateObject("Shell.Application") sCmdLine = Chr(34) & WScript.scriptFullName & Chr(34) If Wscript.Arguments.Count > 0 Then For Each Argument in Wscript.Arguments Select Case UCase(Argument) Case "/Q","/QUIET" 'Don't try to relaunch in quiet mode Exit Sub Case "UAC" 'Already tried elevated relaunch Exit Sub Case Else sCmdLine = sCmdLine & " " & chr(34) & Argument & chr(34) End Select Next 'Argument Else If Not sDefault = "" Then sCmdLine = sCmdLine & " " & chr(34) & sDefault & chr(34) End If oShell.ShellExecute "cscript.exe", sCmdLine & " /NoElevate UAC", "", "runas", 1 Wscript.Quit 5 End Sub 'RelaunchElevated '======================================================================================================= 'Show the expected syntax for the script usage Sub ShowSyntax TmpKeyCleanUp 'Wscript.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 & "/Log [LogfolderPath] ' Custom folder for log files" & vbCrLf & _ ' vbTab & "/SkipSD ' Skips the ShortcutDetection in local profiles" & vbCrLf & _ ' vbTab & "/NoCancel ' Setup.exe and Msiexec.exe have no Cancel button" & vbCrLf &_ ' vbTab & "/Quiet ' Script, 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 & " CLIENTSUITES ' Remove all " & ONAME & " Client suites/products" & 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" & vbCrLf Wscript.Quit End Sub 'ShowSyntax '=======================================================================================================
Notes