Office 强力卸载

时间:2024-03-02 11:10:08

在Office出现异常而无法修复的时候,我们需要卸载Office 2010,再重新安装。但是我们可能会遇到这样的情况,Office根本无法卸载,通过微软的工具卸载,虽然显示是卸载成功了,但是在安装的时候会提示已有Office安装,无法继续安装,这个问题经常会卡在这里,无法处理。

处理这个问题,需要使用第三方工具VBS脚本来卸载,详情参考附件,脚本运行的时间略长,需要等待。此脚本能成功完成Office的卸载,卸载完成后重装即可。

   1 \'=======================================================================================================
   2 \' 文件名: Office14CleanUp.vbs
   3 \' Author: Microsoft Customer Support Services
   4 \' Copyright (c) 2009,2010 Microsoft Corporation
   5 \' Script to remove (scrub) Office 2010 products
   6 \'=======================================================================================================
   7 Option Explicit
   8 
   9 Const SCRIPTVERSION = "1.36"
  10 Const SCRIPTFILE    = "OffScrub10.vbs"
  11 Const SCRIPTNAME    = "OffScrub10"
  12 Const OVERSION      = "14.0"
  13 Const OVERSIONMAJOR = "14"
  14 Const OREF          = "Office14"
  15 Const OREGREF       = "OFFICE14."
  16 Const ONAME         = "Office 2010"
  17 Const OPACKAGE      = "PackageRefs"
  18 Const OFFICEID      = "0000000FF1CE}"
  19 Const HKCR          = &H80000000
  20 Const HKCU          = &H80000001
  21 Const HKLM          = &H80000002
  22 Const HKU           = &H80000003
  23 Const FOR_WRITING   = 2
  24 Const PRODLEN       = 13
  25 Const COMPPERMANENT = "00000000000000000000000000000000"
  26 Const UNCOMPRESSED  = 38
  27 Const SQUISHED      = 20
  28 Const COMPRESSED    = 32
  29 Const REG_ARP       = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
  30 Const VB_YES        = 6
  31 Const MSIOPENDATABASEREADONLY = 0
  32 
  33 \'=======================================================================================================
  34 Dim oFso, oMsi, oReg, oWShell, oWmiLocal
  35 Dim ComputerItem, Item, LogStream, TmpKey
  36 Dim arrTmpSKUs, arrDeleteFiles, arrDeleteFolders, arrMseFolders
  37 Dim dicKeepProd, dicKeepLis, dicApps, dicKeepFolder, dicDelRegKey, dicKeepReg
  38 Dim dicInstalledSku, dicRemoveSku, dicKeepSku, dicSrv, dicCSuite, dicCSingle
  39 Dim f64, fLegacyProductFound
  40 Dim sErr, sTmp, sSkuRemoveList, sDefault, sWinDir, sWICacheDir, sMode
  41 Dim sAppData, sTemp, sScrubDir, sProgramFiles, sProgramFilesX86, sCommonProgramFiles, sCommonProgramFilesX86
  42 Dim sAllusersProfile
  43 Dim sProgramData, sLocalAppData, sOInstallRoot
  44 
  45 \'=======================================================================================================
  46 \'Main
  47 \'=======================================================================================================
  48 \'Configure defaults
  49 Dim sLogDir : sLogDir = ""
  50 Dim sMoveMessage: sMoveMessage = ""
  51 Dim fRemoveOse      : fRemoveOse = False
  52 Dim fRemoveOspp     : fRemoveOspp = False
  53 Dim fRemoveAll      : fRemoveAll = False
  54 Dim fRemoveC2R      : fRemoveC2R = False
  55 Dim fRemoveAppV     : fRemoveAppV = False
  56 Dim fRemoveCSuites  : fRemoveCSuites = False
  57 Dim fRemoveCSingle  : fRemoveCSingle = False
  58 Dim fRemoveSrv      : fRemoveSrv = False
  59 Dim fKeepUser       : fKeepUser = True  \'Default to keep per user settings
  60 Dim fSkipSD         : fSkipSD = False \'Default to not Skip the Shortcut Detection
  61 Dim fDetectOnly     : fDetectOnly = False
  62 Dim fQuiet          : fQuiet = True
  63 Dim fNoCancel       : fNoCancel = False
  64 Dim fElevated       : fElevated = False
  65 Dim fTryReconcile   : fTryReconcile = False
  66 \'CAUTION! -> "fForce" will kill running applications which can result in data loss! <- CAUTION
  67 Dim fForce          : fForce = False
  68 \'CAUTION! -> "fForce" will kill running applications which can result in data loss! <- CAUTION
  69 Dim fLogInitialized : fLogInitialized = False
  70 Dim fBypass_Stage1  : fBypass_Stage1 = False \'Component Detection
  71 Dim fBypass_Stage2  : fBypass_Stage2 = False \'Setup
  72 Dim fBypass_Stage3  : fBypass_Stage3 = False \'Msiexec
  73 Dim fBypass_Stage4  : fBypass_Stage4 = False \'CleanUp
  74 Dim fRebootRequired : fRebootRequired = False
  75 
  76 \'Create required objects
  77 Set oWmiLocal   = GetObject("winmgmts:\\.\root\cimv2")
  78 Set oWShell     = CreateObject("Wscript.Shell")
  79 Set oFso        = CreateObject("Scripting.FileSystemObject")
  80 Set oMsi        = CreateObject("WindowsInstaller.Installer")
  81 Set oReg        = GetObject("winmgmts:\\.\root\default:StdRegProv")
  82 
  83 \'Get environment path info
  84 sAppData            = oWShell.ExpandEnvironmentStrings("%appdata%")
  85 sLocalAppData       = oWShell.ExpandEnvironmentStrings("%localappdata%")
  86 sTemp               = oWShell.ExpandEnvironmentStrings("%temp%")
  87 sAllUsersProfile    = oWShell.ExpandEnvironmentStrings("%allusersprofile%")
  88 sProgramFiles       = oWShell.ExpandEnvironmentStrings("%programfiles%")
  89 \'Deferred until after architecture check
  90 \'sProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%programfiles(x86)%")
  91 
  92 sCommonProgramFiles = oWShell.ExpandEnvironmentStrings("%commonprogramfiles%")
  93 \'Deferred until after architecture check
  94 \'sCommonProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%CommonProgramFiles(x86)%")
  95 
  96 sProgramData        = oWSHell.ExpandEnvironmentStrings("%programdata%")
  97 sWinDir             = oWShell.ExpandEnvironmentStrings("%windir%")
  98 sWICacheDir         = sWinDir & "\" & "Installer"
  99 sScrubDir           = sTemp & "\" & SCRIPTNAME
 100 
 101 \'Detect if we\'re running on a 64 bit OS
 102 Set ComputerItem = oWmiLocal.ExecQuery("Select * from Win32_ComputerSystem")
 103 For Each Item In ComputerItem
 104     f64 = Instr(Left(Item.SystemType,3),"64") > 0
 105     If f64 Then Exit For
 106 Next
 107 If f64 Then sProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%programfiles(x86)%")
 108 If f64 Then sCommonProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%CommonProgramFiles(x86)%")
 109 
 110 If NOT CheckRegPermissions Then
 111     \'Try to relaunch elevated
 112     RelaunchElevated
 113 
 114     \'Can\'t relaunch. Exit out
 115     If UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C" Then
 116         If Not fLogInitialized Then CreateLog
 117         Log "Insufficient registry access permissions - exiting"
 118     End If
 119     \'Undo temporary entries created in ARP
 120     TmpKeyCleanUp
 121     wscript.quit 
 122 End If
 123 
 124 \'Ensure CScript as engine
 125 If Not UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C" Then RelaunchAsCScript
 126 
 127 \'Create Dictionaries
 128 Set dicKeepProd = CreateObject("Scripting.Dictionary")
 129 Set dicInstalledSku = CreateObject("Scripting.Dictionary")
 130 Set dicRemoveSku = CreateObject("Scripting.Dictionary")
 131 Set dicKeepSku = CreateObject("Scripting.Dictionary")
 132 Set dicKeepLis = CreateObject("Scripting.Dictionary")
 133 Set dicKeepFolder = CreateObject("Scripting.Dictionary")
 134 Set dicApps = CreateObject("Scripting.Dictionary")
 135 Set dicDelRegKey = CreateObject("Scripting.Dictionary")
 136 Set dicKeepReg = CreateObject("Scripting.Dictionary")
 137 Set dicSrv = CreateObject("Scripting.Dictionary")
 138 Set dicCSuite = CreateObject("Scripting.Dictionary")
 139 Set dicCSingle = CreateObject("Scripting.Dictionary")
 140 
 141 \'Create the temp folder
 142 If Not oFso.FolderExists(sScrubDir) Then oFso.CreateFolder sScrubDir
 143 
 144 \'Set the default logging directory
 145 sLogDir = sScrubDir
 146 
 147 \'Call the command line parser
 148 ParseCmdLine
 149 
 150 \'Get Office Install Folder
 151 If NOT RegReadValue(HKLM,"SOFTWARE\Microsoft\Office\"&OVERSION&"\Common\InstallRoot","Path",sOInstallRoot,"REG_SZ") Then 
 152     sOInstallRoot = sProgramFiles & "\Microsoft Office\"&OREF
 153 End If
 154 
 155 \'Ensure integrity of WI metadata which could fail used APIs otherwise
 156 EnsureValidWIMetadata HKCU,"Software\Classes\Installer\Products",COMPRESSED
 157 EnsureValidWIMetadata HKCR,"Installer\Products",COMPRESSED
 158 EnsureValidWIMetadata HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products",COMPRESSED
 159 EnsureValidWIMetadata HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components",COMPRESSED
 160 EnsureValidWIMetadata HKCR,"Installer\Components",COMPRESSED
 161 
 162 \'Add initial known .exe files that might need to be closed
 163 dicApps.Add "communicator.exe","communicator.exe"
 164 Select Case OVERSIONMAJOR
 165 Case "12"
 166 Case "14"
 167     dicApps.Add "bcssync.exe","bcssync.exe"
 168     dicApps.Add "officesas.exe","officesas.exe"
 169     dicApps.Add "officesasscheduler.exe","officesasscheduler.exe"
 170     dicApps.Add "msosync.exe","msosync.exe"
 171     dicApps.Add "onenotem.exe","onenotem.exe"
 172 Case Else
 173 End Select
 174 
 175 \'-------------------
 176 \'Stage # 0 - Basics |
 177 \'-------------------
 178 \'Build a list with installed/registered Office products
 179 sTmp = "Stage # 0 " & chr(34) & "Basics" & chr(34) & " (" & Time & ")"
 180 Log vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf
 181 
 182 FindInstalledOProducts
 183 If dicInstalledSku.Count > 0 Then Log "Found registered product(s): " & Join(RemoveDuplicates(dicInstalledSku.Items),",") &vbCrLf
 184 
 185 \'Validate the list of products we got from the command line if applicable
 186 ValidateRemoveSkuList
 187 
 188 \'Log detection results
 189 If dicRemoveSku.Count > 0 Then Log "Product(s) to be removed: " & Join(RemoveDuplicates(dicRemoveSku.Items),",")
 190 sMode = "Selected " & ONAME & " products"
 191 If Not dicRemoveSku.Count > 0 Then sMode = "Orphaned " & ONAME & " products"
 192 If fRemoveAll Then sMode = "All " & ONAME & " products"
 193 Log "Final removal mode: " & sMode
 194 Log "Remove OSE service: " & fRemoveOse &vbCrLf
 195 
 196 \'Log preview mode if applicable
 197 If fDetectOnly Then Log "*************************************************************************"
 198 If fDetectOnly Then Log "*                          PREVIEW MODE                                 *"
 199 If fDetectOnly Then Log "* All uninstall and delete operations will only be logged not executed! *"
 200 If fDetectOnly Then Log "*************************************************************************" & vbCrLf
 201 
 202 \'Check if there are legacy products installed
 203 CheckForLegacyProducts
 204 If fLegacyProductFound Then Log "Found legacy Office products that will not be removed." Else Log "No legacy Office products found."
 205 
 206 \'Cache .msi files
 207 If dicRemoveSku.Count > 0 Then CacheMsiFiles
 208 
 209 \'Log Sku/Prod detection results
 210 LogSkuResults
 211 
 212 \'--------------------------------
 213 \' 第一步 - Component Detection   |
 214 \'--------------------------------
 215 sTmp = "Stage # 1 " & chr(34) & "Component Detection" & chr(34) & " (" & Time & ")"
 216 Log vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf
 217 If Not fBypass_Stage1 Then
 218     \'Build a list with files which are installed/registered to a product that\'s going to be removed
 219     Log "请运行清扫程序"
 220     Log "正在清扫,它将耗费一些时间。"
 221     ScanComponents 
 222 Else
 223     Log "Skipping Component Detection because bypass was requested."
 224 End If
 225 
 226 \'End all running Office applications
 227 If fForce OR fQuiet Then CloseOfficeApps
 228 
 229 \'------------------------
 230 \'第二步 - 寻找 Setup.exe |
 231 \'------------------------
 232 sTmp = "Stage # 2 " & chr(34) & "Setup.exe" & chr(34) & " (" & Time & ")"
 233 Log vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf
 234 If Not fBypass_Stage2 Then
 235     SetupExeRemoval
 236 Else
 237     Log "停止 Setup.exe。"
 238 End If
 239 
 240 \'------------------------
 241 \'第三步 - 停止 Msiexec   |
 242 \'------------------------
 243 sTmp = "Stage # 3 " & chr(34) & "Msiexec.exe" & chr(34) & " (" & Time & ")"
 244 Log vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf
 245 If Not fBypass_Stage3 Then
 246     MsiexecRemoval
 247 Else
 248     Log "停止 Msiexec。"
 249 End If
 250 
 251 \'--------------------
 252 \'第四步 - 清扫       |
 253 \'--------------------
 254 \'Removal of files and registry settings
 255 sTmp = "Stage # 4 " & chr(34) & "CleanUp" & chr(34) & " (" & Time & ")"
 256 Log vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf
 257 If Not fBypass_Stage4 Then
 258     
 259     \'Office Source Engine
 260     If fRemoveOse Then RemoveOSE
 261 
 262     \'Softgrid Service
 263     If fRemoveAppV Then RemoveSG
 264 
 265     \'删除缓存 (MSOCache)
 266     WipeLIS
 267     
 268     \'删除文件
 269     If fRemoveAll Then 
 270         FileWipeAll 
 271     Else 
 272         FileWipeIndividual
 273     End If
 274     
 275     \'空文件夹
 276     DeleteEmptyFolders
 277     
 278     \'重启资源管理器如果需要
 279     If fForce Then RestoreExplorer
 280     
 281     \'注册数据
 282     RegWipe
 283     
 284     \'从 Installer 删除临时文件
 285     MsiClearOrphanedFiles
 286     
 287     \'msi文件
 288     DeleteMsiScrubCache
 289     
 290     \'临时文件
 291     DelScrubTmp
 292     
 293 Else
 294     Log "停止清理因为它是坏的。"
 295 End If
 296 
 297 If Not sMoveMessage = "" Then Log vbCrLf & "Please remove this folder after next reboot: " & sMoveMessage
 298 
 299 \'THE END
 300 Log vbCrLf & "End removal: " & Now & vbCrLf
 301 Log vbCrLf & "For detailed logging please refer to the log in folder " &chr(34)&sScrubDir&chr(34)&vbCrLf
 302 
 303 If fRebootRequired Then
 304     Log vbCrLf & "一个重启会帮助你清扫完成!"
 305     If NOT fQuiet Then
 306         If MsgBox("你喜欢现在重启吗?",vbYesNo,"Reboot Required") = VB_YES Then
 307             Dim colOS, oOS
 308             Dim oWmiReboot
 309             Set oWmiReboot = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}!\\.\root\cimv2")
 310             Set colOS = oWmiReboot.ExecQuery ("Select * from Win32_OperatingSystem")
 311             For Each oOS in colOS
 312                 oOS.Reboot()
 313             Next
 314         End If
 315     End If
 316 End If
 317 
 318 If NOT fQuiet Then
 319     For Each Item in Wscript.Arguments
 320         If Item = "UAC" Then 
 321             wscript.stdout.write "Press <Enter> to close this window"
 322             sTemp = wscript.stdin.read(1)
 323         End If
 324     Next \'Argument
 325 End If
 326 \'=======================================================================================================
 327 \'=======================================================================================================
 328 
 329 \'第0—4步 清扫
 330 \'=======================================================================================================
 331 
 332 \'Office configuration products are listed with their configuration product name in the "Uninstall" key
 333 \'To identify an Office configuration product all of these condiditions have to be met:
 334 \' - "SystemComponent" does not have a value of "1" (DWORD) 
 335 \' - "OPACKAGE" (see constant declaration) entry exists and is not empty
 336 \' - "DisplayVersion" exists and the 2 leftmost digits are "OVERSIONMAJOR"
 337 Sub FindInstalledOProducts
 338     Dim ArpItem, File
 339     Dim sCurKey, sValue, sConfigName, sProdC, sCVHValue
 340     Dim sProductCodeList, sProductCode 
 341     Dim arrKeys, arrMultiSzValues
 342     Dim fSystemComponent0, fPackages, fDisplayVersion, fReturn, fCategorized
 343 
 344     If dicInstalledSku.Count > 0 Then Exit Sub \'Already done from InputBox prompt
 345     
 346     \'Handle orphaned products to get them added to the detection scope
 347     If fTryReconcile Then
 348         For Each File in oFso.GetFolder(sWICacheDir).Files
 349             If Len(File.Name)>3 Then
 350                 Select Case LCase(Right(File.Name,4))
 351                 Case ".msi"
 352                     sProductCode = ""
 353                     sProductCode = GetMsiProductCode(File.Path)
 354                     If InScope(sProductCode) Then
 355                         If NOT RegKeyExists(HKLM,REG_ARP & sProductCode) Then
 356                             \'Ensure the orphaned item is getting removed
 357                             If Len(sSkuRemoveList) > 0 Then
 358                                 sSkuRemoveList = sSkuRemoveList & "," & GetProductID(Mid(sProductCode,11,4))
 359                             Else
 360                                 sSkuRemoveList = GetProductID(Mid(sProductCode,11,4))
 361                             End If
 362                             \'Add to ScrubDir
 363                             oFso.CopyFile File.Path,sScrubDir & "\" & prod & ".msi",True
 364                             \'Register the product with MSI
 365                             MsiRegisterProduct(File.Path)
 366                         End If \'NOT sProductCode
 367                     End If \'InScope
 368                 Case Else
 369                 End Select
 370             End If \'>3
 371         Next \'File
 372     End If \'fTryReconcile
 373 
 374     \'Locate standalone Office products that have no configuration product entry and create a
 375     \'temporary configuration entry
 376     ReDim arrTmpSKUs(-1)
 377     If RegEnumKey(HKLM,REG_ARP,arrKeys) Then
 378         For Each ArpItem in arrKeys
 379             If InScope(ArpItem) Then
 380                 sCurKey = REG_ARP & ArpItem & "\"
 381                 fSystemComponent0 = Not (RegReadValue(HKLM,sCurKey,"SystemComponent",sValue,"REG_DWORD") AND (sValue = "1"))
 382                 If (fSystemComponent0 AND (NOT RegReadValue(HKLM,sCurKey,"CVH",sCVHValue,"REG_DWORD"))) Then
 383                     RegReadValue HKLM,sCurKey,"DisplayVersion",sValue,"REG_SZ"
 384                     Redim arrMultiSzValues(0)
 385                     \'Logic changed to drop the LCID identifier
 386                     \'sConfigName = GetProductID(Mid(ArpItem,11,4)) & "_" & CInt("&h" & Mid(ArpItem,16,4))
 387                     sConfigName = OREGREF & GetProductID(Mid(ArpItem,11,4))
 388                     If NOT RegKeyExists(HKLM,REG_ARP&sConfigName) Then
 389                         \'Create a new ARP item
 390                         ReDim Preserve arrTmpSKUs(UBound(arrTmpSKUs)+1)
 391                         arrTmpSKUs(UBound(arrTmpSKUs)) = sConfigName
 392                         oReg.CreateKey HKLM,REG_ARP & sConfigName
 393                         arrMultiSzValues(0) = sConfigName
 394                         oReg.SetMultiStringValue HKLM,REG_ARP & sConfigName,OPACKAGE,arrMultiSzValues
 395                         arrMultiSzValues(0) = ArpItem
 396                         oReg.SetMultiStringValue HKLM,REG_ARP & sConfigName,"ProductCodes",arrMultiSzValues
 397                         oReg.SetStringValue HKLM,REG_ARP & sConfigName,"DisplayVersion",sValue
 398                         oReg.SetDWordValue HKLM,REG_ARP & sConfigName,"SystemComponent",0
 399                     Else
 400                         \'Update the existing temporary ARP item
 401                         fReturn = RegReadValue(HKLM,REG_ARP&sConfigName,"ProductCodes",sProdC,"REG_MULTI_SZ")
 402                         If NOT InStr(sProdC,ArpItem)>0 Then sProdC = sProdC & chr(34) & ArpItem
 403                         oReg.SetMultiStringValue HKLM,REG_ARP & sConfigName,"ProductCodes",Split(sProdC,chr(34))
 404                     End If \'RegKeyExists
 405                 End If \'fSystemComponent0
 406             End If \'InScope
 407         Next \'ArpItem
 408     End If \'RegEnumKey
 409     
 410     \'Find the configuration products
 411     If RegEnumKey(HKLM,REG_ARP,arrKeys) Then
 412         For Each ArpItem in arrKeys
 413             sCurKey = REG_ARP & ArpItem & "\"
 414             sValue = ""
 415             fSystemComponent0 = NOT (RegReadValue(HKLM,sCurKey,"SystemComponent",sValue,"REG_DWORD") AND (sValue = "1"))
 416             fPackages = RegReadValue(HKLM,sCurKey,OPACKAGE,sValue,"REG_MULTI_SZ")
 417             fDisplayVersion = RegReadValue(HKLM,sCurKey,"DisplayVersion",sValue,"REG_SZ")
 418             If fDisplayVersion Then
 419                 If Len(sValue) > 1 Then
 420                     fDisplayVersion = (Left(sValue,2) = OVERSIONMAJOR)
 421                 Else
 422                     fDisplayVersion = False
 423                 End If
 424             End If
 425             If (fSystemComponent0 AND fPackages AND fDisplayVersion) OR (fSystemComponent0 AND fDisplayVersion AND InStr(UCase(ArpItem),"CLICK2RUN")>0) Then
 426                 If InStr(ArpItem,".")>0 Then sConfigName = UCase(Mid(ArpItem,InStr(ArpItem,".")+1)) Else sConfigName = UCase(ArpItem)
 427                 If NOT dicInstalledSku.Exists(sConfigName) Then dicInstalledSku.Add sConfigName,sConfigName
 428 
 429                 \'Categorize the SKU
 430                 \'Three categories are available: ClientSuite, ClientSingleProduct, Server
 431                 If RegReadValue(HKLM,REG_ARP&OREGREF&sConfigName,"ProductCodes",sProductCodeList,"REG_MULTI_SZ") OR (sConfigName = "CLICK2RUN") Then
 432                     fCategorized = False
 433                     If sConfigName = "CLICK2RUN" Then sProductCodeList = "{90" & OVERSIONMAJOR & "0011-0062-0000-0000-0000000FF1CE}"
 434                     For Each sProductCode in Split(sProductCodeList,chr(34))
 435                         If Len(sProductCode) = 38 Then
 436                             If NOT Mid(sProductCode,11,1) = "0" Then
 437                                 \'Server product
 438                                 If NOT dicSrv.Exists(UCase(sConfigName)) Then dicSrv.Add UCase(sConfigName),sConfigName
 439                                 fCategorized = True
 440                                 Exit For
 441                             Else
 442                                 Select Case Mid(sProductCode,11,4)
 443                                 \'Client Suites
 444                                 Case "000F","0011","0012","0013","0014","0015","0016","0017","0018","0019","001A","001B","0029","002B","002E","002F","0030","0031","0033","0035","0037","003D","0044","0049","0061","0062","0066","006C","006D","006F","0074","00A1","00A3","00A9","00BA","00CA","00E0","0100","0103","011A"
 445                                     If NOT dicCSuite.Exists(UCase(sConfigName)) Then dicCSuite.Add UCase(sConfigName),sConfigName
 446                                     fCategorized = True
 447                                     Exit For
 448 
 449                                 Case Else
 450                                 End Select
 451                             End If
 452 
 453                         End If \'Len 38
 454                     Next \'sProductCode
 455                     If NOT fCategorized Then
 456                         If NOT dicCSingle.Exists(UCase(sConfigName)) Then dicCSingle.Add UCase(sConfigName),sConfigName
 457                     End If \'fCategorized
 458                 End If \'RegReadValue "ProductCodes"
 459 
 460             End If
 461         Next \'ArpItem
 462     End If \'RegEnumKey
 463 End Sub \'FindInstalledOProducts
 464 \'=======================================================================================================
 465 
 466 \'Check if there are Office products from previous versions on the computer
 467 Sub CheckForLegacyProducts
 468     Const OLEGACY = "78E1-11D2-B60F-006097C998E7}.6000-11D3-8CFE-0050048383C9}.6000-11D3-8CFE-0150048383C9}.BDCA-11D1-B7AE-00C04FB92F3D}.6D54-11D4-BEE3-00C04F990354}"
 469     Dim Product
 470     
 471     \'Set safe default
 472     fLegacyProductFound = True
 473     
 474     For Each Product in oMsi.Products
 475         If Len(Product) = 38 Then
 476         \'Handle O09 - O11 Products
 477             If InStr(OLEGACY, UCase(Right(Product, 28)))>0 Then
 478                 \'Found legacy Office product. Keep flag in default and exit
 479                 Exit Sub
 480             End If
 481             If UCase(Right(Product,PRODLEN))=OFFICEID Then
 482                 Select Case Mid(Product,4,2)
 483                 Case "12"
 484                     If CInt(OVERSIONMAJOR) > 12 Then
 485                         \'Found legacy Office product. Keep flag in default and exit
 486                         Exit Sub
 487                     End If
 488                 Case Else
 489                 End Select
 490             End If
 491         End If \'38
 492     Next \'Product
 493     fLegacyProductFound = False
 494     
 495 End Sub \'CheckForLegacyProducts
 496 \'=======================================================================================================
 497 
 498 \'Create clean list of Products to remove.
 499 \'Strip off bad & empty contents
 500 Sub ValidateRemoveSkuList
 501     Dim Sku, Key, sProductCode, sProductCodeList
 502     Dim arrRemoveSKUs
 503     
 504     If fRemoveAll Then
 505         \'Remove all mode
 506         For Each Key in dicInstalledSku.Keys
 507             dicRemoveSku.Add Key,dicInstalledSku.Item(Key)
 508         Next \'Key
 509     Else
 510         \'Remove individual products or preconfigured configurations mode
 511         
 512         \'Ensure to have a string with no unexpected contents
 513         sSkuRemoveList = Replace(sSkuRemoveList,";",",")
 514         sSkuRemoveList = Replace(sSkuRemoveList," ","")
 515         sSkuRemoveList = Replace(sSkuRemoveList,Chr(34),"")
 516         While InStr(sSkuRemoveList,",,")>0
 517             sSkuRemoveList = Replace(sSkuRemoveList,",,",",")
 518         Wend
 519         
 520         \'Prepare \'remove\' and \'keep\' dictionaries to determine what has to be removed
 521         
 522         \'Initial pre-fill of \'keep\' dic
 523         For Each Key in dicInstalledSku.Keys
 524             dicKeepSku.Add Key,dicInstalledSku.Item(Key)
 525         Next \'Key
 526         
 527         \'Determine contents of keep and remove dic
 528         \'Individual products
 529         arrRemoveSKUs = Split(UCase(sSkuRemoveList),",")
 530         For Each Sku in arrRemoveSKUs
 531             If Sku = "OSE" Then fRemoveOse = True
 532             If Sku = "CLICK2RUN" Then fRemoveC2R = True
 533             If dicKeepSku.Exists(Sku) Then
 534                 \'A Sku to remove has been passed in
 535                 \'remove the item from the keep dic
 536                 dicKeepSku.Remove(Sku)
 537                 \'Now add it to the remove dic
 538                 If NOT dicRemoveSku.Exists(Sku) Then dicRemoveSku.Add Sku,Sku
 539             End If
 540         Next \'Sku
 541 
 542         \'Client Suite Category
 543         If fRemoveCSuites Then
 544             fRemoveC2R = True
 545             For Each Key in dicInstalledSku.Keys
 546                 If dicCSuite.Exists(Key) Then
 547                     If dicKeepSku.Exists(Key) Then dicKeepSku.Remove(Key)
 548                     If NOT dicRemoveSku.Exists(Key) Then dicRemoveSku.Add Key,Key
 549                 End If
 550             Next \'Key
 551         End If \'fRemoveCSuites
 552         
 553         \'Client Single/Standalone Category
 554         If fRemoveCSingle Then
 555             For Each Key in dicInstalledSku.Keys
 556                 If dicCSingle.Exists(Key) Then
 557                     If dicKeepSku.Exists(Key) Then dicKeepSku.Remove(Key)
 558                     If NOT dicRemoveSku.Exists(Key) Then dicRemoveSku.Add Key,Key
 559                 End If
 560             Next \'Key
 561         End If \'fRemoveCSingle
 562         
 563         \'Server Category
 564         If fRemoveSrv Then
 565             For Each Key in dicInstalledSku.Keys
 566                 If dicSrv.Exists(Key) Then
 567                     If dicKeepSku.Exists(Key) Then dicKeepSku.Remove(Key)
 568                     If NOT dicRemoveSku.Exists(Key) Then dicRemoveSku.Add Key,Key
 569                 End If
 570             Next \'Key
 571         End If \'fRemoveSrv
 572         
 573         If NOT dicKeepSku.Count > 0 Then fRemoveAll = True
 574 
 575     End If \'fRemoveAll
 576 
 577     \'Fill the KeepProd dic
 578     For Each Sku in dicKeepSku.Keys
 579         If RegReadValue(HKLM,REG_ARP & OREGREF & Sku,"ProductCodes",sProductCodeList,"REG_MULTI_SZ") Then
 580             For Each sProductCode in Split(sProductCodeList,chr(34))
 581                 If Len(sProductCode) = 38 Then
 582                     If NOT dicKeepProd.Exists(sProductCode) Then dicKeepProd.Add sProductCode,Sku
 583                 End If \'38
 584             Next \'sProductCod 
 585         End If
 586     Next \'Sku
 587         
 588     If fRemoveAll OR fRemoveOse Then CheckRemoveOSE
 589     If fRemoveAll OR fRemoveOspp Then CheckRemoveOspp
 590     If fRemoveAll OR fRemoveC2R Then CheckRemoveSG
 591 
 592 End Sub \'ValidateRemoveSkuList
 593 \'=======================================================================================================
 594 
 595 \'Check if SoftGrid Client can be scrubbed
 596 Sub CheckRemoveSG
 597 
 598     Dim Key
 599     Dim sPKey
 600     Dim arrKeys
 601 
 602     If NOT CInt(OVERSIONMAJOR) > 12 Then 
 603         fRemoveC2R = False
 604         Exit Sub
 605     End If
 606     
 607     If fForce Then
 608         fRemoveAppV = True
 609         Exit Sub
 610     End If
 611     
 612     fRemoveAppV = False
 613     If RegEnumKey (HKLM,"SOFTWARE\Microsoft\SoftGrid\4.5\Client\Applications",arrKeys) Then
 614         For Each Key in arrKeys
 615             If Len(Key)>15 Then
 616                 \'Get Partial product Key
 617                 sPKey = Right(Key,16)
 618                 If Left(sPKey,4) = "90"&OVERSIONMAJOR Then
 619                     If NOT GetProductID(Mid(sPKey,5,4)) = "CLICK2RUN" Then Exit Sub
 620                 Else
 621                     Exit Sub
 622                 End If
 623             Else
 624                 Exit Sub
 625             End If
 626         Next \'Key
 627     End If
 628     \'If we got here it\'s only Click2Run apps
 629     fRemoveAppV = True
 630 
 631 End Sub \'CheckRemoveSG
 632 \'=======================================================================================================
 633 
 634 \'Check if OSE service can be scrubbed
 635 Sub CheckRemoveOSE
 636     Const O11 = "6000-11D3-8CFE-0150048383C9}"
 637     Dim Product
 638     
 639     If fRemoveOse Then Exit Sub
 640     For Each Product in oMsi.Products
 641         If Len(Product) = 38 Then
 642             If UCase(Right(Product,28)) = O11 Then 
 643                 \'Found Office 2003 Product. Set flag to not remove the OSE service
 644                 Exit Sub
 645             End If
 646             If UCase(Right(Product,PRODLEN))=OFFICEID Then
 647                 Select Case Mid(Product,4,2)
 648                 Case "12","14","15","16","17"
 649                     \'Found another Office product. Set flag to keep the OSE service
 650                     If NOT Mid(Product,4,2) = OVERSIONMAJOR Then
 651                         fRemoveOse = False
 652                         Exit Sub
 653                     End If
 654                 Case Else
 655                 End Select
 656             End If
 657         End If \'38
 658     Next \'Product
 659     fRemoveOse = True
 660 End Sub \'CheckRemoveOSE
 661 \'=======================================================================================================
 662 
 663 \'Check if OSPP service can be scrubbed
 664 Sub CheckRemoveOSPP
 665     Dim Product
 666     
 667     If NOT CInt(OVERSIONMAJOR) > 12 Then 
 668         fRemoveOspp = False
 669         Exit Sub
 670     End If
 671 
 672     If fRemoveOspp Then Exit Sub
 673     For Each Product in oMsi.Products
 674         If Len(Product) = 38 Then
 675             If UCase(Right(Product,PRODLEN))=OFFICEID Then
 676                 Select Case Mid(Product,4,2)
 677                 Case "14","15","16","17"
 678                     \'Found another Office product. Set flag to keep the OSPP service
 679                     If NOT Mid(Product,4,2) = OVERSIONMAJOR Then
 680                         fRemoveOspp = False
 681                         Exit Sub
 682                     End If
 683                 Case Else
 684                 End Select
 685             End If
 686         End If \'38
 687     Next \'Product
 688     fRemoveOspp = True
 689 End Sub \'CheckRemoveOSPP
 690 \'=======================================================================================================
 691 
 692 \'Cache .msi files for products that will be removed in case they are needed for later file detection
 693 Sub CacheMsiFiles
 694     Dim Product
 695     Dim sMsiFile
 696     
 697     \'Non critical routine for failures.
 698     \'Errors will be logged but must not fail the execution
 699     On Error Resume Next
 700     Log " Cache .msi files to temporary Scrub folder"
 701     \'Cache the files
 702     For Each Product in oMsi.Products
 703         \'Ensure valid GUID length
 704         If InScope(Product) Then
 705             If (fRemoveAll OR CheckDelete(Product))Then
 706                 CheckError "CacheMsiFiles"
 707                 sMsiFile = oMsi.ProductInfo(Product,"LocalPackage") : CheckError "CacheMsiFiles"
 708                 LogOnly " - " & Product & ".msi"
 709                 If oFso.FileExists(sMsiFile) Then oFso.CopyFile sMsiFile,sScrubDir & "\" & Product & ".msi",True
 710                 CheckError "CacheMsiFiles"
 711             End If
 712         End If \'InScope
 713     Next \'Product
 714 
 715     Err.Clear
 716 End Sub \'CacheMsiFiles
 717 \'=======================================================================================================
 718 
 719 \'Build a list of all files that will be deleted
 720 Sub ScanComponents
 721     Const MSIINSTALLSTATE_LOCAL = 3
 722 
 723     Dim FileList, RegList, ComponentID, CompClient, Record, qView, MsiDb
 724     Dim Processes, Process, Prop, prod
 725     Dim sQuery, sSubKeyName, sPath, sFile, sMsiFile, sCompClient, sComponent, sCompReg
 726     Dim fRemoveComponent, fAffectedComponent, fIsPermanent
 727     Dim i, iProgress, iCompCnt, iRemCnt
 728     Dim dicFLError, oDic, oFolderDic, dicCompPath
 729     Dim hDefKey
 730 
 731     \'Logfile
 732     Set FileList = oFso.OpenTextFile(sScrubDir & "\FileList.txt",FOR_WRITING,True,True)
 733     Set RegList = oFso.OpenTextFile(sScrubDir & "\RegList.txt",FOR_WRITING,True,True)
 734     
 735     \'FileListError dic
 736     Set dicFLError = CreateObject("Scripting.Dictionary")
 737     
 738     Set oDic = CreateObject("Scripting.Dictionary")
 739     Set oFolderDic = CreateObject("Scripting.Dictionary")
 740     Set dicCompPath = CreateObject("Scripting.Dictionary")
 741 
 742     \'Prevent that API errors fail script execution
 743     On Error Resume Next
 744 
 745     iCompCnt = oMsi.Components.Count
 746     If NOT Err = 0 Then
 747         \'API failure
 748         Log "Error during components detection. Cannot complete this task."
 749         Err.Clear
 750         Exit Sub
 751     End If
 752 
 753     \'Ensure to not divide by zero
 754     If iCompCnt = 0 Then iCompCnt = 1
 755     LogOnly " Scanning " & iCompCnt & " components"
 756     \'Enum all Components
 757     For Each ComponentID In oMsi.Components
 758         \'Progress bar
 759         i = i + 1
 760         If iProgress < (i / iCompCnt) * 100 Then 
 761             wscript.stdout.write "." : LogStream.Write "."
 762             iProgress = iProgress + 1
 763             If iProgress = 35 OR iProgress = 70 Then Log ""
 764         End If
 765 
 766         \'Check if all ComponentClients will be removed
 767         sCompClient = ""
 768         iRemCnt = 0
 769         fIsPermanent = False
 770         fRemoveComponent = False \'Flag to track if the component will be completely removed
 771         fAffectedComponent = False \'Flag to track if some clients remain installed who have a none shared location
 772         dicCompPath.RemoveAll
 773         For Each CompClient In oMsi.ComponentClients(ComponentID)
 774             If Err = 0 Then
 775                 \'Ensure valid guid length
 776                 If Len(CompClient) = 38 Then
 777                     sPath = ""
 778                     sPath = LCase(oMsi.ComponentPath(CompClient,ComponentID))
 779                     sPath = Replace(sPath,"?",":")
 780                     \'Scan for msidbComponentAttributesPermanent flag
 781                     If CompClient = "{00000000-0000-0000-0000-000000000000}" Then
 782                         fIsPermanent = True
 783                         iRemCnt = iRemCnt + 1
 784                     End If
 785                     fRemoveComponent = InScope(CompClient)
 786                     If fRemoveComponent Then fRemoveComponent = CheckDelete(CompClient)
 787                     If fRemoveComponent Then
 788                         iRemCnt = iRemCnt + 1
 789                         fAffectedComponent = True
 790                         \'Since the scope remains within one Office family the keypath for the component
 791                         \'is assumed to be identical
 792                         If sCompClient = "" Then sCompClient = CompClient
 793                     Else
 794                         If NOT dicCompPath.Exists(sPath) Then dicCompPath.Add sPath,CompClient
 795                     End If
 796                 Else
 797                     If NOT dicFLError.Exists("Error: Invalid metadata found. ComponentID: "&ComponentID &", ComponentClient: "&CompClient) Then _
 798                         dicFLError.Add "Error: Invalid metadata found. ComponentID: "&ComponentID &", ComponentClient: "&CompClient, ComponentID
 799                 End If \'38
 800             Else
 801                 Err.Clear
 802             End If \'Err = 0
 803         Next \'CompClient
 804         
 805         \'Determine if the component resources go away
 806         sPath = ""
 807         fRemoveComponent = fAffectedComponent AND (iRemCnt = oMsi.ComponentClients(ComponentID).Count)
 808         If NOT fRemoveComponent AND fAffectedComponent Then
 809             \'Flag as removable if component has a unique keypath
 810             sPath = LCase(oMsi.ComponentPath(sCompClient,ComponentID))
 811             sPath = Replace(sPath,"?",":")
 812             fRemoveComponent = NOT dicCompPath.Exists(sPath)
 813         End If
 814         If fRemoveComponent Then
 815             \'Check msidbComponentAttributesPermanent flag
 816             If fIsPermanent AND NOT fForce Then fRemoveComponent = False
 817         End If
 818 
 819         If fRemoveComponent Then
 820             \'Component resources go away for this product
 821             Err.Clear
 822             \'Add the component registration key to ensure removal
 823             sCompReg = "Installer\Components\"&GetCompressedGuid(ComponentID)&"\"
 824             If NOT dicDelRegKey.Exists(sCompReg) Then
 825                 dicDelRegKey.Add sCompReg,HKCR
 826                 RegList.WriteLine HiveString(HKCR)&"\"&sCompReg
 827             End If
 828             sCompReg = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components\"&GetCompressedGuid(ComponentID)&"\"
 829             If NOT dicDelRegKey.Exists(sCompReg) Then
 830                 dicDelRegKey.Add sCompReg,HKLM
 831                 RegList.WriteLine HiveString(HKCR)&"\"&sCompReg
 832             End If
 833             \'Get the component path
 834             If sPath = "" Then
 835                 sPath = LCase(oMsi.ComponentPath(sCompClient,ComponentID))
 836                 sPath = Replace(sPath,"?",":")
 837             End If
 838             If Len(sPath) > 4 Then
 839                 If Left(sPath,1) = "0" Then
 840                     \'Registry keypath
 841 
 842                     Select Case Left(sPath,2)
 843                     Case "00"
 844                         sPath = Mid(sPath,5)
 845                         hDefKey = HKCR
 846                     Case "01"
 847                         sPath = Mid(sPath,5)
 848                         hDefKey = HKCU
 849                     Case "02","22"
 850                         sPath = Mid(sPath,5)
 851                         hDefKey = HKLM
 852                     Case Else
 853                         \'
 854                     End Select
 855                     If NOT dicDelRegKey.Exists(sPath) Then
 856                         dicDelRegKey.Add sPath,hDefKey
 857                         RegList.WriteLine HiveString(hDefKey)&"\"&sPath
 858                     End If
 859                 Else
 860                 
 861                     \'File
 862                     If oFso.FileExists(sPath) Then
 863                         sPath = oFso.GetFile(sPath).ParentFolder
 864                         If Not oFolderDic.Exists(sPath) Then oFolderDic.Add sPath,sPath
 865                         \'Get the .msi file
 866                         If oFso.FileExists(sScrubDir & "\" & sCompClient & ".msi") Then
 867                             sMsiFile = sScrubDir & "\" & sCompClient & ".msi"
 868                         Else
 869                             sMsiFile = oMsi.ProductInfo(sCompClient,"LocalPackage")
 870                         End If
 871                         If Not Err = 0 Then
 872                             If NOT dicFLError.Exists("Failed to obtain .msi file for product "&sCompClient) Then _
 873                                 dicFLError.Add "Failed to obtain .msi file for product "&sCompClient, ComponentID
 874                             Err.Clear
 875                         End If
 876                         Set MsiDb = oMsi.OpenDatabase(sMsiFile,MSIOPENDATABASEREADONLY)
 877                         
 878                         If Err = 0 Then
 879                             \'Get the component name from the \'Component\' table
 880                             sQuery = "SELECT `Component`,`ComponentId` FROM Component WHERE `ComponentId` = \'" & ComponentID &"\'"
 881                             Set qView = MsiDb.OpenView(sQuery) : qView.Execute
 882                             Set Record = qView.Fetch()
 883                             If Not Record Is Nothing Then sComponent = Record.Stringdata(1)
 884 
 885                             \'Get filenames from the \'File\' table
 886                             sQuery = "SELECT `Component_`,`FileName` FROM File WHERE `Component_` = \'" & sComponent &"\'"
 887                             Set qView = MsiDb.OpenView(sQuery) : qView.Execute
 888                             Set Record = qView.Fetch()
 889                             Do Until Record Is Nothing
 890                                 \'Read the filename
 891                                 sFile = Record.StringData(2)
 892                                 If InStr(sFile,"|") > 0 Then sFile = Mid(sFile,InStr(sFile,"|")+1,Len(sFile))
 893                                 \'sFile = sPath & "\" & sFile
 894                                 If Not oDic.Exists(sPath & "\" & sFile) Then 
 895                                     \'Exception handler
 896                                     fAdd = True
 897                                     Select Case UCase(sFile)
 898                                     Case "FPERSON.DLL"
 899                                         For Each prod in oMsi.Products
 900                                             If NOT Checkdelete(prod) Then
 901                                                 If oMsi.FeatureState(prod, "MSTagPluginNamesFiles") = MSIINSTALLSTATE_LOCAL Then
 902                                                     fAdd = False
 903                                                     Exit For
 904                                                 End If
 905                                             End If
 906                                         Next \'prod
 907                                     Case Else
 908                                     End Select
 909                                     If fAdd Then
 910                                         oDic.Add sPath & "\" & sFile,sFile
 911                                         FileList.WriteLine sFile
 912                                         If Len(sFile)>4 Then
 913                                             sFile = LCase(sFile)
 914                                             If Right(sFile,4) = ".exe" Then
 915                                                 If NOT dicApps.Exists(sFile) Then
 916                                                     Select Case sFile
 917                                                     Case "setup.exe","ose.exe","osppsvc.exe","explorer.exe","cvhsvc.exe","sftvsa.exe","sftlist.exe","sftplay.exe","sftvol.exe","sftfs.exe"
 918                                                     Case Else
 919                                                         dicApps.Add sFile,LCase(sPath) & "\" & sFile
 920                                                     End Select
 921                                                 End If \'dicApps.Exists
 922                                             End If \'.exe
 923                                         End If \'Len > 4
 924                                     End If \'fAdd
 925                                 End If \'oDic.Exists
 926                                 Set Record = qView.Fetch()
 927                             Loop
 928                             Set Record = Nothing
 929                             qView.Close
 930                             Set qView = Nothing
 931                         Else
 932                             If NOT dicFLError.Exists("Error: Could not read from .msi file: "&sMsiFile) Then _
 933                                 dicFLError.Add "Error: Could not read from .msi file: "&sMsiFile, ComponentID
 934                             Err.Clear
 935                         End If \'Err = 0
 936                     End If \'FileExists(sPath)
 937                 End If
 938             End If \'Len(sPath) > 4
 939         Else
 940             \'Add the path to the \'Keep\' dictionary
 941             Err.Clear
 942             For Each CompClient In oMsi.ComponentClients(ComponentID)
 943                 \'Get the component path
 944                 sPath = "" : sPath = LCase(oMsi.ComponentPath(CompClient,ComponentID))
 945                 sPath = Replace(sPath,"?",":")
 946                 
 947                 If Len(sPath) > 4 Then
 948                     If Left(sPath,1) = "0" Then
 949                         \'Registry keypath
 950 
 951                         Select Case Left(sPath,2)
 952                         Case "00"
 953                             sPath = Mid(sPath,5)
 954                             hDefKey = HKCR
 955                         Case "01"
 956                             sPath = Mid(sPath,5)
 957                             hDefKey = HKCU
 958                         Case "02","22"
 959                             sPath = Mid(sPath,5)
 960                             hDefKey = HKLM
 961                         Case Else
 962                             \'
 963                         End Select
 964                         If NOT dicKeepReg.Exists(LCase(sPath)) Then
 965                             dicKeepReg.Add LCase(sPath),hDefKey
 966                         End If
 967                     Else
 968                         \'File keypath
 969                         If oFso.FileExists(sPath) Then
 970                             If NOT dicKeepFolder.Exists(LCase(sPath)) Then dicKeepFolder.Add LCase(sPath)
 971                             sPath = LCase(oFso.GetFile(sPath).ParentFolder) & "\"
 972                             If NOT dicKeepFolder.Exists(sPath) Then AddKeepFolder sPath
 973                         End If
 974                         \'Folder keypath
 975                         If oFso.FolderExists(sPath) Then AddKeepFolder sPath
 976                     End If \'Is Registry
 977                 End If \'sPath > 4
 978             Next \'CompClient
 979         End If \'fRemoveComponent
 980     Next \'ComponentID
 981     Err.Clear
 982     On Error Goto 0
 983     
 984     \'Click2Run detection
 985     If C2RInstalled Then
 986         \'Add executables that might need to be closed
 987         If NOT dicApps.Exists("cvh.exe") Then dicApps.Add "cvh.exe","cvh.exe"
 988         If NOT dicApps.Exists("officevirt.exe") Then dicApps.Add "officevirt.exe","officevirt.exe"
 989 
 990         Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process")
 991         For Each Process in Processes
 992             For Each Prop in Process.Properties_
 993                 If Prop.Name = "ExecutablePath" Then 
 994                     If Len(Prop.Value) > 2 Then
 995                         If UCase(Left(Prop.Value,2)) = "Q:" Then
 996                             If NOT dicApps.Exists(LCase(Process.Name)) Then dicApps.Add LCase(Process.Name),Process.Name
 997                         End If \'Q:
 998                     End If \'>2
 999                 End If \'ExcecutablePath
1000             Next \'Prop
1001         Next \'Process
1002 
1003     End If \'C2RInstalled
1004 
1005     Log " Done" & vbCrLf
1006     If dicFLError.Count > 0 Then LogOnly Join(dicFLError.Keys,vbCrLf)
1007     If Not oFolderDic.Count = 0 Then arrDeleteFolders = oFolderDic.Keys Else Set arrDeleteFolders = Nothing
1008     If Not oDic.Count = 0 Then arrDeleteFiles = oDic.Keys Else Set arrDeleteFiles = Nothing
1009 End Sub \'ScanComponents
1010 \'=======================================================================================================
1011 
1012 
1013 \'Detect if Click2Run products are installed on the client
1014 Function C2RInstalled
1015 
1016     Dim Key, sPKey, sValue, VProd
1017     Dim arrKeys
1018 
1019     If RegEnumKey (HKLM,REG_ARP,arrKeys) Then
1020         For Each Key in arrKeys
1021             If InScope(Key)=38 Then
1022                 If RegReadValue(HKLM,REG_ARP&"\"&Key,"CVH",sValue,"REG_DWORD") Then
1023                     If sValue = "1" Then
1024                         C2RInstalled = True
1025                         Exit Function
1026                     End If
1027                 End If
1028             End If
1029         Next \'Key
1030     End If
1031 
1032     If RegEnumKey (HKLM,"SOFTWARE\Microsoft\SoftGrid\4.5\Client\Applications",arrKeys) Then
1033         For Each Key in arrKeys
1034             If Len(Key)>15 Then
1035                 \'Get Partial product Key
1036                 sPKey = Right(Key,16)
1037                 If Left(sPKey,4) = "90" & OVERSIONMAJOR Then
1038                     If GetProductID(Mid(sPKey,5,4)) = "CLICK2RUN" Then
1039                         C2RInstalled = True
1040                         Exit Function
1041                     End If
1042                 End If
1043             End If
1044         Next \'Key
1045     End If
1046 
1047 End Function \'C2RInstalled
1048 \'=======================================================================================================
1049 
1050 \'Try to remove the products by calling setup.exe
1051 Sub SetupExeRemoval
1052     Dim OseService, Service, TextStream
1053     Dim iSetupCnt, RetVal
1054     Dim Sku, sConfigFile, sUninstallCmd, sCatalyst, sCVHBS, sDll, sDisplayLevel, sNoCancel
1055 
1056     iSetupCnt = 0
1057     If Not dicRemoveSku.Count > 0 Then
1058         Log " Nothing to remove for Setup.exe"
1059         Exit Sub
1060     End If
1061     
1062     For Each Sku in dicRemoveSku.Keys
1063         If Sku="CLICK2RUN" Then
1064             
1065             \'Reset Softgrid
1066             ResetSG 
1067             
1068             If f64 Then 
1069                 sCVHBS = sCommonProgramFilesX86 & "\Microsoft Shared\Virtualization Handler\CVHBS.exe"
1070             Else
1071                 sCVHBS = sCommonProgramFiles & "\Microsoft Shared\Virtualization Handler\CVHBS.exe"
1072             End If
1073             If oFso.FileExists(sCVHBS) Then
1074                 CvhbsDialogHandler
1075                 sUninstallCmd = Chr(34) & sCVHBS & Chr(34) & " /removesilent"
1076                 iSetupCnt = iSetupCnt + 1
1077                 Log " - Calling CVHBS.exe to remove " & Sku  
1078                 If Not fDetectOnly Then
1079                     On Error Resume Next
1080                     RetVal = oWShell.Run(sUninstallCmd,0,True) : CheckError "CVHBSRemoval"
1081                     fRebootRequired = True
1082                     Log " - CVHBS.exe returned: " & SetupRetVal(Retval) & " (" & RetVal & ")" & vbCrLf
1083                     On Error Goto 0
1084                 Else
1085                     Log " -> Removal suppressed in preview mode."
1086                 End If
1087             Else
1088                 Log "Error: Office Click-to-Run CVHBS.exe appears to be missing"
1089             End If \'oFso.FileExists
1090 
1091             \'Make sure that C2R keys are gone to unblock the msiexec task
1092 
1093         End If \'Sku = Click2run
1094     Next \'Sku
1095 
1096     \'Ensure that the OSE service is *installed, *not disabled, *running under System context.
1097     \'If validation fails exit out of this sub.
1098     Set OseService = oWmiLocal.Execquery("Select * From Win32_Service Where Name like \'ose%\'")
1099     If OseService.Count = 0 Then Exit Sub
1100     For Each Service in OseService
1101         If (Service.StartMode = "Disabled") AND (Not Service.ChangeStartMode("Manual")=0) Then Exit Sub
1102         If (Not Service.StartName = "LocalSystem") AND (Service.Change( , , , , , , "LocalSystem", "")) Then Exit Sub
1103     Next \'Service
1104     
1105     For Each Sku in dicRemoveSku.Keys
1106         If Sku="CLICK2RUN" Then
1107             \'Already done
1108         Else
1109             \'Create an "unattended" config.xml file for uninstall
1110             If fQuiet Then sDisplayLevel = "None" Else sDisplayLevel="Basic"
1111             If fNoCancel Then sNoCancel="Yes" Else sNoCancel="No"
1112             Set TextStream = oFso.OpenTextFile(sScrubDir & "\config.xml",FOR_WRITING,True,True)
1113             TextStream.Writeline "<Configuration Product=""" & Sku & """>"
1114             TextStream.Writeline "<Display Level=""" & sDisplayLevel & """ CompletionNotice=""No"" SuppressModal=""Yes"" NoCancel=""" & sNoCancel & """ AcceptEula=""Yes"" />"
1115             TextStream.Writeline "<Logging Type=""Verbose"" Path=""" & sLogDir & """ Template=""Microsoft Office " & Sku & " Setup(*).txt"" />"
1116             TextStream.Writeline "<Setting Id=""SETUP_REBOOT"" Value=""Never"" />"
1117             TextStream.Writeline "</Configuration>"
1118             TextStream.Close
1119             Set TextStream = Nothing
1120         
1121             \'Ensure path to setup.exe is valid to prevent errors
1122             sDll = ""
1123             If RegReadValue(HKLM,REG_ARP & OREGREF & Sku,"UninstallString",sCatalyst,"REG_SZ") Then
1124                 If InStr(LCase(sCatalyst),"/dll")>0 Then sDll = Right(sCatalyst,Len(sCatalyst)-InStr(LCase(sCatalyst),"/dll")+2)
1125                 If InStr(sCatalyst,"/")>0 Then sCatalyst = Left(sCatalyst,InStr(sCatalyst,"/")-1)
1126                 sCatalyst = Trim(Replace(sCatalyst,Chr(34),""))
1127                 If NOT oFso.FileExists(sCatalyst) Then
1128                     sCatalyst = sCommonProgramFiles & "\" & OREF & "\Office Setup Controller\setup.exe"
1129                     If NOT oFso.FileExists(sCatalyst) AND f64 Then
1130                         sCatalyst = sCommonProgramFilesX86 & "" & OREF & "\Office Setup Controller\setup.exe"
1131                     End If
1132                 End If
1133                 If oFso.FileExists(sCatalyst) Then
1134                     sUninstallCmd = Chr(34) & sCatalyst & Chr(34) & " /uninstall " & Sku & " /config " & Chr(34) & sScrubDir & "\config.xml" & Chr(34) & sDll 
1135                     iSetupCnt = iSetupCnt + 1
1136                     Log " - Calling Setup.exe to remove " & Sku \'& vbCrLf & sUninstallCmd 
1137                     If Not fDetectOnly Then 
1138                         On Error Resume Next
1139                         RetVal = oWShell.Run(sUninstallCmd,0,True) : CheckError "SetupExeRemoval"
1140                         Log " - Setup.exe returned: " & SetupRetVal(Retval) & " (" & RetVal & ")" & vbCrLf
1141                         fRebootRequired = fRebootRequired OR (RetVal = "3010")
1142                         On Error Goto 0
1143                     Else
1144                         Log " -> Removal suppressed in preview mode."
1145                     End If
1146                 Else
1147                     Log " Error: Office setup.exe appears to be missing"
1148                 End If \'RetVal = 0) AND oFso.FileExists
1149             End If \'RegReadValue
1150         End If \'C2R
1151     Next \'Sku
1152     If iSetupCnt = 0 Then Log " Nothing to remove for setup."
1153 End Sub \'SetupExeRemoval
1154 \'=======================================================================================================
1155 
1156 \'Invoke msiexec to remove individual .MSI packages
1157 Sub MsiexecRemoval
1158 
1159     Dim Product
1160     Dim i
1161     Dim sCmd, sReturn, sMsiProp
1162     Dim fRegWipe, fC2RRegWipe
1163 
1164     fRegWipe = False
1165     fC2RRegWipe = False
1166 
1167     Select Case OVERSIONMAJOR
1168     Case "11"
1169         sMsiProp = " REBOOT=ReallySuppress NOLOCALCACHEROLLBACK=1"
1170     Case "12"
1171         fRegWipe = True
1172         sMsiProp = " REBOOT=ReallySuppress NOREMOVESPAWN=True"
1173     Case "14"
1174         fRegWipe = True
1175         sMsiProp = " REBOOT=ReallySuppress NOREMOVESPAWN=True"
1176         fC2RRegWipe = True
1177     Case Else
1178     End Select
1179 
1180     \'Clear up ARP first to avoid possible custom action dependencies
1181     If fRegWipe Then RegWipeARP
1182 
1183     \'Check MSI registered products
1184     \'Office System does only support per machine installation so it\'s sufficient to use Installer.Products
1185     i = 0
1186     For Each Product in oMsi.Products
1187         If InScope(Product) Then
1188             If fRemoveAll OR CheckDelete(Product) Then
1189                 i = i + 1 
1190                 Log " Calling msiexec.exe to remove " & Product
1191                 sCmd = "msiexec.exe /x" & Product & sMsiProp
1192                 If fC2RRegWipe Then 
1193                     \'Need to clear out C2R registration first
1194                     If Mid(Product,11,3)="006" Then RegWipeC2R
1195                 End If
1196                 If fQuiet Then 
1197                     sCmd = sCmd & " /q"
1198                 Else
1199                     sCmd = sCmd & " /qb-"
1200                 End If
1201                 sCmd = sCmd & " /l*v+ "&chr(34)&sLogDir&"\Uninstall_"&Product&".log"&chr(34)
1202                 If NOT fDetectOnly Then 
1203                     LogOnly " - Calling msiexec with \'"&sCmd&"\'"
1204                     \'Execute the patch uninstall
1205                     sReturn = oWShell.Run(sCmd, 0, True)
1206                     Log " - msiexec returned: " & SetupRetVal(sReturn) & " (" & sReturn & ")" & vbCrLf
1207                     fRebootRequired = fRebootRequired OR (sReturn = "3010")
1208                 Else
1209                     Log "  -> Removal suppressed in preview mode."
1210                     LogOnly "  -> Command: "&sCmd
1211                 End If
1212             End If \'CheckDelete
1213         End If \'InScope
1214     Next \'Product
1215     If i = 0 Then Log " Nothing to remove for msiexec"
1216 End Sub \'MsiexecRemoval
1217 \'=======================================================================================================
1218 
1219 \'Remove the OSE (Office Source Engine) service
1220 Sub RemoveOSE
1221     On Error Resume Next
1222     Log vbCrLf & " OSE CleanUp"
1223     DeleteService "ose"
1224     \'Delete the folder
1225     DeleteFolder sCommonProgramFiles & "\Microsoft Shared\Source Engine"
1226     \'Delete the registration
1227     RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\ose\"
1228 End Sub \'RemoveOSE
1229 \'=======================================================================================================
1230 
1231 \'Remove the Softgrid services (App-V and Click2Run)
1232 Sub RemoveSG
1233     On Error Resume Next
1234     Log " Softgrid CleanUp"
1235     DeleteService("cvhsvc")
1236     DeleteService("SftList")
1237     DeleteService("SftPlay")
1238     DeleteService("SftVol")
1239     DeleteService("SftFs")
1240     DeleteService("SftVsa")
1241 
1242     \'Delete the folder
1243     DeleteFolder sAppdata & "\SoftGrid Client"
1244     DeleteFolder sLocalAppData & "\SoftGrid Client"
1245     DeleteFolder sProgramData & "\Microsoft\Application Virtualization Client\SoftGrid Client"
1246     DeleteFolder sProgramData & "\Microsoft\Application Virtualization Client"
1247     DeleteFolder sProgramfiles & "\Microsoft\Microsoft Application Virtualization Client"
1248     DeleteFolder sProgramfiles & "\Microsoft Application Virtualization Client"
1249 
1250     \'Delete the registration
1251     RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\cvhsvc"
1252     RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\sftfs"
1253     RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\sftlist"
1254     RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\sftplay"
1255     RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\sftredir"
1256     RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\sftvol"
1257     RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\sftvsa"
1258     RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\sftfs"
1259     RegDeleteKey HKLM,"SOFTWARE\Microsoft\SoftGrid\4.5"
1260     RegDeleteKey HKCU,"Software\Microsoft\SoftGrid\4.5\Client\AppFS"
1261     RegDeleteKey HKCU,"Software\Microsoft\SoftGrid\4.5\Client\Applications"
1262     RegDeleteKey HKCU,"Software\Microsoft\SoftGrid\4.5\Client\FileExtensions"
1263     RegDeleteKey HKCU,"Software\Microsoft\SoftGrid\4.5\Client\FileTypes"
1264     RegDeleteKey HKCU,"Software\Microsoft\SoftGrid\4.5\Client\UserInfo"
1265     \'C2R places custom permissions on these regkeys which prevent them from getting deleted
1266     \'RegDeleteKey HKCU,"Software\Microsoft\SoftGrid\4.5\Client\Network"
1267     \'RegDeleteKey HKCU,"Software\Microsoft\SoftGrid\4.5\Client\Packages"
1268     \'RegDeleteKey HKCU,"Software\Microsoft\SoftGrid\4.5\Client"
1269     \'RegDeleteKey HKCU,"Software\Microsoft\SoftGrid\4.5"
1270 
1271 End Sub \'RemoveSG
1272 \'=======================================================================================================
1273 
1274 \'Stops all Softgrid services and virtual applications
1275 Sub ResetSG
1276 
1277     Dim Processes, Process
1278     Dim fWait
1279     Dim iRet
1280     
1281     On Error Resume Next
1282     
1283     fWait = False
1284     Log " Doing Action: ResetSG"
1285 
1286     \'Close all running (virtualized) Office applications
1287     \'OfficeVirt.exe needs to be shut down first
1288     Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name like \'officevirt%.exe\'")
1289     For Each Process in Processes
1290         Log " - End process " & Process.Name
1291         iRet = Process.Terminate()
1292         CheckError "ResetSG: " & "Process.Name"
1293         fWait = True
1294     Next \'Process
1295     \'Shut down CVH.exe 
1296     Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name=\'cvh.exe\'")
1297     For Each Process in Processes
1298         Log " - End process " & Process.Name
1299         iRet = Process.Terminate()
1300         CheckError "ResetSG: " & "Process.Name"
1301     Next \'Process
1302     \'Close running instances
1303     Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process")
1304     For Each Process in Processes
1305         If dicApps.Exists(LCase(Process.Name)) Then
1306             Log " - End process " & Process.Name
1307             iRet = Process.Terminate()
1308             CheckError "CloseOfficeApps: " & "Process.Name"
1309         End If
1310     Next \'Process
1311     
1312     If fWait Then wscript.sleep 10000
1313 
1314     \'Stop all SoftGrid services
1315     iRet = StopService("cvhsvc")
1316     iRet = StopService("SftList")
1317     iRet = StopService("SftPlay")
1318     iRet = StopService("SftVol")
1319     iRet = StopService("SftFs")
1320     iRet = StopService("SftVsa")
1321 End Sub \'ResetSG
1322 \'=======================================================================================================
1323 
1324 \'File cleanup operations for the Local Installation Source (MSOCache)
1325 Sub WipeLIS
1326     Const LISROOT = "MSOCache\All Users\"
1327     Dim LogicalDisks, Disk, Folder, SubFolder, MseFolder, File, Files
1328     Dim arrSubFolders
1329     Dim sFolder
1330     Dim fRemoveFolder
1331     
1332     Log vbCrLf & " LIS CleanUp"
1333     \'Search all hard disks
1334     Set LogicalDisks = oWmiLocal.ExecQuery("Select * From Win32_LogicalDisk WHERE DriveType=3")
1335     For Each Disk in LogicalDisks
1336         If oFso.FolderExists(Disk.DeviceID & "\" & LISROOT) Then
1337             Set Folder = oFso.GetFolder(Disk.DeviceID & "\" & LISROOT)
1338             For Each Subfolder in Folder.Subfolders
1339                 If Len(Subfolder) > 37 Then
1340                     If fRemoveAll Then 
1341                         If  (Mid(Subfolder.Name,26,PRODLEN) = OFFICEID AND Mid(SubFolder.Name,4,2)=OVERSIONMAJOR) OR _
1342                             LCase(Right(Subfolder.Name,7)) = OVERSIONMAJOR &".data" Then DeleteFolder Subfolder.Path
1343                     Else
1344                         If  (Mid(Subfolder.Name,26,PRODLEN) = OFFICEID AND Mid(SubFolder.Name,4,2)=OVERSIONMAJOR) AND _
1345                             CheckDelete(UCase(Left(Subfolder.Name,38))) AND _
1346                             UCase(Right(Subfolder,1))= UCase(Left(Disk.DeviceID,1))Then DeleteFolder Subfolder.Path
1347                     End If
1348                 End If \'Len > 37
1349             Next \'Subfolder
1350             If (Folder.Subfolders.Count = 0) AND (Folder.Files.Count = 0) Then 
1351                 sFolder = Folder.Path
1352                 Set Folder = Nothing
1353                 SmartDeleteFolder sFolder
1354             End If
1355         End If \'oFso.FolderExists
1356     Next \'Disk
1357     
1358     \'MSECache
1359     If EnumFolders(sProgramFiles,arrSubFolders) Then
1360         For Each SubFolder in arrSubFolders
1361             If UCase(Right(SubFolder,9))="\MSECACHE" Then
1362                 ReDim arrMseFolders(-1)
1363                 Set Folder = oFso.GetFolder(SubFolder)
1364                 GetMseFolderStructure Folder
1365                 For Each MseFolder in arrMseFolders
1366                     If oFso.FolderExists(MseFolder) Then
1367                         fRemoveFolder = False
1368                         Set Folder = oFso.GetFolder(MseFolder)
1369                         Set Files = Folder.Files
1370                         For Each File in Files
1371                             If (LCase(Right(File.Name,4))=".msi") Then
1372                                 If CheckDelete(ProductCode(File.Path)) Then 
1373                                     fRemoveFolder = True
1374                                     Exit For
1375                                 End If \'CheckDelete
1376                             End If
1377                         Next \'File
1378                         Set Files = Nothing
1379                         Set Folder = Nothing
1380                         If fRemoveFolder Then SmartDeleteFolder MseFolder
1381                     End If \'oFso.FolderExists(MseFolder)
1382                 Next \'MseFolder
1383             End If
1384         Next \'SubFolder
1385     End If \'oFso.FolderExists
1386 End Sub \'WipeLis
1387 \'=======================================================================================================
1388 
1389 \'Wipe files and folders as documented in KB 928218
1390 Sub FileWipeAll
1391     Dim sFolder
1392     Dim Folder, Subfolder
1393     
1394     If fForce OR fQuiet Then CloseOfficeApps
1395     
1396     \'Handle other services.
1397     Select Case OVERSIONMAJOR
1398     Case "11"
1399     Case "12"
1400     Case "14"
1401         DeleteService "odserv"
1402         DeleteService "Microsoft Office Groove Audit Service"
1403         DeleteService "Microsoft SharePoint Workspace Audit Service"
1404     Case Else
1405     End Select
1406 
1407     \'User specific files
1408     If NOT fKeepUser Then
1409         \'Delete files that should be backed up before deleting them
1410         CopyAndDeleteFile sAppdata & "\Microsoft\Templates\Normal.dotm"
1411         CopyAndDeleteFile sAppdata & "\Microsoft\Templates\Normalemail.dotm"
1412         sFolder = sAppdata & "\microsoft\document building blocks"
1413         If oFso.FolderExists(sFolder) Then 
1414             Set Folder = oFso.GetFolder(sFolder)
1415             For Each Subfolder In Folder.Subfolders
1416                 If oFso.FileExists(Subfolder & "\blocks.dotx") Then CopyAndDeleteFile Subfolder & "\blocks.dotx"
1417             Next \'Subfolder
1418             Set Folder = Nothing
1419         End If \'oFso.FolderExists(sFolder)
1420     End If  
1421     
1422     \'Run the individual filewipe from component detection first
1423     FileWipeIndividual
1424     
1425     \'Take care of the rest
1426     DeleteFolder sOInstallRoot
1427     DeleteFolder sCommonProgramFiles & "\Microsoft Shared\" & OREF
1428     DeleteFile sAllUsersProfile & "\Application Data\Microsoft\Office\Data\opa"&OVERSIONMAJOR&".dat"
1429     DeleteFile sAllUsersProfile & "\Application Data\Microsoft\Office\Data\opa"&OVERSIONMAJOR&".bak"
1430     DeleteFile sAllUsersProfile & "\Microsoft\Office\Data\opa"&OVERSIONMAJOR&".dat"
1431     DeleteFile sAllUsersProfile & "\Microsoft\Office\Data\opa"&OVERSIONMAJOR&".bak"
1432     If (fRemoveOspp OR fForce) AND CInt(OVERSIONMAJOR)>12 Then
1433         DeleteService "osppsvc"
1434         DeleteFolder sCommonProgramFiles & "\Microsoft Shared\OfficeSoftwareProtectionPlatform"
1435         DeleteFolder sAllUsersProfile & "\Microsoft\OfficeSoftwareProtectionPlatform"
1436     End If
1437     Select Case OVERSIONMAJOR
1438     Case "12"
1439     Case "14"
1440         DeleteFile oWShell.SpecialFolders("AllUsersStartup")&"\OfficeSAS.lnk"
1441         DeleteFile oWShell.SpecialFolders("Startup")&"\OneNote 2010 Screen Clipper and Launcher.lnk"
1442     Case Else
1443     End Select
1444 End Sub \'FileWipeAll
1445 \'=======================================================================================================
1446 
1447 \'Wipe individual files & folders related to SKU\'s that are no longer installed
1448 Sub FileWipeIndividual
1449     Dim LogicalDisks, Disk
1450     Dim File, Files, XmlFile, scFiles, oFile, Folder, SubFolder, Processes, Process, item
1451     Dim sFile, sFolder, sPath, sConfigName, sContents, sProductCode, sLocalDrives,sScQuery
1452     Dim arrSubfolders
1453     Dim fKeepFolder, fDeleteSC
1454     Dim iRet
1455     
1456     Log vbCrLf & " File CleanUp"
1457     If IsArray(arrDeleteFiles) Then
1458         If fForce OR fQuiet Then
1459             Log " Doing Action: StopOSE"
1460             iRet = StopService("ose")
1461             Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Service Where Name like \'ose%.exe\'")
1462             For Each Process in Processes
1463                 LogOnly " - Running process : " & Process.Name
1464                 Log " -> Ending process: " & Process.Name
1465                 iRet = Process.Terminate()
1466             Next \'Process
1467             LogOnly " End Action: StopOSE"
1468             CloseOfficeApps
1469         End If
1470         \'Wipe individual files detected earlier
1471         LogOnly " Removing left behind files"
1472         For Each sFile in arrDeleteFiles
1473             If oFso.FileExists(sFile) Then DeleteFile sFile
1474         Next \'File
1475     End If \'IsArray
1476     
1477     \'Wipe Catalyst in commonfiles
1478     sFolder = sCommonProgramFiles & "\microsoft shared\"&OREF&"\Office Setup Controller\"
1479     If EnumFolderNames(sFolder,arrSubFolders) Then
1480         For Each SubFolder in arrSubFolders
1481             sPath = sFolder & SubFolder
1482             If InStr(SubFolder,".")>0 Then sConfigName = UCase(Left(SubFolder,InStr(SubFolder,".")-1))Else sConfigName = UCase(Subfolder)
1483             If GetFolderPath(sPath) Then
1484                 Set Folder = oFso.GetFolder(sPath)
1485                 Set Files = Folder.Files
1486                 fKeepFolder = False
1487                 For Each File In Files
1488                     If Len(File.Name)>3 Then
1489                         If (LCase(Right(File.Name,4))=".xml") Then
1490                             If Len(File.Name) >= Len(sConfigName) Then
1491                                 If (UCase(Left(File.Name,Len(sConfigName)))=sConfigName) Then
1492                                     Set XmlFile = oFso.OpenTextFile(File,1)
1493                                     sContents = XmlFile.ReadAll
1494                                     Set XmlFile = Nothing
1495                                     sProductCode = ""
1496                                     On Error Resume Next
1497                                     sProductCode = Mid(sContents,InStr(sContents,"ProductCode=")+Len("ProductCode=")+1,38)
1498                                     On Error Goto 0
1499                                     If Len(sProductCode) = 38 Then
1500                                         If CheckDelete(sProductCode) Then DeleteFile File.Path Else fKeepFolder = True
1501                                     End If
1502                                 End If \'sConfigName
1503                             End If \'Len >=
1504                         End If \'.xml
1505                     End If \'Len(File.Name)>3
1506                 Next \'File
1507                 Set Files = Nothing
1508                 Set Folder = Nothing
1509                 If Not fKeepFolder Then DeleteFolder sPath
1510             End If \'GetFolderPath
1511         Next \'SubFolder
1512     End If \'EnumFolderNames
1513     
1514     \'Wipe Shortcuts from local hard disks
1515     If NOT fSkipSD Then
1516         On Error Resume Next
1517         Log " Searching for shortcuts. This can take some time ..."
1518         Set LogicalDisks = oWmiLocal.ExecQuery("Select * From Win32_LogicalDisk WHERE DriveType=3")
1519         For Each Disk in LogicalDisks
1520             sLocalDrives = sLocalDrives & UCase(Disk.DeviceID) & "\;"
1521             sScQuery = "Select * From Win32_ShortcutFile WHERE Drive=\'"&Disk.DeviceID&"\'"
1522             Set scFiles = oWmiLocal.ExecQuery(sScQuery)
1523             For Each File in scFiles
1524                 fDeleteSC = False
1525                 \'Compare if the shortcut target is in the list of executables that will be removed
1526                 If Len(File.Target)>0 Then
1527                     For Each item in dicApps.Items
1528                         If LCase(File.Target) = item Then
1529                             fDeleteSC = True
1530                             Exit For
1531                         End If
1532                     Next \'item
1533                 End If
1534                 \'Handle Windows Installer shortcuts
1535                 If InStr(File.Target,"{")>0 Then
1536                     If Len(File.Target)>=InStr(File.Target,"{")+37 Then
1537                         If CheckDelete(Mid(File.Target,InStr(File.Target,"{"),38)) Then fDeleteSC = True
1538                     End If
1539                 End If
1540                 \'Handle C2R
1541                 If InStr(File.Target,"CVH.EXE")>0 AND (fRemoveAll OR fRemoveC2R) Then
1542                     If InStr(File.Target,"90" & OVERSIONMAJOR & "006")>0 Then fDeleteSC = True
1543                 End If
1544 
1545                 If fDeleteSC Then 
1546                     If Not IsArray(arrDeleteFolders) Then ReDim arrDeleteFolders(0)
1547                     sFolder = Left(File.Description,InStrRev(File.Description,"\")-1)
1548                     If Not arrDeleteFolders(UBound(arrDeleteFolders)) = sFolder Then
1549                         ReDim Preserve arrDeleteFolders(UBound(arrDeleteFolders)+1)
1550                         arrDeleteFolders(UBound(arrDeleteFolders)) = sFolder
1551                     End If
1552                     DeleteFile File.Description
1553                 End If \'fDeleteSC
1554             Next \'scFile
1555         Next
1556         On Error Goto 0
1557     End If \'NOT SkipSD
1558     Err.Clear
1559         
1560 End Sub \'FileWipeIndividual
1561 \'=======================================================================================================
1562 
1563 Sub DelScrubTmp
1564     
1565     On Error Resume Next
1566     If oFso.FileExists(sScrubDir&"\CvhbsQuiet.vbs") Then oFso.DeleteFile sScrubDir&"\CvhbsQuiet.vbs",True
1567     If oFso.FolderExists(sScrubDir & "\ScrubTmp") Then oFso.DeleteFolder sScrubDir & "\ScrubTmp",True
1568 
1569 End Sub \'DelScrubTmp
1570 \'=======================================================================================================
1571 
1572 \'Ensure there are no unexpected .msi files in the scrub folder
1573 Sub DeleteMsiScrubCache
1574     Dim Folder, File, Files
1575     
1576     Log vbCrLf & " ScrubCache CleanUp"
1577     Set Folder = oFso.GetFolder(sScrubDir) : CheckError "DeleteMsiScrubCache"
1578     Set Files = Folder.Files
1579     For Each File in Files
1580         CheckError "DeleteMsiScrubCache"
1581         If LCase(Right(File.Name,4))=".msi" Then
1582             CheckError "DeleteMsiScrubCache"
1583             DeleteFile File.Path : CheckError "DeleteMsiScrubCache"
1584         End If
1585     Next \'File
1586 End Sub \'DeleteMsiScrubCache
1587 \'=======================================================================================================
1588 
1589 Sub MsiClearOrphanedFiles
1590     Const USERSIDEVERYONE = "s-1-1-0"
1591     Const MSIINSTALLCONTEXT_ALL = 7
1592     Const MSIPATCHSTATE_ALL = 15
1593 
1594     \'Error handling inlined
1595     On Error Resume Next
1596 
1597     Dim Patch, AllPatches, Product, AllProducts
1598     Dim File, Files, Folder
1599     Dim sFName, sLocalMsp, sLocalMsi, sPatchList, sMsiList
1600 
1601     Set Folder = oFso.GetFolder(sWinDir & "\Installer")
1602     Set Files = Folder.Files
1603 
1604     Log vbCrLf & " Windows Installer cache CleanUp"
1605     \'Get a complete list of patches
1606     Err.Clear
1607     Set AllPatches = oMsi.PatchesEx("",USERSIDEVERYONE,MSIINSTALLCONTEXT_ALL,MSIPATCHSTATE_ALL)
1608     If Err <> 0 Then
1609         CheckError "MsiClearOrphanedFiles (msp)"
1610     Else
1611         \'Fill a comma separated stringlist with all .msp patchfiles
1612         For Each Patch in AllPatches
1613             sLocalMsp = "" : sLocalMsp = LCase(Patch.Patchproperty("LocalPackage")) : CheckError "MsiClearOrphanedFiles (msp)"
1614             sPatchList = sPatchList & sLocalMsp & ","
1615         Next \'Patch
1616 
1617         \'Delete all non referenced .msp files from %windir%\installer
1618         For Each File in Files
1619             sFName = "" : sFName = LCase(File.Path)
1620             If LCase(Right(sFName,4)) = ".msp" Then
1621                 If Not InStr(sPatchList,sFName) > 0 Then
1622                     \'While this is an orphaned file keep the scope of Office only
1623                     If InStr(UCase(MspTargets(File.Path)),OFFICEID)>0 Then DeleteFile File.Path
1624                 End If
1625             End If \'LCase(Right(sFName,4))
1626         Next \'File
1627     End If \'Err=0
1628 
1629     \'Get a complete list products
1630     Err.Clear
1631     Set AllProducts = oMsi.ProductsEx("",USERSIDEVERYONE,MSIINSTALLCONTEXT_ALL)
1632     If Err <> 0 Then
1633         CheckError "MsiClearOrphanedFiles (msi)"
1634     Else
1635         \'Fill a comma separated stringlist with all .msi files
1636         For Each Product in AllProducts
1637             sLocalMsi = "" : sLocalMsi = LCase(Product.InstallProperty("LocalPackage")) : CheckError "MsiClearOrphanedFiles (msi)"
1638             sMsiList = sMsiList & sLocalMsi & ","
1639         Next \'Product
1640 
1641         \'Delete all non referenced .msi files from %windir%\installer
1642         For Each File in Files
1643             sFName = "" : sFName = LCase(File.Path)
1644             If LCase(Right(sFName,4)) = ".msi" Then
1645                 If Not InStr(sMsiList,sFName) > 0 Then
1646                     \'While this is an orphaned file keep the scope of Office only
1647                     If UCase(Right(ProductCode(File.Path),PRODLEN))=OFFICEID Then DeleteFile File.Path
1648                 End If
1649             End If \'LCase(Right(sFName,4)) = ".msi"
1650         Next \'File
1651     End If \'Err=0
1652 
1653 End Sub \'MsiClearOrphanedFiles
1654 \'=======================================================================================================
1655 
1656 Sub RegWipe
1657     Dim Item, Name, Sku, key
1658     Dim hDefKey, sSubKeyName, sCurKey, value, sValue, sGuid
1659     Dim fkeep, fSystemComponent0, fPackages, fDisplayVersion
1660     Dim arrKeys, arrNames, arrTypes, arrMultiSzValues, arrMultiSzNewValues
1661     Dim arrTestNames,arrTestTypes
1662     Dim i, iLoopCnt, iPos
1663     Dim fDelReg
1664     
1665     Log vbCrLf & " Registry CleanUp"
1666     \'Wipe registry data
1667     
1668     \'User Profile settings
1669     RegDeleteKey HKCU,"Software\Policies\Microsoft\Office\" & OVERSION & "\"
1670     If NOT fKeepUser Then
1671         RegDeleteKey HKCU,"Software\Microsoft\Office\" & OVERSION & "\"
1672     End If \'fKeepUser
1673     
1674     \'Computer specific settings
1675     If fRemoveAll Then
1676         RegDeleteKey HKLM,"SOFTWARE\Microsoft\Office\" & OVERSION & "\"
1677         If fRemoveOse OR fForce Then
1678             RegDeleteKey HKLM,"SOFTWARE\Microsoft\Office Test\"
1679             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\Common\","LastAccessInstall"
1680             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\Common\","MID"
1681             RegDeleteKey HKLM,"SOFTWARE\Microsoft\Office\Excel\Addins\Microsoft.PerformancePoint.Planning.Client.Excel\"
1682             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\InfoPath\Converters\Import\InfoPath.DesignerExcelImport\Versions\",OVERSION
1683             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\InfoPath\Converters\Import\InfoPath.DesignerWordImport\Versions\",OVERSION
1684             RegDeleteKey HKLM,"SOFTWARE\Microsoft\Office\Outlook\"
1685             RegDeleteKey HKLM,"SOFTWARE\Microsoft\Shared Tools\Text Converters\Export\MEWord12\"
1686             RegDeleteKey HKLM,"SOFTWARE\Microsoft\Shared Tools\Text Converters\Export\Word12\"
1687             RegDeleteKey HKLM,"SOFTWARE\Microsoft\Shared Tools\Text Converters\Export\Word97\"
1688             RegDeleteKey HKLM,"SOFTWARE\Microsoft\Shared Tools\Text Converters\Import\MEWord12\"
1689             RegDeleteKey HKLM,"SOFTWARE\Microsoft\Shared Tools\Text Converters\Import\Word12\"
1690             RegDeleteKey HKLM,"SOFTWARE\Microsoft\Shared Tools\Text Converters\Import\Word97\"
1691             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Run\","GrooveMonitor"
1692             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Run\","LobiServer"
1693             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Run\","BCSSync"
1694             RegDeleteKey HKLM,"SYSTEM\CurrentControlSet\Services\Outlook\"
1695         End If
1696         RegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\Common\OffDiag\Location\",OVERSIONMAJOR
1697         RegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows NT\CurrentVersion\Terminal Server\Install\Software\Microsoft\Office\" & OVERSION & "\"
1698         RegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\Common\OffDiag\Location\",OVERSIONMAJOR
1699         RegDeleteKey HKLM,"SOFTWARE\Microsoft\OfficeCustomizeWizard\" & OVERSION & "\"
1700         RegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows NT\CurrentVersion\Terminal Server\Install\SOFTWARE\Microsoft\OfficeCustomizeWizard\" & OVERSION & "\"
1701         
1702         Select Case OVERSIONMAJOR
1703         Case "11"
1704             \'Jet_Replication
1705             sValue = ""
1706             If RegReadValue(HKCR,"CLSID\{CC2C83A6-9BE4-11D0-98E7-00C04FC2CAF5}\InprocServer32","SystemDB",sValue,"REG_SZ") Then
1707                 If Len(sValue) > Len(sOInstallRoot) Then
1708                     If LCase(Left(sValue,Len(sOInstallRoot))) = LCase(sOInstallRoot) Then RegDeleteKey HKCR,"CLSID\{CC2C83A6-9BE4-11D0-98E7-00C04FC2CAF5}\InprocServer32\"
1709                 End If
1710             End If
1711         Case "12"
1712         Case "14"
1713             RegDeleteKey HKLM,"SOFTWARE\Microsoft\OfficeSoftwareProtectionPlatform\"
1714             RegDeleteKey HKLM,"SOFTWARE\Microsoft\OfficeSoftwareProtectionPlatform_Test\"
1715             RegDeleteKey HKLM,"SOFTWARE\Microsoft\Office\Common\ActiveX Compatibility\{00024512-0000-0000-C000-000000000046}\"
1716             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Office\OneNote\Adapters\","{456B0D0E-49DD-4C95-8DB6-175F54DE69A3}"
1717             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{42042206-2D85-11D3-8CFF-005004838597}"
1718             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{993BE281-6695-4BA5-8A2A-7AACBFAAB69E}"
1719             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{0006F045-0000-0000-C000-000000000046}"
1720             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{C41662BB-1FA0-4CE0-8DC5-9B7F8279FF97}"
1721             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{7CCA70DB-DE7A-4FB7-9B2B-52E2335A3B5A}"
1722             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{506F4668-F13E-4AA1-BB04-B43203AB3CC0}"
1723             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{D66DC78C-4F61-447F-942B-3FB6980118CF}"
1724             RegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\{B4F3A835-0E21-4959-BA22-42B3008E02FF}\"
1725             \'Groove Extensions 
1726             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellExecuteHooks\","{B5A7F190-DDA6-4420-B3BA-52453494E6CD}"
1727             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{99FD978C-D287-4F50-827F-B2C658EDA8E7}"
1728             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{AB5C5600-7E6E-4B06-9197-9ECEF74D31CC}"
1729             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{920E6DB1-9907-4370-B3A0-BAFC03D81399}"
1730             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{16F3DD56-1AF5-4347-846D-7C10C4192619}"
1731             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{2916C86E-86A6-43FE-8112-43ABE6BF8DCC}"
1732             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{72853161-30C5-4D22-B7F9-0BBC1D38A37E}"
1733             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{6C467336-8281-4E60-8204-430CED96822D}"
1734             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{2A541AE1-5BF6-4665-A8A3-CFA9672E4291}"
1735             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{B5A7F190-DDA6-4420-B3BA-52453494E6CD}"
1736             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{A449600E-1DC6-4232-B948-9BD794D62056}"
1737             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{3D60EDA7-9AB4-4DA8-864C-D9B5F2E7281D}"
1738             RegDeleteValue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\","{387E725D-DC16-4D76-B310-2C93ED4752A0}"
1739             RegDeleteKey HKLM,"SOFTWARE\Classes\*\shellex\ContextMenuHandlers\XXX Groove GFS Context Menu Handler XXX\"
1740             RegDeleteKey HKLM,"SOFTWARE\Classes\AllFilesystemObjects\shellex\ContextMenuHandlers\XXX Groove GFS Context Menu Handler XXX\"
1741             RegDeleteKey HKLM,"SOFTWARE\Classes\Directory\shellex\ContextMenuHandlers\XXX Groove GFS Context Menu Handler XXX\"
1742             RegDeleteKey HKLM,"SOFTWARE\Classes\Folder\ShellEx\ContextMenuHandlers\XXX Groove GFS Context Menu Handler XXX\"
1743             RegDeleteKey HKLM,"SOFTWARE\Classes\Directory\Background\shellex\ContextMenuHandlers\XXX Groove GFS Context Menu Handler XXX\"
1744             RegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Groove Explorer Icon Overlay 1 (GFS Unread Stub)\"
1745             RegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Groove Explorer Icon Overlay 2 (GFS Stub)\"
1746             RegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Groove Explorer Icon Overlay 2.5 (GFS Unread Folder)\"
1747             RegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Groove Explorer Icon Overlay 3 (GFS Folder)\"
1748             RegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Groove Explorer Icon Overlay 4 (GFS Unread Mark)\"
1749             RegDeleteKey HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\{72853161-30C5-4D22-B7F9-0BBC1D38A37E}\"
1750 
1751         Case Else
1752         End Select
1753 
1754         \'Win32Assemblies
1755         If RegEnumKey(HKCR,"Installer\Win32Assemblies\",arrKeys) Then
1756             For Each Item in arrKeys
1757                 If InStr(UCase(Item),OREF)>0 Then RegDeleteKey HKCR,"Installer\Win32Assemblies\"&Item & "\"
1758             Next \'Item
1759         End If \'RegEnumKey
1760         \'Groove blocks reinstall if it locates groove.exe over this key
1761         If RegKeyExists(HKCR,"GrooveFile\Shell\Open\Command\") Then
1762             sValue = ""
1763             RegReadValue HKCR,"GrooveFile\Shell\Open\Command\","",sValue,"REG_SZ"
1764             If InStr(sValue,"\"&OREF&"\")>0 Then RegDeleteKey HKCR,"GrooveFile\"
1765         End If \'RegKeyExists
1766     End If \'fRemoveAll
1767 
1768     Select Case OVERSIONMAJOR
1769     Case "11"
1770         For iLoopCnt = 1 to 3
1771             Select Case iLoopCnt
1772             Case 1
1773                 \'CIW - HKCU
1774                 sSubKeyName = "Software\Microsoft\OfficeCustomizeWizard\" & OVERSION & "\RegKeyPaths\"
1775                 hDefKey = HKCU
1776             Case 2 
1777                 \'CIW - HKLM
1778                 sSubKeyName = "SOFTWARE\Microsoft\OfficeCustomizeWizard\" & OVERSION & "\RegKeyPaths\"
1779                 hDefKey = HKLM
1780             Case 3
1781                 \'Add/Remove Programs
1782                 sSubKeyName = REG_ARP
1783                 hDefKey = HKLM
1784             End Select
1785         
1786             If RegEnumKey(hDefKey,sSubKeyName,arrKeys) Then
1787                 For Each Item in arrKeys
1788                     \'OFFICEID id
1789                     If Len(Item)>37 Then
1790                         sGuid = UCase(Left(Item,38))
1791                         If Right(sGuid,PRODLEN)=OFFICEID Then
1792                             If CheckDelete(sGuid) Then 
1793                                 RegDeleteKey hDefKey, sSubKeyName & Item & "\"
1794                             End If
1795                         End If \'Right(Item,PRODLEN)=OFFICEID
1796                     End If \'Len(Item)>37
1797                 Next \'Item
1798                 If iLoopCnt < 3 Then
1799                     If RegEnumValues(hDefKey,sSubKeyName,arrNames,arrTypes) Then
1800                         i = 0
1801                         For Each Name in arrNames
1802                             If RegReadValue(hDefKey,sSubKeyName,Name,sValue,arrTypes(i)) Then
1803                                 If sValue = sGuid Then RegDeleteValue hDefKey,sSubKeyName,Name
1804                             End If
1805                             i = i + 1
1806                         Next
1807                     End If
1808                 End If
1809             End If
1810             If NOT RegEnumKey(hDefKey,sSubKeyName,arrKeys) Then RegDeleteKey hDefKey,"Software\Microsoft\OfficeCustomizeWizard\11.0\"
1811             If NOT RegEnumKey(hDefKey,"Software\Microsoft\OfficeCustomizeWizard\11.0\",arrKeys) Then RegDeleteKey hDefKey,"Software\Microsoft\OfficeCustomizeWizard\"
1812         Next \'iLoopCnt
1813     Case "12"
1814         \'Add/Remove Programs
1815         RegWipeARP 
1816     Case "14"
1817         \'Add/Remove Programs
1818         RegWipeARP 
1819     Case Else
1820     End Select
1821 
1822     \'UpgradeCodes, WI config, WI global config
1823     For iLoopCnt = 1 to 5
1824         Select Case iLoopCnt
1825         Case 1
1826             sSubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UpgradeCodes\"
1827             hDefKey = HKLM
1828         Case 2 
1829             sSubKeyName = "Installer\UpgradeCodes\"
1830             hDefKey = HKCR
1831         Case 3
1832             sSubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products\"
1833             hDefKey = HKLM
1834         Case 4 
1835             sSubKeyName = "Installer\Features\"
1836             hDefKey = HKCR
1837         Case 5 
1838             sSubKeyName = "Installer\Products\"
1839             hDefKey = HKCR
1840         Case Else
1841             sSubKeyName = ""
1842             hDefKey = ""
1843         End Select
1844         If RegEnumKey(hDefKey,sSubKeyName,arrKeys) Then
1845             For Each Item in arrKeys
1846                 \'Ensure we have the expected length for a compressed GUID
1847                 If Len(Item)=32 Then
1848                     \'Expand the GUID
1849                     sGuid = GetExpandedGuid(Item) 
1850                     \'Check if it\'s an Office key
1851                     If InScope(sGuid) Then
1852                         If fRemoveAll Then
1853                             RegDeleteKey hDefKey,sSubKeyName & Item & "\"
1854                         Else
1855                             If iLoopCnt < 3 Then
1856                                 \'Enum all entries
1857                                 RegEnumValues hDefKey,sSubKeyName & Item,arrNames,arrTypes
1858                                 If IsArray(arrNames) Then
1859                                     \'Delete entries within removal scope
1860                                     For Each Name in arrNames
1861                                         If Len(Name)=32 Then
1862                                             sGuid = GetExpandedGuid(Name)
1863                                             If CheckDelete(sGuid) Then RegDeleteValue hDefKey, sSubKeyName & Item & "\", Name
1864                                         Else
1865                                             \'Invalid data -> delete the value
1866                                             RegDeleteValue hDefKey, sSubKeyName & Item & "\", Name
1867                                         End If
1868                                     Next \'Name
1869                                 End If \'IsArray(arrNames)
1870                                 \'If all entries were removed - delete the key
1871                                 RegEnumValues hDefKey,sSubKeyName & Item,arrNames,arrTypes
1872                                 If Not IsArray(arrNames) Then RegDeleteKey hDefKey, sSubKeyName & Item & "\"
1873                             Else \'iLoopCnt >= 3
1874                                 If CheckDelete(sGuid) Then RegDeleteKey hDefKey, sSubKeyName & Item & "\"
1875                             End If \'iLoopCnt < 3
1876                         End If \'fRemoveAll
1877                     End If \'InScope
1878                 End If \'Len(Item)=32
1879             Next \'Item
1880         End If \'RegEnumKey
1881     Next \'iLoopCnt
1882 
1883     \'Components
1884     sSubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components\"
1885     If RegEnumKey(HKLM,sSubKeyName,arrKeys) Then
1886         For Each Item in arrKeys
1887             \'Ensure we have the expected length for a compressed GUID
1888             If Len(Item)=32 Then
1889                 If RegEnumValues(HKLM,sSubKeyName & Item,arrNames,arrTypes) Then
1890                     If IsArray(arrNames) Then
1891                         For Each Name in arrNames
1892                             If Len(Name)=32 Then
1893                                 sGuid = GetExpandedGuid(Name)
1894                                 If CheckDelete(sGuid) Then
1895                                     RegDeleteValue HKLM, sSubKeyName & Item & "\", Name
1896                                     \'Check if the key is now empty
1897                                     If NOT RegEnumValues(HKCR,sSubKeyName & Item,arrTestNames,arrTestTypes) Then
1898                                         If NOT dicDelRegKey.Exists(sSubKeyName&Item&"\") Then dicDelRegKey.Add sSubKeyName&Item&"\",HKCR
1899                                     End If
1900                                 End If
1901                             End If \'32
1902                         Next \'Name
1903                     End If \'IsArray
1904                 End If \'RegEnumValues
1905             End If \'32
1906         Next \'Item
1907     End If \'RegEnumKey
1908 
1909     \'Published Components
1910     sSubKeyName = "Installer\Components\"
1911     If RegEnumKey(HKCR,sSubKeyName,arrKeys) Then
1912         For Each Item in arrKeys
1913             \'Ensure we have the expected length for a compressed GUID
1914             If Len(Item)=32 Then
1915                 If RegEnumValues(HKCR,sSubKeyName & Item,arrNames,arrTypes) Then
1916                     If IsArray(arrNames) Then
1917                         For Each Name in arrNames
1918                             If RegReadValue (HKCR,sSubKeyName & Item, Name, sValue,"REG_MULTI_SZ") Then
1919                                 arrMultiSzValues = Split(sValue,chr(34))
1920                                 If IsArray(arrMultiSzValues) Then
1921                                     i = -1
1922                                     ReDim arrMultiSzNewValues(-1)
1923                                     fDelReg = False
1924                                     For Each value in arrMultiSzValues
1925                                         If Len(value) > 19 Then
1926                                             sGuid = ""
1927                                             If GetDecodedGuid(Left(value,SQUISHED),sGuid) Then
1928                                                 If CheckDelete(sGuid) Then
1929                                                     fDelReg = True
1930                                                 Else
1931                                                     i = i + 1 
1932                                                     ReDim Preserve arrMultiSzNewValues(i)
1933                                                     arrMultiSzNewValues(i) = value
1934                                                 End If \'CheckDelete
1935                                             End If \'decode
1936                                         End If \'19
1937                                     Next \'Value
1938                                     If NOT (i = -1) Then
1939                                         If NOT fDetectOnly Then 
1940                                             If NOT UBound(arrMultiSzValues) = i Then oReg.SetMultiStringValue HKCR,sSubKeyName & Item,Name,arrMultiSzNewValues
1941                                         End If
1942                                     Else
1943                                         If fDelReg Then
1944                                             RegDeleteValue HKCR,sSubKeyName & Item & "\", Name
1945                                             \'Check if the key is now empty
1946                                             If NOT RegEnumValues(HKCR,sSubKeyName & Item,arrTestNames,arrTestTypes) Then
1947                                                 If NOT dicDelRegKey.Exists(sSubKeyName&Item&"\") Then dicDelRegKey.Add sSubKeyName&Item&"\",HKCR
1948                                             End If
1949                                         End If \'DelReg
1950                                     End If
1951                                 End If \'IsArray
1952                             End If
1953                         Next \'Name
1954                     End If \'IsArray
1955                 End If \'RegEnumValues
1956             End If \'32
1957         Next \'Item
1958     End If \'RegEnumKey
1959 
1960     \'Delivery
1961     hDefKey = HKLM
1962     sSubKeyName = "SOFTWARE\Microsoft\Office\Delivery\SourceEngine\Downloads\"
1963     If RegEnumKey(HKLM,sSubKeyName,arrKeys) Then
1964         For Each Item in arrKeys
1965             If Len(Item) > 37 Then
1966                 If fRemoveAll Then
1967                     If (Mid(Item,26,PRODLEN)=OFFICEID AND Mid(Item,4,2)=OVERSIONMAJOR) OR _
1968                        LCase(Right(Item,7))=OVERSIONMAJOR&".data" Then RegDeleteKey HKLM,sSubKeyName & Item & "\"
1969                 Else
1970                     If (Mid(Item,26,PRODLEN)=OFFICEID AND Mid(Item,4,2)=OVERSIONMAJOR) AND _
1971                        CheckDelete(UCase(Left(Item,38))) Then RegDeleteKey HKLM,sSubKeyName & Item & "\"
1972                 End If
1973             End If \'37
1974         Next \'Item
1975     End If \'RegEnumKey
1976     
1977     \'Registration
1978     hDefKey = HKLM
1979     sSubKeyName = "SOFTWARE\Microsoft\Office\"&OVERSION&"\Registration\"
1980     If RegEnumKey(HKLM,sSubKeyName,arrKeys) Then
1981         For Each Item in arrKeys
1982             If Len(Item)>37 Then
1983                 If CheckDelete(UCase(Left(Item,38))) Then RegDeleteKey HKLM,sSubKeyName & Item & "\"
1984             End If
1985         Next \'Item
1986     End If \'RegEnumKey
1987     
1988     \'User Preconfigurations
1989     hDefKey = HKLM
1990     sSubKeyName = "SOFTWARE\Microsoft\Office\"&OVERSION&"\User Settings\"
1991     If RegEnumKey(HKLM,sSubKeyName,arrKeys) Then
1992         For Each Item in arrKeys
1993             If Len(Item)>37 Then
1994                 If CheckDelete(UCase(Left(Item,38))) Then RegDeleteKey HKLM,sSubKeyName & Item & "\"
1995             End If
1996         Next \'Item
1997     End If \'RegEnumKey
1998 
1999     \'Click2Run Cleanup
2000     If CInt(OVERSIONMAJOR) > 12 Then RegWipeC2R 
2001 
2002     \'Known Keypath settings
2003     For Each key in dicDelRegKey.Keys
2004         If Right(key,1) = "\" Then
2005             RegDeleteKey dicDelRegKey.Item(key),key
2006         Else
2007             iPos = InStrRev(Key,"\")
2008             If iPos > 0 Then RegDeleteValue dicDelRegKey.Item(key), Left(key,iPos - 1), Mid(key,iPos+1)
2009         End If
2010     Next
2011 
2012     \'Temporary entries in ARP
2013     TmpKeyCleanUp
2014 End Sub \'RegWipe
2015 \'=======================================================================================================
2016 
2017 \'Clean up Add/Remove Programs registry
2018 Sub RegWipeARP
2019 
2020     Dim Item, Name, Sku, key
2021     Dim sSubKeyName, sCurKey, sValue, sGuid
2022     Dim fkeep, fSystemComponent0, fPackages, fDisplayVersion
2023     Dim arrKeys
2024 
2025     \'Add/Remove Programs
2026     sSubKeyName = REG_ARP
2027     If RegEnumKey(HKLM,sSubKeyName,arrKeys) Then
2028         For Each Item in arrKeys
2029             \'*0FF1CE*
2030             If Len(Item)>37 Then
2031                 sGuid = UCase(Left(Item,38))
2032                 If InScope(sGuid) Then
2033                     If CheckDelete(sGuid) Then RegDeleteKey HKLM, sSubKeyName & Item
2034                 End If \'InScope
2035             End If \'Len(Item)>37
2036             
2037             \'Config entries
2038             sCurKey = sSubKeyName & Item & "\"
2039             fSystemComponent0 = Not (RegReadValue(HKLM,sCurKey,"SystemComponent",sValue,"REG_DWORD") AND (sValue = "1"))
2040             fPackages = RegReadValue(HKLM,sCurKey,OPACKAGE,sValue,"REG_MULTI_SZ")
2041             fDisplayVersion = RegReadValue(HKLM,sCurKey,"DisplayVersion",sValue,"REG_SZ")
2042             If fDisplayVersion AND Len(sValue) > 1 Then
2043                 fDisplayVersion = (Left(sValue,2) = OVERSIONMAJOR)
2044             End If
2045             If (fSystemComponent0 AND fPackages AND fDisplayVersion) OR (fSystemComponent0 AND fDisplayVersion AND InStr(UCase(Item),"CLICK2RUN")>0) Then
2046                 fKeep = False
2047                 If Not fRemoveAll Then
2048                     For Each Sku in dicKeepSku.Keys
2049                         If UCase(Item) =  OREGREF & Sku Then
2050                             fkeep = True
2051                             Exit For
2052                         End If
2053                     Next \'Sku
2054                 End If
2055                 If Not fkeep Then RegDeleteKey HKLM, sSubKeyName & Item
2056             End If
2057         Next \'Item
2058     End If \'RegEnumKey
2059 
2060 End Sub \'RegWipeARP
2061 \'=======================================================================================================
2062 
2063 \'Clean up Click2Run specific registrations
2064 Sub RegWipeC2R
2065 
2066     Dim Item
2067     Dim sSubKeyName
2068     Dim arrKeys
2069 
2070     \'Click2Run Cleanup
2071     If fRemoveAll OR fRemoveC2R Then
2072         RegDeleteKey HKCU,"Software\Microsoft\Office\CVH"
2073         RegDeleteKey HKCU,"Software\Microsoft\Office\" & OVERSION & "\CVH"
2074         RegDeleteKey HKLM,"Software\Microsoft\Office\" & OVERSION & "\CVH"
2075         RegDeleteKey HKLM,"Software\Microsoft\Office\" & OVERSION & "\CVHSettings"
2076         RegDeleteKey HKLM,"SOFTWARE\Microsoft\Office\" & OVERSION & "\Common\InstallRoot\Virtual"
2077 
2078         \'Control Panel Items
2079         RegDeleteKey HKLM,"Software\Microsoft\Windows\CurrentVersion\explorer\ControlPanel\NameSpace\{F9ACD2D6-09C8-4103-995C-912DE68DDE1E}"
2080         RegDeleteKey HKCR,"CLSID\{F9ACD2D6-09C8-4103-995C-912DE68DDE1E}"
2081         RegDeleteKey HKLM,"Software\Microsoft\Windows\CurrentVersion\explorer\ControlPanel\NameSpace\{005CB1F2-224F-4738-B051-91A96758F50C}"
2082         RegDeleteKey HKCR,"CLSID\{005CB1F2-224F-4738-B051-91A96758F50C}"
2083 
2084         sSubKeyName = "SOFTWARE\Microsoft\SoftGrid\4.5\Client\Packages\"
2085         If RegEnumKey(HKLM,sSubKeyName,arrKeys) Then
2086             For Each Item in arrKeys
2087                 If CheckDelete(Item) Then RegDeleteKey HKLM,sSubKeyName & Item
2088             Next \'Item
2089         End If \'RegEnumKey
2090         If RegEnumKey(HKCU,sSubKeyName,arrKeys) Then
2091             For Each Item in arrKeys
2092                 If CheckDelete(Item) Then RegDeleteKey HKLM,sSubKeyName & Item
2093             Next \'Item
2094         End If \'RegEnumKey
2095     End If
2096 
2097 End Sub \'RegWipeC2R
2098 \'=======================================================================================================
2099 
2100 \'Clean up temporary registry keys
2101 Sub TmpKeyCleanUp
2102     Dim TmpKey
2103     
2104     If fLogInitialized Then Log " Remove temporary registry entries"
2105     If IsArray(arrTmpSKUs) Then
2106         For Each TmpKey in arrTmpSKUs
2107             oReg.DeleteKey HKLM, REG_ARP & TmpKey
2108         Next \'Item
2109     End If \'IsArray
2110 End Sub \'TmpKeyCleanUp
2111 
2112 \'=======================================================================================================
2113 \' Helper Functions
2114 \'=======================================================================================================
2115 
2116 \'Create a log with the results of the SKU detection
2117 Sub LogSkuResults
2118     Dim SkuLog, SkuKey , p
2119 
2120     On Error Resume Next \'Don\'t fail on logging
2121     
2122     Set SkuLog = oFso.OpenTextFile(sScrubDir & "\SkuLog.txt",FOR_WRITING,True,True)
2123     
2124     SkuLog.WriteLine "Installed SKUs (All):"
2125     SkuLog.WriteLine "====================="
2126     For Each SkuKey in dicInstalledSku.Keys
2127         SkuLog.WriteLine " - " & SkuKey
2128     Next \'Key
2129 
2130     SkuLog.WriteLine vbCrLf & "Server SKUs:"
2131     SkuLog.WriteLine          "============"
2132     For Each SkuKey in dicSrv.Keys
2133         SkuLog.WriteLine " - " & SkuKey
2134     Next \'Key
2135 
2136     SkuLog.WriteLine vbCrLf & "Client Suite SKUs:"
2137     SkuLog.WriteLine          "=================="
2138     For Each SkuKey in dicCSuite.Keys
2139         SkuLog.WriteLine " - " & SkuKey
2140     Next \'Key
2141 
2142     SkuLog.WriteLine vbCrLf & "Client Standalone SKUs:"
2143     SkuLog.WriteLine          "======================="
2144     For Each SkuKey in dicCSingle.Keys
2145         SkuLog.WriteLine " - " & SkuKey
2146     Next \'Key
2147 
2148     SkuLog.WriteLine vbCrLf & "Installed Products (All):"
2149     SkuLog.WriteLine          "========================="
2150     For Each p in oMsi.Products
2151         If InScope(p) Then
2152             SkuLog.Write " - " & p & " - "
2153             SkuLog.Write oMsi.ProductInfo(p, "ProductName")
2154             SkuLog.WriteLine " "
2155         End If
2156     Next \'Product
2157 
2158     SkuLog.WriteLine vbCrLf & "***************************************************************************************************" & vbCrLf
2159 
2160     SkuLog.WriteLine vbCrLf & "SKUs to keep:"
2161     SkuLog.WriteLine          "============="
2162     For Each SkuKey in dicKeepSku.Keys
2163         SkuLog.WriteLine " - " & SkuKey
2164     Next \'Key
2165 
2166     SkuLog.WriteLine vbCrLf & "Products to keep:"
2167     SkuLog.WriteLine          "================="
2168     For Each p in dicKeepProd.Keys
2169         SkuLog.Write " - " & p & " - "
2170         SkuLog.Write oMsi.ProductInfo(p, "ProductName")
2171         SkuLog.WriteLine " "
2172     Next \'Key
2173 
2174     SkuLog.WriteLine vbCrLf & "***************************************************************************************************" & vbCrLf
2175 
2176     SkuLog.WriteLine vbCrLf & "SKUs to remove:"
2177     SkuLog.WriteLine          "==============="
2178     For Each SkuKey in dicRemoveSku.Keys
2179         SkuLog.WriteLine " - " & SkuKey
2180     Next \'Key
2181 
2182     SkuLog.WriteLine vbCrLf & "Products to remove:"
2183     SkuLog.WriteLine          "==================="
2184     For Each p in oMsi.Products
2185         If InScope(p) Then
2186             If (fRemoveAll OR CheckDelete(p))Then
2187                 SkuLog.Write " - " & p & " - "
2188                 SkuLog.Write oMsi.ProductInfo(p, "ProductName")
2189                 SkuLog.WriteLine " "
2190             End If
2191         End If \'InScope
2192     Next \'Product
2193 
2194     SkuLog.Close
2195     Set SkuLog = Nothing
2196 
2197 End Sub \'LogSkuResults
2198 \'=======================================================================================================
2199 
2200 \'End all running instances of applications that will be removed
2201 Sub CloseOfficeApps
2202     Dim Processes, Process
2203     Dim fWait
2204     Dim iRet
2205     
2206     On Error Resume Next
2207     
2208     fWait = False
2209     Log " Doing Action: CloseOfficeApps"
2210 
2211     \'OfficeVirt.exe needs to be shut down first
2212     Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name like \'officevirt%.exe\'")
2213     For Each Process in Processes
2214         If dicApps.Exists(LCase(Process.Name)) Then
2215             Log " - End process " & Process.Name
2216             iRet = Process.Terminate()
2217             CheckError "CloseOfficeApps: " & "Process.Name"
2218             fWait = True
2219         End If
2220     Next \'Process
2221 
2222     Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process")
2223     For Each Process in Processes
2224         If dicApps.Exists(LCase(Process.Name)) Then
2225             Log " - End process " & Process.Name
2226             iRet = Process.Terminate()
2227             CheckError "CloseOfficeApps: " & "Process.Name"
2228             If Process.Name = "CVH.EXE" Then fWait = True
2229         End If
2230     Next \'Process
2231     If fWait Then
2232         wscript.sleep 10000
2233     End If
2234     LogOnly " End Action: CloseOfficeApps"
2235 End Sub \'CloseOfficeApps
2236 \'=======================================================================================================
2237 
2238 \'CVHBS.exe has no true unattended option
2239 \'To ensure quiet automation does not break this dialog box handler monitors the process
2240 Sub CvhbsDialogHandler
2241 
2242 Dim CvhbsQuiet
2243 Dim sRunCmd, sQuote
2244 
2245 Set CvhbsQuiet = oFso.CreateTextFile(sScrubDir&"\CvhbsQuiet.vbs",True,True)
2246 sQuote = "&chr(34)&"
2247 CvhbsQuiet.WriteLine "On Error Resume Next"
2248 CvhbsQuiet.WriteLine "Set oShell = CreateObject("&chr(34)&"WScript.Shell"&chr(34)&")"
2249 CvhbsQuiet.WriteLine "Set oWmiLocal   = GetObject("&chr(34)&"winmgmts:\\.\root\cimv2"&chr(34)&")"
2250 CvhbsQuiet.WriteLine "wscript.sleep 10000"
2251 CvhbsQuiet.WriteLine "Do"
2252     CvhbsQuiet.WriteLine "Set Processes = oWmiLocal.ExecQuery("&chr(34)&"Select * From Win32_Process Where Name=\'cvhbs.exe\'"&chr(34)&")"
2253     CvhbsQuiet.WriteLine "iCnt = Processes.Count"
2254     CvhbsQuiet.WriteLine "If iCnt > 0 Then"
2255         CvhbsQuiet.WriteLine "sCommand = "&chr(34)&"tasklist /FI "&chr(34)&sQuote&chr(34)&"WINDOWTITLE eq click*"&chr(34)&sQuote&chr(34)&" /FO CSV /NH"&chr(34)
2256         CvhbsQuiet.WriteLine "Set oExec = oShell.Exec(sCommand)"
2257         CvhbsQuiet.WriteLine "sCmdOut = oExec.StdOut.ReadAll()"
2258         CvhbsQuiet.WriteLine "Do While oExec.Status = 0"
2259              CvhbsQuiet.WriteLine "WScript.Sleep 200"
2260         CvhbsQuiet.WriteLine "Loop"
2261 
2262         CvhbsQuiet.WriteLine "If InStr(sCmdOut,"&chr(34)&","&chr(34)&")>0 Then"
2263             CvhbsQuiet.WriteLine "sCmdOut = Replace(sCmdOut,chr(34),"&chr(34)&chr(34)&")"
2264             CvhbsQuiet.WriteLine "arrCol = Split(sCmdOut,"&chr(34)&","&chr(34)&")"
2265                 CvhbsQuiet.WriteLine "sPid = arrCol(1)"
2266                 CvhbsQuiet.WriteLine "oShell.AppActivate sPID"
2267                 CvhbsQuiet.WriteLine "oShell.SendKeys "&chr(34)&"{ENTER}"&chr(34)
2268         CvhbsQuiet.WriteLine "End If"
2269 
2270     CvhbsQuiet.WriteLine "End If"
2271     CvhbsQuiet.WriteLine "wscript.sleep 10000"
2272 CvhbsQuiet.WriteLine "Loop While iCnt > 0"
2273 CvhbsQuiet.Close
2274 
2275 sRunCmd = "cscript "&chr(34)&sScrubDir&"\CvhbsQuiet.vbs"&chr(34)
2276 oWShell.Run sRunCmd, 0, False
2277 
2278 End Sub \'CvhbsDialogHandler
2279 
2280 \'=======================================================================================================
2281 
2282 \'Ensure Windows Explorer is restarted if needed
2283 Sub RestoreExplorer
2284     Dim Processes
2285     
2286     \'Non critical routine. Don\'t fail on error
2287     On Error Resume Next
2288     wscript.sleep 1000
2289     Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name=\'explorer.exe\'")
2290     If Processes.Count < 1 Then oWShell.Run "explorer.exe"
2291 End Sub \'RestoreExploer
2292 \'=======================================================================================================
2293 
2294 \'Check registry access permissions. Failure will terminate the script
2295 Function CheckRegPermissions
2296     Const KEY_QUERY_VALUE       = &H0001
2297     Const KEY_SET_VALUE         = &H0002
2298     Const KEY_CREATE_SUB_KEY    = &H0004
2299     Const DELETE                = &H00010000
2300 
2301     Dim sSubKeyName
2302     Dim fReturn
2303 
2304     CheckRegPermissions = True
2305     sSubKeyName = "Software\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\"
2306     oReg.CheckAccess HKLM, sSubKeyName, KEY_QUERY_VALUE, fReturn
2307     If Not fReturn Then CheckRegPermissions = False
2308     oReg.CheckAccess HKLM, sSubKeyName, KEY_SET_VALUE, fReturn
2309     If Not fReturn Then CheckRegPermissions = False
2310     oReg.CheckAccess HKLM, sSubKeyName, KEY_CREATE_SUB_KEY, fReturn
2311     If Not fReturn Then CheckRegPermissions = False
2312     oReg.CheckAccess HKLM, sSubKeyName, DELETE, fReturn
2313     If Not fReturn Then CheckRegPermissions = False
2314 
2315 End Function \'CheckRegPermissions
2316 \'=======================================================================================================
2317 
2318 \'Check if an Office product is still registered with a SKU that stays on the computer
2319 Function CheckDelete(sProductCode)
2320         
2321     \'Ensure valid GUID length
2322     If NOT Len(sProductCode) = 38 Then
2323         CheckDelete = False
2324         Exit Function
2325     End If
2326 
2327     \'If it\'s a non Office ProductCode exit with false right away
2328     CheckDelete = InScope(sProductCode)
2329     If Not CheckDelete Then Exit Function
2330     If dicKeepProd.Exists(UCase(sProductCode)) Then CheckDelete = False
2331 
2332 End Function \'CheckDelete
2333 \'=======================================================================================================
2334 
2335 \'Check if ProductCode is in scope
2336 Function InScope(sProductCode)
2337 
2338     Dim fInScope
2339     Dim sProd
2340 
2341     fInScope = False
2342     If Len(sProductCode) = 38 Then
2343         sProd = UCase(sProductCode)
2344         Select Case OVERSIONMAJOR
2345         Case "11"
2346             If Right(sProd,PRODLEN)=OFFICEID Then InScope = True
2347         Case "12"
2348             If Right(sProd,PRODLEN)=OFFICEID AND Mid(sProd,4,2) = OVERSIONMAJOR Then fInScope = True
2349         Case "14"
2350             If Right(sProd,PRODLEN)=OFFICEID AND Mid(sProd,4,2) = OVERSIONMAJOR Then fInScope = True
2351         Case Else
2352         End Select
2353     End If \'38
2354 
2355     InScope = fInScope
2356 End Function \'InScope
2357 \'=======================================================================================================
2358 
2359 \'Register an orphaned .msi product as installed for MSI
2360 Sub MsiRegisterProduct (sMsiFile)
2361 
2362     Dim sDisplayVersion, sCurKey, sDisplayName, sLang, sProductCode, sTmpKey
2363     Dim iCnt
2364 
2365     \'Create a temporary keys to simulate an installed product
2366     sProductCode = ""
2367     sProductCode = GetMsiProductCode(sMsiFile)
2368     sDisplayVersion = GetMsiProductVersion(sMsiFile)
2369     If sDisplayVersion = "" Then sDisplayVersion = OVERSION & ".0000.0000"
2370     sDisplayName = GetMsiProductName(sMsiFile)
2371     If sDisplayName = "" Then sDisplayName = sProductCode
2372     Select Case OVERSIONMAJOR
2373     Case "9","10","11"
2374         sLang = CInt("&h" & Mid(sProductCode,6,4))
2375     Case "12","14"
2376         sLang = CInt("&h" & Mid(sProductCode,16,4))
2377     Case Else
2378     End Select
2379 
2380     For iCnt = 1 To 3
2381         Select Case iCnt
2382         Case 1
2383             sCurKey = REG_ARP & sProductCode
2384             oReg.CreateKey HKLM,sCurKey
2385         Case 2
2386             sCurKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products\" & GetCompressedGuid(sProductCode)
2387             oReg.CreateKey HKLM,sCurKey
2388             oReg.CreateKey HKLM,sCurKey & "\Features"
2389             oReg.CreateKey HKLM,sCurKey & "\InstallProperties"
2390             oReg.CreateKey HKLM,sCurKey & "\Patches"
2391             oReg.CreateKey HKLM,sCurKey & "\Usage"
2392             sCurKey = sCurKey & "\InstallProperties"
2393             oReg.SetStringValue HKLM,sCurKey,"LocalPackage",sMsiFile
2394         Case 3
2395             sCurKey = "Installer\Products\" & GetCompressedGuid(sProductCode)
2396             sTmpKey = sCurKey
2397             oReg.CreateKey HKCR,sCurKey
2398             oReg.SetDWordValue HKCR,sCurKey,"AdvertiseFlags",388
2399             oReg.SetDWordValue HKCR,sCurKey,"Assignment",1
2400             oReg.SetDWordValue HKCR,sCurKey,"AuthorizedLUAApp",0
2401             oReg.SetStringValue HKCR,sCurKey,"Clients",":"
2402             oReg.SetDWordValue HKCR,sCurKey,"DeploymentFlags",3
2403             oReg.SetDWordValue HKCR,sCurKey,"InstanceType",0
2404             oReg.SetDWordValue HKCR,sCurKey,"Language",sLang
2405             oReg.SetStringValue HKCR,sCurKey,"PackageCode",GetMsiPackageCode(sMsiFile)
2406             oReg.SetStringValue HKCR,sCurKey,"ProductName",sDisplayName
2407             oReg.SetDWordValue HKCR,sCurKey,"VersionMinor",0
2408             sCurKey = sTmpKey & "\SourceList"
2409             oReg.CreateKey HKCR,sCurKey
2410             oReg.SetExpandedStringValue HKCR,sCurKey,"LastUsedSource",sScrubDir
2411             oReg.SetStringValue HKCR,sCurKey,"PackageName",Mid(sMsiFile,InstrRev(sMsiFile,"\")+1)
2412             sCurKey = sTmpKey & "\SourceList\Media"
2413             oReg.CreateKey HKCR,sCurKey
2414             oReg.SetStringValue HKCR,sCurKey,"1",OREF & ";1"
2415             oReg.SetStringValue HKCR,sCurKey,"DiskPrompt",sDisplayName
2416             sCurKey = sTmpKey & "\SourceList\Net"
2417             oReg.CreateKey HKCR,sCurKey
2418             oReg.SetExpandedStringValue HKCR,sCurKey,"1",sScrubDir
2419 
2420         Case Else
2421         End Select
2422         If iCnt <3 Then
2423             oReg.SetStringValue HKLM,sCurKey,"Comments",""
2424             oReg.SetStringValue HKLM,sCurKey,"Contact",""
2425             oReg.SetStringValue HKLM,sCurKey,"DisplayName",sDisplayName
2426             oReg.SetStringValue HKLM,sCurKey,"DisplayVersion",sDisplayVersion
2427             oReg.SetDWordValue HKLM,sCurKey,"EstimatedSize",0
2428             oReg.SetStringValue HKLM,sCurKey,"HelpLink",""
2429             oReg.SetStringValue HKLM,sCurKey,"HelpTelephone",""
2430             oReg.SetStringValue HKLM,sCurKey,"InstallDate","20100101"
2431             If f64 Then
2432                 oReg.SetStringValue HKLM,sCurKey,"InstallLocation",sProgramFilesX86
2433             Else
2434                 oReg.SetStringValue HKLM,sCurKey,"InstallLocation",sProgramFiles
2435             End If
2436             oReg.SetStringValue HKLM,sCurKey,"InstallSource",sScrubDir
2437             oReg.SetDWordValue HKLM,sCurKey,"Language",sLang
2438             oReg.SetExpandedStringValue HKLM,sCurKey,"ModifyPath","MsiExec.exe /X" & sProductCode
2439             oReg.SetDWordValue HKLM,sCurKey,"NoModify",1
2440             oReg.SetStringValue HKLM,sCurKey,"Publisher","Microsoft Corporation"
2441             oReg.SetStringValue HKLM,sCurKey,"Readme",""
2442             oReg.SetStringValue HKLM,sCurKey,"Size",""
2443             oReg.SetDWordValue HKLM,sCurKey,"SystemComponent",0
2444             oReg.SetExpandedStringValue HKLM,sCurKey,"UninstallString","MsiExec.exe /X" & sProductCode
2445             oReg.SetStringValue HKLM,sCurKey,"URLInfoAbout",""
2446             oReg.SetStringValue HKLM,sCurKey,"URLUpdateInfo",""
2447             oReg.SetDWordValue HKLM,sCurKey,"Version",0
2448             oReg.SetDWordValue HKLM,sCurKey,"VersionMajor",OVERSIONMAJOR
2449             oReg.SetDWordValue HKLM,sCurKey,"VersionMinor",0
2450             oReg.SetDWordValue HKLM,sCurKey,"WindowsInstaller",1
2451         End If \'< 3
2452     Next \'iCnt
2453 
2454 End Sub \'MsiRegisterProduct
2455 \'=======================================================================================================
2456 
2457 \'Obtain the ProductCode (GUID) from a .msi package
2458 \'The function will open the .msi database and query the \'Property\' table to retrieve the ProductCode
2459 Function GetMsiProductCode(sMsiFile)
2460     
2461     Dim MsiDb,Record
2462     Dim qView
2463     
2464     On Error Resume Next
2465     
2466     GetMsiProductCode = ""
2467     Set Record = Nothing
2468     
2469     Set MsiDb = oMsi.OpenDatabase(sMsiFile,MSIOPENDATABASEREADONLY)
2470     Set qView = MsiDb.OpenView("SELECT `Value` FROM Property WHERE `Property` = \'ProductCode\'")
2471     qView.Execute
2472     Set Record = qView.Fetch
2473     GetMsiProductCode = Record.StringData(1)
2474     qView.Close
2475 
2476 End Function \'GetMsiProductCode
2477 \'=======================================================================================================
2478 
2479 \'Obtain the ProductVersion from a .msi package
2480 \'The function will open the .msi database and query the \'Property\' table to retrieve the ProductCode
2481 Function GetMsiProductVersion(sMsiFile)
2482     
2483     Dim MsiDb,Record
2484     Dim qView
2485     
2486     On Error Resume Next
2487     
2488     GetMsiProductVersion = ""
2489     Set Record = Nothing
2490     
2491     Set MsiDb = oMsi.OpenDatabase(sMsiFile,MSIOPENDATABASEREADONLY)
2492     Set qView = MsiDb.OpenView("SELECT `Value` FROM Property WHERE `Property` = \'ProductVersion\'")
2493     qView.Execute
2494     Set Record = qView.Fetch
2495     GetMsiProductVersion = Record.StringData(1)
2496     qView.Close
2497 
2498 End Function \'GetMsiProductVersion
2499 \'=======================================================================================================
2500 
2501 \'Obtain the ProductVersion from a .msi package
2502 \'The function will open the .msi database and query the \'Property\' table to retrieve the ProductCode
2503 Function GetMsiProductName(sMsiFile)
2504     
2505     Dim MsiDb,Record
2506     Dim qView
2507     
2508     On Error Resume Next
2509     
2510     GetMsiProductName = ""
2511     Set Record = Nothing
2512     
2513     Set MsiDb = oMsi.OpenDatabase(sMsiFile,MSIOPENDATABASEREADONLY)
2514     Set qView = MsiDb.OpenView("SELECT `Value` FROM Property WHERE `Property` = \'ProductName\'")
2515     qView.Execute
2516     Set Record = qView.Fetch
2517     GetMsiProductName = Record.StringData(1)
2518     qView.Close
2519 
2520 End Function \'GetMsiProductVersion
2521 \'=======================================================================================================
2522 
2523 \'Obtain the PackageCode (GUID) from a .msi package
2524 \'The function will the .msi\'S SummaryInformation stream
2525 Function GetMsiPackageCode(sMsiFile)
2526 
2527     On Error Resume Next
2528 
2529     Const PID_REVNUMBER = 9
2530     
2531     GetMsiPackageCode = ""
2532     GetMsiPackageCode = GetCompressedGuid(oMsi.SummaryInformation(sMsiFile,MSIOPENDATABASEREADONLY).Property(PID_REVNUMBER))
2533 
2534 End Function \'GetMsiPackageCode
2535 \'=======================================================================================================
2536 
2537 \'Returns a string with a list of ProductCodes from the summary information stream
2538 Function MspTargets (sMspFile)
2539     Const MSIOPENDATABASEMODE_PATCHFILE = 32
2540     Const PID_TEMPLATE                  =  7
2541 
2542     Dim Msp
2543     \'Non critical routine. Don\'t fail on error
2544     On Error Resume Next
2545     MspTargets = ""
2546     If oFso.FileExists(sMspFile) Then
2547         Set Msp = Msi.OpenDatabase(WScript.Arguments(0),MSIOPENDATABASEMODE_PATCHFILE)
2548         If Err = 0 Then MspTargets = Msp.SummaryInformation.Property(PID_TEMPLATE)
2549     End If \'oFso.FileExists(sMspFile)
2550 End Function \'MspTargets
2551 \'=======================================================================================================
2552 
2553 \'Return the ProductCode {GUID} from a .MSI package
2554 Function ProductCode(sMsi)
2555     Const MSIUILEVELNONE = 2 \'No UI
2556     Dim MsiSession
2557 
2558     On Error Resume Next
2559     \'Non critical routine. Don\'t fail on error
2560     If oFso.FileExists(sMsi) Then
2561         oMsi.UILevel = MSIUILEVELNONE
2562         Set MsiSession = oMsi.OpenPackage(sMsi,1)
2563         ProductCode = MsiSession.ProductProperty("ProductCode")
2564         Set MsiSession = Nothing
2565     Else
2566         ProductCode = ""
2567     End If \'oFso.FileExists(sMsi)
2568 End Function \'ProductCode
2569 \'=======================================================================================================
2570 
2571 Function GetExpandedGuid (sGuid)
2572     Dim i
2573 
2574     \'Ensure valid length
2575     If NOT Len(sGuid) = 32 Then Exit Function
2576 
2577     GetExpandedGuid = "{" & StrReverse(Mid(sGuid,1,8)) & "-" & _
2578                        StrReverse(Mid(sGuid,9,4)) & "-" & _
2579                        StrReverse(Mid(sGuid,13,4))& "-"
2580     For i = 17 To 20
2581         If i Mod 2 Then
2582             GetExpandedGuid = GetExpandedGuid & mid(sGuid,(i + 1),1)
2583         Else
2584             GetExpandedGuid = GetExpandedGuid & mid(sGuid,(i - 1),1)
2585         End If
2586     Next
2587     GetExpandedGuid = GetExpandedGuid & "-"
2588     For i = 21 To 32
2589         If i Mod 2 Then
2590             GetExpandedGuid = GetExpandedGuid & mid(sGuid,(i + 1),1)
2591         Else
2592             GetExpandedGuid = GetExpandedGuid & mid(sGuid,(i - 1),1)
2593         End If
2594     Next
2595     GetExpandedGuid = GetExpandedGuid & "}"
2596 End Function
2597 \'=======================================================================================================
2598 
2599 \'Converts a GUID into the compressed format
2600 Function GetCompressedGuid (sGuid)
2601     Dim sCompGUID
2602     Dim i
2603     
2604     \'Ensure Valid Length
2605     If NOT Len(sGuid) = 38 Then Exit Function
2606 
2607     sCompGUID = StrReverse(Mid(sGuid,2,8))  & _
2608                 StrReverse(Mid(sGuid,11,4)) & _
2609                 StrReverse(Mid(sGuid,16,4)) 
2610     For i = 21 To 24
2611         If i Mod 2 Then
2612             sCompGUID = sCompGUID & Mid(sGuid, (i + 1), 1)
2613         Else
2614             sCompGUID = sCompGUID & Mid(sGuid, (i - 1), 1)
2615         End If
2616     Next
2617     For i = 26 To 37
2618         If i Mod 2 Then
2619             sCompGUID = sCompGUID & Mid(sGuid, (i - 1), 1)
2620         Else
2621             sCompGUID = sCompGUID & Mid(sGuid, (i + 1), 1)
2622         End If
2623     Next
2624     GetCompressedGuid = sCompGUID
2625 End Function
2626 \'=======================================================================================================
2627 
2628 \'Unsquish GUID
2629 Function GetDecodedGuid(sEncGuid, sGuid)
2630 
2631 Dim sDecode, sTable, sHex, iChr
2632 Dim arrTable
2633 Dim i, iAsc, pow85, decChar
2634 Dim lTotal
2635 Dim fFailed
2636 
2637     fFailed = False
2638 
2639     sTable =    "0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff," & _
2640                 "0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff," & _
2641                 "0xff,0x00,0xff,0xff,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0x0a,0x0b,0xff," & _
2642                 "0x0c,0x0d,0x0e,0x0f,0x10,0x11,0x12,0x13,0x14,0x15,0xff,0xff,0xff,0x16,0xff,0x17," & _
2643                 "0x18,0x19,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27," & _
2644                 "0x28,0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f,0x30,0x31,0x32,0x33,0xff,0x34,0x35,0x36," & _
2645                 "0x37,0x38,0x39,0x3a,0x3b,0x3c,0x3d,0x3e,0x3f,0x40,0x41,0x42,0x43,0x44,0x45,0x46," & _
2646                 "0x47,0x48,0x49,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f,0x50,0x51,0x52,0xff,0x53,0x54,0xff"
2647     arrTable = Split(sTable,",")
2648     lTotal = 0 : pow85 = 1
2649     For i = 0 To 19
2650         fFailed = True
2651         If i Mod 5 = 0 Then
2652             lTotal = 0 : pow85 = 1
2653         End If \' i Mod 5 = 0
2654         iAsc = Asc(Mid(sEncGuid,i+1,1))
2655         sHex = arrTable(iAsc)
2656         If iAsc >=128 Then Exit For
2657         If sHex = "0xff" Then Exit For
2658         iChr = CInt("&h"&Right(sHex,2))
2659         lTotal = lTotal + (iChr * pow85)
2660         If i Mod 5 = 4 Then sDecode = sDecode & DecToHex(lTotal)
2661         pow85 = pow85 * 85
2662         fFailed = False
2663     Next \'i
2664     If NOT fFailed Then sGuid = "{"&Mid(sDecode,1,8)&"-"& _
2665                                 Mid(sDecode,13,4)&"-"& _
2666                                 Mid(sDecode,9,4)&"-"& _
2667                                 Mid(sDecode,23,2) & Mid(sDecode,21,2)&"-"& _
2668                                 Mid(sDecode,19,2) & Mid(sDecode,17,2) & Mid(sDecode,31,2) & Mid(sDecode,29,2) & Mid(sDecode,27,2) & Mid(sDecode,25,2) &"}"
2669 
2670     GetDecodedGuid = NOT fFailed
2671 
2672 End Function \'GetDecodedGuid
2673 \'=======================================================================================================
2674 
2675 \'Convert a long decimal to hex
2676 Function DecToHex(lDec)
2677     
2678     Dim sHex
2679     Dim iLen
2680     Dim lVal, lExp
2681     Dim arrChr
2682   
2683     arrChr = Array("0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F")
2684     sHex = ""
2685     lVal = lDec
2686     lExp = 16^10
2687     While lExp >= 1
2688         If lVal >= lExp Then
2689             sHex = sHex & arrChr(Int(lVal / lExp))
2690             lVal = lVal - lExp * Int(lVal / lExp)
2691         Else
2692             sHex = sHex & "0"
2693             If sHex = "0" Then sHex = ""
2694         End If
2695         lExp = lExp / 16
2696     Wend
2697 
2698     iLen = 8 - Len(sHex)
2699     If iLen > 0 Then sHex = String(iLen,"0") & sHex
2700     DecToHex = sHex
2701 End Function
2702 \'=======================================================================================================
2703 
2704 \'Ensures that only valid metadata entries exist to avoid API failures
2705 Sub EnsureValidWIMetadata (hDefKey,sKey,iValidLength)
2706 
2707 Dim arrKeys
2708 Dim SubKey
2709 
2710 If Len(sKey) > 1 Then
2711     If Right(sKey,1) = "\" Then sKey = Left(sKey,Len(sKey)-1)
2712 End If
2713 
2714 If RegEnumKey(hDefKey,sKey,arrKeys) Then
2715     For Each SubKey in arrKeys
2716         If NOT Len(SubKey) = iValidLength Then
2717             RegDeleteKey hDefKey,sKey & "\" & SubKey & "\"
2718         End If
2719     Next \'SubKey
2720 End If
2721 
2722 End Sub \'EnsureValidWIMetadata
2723 \'=======================================================================================================
2724 
2725 \'Create a backup copy of the file in the ScrubDir then delete the file
2726 Sub CopyAndDeleteFile(sFile)
2727     Dim File
2728     
2729     \'Error handling inlined
2730     On Error Resume Next
2731     If oFso.FileExists(sFile) Then
2732         Set File = oFso.GetFile(sFile)
2733         If Not oFso.FolderExists(sScrubDir & "\" & File.ParentFolder.Name) Then oFso.CreateFolder sScrubDir & "\" & File.ParentFolder.Name
2734         If Not fDetectOnly Then
2735             LogOnly " - Backing up file: " & sFile
2736             oFso.CopyFile sFile,sScrubDir & "\" & File.ParentFolder.Name & "\" & File.Name,True : CheckError "CopyAndDeleteFile"
2737             Set File = Nothing
2738             DeleteFile(sFile)
2739         Else
2740             LogOnly " - Simulate CopyAndDelete file: " & sFile
2741         End If
2742     End If \'oFso.FileExists
2743 End Sub \'CopyAndDeleteFile
2744 \'=======================================================================================================
2745 
2746 \'Wrapper to delete a file
2747 Sub DeleteFile(sFile)
2748     Dim File
2749     Dim sFileName, sNewPath
2750     
2751     On Error Resume Next
2752 
2753     If dicKeepFolder.Exists(LCase(sFile)) Then
2754         If NOT fForce Then
2755             LogOnly " - Disallowing the delete of still required keypath element: " & sFile
2756             Exit Sub
2757         Else
2758             LogOnly " - Enforced delete of still required keypath element: " & sFile
2759             LogOnly "   Remaining applications will need a repair!"
2760         End If
2761     End If
2762     If f64 Then
2763         If dicKeepFolder.Exists(LCase(Wow64Folder(sFile))) Then
2764         If NOT fForce Then
2765             LogOnly " - Disallowing the delete of still required keypath element: " & sFile
2766             Exit Sub
2767         Else
2768             LogOnly " - Enforced delete of still required keypath element: " & sFile
2769             LogOnly "   Remaining applications will need a repair!"
2770         End If
2771         End If
2772     End If
2773 
2774     If oFso.FileExists(sFile) Then
2775         LogOnly " - Delete file: " & sFile
2776         If Not fDetectOnly Then oFso.DeleteFile sFile,True
2777         If Err <> 0 Then
2778             CheckError "DeleteFile"
2779             If fForce Then
2780                 \'Try to move the file and delete from there
2781                 Set File = oFso.GetFile(sFile)
2782                 sFileName = File.Name
2783                 sNewPath = sScrubDir & "\ScrubTmp"
2784                 Set File = Nothing
2785                 If Not oFso.FolderExists(sNewPath) Then oFso.CreateFolder(sNewPath)
2786                 \'Move the file
2787                 LogOnly " - Move file to: " & sNewPath & "\" & sFileName
2788                 oFso.MoveFile sFile,sNewPath & "\" & sFileName
2789                 If Err <> 0 Then 
2790                     CheckError "DeleteFile (move)"
2791                 End If \'Err <> 0
2792             End If \'fForce
2793         End If \'Err <> 0
2794     End If \'oFso.FileExists
2795 End Sub \'DeleteFile
2796 \'=======================================================================================================
2797 
2798 \'64 bit aware wrapper to return the requested folder 
2799 Function GetFolderPath(sPath)
2800     GetFolderPath = True
2801     If oFso.FolderExists(sPath) Then Exit Function
2802     If f64 AND oFso.FolderExists(Wow64Folder(sPath)) Then
2803         sPath = Wow64Folder(sPath)
2804         Exit Function
2805     End If
2806     GetFolderPath = False
2807 End Function \'GetFolderPath
2808 \'=======================================================================================================
2809 
2810 \'Enumerates subfolder names of a folder and returns True if subfolders exist
2811 Function EnumFolderNames (sFolder, arrSubFolders)
2812     Dim Folder, Subfolder
2813     Dim sSubFolders
2814     
2815     If oFso.FolderExists(sFolder) Then
2816         Set Folder = oFso.GetFolder(sFolder)
2817         For Each Subfolder in Folder.Subfolders
2818             sSubFolders = sSubFolders & Subfolder.Name & ","
2819         Next \'Subfolder
2820     End If
2821     If f64 AND oFso.FolderExists(Wow64Folder(sFolder)) Then
2822         Set Folder = oFso.GetFolder(Wow64Folder(sFolder))
2823         For Each Subfolder in Folder.Subfolders
2824             sSubFolders = sSubFolders & Subfolder.Name & ","
2825         Next \'Subfolder
2826     End If
2827     If Len(sSubFolders)>0 Then arrSubFolders = RemoveDuplicates(Split(Left(sSubFolders,Len(sSubFolders)-1),","))
2828     EnumFolderNames = Len(sSubFolders)>0
2829 End Function \'EnumFolderNames
2830 \'=======================================================================================================
2831 
2832 \'Enumerates subfolders of a folder and returns True if subfolders exist
2833 Function EnumFolders (sFolder, arrSubFolders)
2834     Dim Folder, Subfolder
2835     Dim sSubFolders
2836     
2837     If oFso.FolderExists(sFolder) Then
2838         Set Folder = oFso.GetFolder(sFolder)
2839         For Each Subfolder in Folder.Subfolders
2840             sSubFolders = sSubFolders & Subfolder.Path & ","
2841         Next \'Subfolder
2842     End If
2843     If f64 AND oFso.FolderExists(Wow64Folder(sFolder)) Then
2844         Set Folder = oFso.GetFolder(Wow64Folder(sFolder))
2845         For Each Subfolder in Folder.Subfolders
2846             sSubFolders = sSubFolders & Subfolder.Path & ","
2847         Next \'Subfolder
2848     End If
2849     If Len(sSubFolders)>0 Then arrSubFolders = RemoveDuplicates(Split(Left(sSubFolders,Len(sSubFolders)-1),","))
2850     EnumFolders = Len(sSubFolders)>0
2851 End Function \'EnumFolders
2852 \'=======================================================================================================
2853 
2854 Sub GetMseFolderStructure (Folder)
2855     Dim SubFolder
2856     
2857     For Each SubFolder in Folder.SubFolders
2858         ReDim Preserve arrMseFolders(UBound(arrMseFolders)+1)
2859         arrMseFolders(UBound(arrMseFolders)) = SubFolder.Path
2860         GetMseFolderStructure SubFolder
2861     Next \'SubFolder
2862 End Sub \'GetMseFolderStructure
2863 \'=======================================================================================================
2864 
2865 \'Wrapper to delete a folder 
2866 Sub DeleteFolder(sFolder)
2867     Dim Folder
2868     Dim sDelFolder, sFolderName, sNewPath
2869     
2870     \'Ensure trailing "\"
2871     sFolder = sFolder & "\"
2872     While InStr(sFolder,"\\")>0
2873         sFolder = Replace(sFolder,"\\","\")
2874     Wend
2875 
2876     If dicKeepFolder.Exists(LCase(sFolder)) Then
2877         If NOT fForce Then
2878             LogOnly " - Disallowing the delete of still required keypath element: " & sFolder
2879             Exit Sub
2880         Else
2881             LogOnly " - Enforced delete of still required keypath element: " & sFolder
2882             LogOnly "   Remaining applications will need a repair!"
2883         End If
2884     End If
2885     If f64 Then
2886         If dicKeepFolder.Exists(LCase(Wow64Folder(sFolder))) Then
2887         If NOT fForce Then
2888             LogOnly " - Disallowing the delete of still required keypath element: " & sFolder
2889             Exit Sub
2890         Else
2891             LogOnly " - Enforced delete of still required keypath element: " & sFolder
2892             LogOnly "   Remaining applications will need a repair!"
2893         End If
2894         End If
2895     End If
2896     
2897     \'Strip trailing "\"
2898     If Len(sFolder) > 1 Then
2899         sFolder = Left(sFolder,Len(sFolder)-1)
2900     End If
2901 
2902     On Error Resume Next
2903     If oFso.FolderExists(sFolder) Then 
2904         sDelFolder = sFolder
2905     ElseIf f64 AND oFso.FolderExists(Wow64Folder(sFolder)) Then 
2906         sDelFolder = Wow64Folder(sFolder)
2907     Else
2908         Exit Sub
2909     End If
2910     If Not fDetectOnly Then 
2911         LogOnly " - Delete folder: " & sDelFolder
2912         oFso.DeleteFolder sDelFolder,True
2913     Else
2914         LogOnly " - Simulate delete folder: " & sDelFolder
2915     End If
2916     If Err <> 0 Then
2917         CheckError "DeleteFolder"
2918         \'Try to move the folder and delete from there
2919         Set Folder = oFso.GetFolder(sDelFolder)
2920         sFolderName = Folder.Name
2921         sNewPath = sScrubDir & "\ScrubTmp"
2922         Set Folder = Nothing
2923         \'Ensure we stay within the same drive
2924         If Not oFso.FolderExists(sNewPath) Then oFso.CreateFolder(sNewPath)
2925         \'Move the folder
2926         LogOnly " - Moving folder to: " & sNewPath & "\" & sFolderName
2927         oFso.MoveFolder sFolder,sNewPath & "\" & sFolderName
2928         If Err <> 0 Then
2929             CheckError "DeleteFolder (move)"
2930         End If \'Err <> 0
2931     End If \'Err <> 0
2932 End Sub \'DeleteFolder
2933 \'=======================================================================================================
2934 
2935 \'Delete empty folder structures
2936 Sub DeleteEmptyFolders
2937     Dim Folder
2938     Dim sFolder
2939     
2940     If Not IsArray(arrDeleteFolders) Then Exit Sub
2941     Log vbCrLf & " Empty Folder Cleanup"
2942     For Each sFolder in arrDeleteFolders
2943         If oFso.FolderExists(sFolder) Then
2944             Set Folder = oFso.GetFolder(sFolder)
2945             If (Folder.Subfolders.Count = 0) AND (Folder.Files.Count = 0) Then 
2946                 Set Folder = Nothing
2947                 SmartDeleteFolder sFolder
2948             End If
2949         End If
2950     Next \'sFolder
2951 End Sub \'DeleteEmptyFolders
2952 \'=======================================================================================================
2953 
2954 \'Wrapper to delete a folder and remove the empty parent folder structure
2955 Sub SmartDeleteFolder(sFolder)
2956     If oFso.FolderExists(sFolder) Then 
2957         If Not fDetectOnly Then
2958             LogOnly "  Request SmartDelete for folder: " & sFolder
2959             SmartDeleteFolderEx sFolder
2960         Else
2961             LogOnly "  Simulate request SmartDelete for folder: " & sFolder
2962         End If
2963     End If
2964     If f64 AND oFso.FolderExists(Wow64Folder(sFolder)) Then 
2965         If Not fDetectOnly Then 
2966             LogOnly "Request SmartDelete for folder: " & Wow64Folder(sFolder)
2967             SmartDeleteFolderEx Wow64Folder(sFolder)
2968         Else
2969             LogOnly "Simulate request SmartDelete for folder: " & Wow64Folder(sFolder)
2970         End If
2971     End If
2972 End Sub \'SmartDeleteFolder
2973 \'=======================================================================================================
2974 
2975 \'Executes the folder delete operation
2976 Sub SmartDeleteFolderEx(sFolder)
2977     Dim Folder
2978     
2979     On Error Resume Next
2980     DeleteFolder sFolder : CheckError "SmartDeleteFolderEx"
2981     On Error Goto 0
2982     Set Folder = oFso.GetFolder(oFso.GetParentFolderName(sFolder))
2983     If (Folder.Subfolders.Count = 0) AND (Folder.Files.Count = 0) Then SmartDeleteFolderEx(Folder.Path)
2984 End Sub \'SmartDeleteFolderEx
2985 \'=======================================================================================================
2986 
2987 \'Adds the folder structure to the \'KeepFolder\' dictionary
2988 Sub AddKeepFolder(sPath)
2989 
2990     Dim Folder
2991 
2992     \'Ensure trailing "\"
2993     sPath = LCase(sPath) & "\"
2994     While InStr(sPath,"\\")>0
2995         sPath = Replace(sPath,"\\","\")
2996     Wend
2997 
2998     If NOT dicKeepFolder.Exists (sPath) Then
2999         dicKeepFolder.Add sPath,sPath
3000     Else
3001         Exit Sub
3002     End If
3003     sPath = LCase(oFso.GetParentFolderName(sPath)) & "\"
3004     If oFso.FolderExists(sPath) Then AddKeepFolder(sPath)
3005 End Sub
3006 \'=======================================================================================================
3007 
3008 \'Handles additional folder-path operations on 64 bit environments
3009 Function Wow64Folder(sFolder)
3010     If LCase(Left(sFolder,Len(sWinDir & "\System32"))) = LCase(sWinDir & "\System32") Then 
3011         Wow64Folder = sWinDir & "\syswow64" & Right(sFolder,Len(sFolder)-Len(sSys32Dir))
3012     ElseIf LCase(Left(sFolder,Len(sProgramFiles))) = LCase(sProgramFiles) Then 
3013         Wow64Folder = sProgramFilesX86 & Right(sFolder,Len(sFolder)-Len(sProgramFiles))
3014     Else
3015         Wow64Folder = "?" \'Return invalid string to ensure the folder cannot exist
3016     End If
3017 End Function \'Wow64Folder
3018 \'=======================================================================================================
3019 
3020 Function HiveString(hDefKey)
3021     On Error Resume Next
3022     Select Case hDefKey
3023         Case HKCR : HiveString = "HKEY_CLASSES_ROOT"
3024         Case HKCU : HiveString = "HKEY_CURRENT_USER"
3025         Case HKLM : HiveString = "HKEY_LOCAL_MACHINE"
3026         Case HKU  : HiveString = "HKEY_USERS"
3027         Case Else : HiveString = hDefKey
3028     End Select
3029 End Function
3030 \'=======================================================================================================
3031 
3032 Function RegKeyExists(hDefKey,sSubKeyName)
3033     Dim arrKeys
3034     RegKeyExists = False
3035     If oReg.EnumKey(hDefKey,sSubKeyName,arrKeys) = 0 Then RegKeyExists = True
3036 End Function
3037 \'=======================================================================================================
3038 
3039 Function RegValExists(hDefKey,sSubKeyName,sName)
3040     Dim arrValueTypes, arrValueNames
3041     Dim i
3042 
3043     RegValExists = False
3044     If Not RegKeyExists(hDefKey,sSubKeyName) Then Exit Function
3045     If oReg.EnumValues(hDefKey,sSubKeyName,arrValueNames,arrValueTypes) = 0 AND IsArray(arrValueNames) Then
3046         For i = 0 To UBound(arrValueNames) 
3047             If LCase(arrValueNames(i)) = Trim(LCase(sName)) Then RegValExists = True
3048         Next 
3049     End If \'oReg.EnumValues
3050 End Function
3051 \'=======================================================================================================
3052 
3053 \'Read the value of a given registry entry
3054 Function RegReadValue(hDefKey, sSubKeyName, sName, sValue, sType)
3055     Dim RetVal
3056     Dim Item
3057     Dim arrValues
3058     
3059     Select Case UCase(sType)
3060         Case "1","REG_SZ"
3061             RetVal = oReg.GetStringValue(hDefKey,sSubKeyName,sName,sValue)
3062             If Not RetVal = 0 AND f64 Then RetVal = oReg.GetStringValue(hDefKey,Wow64Key(hDefKey, sSubKeyName),sName,sValue)
3063         
3064         Case "2","REG_EXPAND_SZ"
3065             RetVal = oReg.GetExpandedStringValue(hDefKey,sSubKeyName,sName,sValue)
3066             If Not RetVal = 0 AND f64 Then RetVal = oReg.GetExpandedStringValue(hDefKey,Wow64Key(hDefKey, sSubKeyName),sName,sValue)
3067         
3068         Case "7","REG_MULTI_SZ"
3069             RetVal = oReg.GetMultiStringValue(hDefKey,sSubKeyName,sName,arrValues)
3070             If Not RetVal = 0 AND f64 Then RetVal = oReg.GetMultiStringValue(hDefKey,Wow64Key(hDefKey, sSubKeyName),sName,arrValues)
3071             If RetVal = 0 Then sValue = Join(arrValues,chr(34))
3072         
3073         Case "4","REG_DWORD"
3074             RetVal = oReg.GetDWORDValue(hDefKey,sSubKeyName,sName,sValue)
3075             If Not RetVal = 0 AND f64 Then 
3076                 RetVal = oReg.GetDWORDValue(hDefKey,Wow64Key(hDefKey, sSubKeyName),sName,sValue)
3077             End If
3078         
3079         Case "3","REG_BINARY"
3080             RetVal = oReg.GetBinaryValue(hDefKey,sSubKeyName,sName,sValue)
3081             If Not RetVal = 0 AND f64 Then RetVal = oReg.GetBinaryValue(hDefKey,Wow64Key(hDefKey, sSubKeyName),sName,sValue)
3082         
3083         Case "11","REG_QWORD"
3084             RetVal = oReg.GetQWORDValue(hDefKey,sSubKeyName,sName,sValue)
3085             If Not RetVal = 0 AND f64 Then RetVal = oReg.GetQWORDValue(hDefKey,Wow64Key(hDefKey, sSubKeyName),sName,sValue)
3086         
3087         Case Else
3088             RetVal = -1
3089     End Select \'sValue
3090     
3091     RegReadValue = (RetVal = 0)
3092 End Function \'RegReadValue
3093 \'=======================================================================================================
3094 
3095 \'Enumerate a registry key to return all values
3096 Function RegEnumValues(hDefKey,sSubKeyName,arrNames, arrTypes)
3097     Dim RetVal, RetVal64
3098     Dim arrNames32, arrNames64, arrTypes32, arrTypes64
3099     
3100     If f64 Then
3101         RetVal = oReg.EnumValues(hDefKey,sSubKeyName,arrNames32,arrTypes32)
3102         RetVal64 = oReg.EnumValues(hDefKey,Wow64Key(hDefKey, sSubKeyName),arrNames64,arrTypes64)
3103         If (RetVal = 0) AND (Not RetVal64 = 0) AND IsArray(arrNames32) AND IsArray(arrTypes32) Then 
3104             arrNames = arrNames32
3105             arrTypes = arrTypes32
3106         End If
3107         If (Not RetVal = 0) AND (RetVal64 = 0) AND IsArray(arrNames64) AND IsArray(arrTypes64) Then 
3108             arrNames = arrNames64
3109             arrTypes = arrTypes64
3110         End If
3111         If (RetVal = 0) AND (RetVal64 = 0) AND IsArray(arrNames32) AND IsArray(arrNames64) AND IsArray(arrTypes32) AND IsArray(arrTypes64) Then 
3112             arrNames = RemoveDuplicates(Split((Join(arrNames32,"\") & "\" & Join(arrNames64,"\")),"\"))
3113             arrTypes = RemoveDuplicates(Split((Join(arrTypes32,"\") & "\" & Join(arrTypes64,"\")),"\"))
3114         End If
3115     Else
3116         RetVal = oReg.EnumValues(hDefKey,sSubKeyName,arrNames,arrTypes)
3117     End If \'f64
3118     RegEnumValues = ((RetVal = 0) OR (RetVal64 = 0)) AND IsArray(arrNames) AND IsArray(arrTypes)
3119 End Function \'RegEnumValues
3120 \'=======================================================================================================
3121 
3122 \'Enumerate a registry key to return all subkeys
3123 Function RegEnumKey(hDefKey,sSubKeyName,arrKeys)
3124     Dim RetVal, RetVal64
3125     Dim arrKeys32, arrKeys64
3126     
3127     If f64 Then
3128         RetVal = oReg.EnumKey(hDefKey,sSubKeyName,arrKeys32)
3129         RetVal64 = oReg.EnumKey(hDefKey,Wow64Key(hDefKey, sSubKeyName),arrKeys64)
3130         If (RetVal = 0) AND (Not RetVal64 = 0) AND IsArray(arrKeys32) Then arrKeys = arrKeys32
3131         If (Not RetVal = 0) AND (RetVal64 = 0) AND IsArray(arrKeys64) Then arrKeys = arrKeys64
3132         If (RetVal = 0) AND (RetVal64 = 0) Then 
3133             If IsArray(arrKeys32) AND IsArray (arrKeys64) Then 
3134                 arrKeys = RemoveDuplicates(Split((Join(arrKeys32,"\") & "\" & Join(arrKeys64,"\")),"\"))
3135             ElseIf IsArray(arrKeys64) Then
3136                 arrKeys = arrKeys64
3137             Else
3138                 arrKeys = arrKeys32
3139             End If
3140         End If
3141     Else
3142         RetVal = oReg.EnumKey(hDefKey,sSubKeyName,arrKeys)
3143     End If \'f64
3144     RegEnumKey = ((RetVal = 0) OR (RetVal64 = 0)) AND IsArray(arrKeys)
3145 End Function \'RegEnumKey
3146 \'=======================================================================================================
3147 
3148 \'Wrapper around oReg.DeleteValue to handle 64 bit
3149 Sub RegDeleteValue(hDefKey, sSubKeyName, sName)
3150     Dim sWow64Key
3151     Dim iRetVal
3152     
3153     If dicKeepReg.Exists(LCase(sSubKeyName & sName)) Then
3154         If NOT fForce Then
3155             LogOnly " - Disallowing the delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyName & sName
3156             Exit Sub
3157         Else
3158             LogOnly " - Enforced delete of still required keypath element. Remaining applications will need a repair!"
3159         End If
3160     End If
3161     If f64 Then
3162         If dicKeepReg.Exists(LCase(Wow64Key(hDefKey, sSubKeyName) & sName)) Then
3163             If NOT fForce Then
3164                 LogOnly " - Disallowing the delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyName & sName
3165                 Exit Sub
3166             Else
3167                 LogOnly " - Enforced delete of still required keypath element. Remaining applications will need a repair!"
3168             End If
3169         End If
3170     End If
3171 
3172     If RegValExists(hDefKey,sSubKeyName,sName) Then
3173         On Error Resume Next
3174         If Not fDetectOnly Then 
3175             LogOnly " - Delete registry value: " & HiveString(hDefKey) & "\" & sSubKeyName & " -> " & sName
3176             iRetVal = 0
3177             iRetVal = oReg.DeleteValue(hDefKey, sSubKeyName, sName)
3178             CheckError "RegDeleteValue"
3179             If NOT (iRetVal=0) Then LogOnly "     Delete failed. Return value: "&iRetVal
3180         Else
3181             LogOnly " - Simulate delete registry value: " & HiveString(hDefKey) & "\" & sSubKeyName & " -> " & sName
3182         End If
3183         On Error Goto 0
3184     End If \'RegValExists
3185     If f64 Then 
3186         sWow64Key = Wow64Key(hDefKey, sSubKeyName)
3187         If RegValExists(hDefKey,sWow64Key,sName) Then
3188             On Error Resume Next
3189             If Not fDetectOnly Then 
3190             LogOnly " - Delete registry value: " & HiveString(hDefKey) & "\" & sWow64Key & " -> " & sName
3191                 iRetVal = 0
3192                 iRetVal = oReg.DeleteValue(hDefKey, sWow64Key, sName)
3193                 CheckError "RegDeleteValue"
3194                 If NOT (iRetVal=0) Then LogOnly "     Delete failed. Return value: "&iRetVal
3195             Else
3196                 LogOnly " - Simulate delete registry value: " & HiveString(hDefKey) & "\" & sWow64Key & " -> " & sName
3197             End If
3198             On Error Goto 0
3199         End If \'RegKeyExists
3200     End If
3201 End Sub \'RegDeleteValue
3202 \'=======================================================================================================
3203 
3204 \'Wrappper around RegDeleteKeyEx to handle 64bit scenrios
3205 Sub RegDeleteKey(hDefKey, sSubKeyName)
3206     Dim sWow64Key
3207     
3208     \'Ensure trailing "\"
3209     sSubKeyName = sSubKeyName & "\"
3210     While InStr(sSubKeyName,"\\")>0
3211         sSubKeyName = Replace(sSubKeyName,"\\","\")
3212     Wend
3213 
3214     If dicKeepReg.Exists(LCase(sSubKeyName)) Then
3215         If NOT fForce Then
3216             LogOnly " - Disallowing the delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyName
3217             Exit Sub
3218         Else
3219             LogOnly " - Enforced delete of still required keypath element. Remaining applications will need a repair!"
3220         End If
3221     End If
3222     If f64 Then
3223         If dicKeepReg.Exists(LCase(Wow64Key(hDefKey, sSubKeyName))) Then
3224             If NOT fForce Then
3225                 LogOnly " - Disallowing the delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyName
3226                 Exit Sub
3227             Else
3228                 LogOnly " - Enforced delete of still required keypath element. Remaining applications will need a repair!"
3229             End If
3230         End If
3231     End If
3232     
3233     If Len(sSubKeyName) > 1 Then
3234         \'Strip of trailing "\"
3235         sSubKeyName = Left(sSubKeyName,Len(sSubKeyName)-1)
3236     End If
3237     
3238     If RegKeyExists(hDefKey, sSubKeyName) Then
3239         If Not fDetectOnly Then
3240             LogOnly " - Delete registry key: " & HiveString(hDefKey) & "\" & sSubKeyName
3241             On Error Resume Next
3242             RegDeleteKeyEx hDefKey, sSubKeyName
3243             On Error Goto 0
3244         Else
3245             LogOnly " - Simulate delete registry key: " & HiveString(hDefKey) & "\" & sSubKeyName
3246         End If
3247     End If \'RegKeyExists
3248     If f64 Then 
3249         sWow64Key = Wow64Key(hDefKey, sSubKeyName)
3250         If RegKeyExists(hDefKey,sWow64Key) Then
3251             If Not fDetectOnly Then
3252                 LogOnly " - Delete registry key: " & HiveString(hDefKey) & "\" & sWow64Key
3253                 On Error Resume Next
3254                 RegDeleteKeyEx hDefKey, sWow64Key
3255                 On Error Goto 0
3256             Else
3257                 LogOnly " - Simulate delete registry key: " & HiveString(hDefKey) & "\" & sWow64Key
3258             End If
3259         End If \'RegKeyExists
3260     End If
3261 End Sub \'RegDeleteKey
3262 \'=======================================================================================================
3263 
3264 \'Recursively delete a registry structure
3265 Sub RegDeleteKeyEx(hDefKey, sSubKeyName) 
3266     Dim arrSubkeys
3267     Dim sSubkey
3268     Dim iRetVal
3269 
3270     On Error Resume Next
3271     oReg.EnumKey hDefKey, sSubKeyName, arrSubkeys
3272     If IsArray(arrSubkeys) Then 
3273         For Each sSubkey In arrSubkeys 
3274             RegDeleteKeyEx hDefKey, sSubKeyName & "\" & sSubkey 
3275         Next 
3276     End If 
3277     If Not fDetectOnly Then 
3278         iRetVal = 0
3279         iRetVal = oReg.DeleteKey(hDefKey,sSubKeyName)
3280         If NOT (iRetVal=0) Then LogOnly "     Delete failed. Return value: "&iRetVal
3281     End If
3282 End Sub \'RegDeleteKeyEx
3283 \'=======================================================================================================
3284 
3285 \'Return the alternate regkey location on 64bit environment
3286 Function Wow64Key(hDefKey, sSubKeyName)
3287     Dim iPos
3288 
3289     Select Case hDefKey
3290         Case HKCU
3291             If Left(sSubKeyName,17) = "Software\Classes\" Then
3292                 Wow64Key = Left(sSubKeyName,17) & "Wow6432Node\" & Right(sSubKeyName,Len(sSubKeyName)-17)
3293             Else
3294                 iPos = InStr(sSubKeyName,"\")
3295                 Wow64Key = Left(sSubKeyName,iPos) & "Wow6432Node\" & Right(sSubKeyName,Len(sSubKeyName)-iPos)
3296             End If
3297         
3298         Case HKLM
3299             If Left(sSubKeyName,17) = "Software\Classes\" Then
3300                 Wow64Key = Left(sSubKeyName,17) & "Wow6432Node\" & Right(sSubKeyName,Len(sSubKeyName)-17)
3301             Else
3302                 iPos = InStr(sSubKeyName,"\")
3303                 Wow64Key = Left(sSubKeyName,iPos) & "Wow6432Node\" & Right(sSubKeyName,Len(sSubKeyName)-iPos)
3304             End If
3305         
3306         Case Else
3307             Wow64Key = "Wow6432Node\" & sSubKeyName
3308         
3309     End Select \'hDefKey
3310 End Function \'Wow64Key
3311 \'=======================================================================================================
3312 
3313 \'Remove duplicate entries from a one dimensional array
3314 Function RemoveDuplicates(Array)
3315     Dim Item
3316     Dim oDic
3317     
3318     Set oDic = CreateObject("Scripting.Dictionary")
3319     For Each Item in Array
3320         If Not oDic.Exists(Item) Then oDic.Add Item,Item
3321     Next \'Item
3322     RemoveDuplicates = oDic.Keys
3323 End Function \'RemoveDuplicates
3324 \'=======================================================================================================
3325 
3326 \'Uses WMI to stop a service
3327 Function StopService(sService)
3328     Dim Services, Service
3329     Dim sQuery
3330     Dim iRet
3331 
3332     On Error Resume Next
3333     
3334     iRet = 0
3335     sQuery = "Select * From Win32_Service Where Name=\'" & sService & "\'"
3336     Set Services = oWmiLocal.Execquery(sQuery)
3337     \'Stop the service
3338     For Each Service in Services
3339         If UCase(Service.State) = "STARTED" Then iRet = Service.StopService
3340         If UCase(Service.State) = "RUNNING" Then iRet = Service.StopService
3341 
3342     Next \'Service
3343     StopService = (iRet = 0)
3344 End Function \'StopService
3345 \'=======================================================================================================
3346 
3347 \'Delete a service
3348 Sub DeleteService(sService)
3349     Dim Services, Service, Processes, Process
3350     Dim sQuery, sStates
3351     Dim iRet
3352     
3353     On Error Resume Next
3354     
3355     sStates = "STARTED;RUNNING"
3356     sQuery = "Select * From Win32_Service Where Name=\'" & sService & "\'"
3357     Set Services = oWmiLocal.Execquery(sQuery)
3358     
3359     \'Stop and delete the service
3360     For Each Service in Services
3361         Log " Found service " & sService & " in state " & Service.State
3362         If InStr(sStates,UCase(Service.State))>0 Then iRet = Service.StopService()
3363         \'Ensure no more instances of the service are running
3364         Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name=\'" & sService & ".exe\'")
3365         For Each Process in Processes
3366             iRet = Process.Terminate()
3367         Next \'Process
3368         If Not fDetectOnly Then 
3369             Log " - Deleting Service -> " & sService
3370             iRet = Service.Delete()
3371         Else
3372             Log " - Simulate deleting Service -> " & sService
3373         End If
3374     Next \'Service
3375     Set Services = Nothing
3376     Err.Clear
3377 
3378 End Sub \'DeleteService
3379 \'=======================================================================================================
3380 
3381 \'Translation for setup.exe error codes
3382 Function SetupRetVal(RetVal)
3383     Select Case RetVal
3384         Case 0 : SetupRetVal = "Success"
3385         Case 30001,1 : SetupRetVal = "AbstractMethod"
3386         Case 30002,2 : SetupRetVal = "ApiProhibited"
3387         Case 30003,3  : SetupRetVal = "AlreadyImpersonatingAUser"
3388         Case 30004,4 : SetupRetVal = "AlreadyInitialized"
3389         Case 30005,5 : SetupRetVal = "ArgumentNullException"
3390         Case 30006,6 : SetupRetVal = "AssertionFailed"
3391         Case 30007,7 : SetupRetVal = "CABFileAddFailed"
3392         Case 30008,8 : SetupRetVal = "CommandFailed"
3393         Case 30009,9 : SetupRetVal = "ConcatenationFailed"
3394         Case 30010,10 : SetupRetVal = "CopyFailed"
3395         Case 30011,11 : SetupRetVal = "CreateEventFailed"
3396         Case 30012,12 : SetupRetVal = "CustomizationPatchNotFound"
3397         Case 30013,13 : SetupRetVal = "CustomizationPatchNotApplicable"
3398         Case 30014,14 : SetupRetVal = "DuplicateDefinition"
3399         Case 30015,15 : SetupRetVal = "ErrorCodeOnly - Passthrough for Win32 error"
3400         Case 30016,16 : SetupRetVal = "ExceptionNotThrown"
3401         Case 30017,17 : SetupRetVal = "FailedToImpersonateUser"
3402         Case 30018,18 : SetupRetVal = "FailedToInitializeFlexDataSource"
3403         Case 30019,19 : SetupRetVal = "FailedToStartClassFactories"
3404         Case 30020,20 : SetupRetVal = "FileNotFound"
3405         Case 30021,21 : SetupRetVal = "FileNotOpen"
3406         Case 30022,22 : SetupRetVal = "FlexDialogAlreadyInitialized"
3407         Case 30023,23 : SetupRetVal = "HResultOnly - Passthrough for HRESULT errors"
3408         Case 30024,24 : SetupRetVal = "HWNDNotFound"
3409         Case 30025,25 : SetupRetVal = "IncompatibleCacheAction"
3410         Case 30026,26 : SetupRetVal = "IncompleteProductAddOns"
3411         Case 30027,27 : SetupRetVal = "InstalledProductStateCorrupt"
3412         Case 30028,28 : SetupRetVal = "InsufficientBuffer"
3413         Case 30029,29 : SetupRetVal = "InvalidArgument"
3414         Case 30030,30 : SetupRetVal = "InvalidCDKey"
3415         Case 30031,31 : SetupRetVal = "InvalidColumnType"
3416         Case 30032,31 : SetupRetVal = "InvalidConfigAddLanguage"
3417         Case 30033,33 : SetupRetVal = "InvalidData"
3418         Case 30034,34 : SetupRetVal = "InvalidDirectory"
3419         Case 30035,35 : SetupRetVal = "InvalidFormat"
3420         Case 30036,36 : SetupRetVal = "InvalidInitialization"
3421         Case 30037,37 : SetupRetVal = "InvalidMethod"
3422         Case 30038,38 : SetupRetVal = "InvalidOperation"
3423         Case 30039,39 : SetupRetVal = "InvalidParameter"
3424         Case 30040,40 : SetupRetVal = "InvalidProductFromARP"
3425         Case 30041,41 : SetupRetVal = "InvalidProductInConfigXml"
3426         Case 30042,42 : SetupRetVal = "InvalidReference"
3427         Case 30043,43 : SetupRetVal = "InvalidRegistryValueType"
3428         Case 30044,44 : SetupRetVal = "InvalidXMLProperty"
3429         Case 30045,45 : SetupRetVal = "InvalidMetadataFile"
3430         Case 30046,46 : SetupRetVal = "LogNotInitialized"
3431         Case 30047,47 : SetupRetVal = "LogAlreadyInitialized"
3432         Case 30048,48 : SetupRetVal = "MissingXMLNode"
3433         Case 30049,49 : SetupRetVal = "MsiTableNotFound"
3434         Case 30050,50 : SetupRetVal = "MsiAPICallFailure"
3435         Case 30051,51 : SetupRetVal = "NodeNotOfTypeElement"
3436         Case 30052,52 : SetupRetVal = "NoMoreGraceBoots"
3437         Case 30053,53 : SetupRetVal = "NoProductsFound"
3438         Case 30054,54 : SetupRetVal = "NoSupportedCulture"
3439         Case 30055,55 : SetupRetVal = "NotYetImplemented"
3440         Case 30056,56 : SetupRetVal = "NotAvailableCulture"
3441         Case 30057,57 : SetupRetVal = "NotCustomizationPatch"
3442         Case 30058,58 : SetupRetVal = "NullReference"
3443         Case 30059,59 : SetupRetVal = "OCTPatchForbidden"
3444         Case 30060,60 : SetupRetVal = "OCTWrongMSIDll"
3445         Case 30061,61 : SetupRetVal = "OutOfBoundsIndex"
3446         Case 30062,62 : SetupRetVal = "OutOfDiskSpace"
3447         Case 30063,63 : SetupRetVal = "OutOfMemory"
3448         Case 30064,64 : SetupRetVal = "OutOfRange"
3449         Case 30065,65 : SetupRetVal = "PatchApplicationFailure"
3450         Case 30066,66 : SetupRetVal = "PreReqCheckFailure"
3451         Case 30067,67 : SetupRetVal = "ProcessAlreadyStarted"
3452         Case 30068,68 : SetupRetVal = "ProcessNotStarted"
3453         Case 30069,69 : SetupRetVal = "ProcessNotFinished"
3454         Case 30070,70 : SetupRetVal = "ProductAlreadyDefined"
3455         Case 30071,71 : SetupRetVal = "ResourceAlreadyTracked"
3456         Case 30072,72 : SetupRetVal = "ResourceNotFound"
3457         Case 30073,73 : SetupRetVal = "ResourceNotTracked"
3458         Case 30074,74 : SetupRetVal = "SQLAlreadyConnected"
3459         Case 30075,75 : SetupRetVal = "SQLFailedToAllocateHandle"
3460         Case 30076,76 : SetupRetVal = "SQLFailedToConnect"
3461         Case 30077,77 : SetupRetVal = "SQLFailedToExecuteStatement"
3462         Case 30078,78 : SetupRetVal = "SQLFailedToRetrieveData"
3463         Case 30079,79 : SetupRetVal = "SQLFailedToSetAttribute"
3464         Case 30080,80 : SetupRetVal = "StorageNotCreated"
3465         Case 30081,81 : SetupRetVal = "StreamNameTooLong"
3466         Case 30082,82 : SetupRetVal = "SystemError"
3467         Case 30083,83 : SetupRetVal = "ThreadAlreadyStarted"
3468         Case 30084,84 : SetupRetVal = "ThreadNotStarted"
3469         Case 30085,85 : SetupRetVal = "ThreadNotFinished"
3470         Case 30086,86 : SetupRetVal = "TooManyProducts"
3471         Case 30087,87 : SetupRetVal = "UnexpectedXMLNodeType"
3472         Case 30088,88 : SetupRetVal = "UnexpectedError"
3473         Case 30089,89 : SetupRetVal = "Unitialized"
3474         Case 30090,90 : SetupRetVal = "UserCancel"
3475         Case 30091,91 : SetupRetVal = "ExternalCommandFailed"
3476         Case 30092,92 : SetupRetVal = "SPDatabaseOverSize"
3477         Case 30093,93 : SetupRetVal = "IntegerTruncation"
3478         \'msiexec return values
3479         Case 1259 : SetupRetVal = "APPHELP_BLOCK"
3480         Case 1601 : SetupRetVal = "INSTALL_SERVICE_FAILURE"
3481         Case 1602 : SetupRetVal = "INSTALL_USEREXIT"
3482         Case 1603 : SetupRetVal = "INSTALL_FAILURE"
3483         Case 1604 : SetupRetVal = "INSTALL_SUSPEND"
3484         Case 1605 : SetupRetVal = "UNKNOWN_PRODUCT"
3485         Case 1606 : SetupRetVal = "UNKNOWN_FEATURE"
3486         Case 1607 : SetupRetVal = "UNKNOWN_COMPONENT"
3487         Case 1608 : SetupRetVal = "UNKNOWN_PROPERTY"
3488         Case 1609 : SetupRetVal = "INVALID_HANDLE_STATE"
3489         Case 1610 : SetupRetVal = "BAD_CONFIGURATION"
3490         Case 1611 : SetupRetVal = "INDEX_ABSENT"
3491         Case 1612 : SetupRetVal = "INSTALL_SOURCE_ABSENT"
3492         Case 1613 : SetupRetVal = "INSTALL_PACKAGE_VERSION"
3493         Case 1614 : SetupRetVal = "PRODUCT_UNINSTALLED"
3494         Case 1615 : SetupRetVal = "BAD_QUERY_SYNTAX"
3495         Case 1616 : SetupRetVal = "INVALID_FIELD"
3496         Case 1618 : SetupRetVal = "INSTALL_ALREADY_RUNNING"
3497         Case 1619 : SetupRetVal = "INSTALL_PACKAGE_OPEN_FAILED"
3498         Case 1620 : SetupRetVal = "INSTALL_PACKAGE_INVALID"
3499         Case 1621 : SetupRetVal = "INSTALL_UI_FAILURE"
3500         Case 1622 : SetupRetVal = "INSTALL_LOG_FAILURE"
3501         Case 1623 : SetupRetVal = "INSTALL_LANGUAGE_UNSUPPORTED"
3502         Case 1624 : SetupRetVal = "INSTALL_TRANSFORM_FAILURE"
3503         Case 1625 : SetupRetVal = "INSTALL_PACKAGE_REJECTED"
3504         Case 1626 : SetupRetVal = "FUNCTION_NOT_CALLED"
3505         Case 1627 : SetupRetVal = "FUNCTION_FAILED"
3506         Case 1628 : SetupRetVal = "INVALID_TABLE"
3507         Case 1629 : SetupRetVal = "DATATYPE_MISMATCH"
3508         Case 1630 : SetupRetVal = "UNSUPPORTED_TYPE"
3509         Case 1631 : SetupRetVal = "CREATE_FAILED"
3510         Case 1632 : SetupRetVal = "INSTALL_TEMP_UNWRITABLE"
3511         Case 1633 : SetupRetVal = "INSTALL_PLATFORM_UNSUPPORTED"
3512         Case 1634 : SetupRetVal = "INSTALL_NOTUSED"
3513         Case 1635 : SetupRetVal = "PATCH_PACKAGE_OPEN_FAILED"
3514         Case 1636 : SetupRetVal = "PATCH_PACKAGE_INVALID"
3515         Case 1637 : SetupRetVal = "PATCH_PACKAGE_UNSUPPORTED"
3516         Case 1638 : SetupRetVal = "PRODUCT_VERSION"
3517         Case 1639 : SetupRetVal = "INVALID_COMMAND_LINE"
3518         Case 1640 : SetupRetVal = "INSTALL_REMOTE_DISALLOWED"
3519         Case 1641 : SetupRetVal = "SUCCESS_REBOOT_INITIATED"
3520         Case 1642 : SetupRetVal = "PATCH_TARGET_NOT_FOUND"
3521         Case 1643 : SetupRetVal = "PATCH_PACKAGE_REJECTED"
3522         Case 1644 : SetupRetVal = "INSTALL_TRANSFORM_REJECTED"
3523         Case 1645 : SetupRetVal = "INSTALL_REMOTE_PROHIBITED"
3524         Case 1646 : SetupRetVal = "PATCH_REMOVAL_UNSUPPORTED"
3525         Case 1647 : SetupRetVal = "UNKNOWN_PATCH"
3526         Case 1648 : SetupRetVal = "PATCH_NO_SEQUENCE"
3527         Case 1649 : SetupRetVal = "PATCH_REMOVAL_DISALLOWED"
3528         Case 1650 : SetupRetVal = "INVALID_PATCH_XML"
3529         Case 3010 : SetupRetVal = "SUCCESS_REBOOT_REQUIRED"
3530         Case Else : SetupRetVal = "Unknown Return Value"
3531     End Select
3532 End Function \'SetupRetVal
3533 \'=======================================================================================================
3534 
3535 Function GetProductID(sProdID)
3536         Dim sReturn
3537         
3538         Select Case sProdId
3539         
3540         Case "000F" : sReturn = "MONDO"
3541         Case "0010" : sReturn = "WEBFLDRS"
3542         Case "0011" : sReturn = "PROPLUS"
3543         Case "0012" : sReturn = "STANDARD"
3544         Case "0013" : sReturn = "BASIC"
3545         Case "0014" : sReturn = "PRO"
3546         Case "0015" : sReturn = "ACCESS"
3547         Case "0016" : sReturn = "EXCEL"
3548         Case "0017" : sReturn = "SharePointDesigner"
3549         Case "0018" : sReturn = "PowerPoint"
3550         Case "0019" : sReturn = "Publisher"
3551         Case "001A" : sReturn = "Outlook"
3552         Case "001B" : sReturn = "Word"
3553         Case "001C" : sReturn = "AccessRuntime"
3554         Case "001F" : sReturn = "Proof"
3555         Case "0020" : sReturn = "O2007CNV"
3556         Case "0021" : sReturn = "VisualWebDeveloper"
3557         Case "0026" : sReturn = "ExpressionWeb"
3558         Case "0029" : sReturn = "Excel"
3559         Case "002A" : sReturn = "Office64"
3560         Case "002B" : sReturn = "Word"
3561         Case "002C" : sReturn = "Proofing"
3562         Case "002E" : sReturn = "Ultimate"
3563         Case "002F" : sReturn = "HomeAndStudent"
3564         Case "0028" : sReturn = "IME"
3565         Case "0030" : sReturn = "Enterprise"
3566         Case "0031" : sReturn = "ProfessionalHybrid"
3567         Case "0033" : sReturn = "Personal"
3568         Case "0035" : sReturn = "ProfessionalHybrid"
3569         Case "0037" : sReturn = "PowerPoint"
3570         Case "003A" : sReturn = "PrjStd"
3571         Case "003B" : sReturn = "PrjPro"
3572         Case "003D" : sReturn = "SINGLEIMAGE"
3573         Case "0043" : sReturn = "OFFICE32"
3574         Case "0044" : sReturn = "InfoPath"
3575         Case "0045" : sReturn = "XWEB"
3576         Case "0048" : sReturn = "OLC"
3577         Case "0049" : sReturn = "ACADEMIC"
3578         Case "004A" : sReturn = "OWC11"
3579         Case "0051" : sReturn = "VISPRO"
3580         Case "0052" : sReturn = "VisView"
3581         Case "0053" : sReturn = "VisStd"
3582         Case "0054" : sReturn = "VisMUI"
3583         Case "0055" : sReturn = "VisMUI"
3584         Case "0057" : sReturn = "VISIO"
3585         Case "0061" : sReturn = "CLICK2RUN"
3586         Case "0062" : sReturn = "CLICK2RUN"
3587         Case "0066" : sReturn = "CLICK2RUN"
3588         Case "006C" : sReturn = "CLICK2RUN"
3589         Case "006D" : sReturn = "CLICK2RUN"
3590         Case "006E" : sReturn = "Shared"
3591         Case "006F" : sReturn = "OFFICE"
3592         Case "0074" : sReturn = "STARTER"
3593         Case "007C" : sReturn = "OLC" \'Outlook Connector
3594         Case "007C" : sReturn = "OSCFB" \'Outlook Social Connector for FaceBook
3595         Case "007D" : sReturn = "OSCWL" \'Outlook Social Connector for Windows Live Messenger
3596         Case "008A" : sReturn = "RecentDocs"
3597         Case "008B" : sReturn = "SmallBusinessBasics"
3598         Case "00A1" : sReturn = "ONENOTE"
3599         Case "00A3" : sReturn = "OneNoteHomeStudent"
3600         Case "00A7" : sReturn = "CPAO"
3601         Case "00A9" : sReturn = "InterConnect"
3602         Case "00AF" : sReturn = "PPtView"
3603         Case "00B0" : sReturn = "ExPdf"
3604         Case "00B1" : sReturn = "ExXps"
3605         Case "00B2" : sReturn = "ExPdfXps"
3606         Case "00B4" : sReturn = "PrjMUI"
3607         Case "00B5" : sReturn = "PrjtMUI"
3608         Case "00B9" : sReturn = "AER"
3609         Case "00BA" : sReturn = "Groove"
3610         Case "00CA" : sReturn = "SmallBusiness"
3611         Case "00E0" : sReturn = "Outlook"
3612         Case "00D1" : sReturn = "ACE"
3613         Case "0100" : sReturn = "OfficeMUI"
3614         Case "0101" : sReturn = "OfficeXMUI"
3615         Case "0103" : sReturn = "PTK"
3616         Case "0114" : sReturn = "GrooveSetupMetadata"
3617         Case "0115" : sReturn = "SharedSetupMetadata"
3618         Case "0116" : sReturn = "SharedSetupMetadata"
3619         Case "0117" : sReturn = "AccessSetupMetadata"
3620         Case "011A" : sReturn = "SendASmile"
3621         Case "011D" : sReturn = "ProPlusSubscription"
3622         Case "011F" : sReturn = "OLConnect"
3623         
3624         Case "1014" : sReturn = "STS"
3625         Case "1015" : sReturn = "WSSMUI"
3626         Case "1032" : sReturn = "PJSVRAPP"
3627         Case "104B" : sReturn = "SPS"
3628         Case "104E" : sReturn = "SPSMUI"
3629         Case "107F" : sReturn = "OSrv"
3630         Case "1080" : sReturn = "OSrv"
3631         Case "1088" : sReturn = "lpsrvwfe"
3632         Case "10D7" : sReturn = "IFS"
3633         Case "10D8" : sReturn = "IFSMUI"
3634         Case "10EB" : sReturn = "DLCAPP"
3635         Case "10F5" : sReturn = "XLSRVAPP"
3636         Case "10F6" : sReturn = "XlSrvWFE"
3637         Case "10F7" : sReturn = "DLC"
3638         Case "10F8" : sReturn = "SlSrvMui"
3639         Case "10FB" : sReturn = "OSrchWFE"
3640         Case "10FC" : sReturn = "OSRCHAPP"
3641         Case "10FD" : sReturn = "OSrchMUI"
3642         Case "1103" : sReturn = "DLC"
3643         Case "1104" : sReturn = "LHPSRV"
3644         Case "1105" : sReturn = "PIA"
3645         Case "1106" : sReturn = "GRVMGMTSRV"
3646         Case "1109" : sReturn = "GSERVERRELAY"
3647         Case "110D" : sReturn = "OSERVER"
3648         Case "110F" : sReturn = "PSERVER"
3649         Case "1110" : sReturn = "WSS"
3650         Case "1121" : sReturn = "SPSSDK"
3651         Case "1122" : sReturn = "SPSDev"
3652         Case Else : sReturn = sProdID
3653         
3654         End Select \'sProdId
3655     GetProductID = sReturn
3656 End Function \'GetProductID
3657 \'=======================================================================================================
3658 
3659 Sub Log (sLog)
3660     wscript.echo sLog
3661     LogStream.WriteLine sLog
3662 End Sub \'Log
3663 \'=======================================================================================================
3664 
3665 Sub LogOnly (sLog)
3666     LogStream.WriteLine sLog
3667 End Sub \'Log
3668 \'=======================================================================================================
3669 
3670 Sub CheckError(sModule)
3671     If Err <> 0 Then 
3672         LogOnly "   " & Now & " - " & sModule & " - Source: " & Err.Source & "; Err# (Hex): " & Hex( Err ) & _
3673                "; Err# (Dec): " & Err & "; Description : " & Err.Description
3674     End If \'Err = 0
3675     Err.Clear
3676 End Sub
3677 \'=======================================================================================================
3678 
3679 \'Command line parser
3680 Sub ParseCmdLine
3681 
3682     Dim iCnt, iArgCnt
3683     Dim arrArguments
3684     Dim sArg0
3685     
3686     iArgCnt = Wscript.Arguments.Count
3687     If iArgCnt > 0 Then
3688         If wscript.Arguments(0) = "UAC" Then
3689             If wscript.arguments.count = 1 Then iArgCnt = 0
3690         End If
3691     End If
3692     If iArgCnt = 0 Then
3693         Select Case UCase(wscript.ScriptName)
3694         Case Else
3695             \'Create the log
3696             CreateLog
3697             Log "No argument specified. Preparing user prompt" & vbCrLf
3698             FindInstalledOProducts
3699             If dicInstalledSku.Count > 0 Then sDefault = Join(RemoveDuplicates(dicInstalledSku.Items),",") Else sDefault = "CLIENTALL"
3700             sDefault = InputBox("Enter a list of " & ONAME & " products to remove" & vbCrLf & vbCrLf & _
3701                     "Examples:" & vbCrLf & _
3702                     "CLIENTALL" & vbTab & "-> all Client products" & vbCrLf & _
3703                     "SERVER" & vbTab & "-> all Server products" & vbCrLf & _
3704                     "ALL" & vbTab & vbTab & "-> all Server & Client products" & vbCrLf & _
3705                     "ProPlus,PrjPro" & vbTab & "-> ProPlus and Project" & vbCrLf &_
3706                     "?" & vbTab & vbTab & "-> display Help", _
3707                     SCRIPTFILE & " - " & ONAME & " remover", _
3708                     sDefault)
3709 
3710             If IsEmpty(sDefault) Then \'User cancelled
3711                 Log "User cancelled. CleanUp & Exit."
3712                 \'Undo temporary entries created in ARP
3713                 TmpKeyCleanUp
3714                 wscript.quit 1602
3715             End If \'IsEmpty(sDefault)
3716             Log "Answer from prompt: " & sDefault & vbCrLf
3717             sDefault = Trim(UCase(Trim(Replace(sDefault,Chr(34),""))))
3718             arrArguments = Split(Trim(sDefault)," ")
3719             If UBound(arrArguments) = -1 Then ReDim arrArguments(0)
3720         End Select
3721     Else
3722         ReDim arrArguments(iArgCnt-1)
3723         For iCnt = 0 To (iArgCnt-1)
3724             arrArguments(iCnt) = UCase(Wscript.Arguments(iCnt))
3725         Next \'iCnt
3726     End If \'iArgCnt = 0
3727 
3728     \'Handle the SKU list
3729     sArg0 = Replace(arrArguments(0),"/","")
3730     sArg0 = Replace(sArg0,"-","")
3731 
3732     Select Case UCase(sArg0)
3733     
3734     Case "?"
3735         ShowSyntax
3736     
3737     Case "ALL"
3738         fRemoveAll = True
3739         fRemoveOse = False
3740     
3741     Case "CLIENTSUITES"
3742         fRemoveCSuites = True
3743         fRemoveOse = False
3744     
3745     Case "CLIENTSTANDALONE"
3746         fRemoveCSingle = True
3747         fRemoveOse = False
3748 
3749     Case "CLIENTALL"
3750         fRemoveCSuites = True
3751         fRemoveCSingle = True
3752         fRemoveOse = False
3753     
3754     Case "SERVER"
3755         fRemoveSrv = True
3756         fRemoveOse = False
3757 
3758     Case "ALL,OSE"
3759         fRemoveAll = True
3760         fRemoveOse = True
3761     
3762     Case Else
3763         fRemoveAll = False
3764         fRemoveOse = False
3765         sSkuRemoveList = sArg0
3766     
3767     End Select
3768     
3769     For iCnt = 0 To UBound(arrArguments)
3770 
3771         Select Case arrArguments(iCnt)
3772         
3773         Case "?","/?","-?"
3774             ShowSyntax
3775         
3776         Case "/B","/BYPASS"
3777             If UBound(arrArguments)>iCnt Then
3778                 If InStr(arrArguments(iCnt+1),"1")>0 Then fBypass_Stage1 = True
3779                 If InStr(arrArguments(iCnt+1),"2")>0 Then fBypass_Stage2 = True
3780                 If InStr(arrArguments(iCnt+1),"3")>0 Then fBypass_Stage3 = True
3781                 If InStr(arrArguments(iCnt+1),"4")>0 Then fBypass_Stage4 = True
3782             End If
3783         
3784         Case "/D","/DELETEUSERSETTINGS"
3785             fKeepUser = False
3786         
3787         Case "/FR","/FASTREMOVE"
3788             fBypass_Stage1 = True
3789             fSkipSD = True
3790         
3791         Case "/F","/FORCE"
3792             fForce = True
3793         
3794         Case "/K","/KEEPUSERSETTINGS"
3795             fKeepUser = True
3796         
3797         Case "/L","/LOG"
3798             fLogInitialized = False
3799             If UBound(arrArguments)>iCnt Then
3800                 If oFso.FolderExists(arrArguments(iCnt+1)) Then 
3801                     sLogDir = arrArguments(iCnt+1)
3802                 Else
3803                     On Error Resume Next
3804                     oFso.CreateFolder(arrArguments(iCnt+1))
3805                     If Err <> 0 Then sLogDir = sScrubDir Else sLogDir = arrArguments(iCnt+1)
3806                 End If
3807             End If
3808         
3809         Case "/N","/NOCANCEL"
3810             fNoCancel = True
3811         
3812         Case "/O","/OSE"
3813             fRemoveOse = True
3814         
3815         Case "/P","/PREVIEW","/DETECTONLY"
3816             fDetectOnly = True
3817         
3818         Case "/Q","/QUIET"
3819             fQuiet = True
3820         
3821         Case "/QND"
3822             fBypass_Stage1 = True
3823             fBypass_Stage2 = True
3824             fBypass_Stage3 = True
3825             fRemoveOse = True
3826             fRemoveOspp = True
3827             fRemoveC2R = True
3828             fRemoveAll = True
3829             fSkipSD = True
3830             fForce = True
3831         
3832         Case "/S","/SKIPSD","/SKIPSHORTCUSTDETECTION"
3833             fSkipSD = True
3834         
3835         Case "/R","/RECONCILE"
3836             fTryReconcile = True
3837         
3838         Case Else
3839         
3840         End Select
3841     Next \'iCnt
3842     If Not fLogInitialized Then CreateLog
3843 
3844 End Sub \'ParseCmdLine
3845 \'=======================================================================================================
3846 
3847 Sub CreateLog
3848     Dim DateTime
3849     Dim sLogName
3850     
3851     On Error Resume Next
3852     \'Create the log file
3853     Set DateTime = CreateObject("WbemScripting.SWbemDateTime")
3854     DateTime.SetVarDate Now,True
3855     sLogName = sLogDir & "\" & oWShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
3856     sLogName = sLogName &  "_" & Left(DateTime.Value,14)
3857     sLogName = sLogName & "_ScrubLog.txt"
3858     Err.Clear
3859     Set LogStream = oFso.CreateTextFile(sLogName,True,True)
3860     If Err <> 0 Then 
3861         Err.Clear
3862         sLogDir = sScrubDir
3863         sLogName = sLogDir & "\" & oWShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
3864         sLogName = sLogName &  "_" & Left(DateTime.Value,14)
3865         sLogName = sLogName & "_ScrubLog.txt"
3866         Set LogStream = oFso.CreateTextFile(sLogName,True,True)
3867     End If
3868 
3869     Log "Microsoft Customer Support Services - " & ONAME & " Removal Utility" & vbCrLf & vbCrLf & _
3870                 "Version: " & SCRIPTVERSION & vbCrLf & _
3871                 "64 bit OS: " & f64 & vbCrLf & _
3872                 "Start removal: " & Now & vbCrLf
3873     fLogInitialized = True
3874 End Sub \'CreateLog
3875 \'=======================================================================================================
3876 
3877 Sub RelaunchAsCScript
3878     Dim Argument
3879     Dim sCmdLine
3880     
3881     sCmdLine = "cmd.exe /k " & WScript.Path & "\cscript.exe //NOLOGO " & Chr(34) & WScript.scriptFullName & Chr(34)
3882     If Wscript.Arguments.Count > 0 Then
3883         For Each Argument in Wscript.Arguments
3884             sCmdLine = sCmdLine  &  " " & chr(34) & Argument & chr(34)
3885         Next \'Argument
3886     End If
3887     oWShell.Run sCmdLine,1,False
3888     Wscript.Quit
3889 End Sub \'RelaunchAsCScript
3890 \'=======================================================================================================
3891 
3892 Sub RelaunchElevated
3893     Dim Argument
3894     Dim sCmdLine
3895     Dim oShell
3896 
3897     Set oShell = CreateObject("Shell.Application")
3898 
3899     sCmdLine = Chr(34) & WScript.scriptFullName & Chr(34)
3900     If Wscript.Arguments.Count > 0 Then
3901         For Each Argument in Wscript.Arguments
3902             Select Case UCase(Argument)
3903             Case "/Q","/QUIET"
3904                 \'Don\'t try to relaunch in quiet mode
3905                 Exit Sub
3906             Case "UAC"
3907                 \'Already tried elevated relaunch
3908                 Exit Sub
3909             Case Else
3910                 sCmdLine = sCmdLine  &  " " & chr(34) & Argument & chr(34)
3911             End Select
3912         Next \'Argument
3913     End If
3914     oShell.ShellExecute "cscript.exe", sCmdLine & " UAC", "", "runas", 1
3915     Wscript.Quit
3916 End Sub \'RelaunchElevated
3917 \'=======================================================================================================
3918 
3919 \'Show the expected syntax for the script usage
3920 Sub ShowSyntax
3921     TmpKeyCleanUp
3922     Wscript.Echo sErr & vbCrLf & _
3923              SCRIPTFILE & " V " & SCRIPTVERSION & vbCrLf & _
3924              "Copyright (c) Microsoft Corporation. All Rights Reserved" & vbCrLf & vbCrLf & _
3925              SCRIPTFILE & " helps to remove " & ONAME & " Server & Client products" & vbCrLf & _
3926              "when a regular uninstall is no longer possible" & vbCrLf & vbCrLf & _
3927              "Usage:" & vbTab & SCRIPTFILE & " [List of config ProductIDs] [Options]" & vbCrLf & vbCrLf & _
3928              vbTab & "/?                               \' Displays this help"& vbCrLf &_
3929              vbTab & "/Force                           \' Enforces file removal. May cause data loss!" & vbCrLf &_
3930              vbTab & "/SkipShortcutDetection           \' Does not search the local hard drives for shortcuts" & vbCrLf & _
3931              vbTab & "/Log [LogfolderPath]             \' Custom folder for log files" & vbCrLf & _
3932              vbTab & "/NoCancel                        \' Setup.exe and Msiexec.exe have no Cancel button" & vbCrLf &_
3933              vbTab & "/OSE                             \' Forces removal of the Office Source Engine service" & vbCrLf &_
3934              vbTab & "/Quiet                           \' Setup.exe and Msiexec.exe run quiet with no UI" & vbCrLf &_
3935              vbTab & "/Preview                         \' Run this script to preview what would get removed"& vbCrLf & vbCrLf & _
3936              "Examples:"& vbCrLf & _
3937              vbTab & SCRIPTFILE & " CLIENTALL         \' Remove all " & ONAME & " Client products" & vbCrLf &_
3938              vbTab & SCRIPTFILE & " SERVER            \' Remove all " & ONAME & " Server products" & vbCrLf &_
3939              vbTab & SCRIPTFILE & " ALL               \' Remove all " & ONAME & " Server & Client products" & vbCrLf &_
3940              vbTab & SCRIPTFILE & " ProPlus,PrjPro    \' Remove ProPlus and Project" & vbCrLf
3941     Wscript.Quit
3942 End Sub \'ShowSyntax
3943 \'=======================================================================================================