Uninstall - Microsoft Office - Click to Run - Windows
Log In or Register to download the BES file, and more.

1 Votes

Versioning - This is the latest version.

1Uninstall - Microsoft Office - Click to Run - Windows2/24/2017 2:05:08 PM
2Uninstall - Microsoft Office - Click to Run - Windows2/24/2017 2:43:56 PM
3Uninstall - Microsoft Office - Click to Run - Windows3/13/2017 8:45:49 AM
4Uninstall - Microsoft Office - Click to Run - Windows3/14/2017 8:23:02 AM

Description

This Fixlet uses the Office Cleanup tool to remove a Microsoft Office Click to Run Installation.

For general information or to report issues with C3 Patch content please visit GitHub here: https://github.com/strawgate/C3-Patch


Property Details

ID23815
TitleUninstall - Microsoft Office - Click to Run - Windows
DomainBESC
SourceInternal
Source Release Date2/24/2017 12:00:00 AM
Added by on 3/14/2017 8:23:02 AM
Last Modified by on 3/14/2017 8:23:02 AM
Counters 2417 Views / 40 Downloads
User Rating 1 star 2 star 3 star 4 star 5 star * Average over 0 ratings. ** Log In or Register to add your rating.

Relevance

isWindows (Relevance 1172)
Used in 1095 fixlets and 523 analyses   * Results in a true/false
Show indented relevance
windows of operating system
Used in 3 fixlets   * Results in a true/false
Show indented relevance
exists (keys "ClickToRun" of it; keys "15.0\ClickToRun" of it; keys "16.0\ClickToRun" of it) of keys "HKEY_LOCAL_MACHINE\Software\Microsoft\Office" of (x32 registries;x64 registries)

Actions

Action 1 (default)

Action Link Click here to deploy this action.
Script Type BigFix Action Script
delete "OffScrubc2r.vbs"

createfile until _end_
'*******************************************************************************
' Name: OffScrubC2R.vbs
' Author: Microsoft Customer Support Services
' Copyright (c) 2014 - 2015 Microsoft Corporation
' Script to remove Office Click To Run (C2R) products
' when a regular uninstall is no longer possible
'
' Scope: Office 2013, 2016 and O365 C2R products
'*******************************************************************************

Option Explicit

'-------------------------------------------------------------------------------
'
' Declaration of constants
'-------------------------------------------------------------------------------

Const SCRIPTVERSION = "2.00"
Const SCRIPTFILE = "OffScrubC2R.vbs"
Const SCRIPTNAME = "OffScrubC2R"
Const RETVALFILE = "ScrubRetValFile.txt"
Const ONAME = "Office C2R / O365"
Const HKCR = &H80000000
Const HKCU = &H80000001
Const HKLM = &H80000002
Const HKU = &H80000003
Const PRODLEN = 13
Const SQUISHED = 20
Const COMPRESSED = 32
Const REG_ARP = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
Const VB_YES = 6
Const VB_NO = 7

Const ERROR_SUCCESS = 0 'Bit #1. 0 indicates Success. Script completed successfully
Const ERROR_FAIL = 1 'Bit #1. Failure bit. Indicates an overall script failure.
'RESERVED bit! Returned when process is killed from task manager
Const ERROR_REBOOT_REQUIRED = 2 'Bit #2. Reboot bit. If set a reboot is required
Const ERROR_USERCANCEL = 4 'Bit #3. User Cancel bit. Controlled cancel from script UI
Const ERROR_STAGE1 = 8 'Bit #4. Informational. Msiexec based install was not possible
Const ERROR_STAGE2 = 16 'Bit #5. Critical. Not all of the intended cleanup operations could be applied
Const ERROR_INCOMPLETE = 32 'Bit #6. Pending file renames (del on reboot) - OR - Removal needs to run again after a system reboot.
Const ERROR_DCAF_FAILURE = 64 'Bit #7. Critical. Da capo al fine (second attempt) still failed.
Const ERROR_ELEVATION_USERDECLINED = 128 'Bit #8. Critical script error. User declined to allow mandatory script elevation
Const ERROR_ELEVATION = 256 'Bit #9. Critical script error. The attempt to elevate the process did not succeed
Const ERROR_SCRIPTINIT = 512 'Bit #10. Critical script error. Initialization failed
Const ERROR_RELAUNCH = 1024'Bit #11. Critical script error. This is a temporary value and must not be the final return code
Const ERROR_UNKNOWN = 2048'Bit #12 Critical script error. Script did not complete in a well defined state
Const ERROR_ALL = 4095'Full BitMask
Const ERROR_USER_ABORT = &HC000013A 'RESERVED. Dec -1073741510. Critical error. Returned when user aborts with + or closes the cmd window
Const ERROR_SUCCESS_CONFIG_COMPLETE = 1728
Const ERROR_SUCCESS_REBOOT_REQUIRED = 3010

'-------------------------------------------------------------------------------
'
' Declaration of variables
'-------------------------------------------------------------------------------

Dim oFso, oMsi, oReg, oWShell, oWmiLocal, oShellApp
Dim ComputerItem, Key, Item, LogStream, TmpKey
Dim arrVersion
Dim dictionaryKeepLis, dicApps, dictionaryKeepFolder, dicDelRegKey, dictionaryKeepReg
Dim dicInstalledSku, dicRemoveSku, dictionaryKeepSku, dicC2RSuite, dicDelInUse
Dim dicDelFolder
Dim sAppData, sScrubDir, sProgramFiles, sProgramFilesX86, sCommonProgramFiles
Dim sAllusersProfile, sOSVersion, sWinDir, sWICacheDir, sCommonProgramFilesX86
Dim sProgramData, sPackageFolder, sLocalAppData, sOInstallRoot, sSkuRemoveList
Dim sOSinfo, sDefault, sTemp, sTmp, sCmd, sLogDir, sPrompt, sProfilesDirectory
Dim sRetVal, sScriptDir, sPackageGuid, sValue, sActiveConfiguration
Dim iVersionNT, iError, iProcCloseCnt
Dim f64, fLogInitialized, fNoCancel, fRemoveOse, fDetectOnly, fQuiet, fForce
Dim fC2R, fRemoveAll, fRebootRequired, fRerun, fSetRunOnce, fTestRerun
Dim fIsElevated, fNoElevate, fUserConsent, fCScript

'-------------------------------------------------------------------------------
' Main
'
' Main section of script
'-------------------------------------------------------------------------------


' initialize required settings and objects
' ----------------------------------------
Initialize

' call the command line parser
'-----------------------------
ParseCmdLine

'-----------------------------
' Stage # 0 - Basic detection |
'-----------------------------

LogH "Stage # 0 " & chr(34) & "Basic detection" & chr(34)

' ensure integrity of WI metadata which could fail used APIs otherwise
'---------------------------------------------------------------------
Log "Ensure Windows Installer metadata integrity " & " (" & Time & ")"
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

' build a list with installed/registered Office products
'-------------------------------------------------------
FindInstalledOProducts
If dicC2RSuite.Count > 0 Then
Log "Registered ARP product(s) found:"
For Each Key In dicC2RSuite.Keys
    Log " - " & Key & " - " & dicC2RSuite.Item(Key)
Next 'Key
' For Each Item in dicC2RSuite.Items
' Log " - " & Item
' Next 'Item
Else
Log "No registered product(s) found"
End If

' locate the C2R %PackageFolder% and the PackageGuid
'---------------------------------------------------
sPackageFolder = ""
If RegReadValue(HKLM, "SOFTWARE\Microsoft\Office\15.0\ClickToRun", "PackageFolder", sValue, "REG_SZ") Then
    sPackageFolder = sValue
ElseIf RegReadValue(HKLM, "SOFTWARE\Microsoft\Office\16.0\ClickToRun", "PackageFolder", sPackageFolder, "REG_SZ") Then
    sPackageFolder = sValue
ElseIf RegReadValue(HKLM, "SOFTWARE\Microsoft\Office\ClickToRun", "PackageFolder", sPackageFolder, "REG_SZ") Then
    sPackageFolder = sValue
End If
' if sPackageFolder is invalid set it to the c2r registry reference string
If NOT Len(sPackageFolder) > 0 OR IsNull(sPackageFolder) Then
    If oFso.FolderExists(oWShell.ExpandEnvironmentStrings("%programfiles%") & "\Microsoft Office 15") Then
        sPackageFolder = oWShell.ExpandEnvironmentStrings("%programfiles%") & "\Microsoft Office 15"
    ElseIf oFso.FolderExists(oWShell.ExpandEnvironmentStrings("%programfiles%") & "\Microsoft Office 16") Then
        sPackageFolder = oWShell.ExpandEnvironmentStrings("%programfiles%") & "\Microsoft Office 16"
    ElseIf oFso.FolderExists(oWShell.ExpandEnvironmentStrings("%programfiles%") & "\Microsoft Office\PackageManifests") Then
        sPackageFolder = oWShell.ExpandEnvironmentStrings("%programfiles%") & "\Microsoft Office"
    ElseIf oFso.FolderExists(oWShell.ExpandEnvironmentStrings("%programfiles(x86)%") & "\Microsoft Office\PackageManifests") Then
        sPackageFolder = oWShell.ExpandEnvironmentStrings("%programfiles(x86)%") & "\Microsoft Office"
    End If
End If

sPackageGuid = ""
If RegReadValue(HKLM, "SOFTWARE\Microsoft\Office\15.0\ClickToRun", "PackageGUID", sValue, "REG_SZ") Then
    sPackageGuid = sValue
ElseIf RegReadValue(HKLM, "SOFTWARE\Microsoft\Office\16.0\ClickToRun", "PackageGUID", sValue, "REG_SZ") Then
    sPackageGuid = sValue
ElseIf RegReadValue(HKLM, "SOFTWARE\Microsoft\Office\ClickToRun", "PackageGUID", sValue, "REG_SZ") Then
    sPackageGuid = sValue
End If

' Init complete. Reset the return value
'--------------------------------------
ClearError ERROR_SCRIPTINIT


'-----------------------
' Stage # 1 - Uninstall |
'-----------------------

LogH "Stage # 1 " & chr(34) & "Uninstall" & chr(34)

' clean O15 SPP
'--------------
LogH1 "Clean OSPP"
CleanOSPP

' end all running Office applications
'------------------------------------
LogH1 "End running processes"
CloseOfficeApps

' remove scheduled tasks which might interfere with uninstall
'------------------------------------------------------------
DelSchtasks

' unpin shortcuts
'----------------
' need to unpin as long as the shortcuts are still valid!
LogH1 "Unpinning shortcuts"
CleanShortcuts sAllusersProfile, True, True
CleanShortcuts sProfilesDirectory, True, True

' uninstall
'----------
LogH1 "Removing " & ONAME
Uninstall

'---------------------
' Stage # 2 - CleanUp |
'---------------------
LogH "Stage # 2 " & chr(34) & "CleanUp" & chr(34)

' Cleanup registry data
'----------------------
RegWipe

' Cleanup files
'--------------
FileWipe

' for test purposes only!
If fTestRerun Then
LogH2 "Enforcing 'Rerun' mode for test purposes"
fRebootRequired = True
SetError ERROR_REBOOT_REQUIRED
Rerun
End If

ExitScript

Sub ExitScript

'------------------
' Stage # 3 - Exit |
'------------------
' Update cached error and quit
'-----------------------------
If NOT CBool(iError AND (ERROR_FAIL + ERROR_INCOMPLETE)) Then RegDeleteValue HKCU, "SOFTWARE\Microsoft\Office\15.0\CleanC2R", "Rerun", False
SetRetVal iError

' log result
If CBool(iError AND ERROR_INCOMPLETE) Then
LogH2 "Removal result: " & iError & " - INCOMPLETE. Uninstall requires a system reboot to complete."
Else
sTmp = " - SUCCESS"
If CBool(iError AND ERROR_USERCANCEL) Then sTmp = " - USER CANCELED"
If CBool(iError AND ERROR_FAIL) Then sTmp = " - FAIL"
LogH2 "Removal result: " & iError & sTmp
End If
If CBool(iError AND ERROR_FAIL) Then
If CBool(iError AND ERROR_REBOOT_REQUIRED) Then Log " - Reboot required"
If CBool(iError AND ERROR_USERCANCEL) Then Log " - User cancel"
If CBool(iError AND ERROR_STAGE1) Then Log " - Msiexec failed"
If CBool(iError AND ERROR_STAGE2) Then Log " - Cleanup failed"
If CBool(iError AND ERROR_INCOMPLETE) Then Log " - Removal incomplete. Rerun after reboot needed"
If CBool(iError AND ERROR_DCAF_FAILURE) Then Log " - Second attempt cleanup still incomplete"
If CBool(iError AND ERROR_ELEVATION_USERDECLINED) Then Log " - User declined elevation"
If CBool(iError AND ERROR_ELEVATION) Then Log " - Elevation failed"
If CBool(iError AND ERROR_SCRIPTINIT) Then Log " - Initialization error"
If CBool(iError AND ERROR_RELAUNCH) Then Log " - Unhandled error during relaunch attempt"
If CBool(iError AND ERROR_UNKNOWN) Then Log " - Unknown error"
' ERROR_USER_ABORT is only valid for the temporary cached error file
'If CBool(iError AND ERROR_USER_ABORT) Then Log " - Process terminated by user"
End If

LogH2 "Removal end."

' Reboot handling
If fRebootRequired Then
sPrompt = "In order to complete uninstall, a system reboot is necessary. Would you like to reboot now?"
If NOT fQuiet Then
If MsgBox(sPrompt, vbYesNo, SCRIPTNAME & " - 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

wscript.quit iError
End Sub 'ExitScript

'-------------------------------------------------------------------------------
' End Main
'
' End of Main section
'-------------------------------------------------------------------------------

'-------------------------------------------------------------------------------
' Initialize
'
' Configure defaults and initialize all required objects
'-------------------------------------------------------------------------------
Sub Initialize ()
Dim iCnt

' set defaults
'-------------
iError = ERROR_SUCCESS
iProcCloseCnt = 0
sLogDir = ""
sPackageFolder = ""
f64 = False
fCScript = False
fLogInitialized = False
fNoCancel = False
fRemoveOse = False
fDetectOnly = False
fQuiet = True
fForce = False
fC2R = True
fRebootRequired = False
fRerun = False
fTestRerun = False
fIsElevated = False
fNoElevate = False
fSetRunOnce = False
fUserConsent = False

' create required objects
'------------------------
Set oWmiLocal = GetObject("winmgmts:\\.\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 values
'----------------------------
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%")
'sProgramFilesX86 = deferred. Depends on operating system architecture check
sCommonProgramFiles = oWShell.ExpandEnvironmentStrings("%commonprogramfiles%")
'sCommonProgramFilesX86 = deferred. Depends on operating system architecture check
sProgramData = oWSHell.ExpandEnvironmentStrings("%programdata%")
sWinDir = oWShell.ExpandEnvironmentStrings("%windir%")
'sPackageFolder = deferred
sWICacheDir = sWinDir & "\" & "Installer"
sScrubDir = sTemp & "\" & SCRIPTNAME
sScriptDir = wscript.ScriptFullName
sScriptDir = Left(sScriptDir, InStrRev(sScriptDir, "\"))

' ensure 64 bit host if needed
If InStr(LCase(wscript.path), "syswow64") > 0 Then RelaunchAs64Host

' create the temp folder
'-----------------------
If Not oFso.FolderExists(sScrubDir) Then oFso.CreateFolder sScrubDir

' set the default logging directory
'----------------------------------
sLogDir = sScrubDir

' detect bitness of the operating system
'----------------------------------------
Set ComputerItem = oWmiLocal.ExecQuery("Select * from Win32_ComputerSystem")
For Each Item In ComputerItem
f64 = Instr(Left(Item.SystemType, 3), "64") > 0
Next
If f64 Then sProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%programfiles(x86)%")
If f64 Then sCommonProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%CommonProgramFiles(x86)%")

' update error flag
'------------------
SetError ERROR_SCRIPTINIT

' get Win32_OperatingSystem details
'----------------------------------
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

' get VersionNT number
'---------------------
arrVersion = Split(sOsVersion, Delimiter(sOsVersion))
iVersionNt = CInt(arrVersion(0)) * 100 + CInt(arrVersion(1))

' ensure sufficient registry permisions
'--------------------------------------
fIsElevated = CheckRegPermissions
If NOT fIsElevated AND NOT fNoElevate Then
' try to relaunch elevated
RelaunchElevated

' can't relaunch. Exit out
SetError ERROR_ELEVATION
If UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C" Then
If Not fLogInitialized Then CreateLog
Log "Error: Insufficient registry access permissions - exiting"
End If
SetRetVal iError
wscript.quit iError
End If

' clear error flags
'------------------
ClearError ERROR_ELEVATION
ClearError ERROR_SCRIPTINIT

' ensure CScript as engine
'------------------------
fCScript = UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C"
If NOT fCScript AND NOT fQuiet Then RelaunchAsCScript

' set retval for file based logic
'--------------------------------
' value needs to be kept on 'user abort'
SetRetVal ERROR_USER_ABORT

' create dictionary objects
'--------------------------
Set dicInstalledSku = CreateObject("Scripting.Dictionary")
Set dicRemoveSku = CreateObject("Scripting.Dictionary")
Set dictionaryKeepSku = CreateObject("Scripting.Dictionary")
Set dictionaryKeepLis = CreateObject("Scripting.Dictionary")
Set dictionaryKeepFolder = CreateObject("Scripting.Dictionary")
Set dicApps = CreateObject("Scripting.Dictionary")
Set dicDelRegKey = CreateObject("Scripting.Dictionary")
Set dictionaryKeepReg = CreateObject("Scripting.Dictionary")
Set dicC2RSuite = CreateObject("Scripting.Dictionary")
Set dicDelInUse = CreateObject("Scripting.Dictionary")
Set dicDelFolder = CreateObject("Scripting.Dictionary")

' add initial known .exe files that need to be closed
'----------------------------------------------------
dicApps.Add "appvshnotify.exe", "appvshnotify.exe"
dicApps.Add "integratedoffice.exe", "integratedoffice.exe"
dicApps.Add "integrator.exe", "integrator.exe"
dicApps.Add "firstrun.exe", "firstrun.exe"
dicApps.Add "setup.exe", "setup.exe"
dicApps.Add "communicator.exe", "communicator.exe"
dicApps.Add "msosync.exe", "msosync.exe"
dicApps.Add "OneNoteM.exe", "OneNoteM.exe"
dicApps.Add "iexplore.exe", "iexplore.exe"
dicApps.Add "mavinject32.exe", "mavinject32.exe"
dicApps.Add "werfault.exe", "werfault.exe"
dicApps.Add "perfboost.exe", "perfboost.exe"
dicApps.Add "roamingoffice.exe", "roamingoffice.exe"
' SP1 additions / changes
dicApps.Add "officeclicktorun.exe", "officeclicktorun.exe"
dicApps.Add "officeondemand.exe", "officeondemand.exe"
dicApps.Add "OfficeC2RClient.exe", "OfficeC2RClient.exe"

End Sub 'Initialize


'-------------------------------------------------------------------------------
' ParseCmdLine
'
' Command line parser
'-------------------------------------------------------------------------------
Sub ParseCmdLine

Dim iCnt, iArgCnt
Dim arrArguments
Dim sArg0

iArgCnt = Wscript.Arguments.Count
If iArgCnt > 0 Then
If wscript.Arguments(0) = "UAC" Then
If wscript.arguments.count = 1 Then iArgCnt = 0
End If
End If
If iArgCnt = 0 Then
Select Case UCase(wscript.ScriptName)
Case Else
'Create the log
CreateLog
FindInstalledOProducts
sDefault = "ALL"
arrArguments = Split(Trim(sDefault), " ")
If UBound(arrArguments) = -1 Then ReDim arrArguments(0)
End Select
Else
ReDim arrArguments(iArgCnt-1)
For iCnt = 0 To (iArgCnt-1)
arrArguments(iCnt) = UCase(Wscript.Arguments(iCnt))
Next 'iCnt
End If 'iArgCnt = 0

' hardcode to full removal
sArg0 = "ALL"

Select Case UCase(sArg0)
Case "?"
ShowSyntax
Case "ALL"
fRemoveAll = True
fRemoveOse = False
Case "C2R"
fC2R = True
fRemoveAll = False
fRemoveOse = False
Case Else
fRemoveAll = False
fRemoveOse = False
sSkuRemoveList = sArg0
End Select

For iCnt = 0 To UBound(arrArguments)
Select Case arrArguments(iCnt)
Case "?", "/?", "-?"
ShowSyntax
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 "/N", "/NOCANCEL"
fNoCancel = True

Case "/NE", "/NOELEVATE"
fNoElevate = True

Case "/O", "/OSE"
fRemoveOse = True

Case "/Q", "/QUIET"
fQuiet = True

' for test purposes only!
Case "/TR", "/TESTRERUN"
fTestRerun = True
Case Else
End Select
Next 'iCnt
If Not fLogInitialized Then CreateLog
End Sub 'ParseCmdLine

'-------------------------------------------------------------------------------
' ShowSyntax
'
' Show the expected syntax for the script usage
'-------------------------------------------------------------------------------
Sub ShowSyntax
Wscript.Echo sErr & vbCrLf & _
SCRIPTFILE & " V " & SCRIPTVERSION & vbCrLf & _
"Copyright (c) Microsoft Corporation. All Rights Reserved" & vbCrLf & vbCrLf & _
SCRIPTFILE & " - Remove " & ONAME & vbCrLf & _
"when a regular uninstall is no longer possible" & vbCrLf & vbCrLf & _
"Usage:" & vbTab & SCRIPTFILE & vbCrLf & vbCrLf & _
vbTab & "/? ' Displays this help"& vbCrLf
Wscript.Quit
End Sub 'ShowSyntax

'-------------------------------------------------------------------------------
' FindInstalledOProducts
'
' Office configuration products are listed with their configuration product
' name in the "Uninstall" key.
'-------------------------------------------------------------------------------
Sub FindInstalledOProducts
Dim ArpItem, prod, cult
Dim sCurKey, sValue, sConfigName, sCulture, sDisplayVersion, sProd
Dim sUninstallString
Dim iLeft, iRight
Dim arrKeys, arrProducts, arrCultures
Dim fSystemComponent0, fDisplayVersion, fUninstallString

    Const REG_ARP = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
    Const REG_O15RPROPERTYBAG = "SOFTWARE\Microsoft\Office\15.0\ClickToRun\propertyBag\"
    Const REG_O15C2RCONFIGURATION = "SOFTWARE\Microsoft\Office\15.0\ClickToRun\Configuration\"
    Const REG_O15C2RPRODUCTIDS = "SOFTWARE\Microsoft\Office\15.0\ClickToRun\ProductReleaseIDs\Active\"
    Const REG_O16C2RCONFIGURATION = "SOFTWARE\Microsoft\Office\16.0\ClickToRun\Configuration\"
    Const REG_O16C2RPRODUCTIDS = "SOFTWARE\Microsoft\Office\16.0\ClickToRun\ProductReleaseIDs\Active\"
    Const REG_C2RCONFIGURATION = "SOFTWARE\Microsoft\Office\ClickToRun\Configuration\"
    Const REG_C2RPRODUCTIDS = "SOFTWARE\Microsoft\Office\ClickToRun\ProductReleaseIDs\"


If dicInstalledSku.Count > 0 Then Exit Sub 'Already done from command line parser

fDisplayVersion = False

' identify C2R products
LogOnly vbCrLf & "Detecting installed products "

    LogOnly "Check for O15 C2R products"
    ' Check O15 Configuration key
If RegReadValue(HKLM, REG_O15C2RCONFIGURATION, "ProductReleaseIds", sValue, "REG_SZ") Then
arrProducts = Split(sValue, ",")
fDisplayVersion = RegReadValue(HKLM, REG_O15C2RPRODUCTIDS & "culture", "x-none", sDisplayVersion, "REG_SZ")
If NOT Err = 0 Then
Err.Clear
Else
' get version from active with fallback on configuration
For Each prod in arrProducts
LogOnly "Found O15 C2R product in Configuration: " & prod
' update product dictionary
If NOT dicInstalledSku.Exists(LCase(prod)) Then
    LogOnly "adding new product to dictionary: " & LCase(prod)
    dicInstalledSku.Add LCase(prod), sDisplayVersion
End If
Next 'prod
End If
End If

' Check O15 PropertyBag key
If RegReadValue(HKLM, REG_O15RPROPERTYBAG, "productreleaseid", sValue, "REG_SZ") Then
arrProducts = Split(sValue, ",")
fDisplayVersion = RegReadValue(HKLM, REG_O15C2RPRODUCTIDS & "culture", "x-none", sDisplayVersion, "REG_SZ")
If NOT Err = 0 Then
Err.Clear
Else
For Each prod in arrProducts
LogOnly "Found O15 C2R product in PropertyBag: " & prod
' update product dictionary
If NOT dicInstalledSku.Exists(LCase(prod)) Then
    LogOnly "adding new product to dictionary: " & LCase(prod)
    dicInstalledSku.Add LCase(prod), sDisplayVersion
End If
Next 'prod
End If
End If

    'O16 section
    LogOnly "Check for Office C2R products (>=QR8)"
    ' Check Office Configuration key
If RegReadValue(HKLM, REG_C2RPRODUCTIDS, "ActiveConfiguration", sActiveConfiguration, "REG_SZ") Then
    ' Get DisplayVersion
    'Try QR8 logic first
        fDisplayVersion = RegReadValue(HKLM, REG_C2RPRODUCTIDS & sActiveConfiguration & "\culture", "x-none", sDisplayVersion, "REG_SZ")
    If RegEnumKey(HKLM, REG_C2RPRODUCTIDS & sActiveConfiguration & "\culture", arrCultures) Then
        For Each cult In arrCultures
            If InStr(LCase(cult), "x-none") > 0 Then
                fDisplayVersion = RegReadValue(HKLM, REG_C2RPRODUCTIDS & sActiveConfiguration & "\culture\" & cult, "Version", sDisplayVersion, "REG_SZ")
            End If
        Next 'cult
    End If
    ' Update product dic
    If RegEnumKey(HKLM, REG_C2RPRODUCTIDS & sActiveConfiguration, arrProducts) Then
        For Each prod In arrProducts
            sProd = LCase(prod)
            If InStr(sProd, ".") > 0 Then sProd = Left(sProd, InStr(sProd, ".") - 1)
            Select Case LCase(sProd)
            Case "culture", "stream"
            Case Else
     LogOnly "Found Office C2R product in Configuration: " & prod
     ' update product dictionary
     If NOT dicInstalledSku.Exists(sProd) Then
         LogOnly "adding new product to dictionary: " & sProd
         dicInstalledSku.Add sProd, sDisplayVersion
     End If
            End Select
        Next 'prod
    End If 'arrProducts
End If 'ActiveConfiguration

    LogOnly "Check for Office C2R products (QR7)"
    ' Check Office Configuration key
    If RegReadValue(HKLM, REG_C2RCONFIGURATION, "ProductReleaseIds", sValue, "REG_SZ") Then
     arrProducts = Split(sValue, ",")
     If Not fDisplayVersion Then fDisplayVersion = RegReadValue(HKLM, REG_C2RPRODUCTIDS & "Active\culture", "x-none", sDisplayVersion, "REG_SZ")
     If NOT Err = 0 Then
     Err.Clear
     Else
     For Each prod in arrProducts
     LogOnly "Found Office C2R product in Configuration: " & prod
     ' update version tracking
     If NOT dicInstalledSku.Exists(LCase(prod)) Then
         LogOnly "adding new product to dictionary: " & LCase(prod)
         dicInstalledSku.Add LCase(prod), sDisplayVersion
     End If
     Next 'prod
     End If
    End If

    LogOnly "Check for O16 C2R products (QR6)"
    ' Check O16 Configuration key
If RegReadValue(HKLM, REG_O16C2RCONFIGURATION, "ProductReleaseIds", sValue, "REG_SZ") Then
arrProducts = Split(sValue, ",")
If Not fDisplayVersion Then fDisplayVersion = RegReadValue(HKLM, REG_O16C2RPRODUCTIDS & "culture", "x-none", sDisplayVersion, "REG_SZ")
If NOT Err = 0 Then
Err.Clear
Else
For Each prod in arrProducts
LogOnly "Found O16 (QR6) C2R product in Configuration: " & prod
' update product dictionary
If NOT dicInstalledSku.Exists(LCase(prod)) Then
    LogOnly "adding new product to dictionary: " & prod
    dicInstalledSku.Add LCase(prod), sDisplayVersion
End If
Next 'prod
End If
End If

LogOnly "Check ARP for Office C2R products"
' ARP
RegEnumKey HKLM, REG_ARP, arrKeys
If IsArray(arrKeys) Then
For Each ArpItem in arrKeys
' filter on Office C2R products
sCurKey = REG_ARP & ArpItem & "\"
fUninstallString = RegReadValue(HKLM, sCurKey, "UninstallString", sValue, "REG_SZ")
If (fUninstallString And( (InStr(UCase(sValue), UCase("Microsoft Office 1")) > 0) Or (InStr(UCase(sValue), UCase("OfficeClickToRun.exe")) > 0) )) Then
'get Version
fDisplayVersion = RegReadValue(HKLM, sCurKey, "DisplayVersion", sDisplayVersion, "REG_SZ")
'extract the productreleaseid
sValue = Trim(sValue)
prod = Trim(Mid(sValue, InStrRev(sValue, " ")))
prod = Replace(prod, "productstoremove=", "")
If InStr(prod, "_") > 0 Then
prod = Left(prod, InStr(prod, "_") - 1)
End If
If InStr(prod, ".1") > 0 Then
prod = Left(prod, InStr(prod, ".1") - 1)
End If
LogOnly "Found C2R product in ARP: " & prod
If NOT dicInstalledSku.Exists(LCase(prod)) Then
    LogOnly "adding new product to dictionary: " & prod
    dicInstalledSku.Add LCase(prod), sDisplayVersion
End If
' categorize the SKU as C2R
If NOT dicC2RSuite.Exists(ArpItem) Then dicC2RSuite.Add ArpItem, prod & " - " & sDisplayVersion
Else

     'Legacy logic keep for compat reasons
     sValue = ""
     sDisplayVersion = ""
     fSystemComponent0 = NOT (RegReadValue(HKLM, sCurKey, "SystemComponent", sValue, "REG_DWORD") AND (sValue = "1"))
     fDisplayVersion = RegReadValue(HKLM, sCurKey, "DisplayVersion", sValue, "REG_SZ")
     If fDisplayVersion Then
     sDisplayVersion = sValue
     If Len(sValue) > 1 Then
         On Error Resume Next
     fDisplayVersion = (CInt(Left(sValue, 2)) > 14)
     If Not Err <> 0 Then Err.Clear
     Else
     fDisplayVersion = False
     End If
     End If
     fUninstallString = RegReadValue(HKLM, sCurKey, "UninstallString", sUninstallString, "REG_SZ")
    
     ' filter on C2R configuration SKU
     If (fUninstallString And( (InStr(UCase(sUninstallString), UCase("Microsoft Office 1")) > 0) Or (InStr(UCase(sUninstallString), UCase("OfficeClickToRun.exe")) > 0) )) Then
     ' Extract the ProductReleaseID
     If InStr(sUninstallString, "productstoremove=") > 0 Then
         sConfigName = Trim(Mid(sValue, InStrRev(sUninstallString, " ")))
         sConfigName = Replace(sConfigName, "productstoremove=", "")
         If InStr(prod, "_") > 0 Then
         sConfigName = Left(sConfigName, InStr(sConfigName, "_") - 1)
         End If
     Else
         iLeft = InStr(ArpItem, " - ") + 2
         iRight = InStr(iLeft, ArpItem, " - ") - 1
         If iRight > 0 Then
         sConfigName = Trim(Mid(ArpItem, iLeft, (iRight - iLeft)))
         sCulture = Mid(ArpItem, iRight + 3)
         Else
         sConfigName = Trim(Left(ArpItem, iLeft - 3))
         sCulture = Mid(ArpItem, iLeft)
         End If
         sConfigName = Replace(sConfigName, "Microsoft", "")
         sConfigName = Replace(sConfigName, "Office", "")
         sConfigName = Replace(sConfigName, "Professional", "Pro")
         sConfigName = Replace(sConfigName, "Standard", "Std")
         sConfigName = Replace(sConfigName, "(Technical Preview)", "")
         sConfigName = Replace(sConfigName, "15", "")
         sConfigName = Replace(sConfigName, "16", "")
         sConfigName = Replace(sConfigName, "2013", "")
         sConfigName = Replace(sConfigName, "2016", "")
         sConfigName = Replace(sConfigName, " ", "")
         sConfigName = Replace(sConfigName, "Project", "Prj")
         sConfigName = Replace(sConfigName, "Visio", "Vis")
     End If
     If NOT dicInstalledSku.Exists(LCase(sConfigName)) Then
         LogOnly "adding new product to dictionary (ARP Legacy): " & sConfigName
         dicInstalledSku.Add LCase(sConfigName), sDisplayVersion
     End If
     ' categorize the SKU as C2R
     If NOT dicC2RSuite.Exists(ArpItem) Then dicC2RSuite.Add ArpItem, sConfigName & " - " & sDisplayVersion
     ElseIf (fSystemComponent0 AND fDisplayVersion AND (InStr(UCase(ArpItem), UCase("OFFICE15.")) > 0 Or InStr(UCase(ArpItem), UCase("OFFICE16.")) > 0)) Then
     ' classic .msi install SKU
     iLeft = InStr(ArpItem, ".") + 1
     iRight = InStr(iLeft, ArpItem, "-") - 1
     sConfigName = Mid(ArpItem, iLeft)
     sCulture = ""
     If NOT dictionaryKeepSku.Exists(ArpItem) Then dictionaryKeepSku.Add ArpItem, sConfigName & " - " & sDisplayVersion
     End If
    
     ' Other products
     If InScope(ArpItem) Then
     Select Case Mid(ArpItem,11,4)
     ' 007E = Licensing
     ' 008C = Extensibility Components
     Case "007E", "008F", "008C"
     sConfigName = "Habanero"
     RegReadValue HKLM, sCurKey, "DisplayName", sConfigName, "REG_SZ"
     If NOT dicInstalledSku.Exists(LCase(ArpItem)) Then
         LogOnly "adding new product to dictionary (ARP Legacy other): " & ArpItem
         dicInstalledSku.Add LCase(ArpItem), sDisplayVersion
     End If
     If NOT dicC2RSuite.Exists(ArpItem) Then dicC2RSuite.Add ArpItem, sConfigName & " - " & sDisplayVersion
     Case "24E1", "237A"
     sConfigName = "MSOIDLOGIN"
     If NOT dicInstalledSku.Exists(LCase(ArpItem)) Then
         LogOnly "adding new product to dictionary (ARP Legacy other): " & ArpItem
         dicInstalledSku.Add LCase(ArpItem), sDisplayVersion
     End If
     If NOT dicC2RSuite.Exists(ArpItem) Then dicC2RSuite.Add ArpItem, sConfigName & " - " & sDisplayVersion
     Case Else
     ' not in scope for c2r removal!
     If NOT dictionaryKeepSku.Exists(ArpItem) Then dictionaryKeepSku.Add ArpItem, ArpItem
     End Select
     End If 'InScope
     ' End legacy logic
    
End If
Next 'ArpItem
End If

End Sub 'FindInstalledOProducts

'-------------------------------------------------------------------------------
' EnsureValidWIMetadata
'
' Ensures that only valid metadata entries exist to avoid API failures.
' Invalid entries will be removed
'-------------------------------------------------------------------------------
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

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
If NOT (dicC2RSuite.Count > 0 OR dictionaryKeepSku.Count > 0) Then
Log "Skipping CleanOSPP"
Exit Sub
End If

' Initialize the software protection platform object with a filter on Office 2013 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

'-------------------------------------------------------------------------------
' DelSchtasks
'
' Delete know scheduled tasks.
'-------------------------------------------------------------------------------
Sub DelSchtasks ()
Dim sCmd

If CBool(iError AND ERROR_USERCANCEL) Then Exit Sub

LogH2 "Removing scheduled tasks"

LogOnly "FF_INTEGRATEDstreamSchedule"
oWShell.Run "SCHTASKS /Delete /TN FF_INTEGRATEDstreamSchedule /F", 0, False
wscript.sleep 500

LogOnly "FF_INTEGRATEDUPDATEDETECTION"
oWShell.Run "SCHTASKS /Delete /TN FF_INTEGRATEDUPDATEDETECTION /F", 0, False
wscript.sleep 500

LogOnly "C2RAppVLoggingStart"
oWShell.Run "SCHTASKS /Delete /TN C2RAppVLoggingStart /F", 0, False
wscript.sleep 500

LogOnly "Office 15 Subscription Heartbeat"
sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "Office 15 Subscription Heartbeat" & Chr(34) & " /F"
oWShell.Run sCmd, 0, False
wscript.sleep 500

LogOnly "Microsoft Office 15 Sync Maintenance"
sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "Microsoft Office 15 Sync Maintenance for {{d068b555-9700-40b8-992c-f866287b06c1}" & Chr(34) & " /F"
oWShell.Run sCmd, 0, False
wscript.sleep 500

LogOnly "OfficeInventoryAgentFallBack"
sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "\Microsoft\Office\OfficeInventoryAgentFallBack" & Chr(34) & " /F"
oWShell.Run sCmd, 0, False
wscript.sleep 500

LogOnly "OfficeTelemetryAgentFallBack"
sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "\Microsoft\Office\OfficeTelemetryAgentFallBack" & Chr(34) & " /F"
oWShell.Run sCmd, 0, False
wscript.sleep 500

LogOnly "OfficeInventoryAgentLogOn"
sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "\Microsoft\Office\OfficeInventoryAgentLogOn" & Chr(34) & " /F"
oWShell.Run sCmd, 0, False

LogOnly "OfficeTelemetryAgentLogOn"
sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "\Microsoft\Office\OfficeTelemetryAgentLogOn" & Chr(34) & " /F"
oWShell.Run sCmd, 0, False

LogOnly "Office Background Streaming"
sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "Office Background Streaming" & Chr(34) & " /F"
oWShell.Run sCmd, 0, False
wscript.sleep 500

LogOnly "Office Automatic Updates"
sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "\Microsoft\Office\Office Automatic Updates" & Chr(34) & " /F"
oWShell.Run sCmd, 0, False
wscript.sleep 500

LogOnly "Office ClickToRun Service Monitor"
sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "\Microsoft\Office\Office ClickToRun Service Monitor" & Chr(34) & " /F"
oWShell.Run sCmd, 0, False
wscript.sleep 500

LogOnly "Office Subscription Maintenance"
sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "Office Subscription Maintenance" & Chr(34) & " /F"
oWShell.Run sCmd, 0, False
wscript.sleep 500

End Sub

'-------------------------------------------------------------------------------
' CloseOfficeApps
'
' End all running instances of applications that will be removed.
'-------------------------------------------------------------------------------
Sub CloseOfficeApps
Dim Processes, Process, app, prop
Dim sAppName, sOut, sUserWarn
Dim fWait
Dim iRet

On Error Resume Next
fWait = False
iProcCloseCnt = iProcCloseCnt + 1
If fRerun Then Exit Sub

If NOT fUserConsent Then
' detect processes to allow a user warning
sUserWarn = "Please save all open documents and close all Office, IE and Windows Explorer applications before proceeding." & vbCrLf & _
"When you click OK this removal process will terminate all running Office, IE and Windows Explorer processes and applications." & vbCrLf & vbCrLf & _
"Click â??Cancelâ?? to to end this removal now."
For Each app in dicApps.Keys
if NOT app = "iexplore.exe" Then
sAppName = Replace(app, ".", "%.")
Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name like '" & sAppName & "'")
For Each Process in Processes
If NOT InStr(sUserWarn, Process.Name) > 0 Then sUserWarn = sUserWarn & vbCrLf & " - " & Process.Name
Next 'Process
End If
Next 'app
Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process")
For Each Process in Processes
For Each prop in Process.Properties_
If prop.Name = "ExecutablePath" Then
If IsC2R(prop.Value) Then sUserWarn = sUserWarn & vbCrLf & " - " & Process.Name
End If 'ExcecutablePath
Next 'prop
Next 'Process
If (InStr(sUserWarn, " - ") > 0 AND NOT fQuiet) Then
iRet = MsgBox(sUserWarn, 49, "Save your unsaved work now!")
If iRet = 2 Then
SetError ERROR_USERCANCEL
ExitScript
Else
fUserConsent = True
End If
End If
End If 'fUserConsent

' end known processes first
For Each app in dicApps.Keys
if NOT app = "iexplore.exe" Then
sAppName = Replace(app, ".", "%.")
Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name like '" & sAppName & "'")
For Each Process in Processes
sOut = "End process '" & Process.Name
iRet = Process.Terminate()
CheckError "CloseOfficeApps: " & "Process.Name"
Log sOut & "' returned: " & iRet
fWait = True
Next 'Process
End If
Next 'app
' end running applications
Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process")
For Each Process in Processes
For Each prop in Process.Properties_
If prop.Name = "ExecutablePath" Then
If IsC2R(prop.Value) Then
sOut = "End process '" & Process.Name
iRet = Process.Terminate()
CheckError "CloseOfficeApps: " & "Process.Name"
Log sOut & "' returned: " & iRet
fWait = True
End If
End If 'ExcecutablePath
Next 'prop
Next 'Process
If fWait Then wscript.sleep 5000
End Sub 'CloseOfficeApps

'-------------------------------------------------------------------------------
' Uninstall
'
' Identify and invoke default uninstall command for a regular uninstall.
'-------------------------------------------------------------------------------
Sub Uninstall
Dim OseService, srvc
Dim hDefKey, sSubKeyName, sValue, Name, arrNames, arrTypes
Dim sku, prod, sUninstallCmd, sReturn, sMsiProp, sCmd
Dim sPkgFld, sPkgGuid
Dim i
If CBool(iError AND ERROR_USERCANCEL) Then Exit Sub

' check if OSE service is *installed, *not disabled, *running under System context.
LogH2 "Checking state of OSE service"
Set OseService = oWmiLocal.Execquery("Select * From Win32_Service Where Name like 'ose%'")
For Each srvc in OseService
If (srvc.StartMode = "Disabled") AND (Not srvc.ChangeStartMode("Manual") = 0) Then _
Log "Conflict detected: OSE service is disabled"
If (Not srvc.StartName = "LocalSystem") AND (srvc.Change( , , , , , , "LocalSystem", "")) Then _
Log "Conflict detected: OSE service not running as LocalSystem"
Next 'srvc

If NOT dicC2RSuite.Count > 0 Then
Log "No uninstallable C2R items registered in Uninstall"
End If

' remove the published component registration for C2R packages
LogH2 "Removing published component registration for C2R packages"
' delete the manifest files
For i = 1 To 4
    Select Case i
    Case 1
         RegReadValue HKLM, "SOFTWARE\Microsoft\Office\15.0\ClickToRun", "PackageFolder", sPkgFld, "REG_SZ"
         RegReadValue HKLM, "SOFTWARE\Microsoft\Office\15.0\ClickToRun", "PackageGUID", sPkgGuid, "REG_SZ"
     Case 2
         RegReadValue HKLM, "SOFTWARE\Microsoft\Office\16.0\ClickToRun", "PackageFolder", sPkgFld, "REG_SZ"
         RegReadValue HKLM, "SOFTWARE\Microsoft\Office\16.0\ClickToRun", "PackageGUID", sPkgGuid, "REG_SZ"
     Case 3
         RegReadValue HKLM, "SOFTWARE\Microsoft\Office\ClickToRun", "PackageFolder", sPkgFld, "REG_SZ"
         RegReadValue HKLM, "SOFTWARE\Microsoft\Office\ClickToRun", "PackageGUID", sPkgGuid, "REG_SZ"
     Case 4
         sPkgFld = sPackageFolder
         sPkgGuid = sPackageGuid
     End Select
     If oFso.FolderExists(sValue & "\root\Integration") Then
     sCmd = "cmd.exe /c del " & chr(34) & sPkgFld & "\root\Integration\C2RManifest*.xml" & chr(34)
     Log " Running: " & sCmd
     sReturn = oWShell.Run (sCmd, 0, True)
     Log " Return value: " & sReturn
     If oFso.FileExists(sPkgFld & "\root\Integration\integrator.exe") Then
     sCmd = chr(34) & sPkgFld & "\root\Integration\integrator.exe" & chr(34) & " /U /Extension PackageRoot=" & chr(34) & sPkgFld & "\root" & chr(34) & " PackageGUID=" & sPkgGuid
     Log " Running: " & sCmd
     sReturn = oWShell.Run (sCmd, 0, True)
     Log " Return value: " & sReturn
     sCmd = chr(34) & sPkgFld & "\root\Integration\integrator.exe" & chr(34) & " /U"
     Log " Running: " & sCmd
     sReturn = oWShell.Run (sCmd, 0, True)
     Log " Return value: " & sReturn
     End If
     If oFso.FileExists(sProgramData & "\Microsoft\ClickToRun\{{" & sPkgGuid & "}\integrator.exe") Then
     sCmd = chr(34) & sProgramData & "\Microsoft\ClickToRun\{{" & sPkgGuid & "}\integrator.exe" & chr(34) & " /U /Extension PackageRoot=" & chr(34) & sPkgFld & "\root" & chr(34) & " PackageGUID=" & sPkgGuid
     Log " Running: " & sCmd
     sReturn = oWShell.Run (sCmd, 0, True)
     Log " Return value: " & sReturn
     End If
     End If
Next 'i

' delete potential blocking registry keys for msiexec based tasks
LogH2 "Removing C2R and App-V registry data"
For Each sku in dicC2RSuite.Keys
' remove the ARP entry
RegDeleteKey HKLM, REG_ARP & sku
Next 'sku
RegDeleteKey HKCU, "SOFTWARE\Microsoft\Office\15.0\ClickToRun"
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\15.0\ClickToRun"
RegDeleteKey HKCU, "SOFTWARE\Microsoft\Office\16.0\ClickToRun"
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\16.0\ClickToRun"
RegDeleteKey HKCU, "SOFTWARE\Microsoft\Office\ClickToRun"
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\ClickToRun"

' AppV keys
hDefKey = HKCU
sSubKeyName = "SOFTWARE\Microsoft\AppV\ISV"
Do
If RegEnumValues(hDefKey, sSubKeyName, arrNames, arrTypes) Then
For Each Name in arrNames
If IsC2R(Name) Then RegDeleteValue hDefKey, sSubKeyName, Name, False
Next 'Name
End If 'RegEnumValues
If hDefKey = HKLM Then Exit Do
hDefKey = HKLM
Loop

' msiexec based uninstall
sMsiProp = " REBOOT=ReallySuppress NOREMOVESPAWN=True"
LogH2 "Detect Msi based products"
For Each prod in oMsi.Products
If CheckDelete(prod) Then
Log "Calling msiexec.exe to remove " & prod
sUninstallCmd = "msiexec.exe /x" & prod & sMsiProp
If fQuiet Then
sUninstallCmd = sUninstallCmd & " /q"
Else
sUninstallCmd = sUninstallCmd & " /qb-!"
End If
sUninstallCmd = sUninstallCmd & " /l*v " & chr(34) & sLogDir & "\Uninstall_" & prod & ".log" & chr(34)
CloseOfficeApps
LogOnly "Calling msiexec with '" & sUninstallCmd & "'"
sReturn = oWShell.Run(sUninstallCmd, 0, True)
Log "msiexec returned: " & SetupRetVal(sReturn) & " (" & sReturn & ")" & vbCrLf
fRebootRequired = fRebootRequired OR (sReturn = "3010")
If fRebootRequired Then SetError ERROR_REBOOT_REQUIRED
Select Case CInt(sReturn)
Case ERROR_SUCCESS,ERROR_SUCCESS_CONFIG_COMPLETE,ERROR_SUCCESS_REBOOT_REQUIRED
'success no action required
Case Else
SetError ERROR_STAGE1
End Select
Else
    LogOnly "Skipping out of scope product: " & prod
End If 'CheckDelete
Next 'Product
oWShell.Run "cmd.exe /c net stop msiserver", 0, False
End Sub 'Uninstall

'-------------------------------------------------------------------------------
' RegWipe
'
' Removal of left behind registry data
'-------------------------------------------------------------------------------
Sub Regwipe
Dim hDefKey, item, name, value, RetVal
Dim sGuid, sSubKeyName, sValue, sCmd
Dim i, iLoopCnt
Dim arrKeys, arrNames, arrTypes, arrTestNames, arrTestTypes
Dim arrMultiSzValues, arrMultiSzNewValues
Dim fDelReg

If CBool(iError AND ERROR_USERCANCEL) Then Exit Sub

LogH1 "Registry CleanUp"
CloseOfficeApps

' Note: ARP entries have already been cleared in uninstall stage

' HKCU Registration
RegDeleteKey HKCU, "Software\Microsoft\Office\15.0\Registration"
RegDeleteKey HKCU, "Software\Microsoft\Office\16.0\Registration"
RegDeleteKey HKCU, "Software\Microsoft\Office\Registration"


' C2R specifics
' AppV key "SOFTWARE\Microsoft\AppV" has already been cleared in uninstall stage

' Virtual InstallRoot
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\15.0\Common\InstallRoot\Virtual"
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\16.0\Common\InstallRoot\Virtual"
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\Common\InstallRoot\Virtual"

' Mapi reg
If NOT dictionaryKeepSku.Count > 0 Then RegDeleteKey HKLM, "SOFTWARE\Classes\CLSID\{{2027FC3B-CF9D-4ec7-A823-38BA308625CC}"

' C2R keys
RegDeleteKey HKCU, "SOFTWARE\Microsoft\Office\15.0\ClickToRun"
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\15.0\ClickToRun"
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\15.0\ClickToRunStore"
RegDeleteKey HKCU, "SOFTWARE\Microsoft\Office\16.0\ClickToRun"
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\16.0\ClickToRun"
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\16.0\ClickToRunStore"
RegDeleteKey HKCU, "SOFTWARE\Microsoft\Office\ClickToRun"
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\ClickToRun"
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\ClickToRunStore"

' Office key in HKLM
If Not dictionaryKeepSku.Count > 0 Then
    'double calls to ensure Wow6432 gets cleared out as well
    RegDeleteKey HKLM, "Software\Microsoft\Office\15.0"
    RegDeleteKey HKLM, "Software\Microsoft\Office\15.0"
    RegDeleteKey HKLM, "Software\Microsoft\Office\16.0"
    RegDeleteKey HKLM, "Software\Microsoft\Office\16.0"
End If
ClearOfficeHKLM "SOFTWARE\Microsoft\Office"

' Run key
sSubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
If RegEnumValues (HKLM, sSubKeyName, arrNames, arrTypes) Then
For Each name in arrNames
If RegReadValue(HKLM, sSubKeyName, name, sValue, "REG_SZ") Then
If IsC2R(sValue) Then RegDeleteValue HKLM, sSubKeyName, name, False
End If
Next 'item
End If
RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "Lync15", False
RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "Lync16", False


If NOT dictionaryKeepSku.Count > 0 Then
' Protocol Handlers
RegDeleteKey HKLM, "SOFTWARE\Classes\Protocols\Handler\osf"

' Groove ShellIconOverlayIdentifiers
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Microsoft SPFS Icon Overlay 1 (ErrorConflict)"
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Microsoft SPFS Icon Overlay 2 (SyncInProgress)"
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Microsoft SPFS Icon Overlay 3 (InSync)"
RegDeleteKey HKLM, "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Microsoft SPFS Icon Overlay 1 (ErrorConflict)"
RegDeleteKey HKLM, "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Microsoft SPFS Icon Overlay 2 (SyncInProgress)"
RegDeleteKey HKLM, "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Microsoft SPFS Icon Overlay 3 (InSync)"

' Shell extensions
RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\", "{{B28AA736-876B-46DA-B3A8-84C5E30BA492}", False
RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\", "{{8B02D659-EBBB-43D7-9BBA-52CF22C5B025}", False
RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\", "{{0875DCB6-C686-4243-9432-ADCCF0B9F2D7}", 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\", "{{C41662BB-1FA0-4CE0-8DC5-9B7F8279FF97}", 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
RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\", "{{46137B78-0EC3-426D-8B89-FF7C3A458B5E}", False

' BHO
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\{{31D09BA0-12F5-4CCE-BE8A-2923E76605DA}"
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\{{B4F3A835-0E21-4959-BA22-42B3008E02FF}"
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\{{D0498E0A-45B7-42AE-A9AA-ABA463DBD3BF}"
RegDeleteKey HKLM, "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\{{31D09BA0-12F5-4CCE-BE8A-2923E76605DA}"
RegDeleteKey HKLM, "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\{{B4F3A835-0E21-4959-BA22-42B3008E02FF}"
RegDeleteKey HKLM, "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\{{D0498E0A-45B7-42AE-A9AA-ABA463DBD3BF}"

' OneNote Namespace Extension for Desktop
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Desktop\NameSpace\{{0875DCB6-C686-4243-9432-ADCCF0B9F2D7}"

' Web Sites
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Desktop\Namespace\{{B28AA736-876B-46DA-B3A8-84C5E30BA492}"
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\NetworkNeighborhood\Namespace\{{46137B78-0EC3-426D-8B89-FF7C3A458B5E}"

' VolumeCaches
RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Microsoft Office Temp Files"
End If 'NOT dictionaryKeepSku.Count > 0

' ARP
' Note: configuration entries have already been removed
' as part of the 'Uninstall' stage
If RegEnumKey(HKLM, REG_ARP, arrKeys) Then
For Each item in arrKeys
If Len(item) > 37 Then
sGuid = UCase(Left(item, 38))
If CheckDelete(sGuid) Then RegDeleteKey HKLM, REG_ARP & item & "\"
End If 'Len(Item)>37
Next 'Item
End If

' UpgradeCodes, WI config, WI global config
LogH2 "Scanning Windows Installer metadata for removeable UpgradeCodes"
For iLoopCnt = 1 to 5
Select Case iLoopCnt
Case 1
sSubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UpgradeCodes\"
hDefKey = HKLM
Case 2
sSubKeyName = "Installer\UpgradeCodes\"
hDefKey = HKCR
Case 3
sSubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products\"
hDefKey = HKLM
Case 4
sSubKeyName = "Installer\Features\"
hDefKey = HKCR
Case 5
sSubKeyName = "Installer\Products\"
hDefKey = HKCR
End Select
If RegEnumKey(hDefKey, sSubKeyName, arrKeys) Then
For Each item in arrKeys
' ensure 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 CheckDelete(sGuid) Then
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
If NOT RegEnumValues(hDefKey, sSubKeyName & item, arrNames, arrTypes) Then RegDeleteKey hDefKey, sSubKeyName & item & "\"
Else 'iLoopCnt >= 3
RegDeleteKey hDefKey, sSubKeyName & item & "\"
End If 'iLoopCnt < 3
End If 'InScope
End If 'Len(Item)=32
Next 'Item
End If 'RegEnumKey
Next 'iLoopCnt

' Components in Global
LogH2 "Scanning Windows Installer Global Components metadata"
sSubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components\"
hDefKey = HKLM
If RegEnumKey(hDefKey, sSubKeyName, arrKeys) Then
For Each item in arrKeys
' ensure the expected length for a compressed GUID
If Len(Item) = 32 Then
If RegEnumValues(hDefKey, sSubKeyName & item, arrNames, arrTypes) Then
For Each name in arrNames
If Len(Name) = 32 Then
sGuid = GetExpandedGuid(Name)
If CheckDelete(sGuid) Then
RegDeleteValue hDefKey, sSubKeyName & item & "\", name, False
' if all entries were removed - delete the key
If NOT RegEnumValues(hDefKey, sSubKeyName & item, arrTestNames, arrTestTypes) Then RegDeleteKey hDefKey, sSubKeyName & item & "\"
End If
End If '32
Next 'Name
End If 'RegEnumValues
End If '32
Next 'Item
End If 'RegEnumKey

' Published Components
LogH2 "Scanning Windows Installer Published Components metadata"
sSubKeyName = "Installer\Components\"
hDefKey = HKCR
If RegEnumKey(hDefKey, sSubKeyName, arrKeys) Then
For Each item in arrKeys
' ensure the expected length for a compressed GUID
If Len(Item) = 32 Then
If RegEnumValues(hDefKey, sSubKeyName & item, arrNames, arrTypes) Then
For Each name in arrNames
If RegReadValue (hDefKey, sSubKeyName & item, name, sValue, "REG_MULTI_SZ") Then
arrMultiSzValues = Split(sValue, chr(13))
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 UBound(arrMultiSzValues) = i Then oReg.SetMultiStringValue hDefKey, sSubKeyName & item, name,arrMultiSzNewValues
Else
If fDelReg Then
RegDeleteValue hDefKey, sSubKeyName & item & "\", name, True
' if all entries were removed - delete the key
If NOT RegEnumValues(hDefKey, sSubKeyName & item, arrTestNames, arrTestTypes) Then RegDeleteKey hDefKey, sSubKeyName & item & "\"
End If 'DelReg
End If
End If 'IsArray
End If
Next 'Name
End If 'RegEnumValues
End If '32
Next 'Item
End If 'RegEnumKey

End Sub 'Regwipe

'-------------------------------------------------------------------------------
' FileWipe
'
' Removal of left behind services, files and shortcuts
'-------------------------------------------------------------------------------
Sub FileWipe
Dim scRoot
Dim fDelFolders

If CBool(iError AND ERROR_USERCANCEL) Then Exit Sub

LogH1 "File Cleanup"

fDelFolders = False
CloseOfficeApps
DelSchtasks

' remove the OfficeSvc service
LogH2 "Deleting OfficeSvc service"
DeleteService "OfficeSvc"

' SP1 addition / change
' remove the ClickToRunSvc service
LogH2 "Deleting ClickToRunSvc service"
DeleteService "ClickToRunSvc"

' adding additional processes for termination
dicApps.Add "explorer.exe", "explorer.exe"
dicApps.Add "msiexec.exe", "msiexec.exe"
dicApps.Add "ose.exe", "ose.exe"

If fC2R Then
     ' delete C2R package files
LogH2 "Deleting C2R package files"
If oFso.FolderExists(sProgramFiles & "\Microsoft Office 15") _
Or oFso.FolderExists(sProgramFiles & "\Microsoft Office 16") _
Or oFso.FolderExists(oWShell.ExpandEnvironmentStrings("%programfiles%") & "\Microsoft Office\PackageManifests") _
Or oFso.FolderExists(oWShell.ExpandEnvironmentStrings("%programfiles(x86)%") & "\Microsoft Office\PackageManifests") Then
fDelFolders = True
Log " Attention: Now closing Explorer.exe for file delete operations"
Log " Explorer will automatically restart."
wscript.sleep 2000
CloseOfficeApps
End If
' delete Office folders
LogH2 "Deleting Office folders"
DeleteFolder sProgramFiles & "\Microsoft Office 15"
DeleteFolder sProgramFiles & "\Microsoft Office 16"
If f64 Then
    DeleteFolder sCommonProgramFilesX86 & "\Microsoft Office 15"
    DeleteFolder sCommonProgramFilesX86 & "\Microsoft Office 16"
End If
If fDelFolders Then
    DeleteFolder sProgramFiles & "\Microsoft Office\PackageManifests"
    DeleteFolder sProgramFiles & "\Microsoft Office\PackageSunrisePolicies"
    DeleteFolder sProgramFiles & "\Microsoft Office\root"
    DeleteFile sProgramFiles & "\Microsoft Office\AppXManifest.xml"
    DeleteFile sProgramFiles & "\Microsoft Office\FileSystemMetadata.xml"
    If Not dictionaryKeepSku.Count > 0 Then
        DeleteFolder sProgramFiles & "\Microsoft Office\Office16"
        DeleteFolder sProgramFiles & "\Microsoft Office\Office15"
    End If
    If f64 Then
         DeleteFolder sProgramFilesX86 & "\Microsoft Office\PackageManifests"
         DeleteFolder sProgramFilesX86 & "\Microsoft Office\PackageSunrisePolicies"
         DeleteFolder sProgramFilesX86 & "\Microsoft Office\root"
         DeleteFile sProgramFilesX86 & "\Microsoft Office\AppXManifest.xml"
         DeleteFile sProgramFilesX86 & "\Microsoft Office\FileSystemMetadata.xml"
         If Not dictionaryKeepSku.Count > 0 Then
             DeleteFolder sProgramFilesX86 & "\Microsoft Office\Office16"
             DeleteFolder sProgramFilesX86 & "\Microsoft Office\Office15"
         End If
        End If
        End If

DeleteFolder sProgramData & "\Microsoft\ClickToRun"
DeleteFolder sCommonProgramFiles & "\microsoft shared\ClickToRun"
DeleteFolder sProgramData & "\Microsoft\office\FFPackageLocker"
DeleteFolder sProgramData & "\Microsoft\office\ClickToRunPackageLocker"
If oFso.FileExists(sProgramData & "\Microsoft\office\FFPackageLocker") Then DeleteFile sProgramData & "\Microsoft\office\FFPackageLocker"
If oFso.FileExists(sProgramData & "\Microsoft\office\FFStatePBLocker") Then DeleteFile sProgramData & "\Microsoft\office\FFStatePBLocker"
If NOT dictionaryKeepSku.Count > 0 Then DeleteFolder sProgramData & "\Microsoft\office\Heartbeat"
DeleteFolder oWShell.ExpandEnvironmentStrings("%userprofile%") & "\Microsoft Office"
DeleteFolder oWShell.ExpandEnvironmentStrings("%userprofile%") & "\Microsoft Office 15"
DeleteFolder oWShell.ExpandEnvironmentStrings("%userprofile%") & "\Microsoft Office 16"
End If

' restore explorer.exe if needed
RestoreExplorer

' delete shortcuts
LogH2 "Search and delete shortcuts"
CleanShortcuts sAllUsersProfile, True, False
CleanShortcuts sProfilesDirectory, True, False

' delete empty folder structures
If dicDelFolder.Count > 0 Then
LogH2 "Removing empty folders"
DeleteEmptyFolders
End If

' add the collected files in use for delete on reboot
If dicDelInUse.Count > 0 Then ScheduleDeleteEx

LogH2 "File Cleanup complete"
End Sub ' FileWipe

'-------------------------------------------------------------------------------
' 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 IsC2R(sc.TargetPath) Then fDeleteSC = True
If NOT oFso.FileExists(sc.TargetPath) Then
' Shortcut target does not exist
If IsC2R(sc.TargetPath) 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 dicDelFolder.Exists(sFolder) Then dicDelFolder.Add sFolder, sFolder
If fUnPin Then UnPin file
If fDelete 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 > 600 Then verb.DoIt
End Select
Next
On Error Goto 0
End Sub

'-------------------------------------------------------------------------------
' ClearOfficeHKLM
'
' Recursively search and clear the HKLM Office key from references in scope
'-------------------------------------------------------------------------------
Sub ClearOfficeHKLM (sSubKeyName)
Dim key, name
Dim sValue
Dim arrKeys, arrNames, arrTypes
Dim arrTestNames, arrTestTypes, arrTestKeys

' recursion
If RegEnumKey(HKLM, sSubKeyName, arrKeys) Then
For Each key in arrKeys
ClearOfficeHKLM sSubKeyName & "\" & key
Next 'key
End If

' identify & clear removable entries
If RegEnumValues(HKLM, sSubKeyName, arrNames, arrTypes) Then
For Each name in arrNames
If RegReadValue(HKLM, sSubKeyName, name, sValue, "REG_SZ") Then
If IsC2R(sValue) Then RegDeleteValue HKLM, sSubKeyName, name, False
End If
Next 'item
End If

' clear out empty keys
If (NOT RegEnumValues(HKLM, sSubKeyName, arrNames, arrTypes)) AND _
(NOT RegEnumKey(HKLM, sSubKeyName, arrKeys)) AND _
(NOT dictionaryKeepSku.Count > 0) Then _
RegDeleteKey HKLM, sSubKeyName
End Sub


'-------------------------------------------------------------------------------
'
' Helper Functions
'
'-------------------------------------------------------------------------------

'-------------------------------------------------------------------------------
' IsC2R
'
' Check if the passed in string is related to C2R
' Returns TRUE if in C2R scope
'-------------------------------------------------------------------------------
Function IsC2R (sValue)

    Const OREF = "\ROOT\OFFICE1"
    Const OREFROOT = "Microsoft Office\Root\"
    Const OREGREFC2R15 = "Microsoft Office 15"
    Const OREGREFC2R16 = "Microsoft Office 16"
    Const OCOMMON         = "\microsoft shared\ClickToRun"
    Const OMANIFEST         = "\Microsoft Office\PackageManifests"
    Const OSUNRISE         = "\Microsoft Office\PackageSunrisePolicies"
    
    Dim fReturn
    
    fReturn = False
    
If InStr(LCase(sValue), LCase(OREF)) > 0 _
Or InStr(LCase(sValue), LCase(OREFROOT)) > 0 _
Or InStr(LCase(sValue), LCase(OCOMMON)) > 0 _
Or InStr(LCase(sValue), LCase(OMANIFEST)) > 0 _
Or InStr(LCase(sValue), LCase(OSUNRISE)) > 0 _
Or InStr(LCase(sValue), LCase(OREGREFC2R15)) > 0 _
Or InStr(LCase(sValue), LCase(OREGREFC2R16)) > 0 Then fReturn = True

    IsC2R = fReturn
End Function

'-------------------------------------------------------------------------------
' CheckRegPermissions
'
' Test the permissions on some key registry locations to determine if
' sufficient permissions are given.
'-------------------------------------------------------------------------------
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

'-------------------------------------------------------------------------------
' GetMyProcessId
'
' Returns the process id of the own process
'-------------------------------------------------------------------------------
Function GetMyProcessId()
Dim iParentProcessId

iParentProcessId = 0
' try to obtain from creating a new cscript instance
On Error Resume Next
iParentProcessId = GetObject("winmgmts:root\cimv2").Get("Win32_Process.Handle='" & oWShell.Exec("cscript.exe").ProcessId & "'").ParentProcessId
On Error Goto 0
If iParentProcessId > 0 Then
' succeeded to obtain the process id
GetMyProcessId = iParentProcessId
Exit Function
End If

' failed to obtain the id from the creation of a new instance
' get it from enum of Win32_Process
Dim Process, Processes
Err.Clear
Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process WHERE Name='cscript.exe' AND CommandLine like '%" & SCRIPTNAME & "%'")
For Each Process in Processes
iParentProcessId = Process.ProcessId
Exit For
Next
GetMyProcessId = iParentProcessId
End Function 'GetMyProcessId

'-------------------------------------------------------------------------------
' Delimiter
'
' 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

'-------------------------------------------------------------------------------
' GetExpandedGuid
'
' Returns the expanded string from a compressed GUID
'-------------------------------------------------------------------------------
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 'GetExpandedGuid

'-------------------------------------------------------------------------------
' GetCompressedGuid
'
' Returns the compressed string for a GUID
'-------------------------------------------------------------------------------
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

'-------------------------------------------------------------------------------
' GetDecodedGuid
'
' Returns the GUID from a squished format
'-------------------------------------------------------------------------------
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

'-------------------------------------------------------------------------------
' DecToHex
'
' 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

'-------------------------------------------------------------------------------
' RelaunchAs64Host
'
' Relaunch self with 64 bit CScript host
'-------------------------------------------------------------------------------
Sub RelaunchAs64Host
Dim Argument, sCmd

sCmd = Replace(LCase(wscript.Path), "syswow64", "sysnative") & "\cscript.exe " & Chr(34) & WScript.scriptFullName & Chr(34)
If Wscript.Arguments.Count > 0 Then
For Each Argument in Wscript.Arguments
sCmd = sCmd & " " & chr(34) & Argument & chr(34)
Next 'Argument
End If
Wscript.Quit CLng(oWShell.Run(sCmd, 1, True))

End Sub 'RelaunchAs64Host

'-------------------------------------------------------------------------------
' RelaunchElevated
'
' Relaunch the script with elevated permissions
'-------------------------------------------------------------------------------
Sub RelaunchElevated
Dim Argument, Process, Processes
Dim iParentProcessId, iSpawnedProcessId
Dim sCmdLine, sRetValFile, sValue
Dim oShell

SetError ERROR_RELAUNCH
' Shell object for relaunch
Set oShell = CreateObject("Shell.Application")
' build command line for relaunch
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
SetError ERROR_ELEVATION_FAILED
Case "UAC"
'Already tried elevated relaunch
SetError ERROR_ELEVATION_FAILED
Exit Sub
Case Else
sCmdLine = sCmdLine & " " & chr(34) & Argument & chr(34)
End Select
Next 'Argument
End If
' prep work to get the return value from the elevated process
iParentProcessId = GetMyProcessId

' ' make user aware of elevation attempt after reboot
' If RegReadValue(HKCU, "SOFTWARE\Microsoft\Office\15.0\CleanC2R", "Rerun", sValue, "REG_DWORD") Then
' oWShell.Popup "System reboot complete. OffScrub will now prompt for elevation!", 10, SCRIPTNAME & " - NOTE!"
' End If

' launch the elevated instance
oShell.ShellExecute "cscript.exe", sCmdLine & " /NoElevate UAC", "", "runas", 1
' get the process id of the spawned instance
WScript.Sleep 500
Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process WHERE ParentProcessId='" & iParentProcessId & "'")
If Processes.Count > 0 Then
For Each Process in Processes
         iSpawnedProcessId = Process.ProcessId
         Exit For
Next 'Process
' monitor the tasklist to detect the end of the spawned process
While oWmiLocal.ExecQuery("Select * From Win32_Process WHERE ProcessId='" & iSpawnedProcessId & "'").Count > 0
WScript.Sleep 3000
Wend
' get the return value from the file
Wscript.Quit GetRetValFromFile
End If
' elevation failed (user declined)
SetError ERROR_ELEVATION_USERDECLINED
End Sub 'RelaunchElevated

'-------------------------------------------------------------------------------
' RelaunchAsCScript
'
' Relaunch self with Cscript as host
'-------------------------------------------------------------------------------
Sub RelaunchAsCScript
Dim Argument
Dim sCmdLine

SetError ERROR_RELAUNCH
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 CLng(oWShell.Run(sCmdLine, 1, True))
End Sub 'RelaunchAsCScript

'-------------------------------------------------------------------------------
' SetError
'
' Set error bit(s)
'-------------------------------------------------------------------------------
Sub SetError(ErrorBit)
iError = iError OR ErrorBit
Select Case ErrorBit
Case ERROR_DCAF_FAILURE, ERROR_STAGE2, ERROR_ELEVATION_USERDECLINED, ERROR_ELEVATION, ERROR_SCRIPTINIT
iError = iError OR ERROR_FAIL
End Select
End Sub

'-------------------------------------------------------------------------------
' ClearError
'
' Unset error bit(s)
'-------------------------------------------------------------------------------
Sub ClearError(ErrorBit)
iError = iError AND (ERROR_ALL - ErrorBit)
Select Case ErrorBit
Case ERROR_ELEVATION_USERDECLINED, ERROR_ELEVATION, ERROR_SCRIPTINIT
iError = iError AND (ERROR_ALL - ERROR_FAIL)
End Select
End Sub

'-------------------------------------------------------------------------------
' SetRetVal
'
' Write return value to file
'-------------------------------------------------------------------------------
Sub SetRetVal(iError)
Dim RetValFileStream

'don't fail script execution if writing the return value to file fails
On Error Resume Next

Set RetValFileStream = oFso.createTextFile(sScrubDir & "\" & RETVALFILE, True, True)
RetValFileStream.Write iError
RetValFileStream.Close
On Error Goto 0
End Sub 'SetRetVal

'-------------------------------------------------------------------------------
' GetRetValFromFile
'
' Read return value from file.
' Used to ensure return value can get obtained from an elevated process
'-------------------------------------------------------------------------------
Function GetRetValFromFile ()
Dim RetValFileStream
Dim iRetValFromFile

On Error Resume Next 'don't fail script execution when getting the return value from file fails

If oFso.FileExists(sScrubDir & "\" & RETVALFILE) Then
Set RetValFileStream = oFso.OpenTextFile(sScrubDir & "\" & RETVALFILE, 1, False, -2)
GetRetValFromFile = RetValFileStream.ReadAll
RetValFileStream.Close
Exit Function
End If
Err.Clear
On Error Goto 0
GetRetValFromFile = ERROR_UNKNOWN
End Function 'GetRetValFromFile

'-------------------------------------------------------------------------------
' CreateLog
'
' Create the removal log file
'-------------------------------------------------------------------------------
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
On Error Goto 0

Log "Microsoft Customer Support Services - " & ONAME & " Removal Utility" & vbCrLf &_
"Removes "& ONAME & " when a regular uninstall is no longer possible." & vbCrLf & vbCrLf & _
"Version: " & vbTab & SCRIPTVERSION & vbCrLf & _
"64 bit OS: " & vbTab & f64 & vbCrLf & _
"Removal start: " & vbTab & Time & vbCrLf
fLogInitialized = True
End Sub 'CreateLog

'-------------------------------------------------------------------------------
' HiveString
'
' Translates the numeric constant into the human readable registry hive string
'-------------------------------------------------------------------------------
Function HiveString(hDefKey)
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

'-------------------------------------------------------------------------------
' RegKeyExists
'
' Returns a boolean for the test on existence of a given registry key
'-------------------------------------------------------------------------------
Function RegKeyExists(hDefKey, sSubKeyName)
Dim arrKeys
RegKeyExists = False
If oReg.EnumKey(hDefKey, sSubKeyName, arrKeys) = 0 Then RegKeyExists = True
End Function

'-------------------------------------------------------------------------------
' RegValExists
'
' Returns a boolean for the test on existence of a given registry value
'-------------------------------------------------------------------------------
Function RegValExists(hDefKey,sSubKeyName,sName)
Dim arrValueTypes, arrValueNames
Dim i

RegValExists = False
If Not RegKeyExists(hDefKey,sSubKeyName) Then Exit Function
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

'-------------------------------------------------------------------------------
' RegReadValue
'
' Read the value of a given registry entry
' The correct type has to be passed in as argument
'-------------------------------------------------------------------------------
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 "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 "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)
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(13))
Case Else
RetVal = -1
End Select 'sValue

RegReadValue = (RetVal = 0)
End Function 'RegReadValue

'-------------------------------------------------------------------------------
' RegEnumValues
'
' 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

'-------------------------------------------------------------------------------
' RegEnumKey
'
' 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

'-------------------------------------------------------------------------------
' RegDeleteValue
'
' Wrapper around oReg.DeleteValue to handle 64 bit
'-------------------------------------------------------------------------------
Sub RegDeleteValue(hDefKey, sSubKeyName, sName, fRegMultiSZ)
Dim sDelKeyName, sValue
Dim iRetVal
Dim fKeep

' ensure trailing "\"
sSubKeyName = sSubKeyName & "\"
While InStr(sSubKeyName, "\\") > 0
sSubKeyName = Replace(sSubKeyName, "\\", "\")
Wend

fKeep = dictionaryKeepReg.Exists(LCase(sSubKeyName & sName))
If (NOT fKeep AND f64) Then fKeep = dictionaryKeepReg.Exists(LCase(Wow64Key(hDefKey, sSubKeyName) & sName))
If fKeep Then
LogOnly "Disallowing the delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyName & sName
If NOT fForce Then Exit Sub
End If

' check on forced delete
If fKeep Then
LogOnly "Enforced delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyName & sName
LogOnly " Remaining applications will need a repair!"
End If

' ensure value exists
If RegValExists(hDefKey, sSubKeyName, sName) Then
sDelKeyName = sSubKeyName
ElseIf RegValExists(hDefKey, Wow64Key(hDefKey, sSubKeyName), sName) Then
sDelKeyName = Wow64Key(hDefKey, sSubKeyName)
Else
LogOnly "Value not found. Cannot delete value: " & HiveString(hDefKey) & "\" & sSubKeyName & sName
Exit Sub
End If

' prevent unintentional, unsafe REG_MULTI_SZ delete
If RegReadValue(hDefKey, sDelKeyName, sName, sValue, "REG_MULTI_SZ") AND NOT fRegMultiSZ Then
LogOnly "Disallowing unsafe delete of REG_MULTI_SZ: " & HiveString(hDefKey) & "\" & sDelKeyName & sName
Exit Sub
End If

' execute delete operation
If Not fDetectOnly Then
LogOnly "Delete registry value: " & HiveString(hDefKey) & "\" & sDelKeyName & " -> " & sName
iRetVal = 0
iRetVal = oReg.DeleteValue(hDefKey, sDelKeyName, sName)
CheckError "RegDeleteValue"
If NOT (iRetVal = 0) Then
LogOnly " Delete failed. Return value: " & iRetVal
SetError ERROR_STAGE2
End If
Else
LogOnly "Preview mode. Disallowing delete registry value: " & HiveString(hDefKey) & "\" & sDelKeyName & " -> " & sName
End If
On Error Goto 0

End Sub 'RegDeleteValue

'-------------------------------------------------------------------------------
' RegDeleteKey
'
' Wrappper around RegDeleteKeyEx to handle 64bit
'-------------------------------------------------------------------------------
Sub RegDeleteKey(hDefKey, sSubKeyName)
Dim sDelKeyName
Dim fKeep

' ensure trailing "\"
sSubKeyName = sSubKeyName & "\"
While InStr(sSubKeyName, "\\") > 0
sSubKeyName = Replace(sSubKeyName, "\\", "\")
Wend

fKeep = dictionaryKeepReg.Exists(LCase(sSubKeyName))
If (NOT fKeep AND f64) Then fKeep = dictionaryKeepReg.Exists(LCase(Wow64Key(hDefKey, sSubKeyName)))
If fKeep Then
LogOnly "Disallowing the delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyName
If NOT fForce Then Exit Sub
End If

' check on forced delete
If fKeep Then
LogOnly "Enforced delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyName
LogOnly " Remaining applications will need a repair!"
End If

If Len(sSubKeyName) > 1 Then
'Strip of trailing "\"
sSubKeyName = Left(sSubKeyName, Len(sSubKeyName) - 1)
End If

' ensure key exists
If RegKeyExists(hDefKey, sSubKeyName) Then
sDelKeyName = sSubKeyName
ElseIf f64 AND RegKeyExists(hDefKey, Wow64Key(hDefKey, sSubKeyName)) Then
sDelKeyName = Wow64Key(hDefKey, sSubKeyName)
Else
LogOnly "Key not found. Cannot delete key: " & HiveString(hDefKey) & "\" & sSubKeyName
Exit Sub
End If

' execute delete
If Not fDetectOnly Then
LogOnly "Delete registry key: " & HiveString(hDefKey) & "\" & sDelKeyName
On Error Resume Next
RegDeleteKeyEx hDefKey, sDelKeyName
On Error Goto 0
Else
LogOnly "Preview mode. Disallowing delete of registry key: " & HiveString(hDefKey) & "\" & sSubKeyName
End If
End Sub 'RegDeleteKey

'-------------------------------------------------------------------------------
' RegDeleteKeyEx
'
' Recursively delete a registry structure
'-------------------------------------------------------------------------------
Sub RegDeleteKeyEx(hDefKey, sSubKeyName)
Dim arrSubkeys
Dim sSubkey
Dim iRetVal

'Strip of trailing "\"
If Len(sSubKeyName) > 1 Then
If Right(sSubKeyName, 1) = "\" Then sSubKeyName = Left(sSubKeyName, Len(sSubKeyName) - 1)
End If
On Error Resume Next

' exception handler
If (hDefKey = HKLM) AND (sSubKeyName = "SOFTWARE\Microsoft\Office\15.0\ClickToRun") Then
iRetVal = oWShell.Run("reg delete HKLM\SOFTWARE\Microsoft\Office\15.0\ClickToRun /f", 0, True)
Exit Sub
End If

' regular recursion
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
On Error Goto 0
End Sub 'RegDeleteKeyEx

'-------------------------------------------------------------------------------
' Wow64Key
'
' Return the 32bit regkey location on a 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

'-------------------------------------------------------------------------------
' RemoveDuplicates
'
' Remove duplicate entries from a one dimensional array
'-------------------------------------------------------------------------------
Function RemoveDuplicates(Array)
Dim Item
Dim dicNoDupes

Set dicNoDupes = CreateObject("Scripting.Dictionary")
For Each Item in Array
If Not dicNoDupes.Exists(Item) Then dicNoDupes.Add Item,Item
Next 'Item
RemoveDuplicates = dicNoDupes.Keys
End Function 'RemoveDuplicates

'-------------------------------------------------------------------------------
' CheckError
'
' Checks the status of 'Err' and logs the error details if <> 0
'-------------------------------------------------------------------------------
Sub CheckError(sModule)
If Err <> 0 Then
LogOnly " Error: " & sModule & " - Source: " & Err.Source & "; Err# (Hex): " & Hex( Err ) & _
"; Err# (Dec): " & Err & "; Description : " & Err.Description
End If 'Err = 0
Err.Clear
End Sub

'-------------------------------------------------------------------------------
' LogH
'
' Write a header log string to the log file
'-------------------------------------------------------------------------------
Sub LogH (sLog)
LogStream.WriteLine ""
sLog = sLog & vbCrLf & String(Len(sLog), "=")
If NOT fQuiet AND fCScript Then wscript.echo ""
If NOT fQuiet AND fCScript Then wscript.echo sLog
LogStream.WriteLine sLog
End Sub 'Logh

'-------------------------------------------------------------------------------
' LogH1
'
' Write a header log string to the log file
'-------------------------------------------------------------------------------
Sub LogH1 (sLog)
LogStream.WriteLine ""
sLog = sLog & vbCrLf & String(Len(sLog), "-")
If NOT fQuiet AND fCScript Then wscript.echo ""
If NOT fQuiet AND fCScript Then wscript.echo sLog
LogStream.WriteLine sLog
End Sub 'LogH1

'-------------------------------------------------------------------------------
' LogH2
'
' Write w/o indent Cmd window and the log file
'-------------------------------------------------------------------------------
Sub LogH2 (sLog)
If NOT fQuiet AND fCScript Then wscript.echo sLog
LogStream.WriteLine ""
LogStream.WriteLine sLog
End Sub 'LogH2

'-------------------------------------------------------------------------------
' Log
'
' Echos the log string to the Cmd window and the log file
'-------------------------------------------------------------------------------
Sub Log (sLog)
If NOT fQuiet AND fCScript Then wscript.echo sLog
LogStream.WriteLine " " & Time & ": " & sLog
End Sub 'Log

'-------------------------------------------------------------------------------
' LogOnly
'
' Commits the log string to the log file
'-------------------------------------------------------------------------------
Sub LogOnly (sLog)
LogStream.WriteLine " " & Time & ": " & sLog
End Sub 'Log

'-------------------------------------------------------------------------------
' InScope
'
' Check if ProductCode is in scope for removal
'-------------------------------------------------------------------------------
'Check if ProductCode is in scope
Function InScope(sProductCode)
Dim fInScope
Dim sProd
    
    Const OFFICEID = "0000000FF1CE}"
    
    On Error Resume Next

fInScope = False
If Len(sProductCode) = 38 Then
sProd = UCase(sProductCode)
If Right(sProd, PRODLEN) = OFFICEID Then
    If CInt(Mid(sProd, 4, 2)) > 14 Then
     If Err <> 0 Then
         Err.Clear
         Exit Function
     End If
     Select Case Mid(sProd, 11, 4)
     Case "007E", "008F", "008C", "24E1", "237A"
     fInScope = True
     End Select
End If
End If
' Microsoft Online Services Sign-in Assistant (x64 ship and x86 ship)
If sProd = "{{6C1ADE97-24E1-4AE4-AEDD-86D3A209CE60}" Then fInScope = True
If sProd = "{{9520DDEB-237A-41DB-AA20-F2EF2360DCEB}" Then fInScope = True
If sProd = UCase(sPackageGuid) Then fInScope = True
If sProd = UCase("{{9AC08E99-230B-47e8-9721-4577B7F124EA}") Then fInScope = True
End If '38

InScope = fInScope
End Function 'InScope

'-------------------------------------------------------------------------------
' CheckDelete
'
' Check a ProductCode is known to stay installed
'-------------------------------------------------------------------------------
Function CheckDelete(sProductCode)

CheckDelete = False
' ensure valid GUID length
If NOT Len(sProductCode) = 38 Then Exit Function
' only care if it's in the expected ProductCode pattern
If NOT InScope(sProductCode) Then Exit Function
' check if it's a known product that should be kept
If dictionaryKeepSku.Exists(UCase(sProductCode)) Then Exit Function

CheckDelete = True
End Function 'CheckDelete

'-------------------------------------------------------------------------------
' DeleteService
'
' Delete a service
'-------------------------------------------------------------------------------
'Delete a service
Sub DeleteService(sName)
Dim Services, srvc, Processes, process
Dim sQuery, sStates, sProcessName, sCmd
Dim iRet

On Error Resume Next

sStates = "STARTED;RUNNING"
sQuery = "Select * From Win32_Service Where Name='" & sName & "'"
Set Services = oWmiLocal.Execquery(sQuery)

' stop and delete the service
For Each srvc in Services
Log " Found service " & sName & " (" & srvc.DisplayName & ") in state " & srvc.State
' get the process name
sProcessName = Trim(Replace(Mid(srvc.PathName, InStrRev(srvc.PathName,"\") + 1), chr(34), ""))
' stop the service
If InStr(sStates, UCase(srvc.State)) > 0 Then
iRet = srvc.StopService()
LogOnly " attempt to stop service " & sName & " returned: " & iRet
End If
' ensure no more instances of the service are running
Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name='" & sProcessName & "'")
For Each process in Processes
iRet = process.Terminate()
Next 'Process
If fDetectOnly Then
Log " Not deleting service " & sName & " in preview mode"
Exit Sub
End If
iRet = srvc.Delete()
Log " Delete service " & sName & " returned: " & iRet
Next 'srvc

' check if service got deleted
Set Services = oWmiLocal.Execquery(sQuery)
For Each srvc in Services
' failed to delete service. retry with 'sc' command
sLog " Deleting service " & sName & " failed. Retry delete using 'SC' command"
sCmd = "sc delete " & sName
iRet = oWShell.Run(sCmd, 0, True)
Next 'srvc

Set Services = Nothing
Err.Clear
On Error Goto 0
End Sub 'DeleteService


'-------------------------------------------------------------------------------
' SetupRetVal
'
' Translation for known uninstall return values
'-------------------------------------------------------------------------------
Function SetupRetVal(RetVal)
Select Case RetVal
Case 0 : SetupRetVal = "Success"
'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

'-------------------------------------------------------------------------------
' DeleteFile
'
' Wrapper to delete a file
'-------------------------------------------------------------------------------
Sub DeleteFile(sFile)
Dim File, attr
Dim sDelFile, sFileName, sNewPath
Dim fKeep

On Error Resume Next

fKeep = dictionaryKeepFolder.Exists(LCase(sFile))
If (NOT fKeep AND f64) Then fKeep = dictionaryKeepFolder.Exists(LCase(Wow64Folder(sFile)))
If fKeep Then
LogOnly "Disallowing the delete of still required keypath element: " & sFile
If NOT fForce Then Exit Sub
End If

' check on forced delete
If fKeep Then
LogOnly "Enforced delete of still required keypath element: " & sFile
LogOnly " Remaining applications will need a repair!"
End If

If oFso.FileExists(sFile) Then
sDelFile = sFile
ElseIf f64 AND oFso.FileExists(Wow64Folder(sFile)) Then
sDelFile = Wow64Folder(sFile)
Else
LogOnly "Path not found. Cannot not delete folder: " & sFile
Exit Sub
End If
If Not fDetectOnly Then
LogOnly "Delete file: " & sDelFile
        Set File = oFso.GetFile(sDelFile)
' ensure read-only flag is not set
attr = File.Attributes
If CBool(attr AND 1) Then File.Attributes = attr AND (attr - 1)
' add folder to empty folder cleanup list
If NOT dicDelFolder.Exists(File.ParentFolder.Path) Then dicDelFolder.Add File.ParentFolder.Path, File.ParentFolder.Path
' delete the file
sFile = File.Path
File.Delete True
Set File = Nothing
If Err <> 0 Then
CheckError "DeleteFile"
' schedule file for delete on next reboot
ScheduleDeleteFile sFile
End If 'Err <> 0
Else
LogOnly "Preview mode. Disallowing delete for folder: " & sDelFile
End If
On Error Goto 0
End Sub 'DeleteFile

'-------------------------------------------------------------------------------
' DeleteFolder
'
' Wrapper to delete a folder
'-------------------------------------------------------------------------------
Sub DeleteFolder(sFolder)
Dim Folder, fld, attr
Dim sDelFolder, sFolderName, sNewPath, sCmd
Dim fKeep

' ensure trailing "\"
' trailing \ is required for dictionaryKeepFolder comparisons
sFolder = sFolder & "\"
While InStr(sFolder,"\\")>0
sFolder = Replace(sFolder,"\\","\")
Wend

' prevent delete of folders that are known to be still required
fKeep = dictionaryKeepFolder.Exists(LCase(sFolder))
If (NOT fKeep AND f64) Then fKeep = dictionaryKeepFolder.Exists(LCase(Wow64Folder(sFolder)))
If fKeep Then
LogOnly "Disallowing the delete of still required keypath element: " & sFolder
If NOT fForce Then Exit Sub
End If

' check on forced delete
If fKeep Then
LogOnly "Enforced delete of still required keypath element: " & sFolder
LogOnly " Remaining applications will need a repair!"
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
LogOnly "Path not found. Cannot not delete folder: " & sFolder
Exit Sub
End If
If Not fDetectOnly Then
LogOnly "Delete folder: " & sDelFolder
Set Folder = oFso.GetFolder(sDelFolder)
' ensure to remove read only flag
attr = Folder.Attributes
If CBool(attr AND 1) Then Folder.Attributes = attr AND (attr - 1)
' add to empty folder cleanup list
If NOT dicDelFolder.Exists(Folder.Path) Then dicDelFolder.Add Folder.Path, Folder.Path
' delete the folder
' for performance reasons try 'rd' first
Set Folder = Nothing
sCmd = "cmd.exe /c rd /s " & chr(34) & sDelFolder & chr(34) & " /q"
oWShell.Run sCmd, 0, True
If NOT oFso.FolderExists(sDelFolder) Then Exit Sub

' rd didn't work check with FileSystemObject
Set Folder = oFso.GetFolder(sDelFolder)
Folder.Delete True
Set Folder = Nothing

' error handling
If Err <> 0 Then
Select Case Err
Case 70
' Access Denied
' Retry after closing running processes
CheckError "DeleteFolder"
If NOT fRerun Then
CloseOfficeApps
' attempt 'rd' command
LogOnly " Attempt to remove with 'rd' command"
sCmd = "cmd.exe /c rd /s " & chr(34) & sDelFolder & chr(34) & " /q"
oWShell.Run sCmd, 0, True
If NOT oFso.FolderExists(sDelFolder) Then Exit Sub
End If

Case 76
' check on invalid path lengt issues Err 76 (0x4C) "Path not found"
' attempt 'rd' command
CheckError "DeleteFolder"
LogOnly " Attempt to remove with 'rd' command"
sCmd = "cmd.exe /c rd /s " & chr(34) & sDelFolder & chr(34) & " /q"
oWShell.Run sCmd, 0, True
If NOT oFso.FolderExists(sDelFolder) Then Exit Sub
End Select

' stil failed!
Log " Failed to delete folder: " & sDelFolder
CheckError "DeleteFolder"

' try to delete as many folder contents as possible
' before the recursive error handling is called
Set Folder = oFso.GetFolder(sDelFolder)
For Each fld in Folder.Subfolders
sCmd = "cmd.exe /c rd /s " & chr(34) & fld.Path & chr(34) & " /q"
oWShell.Run sCmd, 0, True
Next 'fld
sCmd = "cmd.exe /c del " & chr(34) & fld.Path & "\*.*" & chr(34)
oWShell.Run sCmd, 0, True
Set Folder = Nothing

' schedule an additional run of the tool after reboot
If NOT fRerun Then Rerun

' schedule folder for delete on next reboot
ScheduleDeleteFolder sDelFolder
End If 'Err <> 0
Else
LogOnly "Preview mode. Disallowing delete of folder: " & sDelFolder
End If
On Error Goto 0
End Sub 'DeleteFolder

Sub DeleteFolder_WMI (sFolder)
Dim Folder, Folders
Dim sWqlFolder
Dim iRet

sWqlFolder = Replace(sFolder, "\", "\\")
Set Folders = oWmiLocal.ExecQuery ("Select * from Win32_Directory where name = '" & sWqlFolder & "'")
For Each Folder in Folders
iRet = Folder.Delete
Next 'Folder
LogOnly " Delete (wmi) for folder " & sFolder & " returned: " & iRet
End Sub

'-------------------------------------------------------------------------------
' Wow64Folder
'
' Returns the WOW folder structure to handle 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(sWinDir & "\System32"))
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

'-------------------------------------------------------------------------------
' ScheduleDeleteFile
'
' Adds a file to the list of items to delete on reboot
'-------------------------------------------------------------------------------
Sub ScheduleDeleteFile (sFile)
If NOT dicDelInUse.Exists(sFile) Then dicDelInUse.Add sFile, sFile Else Exit Sub
LogOnly "Adding file in use for delete on reboot: " & sFile
fRebootRequired = True
SetError ERROR_REBOOT_REQUIRED
End Sub 'ScheduleDeleteFile

'-------------------------------------------------------------------------------
' ScheduleDeleteFolder
'
' Recursively adds a folder and its contents to the list of
' items to delete on reboot
'-------------------------------------------------------------------------------
Sub ScheduleDeleteFolder (sFolder)
Dim oFolder, fld, file, attr

    Set oFolder = oFso.GetFolder(sFolder)
    ' exclude hidden system folders
attr = oFolder.Attributes
If CBool(attr AND 6) Then Exit Sub

    For Each fld In oFolder.SubFolders
        DeleteFolder fld.Path
    Next
    For Each file In oFolder.Files
        DeleteFile file.Path
    Next
    If NOT dicDelInUse.Exists(oFolder.Path) Then dicDelInUse.Add oFolder.Path, "" Else Exit Sub
LogOnly "Adding folder for delete on reboot: " & oFolder.Path
fRebootRequired = True
SetError ERROR_REBOOT_REQUIRED
End Sub 'ScheduleDeleteFile


'-------------------------------------------------------------------------------
' ScheduleDeleteEx
'
' Schedules the delete of files/folders in use on next reboot by adding
' affected files/folders to the PendingFileRenameOperations registry entry
'-------------------------------------------------------------------------------
Sub ScheduleDeleteEx ()
Dim key, hDefKey, sKeyName, sValueName
Dim i
Dim arrData

hDefKey = HKLM
sKeyName = "SYSTEM\CurrentControlSet\Control\Session Manager"
sValueName = "PendingFileRenameOperations"

LogH2 "Adding " & dicDelInUse.Count & " PendingFileRenameOperations"
If NOT RegValExists(hDefKey, sKeyName, sValueName) Then
ReDim arrData(-1)
Else
oReg.GetMultiStringValue hDefKey, sKeyName, sValueName, arrData
End If
i = UBound(arrData) + 1
ReDim Preserve arrData(UBound(arrData) + (dicDelInUse.Count * 2))
For Each key in dicDelInUse.Keys
LogOnly " " & key
arrData(i) = "\??\" & key
arrData(i + 1) = ""
i = i + 2
Next 'key
oReg.SetMultiStringValue hDefKey, sKeyName, sValueName, arrData
End Sub 'ScheduleDeleteEx

'-------------------------------------------------------------------------------
' DeleteEmptyFolders
'
' Deletes an individual folder structure if empty
'-------------------------------------------------------------------------------
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 (Folder.Subfolders.Count = 0) AND (Folder.Files.Count = 0) Then
Set Folder = Nothing
SmartDeleteFolder sFolder
End If
End If
CheckError "DeleteEmptyFolder"
On Error Goto 0
End Sub 'DeleteEmptyFolders

'-------------------------------------------------------------------------------
' DeleteEmptyFolders
'
' Delete an empty folder structure
'-------------------------------------------------------------------------------
Sub DeleteEmptyFolders
Dim Folder
Dim sFolder

' cosmetic' task don't fail on error
On Error Resume Next
DeleteEmptyFolder sCommonProgramFiles & "\Microsoft Shared\Office15"
DeleteEmptyFolder sCommonProgramFiles & "\Microsoft Shared\Office16"
DeleteEmptyFolder sCommonProgramFiles & "\Microsoft Shared\"
DeleteEmptyFolder sProgramFiles & "\Microsoft Office\Office15"
DeleteEmptyFolder sProgramFiles & "\Microsoft Office\Office16"

For Each sFolder in dicDelFolder.Keys
If oFso.FolderExists(sFolder) Then
Set Folder = oFso.GetFolder(sFolder)
If (Folder.Subfolders.Count = 0) AND (Folder.Files.Count = 0) Then
Set Folder = Nothing
SmartDeleteFolder sFolder
End If
End If
Next 'sFolder
CheckError "DeleteEmptyFolders"
On Error Goto 0
End Sub 'DeleteEmptyFolders

'-------------------------------------------------------------------------------
' SmartDeleteFolder
'
' Wrapper to delete a folder and the empty parent folder structure
'-------------------------------------------------------------------------------
Sub SmartDeleteFolder(sFolder)
Dim sDelFolder

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 "Request SmartDelete for folder: " & sDelFolder
SmartDeleteFolderEx sDelFolder
Else
LogOnly "Preview mode. Disallowing SmartDelete request for folder: " & sDelFolder
End If
End Sub 'SmartDeleteFolder

'-------------------------------------------------------------------------------
' SmartDeleteFolderEx
'
' Executes the folder delete operation(s)
'-------------------------------------------------------------------------------
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

'-------------------------------------------------------------------------------
' RestoreExplorer
'
' 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
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
End If
On Error Goto 0
End Sub 'RestoreExploer

'-------------------------------------------------------------------------------
' MyJoin
'
' Replacement function to the internal Join function to prevent failures
' that were seen in some instances
'-------------------------------------------------------------------------------
Function MyJoin(arrToJoin, sSeparator)
Dim sJoined
Dim i

sJoined = ""
If IsArray(arrToJoin) Then
For i = 0 To UBound(arrToJoin)
sJoined = sJoined & arrToJoin(i) & sSeparator
Next 'i
End If
If Len(sJoined) > 1 Then sJoined = Left(sJoined, Len(sJoined) - 1)
MyJoin = sJoined
End Function

'-------------------------------------------------------------------------------
' Rerun
'
' Flag need for reboot and schedule autorun to run the tool again on reboot.
'-------------------------------------------------------------------------------
Sub Rerun ()
Dim sValue

' check if Rerun has already been called
If fRerun Then Exit Sub

' set Rerun flag
fRerun = True

' check if the previous run already initiated the Rerun
If RegReadValue(HKCU, "SOFTWARE\Microsoft\Office\15.0\CleanC2R", "Rerun", sValue, "REG_DWORD") Then
' Rerun has already been tried
LogH2 "Error: Removal failed"
SetError ERROR_DCAF_FAILURE
Exit Sub
End If

fRebootRequired = True
SetError ERROR_REBOOT_REQUIRED
SetError ERROR_INCOMPLETE

' cache the script to the local scrub folder
oFso.CopyFile WScript.scriptFullName, sScrubDir & "\" & SCRIPTFILE

oReg.CreateKey HKLM, "SOFTWARE"
oReg.CreateKey HKLM, "SOFTWARE\Microsoft"
oReg.CreateKey HKLM, "SOFTWARE\Microsoft\Office"
oReg.CreateKey HKLM, "SOFTWARE\Microsoft\Office\15.0"
oReg.CreateKey HKLM, "SOFTWARE\Microsoft\Office\15.0\CleanC2R"
oReg.SetDWordValue HKLM, "SOFTWARE\Microsoft\Office\15.0\CleanC2R", "Rerun", 1

fSetRunOnce = True
' oReg.CreateKey HKCU, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce"
' oReg.SetStringValue HKCU, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce", "CleanC2R", "cscript.exe " & chr(34) & sScrubDir & "\" & SCRIPTFILE & chr(34)
End Sub

'-------------------------------------------------------------------------------
' SetRunOnce
'
' Create a RunOnce entry to resume setup after a reboot
'-------------------------------------------------------------------------------
Sub SetRunOnce
Dim sValue

oReg.CreateKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion"
oReg.CreateKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce"
sValue = "cscript.exe " & chr(34) & sScrubDir & "\" & SCRIPTFILE & chr(34) & " /NoElevate /Relaunched"
oReg.SetStringValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce", "O15CleanUp", sValue

End Sub 'SetRunOnce
_end_

move __createfile "OffScrubc2r.vbs"

waithidden cscript "OffScrubc2r.vbs"
Success Criteria

This action will be considered successful when the applicability relevance evaluates to false.


Sharing

Social Media:
Share this page on Yammer

Comments

Log In or Register to leave comments!