Gv80yy7k

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