· 6 years ago · Nov 05, 2019, 05:06 AM
1'*******************************************************************************
2' Name: OffScrubC2R.vbs
3' Author: Microsoft Customer Support Services
4' Copyright (c) 2014 - 2016 Microsoft Corporation
5' Script to remove Office Click To Run (C2R) products
6' when a regular uninstall is no longer possible
7'
8' Scope: Office 2013, 2016 and O365 C2R products
9'*******************************************************************************
10
11Option Explicit
12
13'-------------------------------------------------------------------------------
14'
15' Declaration of constants
16'-------------------------------------------------------------------------------
17
18
19Const SCRIPTVERSION = "2.15"
20Const SCRIPTFILE = "OffScrubC2R.vbs"
21Const SCRIPTNAME = "OffScrubC2R"
22Const RETVALFILE = "ScrubRetValFile.txt"
23Const ONAME = "Office C2R / O365"
24Const HKCR = &H80000000
25Const HKCU = &H80000001
26Const HKLM = &H80000002
27Const HKU = &H80000003
28Const PRODLEN = 13
29Const SQUISHED = 20
30Const COMPRESSED = 32
31Const REG_ARP = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
32Const VB_YES = 6
33Const VB_NO = 7
34
35Const ERROR_SUCCESS = 0 'Bit #1. 0 indicates Success. Script completed successfully
36Const ERROR_FAIL = 1 'Bit #1. Failure bit. Indicates an overall script failure.
37 'RESERVED bit! Returned when process is killed from task manager
38Const ERROR_REBOOT_REQUIRED = 2 'Bit #2. Reboot bit. If set a reboot is required
39Const ERROR_USERCANCEL = 4 'Bit #3. User Cancel bit. Controlled cancel from script UI
40Const ERROR_STAGE1 = 8 'Bit #4. Informational. Msiexec based install was not possible
41Const ERROR_STAGE2 = 16 'Bit #5. Critical. Not all of the intended cleanup operations could be applied
42Const ERROR_INCOMPLETE = 32 'Bit #6. Pending file renames (del on reboot) - OR - Removal needs to run again after a system reboot.
43Const ERROR_DCAF_FAILURE = 64 'Bit #7. Critical. Da capo al fine (second attempt) still failed.
44Const ERROR_ELEVATION_USERDECLINED = 128 'Bit #8. Critical script error. User declined to allow mandatory script elevation
45Const ERROR_ELEVATION = 256 'Bit #9. Critical script error. The attempt to elevate the process did not succeed
46Const ERROR_SCRIPTINIT = 512 'Bit #10. Critical script error. Initialization failed
47Const ERROR_RELAUNCH = 1024'Bit #11. Critical script error. This is a temporary value and must not be the final return code
48Const ERROR_UNKNOWN = 2048'Bit #12 Critical script error. Script did not complete in a well defined state
49Const ERROR_ALL = 4095'Full BitMask
50Const ERROR_USER_ABORT = &HC000013A 'RESERVED. Dec -1073741510. Critical error. Returned when user aborts with <Ctrl>+<Break> or closes the cmd window
51Const ERROR_SUCCESS_CONFIG_COMPLETE = 1728
52Const ERROR_SUCCESS_REBOOT_REQUIRED = 3010
53
54'-------------------------------------------------------------------------------
55'
56' Declaration of variables
57'-------------------------------------------------------------------------------
58
59Dim oFso, oMsi, oReg, oWShell, oWmiLocal, oShellApp
60Dim ComputerItem, Key, Item, LogStream, TmpKey
61Dim arrVersion
62Dim dicKeepLis, dicApps, dicKeepFolder, dicDelRegKey, dicKeepReg, dicSC
63Dim dicInstalledSku, dicRemoveSku, dicKeepSku, dicC2RSuite, dicDelInUse
64Dim dicDelFolder
65Dim sAppData, sScrubDir, sProgramFiles, sProgramFilesX86, sCommonProgramFiles
66Dim sAllusersProfile, sOSVersion, sWinDir, sWICacheDir, sCommonProgramFilesX86
67Dim sProgramData, sPackageFolder, sLocalAppData, sOInstallRoot, sSkuRemoveList
68Dim sOSinfo, sDefault, sTemp, sTmp, sCmd, sLogDir, sProfilesDirectory
69Dim sRetVal, sScriptDir, sPackageGuid, sValue, sActiveConfiguration, sNotepad
70Dim iVersionNT, iError, iProcCloseCnt
71Dim f64, fLogInitialized, fNoCancel, fRemoveOse, fDetectOnly, fQuiet, fForce
72Dim fC2R, fRemoveAll, fRebootRequired, fRerun, fSetRunOnce, fTestRerun
73Dim fIsElevated, fNoElevate, fUserConsent, fCScript, fReturnErrorOrSuccess
74Dim fClearTaskBand, fSkipSD, fUnpinMode, fKeepLicense
75Dim pipename, pipeStream, fs
76
77'-------------------------------------------------------------------------------
78' Main
79'
80' Main section of script
81'-------------------------------------------------------------------------------
82
83' initialize required settings and objects
84' ----------------------------------------
85Initialize
86
87' call the command line parser
88'-----------------------------
89ParseCmdLine
90
91 '-----------------------------
92 ' Stage # 0 - Basic detection |
93 '-----------------------------
94
95LogH "Stage # 0 " & chr(34) & "Basic detection" & chr(34)
96LogY "stage0"
97
98' ensure integrity of WI metadata which could fail used APIs otherwise
99'---------------------------------------------------------------------
100LogH1 "Ensure Windows Installer metadata integrity " & " (" & Time & ")"
101EnsureValidWIMetadata HKCU,"Software\Classes\Installer\Products", COMPRESSED
102EnsureValidWIMetadata HKCR,"Installer\Products", COMPRESSED
103EnsureValidWIMetadata HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products", COMPRESSED
104EnsureValidWIMetadata HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components", COMPRESSED
105EnsureValidWIMetadata HKCR,"Installer\Components", COMPRESSED
106
107' build a list with installed/registered Office products
108'-------------------------------------------------------
109FindInstalledOProducts
110If dicC2RSuite.Count > 0 Then
111 Log "Registered ARP product(s) found:"
112 For Each Key In dicC2RSuite.Keys
113 Log " - " & Key & " - " & dicC2RSuite.Item(Key)
114 Next 'Key
115' For Each Item in dicC2RSuite.Items
116' Log " - " & Item
117' Next 'Item
118Else
119 Log "No registered product(s) found"
120End If
121
122' locate the C2R %PackageFolder% and the PackageGuid
123'---------------------------------------------------
124sPackageFolder = ""
125If RegReadValue(HKLM, "SOFTWARE\Microsoft\Office\15.0\ClickToRun", "PackageFolder", sValue, "REG_SZ") Then
126 sPackageFolder = sValue
127ElseIf RegReadValue(HKLM, "SOFTWARE\Microsoft\Office\16.0\ClickToRun", "PackageFolder", sPackageFolder, "REG_SZ") Then
128 sPackageFolder = sValue
129ElseIf RegReadValue(HKLM, "SOFTWARE\Microsoft\Office\ClickToRun", "PackageFolder", sPackageFolder, "REG_SZ") Then
130 sPackageFolder = sValue
131End If
132' if sPackageFolder is invalid set it to the c2r registry reference string
133If NOT Len(sPackageFolder) > 0 OR IsNull(sPackageFolder) Then
134 If oFso.FolderExists(oWShell.ExpandEnvironmentStrings("%programfiles%") & "\Microsoft Office 15") Then
135 sPackageFolder = oWShell.ExpandEnvironmentStrings("%programfiles%") & "\Microsoft Office 15"
136 ElseIf oFso.FolderExists(oWShell.ExpandEnvironmentStrings("%programfiles%") & "\Microsoft Office 16") Then
137 sPackageFolder = oWShell.ExpandEnvironmentStrings("%programfiles%") & "\Microsoft Office 16"
138 ElseIf oFso.FolderExists(oWShell.ExpandEnvironmentStrings("%programfiles%") & "\Microsoft Office\PackageManifests") Then
139 sPackageFolder = oWShell.ExpandEnvironmentStrings("%programfiles%") & "\Microsoft Office"
140 ElseIf oFso.FolderExists(oWShell.ExpandEnvironmentStrings("%programfiles(x86)%") & "\Microsoft Office\PackageManifests") Then
141 sPackageFolder = oWShell.ExpandEnvironmentStrings("%programfiles(x86)%") & "\Microsoft Office"
142 End If
143End If
144
145sPackageGuid = ""
146If RegReadValue(HKLM, "SOFTWARE\Microsoft\Office\15.0\ClickToRun", "PackageGUID", sValue, "REG_SZ") Then
147 sPackageGuid = sValue
148ElseIf RegReadValue(HKLM, "SOFTWARE\Microsoft\Office\16.0\ClickToRun", "PackageGUID", sValue, "REG_SZ") Then
149 sPackageGuid = sValue
150ElseIf RegReadValue(HKLM, "SOFTWARE\Microsoft\Office\ClickToRun", "PackageGUID", sValue, "REG_SZ") Then
151 sPackageGuid = sValue
152End If
153
154' Init complete. Reset the return value
155'--------------------------------------
156ClearError ERROR_SCRIPTINIT
157
158
159 '-----------------------
160 ' Stage # 1 - Uninstall |
161 '-----------------------
162
163LogH "Stage # 1 " & chr(34) & "Uninstall" & chr(34)
164LogY "stage1"
165
166' clean O15 SPP
167'--------------
168LogH1 "Clean OSPP"
169If NOT fKeepLicense Then CleanOSPP
170
171' end all running Office applications
172'------------------------------------
173LogH1 "End running processes"
174'LogY "stage2"
175If NOT dicKeepSku.Count > 0 Then ClearShellIntegrationReg
176CloseOfficeApps
177
178' remove scheduled tasks which might interfere with uninstall
179'------------------------------------------------------------
180DelSchtasks
181
182' unpin shortcuts
183'----------------
184' need to unpin as long as the shortcuts are still valid!
185LogH1 "Clean shortcuts"
186'LogY "stage3"
187CleanShortcuts sAllusersProfile, True, True
188CleanShortcuts sProfilesDirectory, True, True
189
190' uninstall
191'----------
192LogH1 "Remove " & ONAME
193Uninstall
194
195 '---------------------
196 ' Stage # 2 - CleanUp |
197 '---------------------
198LogH "Stage # 2 " & chr(34) & "CleanUp" & chr(34)
199LogY "stage4"
200' Cleanup registry data
201'----------------------
202RegWipe
203
204' Cleanup files
205'--------------
206FileWipe
207
208' for test purposes only!
209If fTestRerun Then
210 LogH2 "Enforcing 'Rerun' mode for test purposes"
211 fRebootRequired = True
212 SetError ERROR_REBOOT_REQUIRED
213 Rerun
214End If
215
216' Ensure Explorer runs
217RestoreExplorer
218
219' Exit
220ExitScript
221
222 '------------------
223 ' Stage # 3 - Exit |
224 '------------------
225
226'-------------------------------------------------------------------------------
227' ExitScript
228'
229' Returncode and reboot handler
230'-------------------------------------------------------------------------------
231Sub ExitScript
232 Dim sPrompt
233
234 ' Update cached error and quit
235 '-----------------------------
236 If NOT CBool(iError AND (ERROR_FAIL + ERROR_INCOMPLETE)) Then RegDeleteValue HKCU, "SOFTWARE\Microsoft\Office\15.0\CleanC2R", "Rerun", False
237 SetRetVal iError
238
239 ' log result
240 If CBool(iError AND ERROR_INCOMPLETE) Then
241 LogH2 "Removal result: " & iError & " - INCOMPLETE. Uninstall requires a system reboot to complete."
242 Else
243 sTmp = " - SUCCESS"
244 If CBool(iError AND ERROR_USERCANCEL) Then sTmp = " - USER CANCELED"
245 If CBool(iError AND ERROR_FAIL) Then sTmp = " - FAIL"
246 LogH2 "Removal result: " & iError & sTmp
247 End If
248 If CBool(iError AND ERROR_FAIL) Then
249 If CBool(iError AND ERROR_REBOOT_REQUIRED) Then Log " - Reboot required"
250 If CBool(iError AND ERROR_USERCANCEL) Then Log " - User cancel"
251 If CBool(iError AND ERROR_STAGE1) Then Log " - Msiexec failed"
252 If CBool(iError AND ERROR_STAGE2) Then Log " - Cleanup failed"
253 If CBool(iError AND ERROR_INCOMPLETE) Then Log " - Removal incomplete. Rerun after reboot needed"
254 If CBool(iError AND ERROR_DCAF_FAILURE) Then Log " - Second attempt cleanup still incomplete"
255 If CBool(iError AND ERROR_ELEVATION_USERDECLINED) Then Log " - User declined elevation"
256 If CBool(iError AND ERROR_ELEVATION) Then Log " - Elevation failed"
257 If CBool(iError AND ERROR_SCRIPTINIT) Then Log " - Initialization error"
258 If CBool(iError AND ERROR_RELAUNCH) Then Log " - Unhandled error during relaunch attempt"
259 If CBool(iError AND ERROR_UNKNOWN) Then Log " - Unknown error"
260 ' ERROR_USER_ABORT is only valid for the temporary cached error file
261 'If CBool(iError AND ERROR_USER_ABORT) Then Log " - Process terminated by user"
262 End If
263
264 LogH2 "Removal end."
265 LogY "stage5"
266
267 ' Check if we need to show a simplified return code
268 ' 0 = Success
269 ' Non Zero = Error
270 If fReturnErrorOrSuccess Then
271 Dim fOverallSuccess
272 fOverallSuccess = True
273 If CBool(iError AND ERROR_USERCANCEL) Then fOverallSuccess = False
274 If CBool(iError AND ERROR_STAGE2) Then fOverallSuccess = False
275 If CBool(iError AND ERROR_DCAF_FAILURE) Then fOverallSuccess = False
276 If CBool(iError AND ERROR_ELEVATION_USERDECLINED) Then fOverallSuccess = False
277 If CBool(iError AND ERROR_ELEVATION) Then fOverallSuccess = False
278 If CBool(iError AND ERROR_SCRIPTINIT) Then fOverallSuccess = False
279 If CBool(iError AND ERROR_RELAUNCH) Then fOverallSuccess = False
280 If CBool(iError AND ERROR_UNKNOWN) Then fOverallSuccess = False
281
282 If fOverallSuccess Then iError = ERROR_SUCCESS
283
284 sTmp = "ReturnErrorOrSuccess switch has been set. The current value return code translates to: "
285 If fOverallSuccess Then
286 iError = ERROR_SUCCESS
287 LogY "result:stage5:true"
288 Log sTmp & "SUCCESS"
289 Else
290 LogY "result:stage5:false"
291 Log sTmp & "ERROR"
292 End If
293
294 End If
295
296 ' Reboot handling
297 If fRebootRequired Then
298 LogY "reboot"
299 sPrompt = "In order to complete uninstall, a system reboot is necessary. Would you like to reboot now?"
300 If NOT fQuiet Then
301 If MsgBox(sPrompt, vbYesNo, SCRIPTNAME & " - Reboot Required") = VB_YES Then
302 Dim colOS, oOS
303 Dim oWmiReboot
304 Set oWmiReboot = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}!\\.\root\cimv2")
305 Set colOS = oWmiReboot.ExecQuery ("Select * from Win32_OperatingSystem")
306 For Each oOS in colOS
307 oOS.Reboot()
308 Next
309 End If
310 End If
311 End If
312 LogY "ok"
313
314 wscript.quit iError
315End Sub 'ExitScript
316
317'-------------------------------------------------------------------------------
318' End Main
319'
320' End of Main section
321'-------------------------------------------------------------------------------
322
323'-------------------------------------------------------------------------------
324' Initialize
325'
326' Configure defaults and initialize all required objects
327'-------------------------------------------------------------------------------
328Sub Initialize ()
329 Dim iCnt
330
331 ' set variable defaults
332 '----------------------
333 iError = ERROR_SUCCESS
334 iProcCloseCnt = 0
335 sLogDir = ""
336 sPackageFolder = ""
337 f64 = False
338 fCScript = False
339 fLogInitialized = False
340 fNoCancel = False
341 fRemoveOse = False
342 fDetectOnly = False
343 fQuiet = True
344 fForce = False
345 fC2R = True
346 fRebootRequired = False
347 fRerun = False
348 fTestRerun = False
349 fIsElevated = False
350 fNoElevate = False
351 fSetRunOnce = False
352 fUserConsent = False
353 fReturnErrorOrSuccess = False
354 fSkipSD = False
355 fClearTaskBand = False
356 fUnpinMode = False
357 fKeepLicense = False
358
359 ' create required objects
360 '------------------------
361 InitObjects
362
363 ' get environment path values
364 '----------------------------
365 sAppData = oWShell.ExpandEnvironmentStrings("%appdata%")
366 sLocalAppData = oWShell.ExpandEnvironmentStrings("%localappdata%")
367 sTemp = oWShell.ExpandEnvironmentStrings("%temp%")
368 sAllUsersProfile = oWShell.ExpandEnvironmentStrings("%allusersprofile%")
369 RegReadValue HKLM, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList", "ProfilesDirectory", sProfilesDirectory, "REG_EXPAND_SZ"
370 If NOT oFso.FolderExists(sProfilesDirectory) Then
371 sProfilesDirectory = oFso.GetParentFolderName(oWShell.ExpandEnvironmentStrings("%userprofile%"))
372 End If
373 sProgramFiles = oWShell.ExpandEnvironmentStrings("%programfiles%")
374 'sProgramFilesX86 = deferred. Depends on operating system architecture check
375 sCommonProgramFiles = oWShell.ExpandEnvironmentStrings("%commonprogramfiles%")
376 'sCommonProgramFilesX86 = deferred. Depends on operating system architecture check
377 sProgramData = oWSHell.ExpandEnvironmentStrings("%programdata%")
378 sWinDir = oWShell.ExpandEnvironmentStrings("%windir%")
379 'sPackageFolder = deferred
380 sWICacheDir = sWinDir & "\" & "Installer"
381 sScrubDir = sTemp & "\" & SCRIPTNAME
382 sScriptDir = wscript.ScriptFullName
383 sScriptDir = Left(sScriptDir, InStrRev(sScriptDir, "\"))
384 sNotepad = sWinDir & "\notepad.exe"
385
386 ' check if called to unpin a shortcut
387 If WScript.Arguments.Count > 0 Then
388 If WScript.Arguments(0) = "UNPINSC" Then
389 Unpin WScript.Arguments(1)
390 WScript.Quit
391 End If
392 End If
393
394
395 ' ensure 64 bit host if needed
396 If InStr(LCase(wscript.path), "syswow64") > 0 Then RelaunchAs64Host
397
398 ' create the temp folder
399 '-----------------------
400 If Not oFso.FolderExists(sScrubDir) Then oFso.CreateFolder sScrubDir
401
402 ' set the default logging directory
403 '----------------------------------
404 sLogDir = sScrubDir
405
406 ' detect bitness of the operating system
407 '----------------------------------------
408 Set ComputerItem = oWmiLocal.ExecQuery("Select * from Win32_ComputerSystem")
409 For Each Item In ComputerItem
410 f64 = Instr(Left(Item.SystemType, 3), "64") > 0
411 Next
412 If f64 Then sProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%programfiles(x86)%")
413 If f64 Then sCommonProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%CommonProgramFiles(x86)%")
414
415 ' update error flag
416 '------------------
417 SetError ERROR_SCRIPTINIT
418
419 ' get Win32_OperatingSystem details
420 '----------------------------------
421 Set ComputerItem = oWmiLocal.ExecQuery("Select * from Win32_OperatingSystem")
422 For Each Item in ComputerItem
423 sOSinfo = sOSinfo & Item.Caption
424 sOSinfo = sOSinfo & Item.OtherTypeDescription
425 sOSinfo = sOSinfo & ", " & "SP " & Item.ServicePackMajorVersion
426 sOSinfo = sOSinfo & ", " & "Version: " & Item.Version
427 sOsVersion = Item.Version
428 sOSinfo = sOSinfo & ", " & "Codepage: " & Item.CodeSet
429 sOSinfo = sOSinfo & ", " & "Country Code: " & Item.CountryCode
430 sOSinfo = sOSinfo & ", " & "Language: " & Item.OSLanguage
431 Next
432
433 ' get VersionNT number
434 '---------------------
435 arrVersion = Split(sOsVersion, Delimiter(sOsVersion))
436 iVersionNt = CInt(arrVersion(0)) * 100 + CInt(arrVersion(1))
437
438 ' ensure sufficient registry permisions
439 '--------------------------------------
440 fIsElevated = CheckRegPermissions
441 If NOT fIsElevated AND NOT fNoElevate Then
442 ' try to relaunch elevated
443 RelaunchElevated
444
445 ' can't relaunch. Exit out
446 SetError ERROR_ELEVATION
447 If UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C" Then
448 If Not fLogInitialized Then CreateLog
449 Log "Error: Insufficient registry access permissions - exiting"
450 End If
451 SetRetVal iError
452 'wscript.quit iError
453 ExitScript
454 End If
455
456 ' clear error flags
457 '------------------
458 ClearError ERROR_ELEVATION
459 ClearError ERROR_SCRIPTINIT
460
461 ' ensure CScript as engine
462 '------------------------
463 fCScript = UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C"
464 If NOT fCScript AND NOT fQuiet Then RelaunchAsCScript
465
466 ' set retval for file based logic
467 '--------------------------------
468 ' value needs to be kept on 'user abort'
469 SetRetVal ERROR_USER_ABORT
470
471 ' create dictionary objects
472 '--------------------------
473 Set dicInstalledSku = CreateObject("Scripting.Dictionary")
474 Set dicRemoveSku = CreateObject("Scripting.Dictionary")
475 Set dicKeepSku = CreateObject("Scripting.Dictionary")
476 Set dicKeepLis = CreateObject("Scripting.Dictionary")
477 Set dicKeepFolder = CreateObject("Scripting.Dictionary")
478 Set dicApps = CreateObject("Scripting.Dictionary")
479 Set dicDelRegKey = CreateObject("Scripting.Dictionary")
480 Set dicKeepReg = CreateObject("Scripting.Dictionary")
481 Set dicC2RSuite = CreateObject("Scripting.Dictionary")
482 Set dicDelInUse = CreateObject("Scripting.Dictionary")
483 Set dicDelFolder = CreateObject("Scripting.Dictionary")
484 Set dicSC = CreateObject("Scripting.Dictionary")
485
486 ' add initial known .exe files that need to be closed
487 '----------------------------------------------------
488 dicApps.Add "appvshnotify.exe", "appvshnotify.exe"
489 dicApps.Add "integratedoffice.exe", "integratedoffice.exe"
490 dicApps.Add "integrator.exe", "integrator.exe"
491 dicApps.Add "firstrun.exe", "firstrun.exe"
492 'Adding setup.exe to the hard list of processes that are shut down will potentially break wrappers that invoke OffScrub
493 'dicApps.Add "setup.exe", "setup.exe"
494 dicApps.Add "communicator.exe", "communicator.exe"
495 dicApps.Add "msosync.exe", "msosync.exe"
496 dicApps.Add "OneNoteM.exe", "OneNoteM.exe"
497 dicApps.Add "iexplore.exe", "iexplore.exe"
498 dicApps.Add "mavinject32.exe", "mavinject32.exe"
499 dicApps.Add "werfault.exe", "werfault.exe"
500 dicApps.Add "perfboost.exe", "perfboost.exe"
501 dicApps.Add "roamingoffice.exe", "roamingoffice.exe"
502 ' SP1 additions / changes
503 dicApps.Add "officeclicktorun.exe", "officeclicktorun.exe"
504 dicApps.Add "officeondemand.exe", "officeondemand.exe"
505 dicApps.Add "OfficeC2RClient.exe", "OfficeC2RClient.exe"
506
507End Sub 'Initialize
508
509'-------------------------------------------------------------------------------
510' InitObjects
511'
512' Initialize global objects
513'-------------------------------------------------------------------------------
514Sub InitObjects ()
515
516 Set oWmiLocal = GetObject("winmgmts:\\.\root\cimv2")
517 Set oWShell = CreateObject("Wscript.Shell")
518 Set oShellApp = CreateObject("Shell.Application")
519 Set oFso = CreateObject("Scripting.FileSystemObject")
520 Set oMsi = CreateObject("WindowsInstaller.Installer")
521 Set oReg = GetObject("winmgmts:\\.\root\default:StdRegProv")
522
523End Sub 'InitObjects
524
525'-------------------------------------------------------------------------------
526' FreeObjects
527'
528' Free initialized global objects
529'-------------------------------------------------------------------------------
530Sub FreeObjects ()
531
532 Set oWmiLocal = Nothing
533 Set oWShell = Nothing
534 Set oShellApp = Nothing
535 Set oFso = Nothing
536 Set oMsi = Nothing
537 Set oReg = Nothing
538
539End Sub 'FreeObjects
540
541'-------------------------------------------------------------------------------
542' ParseCmdLine
543'
544' Command line parser
545'-------------------------------------------------------------------------------
546Sub ParseCmdLine
547
548 Dim iCnt, iArgCnt
549 Dim arrArguments, sArguments
550 Dim sArg0
551
552 iArgCnt = Wscript.Arguments.Count
553 If iArgCnt > 0 Then
554 If wscript.Arguments(0) = "UAC" Then
555 If wscript.arguments.count = 1 Then iArgCnt = 0
556 End If
557 End If
558 If iArgCnt = 0 Then
559 Select Case UCase(wscript.ScriptName)
560 Case Else
561 'Create the log
562 CreateLog
563 FindInstalledOProducts
564 sDefault = "ALL"
565 arrArguments = Split(Trim(sDefault), " ")
566 If UBound(arrArguments) = -1 Then ReDim arrArguments(0)
567 End Select
568 Else
569 ReDim arrArguments(iArgCnt-1)
570 For iCnt = 0 To (iArgCnt-1)
571 arrArguments(iCnt) = UCase(Wscript.Arguments(iCnt))
572 sArguments = sArguments & arrArguments(iCnt) & " "
573 Next 'iCnt
574 End If 'iArgCnt = 0
575
576 ' hardcode to full removal
577 sArg0 = "ALL"
578
579 Select Case UCase(sArg0)
580 Case "?"
581 ShowSyntax
582 Case "ALL"
583 fRemoveAll = True
584 fRemoveOse = False
585 Case "C2R"
586 fC2R = True
587 fRemoveAll = False
588 fRemoveOse = False
589 Case Else
590 fRemoveAll = False
591 fRemoveOse = False
592 sSkuRemoveList = sArg0
593 End Select
594
595 For iCnt = 0 To UBound(arrArguments)
596 Select Case arrArguments(iCnt)
597 Case "?", "/?", "-?"
598 ShowSyntax
599
600 Case "/KL", "/KEEPLICENSE"
601 fKeepLicense = True
602
603 Case "/L", "/LOG"
604 fLogInitialized = False
605 If UBound(arrArguments) > iCnt Then
606 If oFso.FolderExists(arrArguments(iCnt + 1)) Then
607 sLogDir = arrArguments(iCnt + 1)
608 Else
609 On Error Resume Next
610 oFso.CreateFolder(arrArguments(iCnt + 1))
611 If Err <> 0 Then sLogDir = sScrubDir Else sLogDir = arrArguments(iCnt + 1)
612 End If
613 End If
614
615 Case "/N", "/NOCANCEL"
616 fNoCancel = True
617
618 Case "/NE", "/NOELEVATE"
619 fNoElevate = True
620
621 Case "/O", "/OSE"
622 fRemoveOse = True
623
624 Case "/Q", "/QUIET"
625 fQuiet = True
626
627 Case "/RETERRORSUCCESS", "/RETURNERRORORSUCCESS", "/REOS"
628 fReturnErrorOrSuccess = True
629
630 Case "/S", "/SKIPSD", "/SKIPSHORTCUTDETECTION"
631 fSkipSD = True
632
633 ' for test purposes only!
634 Case "/TR", "/TESTRERUN"
635 fTestRerun = True
636 Case Else
637 End Select
638 Next 'iCnt
639 If Not fLogInitialized Then CreateLog
640 LogH2 "Arguments: " & sArguments & vbCrLf
641
642End Sub 'ParseCmdLine
643
644'-------------------------------------------------------------------------------
645' ShowSyntax
646'
647' Show the expected syntax for the script usage
648'-------------------------------------------------------------------------------
649Sub ShowSyntax
650 Wscript.Echo vbCrLf & _
651 SCRIPTFILE & " V " & SCRIPTVERSION & vbCrLf & _
652 "Copyright (c) Microsoft Corporation. All Rights Reserved" & vbCrLf & vbCrLf & _
653 SCRIPTFILE & " - Remove " & ONAME & vbCrLf & _
654 "when a regular uninstall is no longer possible" & vbCrLf & vbCrLf & _
655 "Usage:" & vbTab & SCRIPTFILE & vbCrLf & vbCrLf & _
656 vbTab & "/? ' Displays this help"& vbCrLf & _
657 vbTab & "/Log [LogfolderPath] ' Custom folder for log files" & vbCrLf & _
658 vbTab & "/SkipSD ' Skips the ShortcutDetection in local profiles" & vbCrLf & _
659 vbTab & "/NoCancel ' Setup.exe and Msiexec.exe have no Cancel button" & vbCrLf &_
660 vbTab & "/Quiet ' Script, Setup.exe and Msiexec.exe run quiet with no UI" & vbCrLf &_
661 vbTab & "/ReturnErorOrSuccess ' Returns 0 for a successful removal. Non-Zero if not." & vbCrLf
662 Wscript.Quit
663End Sub 'ShowSyntax
664
665'-------------------------------------------------------------------------------
666' FindInstalledOProducts
667'
668' Office configuration products are listed with their configuration product
669' name in the "Uninstall" key.
670'-------------------------------------------------------------------------------
671Sub FindInstalledOProducts
672 Dim ArpItem, prod, cult
673 Dim sCurKey, sValue, sConfigName, sCulture, sDisplayVersion, sVersionFallback
674 Dim sUninstallString, sProd
675 Dim iLeft, iRight
676 Dim arrKeys, arrProducts, arrCultures
677 Dim fSystemComponent0, fDisplayVersion, fUninstallString
678
679 Const REG_ARP = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
680 Const REG_O15RPROPERTYBAG = "SOFTWARE\Microsoft\Office\15.0\ClickToRun\propertyBag\"
681 Const REG_O15C2RCONFIGURATION = "SOFTWARE\Microsoft\Office\15.0\ClickToRun\Configuration\"
682 Const REG_O15C2RPRODUCTIDS = "SOFTWARE\Microsoft\Office\15.0\ClickToRun\ProductReleaseIDs\Active\"
683 Const REG_O16C2RCONFIGURATION = "SOFTWARE\Microsoft\Office\16.0\ClickToRun\Configuration\"
684 Const REG_O16C2RPRODUCTIDS = "SOFTWARE\Microsoft\Office\16.0\ClickToRun\ProductReleaseIDs\Active\"
685 Const REG_C2RCONFIGURATION = "SOFTWARE\Microsoft\Office\ClickToRun\Configuration\"
686 Const REG_C2RPRODUCTIDS = "SOFTWARE\Microsoft\Office\ClickToRun\ProductReleaseIDs\"
687
688
689 If dicInstalledSku.Count > 0 Then Exit Sub 'Already done from command line parser
690
691 fDisplayVersion = False
692
693 ' identify C2R products
694 LogH1 "Detect installed products "
695
696 LogOnly "Check for O15 C2R products"
697 ' Check O15 Configuration key
698 If RegReadValue(HKLM, REG_O15C2RCONFIGURATION, "ProductReleaseIds", sValue, "REG_SZ") Then
699 arrProducts = Split(sValue, ",")
700 fDisplayVersion = RegReadValue(HKLM, REG_O15C2RPRODUCTIDS & "culture", "x-none", sVersionFallback, "REG_SZ")
701 If NOT Err = 0 Then
702 Err.Clear
703 Else
704 ' get version from active with fallback on configuration
705 For Each prod in arrProducts
706 LogOnly "Found O15 C2R product in Configuration: " & prod
707 ' update product dictionary
708 If NOT dicInstalledSku.Exists(LCase(prod)) Then
709 LogOnly "add new product to dictionary: " & LCase(prod)
710 dicInstalledSku.Add LCase(prod), sVersionFallback
711 End If
712 Next 'prod
713 End If
714 End If
715
716 ' Check O15 PropertyBag key
717 If RegReadValue(HKLM, REG_O15RPROPERTYBAG, "productreleaseid", sValue, "REG_SZ") Then
718 arrProducts = Split(sValue, ",")
719 fDisplayVersion = RegReadValue(HKLM, REG_O15C2RPRODUCTIDS & "culture", "x-none", sVersionFallback, "REG_SZ")
720 If NOT Err = 0 Then
721 Err.Clear
722 Else
723 For Each prod in arrProducts
724 LogOnly "Found O15 C2R product in PropertyBag: " & prod
725 ' update product dictionary
726 If NOT dicInstalledSku.Exists(LCase(prod)) Then
727 LogOnly "add new product to dictionary: " & LCase(prod)
728 dicInstalledSku.Add LCase(prod), sVersionFallback
729 End If
730 Next 'prod
731 End If
732 End If
733
734 'O16 section
735 LogOnly "Check for Office C2R products (>=QR8)"
736 ' Check Office Configuration key
737 If RegReadValue(HKLM, REG_C2RPRODUCTIDS, "ActiveConfiguration", sActiveConfiguration, "REG_SZ") Then
738 ' Get DisplayVersion
739 'Try QR8 logic first
740 fDisplayVersion = RegReadValue(HKLM, REG_C2RPRODUCTIDS & sActiveConfiguration & "\culture", "x-none", sVersionFallback, "REG_SZ")
741 If RegEnumKey(HKLM, REG_C2RPRODUCTIDS & sActiveConfiguration & "\culture", arrCultures) Then
742 For Each cult In arrCultures
743 If InStr(LCase(cult), "x-none") > 0 Then
744 fDisplayVersion = RegReadValue(HKLM, REG_C2RPRODUCTIDS & sActiveConfiguration & "\culture\" & cult, "Version", sVersionFallback, "REG_SZ")
745 End If
746 Next 'cult
747 End If
748 ' Update product dic
749 If RegEnumKey(HKLM, REG_C2RPRODUCTIDS & sActiveConfiguration, arrProducts) Then
750 For Each prod In arrProducts
751 sProd = LCase(prod)
752 If InStr(sProd, ".") > 0 Then sProd = Left(sProd, InStr(sProd, ".") - 1)
753 Select Case LCase(sProd)
754 Case "culture", "stream"
755 Case Else
756 LogOnly "Found Office C2R product in Configuration: " & prod
757 ' update product dictionary
758 If NOT dicInstalledSku.Exists(sProd) Then
759 LogOnly "add new product to dictionary: " & sProd
760 If RegReadValue(HKLM, REG_C2RPRODUCTIDS & sActiveConfiguration & "\" & prod & "\x-none", "Version", sDisplayVersion, "REG_SZ") Then
761 dicInstalledSku.Add sProd, sDisplayVersion
762 Else
763 dicInstalledSku.Add sProd, sVersionFallback
764 End If
765 End If
766 End Select
767 Next 'prod
768 End If 'arrProducts
769 End If 'ActiveConfiguration
770
771 LogOnly "Check for Office C2R products (QR7)"
772 ' Check Office Configuration key
773 If RegReadValue(HKLM, REG_C2RCONFIGURATION, "ProductReleaseIds", sValue, "REG_SZ") Then
774 arrProducts = Split(sValue, ",")
775 If Not fDisplayVersion Then fDisplayVersion = RegReadValue(HKLM, REG_C2RPRODUCTIDS & "Active\culture", "x-none", sVersionFallback, "REG_SZ")
776 If NOT Err = 0 Then
777 Err.Clear
778 Else
779 For Each prod in arrProducts
780 LogOnly "Found Office C2R product in Configuration: " & prod
781 ' update version tracking
782 If NOT dicInstalledSku.Exists(LCase(prod)) Then
783 LogOnly "add new product to dictionary: " & LCase(prod)
784 dicInstalledSku.Add LCase(prod), sVersionFallback
785 End If
786 Next 'prod
787 End If
788 End If
789
790 LogOnly "Check for O16 C2R products (QR6)"
791 ' Check O16 Configuration key
792 If RegReadValue(HKLM, REG_O16C2RCONFIGURATION, "ProductReleaseIds", sValue, "REG_SZ") Then
793 arrProducts = Split(sValue, ",")
794 If Not fDisplayVersion Then fDisplayVersion = RegReadValue(HKLM, REG_O16C2RPRODUCTIDS & "culture", "x-none", sVersionFallback, "REG_SZ")
795 If NOT Err = 0 Then
796 Err.Clear
797 Else
798 For Each prod in arrProducts
799 LogOnly "Found O16 (QR6) C2R product in Configuration: " & prod
800 ' update product dictionary
801 If NOT dicInstalledSku.Exists(LCase(prod)) Then
802 LogOnly "add new product to dictionary: " & prod
803 dicInstalledSku.Add LCase(prod), sVersionFallback
804 End If
805 Next 'prod
806 End If
807 End If
808
809 LogOnly "Check ARP for Office C2R products"
810 ' ARP
811 RegEnumKey HKLM, REG_ARP, arrKeys
812 If IsArray(arrKeys) Then
813 For Each ArpItem in arrKeys
814 ' filter on Office C2R products
815 sCurKey = REG_ARP & ArpItem & "\"
816 fUninstallString = RegReadValue(HKLM, sCurKey, "UninstallString", sValue, "REG_SZ")
817 If (fUninstallString And( (InStr(UCase(sValue), UCase("Microsoft Office 1")) > 0) Or (InStr(UCase(sValue), UCase("OfficeClickToRun.exe")) > 0) )) Then
818 'get Version
819 fDisplayVersion = RegReadValue(HKLM, sCurKey, "DisplayVersion", sDisplayVersion, "REG_SZ")
820 'extract the productreleaseid
821 sValue = Trim(sValue)
822 prod = Trim(Mid(sValue, InStrRev(sValue, " ")))
823 prod = Replace(prod, "productstoremove=", "")
824 If InStr(prod, "_") > 0 Then
825 prod = Left(prod, InStr(prod, "_") - 1)
826 End If
827 If InStr(prod, ".1") > 0 Then
828 prod = Left(prod, InStr(prod, ".1") - 1)
829 End If
830 LogOnly "Found C2R product in ARP: " & prod
831 If NOT dicInstalledSku.Exists(LCase(prod)) Then
832 LogOnly "add new product to dictionary: " & prod
833 dicInstalledSku.Add LCase(prod), sDisplayVersion
834 End If
835 ' categorize the SKU as C2R
836 If NOT dicC2RSuite.Exists(ArpItem) Then dicC2RSuite.Add ArpItem, prod & " - " & sDisplayVersion
837 Else
838
839 'Legacy logic keep for compat reasons
840 sValue = ""
841 sDisplayVersion = ""
842 fSystemComponent0 = NOT (RegReadValue(HKLM, sCurKey, "SystemComponent", sValue, "REG_DWORD") AND (sValue = "1"))
843 fDisplayVersion = RegReadValue(HKLM, sCurKey, "DisplayVersion", sValue, "REG_SZ")
844 If fDisplayVersion Then
845 sDisplayVersion = sValue
846 If Len(sValue) > 1 Then
847 On Error Resume Next
848 fDisplayVersion = (CInt(Left(sValue, 2)) > 14)
849 If Not Err <> 0 Then Err.Clear
850 Else
851 fDisplayVersion = False
852 End If
853 End If
854 fUninstallString = RegReadValue(HKLM, sCurKey, "UninstallString", sUninstallString, "REG_SZ")
855
856 ' filter on C2R configuration SKU
857 If (fUninstallString And( (InStr(UCase(sUninstallString), UCase("Microsoft Office 1")) > 0) Or (InStr(UCase(sUninstallString), UCase("OfficeClickToRun.exe")) > 0) )) Then
858 ' Extract the ProductReleaseID
859 If InStr(sUninstallString, "productstoremove=") > 0 Then
860 sConfigName = Trim(Mid(sValue, InStrRev(sUninstallString, " ")))
861 sConfigName = Replace(sConfigName, "productstoremove=", "")
862 If InStr(prod, "_") > 0 Then
863 sConfigName = Left(sConfigName, InStr(sConfigName, "_") - 1)
864 End If
865 Else
866 iLeft = InStr(ArpItem, " - ") + 2
867 iRight = InStr(iLeft, ArpItem, " - ") - 1
868 If iRight > 0 Then
869 sConfigName = Trim(Mid(ArpItem, iLeft, (iRight - iLeft)))
870 sCulture = Mid(ArpItem, iRight + 3)
871 Else
872 sConfigName = Trim(Left(ArpItem, iLeft - 3))
873 sCulture = Mid(ArpItem, iLeft)
874 End If
875 sConfigName = Replace(sConfigName, "Microsoft", "")
876 sConfigName = Replace(sConfigName, "Office", "")
877 sConfigName = Replace(sConfigName, "Professional", "Pro")
878 sConfigName = Replace(sConfigName, "Standard", "Std")
879 sConfigName = Replace(sConfigName, "(Technical Preview)", "")
880 sConfigName = Replace(sConfigName, "15", "")
881 sConfigName = Replace(sConfigName, "16", "")
882 sConfigName = Replace(sConfigName, "2013", "")
883 sConfigName = Replace(sConfigName, "2016", "")
884 sConfigName = Replace(sConfigName, " ", "")
885 sConfigName = Replace(sConfigName, "Project", "Prj")
886 sConfigName = Replace(sConfigName, "Visio", "Vis")
887 End If
888 If NOT dicInstalledSku.Exists(LCase(sConfigName)) Then
889 LogOnly "add new product to dictionary (ARP Legacy): " & sConfigName
890 dicInstalledSku.Add LCase(sConfigName), sDisplayVersion
891 End If
892 ' categorize the SKU as C2R
893 If NOT dicC2RSuite.Exists(ArpItem) Then dicC2RSuite.Add ArpItem, sConfigName & " - " & sDisplayVersion
894 ElseIf (fDisplayVersion AND (InStr(UCase(ArpItem), UCase("OFFICE15.")) > 0 Or InStr(UCase(ArpItem), UCase("OFFICE16.")) > 0)) Then
895 ' classic .msi install SKU
896 iLeft = InStr(ArpItem, ".") + 1
897 iRight = InStr(iLeft, ArpItem, "-") - 1
898 sConfigName = Mid(ArpItem, iLeft)
899 sCulture = ""
900 If NOT dicKeepSku.Exists(ArpItem) Then dicKeepSku.Add ArpItem, sConfigName & " - " & sDisplayVersion
901 End If
902
903 ' Other products
904 If InScope(ArpItem) Then
905 Select Case Mid(ArpItem,11,4)
906 ' 007E = Licensing
907 ' 008F = Licensing
908 ' 008C = Extensibility Components
909 ' 00DD = Extensibility Components 64 bit
910 Case "007E", "008F", "008C", "00DD"
911 sConfigName = "Habanero"
912 RegReadValue HKLM, sCurKey, "DisplayName", sConfigName, "REG_SZ"
913 If NOT dicInstalledSku.Exists(LCase(ArpItem)) Then
914 LogOnly "add new product to dictionary (ARP Integraton Components): " & ArpItem
915 dicInstalledSku.Add LCase(ArpItem), sDisplayVersion
916 End If
917 If NOT dicC2RSuite.Exists(ArpItem) Then dicC2RSuite.Add ArpItem, sConfigName & " - " & sDisplayVersion
918 Case "24E1", "237A"
919 sConfigName = "MSOIDLOGIN"
920 If NOT dicInstalledSku.Exists(LCase(ArpItem)) Then
921 LogOnly "add new product to dictionary (ARP MSOIDLogin): " & ArpItem
922 dicInstalledSku.Add LCase(ArpItem), sDisplayVersion
923 End If
924 If NOT dicC2RSuite.Exists(ArpItem) Then dicC2RSuite.Add ArpItem, sConfigName & " - " & sDisplayVersion
925 Case Else
926 If NOT dicInstalledSku.Exists(LCase(ArpItem)) Then
927 LogOnly "add new product to dictionary (ARP other): " & ArpItem
928 dicInstalledSku.Add LCase(ArpItem), sDisplayVersion
929 End If
930 End Select
931 Else
932 ' not in scope for c2r removal!
933 End If 'InScope
934 ' End legacy logic
935
936 End If
937 Next 'ArpItem
938 End If
939
940End Sub 'FindInstalledOProducts
941
942'-------------------------------------------------------------------------------
943' EnsureValidWIMetadata
944'
945' Ensures that only valid metadata entries exist to avoid API failures.
946' Invalid entries will be removed
947'-------------------------------------------------------------------------------
948Sub EnsureValidWIMetadata(hDefKey, sKey, iValidLength)
949 Dim arrKeys
950 Dim SubKey
951
952 If Len(sKey) > 1 Then
953 If Right(sKey, 1) = "\" Then sKey = Left(sKey, Len(sKey) - 1)
954 End If
955
956 If RegEnumKey(hDefKey, sKey, arrKeys) Then
957 For Each SubKey in arrKeys
958 If NOT Len(SubKey) = iValidLength Then
959 RegDeleteKey hDefKey, sKey & "\" & SubKey & "\"
960 End If
961 Next 'SubKey
962 End If
963End Sub 'EnsureValidWIMetadata
964
965'-------------------------------------------------------------------------------
966' CleanOSPP
967'
968' Clean out licenses from the Office Software Protection Platform
969'-------------------------------------------------------------------------------
970Sub CleanOSPP
971 Dim oProductInstances, pi
972 Dim sCleanOSPP, sCmd, sRetVal
973 LogY "CleanOSPP"
974
975 CONST OfficeAppId = "0ff1ce15-a989-479d-af46-f275c6370663" 'Office 2013
976
977 sCleanOSPP = "x64\CleanOSPP.exe"
978 If Not f64 Then sCleanOSPP = "x86\CleanOSPP.exe"
979 If oFso.FileExists(sScriptDir & sCleanOSPP) Then
980 sCmd = sScriptDir & sCleanOSPP
981 Log " Running: " & sCmd
982 On Error Resume Next
983 sRetVal = oWShell.Run(sCmd, 0, True)
984 Log " Return value: " & sRetVal
985 On Error Goto 0
986 Exit Sub
987 End If
988
989 On Error Resume Next
990 If NOT (dicC2RSuite.Count > 0 OR dicKeepSku.Count > 0) Then
991 Log "Skip CleanOSPP"
992 Exit Sub
993 End If
994
995 ' Initialize the software protection platform object with a filter on Office 2013 products
996 If iVersionNT > 601 Then
997 Set oProductInstances = oWmiLocal.ExecQuery("SELECT ID, ApplicationId, PartialProductKey, Name, ProductKeyID FROM SoftwareLicensingProduct WHERE ApplicationId = '" & OfficeAppId & "' " & "AND PartialProductKey <> NULL")
998 Else
999 Set oProductInstances = oWmiLocal.ExecQuery("SELECT ID, ApplicationId, PartialProductKey, Name, ProductKeyID FROM OfficeSoftwareProtectionProduct WHERE ApplicationId = '" & OfficeAppId & "' " & "AND PartialProductKey <> NULL")
1000 End If
1001
1002 ' Remove all licenses
1003 For Each pi in oProductInstances
1004 If NOT IsNull(pi) Then
1005 pi.UninstallProductKey( pi.ProductKeyID)
1006 End If
1007 Next 'pi
1008
1009
1010End Sub 'CleanOSPP
1011
1012'-------------------------------------------------------------------------------
1013' DelSchtasks
1014'
1015' Delete know scheduled tasks.
1016'-------------------------------------------------------------------------------
1017Sub DelSchtasks ()
1018 Dim sCmd
1019
1020 If CBool(iError AND ERROR_USERCANCEL) Then Exit Sub
1021
1022 LogH1 "Remove scheduled tasks"
1023
1024 LogOnly "FF_INTEGRATEDstreamSchedule"
1025 oWShell.Run "SCHTASKS /Delete /TN FF_INTEGRATEDstreamSchedule /F", 0, False
1026 wscript.sleep 500
1027
1028 LogOnly "FF_INTEGRATEDUPDATEDETECTION"
1029 oWShell.Run "SCHTASKS /Delete /TN FF_INTEGRATEDUPDATEDETECTION /F", 0, False
1030 wscript.sleep 500
1031
1032 LogOnly "C2RAppVLoggingStart"
1033 oWShell.Run "SCHTASKS /Delete /TN C2RAppVLoggingStart /F", 0, False
1034 wscript.sleep 500
1035
1036 LogOnly "Office 15 Subscription Heartbeat"
1037 sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "Office 15 Subscription Heartbeat" & Chr(34) & " /F"
1038 oWShell.Run sCmd, 0, False
1039 wscript.sleep 500
1040
1041 LogOnly "Microsoft Office 15 Sync Maintenance"
1042 sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "Microsoft Office 15 Sync Maintenance for {d068b555-9700-40b8-992c-f866287b06c1}" & Chr(34) & " /F"
1043 oWShell.Run sCmd, 0, False
1044 wscript.sleep 500
1045
1046 LogOnly "OfficeInventoryAgentFallBack"
1047 sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "\Microsoft\Office\OfficeInventoryAgentFallBack" & Chr(34) & " /F"
1048 oWShell.Run sCmd, 0, False
1049 wscript.sleep 500
1050
1051 LogOnly "OfficeTelemetryAgentFallBack"
1052 sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "\Microsoft\Office\OfficeTelemetryAgentFallBack" & Chr(34) & " /F"
1053 oWShell.Run sCmd, 0, False
1054 wscript.sleep 500
1055
1056 LogOnly "OfficeInventoryAgentLogOn"
1057 sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "\Microsoft\Office\OfficeInventoryAgentLogOn" & Chr(34) & " /F"
1058 oWShell.Run sCmd, 0, False
1059
1060 LogOnly "OfficeTelemetryAgentLogOn"
1061 sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "\Microsoft\Office\OfficeTelemetryAgentLogOn" & Chr(34) & " /F"
1062 oWShell.Run sCmd, 0, False
1063
1064 LogOnly "Office Background Streaming"
1065 sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "Office Background Streaming" & Chr(34) & " /F"
1066 oWShell.Run sCmd, 0, False
1067 wscript.sleep 500
1068
1069 LogOnly "Office Automatic Updates"
1070 sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "\Microsoft\Office\Office Automatic Updates" & Chr(34) & " /F"
1071 oWShell.Run sCmd, 0, False
1072 wscript.sleep 500
1073
1074 LogOnly "Office ClickToRun Service Monitor"
1075 sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "\Microsoft\Office\Office ClickToRun Service Monitor" & Chr(34) & " /F"
1076 oWShell.Run sCmd, 0, False
1077 wscript.sleep 500
1078
1079 LogOnly "Office Subscription Maintenance"
1080 sCmd = "SCHTASKS /Delete /TN " & Chr(34) & "Office Subscription Maintenance" & Chr(34) & " /F"
1081 oWShell.Run sCmd, 0, False
1082 wscript.sleep 500
1083
1084End Sub
1085
1086'-------------------------------------------------------------------------------
1087' CloseOfficeApps
1088'
1089' End all running instances of applications that will be removed.
1090'-------------------------------------------------------------------------------
1091Sub CloseOfficeApps
1092 Dim Processes, Process, app, prop
1093 Dim sAppName, sOut, sUserWarn
1094 Dim fWait
1095 Dim iRet
1096
1097 On Error Resume Next
1098 fWait = False
1099 iProcCloseCnt = iProcCloseCnt + 1
1100 If fRerun Then Exit Sub
1101
1102 If NOT fUserConsent Then
1103 ' detect processes to allow a user warning
1104 sUserWarn = "Please save all open documents and close all Office, IE and Windows Explorer applications before proceeding." & vbCrLf & _
1105 "When you click OK this removal process will terminate all running Office, IE and Windows Explorer processes and applications." & vbCrLf & vbCrLf & _
1106 "Click СCancelТ to to end this removal now."
1107 For Each app in dicApps.Keys
1108 sAppName = Replace(app, ".", "%.")
1109 Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name like '" & sAppName & "'")
1110 For Each Process in Processes
1111 If NOT InStr(sUserWarn, Process.Name) > 0 Then sUserWarn = sUserWarn & vbCrLf & " - " & Process.Name
1112 Next 'Process
1113 Next 'app
1114 Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process")
1115 For Each Process in Processes
1116 For Each prop in Process.Properties_
1117 If prop.Name = "ExecutablePath" Then
1118 If IsC2R(prop.Value) Then sUserWarn = sUserWarn & vbCrLf & " - " & Process.Name
1119 End If 'ExcecutablePath
1120 Next 'prop
1121 Next 'Process
1122 If (InStr(sUserWarn, " - ") > 0 AND NOT fQuiet) Then
1123 iRet = MsgBox(sUserWarn, 49, "Save your unsaved work now!")
1124 If iRet = 2 Then
1125 SetError ERROR_USERCANCEL
1126 ExitScript
1127 Else
1128 fUserConsent = True
1129 End If
1130 End If
1131 End If 'fUserConsent
1132
1133 ' end known processes first
1134 For Each app in dicApps.Keys
1135 sAppName = Replace(app, ".", "%.")
1136 Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name like '" & sAppName & "'")
1137 For Each Process in Processes
1138 sOut = "End process '" & Process.Name
1139 iRet = Process.Terminate()
1140 CheckError "CloseOfficeApps: " & Process.Name
1141 Log sOut & "' returned: " & iRet
1142 fWait = True
1143 Next 'Process
1144 Next 'app
1145
1146 ' end running applications
1147 Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process")
1148 For Each Process in Processes
1149 For Each prop in Process.Properties_
1150 If prop.Name = "ExecutablePath" Then
1151 If IsC2R(prop.Value) Then
1152 sOut = "End process '" & Process.Name
1153 iRet = Process.Terminate()
1154 CheckError "CloseOfficeApps: " & Process.Name
1155 Log sOut & "' returned: " & iRet
1156 fWait = True
1157 End If
1158 End If 'ExcecutablePath
1159 Next 'prop
1160 Next 'Process
1161 If fWait Then wscript.sleep 5000
1162End Sub 'CloseOfficeApps
1163
1164'-------------------------------------------------------------------------------
1165' Uninstall
1166'
1167' Identify and invoke default uninstall command for a regular uninstall.
1168'-------------------------------------------------------------------------------
1169Sub Uninstall
1170 Dim OseService, srvc
1171 Dim hDefKey, sSubKeyName, sValue, Name, arrNames, arrTypes
1172 Dim sku, prod, sUninstallCmd, sReturn, sMsiProp, sCmd
1173 Dim sPkgFld, sPkgGuid
1174 Dim i
1175
1176 If CBool(iError AND ERROR_USERCANCEL) Then Exit Sub
1177
1178 ' check if OSE service is *installed, *not disabled, *running under System context.
1179 LogH2 "Check state of OSE service"
1180 Set OseService = oWmiLocal.Execquery("Select * From Win32_Service Where Name like 'ose%'")
1181 For Each srvc in OseService
1182 If (srvc.StartMode = "Disabled") AND (Not srvc.ChangeStartMode("Manual") = 0) Then _
1183 Log "Conflict detected: OSE service is disabled"
1184 If (Not srvc.StartName = "LocalSystem") AND (srvc.Change( , , , , , , "LocalSystem", "")) Then _
1185 Log "Conflict detected: OSE service not running as LocalSystem"
1186 Next 'srvc
1187
1188 If NOT dicC2RSuite.Count > 0 Then
1189 Log "No uninstallable C2R items registered in Uninstall"
1190 End If
1191
1192 ' remove the published component registration for C2R packages
1193 LogH2 "Remove published component registration for C2R packages"
1194 ' delete the manifest files
1195 For i = 1 To 4
1196 Select Case i
1197 Case 1
1198 RegReadValue HKLM, "SOFTWARE\Microsoft\Office\15.0\ClickToRun", "PackageFolder", sPkgFld, "REG_SZ"
1199 RegReadValue HKLM, "SOFTWARE\Microsoft\Office\15.0\ClickToRun", "PackageGUID", sPkgGuid, "REG_SZ"
1200 Case 2
1201 RegReadValue HKLM, "SOFTWARE\Microsoft\Office\16.0\ClickToRun", "PackageFolder", sPkgFld, "REG_SZ"
1202 RegReadValue HKLM, "SOFTWARE\Microsoft\Office\16.0\ClickToRun", "PackageGUID", sPkgGuid, "REG_SZ"
1203 Case 3
1204 RegReadValue HKLM, "SOFTWARE\Microsoft\Office\ClickToRun", "PackageFolder", sPkgFld, "REG_SZ"
1205 RegReadValue HKLM, "SOFTWARE\Microsoft\Office\ClickToRun", "PackageGUID", sPkgGuid, "REG_SZ"
1206 Case 4
1207 sPkgFld = sPackageFolder
1208 sPkgGuid = sPackageGuid
1209 End Select
1210 If oFso.FolderExists(sValue & "\root\Integration") Then
1211 sCmd = "cmd.exe /c del " & chr(34) & sPkgFld & "\root\Integration\C2RManifest*.xml" & chr(34)
1212 Log " Run: " & sCmd
1213 sReturn = oWShell.Run (sCmd, 0, True)
1214 Log " Return value: " & sReturn
1215 If oFso.FileExists(sPkgFld & "\root\Integration\integrator.exe") Then
1216 sCmd = chr(34) & sPkgFld & "\root\Integration\integrator.exe" & chr(34) & " /U /Extension PackageRoot=" & chr(34) & sPkgFld & "\root" & chr(34) & " PackageGUID=" & sPkgGuid
1217 Log " Run: " & sCmd
1218 sReturn = oWShell.Run (sCmd, 0, True)
1219 Log " Return value: " & sReturn
1220 sCmd = chr(34) & sPkgFld & "\root\Integration\integrator.exe" & chr(34) & " /U"
1221 Log " Run: " & sCmd
1222 sReturn = oWShell.Run (sCmd, 0, True)
1223 Log " Return value: " & sReturn
1224 End If
1225 If oFso.FileExists(sProgramData & "\Microsoft\ClickToRun\{" & sPkgGuid & "}\integrator.exe") Then
1226 sCmd = chr(34) & sProgramData & "\Microsoft\ClickToRun\{" & sPkgGuid & "}\integrator.exe" & chr(34) & " /U /Extension PackageRoot=" & chr(34) & sPkgFld & "\root" & chr(34) & " PackageGUID=" & sPkgGuid
1227 Log " Run: " & sCmd
1228 sReturn = oWShell.Run (sCmd, 0, True)
1229 Log " Return value: " & sReturn
1230 End If
1231 End If
1232 Next 'i
1233
1234 ' delete potential blocking registry keys for msiexec based tasks
1235 LogH2 "Remove C2R and App-V registry data"
1236 For Each sku in dicC2RSuite.Keys
1237 ' remove the ARP entry
1238 RegDeleteKey HKLM, REG_ARP & sku
1239 Next 'sku
1240 RegDeleteKey HKCU, "SOFTWARE\Microsoft\Office\15.0\ClickToRun"
1241 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\15.0\ClickToRun"
1242 RegDeleteKey HKCU, "SOFTWARE\Microsoft\Office\16.0\ClickToRun"
1243 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\16.0\ClickToRun"
1244 RegDeleteKey HKCU, "SOFTWARE\Microsoft\Office\ClickToRun"
1245 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\ClickToRun"
1246
1247 ' AppV keys
1248 hDefKey = HKCU
1249 sSubKeyName = "SOFTWARE\Microsoft\AppV\ISV"
1250 Do
1251 LogOnly "Scanning key: " & sSubKeyName
1252 If RegEnumValues(hDefKey, sSubKeyName, arrNames, arrTypes) Then
1253 For Each Name in arrNames
1254 If IsC2R(Name) Then RegDeleteValue hDefKey, sSubKeyName, Name, False
1255 Next 'Name
1256 End If 'RegEnumValues
1257 If hDefKey = HKLM Then Exit Do
1258 hDefKey = HKLM
1259 Loop
1260 hDefKey = HKCU
1261 sSubKeyName = "SOFTWARE\Microsoft\AppVISV"
1262 Do
1263 LogOnly "Scanning key: " & sSubKeyName
1264 If RegEnumValues(hDefKey, sSubKeyName, arrNames, arrTypes) Then
1265 For Each Name in arrNames
1266 If IsC2R(Name) Then RegDeleteValue hDefKey, sSubKeyName, Name, False
1267 Next 'Name
1268 End If 'RegEnumValues
1269 If hDefKey = HKLM Then Exit Do
1270 hDefKey = HKLM
1271 Loop
1272
1273 ' msiexec based uninstall
1274 sMsiProp = " REBOOT=ReallySuppress NOREMOVESPAWN=True"
1275 LogH2 "Detect Msi based products"
1276 For Each prod in oMsi.Products
1277 If CheckDelete(prod) Then
1278 Log "Call msiexec.exe to remove " & prod
1279 sUninstallCmd = "msiexec.exe /x" & prod & sMsiProp
1280 If fQuiet Then
1281 sUninstallCmd = sUninstallCmd & " /q"
1282 Else
1283 sUninstallCmd = sUninstallCmd & " /qb-!"
1284 End If
1285 sUninstallCmd = sUninstallCmd & " /l*v " & chr(34) & sLogDir & "\Uninstall_" & prod & ".log" & chr(34)
1286 CloseOfficeApps
1287 LogOnly "Call msiexec with '" & sUninstallCmd & "'"
1288 sReturn = oWShell.Run(sUninstallCmd, 0, True)
1289 Log "msiexec returned: " & SetupRetVal(sReturn) & " (" & sReturn & ")" & vbCrLf
1290 fRebootRequired = fRebootRequired OR (sReturn = "3010")
1291 If fRebootRequired Then SetError ERROR_REBOOT_REQUIRED
1292 Select Case CInt(sReturn)
1293 Case ERROR_SUCCESS,ERROR_SUCCESS_CONFIG_COMPLETE,ERROR_SUCCESS_REBOOT_REQUIRED
1294 'success no action required
1295 Case Else
1296 SetError ERROR_STAGE1
1297 End Select
1298 Else
1299 LogOnly "Skip out of scope product: " & prod
1300 End If 'CheckDelete
1301 Next 'Product
1302 oWShell.Run "cmd.exe /c net stop msiserver", 0, False
1303End Sub 'Uninstall
1304
1305'-------------------------------------------------------------------------------
1306' RegWipe
1307'
1308' Removal of left behind registry data
1309'-------------------------------------------------------------------------------
1310Sub Regwipe
1311 Dim hDefKey, item, name, value, RetVal
1312 Dim sGuid, sSubKeyName, sValue, sCmd
1313 Dim i, iLoopCnt
1314 Dim arrKeys, arrNames, arrTypes, arrTestNames, arrTestTypes
1315 Dim arrMultiSzValues, arrMultiSzNewValues
1316 Dim fDelReg
1317
1318 If CBool(iError AND ERROR_USERCANCEL) Then Exit Sub
1319
1320 LogH1 "Registry CleanUp"
1321
1322 'Moved to earlier timing to avoid reboot needs
1323 'If NOT dicKeepSku.Count > 0 Then ClearShellIntegrationReg
1324
1325 CloseOfficeApps
1326
1327 ' Note: ARP entries have already been cleared in uninstall stage
1328
1329 ' HKCU Registration
1330 RegDeleteKey HKCU, "Software\Microsoft\Office\15.0\Registration"
1331 RegDeleteKey HKCU, "Software\Microsoft\Office\16.0\Registration"
1332 RegDeleteKey HKCU, "Software\Microsoft\Office\Registration"
1333
1334
1335 ' C2R specifics
1336 ' AppV key "SOFTWARE\Microsoft\AppV" has already been cleared in uninstall stage
1337
1338 ' Virtual InstallRoot
1339 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\15.0\Common\InstallRoot\Virtual"
1340 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\16.0\Common\InstallRoot\Virtual"
1341 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\Common\InstallRoot\Virtual"
1342
1343 ' Mapi Search reg
1344 'O15
1345 If NOT dicKeepSku.Count > 0 Then RegDeleteKey HKLM, "SOFTWARE\Classes\CLSID\{2027FC3B-CF9D-4ec7-A823-38BA308625CC}"
1346 'O16
1347 '{F8E61EDD-EA25-484e-AC8A-7447F2AAE2A9}
1348
1349
1350 ' C2R keys
1351 RegDeleteKey HKCU, "SOFTWARE\Microsoft\Office\15.0\ClickToRun"
1352 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\15.0\ClickToRun"
1353 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\15.0\ClickToRunStore"
1354 RegDeleteKey HKCU, "SOFTWARE\Microsoft\Office\16.0\ClickToRun"
1355 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\16.0\ClickToRun"
1356 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\16.0\ClickToRunStore"
1357 RegDeleteKey HKCU, "SOFTWARE\Microsoft\Office\ClickToRun"
1358 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\ClickToRun"
1359 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Office\ClickToRunStore"
1360
1361 ' Office key in HKLM
1362 If Not dicKeepSku.Count > 0 Then
1363 'double calls to ensure Wow6432 gets cleared out as well
1364 RegDeleteKey HKLM, "Software\Microsoft\Office\15.0"
1365 RegDeleteKey HKLM, "Software\Microsoft\Office\15.0"
1366 RegDeleteKey HKLM, "Software\Microsoft\Office\16.0"
1367 RegDeleteKey HKLM, "Software\Microsoft\Office\16.0"
1368 End If
1369 ClearOfficeHKLM "SOFTWARE\Microsoft\Office"
1370
1371 ' Run key
1372 sSubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
1373 If RegEnumValues (HKLM, sSubKeyName, arrNames, arrTypes) Then
1374 For Each name in arrNames
1375 If RegReadValue(HKLM, sSubKeyName, name, sValue, "REG_SZ") Then
1376 If IsC2R(sValue) Then RegDeleteValue HKLM, sSubKeyName, name, False
1377 End If
1378 Next 'item
1379 End If
1380 RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "Lync15", False
1381 RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "Lync16", False
1382
1383 ' ARP
1384 ' Note: configuration entries have already been removed
1385 ' as part of the 'Uninstall' stage
1386 If RegEnumKey(HKLM, REG_ARP, arrKeys) Then
1387 For Each item in arrKeys
1388 If Len(item) > 37 Then
1389 sGuid = UCase(Left(item, 38))
1390 If CheckDelete(sGuid) Then RegDeleteKey HKLM, REG_ARP & item & "\"
1391 End If 'Len(Item)>37
1392 Next 'Item
1393 End If
1394
1395 ' UpgradeCodes, WI config, WI global config
1396 LogH2 "Scan Windows Installer metadata for removeable UpgradeCodes"
1397 For iLoopCnt = 1 to 5
1398 Select Case iLoopCnt
1399 Case 1
1400 sSubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UpgradeCodes\"
1401 hDefKey = HKLM
1402 Case 2
1403 sSubKeyName = "Installer\UpgradeCodes\"
1404 hDefKey = HKCR
1405 Case 3
1406 sSubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products\"
1407 hDefKey = HKLM
1408 Case 4
1409 sSubKeyName = "Installer\Features\"
1410 hDefKey = HKCR
1411 Case 5
1412 sSubKeyName = "Installer\Products\"
1413 hDefKey = HKCR
1414 End Select
1415 If RegEnumKey(hDefKey, sSubKeyName, arrKeys) Then
1416 For Each item in arrKeys
1417 ' ensure the expected length for a compressed GUID
1418 If Len(item) = 32 Then
1419 ' expand the GUID
1420 sGuid = GetExpandedGuid(item)
1421 ' check if it's an Office key
1422 If CheckDelete(sGuid) Then
1423 If iLoopCnt < 3 Then
1424 ' enum all entries
1425 RegEnumValues hDefKey, sSubKeyName & item, arrNames, arrTypes
1426 If IsArray(arrNames) Then
1427 ' delete entries within removal scope
1428 For Each name in arrNames
1429 If Len(name) = 32 Then
1430 sGuid = GetExpandedGuid(name)
1431 If CheckDelete(sGuid) Then RegDeleteValue hDefKey, sSubKeyName & item & "\", name, True
1432 Else
1433 ' invalid data -> delete the value
1434 RegDeleteValue hDefKey, sSubKeyName & item & "\", name, True
1435 End If
1436 Next 'Name
1437 End If 'IsArray(arrNames)
1438 ' if all entries were removed - delete the key
1439 If NOT RegEnumValues(hDefKey, sSubKeyName & item, arrNames, arrTypes) Then RegDeleteKey hDefKey, sSubKeyName & item & "\"
1440 Else 'iLoopCnt >= 3
1441 RegDeleteKey hDefKey, sSubKeyName & item & "\"
1442 End If 'iLoopCnt < 3
1443 End If 'InScope
1444 End If 'Len(Item)=32
1445 Next 'Item
1446 End If 'RegEnumKey
1447 Next 'iLoopCnt
1448
1449 ' Components in Global
1450 LogH2 "Scan Windows Installer Global Components metadata"
1451 sSubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components\"
1452 hDefKey = HKLM
1453 If RegEnumKey(hDefKey, sSubKeyName, arrKeys) Then
1454 For Each item in arrKeys
1455 ' ensure the expected length for a compressed GUID
1456 If Len(Item) = 32 Then
1457 If RegEnumValues(hDefKey, sSubKeyName & item, arrNames, arrTypes) Then
1458 For Each name in arrNames
1459 If Len(Name) = 32 Then
1460 sGuid = GetExpandedGuid(Name)
1461 If CheckDelete(sGuid) Then
1462 RegDeleteValue hDefKey, sSubKeyName & item & "\", name, False
1463 ' if all entries were removed - delete the key
1464 If NOT RegEnumValues(hDefKey, sSubKeyName & item, arrTestNames, arrTestTypes) Then RegDeleteKey hDefKey, sSubKeyName & item & "\"
1465 End If
1466 End If '32
1467 Next 'Name
1468 End If 'RegEnumValues
1469 End If '32
1470 Next 'Item
1471 End If 'RegEnumKey
1472
1473 ' Published Components
1474 LogH2 "Scanning Windows Installer Published Components metadata"
1475 sSubKeyName = "Installer\Components\"
1476 hDefKey = HKCR
1477 If RegEnumKey(hDefKey, sSubKeyName, arrKeys) Then
1478 For Each item in arrKeys
1479 ' ensure the expected length for a compressed GUID
1480 If Len(Item) = 32 Then
1481 If RegEnumValues(hDefKey, sSubKeyName & item, arrNames, arrTypes) Then
1482 For Each name in arrNames
1483 If RegReadValue (hDefKey, sSubKeyName & item, name, sValue, "REG_MULTI_SZ") Then
1484 arrMultiSzValues = Split(sValue, chr(13))
1485 If IsArray(arrMultiSzValues) Then
1486 i = -1
1487 ReDim arrMultiSzNewValues(-1)
1488 fDelReg = False
1489 For Each value in arrMultiSzValues
1490 If Len(value) > 19 Then
1491 sGuid = ""
1492 If GetDecodedGuid(Left(value, SQUISHED), sGuid) Then
1493 If CheckDelete(sGuid) Then
1494 fDelReg = True
1495 Else
1496 i = i + 1
1497 ReDim Preserve arrMultiSzNewValues(i)
1498 arrMultiSzNewValues(i) = value
1499 End If 'CheckDelete
1500 End If 'decode
1501 End If '19
1502 Next 'Value
1503 If NOT (i = -1) Then
1504 If NOT UBound(arrMultiSzValues) = i Then oReg.SetMultiStringValue hDefKey, sSubKeyName & item, name,arrMultiSzNewValues
1505 Else
1506 If fDelReg Then
1507 RegDeleteValue hDefKey, sSubKeyName & item & "\", name, True
1508 ' if all entries were removed - delete the key
1509 If NOT RegEnumValues(hDefKey, sSubKeyName & item, arrTestNames, arrTestTypes) Then RegDeleteKey hDefKey, sSubKeyName & item & "\"
1510 End If 'DelReg
1511 End If
1512 End If 'IsArray
1513 End If
1514 Next 'Name
1515 End If 'RegEnumValues
1516 End If '32
1517 Next 'Item
1518 End If 'RegEnumKey
1519
1520End Sub 'Regwipe
1521
1522'-------------------------------------------------------------------------------
1523' ClearShellIntegrationReg
1524'
1525' Delete registry items that may cause Explorer / Windows Shell to have a lock
1526' on files
1527'-------------------------------------------------------------------------------
1528Sub ClearShellIntegrationReg
1529 Dim Processes, Process
1530 Dim sOut
1531 Dim iRet
1532
1533' Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name like 'explorer.exe'")
1534' For Each Process in Processes
1535' sOut = "End process '" & Process.Name
1536' iRet = Process.Terminate()
1537' CheckError "ClearShellIntegrationReg: " & Process.Name
1538' Log sOut & "' returned: " & iRet
1539' Next 'Process
1540' wscript.sleep 500
1541
1542
1543 ' Protocol Handlers
1544 RegDeleteKey HKLM, "SOFTWARE\Classes\Protocols\Handler\osf"
1545
1546 ' Context Menu Handlers
1547 RegDeleteKey HKLM, "SOFTWARE\Classes\CLSID\{573FFD05-2805-47C2-BCE0-5F19512BEB8D}"
1548 'RegDeleteKey HKLM, "SOFTWARE\Classes\CLSID\{4693FF15-B962-420A-9E5D-176F7D4B8321}"
1549 RegDeleteKey HKLM, "SOFTWARE\Classes\CLSID\{8BA85C75-763B-4103-94EB-9470F12FE0F7}"
1550 RegDeleteKey HKLM, "SOFTWARE\Classes\CLSID\{CD55129A-B1A1-438E-A425-CEBC7DC684EE}"
1551 RegDeleteKey HKLM, "SOFTWARE\Classes\CLSID\{D0498E0A-45B7-42AE-A9AA-ABA463DBD3BF}"
1552 RegDeleteKey HKLM, "SOFTWARE\Classes\CLSID\{E768CD3B-BDDC-436D-9C13-E1B39CA257B1}"
1553
1554 ' Groove ShellIconOverlayIdentifiers
1555 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Microsoft SPFS Icon Overlay 1 (ErrorConflict)"
1556 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Microsoft SPFS Icon Overlay 2 (SyncInProgress)"
1557 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Microsoft SPFS Icon Overlay 3 (InSync)"
1558 RegDeleteKey HKLM, "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Microsoft SPFS Icon Overlay 1 (ErrorConflict)"
1559 RegDeleteKey HKLM, "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Microsoft SPFS Icon Overlay 2 (SyncInProgress)"
1560 RegDeleteKey HKLM, "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\Microsoft SPFS Icon Overlay 3 (InSync)"
1561
1562 ' Shell extensions
1563 RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\", "{B28AA736-876B-46DA-B3A8-84C5E30BA492}", False
1564 RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\", "{8B02D659-EBBB-43D7-9BBA-52CF22C5B025}", False
1565 RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\", "{0875DCB6-C686-4243-9432-ADCCF0B9F2D7}", False
1566 RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\", "{42042206-2D85-11D3-8CFF-005004838597}", False
1567 RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\", "{993BE281-6695-4BA5-8A2A-7AACBFAAB69E}", False
1568 RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\", "{C41662BB-1FA0-4CE0-8DC5-9B7F8279FF97}", False
1569 RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\", "{506F4668-F13E-4AA1-BB04-B43203AB3CC0}", False
1570 RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\", "{D66DC78C-4F61-447F-942B-3FB6980118CF}", False
1571 RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\", "{46137B78-0EC3-426D-8B89-FF7C3A458B5E}", False
1572 RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\", "{8BA85C75-763B-4103-94EB-9470F12FE0F7}", False
1573 RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\", "{CD55129A-B1A1-438E-A425-CEBC7DC684EE}", False
1574 RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\", "{D0498E0A-45B7-42AE-A9AA-ABA463DBD3BF}", False
1575 RegDeleteValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\", "{E768CD3B-BDDC-436D-9C13-E1B39CA257B1}", False
1576
1577 ' BHO
1578 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\{31D09BA0-12F5-4CCE-BE8A-2923E76605DA}"
1579 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\{B4F3A835-0E21-4959-BA22-42B3008E02FF}"
1580 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\{D0498E0A-45B7-42AE-A9AA-ABA463DBD3BF}"
1581 RegDeleteKey HKLM, "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\{31D09BA0-12F5-4CCE-BE8A-2923E76605DA}"
1582 RegDeleteKey HKLM, "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\{B4F3A835-0E21-4959-BA22-42B3008E02FF}"
1583 RegDeleteKey HKLM, "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\{D0498E0A-45B7-42AE-A9AA-ABA463DBD3BF}"
1584
1585 ' OneNote Namespace Extension for Desktop
1586 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Desktop\NameSpace\{0875DCB6-C686-4243-9432-ADCCF0B9F2D7}"
1587
1588 ' Web Sites
1589 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Desktop\Namespace\{B28AA736-876B-46DA-B3A8-84C5E30BA492}"
1590 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\NetworkNeighborhood\Namespace\{46137B78-0EC3-426D-8B89-FF7C3A458B5E}"
1591
1592 ' VolumeCaches
1593 RegDeleteKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Microsoft Office Temp Files"
1594
1595' Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name like 'explorer.exe'")
1596' For Each Process in Processes
1597' sOut = "End process '" & Process.Name
1598' iRet = Process.Terminate()
1599' CheckError "ClearShellIntegrationReg: " & Process.Name
1600' Log sOut & "' returned: " & iRet
1601' Next 'Process
1602' wscript.sleep 500
1603 RestoreExplorer
1604 FreeObjects
1605 wscript.sleep 500
1606 InitObjects
1607
1608End Sub 'ClearShellIntegrationReg
1609
1610'-------------------------------------------------------------------------------
1611' FileWipe
1612'
1613' Removal of left behind services, files and shortcuts
1614'-------------------------------------------------------------------------------
1615Sub FileWipe
1616 Dim scRoot
1617 Dim fDelFolders
1618
1619 If CBool(iError AND ERROR_USERCANCEL) Then Exit Sub
1620
1621 LogH1 "File Cleanup"
1622
1623 fDelFolders = False
1624 CloseOfficeApps
1625 DelSchtasks
1626
1627 LogH1 "Delete Services"
1628 ' remove the OfficeSvc service
1629 LogH2 "Delete OfficeSvc service"
1630 DeleteService "OfficeSvc"
1631
1632 ' SP1 addition / change
1633 ' remove the ClickToRunSvc service
1634 LogH2 "Delete ClickToRunSvc service"
1635 DeleteService "ClickToRunSvc"
1636
1637 ' adding additional processes for termination
1638 dicApps.Add "explorer.exe", "explorer.exe"
1639 dicApps.Add "msiexec.exe", "msiexec.exe"
1640 dicApps.Add "ose.exe", "ose.exe"
1641
1642 If fC2R Then
1643 LogH1 "Delete Files and Folders"
1644 ' delete C2R package files
1645 LogH2 "Delete C2R package files"
1646 If oFso.FolderExists(sProgramFiles & "\Microsoft Office 15") _
1647 Or oFso.FolderExists(sProgramFiles & "\Microsoft Office 16") _
1648 Or oFso.FolderExists(oWShell.ExpandEnvironmentStrings("%programfiles%") & "\Microsoft Office\PackageManifests") _
1649 Or oFso.FolderExists(oWShell.ExpandEnvironmentStrings("%programfiles(x86)%") & "\Microsoft Office\PackageManifests") Then
1650 fDelFolders = True
1651 Log " Attention: Now closing Explorer.exe for file delete operations"
1652 Log " Explorer will automatically restart."
1653 wscript.sleep 2000
1654 CloseOfficeApps
1655 End If
1656 ' delete Office folders
1657 LogH2 "Delete Office folders"
1658 DeleteFolder sProgramFiles & "\Microsoft Office 15"
1659 DeleteFolder sProgramFiles & "\Microsoft Office 16"
1660 If f64 Then
1661 DeleteFolder sCommonProgramFilesX86 & "\Microsoft Office 15"
1662 DeleteFolder sCommonProgramFilesX86 & "\Microsoft Office 16"
1663 End If
1664 If fDelFolders Then
1665 DeleteFolder sProgramFiles & "\Microsoft Office\PackageManifests"
1666 DeleteFolder sProgramFiles & "\Microsoft Office\PackageSunrisePolicies"
1667 DeleteFolder sProgramFiles & "\Microsoft Office\root"
1668 DeleteFile sProgramFiles & "\Microsoft Office\AppXManifest.xml"
1669 DeleteFile sProgramFiles & "\Microsoft Office\FileSystemMetadata.xml"
1670 If Not dicKeepSku.Count > 0 Then
1671 DeleteFolder sProgramFiles & "\Microsoft Office\Office16"
1672 DeleteFolder sProgramFiles & "\Microsoft Office\Office15"
1673 End If
1674 If f64 Then
1675 DeleteFolder sProgramFilesX86 & "\Microsoft Office\PackageManifests"
1676 DeleteFolder sProgramFilesX86 & "\Microsoft Office\PackageSunrisePolicies"
1677 DeleteFolder sProgramFilesX86 & "\Microsoft Office\root"
1678 DeleteFile sProgramFilesX86 & "\Microsoft Office\AppXManifest.xml"
1679 DeleteFile sProgramFilesX86 & "\Microsoft Office\FileSystemMetadata.xml"
1680 If Not dicKeepSku.Count > 0 Then
1681 DeleteFolder sProgramFilesX86 & "\Microsoft Office\Office16"
1682 DeleteFolder sProgramFilesX86 & "\Microsoft Office\Office15"
1683 End If
1684 End If
1685 End If
1686
1687 DeleteFolder sProgramData & "\Microsoft\ClickToRun"
1688 DeleteFolder sCommonProgramFiles & "\microsoft shared\ClickToRun"
1689 DeleteFolder sProgramData & "\Microsoft\office\FFPackageLocker"
1690 DeleteFolder sProgramData & "\Microsoft\office\ClickToRunPackageLocker"
1691 If oFso.FileExists(sProgramData & "\Microsoft\office\FFPackageLocker") Then DeleteFile sProgramData & "\Microsoft\office\FFPackageLocker"
1692 If oFso.FileExists(sProgramData & "\Microsoft\office\FFStatePBLocker") Then DeleteFile sProgramData & "\Microsoft\office\FFStatePBLocker"
1693 If NOT dicKeepSku.Count > 0 Then DeleteFolder sProgramData & "\Microsoft\office\Heartbeat"
1694 DeleteFolder oWShell.ExpandEnvironmentStrings("%userprofile%") & "\Microsoft Office"
1695 DeleteFolder oWShell.ExpandEnvironmentStrings("%userprofile%") & "\Microsoft Office 15"
1696 DeleteFolder oWShell.ExpandEnvironmentStrings("%userprofile%") & "\Microsoft Office 16"
1697 End If
1698
1699 ' restore explorer.exe if needed
1700 RestoreExplorer
1701
1702 ' delete shortcuts
1703 LogH2 "Search and delete shortcuts"
1704 CleanShortcuts sAllUsersProfile, True, False
1705 CleanShortcuts sProfilesDirectory, True, False
1706
1707 ' delete empty folder structures
1708 If dicDelFolder.Count > 0 Then
1709 LogH2 "Remove empty folders"
1710 DeleteEmptyFolders
1711 End If
1712
1713 ' add the collected files in use for delete on reboot
1714 If dicDelInUse.Count > 0 Then ScheduleDeleteEx
1715
1716 LogH2 "File Cleanup complete"
1717End Sub ' FileWipe
1718
1719'-------------------------------------------------------------------------------
1720' CleanShortcuts
1721'
1722' Recursively search all profile folders for Office shortcuts in scope
1723'-------------------------------------------------------------------------------
1724Sub CleanShortcuts (sFolder, fDelete, fUnPin)
1725 Dim oFolder, fld, file, sc, item
1726 Dim fDeleteSC
1727 Dim sCmdLine, sReturn
1728
1729 If fSkipSD Then Exit Sub
1730
1731 Set oFolder = oFso.GetFolder(sFolder)
1732 ' exclude system protected link folders
1733 If CBool(oFolder.Attributes AND 1024) Then Exit Sub
1734
1735 On Error Resume Next
1736 For Each fld In oFolder.SubFolders
1737 If Err <> 0 Then
1738 CheckError "CleanShortcuts: " & vbTab & sFolder
1739 Else
1740 CleanShortcuts fld.Path, fDelete, fUnPin
1741 End If
1742 Next
1743 For Each file In oFolder.Files
1744 If LCase(Right(file.Path, 4)) = ".lnk" AND (NOT InStr(LCase(file.Path), "recentplaces") > 0) Then
1745 fDeleteSC = False
1746 LogOnly " check file: " & file.Path
1747 set sc = oWShell.CreateShortcut(file.Path)
1748 If Err <> 0 Then
1749 CheckError "CleanShortcutsSC: " & vbTab & sFolder
1750 Else
1751 'Compare if the shortcut target is in the list of executables that will be removed
1752 'LogOnly " - SC.TargetPath: " & sc.TargetPath
1753 If Len(sc.TargetPath) > 0 Then
1754 If InStr(sc.TargetPath,"{") > 0 Then
1755 'Handle Windows Installer shortcuts
1756 If Len(sc.TargetPath) >= InStr(sc.TargetPath,"{") + 37 Then
1757 If CheckDelete(Mid(sc.TargetPath, InStr(sc.TargetPath,"{"), 38)) Then fDeleteSC = True
1758 End If
1759 Else
1760 'Handle regular shortcuts
1761 If IsC2R(sc.TargetPath) Then fDeleteSC = True
1762 If NOT oFso.FileExists(sc.TargetPath) Then
1763 ' Shortcut target does not exist
1764 If IsC2R(sc.TargetPath) Then
1765 LogOnly "remove Office shortcut with non-existent target: " & file.Path & " - " & sc.TargetPath
1766 fDeleteSC = True
1767 Else
1768 'LogOnly " - keep orphaned SC as target is not in scope: " & sc.TargetPath
1769 End If
1770 Else
1771 'LogOnly " - keep SC as shortcut target does still exist: " & sc.TargetPath
1772 End If
1773 End If
1774 End If
1775 End If
1776 If fDeleteSC Then
1777 If NOT dicDelFolder.Exists(sFolder) Then dicDelFolder.Add sFolder, sFolder
1778 If fUnPin OR fDelete Then
1779 If oFso.FileExists(sc.TargetPath) Then
1780 Else
1781 sc.TargetPath = sNotepad
1782 sc.Save
1783 LogOnly "linking empty shortcut to Notepad.exe as target: " & file.Path & " - " & sc.TargetPath
1784 End If
1785 'Invoke new instance to UnPin file
1786 sCmdLine = WScript.Path & "\wscript.exe " & Chr(34) & WScript.scriptFullName & Chr(34)
1787 sCmdLine = sCmdLine & " " & chr(34) & "UNPINSC" & chr(34)
1788 sCmdLine = sCmdLine & " " & chr(34) & file.Path & chr(34)
1789 LogOnly "Invoke UnPin handler for shortcut: " & file.Path
1790 LogOnly "UnPin command: " & sCmdLine
1791 sReturn = CStr(oWShell.Run (sCmdLine, 0, True))
1792 LogOnly "UnPin returned with: " & sReturn
1793 End If
1794 If fDelete Then DeleteFile file.Path
1795 fDeleteSC = False
1796 fClearTaskBand = True
1797 End If 'fDeleteSC
1798 End If
1799 Next
1800 On Error Goto 0
1801End Sub 'CleanShortcuts
1802
1803'-------------------------------------------------------------------------------
1804' UnPin
1805'
1806' Unpins a shortcut from the taskbar or start menu
1807'-------------------------------------------------------------------------------
1808Sub UnPin(sFilePath)
1809 Dim fldItem, verb, file
1810 Dim oShellAppUnPin
1811
1812 On Error Resume Next
1813 Set oShellAppUnPin = CreateObject("Shell.Application")
1814 Set file = oFso.GetFile(sFilePath)
1815
1816 Set fldItem = oShellAppUnPin.NameSpace(file.ParentFolder.Path).ParseName(file.Name)
1817 For Each verb in fldItem.Verbs
1818 Select Case LCase(Replace(verb, "&", ""))
1819 Case "unpin from taskbar", "von taskleiste losen", "detacher du barre des taches", "detacher de la barre des taches", "desanclar de la barra de tareas", "ta bort fran aktivitetsfaltet", "frigor fra proceslinje", "frigor fra proceslinjen", "desanclar de la barra de tareas", "odepnout z hlavniho panelu", "van de taakbalk losmaken", "poista kiinnitys tehtavapalkista", "rimuovi dalla barra delle applicazioni"
1820 verb.DoIt
1821 Case "unpin from start menu", "vom startmenu losen", "desepingler du menu demarrer", "supprimer du menu demarrer", "detacher du menu demarrer", "detacher de la menu demarrer", "odepnout z nabidky start", "frigor fra menuen start", "van het menu start losmaken", "losmaken van menu start", "poista kiinnitys kaynnista-valikosta", "irrota aloitusvalikosta"
1822 verb.DoIt
1823 End Select
1824 Select Case Replace(verb, "&", "")
1825 Case "?????????", "? [??] ???????", "??? ????????(K)", "?? ????? ??(K)", "ќткрепить от панели задач", "???????????? ??? ?? ????? ??????", "????? ????? ?????? ?????"
1826 verb.DoIt
1827 End Select
1828 Next
1829 Set verb = Nothing
1830 Set fldItem = Nothing
1831 Set oShellAppUnPin = Nothing
1832 On Error Goto 0
1833End Sub
1834
1835'-------------------------------------------------------------------------------
1836' ClearTaskBand
1837'
1838' Clears contents from the users taskband to get rid of pinned items
1839'-------------------------------------------------------------------------------
1840Sub ClearTaskBand ()
1841 Dim sid
1842 Dim sTaskBand, sHKUTaskBand
1843 Dim arrSid
1844
1845 sTaskBand = "Software\Microsoft\Windows\CurrentVersion\Explorer\Taskband\"
1846 RegDeleteValue HKCU, sTaskBand, "Favorites", False
1847 RegDeleteValue HKCU, sTaskBand, "FavoritesRemovedChanges", False
1848 RegDeleteValue HKCU, sTaskBand, "FavoritesChanges", False
1849 RegDeleteValue HKCU, sTaskBand, "FavoritesResolve", False
1850 RegDeleteValue HKCU, sTaskBand, "FavoritesVersion", False
1851
1852 ' enum all profiles in HKU
1853 LoadUsersReg
1854 If NOT RegEnumKey(HKU, "", arrSid) Then Exit Sub
1855 For Each sid in arrSid
1856 sHKUTaskBand = sid & "\" & sTaskBand
1857 RegDeleteValue HKCU, sHKUTaskBand, "Favorites", False
1858 RegDeleteValue HKCU, sHKUTaskBand, "FavoritesRemovedChanges", False
1859 RegDeleteValue HKCU, sHKUTaskBand, "FavoritesChanges", False
1860 RegDeleteValue HKCU, sHKUTaskBand, "FavoritesResolve", False
1861 RegDeleteValue HKCU, sHKUTaskBand, "FavoritesVersion", False
1862 Next 'sid
1863End Sub 'ClearTaskBand
1864
1865'-------------------------------------------------------------------------------
1866' LoadUsersReg
1867'
1868' Loads the HKCU for all local users
1869'-------------------------------------------------------------------------------
1870Sub LoadUsersReg ()
1871 Dim profilefolder
1872 Dim sValue
1873
1874 LogH1 "Load User Registry Profiles"
1875 On Error Resume Next
1876
1877 oReg.GetExpandedStringValue HKLM, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList", "ProfilesDirectory", sValue
1878 For Each profilefolder in oFso.GetFolder(sValue).SubFolders
1879 If oFso.FileExists(profilefolder.path & "\ntuser.dat") Then
1880 LogOnly " load: " & profilefolder.path & "\ntuser.dat" & " as " & "HKU\" & profilefolder.name
1881 oWShell.Run "reg load " & _
1882 chr(34) & "HKU\" & profilefolder.name & chr(34) & " " & _
1883 chr(34) & profilefolder.path & "\ntuser.dat" & chr(34), 0, True
1884 End If
1885' If oFso.FileExists(profilefolder.path & "\Local Settings\Application Data\Microsoft\Windows\UsrClass.dat") Then
1886' LogOnly " load: " & profilefolder.path & "\..\UsrClass.dat" & " as " & "HKU\" & profilefolder.name & "_Classes"
1887' oWShell.Run "reg load " & _
1888' chr(34) & "HKU\" & profilefolder.name & "_Classes" & chr(34) & " " & _
1889' chr(34) & profilefolder.path & "\Local Settings\Application Data\Microsoft\Windows\UsrClass.dat" & chr(34),0,True
1890' End If
1891 Next
1892End Sub
1893
1894'-------------------------------------------------------------------------------
1895' ClearOfficeHKLM
1896'
1897' Recursively search and clear the HKLM Office key from references in scope
1898'-------------------------------------------------------------------------------
1899Sub ClearOfficeHKLM (sSubKeyName)
1900 Dim key, name
1901 Dim sValue
1902 Dim arrKeys, arrNames, arrTypes
1903 Dim arrTestNames, arrTestTypes, arrTestKeys
1904
1905 ' recursion
1906 If RegEnumKey(HKLM, sSubKeyName, arrKeys) Then
1907 For Each key in arrKeys
1908 ClearOfficeHKLM sSubKeyName & "\" & key
1909 Next 'key
1910 End If
1911
1912 ' identify & clear removable entries
1913 If RegEnumValues(HKLM, sSubKeyName, arrNames, arrTypes) Then
1914 For Each name in arrNames
1915 If RegReadValue(HKLM, sSubKeyName, name, sValue, "REG_SZ") Then
1916 If IsC2R(sValue) Then RegDeleteValue HKLM, sSubKeyName, name, False
1917 End If
1918 Next 'item
1919 End If
1920
1921 ' clear out empty keys
1922 If (NOT RegEnumValues(HKLM, sSubKeyName, arrNames, arrTypes)) AND _
1923 (NOT RegEnumKey(HKLM, sSubKeyName, arrKeys)) AND _
1924 (NOT dicKeepSku.Count > 0) Then _
1925 RegDeleteKey HKLM, sSubKeyName
1926End Sub
1927
1928
1929'-------------------------------------------------------------------------------
1930'
1931' Helper Functions
1932'
1933'-------------------------------------------------------------------------------
1934
1935'-------------------------------------------------------------------------------
1936' IsC2R
1937'
1938' Check if the passed in string is related to C2R
1939' Returns TRUE if in C2R scope
1940'-------------------------------------------------------------------------------
1941Function IsC2R (sValue)
1942
1943 Const OREF = "\ROOT\OFFICE1"
1944 Const OREFROOT = "Microsoft Office\Root\"
1945 Const OREGREFC2R15 = "Microsoft Office 15"
1946 Const OREGREFC2R16 = "Microsoft Office 16"
1947 Const OCOMMON = "\microsoft shared\ClickToRun"
1948 Const OMANIFEST = "\Microsoft Office\PackageManifests"
1949 Const OSUNRISE = "\Microsoft Office\PackageSunrisePolicies"
1950
1951 Dim fReturn
1952
1953 fReturn = False
1954
1955 If InStr(LCase(sValue), LCase(OREF)) > 0 _
1956 Or InStr(LCase(sValue), LCase(OREFROOT)) > 0 _
1957 Or InStr(LCase(sValue), LCase(OCOMMON)) > 0 _
1958 Or InStr(LCase(sValue), LCase(OMANIFEST)) > 0 _
1959 Or InStr(LCase(sValue), LCase(OSUNRISE)) > 0 _
1960 Or InStr(LCase(sValue), LCase(OREGREFC2R15)) > 0 _
1961 Or InStr(LCase(sValue), LCase(OREGREFC2R16)) > 0 Then fReturn = True
1962
1963 IsC2R = fReturn
1964End Function
1965
1966'-------------------------------------------------------------------------------
1967' CheckRegPermissions
1968'
1969' Test the permissions on some key registry locations to determine if
1970' sufficient permissions are given.
1971'-------------------------------------------------------------------------------
1972Function CheckRegPermissions
1973 Const KEY_QUERY_VALUE = &H0001
1974 Const KEY_SET_VALUE = &H0002
1975 Const KEY_CREATE_SUB_KEY = &H0004
1976 Const DELETE = &H00010000
1977
1978 Dim sSubKeyName
1979 Dim fReturn
1980
1981 CheckRegPermissions = True
1982 sSubKeyName = "Software\Microsoft\Windows\"
1983 oReg.CheckAccess HKLM, sSubKeyName, KEY_QUERY_VALUE, fReturn
1984 If Not fReturn Then CheckRegPermissions = False
1985 oReg.CheckAccess HKLM, sSubKeyName, KEY_SET_VALUE, fReturn
1986 If Not fReturn Then CheckRegPermissions = False
1987 oReg.CheckAccess HKLM, sSubKeyName, KEY_CREATE_SUB_KEY, fReturn
1988 If Not fReturn Then CheckRegPermissions = False
1989 oReg.CheckAccess HKLM, sSubKeyName, DELETE, fReturn
1990 If Not fReturn Then CheckRegPermissions = False
1991
1992End Function 'CheckRegPermissions
1993
1994'-------------------------------------------------------------------------------
1995' GetMyProcessId
1996'
1997' Returns the process id of the own process
1998'-------------------------------------------------------------------------------
1999Function GetMyProcessId()
2000 Dim iParentProcessId
2001
2002 iParentProcessId = 0
2003 ' try to obtain from creating a new cscript instance
2004 On Error Resume Next
2005 iParentProcessId = GetObject("winmgmts:root\cimv2").Get("Win32_Process.Handle='" & oWShell.Exec("cscript.exe").ProcessId & "'").ParentProcessId
2006 On Error Goto 0
2007 If iParentProcessId > 0 Then
2008 ' succeeded to obtain the process id
2009 GetMyProcessId = iParentProcessId
2010 Exit Function
2011 End If
2012
2013 ' failed to obtain the id from the creation of a new instance
2014 ' get it from enum of Win32_Process
2015 Dim Process, Processes
2016 Err.Clear
2017 Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process WHERE Name='cscript.exe' AND CommandLine like '%" & SCRIPTNAME & "%'")
2018 For Each Process in Processes
2019 iParentProcessId = Process.ProcessId
2020 Exit For
2021 Next
2022 GetMyProcessId = iParentProcessId
2023End Function 'GetMyProcessId
2024
2025'-------------------------------------------------------------------------------
2026' Delimiter
2027'
2028' Returns the delimiter for a passed in string
2029'-------------------------------------------------------------------------------
2030Function Delimiter (sVersion)
2031 Dim iCnt, iAsc
2032
2033 Delimiter = " "
2034 For iCnt = 1 To Len(sVersion)
2035 iAsc = Asc(Mid(sVersion, iCnt, 1))
2036 If Not (iASC >= 48 And iASC <= 57) Then
2037 Delimiter = Mid(sVersion, iCnt, 1)
2038 Exit Function
2039 End If
2040 Next 'iCnt
2041End Function
2042
2043'-------------------------------------------------------------------------------
2044' GetExpandedGuid
2045'
2046' Returns the expanded string from a compressed GUID
2047'-------------------------------------------------------------------------------
2048Function GetExpandedGuid (sGuid)
2049 Dim i
2050
2051 'Ensure valid length
2052 If NOT Len(sGuid) = 32 Then Exit Function
2053
2054 GetExpandedGuid = "{" & StrReverse(Mid(sGuid,1,8)) & "-" & _
2055 StrReverse(Mid(sGuid,9,4)) & "-" & _
2056 StrReverse(Mid(sGuid,13,4))& "-"
2057 For i = 17 To 20
2058 If i Mod 2 Then
2059 GetExpandedGuid = GetExpandedGuid & mid(sGuid,(i + 1),1)
2060 Else
2061 GetExpandedGuid = GetExpandedGuid & mid(sGuid,(i - 1),1)
2062 End If
2063 Next
2064 GetExpandedGuid = GetExpandedGuid & "-"
2065 For i = 21 To 32
2066 If i Mod 2 Then
2067 GetExpandedGuid = GetExpandedGuid & mid(sGuid,(i + 1),1)
2068 Else
2069 GetExpandedGuid = GetExpandedGuid & mid(sGuid,(i - 1),1)
2070 End If
2071 Next
2072 GetExpandedGuid = GetExpandedGuid & "}"
2073End Function 'GetExpandedGuid
2074
2075'-------------------------------------------------------------------------------
2076' GetCompressedGuid
2077'
2078' Returns the compressed string for a GUID
2079'-------------------------------------------------------------------------------
2080Function GetCompressedGuid (sGuid)
2081 Dim sCompGUID
2082 Dim i
2083
2084 'Ensure Valid Length
2085 If NOT Len(sGuid) = 38 Then Exit Function
2086
2087 sCompGUID = StrReverse(Mid(sGuid,2,8)) & _
2088 StrReverse(Mid(sGuid,11,4)) & _
2089 StrReverse(Mid(sGuid,16,4))
2090 For i = 21 To 24
2091 If i Mod 2 Then
2092 sCompGUID = sCompGUID & Mid(sGuid, (i + 1), 1)
2093 Else
2094 sCompGUID = sCompGUID & Mid(sGuid, (i - 1), 1)
2095 End If
2096 Next
2097 For i = 26 To 37
2098 If i Mod 2 Then
2099 sCompGUID = sCompGUID & Mid(sGuid, (i - 1), 1)
2100 Else
2101 sCompGUID = sCompGUID & Mid(sGuid, (i + 1), 1)
2102 End If
2103 Next
2104 GetCompressedGuid = sCompGUID
2105End Function
2106
2107'-------------------------------------------------------------------------------
2108' GetDecodedGuid
2109'
2110' Returns the GUID from a squished format
2111'-------------------------------------------------------------------------------
2112Function GetDecodedGuid(sEncGuid, sGuid)
2113
2114Dim sDecode, sTable, sHex, iChr
2115Dim arrTable
2116Dim i, iAsc, pow85, decChar
2117Dim lTotal
2118Dim fFailed
2119
2120 fFailed = False
2121
2122 sTable = "0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff," & _
2123 "0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff," & _
2124 "0xff,0x00,0xff,0xff,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0x0a,0x0b,0xff," & _
2125 "0x0c,0x0d,0x0e,0x0f,0x10,0x11,0x12,0x13,0x14,0x15,0xff,0xff,0xff,0x16,0xff,0x17," & _
2126 "0x18,0x19,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27," & _
2127 "0x28,0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f,0x30,0x31,0x32,0x33,0xff,0x34,0x35,0x36," & _
2128 "0x37,0x38,0x39,0x3a,0x3b,0x3c,0x3d,0x3e,0x3f,0x40,0x41,0x42,0x43,0x44,0x45,0x46," & _
2129 "0x47,0x48,0x49,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f,0x50,0x51,0x52,0xff,0x53,0x54,0xff"
2130 arrTable = Split(sTable,",")
2131 lTotal = 0 : pow85 = 1
2132 For i = 0 To 19
2133 fFailed = True
2134 If i Mod 5 = 0 Then
2135 lTotal = 0 : pow85 = 1
2136 End If ' i Mod 5 = 0
2137 iAsc = Asc(Mid(sEncGuid,i+1,1))
2138 sHex = arrTable(iAsc)
2139 If iAsc >=128 Then Exit For
2140 If sHex = "0xff" Then Exit For
2141 iChr = CInt("&h"&Right(sHex,2))
2142 lTotal = lTotal + (iChr * pow85)
2143 If i Mod 5 = 4 Then sDecode = sDecode & DecToHex(lTotal)
2144 pow85 = pow85 * 85
2145 fFailed = False
2146 Next 'i
2147 If NOT fFailed Then sGuid = "{"&Mid(sDecode,1,8)&"-"& _
2148 Mid(sDecode,13,4)&"-"& _
2149 Mid(sDecode,9,4)&"-"& _
2150 Mid(sDecode,23,2) & Mid(sDecode,21,2)&"-"& _
2151 Mid(sDecode,19,2) & Mid(sDecode,17,2) & Mid(sDecode,31,2) & Mid(sDecode,29,2) & Mid(sDecode,27,2) & Mid(sDecode,25,2) &"}"
2152
2153 GetDecodedGuid = NOT fFailed
2154
2155End Function 'GetDecodedGuid
2156
2157'-------------------------------------------------------------------------------
2158' DecToHex
2159'
2160' Convert a long decimal to hex
2161'-------------------------------------------------------------------------------
2162Function DecToHex(lDec)
2163
2164 Dim sHex
2165 Dim iLen
2166 Dim lVal, lExp
2167 Dim arrChr
2168
2169 arrChr = Array("0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F")
2170 sHex = ""
2171 lVal = lDec
2172 lExp = 16^10
2173 While lExp >= 1
2174 If lVal >= lExp Then
2175 sHex = sHex & arrChr(Int(lVal / lExp))
2176 lVal = lVal - lExp * Int(lVal / lExp)
2177 Else
2178 sHex = sHex & "0"
2179 If sHex = "0" Then sHex = ""
2180 End If
2181 lExp = lExp / 16
2182 Wend
2183
2184 iLen = 8 - Len(sHex)
2185 If iLen > 0 Then sHex = String(iLen, "0") & sHex
2186 DecToHex = sHex
2187End Function
2188
2189'-------------------------------------------------------------------------------
2190' RelaunchAs64Host
2191'
2192' Relaunch self with 64 bit CScript host
2193'-------------------------------------------------------------------------------
2194Sub RelaunchAs64Host
2195 Dim Argument, sCmd
2196 Dim fQuietRelaunch
2197
2198 fQuietRelaunch = False
2199 sCmd = Replace(LCase(wscript.Path), "syswow64", "sysnative") & "\cscript.exe " & Chr(34) & WScript.scriptFullName & Chr(34)
2200 If fQuiet Then fQuietRelaunch = True
2201 If Wscript.Arguments.Count > 0 Then
2202 For Each Argument in Wscript.Arguments
2203 sCmd = sCmd & " " & chr(34) & Argument & chr(34)
2204 Select Case UCase(Argument)
2205 Case "/Q", "/QUIET"
2206 fQuietRelaunch = True
2207 End Select
2208 Next 'Argument
2209 End If
2210 sCmd = sCmd & " /ChangedHostBitness"
2211 If fQuietRelaunch Then
2212 sCmd = Replace (sCmd, "\cscript.exe", "\wscript.exe")
2213 Wscript.Quit CLng(oWShell.Run (sCmd, 0, True))
2214 Else
2215 Wscript.Quit CLng(oWShell.Run (sCmd, 1, True))
2216 End If
2217
2218End Sub 'RelaunchAs64Host
2219
2220'-------------------------------------------------------------------------------
2221' RelaunchElevated
2222'
2223' Relaunch the script with elevated permissions
2224'-------------------------------------------------------------------------------
2225Sub RelaunchElevated
2226 Dim Argument, Process, Processes
2227 Dim iParentProcessId, iSpawnedProcessId
2228 Dim sCmdLine, sRetValFile, sValue
2229 Dim oShell
2230
2231 SetError ERROR_RELAUNCH
2232 ' Shell object for relaunch
2233 Set oShell = CreateObject("Shell.Application")
2234 ' Note: Command line has not been parsed at this point
2235 ' build command line for relaunch
2236 sCmdLine = Chr(34) & WScript.ScriptFullName & Chr(34)
2237 If Wscript.Arguments.Count > 0 Then
2238 For Each Argument in Wscript.Arguments
2239 Select Case UCase(Argument)
2240 Case "/Q","/QUIET"
2241 'Don't try to relaunch in quiet mode
2242 Exit Sub
2243 SetError ERROR_ELEVATION_FAILED
2244 Case "UAC"
2245 'Already tried elevated relaunch
2246 SetError ERROR_ELEVATION_FAILED
2247 Exit Sub
2248 Case Else
2249 sCmdLine = sCmdLine & " " & chr(34) & Argument & chr(34)
2250 End Select
2251 Next 'Argument
2252 End If
2253 ' prep work to get the return value from the elevated process
2254 iParentProcessId = GetMyProcessId
2255
2256' ' make user aware of elevation attempt after reboot
2257' If RegReadValue(HKCU, "SOFTWARE\Microsoft\Office\15.0\CleanC2R", "Rerun", sValue, "REG_DWORD") Then
2258' oWShell.Popup "System reboot complete. OffScrub will now prompt for elevation!", 10, SCRIPTNAME & " - NOTE!"
2259' End If
2260
2261 ' launch the elevated instance
2262 oShell.ShellExecute "cscript.exe", sCmdLine & " /NoElevate UAC", "", "runas", 1
2263 ' get the process id of the spawned instance
2264 WScript.Sleep 500
2265 Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process WHERE ParentProcessId='" & iParentProcessId & "'")
2266 If Processes.Count > 0 Then
2267 For Each Process in Processes
2268 iSpawnedProcessId = Process.ProcessId
2269 Exit For
2270 Next 'Process
2271 ' monitor the tasklist to detect the end of the spawned process
2272 While oWmiLocal.ExecQuery("Select * From Win32_Process WHERE ProcessId='" & iSpawnedProcessId & "'").Count > 0
2273 WScript.Sleep 3000
2274 Wend
2275 ' get the return value from the file
2276 Wscript.Quit GetRetValFromFile
2277 End If
2278 ' elevation failed (user declined)
2279 SetError ERROR_ELEVATION_USERDECLINED
2280End Sub 'RelaunchElevated
2281
2282'-------------------------------------------------------------------------------
2283' RelaunchAsCScript
2284'
2285' Relaunch self with Cscript as host
2286'-------------------------------------------------------------------------------
2287Sub RelaunchAsCScript
2288 Dim Argument
2289 Dim sCmdLine
2290 Dim fQuietNoCScript
2291
2292 fQuietNoCScript = False
2293 SetError ERROR_RELAUNCH
2294 sCmdLine = "cmd.exe /c " & WScript.Path & "\cscript.exe //NOLOGO " & Chr(34) & WScript.scriptFullName & Chr(34)
2295 If Wscript.Arguments.Count > 0 Then
2296 For Each Argument in Wscript.Arguments
2297 sCmdLine = sCmdLine & " " & chr(34) & Argument & chr(34)
2298 Select Case UCase(Argument)
2299 Case "/Q","/QUIET"
2300 fQuietNoCScript = True
2301 ClearError ERROR_RELAUNCH
2302 End Select
2303 Next 'Argument
2304 End If
2305 sCmdLine = sCmdLine & " " & chr(34) & "/ChangedScriptHost" & chr(34)
2306
2307 If NOT fQuietNoCScript Then Wscript.Quit CLng(oWShell.Run(sCmdLine, 1, True))
2308End Sub 'RelaunchAsCScript
2309
2310'-------------------------------------------------------------------------------
2311' SetError
2312'
2313' Set error bit(s)
2314'-------------------------------------------------------------------------------
2315Sub SetError(ErrorBit)
2316 iError = iError OR ErrorBit
2317 Select Case ErrorBit
2318 Case ERROR_DCAF_FAILURE, ERROR_STAGE2, ERROR_ELEVATION_USERDECLINED, ERROR_ELEVATION, ERROR_SCRIPTINIT
2319 iError = iError OR ERROR_FAIL
2320 End Select
2321End Sub
2322
2323'-------------------------------------------------------------------------------
2324' ClearError
2325'
2326' Unset error bit(s)
2327'-------------------------------------------------------------------------------
2328Sub ClearError(ErrorBit)
2329 iError = iError AND (ERROR_ALL - ErrorBit)
2330 Select Case ErrorBit
2331 Case ERROR_ELEVATION_USERDECLINED, ERROR_ELEVATION, ERROR_SCRIPTINIT
2332 iError = iError AND (ERROR_ALL - ERROR_FAIL)
2333 End Select
2334End Sub
2335
2336'-------------------------------------------------------------------------------
2337' SetRetVal
2338'
2339' Write return value to file
2340'-------------------------------------------------------------------------------
2341Sub SetRetVal(iError)
2342 Dim RetValFileStream
2343
2344 'don't fail script execution if writing the return value to file fails
2345 On Error Resume Next
2346
2347 Set RetValFileStream = oFso.createTextFile(sScrubDir & "\" & RETVALFILE, True, True)
2348 RetValFileStream.Write iError
2349 RetValFileStream.Close
2350 On Error Goto 0
2351End Sub 'SetRetVal
2352
2353'-------------------------------------------------------------------------------
2354' GetRetValFromFile
2355'
2356' Read return value from file.
2357' Used to ensure return value can get obtained from an elevated process
2358'-------------------------------------------------------------------------------
2359Function GetRetValFromFile ()
2360 Dim RetValFileStream
2361 Dim iRetValFromFile
2362
2363 On Error Resume Next 'don't fail script execution when getting the return value from file fails
2364
2365 If oFso.FileExists(sScrubDir & "\" & RETVALFILE) Then
2366 Set RetValFileStream = oFso.OpenTextFile(sScrubDir & "\" & RETVALFILE, 1, False, -2)
2367 GetRetValFromFile = RetValFileStream.ReadAll
2368 RetValFileStream.Close
2369 Exit Function
2370 End If
2371 Err.Clear
2372 On Error Goto 0
2373 GetRetValFromFile = ERROR_UNKNOWN
2374End Function 'GetRetValFromFile
2375
2376'-------------------------------------------------------------------------------
2377' CreateLog
2378'
2379' Create the removal log file
2380'-------------------------------------------------------------------------------
2381Sub CreateLog
2382 Dim DateTime
2383 Dim sLogName
2384
2385 On Error Resume Next
2386 ' create the log file
2387 Set DateTime = CreateObject("WbemScripting.SWbemDateTime")
2388 DateTime.SetVarDate Now, True
2389 sLogName = sLogDir & "\" & oWShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
2390 sLogName = sLogName & "_" & Left(DateTime.Value, 14)
2391 sLogName = sLogName & "_ScrubLog.txt"
2392 Err.Clear
2393 Set LogStream = oFso.CreateTextFile(sLogName, True, True)
2394 If Err <> 0 Then
2395 Err.Clear
2396 sLogDir = sScrubDir
2397 sLogName = sLogDir & "\" & oWShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
2398 sLogName = sLogName & "_" & Left(DateTime.Value, 14)
2399 sLogName = sLogName & "_ScrubLog.txt"
2400 Set LogStream = oFso.CreateTextFile(sLogName, True, True)
2401 End If
2402 On Error Goto 0
2403
2404 LogH2 "Microsoft Customer Support Services - " & ONAME & " Removal Utility" & vbCrLf & vbCrLf & _
2405 "Version: " & vbTab & SCRIPTVERSION & vbCrLf & _
2406 "64 bit OS: " & vbTab & f64 & vbCrLf & _
2407 "Removal start: " & vbTab & Time
2408 LogH2 "OS Details: " & sOSinfo & vbCrLf
2409 fLogInitialized = True
2410End Sub 'CreateLog
2411
2412'-------------------------------------------------------------------------------
2413' HiveString
2414'
2415' Translates the numeric constant into the human readable registry hive string
2416'-------------------------------------------------------------------------------
2417Function HiveString(hDefKey)
2418 Select Case hDefKey
2419 Case HKCR : HiveString = "HKEY_CLASSES_ROOT"
2420 Case HKCU : HiveString = "HKEY_CURRENT_USER"
2421 Case HKLM : HiveString = "HKEY_LOCAL_MACHINE"
2422 Case HKU : HiveString = "HKEY_USERS"
2423 Case Else : HiveString = hDefKey
2424 End Select
2425End Function
2426
2427'-------------------------------------------------------------------------------
2428' RegKeyExists
2429'
2430' Returns a boolean for the test on existence of a given registry key
2431'-------------------------------------------------------------------------------
2432Function RegKeyExists(hDefKey, sSubKeyName)
2433 Dim arrKeys
2434 RegKeyExists = False
2435 If oReg.EnumKey(hDefKey, sSubKeyName, arrKeys) = 0 Then RegKeyExists = True
2436End Function
2437
2438'-------------------------------------------------------------------------------
2439' RegValExists
2440'
2441' Returns a boolean for the test on existence of a given registry value
2442'-------------------------------------------------------------------------------
2443Function RegValExists(hDefKey,sSubKeyName,sName)
2444 Dim arrValueTypes, arrValueNames
2445 Dim i
2446
2447 RegValExists = False
2448 If Not RegKeyExists(hDefKey,sSubKeyName) Then Exit Function
2449 If oReg.EnumValues(hDefKey,sSubKeyName,arrValueNames,arrValueTypes) = 0 AND IsArray(arrValueNames) Then
2450 For i = 0 To UBound(arrValueNames)
2451 If LCase(arrValueNames(i)) = Trim(LCase(sName)) Then RegValExists = True
2452 Next
2453 End If 'oReg.EnumValues
2454End Function
2455
2456'-------------------------------------------------------------------------------
2457' RegReadValue
2458'
2459' Read the value of a given registry entry
2460' The correct type has to be passed in as argument
2461'-------------------------------------------------------------------------------
2462Function RegReadValue(hDefKey, sSubKeyName, sName, sValue, sType)
2463 Dim RetVal
2464 Dim Item
2465 Dim arrValues
2466
2467 Select Case UCase(sType)
2468 Case "1", "REG_SZ"
2469 RetVal = oReg.GetStringValue(hDefKey, sSubKeyName, sName, sValue)
2470 If Not RetVal = 0 AND f64 Then RetVal = oReg.GetStringValue(hDefKey, Wow64Key(hDefKey, sSubKeyName), sName, sValue)
2471 Case "2", "REG_EXPAND_SZ"
2472 RetVal = oReg.GetExpandedStringValue(hDefKey, sSubKeyName, sName, sValue)
2473 If NOT RetVal = 0 AND f64 Then RetVal = oReg.GetExpandedStringValue(hDefKey, Wow64Key(hDefKey, sSubKeyName), sName, sValue)
2474 Case "3", "REG_BINARY"
2475 RetVal = oReg.GetBinaryValue(hDefKey, sSubKeyName, sName, sValue)
2476 If NOT RetVal = 0 AND f64 Then RetVal = oReg.GetBinaryValue(hDefKey, Wow64Key(hDefKey, sSubKeyName), sName, sValue)
2477 Case "4", "REG_DWORD"
2478 RetVal = oReg.GetDWORDValue(hDefKey, sSubKeyName, sName, sValue)
2479 If NOT RetVal = 0 AND f64 Then RetVal = oReg.GetDWORDValue(hDefKey, Wow64Key(hDefKey, sSubKeyName), sName, sValue)
2480 Case "7", "REG_MULTI_SZ"
2481 RetVal = oReg.GetMultiStringValue(hDefKey, sSubKeyName, sName, arrValues)
2482 If NOT RetVal = 0 AND f64 Then RetVal = oReg.GetMultiStringValue(hDefKey, Wow64Key(hDefKey, sSubKeyName), sName, arrValues)
2483 If RetVal = 0 Then sValue = Join(arrValues, chr(13))
2484 Case Else
2485 RetVal = -1
2486 End Select 'sValue
2487
2488 RegReadValue = (RetVal = 0)
2489End Function 'RegReadValue
2490
2491'-------------------------------------------------------------------------------
2492' RegEnumValues
2493'
2494' Enumerate a registry key to return all values
2495'-------------------------------------------------------------------------------
2496Function RegEnumValues(hDefKey, sSubKeyName, arrNames, arrTypes)
2497 Dim RetVal, RetVal64
2498 Dim arrNames32, arrNames64, arrTypes32, arrTypes64
2499
2500 If f64 Then
2501 RetVal = oReg.EnumValues(hDefKey, sSubKeyName, arrNames32, arrTypes32)
2502 RetVal64 = oReg.EnumValues(hDefKey, Wow64Key(hDefKey, sSubKeyName), arrNames64, arrTypes64)
2503 If (RetVal = 0) AND (NOT RetVal64 = 0) AND IsArray(arrNames32) AND IsArray(arrTypes32) Then
2504 arrNames = arrNames32
2505 arrTypes = arrTypes32
2506 End If
2507 If (NOT RetVal = 0) AND (RetVal64 = 0) AND IsArray(arrNames64) AND IsArray(arrTypes64) Then
2508 arrNames = arrNames64
2509 arrTypes = arrTypes64
2510 End If
2511 If (RetVal = 0) AND (RetVal64 = 0) AND IsArray(arrNames32) AND IsArray(arrNames64) AND IsArray(arrTypes32) AND IsArray(arrTypes64) Then
2512 arrNames = RemoveDuplicates(Split((Join(arrNames32, "\") & "\" & Join(arrNames64, "\")), "\"))
2513 arrTypes = RemoveDuplicates(Split((Join(arrTypes32, "\") & "\" & Join(arrTypes64, "\")), "\"))
2514 End If
2515 Else
2516 RetVal = oReg.EnumValues(hDefKey, sSubKeyName, arrNames, arrTypes)
2517 End If 'f64
2518 RegEnumValues = ((RetVal = 0) OR (RetVal64 = 0)) AND IsArray(arrNames) AND IsArray(arrTypes)
2519End Function 'RegEnumValues
2520
2521'-------------------------------------------------------------------------------
2522' RegEnumKey
2523'
2524' Enumerate a registry key to return all subkeys
2525'-------------------------------------------------------------------------------
2526Function RegEnumKey(hDefKey, sSubKeyName, arrKeys)
2527 Dim RetVal, RetVal64
2528 Dim arrKeys32, arrKeys64
2529
2530 If f64 Then
2531 RetVal = oReg.EnumKey(hDefKey, sSubKeyName, arrKeys32)
2532 RetVal64 = oReg.EnumKey(hDefKey, Wow64Key(hDefKey, sSubKeyName), arrKeys64)
2533 If (RetVal = 0) AND (NOT RetVal64 = 0) AND IsArray(arrKeys32) Then arrKeys = arrKeys32
2534 If (Not RetVal = 0) AND (RetVal64 = 0) AND IsArray(arrKeys64) Then arrKeys = arrKeys64
2535 If (RetVal = 0) AND (RetVal64 = 0) Then
2536 If IsArray(arrKeys32) AND IsArray (arrKeys64) Then
2537 arrKeys = RemoveDuplicates(Split((Join(arrKeys32, "\") & "\" & Join(arrKeys64, "\")), "\"))
2538 ElseIf IsArray(arrKeys64) Then
2539 arrKeys = arrKeys64
2540 Else
2541 arrKeys = arrKeys32
2542 End If
2543 End If
2544 Else
2545 RetVal = oReg.EnumKey(hDefKey, sSubKeyName, arrKeys)
2546 End If 'f64
2547 RegEnumKey = ((RetVal = 0) OR (RetVal64 = 0)) AND IsArray(arrKeys)
2548End Function 'RegEnumKey
2549
2550'-------------------------------------------------------------------------------
2551' RegDeleteValue
2552'
2553' Wrapper around oReg.DeleteValue to handle 64 bit
2554'-------------------------------------------------------------------------------
2555Sub RegDeleteValue(hDefKey, sSubKeyName, sName, fRegMultiSZ)
2556 Dim sDelKeyName, sValue
2557 Dim iRetVal
2558 Dim fKeep
2559
2560 ' ensure trailing "\"
2561 sSubKeyName = sSubKeyName & "\"
2562 While InStr(sSubKeyName, "\\") > 0
2563 sSubKeyName = Replace(sSubKeyName, "\\", "\")
2564 Wend
2565
2566 fKeep = dicKeepReg.Exists(LCase(sSubKeyName & sName))
2567 If (NOT fKeep AND f64) Then fKeep = dicKeepReg.Exists(LCase(Wow64Key(hDefKey, sSubKeyName) & sName))
2568 If fKeep Then
2569 LogOnly "Disallowing the delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyName & sName
2570 If NOT fForce Then Exit Sub
2571 End If
2572
2573 ' check on forced delete
2574 If fKeep Then
2575 LogOnly "Enforced delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyName & sName
2576 LogOnly " Remaining applications will need a repair!"
2577 End If
2578
2579 ' ensure value exists
2580 If RegValExists(hDefKey, sSubKeyName, sName) Then
2581 sDelKeyName = sSubKeyName
2582 ElseIf RegValExists(hDefKey, Wow64Key(hDefKey, sSubKeyName), sName) Then
2583 sDelKeyName = Wow64Key(hDefKey, sSubKeyName)
2584 Else
2585 LogOnly "Value not found. Cannot delete value: " & HiveString(hDefKey) & "\" & sSubKeyName & sName
2586 Exit Sub
2587 End If
2588
2589 ' prevent unintentional, unsafe REG_MULTI_SZ delete
2590 If RegReadValue(hDefKey, sDelKeyName, sName, sValue, "REG_MULTI_SZ") AND NOT fRegMultiSZ Then
2591 LogOnly "Disallowing unsafe delete of REG_MULTI_SZ: " & HiveString(hDefKey) & "\" & sDelKeyName & sName
2592 Exit Sub
2593 End If
2594
2595 ' execute delete operation
2596 If Not fDetectOnly Then
2597 LogOnly "Delete registry value: " & HiveString(hDefKey) & "\" & sDelKeyName & " -> " & sName
2598 iRetVal = 0
2599 iRetVal = oReg.DeleteValue(hDefKey, sDelKeyName, sName)
2600 CheckError "RegDeleteValue"
2601 If NOT (iRetVal = 0) Then
2602 LogOnly " Delete failed. Return value: " & iRetVal
2603 SetError ERROR_STAGE2
2604 End If
2605 Else
2606 LogOnly "Preview mode. Disallowing delete registry value: " & HiveString(hDefKey) & "\" & sDelKeyName & " -> " & sName
2607 End If
2608 On Error Goto 0
2609
2610End Sub 'RegDeleteValue
2611
2612'-------------------------------------------------------------------------------
2613' RegDeleteKey
2614'
2615' Wrappper around RegDeleteKeyEx to handle 64bit
2616'-------------------------------------------------------------------------------
2617Sub RegDeleteKey(hDefKey, sSubKeyName)
2618 Dim sDelKeyName
2619 Dim fKeep
2620
2621 ' ensure trailing "\"
2622 sSubKeyName = sSubKeyName & "\"
2623 While InStr(sSubKeyName, "\\") > 0
2624 sSubKeyName = Replace(sSubKeyName, "\\", "\")
2625 Wend
2626
2627 fKeep = dicKeepReg.Exists(LCase(sSubKeyName))
2628 If (NOT fKeep AND f64) Then fKeep = dicKeepReg.Exists(LCase(Wow64Key(hDefKey, sSubKeyName)))
2629 If fKeep Then
2630 LogOnly "Disallowing the delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyName
2631 If NOT fForce Then Exit Sub
2632 End If
2633
2634 ' check on forced delete
2635 If fKeep Then
2636 LogOnly "Enforced delete of still required keypath element: " & HiveString(hDefKey) & "\" & sSubKeyName
2637 LogOnly " Remaining applications will need a repair!"
2638 End If
2639
2640 If Len(sSubKeyName) > 1 Then
2641 'Strip of trailing "\"
2642 sSubKeyName = Left(sSubKeyName, Len(sSubKeyName) - 1)
2643 End If
2644
2645 ' ensure key exists
2646 If RegKeyExists(hDefKey, sSubKeyName) Then
2647 sDelKeyName = sSubKeyName
2648 ElseIf f64 AND RegKeyExists(hDefKey, Wow64Key(hDefKey, sSubKeyName)) Then
2649 sDelKeyName = Wow64Key(hDefKey, sSubKeyName)
2650 Else
2651 LogOnly "Key not found. Cannot delete key: " & HiveString(hDefKey) & "\" & sSubKeyName
2652 Exit Sub
2653 End If
2654
2655 ' execute delete
2656 If Not fDetectOnly Then
2657 LogOnly "Delete registry key: " & HiveString(hDefKey) & "\" & sDelKeyName
2658 On Error Resume Next
2659 RegDeleteKeyEx hDefKey, sDelKeyName
2660 On Error Goto 0
2661 Else
2662 LogOnly "Preview mode. Disallowing delete of registry key: " & HiveString(hDefKey) & "\" & sSubKeyName
2663 End If
2664End Sub 'RegDeleteKey
2665
2666'-------------------------------------------------------------------------------
2667' RegDeleteKeyEx
2668'
2669' Recursively delete a registry structure
2670'-------------------------------------------------------------------------------
2671Sub RegDeleteKeyEx(hDefKey, sSubKeyName)
2672 Dim arrSubkeys
2673 Dim sSubkey
2674 Dim iRetVal
2675
2676 'Strip of trailing "\"
2677 If Len(sSubKeyName) > 1 Then
2678 If Right(sSubKeyName, 1) = "\" Then sSubKeyName = Left(sSubKeyName, Len(sSubKeyName) - 1)
2679 End If
2680 On Error Resume Next
2681
2682 ' exception handler
2683 If (hDefKey = HKLM) AND (sSubKeyName = "SOFTWARE\Microsoft\Office\15.0\ClickToRun") Then
2684 iRetVal = oWShell.Run("reg delete HKLM\SOFTWARE\Microsoft\Office\15.0\ClickToRun /f", 0, True)
2685 Exit Sub
2686 End If
2687
2688 ' regular recursion
2689 oReg.EnumKey hDefKey, sSubKeyName, arrSubkeys
2690 If IsArray(arrSubkeys) Then
2691 For Each sSubkey In arrSubkeys
2692 RegDeleteKeyEx hDefKey, sSubKeyName & "\" & sSubkey
2693 Next
2694 End If
2695 If Not fDetectOnly Then
2696 iRetVal = 0
2697 iRetVal = oReg.DeleteKey(hDefKey, sSubKeyName)
2698 If NOT (iRetVal = 0) Then LogOnly " Delete failed. Return value: "&iRetVal
2699 End If
2700 On Error Goto 0
2701End Sub 'RegDeleteKeyEx
2702
2703'-------------------------------------------------------------------------------
2704' Wow64Key
2705'
2706' Return the 32bit regkey location on a 64bit environment
2707'-------------------------------------------------------------------------------
2708Function Wow64Key(hDefKey, sSubKeyName)
2709 Dim iPos
2710
2711 Select Case hDefKey
2712 Case HKCU
2713 If Left(sSubKeyName, 17) = "Software\Classes\" Then
2714 Wow64Key = Left(sSubKeyName, 17) & "Wow6432Node\" & Right(sSubKeyName, Len(sSubKeyName) - 17)
2715 Else
2716 iPos = InStr(sSubKeyName, "\")
2717 Wow64Key = Left(sSubKeyName, iPos) & "Wow6432Node\" & Right(sSubKeyName, Len(sSubKeyName) - iPos)
2718 End If
2719 Case HKLM
2720 If Left(sSubKeyName, 17) = "Software\Classes\" Then
2721 Wow64Key = Left(sSubKeyName, 17) & "Wow6432Node\" & Right(sSubKeyName, Len(sSubKeyName) - 17)
2722 Else
2723 iPos = InStr(sSubKeyName, "\")
2724 Wow64Key = Left(sSubKeyName, iPos) & "Wow6432Node\" & Right(sSubKeyName, Len(sSubKeyName) - iPos)
2725 End If
2726 Case Else
2727 Wow64Key = "Wow6432Node\" & sSubKeyName
2728 End Select 'hDefKey
2729End Function 'Wow64Key
2730
2731'-------------------------------------------------------------------------------
2732' RemoveDuplicates
2733'
2734' Remove duplicate entries from a one dimensional array
2735'-------------------------------------------------------------------------------
2736Function RemoveDuplicates(Array)
2737 Dim Item
2738 Dim dicNoDupes
2739
2740 Set dicNoDupes = CreateObject("Scripting.Dictionary")
2741 For Each Item in Array
2742 If Not dicNoDupes.Exists(Item) Then dicNoDupes.Add Item,Item
2743 Next 'Item
2744 RemoveDuplicates = dicNoDupes.Keys
2745End Function 'RemoveDuplicates
2746
2747'-------------------------------------------------------------------------------
2748' CheckError
2749'
2750' Checks the status of 'Err' and logs the error details if <> 0
2751'-------------------------------------------------------------------------------
2752Sub CheckError(sModule)
2753 If Err <> 0 Then
2754 LogOnly " Error: " & sModule & " - Source: " & Err.Source & "; Err# (Hex): " & Hex( Err ) & _
2755 "; Err# (Dec): " & Err & "; Description : " & Err.Description
2756 End If 'Err = 0
2757 Err.Clear
2758End Sub
2759
2760'-------------------------------------------------------------------------------
2761' LogH
2762'
2763' Write a header log string to the log file
2764'-------------------------------------------------------------------------------
2765Sub LogH (sLog)
2766 LogStream.WriteLine ""
2767 sLog = sLog & vbCrLf & String(Len(sLog), "=")
2768 If NOT fQuiet AND fCScript Then wscript.echo ""
2769 If NOT fQuiet AND fCScript Then wscript.echo sLog
2770 LogStream.WriteLine sLog
2771End Sub 'Logh
2772
2773'-------------------------------------------------------------------------------
2774' LogH1
2775'
2776' Write a header log string to the log file
2777'-------------------------------------------------------------------------------
2778Sub LogH1 (sLog)
2779 LogStream.WriteLine ""
2780 sLog = sLog & vbCrLf & String(Len(sLog), "-")
2781 If NOT fQuiet AND fCScript Then wscript.echo ""
2782 If NOT fQuiet AND fCScript Then wscript.echo sLog
2783 LogStream.WriteLine sLog
2784End Sub 'LogH1
2785
2786'-------------------------------------------------------------------------------
2787' LogH2
2788'
2789' Write w/o indent Cmd window and the log file
2790'-------------------------------------------------------------------------------
2791Sub LogH2 (sLog)
2792 If NOT fQuiet AND fCScript Then wscript.echo sLog
2793 LogStream.WriteLine ""
2794 LogStream.WriteLine sLog
2795End Sub 'LogH2
2796
2797'-------------------------------------------------------------------------------
2798' Log
2799'
2800' Echos the log string to the Cmd window and the log file
2801'-------------------------------------------------------------------------------
2802Sub Log (sLog)
2803 If NOT fQuiet AND fCScript Then wscript.echo sLog
2804 If sLog = "" Then
2805 LogStream.WriteLine
2806 Else
2807 LogStream.WriteLine " " & Time & ": " & sLog
2808 End If
2809End Sub 'Log
2810
2811'-------------------------------------------------------------------------------
2812' LogOnly
2813'
2814' Commits the log string to the log file
2815'-------------------------------------------------------------------------------
2816Sub LogOnly (sLog)
2817 If sLog = "" Then
2818 LogStream.WriteLine
2819 Else
2820 LogStream.WriteLine " " & Time & ": " & sLog
2821 End If
2822End Sub 'Log
2823
2824
2825Sub LogY (sLog)
2826 LogPipe sLog
2827End Sub
2828
2829Sub LogPipe (sLog)
2830 Err.Clear
2831 On Error Resume Next
2832 'wscript.Echo "Here"
2833 'wscript.Echo sLog
2834
2835
2836 Set fs = CreateObject("Scripting.FileSystemObject")
2837 Set pipeStream = fs.CreateTextFile("\\.\pipe\offscrub_pipe", True)
2838 pipeStream.WriteLine(sLog)
2839 pipeStream.Close()
2840 WScript.Sleep 5000
2841
2842 If Err <> 0 Then
2843 'wscript.Echo Err.Source
2844 'wscript.echo Err.Description
2845 'Wscript.Quit
2846 End If 'Err = 0
2847End Sub
2848
2849'-------------------------------------------------------------------------------
2850' InScope
2851'
2852' Check if ProductCode is in scope for removal
2853'-------------------------------------------------------------------------------
2854'Check if ProductCode is in scope
2855Function InScope(sProductCode)
2856 Dim fInScope
2857 Dim sProd
2858
2859 Const OFFICEID = "0000000FF1CE}"
2860
2861 On Error Resume Next
2862
2863 fInScope = False
2864 'LogOnly "Now checking scope of: " & sProductCode
2865 If Len(sProductCode) = 38 Then
2866 'LogOnly "GUID length validated to be 38 characters"
2867 sProd = UCase(sProductCode)
2868 If Right(sProd, PRODLEN) = OFFICEID Then
2869 'LogOnly "Pattern matches " & OFFICEID
2870 If CInt(Mid(sProd, 4, 2)) > 14 Then
2871 If Err <> 0 Then
2872 Err.Clear
2873 Exit Function
2874 End If
2875 'LogOnly "VersionMajor confirmed to be > 14"
2876 Select Case Mid(sProd, 11, 4)
2877 Case "007E", "008F", "008C", "24E1", "237A", "00DD"
2878 'LogOnly "SKUFilter matches scope"
2879 fInScope = True
2880 Case Else
2881 'LogOnly "SKU " & Mid(sProd, 11, 4) & " doesn't match known integration products scope"
2882 End Select
2883 End If
2884 End If
2885 ' Microsoft Online Services Sign-in Assistant (x64 ship and x86 ship)
2886 If sProd = "{6C1ADE97-24E1-4AE4-AEDD-86D3A209CE60}" Then fInScope = True
2887 If sProd = "{9520DDEB-237A-41DB-AA20-F2EF2360DCEB}" Then fInScope = True
2888 If sProd = UCase(sPackageGuid) Then fInScope = True
2889 If sProd = UCase("{9AC08E99-230B-47e8-9721-4577B7F124EA}") Then fInScope = True
2890 End If '38
2891
2892 InScope = fInScope
2893End Function 'InScope
2894
2895'-------------------------------------------------------------------------------
2896' CheckDelete
2897'
2898' Check a ProductCode is known to stay installed
2899'-------------------------------------------------------------------------------
2900Function CheckDelete(sProductCode)
2901
2902 CheckDelete = False
2903 ' ensure valid GUID length
2904 If NOT Len(sProductCode) = 38 Then Exit Function
2905 ' only care if it's in the expected ProductCode pattern
2906 If NOT InScope(sProductCode) Then Exit Function
2907 ' check if it's a known product that should be kept
2908 If dicKeepSku.Exists(UCase(sProductCode)) Then Exit Function
2909
2910 CheckDelete = True
2911End Function 'CheckDelete
2912
2913'-------------------------------------------------------------------------------
2914' DeleteService
2915'
2916' Delete a service
2917'-------------------------------------------------------------------------------
2918'Delete a service
2919Sub DeleteService(sName)
2920 Dim Services, srvc, Processes, process
2921 Dim sQuery, sStates, sProcessName, sCmd
2922 Dim iRet
2923
2924 On Error Resume Next
2925
2926 sStates = "STARTED;RUNNING"
2927 sQuery = "Select * From Win32_Service Where Name='" & sName & "'"
2928 Set Services = oWmiLocal.Execquery(sQuery)
2929
2930 ' stop and delete the service
2931 For Each srvc in Services
2932 Log " Found service " & sName & " (" & srvc.DisplayName & ") in state " & srvc.State
2933 ' get the process name
2934 sProcessName = Trim(Replace(Mid(srvc.PathName, InStrRev(srvc.PathName,"\") + 1), chr(34), ""))
2935 ' stop the service
2936 If InStr(sStates, UCase(srvc.State)) > 0 Then
2937 iRet = srvc.StopService()
2938 LogOnly " attempt to stop service " & sName & " returned: " & iRet
2939 End If
2940 ' ensure no more instances of the service are running
2941 Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name='" & sProcessName & "'")
2942 For Each process in Processes
2943 iRet = process.Terminate()
2944 Next 'Process
2945 If fDetectOnly Then
2946 Log " Not deleting service " & sName & " in preview mode"
2947 Exit Sub
2948 End If
2949 iRet = srvc.Delete()
2950 Log " Delete service " & sName & " returned: " & iRet
2951 Next 'srvc
2952
2953 ' check if service got deleted
2954 Set Services = oWmiLocal.Execquery(sQuery)
2955 For Each srvc in Services
2956 ' failed to delete service. retry with 'sc' command
2957 sLog "Delete service " & sName & " failed."
2958 sLog "Retry delete using 'SC' command"
2959 sCmd = "sc delete " & sName
2960 iRet = oWShell.Run(sCmd, 0, True)
2961 Next 'srvc
2962
2963 Set Services = Nothing
2964 Err.Clear
2965 On Error Goto 0
2966End Sub 'DeleteService
2967
2968
2969'-------------------------------------------------------------------------------
2970' SetupRetVal
2971'
2972' Translation for known uninstall return values
2973'-------------------------------------------------------------------------------
2974Function SetupRetVal(RetVal)
2975 Select Case RetVal
2976 Case 0 : SetupRetVal = "Success"
2977 'msiexec return values
2978 Case 1259 : SetupRetVal = "APPHELP_BLOCK"
2979 Case 1601 : SetupRetVal = "INSTALL_SERVICE_FAILURE"
2980 Case 1602 : SetupRetVal = "INSTALL_USEREXIT"
2981 Case 1603 : SetupRetVal = "INSTALL_FAILURE"
2982 Case 1604 : SetupRetVal = "INSTALL_SUSPEND"
2983 Case 1605 : SetupRetVal = "UNKNOWN_PRODUCT"
2984 Case 1606 : SetupRetVal = "UNKNOWN_FEATURE"
2985 Case 1607 : SetupRetVal = "UNKNOWN_COMPONENT"
2986 Case 1608 : SetupRetVal = "UNKNOWN_PROPERTY"
2987 Case 1609 : SetupRetVal = "INVALID_HANDLE_STATE"
2988 Case 1610 : SetupRetVal = "BAD_CONFIGURATION"
2989 Case 1611 : SetupRetVal = "INDEX_ABSENT"
2990 Case 1612 : SetupRetVal = "INSTALL_SOURCE_ABSENT"
2991 Case 1613 : SetupRetVal = "INSTALL_PACKAGE_VERSION"
2992 Case 1614 : SetupRetVal = "PRODUCT_UNINSTALLED"
2993 Case 1615 : SetupRetVal = "BAD_QUERY_SYNTAX"
2994 Case 1616 : SetupRetVal = "INVALID_FIELD"
2995 Case 1618 : SetupRetVal = "INSTALL_ALREADY_RUNNING"
2996 Case 1619 : SetupRetVal = "INSTALL_PACKAGE_OPEN_FAILED"
2997 Case 1620 : SetupRetVal = "INSTALL_PACKAGE_INVALID"
2998 Case 1621 : SetupRetVal = "INSTALL_UI_FAILURE"
2999 Case 1622 : SetupRetVal = "INSTALL_LOG_FAILURE"
3000 Case 1623 : SetupRetVal = "INSTALL_LANGUAGE_UNSUPPORTED"
3001 Case 1624 : SetupRetVal = "INSTALL_TRANSFORM_FAILURE"
3002 Case 1625 : SetupRetVal = "INSTALL_PACKAGE_REJECTED"
3003 Case 1626 : SetupRetVal = "FUNCTION_NOT_CALLED"
3004 Case 1627 : SetupRetVal = "FUNCTION_FAILED"
3005 Case 1628 : SetupRetVal = "INVALID_TABLE"
3006 Case 1629 : SetupRetVal = "DATATYPE_MISMATCH"
3007 Case 1630 : SetupRetVal = "UNSUPPORTED_TYPE"
3008 Case 1631 : SetupRetVal = "CREATE_FAILED"
3009 Case 1632 : SetupRetVal = "INSTALL_TEMP_UNWRITABLE"
3010 Case 1633 : SetupRetVal = "INSTALL_PLATFORM_UNSUPPORTED"
3011 Case 1634 : SetupRetVal = "INSTALL_NOTUSED"
3012 Case 1635 : SetupRetVal = "PATCH_PACKAGE_OPEN_FAILED"
3013 Case 1636 : SetupRetVal = "PATCH_PACKAGE_INVALID"
3014 Case 1637 : SetupRetVal = "PATCH_PACKAGE_UNSUPPORTED"
3015 Case 1638 : SetupRetVal = "PRODUCT_VERSION"
3016 Case 1639 : SetupRetVal = "INVALID_COMMAND_LINE"
3017 Case 1640 : SetupRetVal = "INSTALL_REMOTE_DISALLOWED"
3018 Case 1641 : SetupRetVal = "SUCCESS_REBOOT_INITIATED"
3019 Case 1642 : SetupRetVal = "PATCH_TARGET_NOT_FOUND"
3020 Case 1643 : SetupRetVal = "PATCH_PACKAGE_REJECTED"
3021 Case 1644 : SetupRetVal = "INSTALL_TRANSFORM_REJECTED"
3022 Case 1645 : SetupRetVal = "INSTALL_REMOTE_PROHIBITED"
3023 Case 1646 : SetupRetVal = "PATCH_REMOVAL_UNSUPPORTED"
3024 Case 1647 : SetupRetVal = "UNKNOWN_PATCH"
3025 Case 1648 : SetupRetVal = "PATCH_NO_SEQUENCE"
3026 Case 1649 : SetupRetVal = "PATCH_REMOVAL_DISALLOWED"
3027 Case 1650 : SetupRetVal = "INVALID_PATCH_XML"
3028 Case 3010 : SetupRetVal = "SUCCESS_REBOOT_REQUIRED"
3029 Case Else : SetupRetVal = "Unknown Return Value"
3030 End Select
3031End Function 'SetupRetVal
3032
3033'-------------------------------------------------------------------------------
3034' DeleteFile
3035'
3036' Wrapper to delete a file
3037'-------------------------------------------------------------------------------
3038Sub DeleteFile(sFile)
3039 Dim File, attr
3040 Dim sDelFile, sFileName, sNewPath
3041 Dim fKeep
3042
3043 On Error Resume Next
3044
3045 fKeep = dicKeepFolder.Exists(LCase(sFile))
3046 If (NOT fKeep AND f64) Then fKeep = dicKeepFolder.Exists(LCase(Wow64Folder(sFile)))
3047 If fKeep Then
3048 LogOnly "Disallowing the delete of still required keypath element: " & sFile
3049 If NOT fForce Then Exit Sub
3050 End If
3051
3052 ' check on forced delete
3053 If fKeep Then
3054 LogOnly "Enforced delete of still required keypath element: " & sFile
3055 LogOnly " Remaining applications will need a repair!"
3056 End If
3057
3058 If oFso.FileExists(sFile) Then
3059 sDelFile = sFile
3060 ElseIf f64 AND oFso.FileExists(Wow64Folder(sFile)) Then
3061 sDelFile = Wow64Folder(sFile)
3062 Else
3063 LogOnly "Path not found. Cannot not delete folder: " & sFile
3064 Exit Sub
3065 End If
3066 If Not fDetectOnly Then
3067 LogOnly "Delete file: " & sDelFile
3068 Set File = oFso.GetFile(sDelFile)
3069 ' ensure read-only flag is not set
3070 attr = File.Attributes
3071 If CBool(attr AND 1) Then File.Attributes = attr AND (attr - 1)
3072 ' add folder to empty folder cleanup list
3073 If NOT dicDelFolder.Exists(File.ParentFolder.Path) Then dicDelFolder.Add File.ParentFolder.Path, File.ParentFolder.Path
3074 ' delete the file
3075 sFile = File.Path
3076 File.Delete True
3077 Set File = Nothing
3078 If Err <> 0 Then
3079 CheckError "DeleteFile"
3080 ' schedule file for delete on next reboot
3081 ScheduleDeleteFile sFile
3082 End If 'Err <> 0
3083 Else
3084 LogOnly "Preview mode. Disallowing delete for folder: " & sDelFile
3085 End If
3086 On Error Goto 0
3087End Sub 'DeleteFile
3088
3089'-------------------------------------------------------------------------------
3090' DeleteFolder
3091'
3092' Wrapper to delete a folder
3093'-------------------------------------------------------------------------------
3094Sub DeleteFolder(sFolder)
3095 Dim Folder, fld, attr
3096 Dim sDelFolder, sFolderName, sNewPath, sCmd
3097 Dim fKeep
3098
3099 ' ensure trailing "\"
3100 ' trailing \ is required for dicKeepFolder comparisons
3101 sFolder = sFolder & "\"
3102 While InStr(sFolder,"\\")>0
3103 sFolder = Replace(sFolder,"\\","\")
3104 Wend
3105
3106 ' prevent delete of folders that are known to be still required
3107 fKeep = dicKeepFolder.Exists(LCase(sFolder))
3108 If (NOT fKeep AND f64) Then fKeep = dicKeepFolder.Exists(LCase(Wow64Folder(sFolder)))
3109 If fKeep Then
3110 LogOnly "Disallowing the delete of still required keypath element: " & sFolder
3111 If NOT fForce Then Exit Sub
3112 End If
3113
3114 ' check on forced delete
3115 If fKeep Then
3116 LogOnly "Enforced delete of still required keypath element: " & sFolder
3117 LogOnly " Remaining applications will need a repair!"
3118 End If
3119
3120 ' strip trailing "\"
3121 If Len(sFolder) > 1 Then
3122 sFolder = Left(sFolder, Len(sFolder) - 1)
3123 End If
3124
3125 On Error Resume Next
3126 If oFso.FolderExists(sFolder) Then
3127 sDelFolder = sFolder
3128 ElseIf f64 AND oFso.FolderExists(Wow64Folder(sFolder)) Then
3129 sDelFolder = Wow64Folder(sFolder)
3130 Else
3131 LogOnly "Path not found. Cannot not delete folder: " & sFolder
3132 Exit Sub
3133 End If
3134 If Not fDetectOnly Then
3135 LogOnly "Delete folder: " & sDelFolder
3136 Set Folder = oFso.GetFolder(sDelFolder)
3137 ' ensure to remove read only flag
3138 attr = Folder.Attributes
3139 If CBool(attr AND 1) Then Folder.Attributes = attr AND (attr - 1)
3140 ' add to empty folder cleanup list
3141 If NOT dicDelFolder.Exists(Folder.Path) Then dicDelFolder.Add Folder.Path, Folder.Path
3142 ' delete the folder
3143 ' for performance reasons try 'rd' first
3144 Set Folder = Nothing
3145 sCmd = "cmd.exe /c rd /s " & chr(34) & sDelFolder & chr(34) & " /q"
3146 oWShell.Run sCmd, 0, True
3147 If NOT oFso.FolderExists(sDelFolder) Then Exit Sub
3148
3149 ' rd didn't work check with FileSystemObject
3150 Set Folder = oFso.GetFolder(sDelFolder)
3151 Folder.Delete True
3152 Set Folder = Nothing
3153
3154 ' error handling
3155 If Err <> 0 Then
3156 Select Case Err
3157 Case 70
3158 ' Access Denied
3159 ' Retry after closing running processes
3160 CheckError "DeleteFolder"
3161 If NOT fRerun Then
3162 CloseOfficeApps
3163 ' attempt 'rd' command
3164 LogOnly " Attempt to remove with 'rd' command"
3165 sCmd = "cmd.exe /c rd /s " & chr(34) & sDelFolder & chr(34) & " /q"
3166 oWShell.Run sCmd, 0, True
3167 If NOT oFso.FolderExists(sDelFolder) Then Exit Sub
3168 End If
3169
3170 Case 76
3171 ' check on invalid path lengt issues Err 76 (0x4C) "Path not found"
3172 ' attempt 'rd' command
3173 CheckError "DeleteFolder"
3174 LogOnly " Attempt to remove with 'rd' command"
3175 sCmd = "cmd.exe /c rd /s " & chr(34) & sDelFolder & chr(34) & " /q"
3176 oWShell.Run sCmd, 0, True
3177 If NOT oFso.FolderExists(sDelFolder) Then Exit Sub
3178 End Select
3179
3180 ' stil failed!
3181 Log " Failed to delete folder: " & sDelFolder
3182 CheckError "DeleteFolder"
3183
3184 ' try to delete as many folder contents as possible
3185 ' before the recursive error handling is called
3186 Set Folder = oFso.GetFolder(sDelFolder)
3187 For Each fld in Folder.Subfolders
3188 sCmd = "cmd.exe /c rd /s " & chr(34) & fld.Path & chr(34) & " /q"
3189 oWShell.Run sCmd, 0, True
3190 Next 'fld
3191 sCmd = "cmd.exe /c del " & chr(34) & fld.Path & "\*.*" & chr(34)
3192 oWShell.Run sCmd, 0, True
3193 Set Folder = Nothing
3194
3195 ' schedule an additional run of the tool after reboot
3196 If NOT fRerun Then Rerun
3197
3198 ' schedule folder for delete on next reboot
3199 ScheduleDeleteFolder sDelFolder
3200 End If 'Err <> 0
3201 Else
3202 LogOnly "Preview mode. Disallowing delete of folder: " & sDelFolder
3203 End If
3204 On Error Goto 0
3205End Sub 'DeleteFolder
3206
3207Sub DeleteFolder_WMI (sFolder)
3208 Dim Folder, Folders
3209 Dim sWqlFolder
3210 Dim iRet
3211
3212 sWqlFolder = Replace(sFolder, "\", "\\")
3213 Set Folders = oWmiLocal.ExecQuery ("Select * from Win32_Directory where name = '" & sWqlFolder & "'")
3214 For Each Folder in Folders
3215 iRet = Folder.Delete
3216 Next 'Folder
3217 LogOnly " Delete (wmi) for folder " & sFolder & " returned: " & iRet
3218End Sub
3219
3220'-------------------------------------------------------------------------------
3221' Wow64Folder
3222'
3223' Returns the WOW folder structure to handle folder-path operations on
3224' 64 bit environments
3225'-------------------------------------------------------------------------------
3226Function Wow64Folder(sFolder)
3227 If LCase(Left(sFolder, Len(sWinDir & "\System32"))) = LCase(sWinDir & "\System32") Then
3228 Wow64Folder = sWinDir & "\syswow64" & Right(sFolder, Len(sFolder) - Len(sWinDir & "\System32"))
3229 ElseIf LCase(Left(sFolder, Len(sProgramFiles))) = LCase(sProgramFiles) Then
3230 Wow64Folder = sProgramFilesX86 & Right(sFolder, Len(sFolder) - Len(sProgramFiles))
3231 Else
3232 Wow64Folder = "?" 'Return invalid string to ensure the folder cannot exist
3233 End If
3234End Function 'Wow64Folder
3235
3236'-------------------------------------------------------------------------------
3237' ScheduleDeleteFile
3238'
3239' Adds a file to the list of items to delete on reboot
3240'-------------------------------------------------------------------------------
3241Sub ScheduleDeleteFile (sFile)
3242 If NOT dicDelInUse.Exists(sFile) Then dicDelInUse.Add sFile, sFile Else Exit Sub
3243 LogOnly "Add file in use for delete on reboot: " & sFile
3244 fRebootRequired = True
3245 SetError ERROR_REBOOT_REQUIRED
3246End Sub 'ScheduleDeleteFile
3247
3248'-------------------------------------------------------------------------------
3249' ScheduleDeleteFolder
3250'
3251' Recursively adds a folder and its contents to the list of
3252' items to delete on reboot
3253'-------------------------------------------------------------------------------
3254Sub ScheduleDeleteFolder (sFolder)
3255 Dim oFolder, fld, file, attr
3256
3257 Set oFolder = oFso.GetFolder(sFolder)
3258 ' exclude hidden system folders
3259 attr = oFolder.Attributes
3260 If CBool(attr AND 6) Then Exit Sub
3261
3262 For Each fld In oFolder.SubFolders
3263 DeleteFolder fld.Path
3264 Next
3265 For Each file In oFolder.Files
3266 DeleteFile file.Path
3267 Next
3268 If NOT dicDelInUse.Exists(oFolder.Path) Then dicDelInUse.Add oFolder.Path, "" Else Exit Sub
3269 LogOnly "Add folder for delete on reboot: " & oFolder.Path
3270 fRebootRequired = True
3271 SetError ERROR_REBOOT_REQUIRED
3272End Sub 'ScheduleDeleteFile
3273
3274
3275'-------------------------------------------------------------------------------
3276' ScheduleDeleteEx
3277'
3278' Schedules the delete of files/folders in use on next reboot by adding
3279' affected files/folders to the PendingFileRenameOperations registry entry
3280'-------------------------------------------------------------------------------
3281Sub ScheduleDeleteEx ()
3282 Dim key, hDefKey, sKeyName, sValueName
3283 Dim i
3284 Dim arrData
3285
3286 hDefKey = HKLM
3287 sKeyName = "SYSTEM\CurrentControlSet\Control\Session Manager"
3288 sValueName = "PendingFileRenameOperations"
3289
3290 LogH2 "Add " & dicDelInUse.Count & " PendingFileRenameOperations"
3291 If NOT RegValExists(hDefKey, sKeyName, sValueName) Then
3292 ReDim arrData(-1)
3293 Else
3294 oReg.GetMultiStringValue hDefKey, sKeyName, sValueName, arrData
3295 End If
3296 i = UBound(arrData) + 1
3297 ReDim Preserve arrData(UBound(arrData) + (dicDelInUse.Count * 2))
3298 For Each key in dicDelInUse.Keys
3299 LogOnly " " & key
3300 arrData(i) = "\??\" & key
3301 arrData(i + 1) = ""
3302 i = i + 2
3303 Next 'key
3304 oReg.SetMultiStringValue hDefKey, sKeyName, sValueName, arrData
3305End Sub 'ScheduleDeleteEx
3306
3307'-------------------------------------------------------------------------------
3308' DeleteEmptyFolders
3309'
3310' Deletes an individual folder structure if empty
3311'-------------------------------------------------------------------------------
3312Sub DeleteEmptyFolder (sFolder)
3313 Dim Folder
3314
3315 ' cosmetic' task don't fail on error
3316 On Error Resume Next
3317 If oFso.FolderExists(sFolder) Then
3318 Set Folder = oFso.GetFolder(sFolder)
3319 If (Folder.Subfolders.Count = 0) AND (Folder.Files.Count = 0) Then
3320 Set Folder = Nothing
3321 SmartDeleteFolder sFolder
3322 End If
3323 End If
3324 CheckError "DeleteEmptyFolder"
3325 On Error Goto 0
3326End Sub 'DeleteEmptyFolders
3327
3328'-------------------------------------------------------------------------------
3329' DeleteEmptyFolders
3330'
3331' Delete an empty folder structure
3332'-------------------------------------------------------------------------------
3333Sub DeleteEmptyFolders
3334 Dim Folder
3335 Dim sFolder
3336
3337 ' cosmetic' task don't fail on error
3338 On Error Resume Next
3339 DeleteEmptyFolder sCommonProgramFiles & "\Microsoft Shared\Office15"
3340 DeleteEmptyFolder sCommonProgramFiles & "\Microsoft Shared\Office16"
3341 DeleteEmptyFolder sCommonProgramFiles & "\Microsoft Shared\"
3342 DeleteEmptyFolder sProgramFiles & "\Microsoft Office\Office15"
3343 DeleteEmptyFolder sProgramFiles & "\Microsoft Office\Office16"
3344
3345 For Each sFolder in dicDelFolder.Keys
3346 If oFso.FolderExists(sFolder) Then
3347 Set Folder = oFso.GetFolder(sFolder)
3348 If (Folder.Subfolders.Count = 0) AND (Folder.Files.Count = 0) Then
3349 Set Folder = Nothing
3350 SmartDeleteFolder sFolder
3351 End If
3352 End If
3353 Next 'sFolder
3354 CheckError "DeleteEmptyFolders"
3355 On Error Goto 0
3356End Sub 'DeleteEmptyFolders
3357
3358'-------------------------------------------------------------------------------
3359' SmartDeleteFolder
3360'
3361' Wrapper to delete a folder and the empty parent folder structure
3362'-------------------------------------------------------------------------------
3363Sub SmartDeleteFolder(sFolder)
3364 Dim sDelFolder
3365
3366 If oFso.FolderExists(sFolder) Then
3367 sDelFolder = sFolder
3368 ElseIf f64 AND oFso.FolderExists(Wow64Folder(sFolder)) Then
3369 sDelFolder = Wow64Folder(sFolder)
3370 Else
3371 Exit Sub
3372 End If
3373
3374 If Not fDetectOnly Then
3375 LogOnly "Request SmartDelete for folder: " & sDelFolder
3376 SmartDeleteFolderEx sDelFolder
3377 Else
3378 LogOnly "Preview mode. Disallowing SmartDelete request for folder: " & sDelFolder
3379 End If
3380End Sub 'SmartDeleteFolder
3381
3382'-------------------------------------------------------------------------------
3383' SmartDeleteFolderEx
3384'
3385' Executes the folder delete operation(s)
3386'-------------------------------------------------------------------------------
3387Sub SmartDeleteFolderEx(sFolder)
3388 Dim Folder
3389
3390 On Error Resume Next
3391 DeleteFolder sFolder : CheckError "SmartDeleteFolderEx"
3392 On Error Goto 0
3393 Set Folder = oFso.GetFolder(oFso.GetParentFolderName(sFolder))
3394 If (Folder.Subfolders.Count = 0) AND (Folder.Files.Count = 0) Then SmartDeleteFolderEx(Folder.Path)
3395End Sub 'SmartDeleteFolderEx
3396
3397'-------------------------------------------------------------------------------
3398' RestoreExplorer
3399'
3400' Ensure Windows Explorer is restarted if needed
3401'-------------------------------------------------------------------------------
3402Sub RestoreExplorer
3403 Dim Processes, Result, oAT, DateTime, JobID
3404 Dim sCmd
3405
3406 'Non critical routine. Don't fail on error
3407 On Error Resume Next
3408 wscript.sleep 1000
3409 Set Processes = oWmiLocal.ExecQuery("Select * From Win32_Process Where Name='explorer.exe'")
3410 If Processes.Count < 1 Then
3411 oWShell.Run "explorer.exe"
3412 'To handle this in case of System context, schedule and run as interactive task
3413 oWShell.Run "SCHTASKS /Create /TN OffScrEx /TR explorer /SC ONCE /ST 12:00 /IT", 0, True
3414 oWShell.Run "SCHTASKS /Run /TN OffScrEx", 0, True
3415 oWShell.Run "SCHTASKS /Delete /TN OffScrEx /F", 0, False
3416 End If
3417 On Error Goto 0
3418End Sub 'RestoreExploer
3419
3420'-------------------------------------------------------------------------------
3421' MyJoin
3422'
3423' Replacement function to the internal Join function to prevent failures
3424' that were seen in some instances
3425'-------------------------------------------------------------------------------
3426Function MyJoin(arrToJoin, sSeparator)
3427 Dim sJoined
3428 Dim i
3429
3430 sJoined = ""
3431 If IsArray(arrToJoin) Then
3432 For i = 0 To UBound(arrToJoin)
3433 sJoined = sJoined & arrToJoin(i) & sSeparator
3434 Next 'i
3435 End If
3436 If Len(sJoined) > 1 Then sJoined = Left(sJoined, Len(sJoined) - 1)
3437 MyJoin = sJoined
3438End Function
3439
3440'-------------------------------------------------------------------------------
3441' Rerun
3442'
3443' Flag need for reboot and schedule autorun to run the tool again on reboot.
3444'-------------------------------------------------------------------------------
3445Sub Rerun ()
3446 Dim sValue
3447
3448 ' check if Rerun has already been called
3449 If fRerun Then Exit Sub
3450
3451 ' set Rerun flag
3452 fRerun = True
3453
3454 ' check if the previous run already initiated the Rerun
3455 If RegReadValue(HKCU, "SOFTWARE\Microsoft\Office\15.0\CleanC2R", "Rerun", sValue, "REG_DWORD") Then
3456 ' Rerun has already been tried
3457 LogH2 "Error: Removal failed"
3458 SetError ERROR_DCAF_FAILURE
3459 Exit Sub
3460 End If
3461
3462 fRebootRequired = True
3463 SetError ERROR_REBOOT_REQUIRED
3464 SetError ERROR_INCOMPLETE
3465
3466 ' cache the script to the local scrub folder
3467 oFso.CopyFile WScript.scriptFullName, sScrubDir & "\" & SCRIPTFILE
3468
3469 oReg.CreateKey HKLM, "SOFTWARE"
3470 oReg.CreateKey HKLM, "SOFTWARE\Microsoft"
3471 oReg.CreateKey HKLM, "SOFTWARE\Microsoft\Office"
3472 oReg.CreateKey HKLM, "SOFTWARE\Microsoft\Office\15.0"
3473 oReg.CreateKey HKLM, "SOFTWARE\Microsoft\Office\15.0\CleanC2R"
3474 oReg.SetDWordValue HKLM, "SOFTWARE\Microsoft\Office\15.0\CleanC2R", "Rerun", 1
3475
3476 fSetRunOnce = True
3477' oReg.CreateKey HKCU, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce"
3478' oReg.SetStringValue HKCU, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce", "CleanC2R", "cscript.exe " & chr(34) & sScrubDir & "\" & SCRIPTFILE & chr(34)
3479End Sub
3480
3481'-------------------------------------------------------------------------------
3482' SetRunOnce
3483'
3484' Create a RunOnce entry to resume setup after a reboot
3485'-------------------------------------------------------------------------------
3486Sub SetRunOnce
3487 Dim sValue
3488
3489 oReg.CreateKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion"
3490 oReg.CreateKey HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce"
3491 sValue = "cscript.exe " & chr(34) & sScrubDir & "\" & SCRIPTFILE & chr(34) & " /NoElevate /Relaunched"
3492 oReg.SetStringValue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce", "O15CleanUp", sValue
3493
3494End Sub 'SetRunOnce