Office 2010强力卸载
在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 '=======================================================================================================
