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