This repository has been archived by the owner on Jan 14, 2021. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 833
/
OffScrub10.vbs
4742 lines (4241 loc) · 417 KB
/
OffScrub10.vbs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
'=======================================================================================================
' Name: OffScrub10.vbs
' Author: Microsoft Customer Support Services
' Copyright (c) 2009-2015 Microsoft Corporation
' Script to remove (scrub) Office 2010 products
' when a regular uninstall is no longer possible
'=======================================================================================================
Option Explicit
Dim sDefault
'=======================================================================================================
'[INI] Section for script behavior customizations
'Pre-configure the SKU's to remove.
'Only for use without command line parameters
'Example: sDefault = "CLIENTALL"
sDefault = ""
'DO NOT CUSTOMIZE BELOW THIS LINE!
'=======================================================================================================
Const SCRIPTVERSION = "2.10"
Const SCRIPTFILE = "OffScrub10.vbs"
Const SCRIPTNAME = "OffScrub10"
Const RETVALFILE = "ScrubRetValFile.txt"
Const OVERSION = "14.0"
Const OVERSIONMAJOR = "14"
Const OREF = "Office14"
Const OREGREF = "OFFICE14."
Const ONAME = "Office 2010"
Const OPACKAGE = "PackageRefs"
Const OFFICEID = "000000FF1CE}"
Const HKCR = &H80000000
Const HKCU = &H80000001
Const HKLM = &H80000002
Const HKU = &H80000003
Const FOR_WRITING = 2
Const PRODLEN = 12
Const COMPPERMANENT = "00000000000000000000000000000000"
Const UNCOMPRESSED = 38
Const SQUISHED = 20
Const COMPRESSED = 32
Const REG_ARP = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
Const VB_YES = 6
Const MSIOPENDATABASEREADONLY = 0
Const LYNC_ALL = "{4A2C120F-307B-4400-B239-F29ADB54D3C6}{5CFD6599-10E5-4CF0-B6E1-BF39D30A64F8}{5CFD6599-10E5-4CF0-B6E1-BF39D30A64F8}{BF3AC8BA-1A0F-42AD-8B65-4250617AF682}{3475BF22-3564-4EF3-A633-C5F3F4582392}{263BA91B-7782-4EEB-A4FC-7BD554CAF1F3}{AA256AE1-6B6A-48E6-9957-B38F92CA614B}{D79732A1-BB17-4789-AE75-69D61261E305}{C7B887F2-07CA-4903-93A2-9B4E16E4EABD}{81BE0B17-563B-45D4-B198-5721E6C665CD}{11298539-8073-4D54-B6A0-88D4FA512E5C}{C192041D-2861-4E02-9F43-4041858A58F1}{7023C711-0E65-471E-8048-12C455968841}{58A013B1-1613-4978-881A-FCA43710C84A}{7FD6C049-9777-4B51-91FF-B19D79ADF439}{D3001D99-675B-44DF-A8EB-A7BB6F864DB7}{0C5EA724-8649-47FA-B505-75B35390378D}{13DE0C92-2AE4-48D0-8CC8-58D5E327BDCB}{E7EC16E6-C220-41C0-9C91-5E7702B8EC86}{1B10C75C-70E1-460E-B07B-D7DFF365D80F}{331977BC-B246-46B4-8829-1D52F41C8C7B}{D8255EF2-0BB2-4AF1-A662-5EBACD179475}{DD069437-C92B-4C1C-A992-14F6C7E12C2C}{E9E30DB3-8D72-43A0-B1B8-A6F8261D20D6}{545B7E32-E254-40E1-8935-91C61E3D02C2}{70409E9E-AFAE-4C05-AE57-F83B89819434}{1D6E3225-753D-41AD-A2C4-68684700F592}{217AA75D-82C0-4C49-9252-A0E6F9661688}{5AB81CD4-7C78-420C-AAAC-855C4BADBDDD}{AA595672-6515-4961-B81F-485F86627C76}{C9F2C38C-21F0-4687-8C7D-51AA02CE8C98}{DD80DED6-700D-4CC5-B2A9-C64A1AD155B9}{88257193-EC61-4152-8AB1-A5FB4BE638D7}{7D9109C3-58A9-4AFD-A1D3-47E7D811726E}{71C6D199-5B8E-41E7-BA36-D99F66E0072E}{1CFE7869-777D-4563-8161-2C75ED95B621}{FE25DDB2-5766-4A9E-86D2-2B709CC8F65D}{621F7793-1C51-45BA-899F-41557946B0E3}{B31017AA-FBF8-4003-8785-EC789C2AE0C2}{11849FBC-C416-4742-8279-17C3A2C85F72}{4F380D4B-A84D-45C7-AF58-59EA2AEDF35A}{81BE0B17-563B-45D4-B198-5721E6C665CD}"
Const ERROR_SUCCESS = 0 'Bit #1. 0 indicates Success. Script completed successfully
Const ERROR_FAIL = 1 'Bit #1. Failure bit. Indicates an overall script failure.
'RESERVED bit! Returned when process is killed from task manager
Const ERROR_REBOOT_REQUIRED = 2 'Bit #2. Reboot bit. If set a reboot is required
Const ERROR_USERCANCEL = 4 'Bit #3. User Cancel bit. Controlled cancel from script UI
Const ERROR_STAGE1 = 8 'Bit #4. Informational. Msiexec based install was not possible
Const ERROR_STAGE2 = 16 'Bit #5. Critical. Not all of the intended cleanup operations could be applied
Const ERROR_INCOMPLETE = 32 'Bit #6. Pending file renames (del on reboot) - OR - Removal needs to run again after a system reboot.
Const ERROR_DCAF_FAILURE = 64 'Bit #7. Critical. Da capo al fine (second attempt) still failed.
Const ERROR_ELEVATION_USERDECLINED = 128 'Bit #8. Critical script error. User declined to allow mandatory script elevation
Const ERROR_ELEVATION = 256 'Bit #9. Critical script error. The attempt to elevate the process did not succeed
Const ERROR_SCRIPTINIT = 512 'Bit #10. Critical script error. Initialization failed
Const ERROR_RELAUNCH = 1024'Bit #11. Critical script error. This is a temporary value and must not be the final return code
Const ERROR_UNKNOWN = 2048'Bit #12 Critical script error. Script did not complete in a well defined state
Const ERROR_ALL = 4095'Full BitMask
Const ERROR_USER_ABORT = &HC000013A 'RESERVED. Dec -1073741510. Critical error. Returned when user aborts with <Ctrl>+<Break> or closes the cmd window
Const ERROR_SUCCESS_CONFIG_COMPLETE = 1728
Const ERROR_SUCCESS_REBOOT_REQUIRED = 3010
'=======================================================================================================
Dim oFso, oMsi, oReg, oWShell, oWmiLocal, oShellApp
Dim ComputerItem, Item, LogStream, TmpKey
Dim arrTmpSKUs, arrDeleteFiles, arrDeleteFolders, arrMseFolders, arrVersion
Dim dicKeepProd, dicKeepLis, dicApps, dicKeepFolder, dicDelRegKey, dicKeepReg
Dim dicInstalledSku, dicRemoveSku, dicKeepSku, dicSrv, dicCSuite, dicCSingle
Dim f64, fLegacyProductFound, fCScript
Dim sTmp, sSkuRemoveList, sWinDir, sWICacheDir, sMode
Dim sAppData, sTemp, sScrubDir, sProgramFiles, sProgramFilesX86, sCommonProgramFiles
Dim sAllusersProfile, sOSinfo, sOSVersion, sCommonProgramFilesX86, sProfilesDirectory
Dim sProgramData, sLocalAppData, sOInstallRoot, sNotepad
Dim iVersionNT, iError
'=======================================================================================================
'Main
'=======================================================================================================
'Configure defaults
Dim sLogDir : sLogDir = ""
Dim sMoveMessage: sMoveMessage = ""
Dim fClearAddinReg : fClearAddinReg = False
Dim fRemoveOse : fRemoveOse = False
Dim fRemoveOspp : fRemoveOspp = False
Dim fRemoveAll : fRemoveAll = False
Dim fRemoveC2R : fRemoveC2R = False
Dim fRemoveAppV : fRemoveAppV = False
Dim fRemoveCSuites : fRemoveCSuites = False
Dim fRemoveCSingle : fRemoveCSingle = False
Dim fRemoveSrv : fRemoveSrv = False
Dim fRemoveLync : fRemoveLync = False
Dim fKeepUser : fKeepUser = True 'Default to keep per user settings
Dim fSkipSD : fSkipSD = False 'Default to not Skip the Shortcut Detection
Dim fKeepSG : fKeepSG = False 'Default to not override the SoftGrid detection
Dim fDetectOnly : fDetectOnly = False
Dim fQuiet : fQuiet = False
Dim fBasic : fBasic = False
Dim fNoCancel : fNoCancel = False
Dim fPassive : fPassive = True
Dim fNoReboot : fNoReboot = False 'Default to offer reboot prompt if needed
Dim fNoElevate : fNoElevate = False
Dim fElevated : fElevated = False
Dim fTryReconcile : fTryReconcile = False
Dim fC2rInstalled : fC2rInstalled = False
Dim fRebootRequired : fRebootRequired = False
Dim fReturnErrorOrSuccess : fReturnErrorOrSuccess = False
Dim fEndCurrentInstalls : fEndCurrentInstalls = False
'CAUTION! -> "fForce" will kill running applications which can result in data loss! <- CAUTION
Dim fForce : fForce = False
'CAUTION! -> "fForce" will kill running applications which can result in data loss! <- CAUTION
Dim fLogInitialized : fLogInitialized = False
Dim fBypass_Stage1 : fBypass_Stage1 = True 'Component Detection
Dim fBypass_Stage2 : fBypass_Stage2 = False 'Setup
Dim fBypass_Stage3 : fBypass_Stage3 = False 'Msiexec
Dim fBypass_Stage4 : fBypass_Stage4 = False 'CleanUp
'Create required objects
Set oWmiLocal = GetObject("winmgmts:{(Debug)}\\.\root\cimv2")
Set oWShell = CreateObject("Wscript.Shell")
Set oShellApp = CreateObject("Shell.Application")
Set oFso = CreateObject("Scripting.FileSystemObject")
Set oMsi = CreateObject("WindowsInstaller.Installer")
Set oReg = GetObject("winmgmts:\\.\root\default:StdRegProv")
'Get environment path info
sAppData = oWShell.ExpandEnvironmentStrings("%appdata%")
sLocalAppData = oWShell.ExpandEnvironmentStrings("%localappdata%")
sTemp = oWShell.ExpandEnvironmentStrings("%temp%")
sAllUsersProfile = oWShell.ExpandEnvironmentStrings("%allusersprofile%")
RegReadValue HKLM, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList", "ProfilesDirectory", sProfilesDirectory, "REG_EXPAND_SZ"
If NOT oFso.FolderExists(sProfilesDirectory) Then
sProfilesDirectory = oFso.GetParentFolderName(oWShell.ExpandEnvironmentStrings("%userprofile%"))
End If
sProgramFiles = oWShell.ExpandEnvironmentStrings("%programfiles%")
'Deferred until after architecture check
'sProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%programfiles(x86)%")
sCommonProgramFiles = oWShell.ExpandEnvironmentStrings("%commonprogramfiles%")
'Deferred until after architecture check
'sCommonProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%CommonProgramFiles(x86)%")
sProgramData = oWSHell.ExpandEnvironmentStrings("%programdata%")
sWinDir = oWShell.ExpandEnvironmentStrings("%windir%")
sWICacheDir = sWinDir & "\" & "Installer"
sScrubDir = sTemp & "\" & SCRIPTNAME
sNotepad = sWinDir & "\notepad.exe"
' Get current script host
fCScript = UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C"
'Detect if we're running on a 64 bit OS
Set ComputerItem = oWmiLocal.ExecQuery("Select * from Win32_ComputerSystem")
For Each Item In ComputerItem
f64 = Instr(Left(Item.SystemType,3),"64") > 0
If f64 Then Exit For
Next
If f64 Then sProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%programfiles(x86)%")
If f64 Then sCommonProgramFilesX86 = oWShell.ExpandEnvironmentStrings("%CommonProgramFiles(x86)%")
'Get OS details and VersionNT
Set ComputerItem = oWmiLocal.ExecQuery("Select * from Win32_OperatingSystem")
For Each Item in ComputerItem
sOSinfo = sOSinfo & Item.Caption
sOSinfo = sOSinfo & Item.OtherTypeDescription
sOSinfo = sOSinfo & ", " & "SP " & Item.ServicePackMajorVersion
sOSinfo = sOSinfo & ", " & "Version: " & Item.Version
sOsVersion = Item.Version
sOSinfo = sOSinfo & ", " & "Codepage: " & Item.CodeSet
sOSinfo = sOSinfo & ", " & "Country Code: " & Item.CountryCode
sOSinfo = sOSinfo & ", " & "Language: " & Item.OSLanguage
Next
'Build the VersionNT number
arrVersion = Split(sOsVersion, Delimiter(sOsVersion))
iVersionNt = CInt(arrVersion (0)) * 100 + CInt(arrVersion (1))
'Check if we're running as 32 bit process on a 64 bit OS
If InStr(LCase(wscript.path), "syswow64") > 0 Then RelaunchAs64Host
fElevated = CheckRegPermissions
If NOT fElevated AND NOT fNoElevate Then
'Try to relaunch elevated
RelaunchElevated
' can't relaunch. Exit out
SetError ERROR_ELEVATION
If UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C" Then
If Not fLogInitialized Then CreateLog
Log "Error: Insufficient registry access permissions - exiting"
End If
SetRetVal iError
'Undo temporary entries created in ARP
TmpKeyCleanUp
'wscript.quit 3
ExitScript
End If
' set retval for file based logic
'--------------------------------
' value needs to be kept on 'user abort'
SetRetVal ERROR_USER_ABORT
' create dictionary objects
'--------------------------
Set dicKeepProd = CreateObject("Scripting.Dictionary")
Set dicInstalledSku = CreateObject("Scripting.Dictionary")
Set dicRemoveSku = CreateObject("Scripting.Dictionary")
Set dicKeepSku = CreateObject("Scripting.Dictionary")
Set dicKeepLis = CreateObject("Scripting.Dictionary")
Set dicKeepFolder = CreateObject("Scripting.Dictionary")
Set dicApps = CreateObject("Scripting.Dictionary")
Set dicDelRegKey = CreateObject("Scripting.Dictionary")
Set dicKeepReg = CreateObject("Scripting.Dictionary")
Set dicSrv = CreateObject("Scripting.Dictionary")
Set dicCSuite = CreateObject("Scripting.Dictionary")
Set dicCSingle = CreateObject("Scripting.Dictionary")
'Create the temp folder
If Not oFso.FolderExists(sScrubDir) Then oFso.CreateFolder sScrubDir
'Set the default logging directory
sLogDir = sScrubDir
'Call the command line parser
ParseCmdLine
'Ensure CScript as engine
If NOT fCScript AND NOT fQuiet Then RelaunchAsCScript
'Get Office Install Folder
If NOT RegReadValue(HKLM,"SOFTWARE\Microsoft\Office\"&OVERSION&"\Common\InstallRoot","Path",sOInstallRoot,"REG_SZ") Then
sOInstallRoot = sProgramFiles & "\Microsoft Office\"&OREF
End If
'Ensure integrity of WI metadata which could fail used APIs otherwise
EnsureValidWIMetadata HKCU,"Software\Classes\Installer\Products",COMPRESSED
EnsureValidWIMetadata HKCR,"Installer\Products",COMPRESSED
EnsureValidWIMetadata HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products",COMPRESSED
EnsureValidWIMetadata HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components",COMPRESSED
EnsureValidWIMetadata HKCR,"Installer\Components",COMPRESSED
'Add initial known .exe files that might need to be closed
dicApps.Add "communicator.exe", "communicator.exe"
'Adding setup.exe to the hard list of processes that are shut down will potentially break wrappers that invoke OffScrub
'dicApps.Add "setup.exe", "setup.exe"
Select Case OVERSIONMAJOR
Case "12"
Case "14"
dicApps.Add "bcssync.exe","bcssync.exe"
dicApps.Add "officesas.exe","officesas.exe"
dicApps.Add "officesasscheduler.exe","officesasscheduler.exe"
dicApps.Add "msosync.exe","msosync.exe"
dicApps.Add "onenotem.exe","onenotem.exe"
Case "15"
Case Else
End Select
'-------------------
'Stage # 0 - Basics |
'-------------------
'Build a list with installed/registered Office products
sTmp = "Stage # 0 " & chr(34) & "Basics" & chr(34) & " (" & Time & ")"
LogH2 vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf
FindInstalledOProducts
If dicInstalledSku.Count > 0 Then Log "Found registered product(s): " & Join(RemoveDuplicates(dicInstalledSku.Items),",")
'Validate the list of products we got from the command line if applicable
ValidateRemoveSkuList
'Log detection results
If dicRemoveSku.Count > 0 Then Log "Product(s) to be removed: " & Join(RemoveDuplicates(dicRemoveSku.Items),",")
sMode = "Selected " & ONAME & " products"
If Not dicRemoveSku.Count > 0 Then sMode = "Orphaned " & ONAME & " products"
If fRemoveAll Then sMode = "All " & ONAME & " products"
Log "Final removal mode: " & sMode
Log "Remove OSE service: " & fRemoveOse
'Log preview mode if applicable
If fDetectOnly Then Log "*************************************************************************"
If fDetectOnly Then Log "* PREVIEW MODE *"
If fDetectOnly Then Log "* All uninstall and delete operations will only be logged not executed! *"
If fDetectOnly Then Log "*************************************************************************" & vbCrLf
'Check if there are legacy products installed
CheckForLegacyProducts
If fLegacyProductFound Then Log "Found legacy Office products that will not be removed." Else Log "No legacy Office products found."
'Cache .msi files
If dicRemoveSku.Count > 0 Then CacheMsiFiles
'Log Sku/Prod detection results
LogSkuResults
'UnPin Shortcuts
If NOT fSkipSD AND dicRemoveSku.Count > 0 Then
On Error Resume Next
LogH1 "UnPin shortcuts"
CleanShortcuts sAllUsersProfile, False, True
CleanShortcuts sProfilesDirectory, False, True
On Error Goto 0
End If 'NOT SkipSD
'--------------------------------
'Stage # 1 - Component Detection |
'--------------------------------
sTmp = "Stage # 1 " & chr(34) & "Component Detection" & chr(34) & " (" & Time & ")"
LogH2 vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf
If Not fBypass_Stage1 OR fForce Then
'Build a list with files which are installed/registered to a product that's going to be removed
Log "Prepare for CleanUp stages."
Log "Identifying removable elements. This can take several minutes."
ScanComponents
Else
Log "Not running Component Detection in default removal."
End If
'End all running Office applications
If fForce OR fQuiet OR fPassive Then CloseOfficeApps
'----------------------
'Stage # 2 - Setup.exe |
'----------------------
sTmp = "Stage # 2 " & chr(34) & "Setup.exe" & chr(34) & " (" & Time & ")"
LogH2 vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf
If Not fBypass_Stage2 Then
SetupExeRemoval
Else
Log "Skipping Setup.exe because bypass was requested."
End If
'------------------------
'Stage # 3 - Msiexec.exe |
'------------------------
sTmp = "Stage # 3 " & chr(34) & "Msiexec.exe" & chr(34) & " (" & Time & ")"
LogH2 vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf
If Not fBypass_Stage3 Then
MsiexecRemoval
Else
Log "Skipping Msiexec.exe because bypass was requested."
End If
'--------------------
'Stage # 4 - CleanUp |
'--------------------
'Removal of files and registry settings
sTmp = "Stage # 4 " & chr(34) & "CleanUp" & chr(34) & " (" & Time & ")"
LogH2 vbCrLf & sTmp & vbCrLf & String(Len(sTmp),"=") & vbCrLf
If Not fBypass_Stage4 Then
'Office Source Engine
If fRemoveOse Then
LogH1 "Office Source Engine CleanUp"
RemoveOSE
End If
'Local Installation Source (MSOCache)
LogH1 "Local Installation Source CleanUp"
WipeLIS
'Obsolete files
LogH1 "File CleanUp"
If fRemoveAll Then
FileWipeAll
Else
FileWipeIndividual
End If
'Empty Folders
LogH1 "Folder CleanUp"
DeleteEmptyFolders
'Restore Explorer if needed
If fForce OR fQuiet OR fPassive Then RestoreExplorer
'Registry data
LogH1 "Registry CleanUp"
RegWipe
'Wipe orphaned files from Windows Installer cache
LogH1 "MSI Cache - orphaned files CleanUp"
MsiClearOrphanedFiles
'Temporary .msi files in scrubcache
LogH1 "Temporary files CleanUp"
DeleteMsiScrubCache
'Temporary files
DelScrubTmp
Else
Log "Skipping CleanUp because bypass was requested."
End If
If Not sMoveMessage = "" Then Log vbCrLf & "Please remove this folder after next reboot: " & sMoveMessage
ExitScript
'-------------------------------------------------------------------------------
' ExitScript
'
' Returncode and reboot handler
'-------------------------------------------------------------------------------
Sub ExitScript
Dim sPrompt
' Update cached error and quit
'-----------------------------
SetRetVal iError
Log vbCrLf & "For detailed logging please refer to the log in folder " & chr(34) & sScrubDir & chr(34) & vbCrLf
' log result
If CBool(iError AND ERROR_INCOMPLETE) Then
LogH2 "Removal result: " & iError & " - INCOMPLETE. Uninstall requires a system reboot to complete."
Else
sTmp = " - SUCCESS"
If CBool(iError AND ERROR_USERCANCEL) Then sTmp = " - USER CANCELED"
If CBool(iError AND ERROR_FAIL) Then sTmp = " - FAIL"
LogH2 "Removal result: " & iError & sTmp
End If
If CBool(iError AND ERROR_FAIL) Then
If CBool(iError AND ERROR_REBOOT_REQUIRED) Then Log " - Reboot required"
If CBool(iError AND ERROR_USERCANCEL) Then Log " - User cancel"
If CBool(iError AND ERROR_STAGE1) Then Log " - Msiexec failed"
If CBool(iError AND ERROR_STAGE2) Then Log " - Cleanup failed"
If CBool(iError AND ERROR_INCOMPLETE) Then Log " - Removal incomplete. Rerun after reboot needed"
If CBool(iError AND ERROR_DCAF_FAILURE) Then Log " - Second attempt cleanup still incomplete"
If CBool(iError AND ERROR_ELEVATION_USERDECLINED) Then Log " - User declined elevation"
If CBool(iError AND ERROR_ELEVATION) Then Log " - Elevation failed"
If CBool(iError AND ERROR_SCRIPTINIT) Then Log " - Initialization error"
If CBool(iError AND ERROR_RELAUNCH) Then Log " - Unhandled error during relaunch attempt"
If CBool(iError AND ERROR_UNKNOWN) Then Log " - Unknown error"
' ERROR_USER_ABORT is only valid for the temporary cached error file
'If CBool(iError AND ERROR_USER_ABORT) Then Log " - Process terminated by user"
End If
' Check if we need to show a simplified return code
' 0 = Success
' Non Zero = Error
If CBool(iError AND ERROR_FAIL) AND fReturnErrorOrSuccess Then
Dim fOverallSuccess
fOverallSuccess = True
If CBool(iError AND ERROR_USERCANCEL) Then fOverallSuccess = False
If CBool(iError AND ERROR_STAGE2) Then fOverallSuccess = False
If CBool(iError AND ERROR_DCAF_FAILURE) Then fOverallSuccess = False
If CBool(iError AND ERROR_ELEVATION_USERDECLINED) Then fOverallSuccess = False
If CBool(iError AND ERROR_ELEVATION) Then fOverallSuccess = False
If CBool(iError AND ERROR_SCRIPTINIT) Then fOverallSuccess = False
If CBool(iError AND ERROR_RELAUNCH) Then fOverallSuccess = False
If CBool(iError AND ERROR_UNKNOWN) Then fOverallSuccess = False
sTmp = "ReturnErrorOrSuccess switch has been set. The current value return code translates to: "
If fOverallSuccess Then
iError = ERROR_SUCCESS
Log sTmp & "SUCCESS"
Else
Log sTmp & "ERROR"
End If
End If
LogH2 "Removal end."
' Reboot handling
If fRebootRequired Then
Log vbCrLf & "A restart is required to complete the operation!"
sPrompt = "In order to complete uninstall, a system reboot is necessary. Would you like to reboot now?"
If NOT (fQuiet OR fPassive OR fNoReboot) Then
If MsgBox(sPrompt, vbYesNo, SCRIPTNAME & " - Reboot Required") = VB_YES Then
Dim colOS, oOS
Dim oWmiReboot
Set oWmiReboot = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}!\\.\root\cimv2")
Set colOS = oWmiReboot.ExecQuery ("Select * from Win32_OperatingSystem")
For Each oOS in colOS
oOS.Reboot()
Next
End If
End If
End If
If NOT fQuiet Then
For Each Item in Wscript.Arguments
If Item = "UAC" Then
wscript.stdout.write "Press <Enter> to close this window"
sTemp = wscript.stdin.read(1)
End If
Next 'Argument
End If
wscript.quit iError
End Sub 'ExitScript
'=======================================================================================================
'=======================================================================================================
'Stage 0 - 4 Subroutines
'=======================================================================================================
'Office configuration products are listed with their configuration product name in the "Uninstall" key
'To identify an Office configuration product all of these condiditions have to be met:
' - "SystemComponent" does not have a value of "1" (DWORD)
' - "OPACKAGE" (see constant declaration) entry exists and is not empty
' - "DisplayVersion" exists and the 2 leftmost digits are "OVERSIONMAJOR"
Sub FindInstalledOProducts
Dim ArpItem, File
Dim sCurKey, sValue, sConfigName, sProdC, sCVHValue
Dim sProductCodeList, sProductCode
Dim arrKeys, arrMultiSzValues
Dim fSystemComponent0, fPackages, fDisplayVersion, fReturn, fCategorized
If dicInstalledSku.Count > 0 Then Exit Sub 'Already done from InputBox prompt
'Handle orphaned products to get them added to the detection scope
If fTryReconcile Then
For Each File in oFso.GetFolder(sWICacheDir).Files
If Len(File.Name)>3 Then
Select Case LCase(Right(File.Name, 4))
Case ".msi"
sProductCode = ""
sProductCode = GetMsiProductCode(File.Path)
If InScope(sProductCode) Then
If NOT RegKeyExists(HKLM,REG_ARP & sProductCode) Then
'Ensure the orphaned item is getting removed
If Len(sSkuRemoveList) > 0 Then
sSkuRemoveList = sSkuRemoveList & "," & GetProductID(Mid(sProductCode, 11, 4))
Else
sSkuRemoveList = GetProductID(Mid(sProductCode, 11, 4))
End If
'Add to ScrubDir
oFso.CopyFile File.Path,sScrubDir & "\" & sProductCode & ".msi",True
'Register the product with MSI
MsiRegisterProduct File.Path
End If 'NOT sProductCode
End If 'InScope
Case Else
End Select
End If '>3
Next 'File
End If 'fTryReconcile
'Locate standalone Office products that have no configuration product entry and create a
'temporary configuration entry
ReDim arrTmpSKUs(-1)
If RegEnumKey(HKLM, REG_ARP, arrKeys) Then
For Each ArpItem in arrKeys
If InScope(ArpItem) Then
sCurKey = REG_ARP & ArpItem & "\"
fSystemComponent0 = Not (RegReadValue(HKLM, sCurKey, "SystemComponent", sValue, "REG_DWORD") AND (sValue = "1"))
If (fSystemComponent0 AND (NOT RegReadValue(HKLM, sCurKey, "CVH", sCVHValue, "REG_DWORD"))) Then
RegReadValue HKLM,sCurKey,"DisplayVersion", sValue, "REG_SZ"
Redim arrMultiSzValues(0)
'Logic changed to drop the LCID identifier
'sConfigName = GetProductID(Mid(ArpItem,11,4)) & "_" & CInt("&h" & Mid(ArpItem,16,4))
sConfigName = OREGREF & GetProductID(Mid(ArpItem, 11, 4))
If NOT RegKeyExists(HKLM, REG_ARP&sConfigName) Then
'Create a new ARP item
ReDim Preserve arrTmpSKUs(UBound(arrTmpSKUs) + 1)
arrTmpSKUs(UBound(arrTmpSKUs)) = sConfigName
oReg.CreateKey HKLM, REG_ARP & sConfigName
arrMultiSzValues(0) = sConfigName
oReg.SetMultiStringValue HKLM,REG_ARP & sConfigName, OPACKAGE, arrMultiSzValues
arrMultiSzValues(0) = ArpItem
oReg.SetStringValue HKLM, REG_ARP & sConfigName, "Comment", "Temporary OffScrub generated key. Please delete this key!"
oReg.SetMultiStringValue HKLM,REG_ARP & sConfigName, "ProductCodes", arrMultiSzValues
oReg.SetStringValue HKLM, REG_ARP & sConfigName, "DisplayVersion", sValue
oReg.SetStringValue HKLM, REG_ARP & sConfigName, "DisplayName", SCRIPTNAME & "_" & sConfigName
oReg.SetDWordValue HKLM, REG_ARP & sConfigName, "SystemComponent", 0
Else
'Update the existing temporary ARP item
fReturn = RegReadValue(HKLM, REG_ARP&sConfigName, "ProductCodes", sProdC, "REG_MULTI_SZ")
If NOT InStr(sProdC, ArpItem) > 0 Then sProdC = sProdC & chr(34) & ArpItem
oReg.SetMultiStringValue HKLM, REG_ARP & sConfigName, "ProductCodes", Split(sProdC, Chr(34))
End If 'RegKeyExists
End If 'fSystemComponent0
End If 'InScope
Next 'ArpItem
End If 'RegEnumKey
'Find the configuration products
If RegEnumKey(HKLM,REG_ARP,arrKeys) Then
For Each ArpItem in arrKeys
sCurKey = REG_ARP & ArpItem & "\"
sValue = ""
fSystemComponent0 = NOT (RegReadValue(HKLM, sCurKey, "SystemComponent", sValue, "REG_DWORD") AND (sValue = "1"))
fPackages = RegReadValue(HKLM, sCurKey, OPACKAGE, sValue, "REG_MULTI_SZ")
fDisplayVersion = RegReadValue(HKLM, sCurKey, "DisplayVersion", sValue, "REG_SZ")
If fDisplayVersion Then
If Len(sValue) > 1 Then
fDisplayVersion = (Left(sValue,2) = OVERSIONMAJOR)
Else
fDisplayVersion = False
End If
End If
'fSystemComponent0 filter causes issues if the ARP entries have been hidden
If (fPackages AND fDisplayVersion) Then
'If (fSystemComponent0 AND fPackages AND fDisplayVersion) OR (fSystemComponent0 AND fDisplayVersion AND InStr(UCase(ArpItem), "CLICK2RUN") > 0) Then
If InStr(ArpItem,".") > 0 Then sConfigName = UCase(Mid(ArpItem,InStr(ArpItem,".") + 1)) Else sConfigName = UCase(ArpItem)
If NOT dicInstalledSku.Exists(sConfigName) Then dicInstalledSku.Add sConfigName,sConfigName
'Categorize the SKU
'Four categories are available: ClientSuite, ClientSingleProduct, Server, C2R
If RegReadValue(HKLM, REG_ARP & OREGREF & sConfigName, "ProductCodes", sProductCodeList, "REG_MULTI_SZ") OR (sConfigName = "CLICK2RUN") Then
fCategorized = False
If sConfigName = "CLICK2RUN" Then sProductCodeList = "{90" & OVERSIONMAJOR & "0011-0062-0000-0000-0000000FF1CE}"
For Each sProductCode in Split(sProductCodeList,chr(34))
If Len(sProductCode) = 38 Then
If Mid(sProductCode, 11, 1) = "1" Then
'Server product
If NOT dicSrv.Exists(UCase(sConfigName)) Then dicSrv.Add UCase(sConfigName), sConfigName
fCategorized = True
Exit For
Else
Select Case Mid(sProductCode, 11, 4)
'Client Suites
Case "000F","0011","0012","0013","0014","0015","0016","0017","0018","0019","001A","001B","0029","002B","002E","002F","0030","0031","0033","0035","0037","003D","0044","0049","0061","0062","0066","006C","006D","006F","0074","00A1","00A3","00A9","00BA","00CA","00E0","0100","0103","011A"
If NOT dicCSuite.Exists(UCase(sConfigName)) Then dicCSuite.Add UCase(sConfigName), sConfigName
fCategorized = True
Exit For
Case "007E", "008F", "008C", "24E1", "237A"
If NOT dicKeepProd.Exists(sProductCode) Then dicKeepProd.Add sProductCode, sConfigName
fC2rInstalled = True
Case Else
End Select
End If
End If 'Len 38
Next 'sProductCode
If NOT fCategorized Then
If NOT dicCSingle.Exists(UCase(sConfigName)) Then dicCSingle.Add UCase(sConfigName), sConfigName
End If 'fCategorized
End If 'RegReadValue "ProductCodes"
End If
Next 'ArpItem
End If 'RegEnumKey
End Sub 'FindInstalledOProducts
'=======================================================================================================
'Check if there are Office products from previous versions on the computer
Sub CheckForLegacyProducts
Const OLEGACY = "78E1-11D2-B60F-006097C998E7}.6000-11D3-8CFE-0050048383C9}.6000-11D3-8CFE-0150048383C9}.BDCA-11D1-B7AE-00C04FB92F3D}.6D54-11D4-BEE3-00C04F990354}"
Dim Product
'Set safe default
fLegacyProductFound = True
For Each Product in oMsi.Products
If Len(Product) = 38 Then
'Handle O09 - O11 Products
If InStr(OLEGACY, UCase(Right(Product, 28))) > 0 Then
'Found legacy Office product. Keep flag in default and exit
Exit Sub
End If
If UCase(Right(Product,PRODLEN))= OFFICEID Then
Select Case Mid(Product, 4, 2)
Case "12"
If CInt(OVERSIONMAJOR) > 12 Then
'Found legacy Office product. Keep flag in default and exit
Exit Sub
End If
Case Else
End Select
End If
End If '38
Next 'Product
fLegacyProductFound = False
End Sub 'CheckForLegacyProducts
'=======================================================================================================
'Create clean list of Products to remove.
'Strip off bad & empty contents
Sub ValidateRemoveSkuList
Dim Sku, Key, sProductCode, sProductCodeList
Dim arrRemoveSKUs
If fRemoveAll Then
'Remove all mode
For Each Key in dicInstalledSku.Keys
dicRemoveSku.Add Key,dicInstalledSku.Item(Key)
Next 'Key
Else
'Remove individual products or preconfigured configurations mode
'Ensure to have a string with no unexpected contents
sSkuRemoveList = Replace(sSkuRemoveList,";",",")
sSkuRemoveList = Replace(sSkuRemoveList," ","")
sSkuRemoveList = Replace(sSkuRemoveList,Chr(34),"")
While InStr(sSkuRemoveList,",,")>0
sSkuRemoveList = Replace(sSkuRemoveList,",,",",")
Wend
'Prepare 'remove' and 'keep' dictionaries to determine what has to be removed
'Initial pre-fill of 'keep' dic
For Each Key in dicInstalledSku.Keys
dicKeepSku.Add Key,dicInstalledSku.Item(Key)
Next 'Key
'Determine contents of keep and remove dic
'Individual products
arrRemoveSKUs = Split(UCase(sSkuRemoveList),",")
For Each Sku in arrRemoveSKUs
If Sku = "OSE" Then fRemoveOse = True
If Sku = "CLICK2RUN" Then fRemoveC2R = True
If dicKeepSku.Exists(Sku) Then
'A Sku to remove has been passed in
'remove the item from the keep dic
dicKeepSku.Remove(Sku)
'Now add it to the remove dic
If NOT dicRemoveSku.Exists(Sku) Then dicRemoveSku.Add Sku,Sku
End If
Next 'Sku
'Client Suite Category
If fRemoveCSuites Then
fRemoveC2R = True
For Each Key in dicInstalledSku.Keys
If dicCSuite.Exists(Key) Then
If dicKeepSku.Exists(Key) Then dicKeepSku.Remove(Key)
If NOT dicRemoveSku.Exists(Key) Then dicRemoveSku.Add Key,Key
End If
Next 'Key
End If 'fRemoveCSuites
'Client Single/Standalone Category
If fRemoveCSingle Then
For Each Key in dicInstalledSku.Keys
If dicCSingle.Exists(Key) Then
If dicKeepSku.Exists(Key) Then dicKeepSku.Remove(Key)
If NOT dicRemoveSku.Exists(Key) Then dicRemoveSku.Add Key,Key
End If
Next 'Key
End If 'fRemoveCSingle
'Server Category
If fRemoveSrv Then
For Each Key in dicInstalledSku.Keys
If dicSrv.Exists(Key) Then
If dicKeepSku.Exists(Key) Then dicKeepSku.Remove(Key)
If NOT dicRemoveSku.Exists(Key) Then dicRemoveSku.Add Key,Key
End If
Next 'Key
End If 'fRemoveSrv
If NOT dicKeepSku.Count > 0 Then fRemoveAll = True
End If 'fRemoveAll
'Fill the KeepProd dic
For Each Sku in dicKeepSku.Keys
If RegReadValue(HKLM, REG_ARP & OREGREF & Sku, "ProductCodes", sProductCodeList, "REG_MULTI_SZ") Then
For Each sProductCode in Split(sProductCodeList, chr(34))
If Len(sProductCode) = 38 Then
If NOT dicKeepProd.Exists(sProductCode) Then
dicKeepProd.Add sProductCode, Sku
' also add the UpgradeCode
If Not dicKeepProd.Exists(GetUpgradeCode(sProductCode)) Then dicKeepProd.Add GetUpgradeCode(sProductCode), Sku & "_UpgradeCode"
End If
End If '38
Next 'sProductCode
End If
Next 'Sku
If fRemoveAll OR fRemoveOse Then CheckRemoveOSE
If fRemoveAll OR fRemoveOspp Then CheckRemoveOspp
If fRemoveAll OR fRemoveC2R Then CheckRemoveSG
End Sub 'ValidateRemoveSkuList
'=======================================================================================================
'Check if SoftGrid Client can be scrubbed
Sub CheckRemoveSG
Dim Key
Dim sPKey
Dim arrKeys
If NOT CInt(OVERSIONMAJOR) > 12 Then
fRemoveC2R = False
Exit Sub
End If
If fForce Then
If NOT fKeepSG Then fRemoveAppV = True
Exit Sub
End If
fRemoveAppV = False
If fKeepSG Then Exit Sub
If RegEnumKey (HKLM,"SOFTWARE\Microsoft\SoftGrid\4.5\Client\Applications",arrKeys) Then
For Each Key in arrKeys
If Len(Key)>15 Then
'Get Partial product Key
sPKey = Right(Key,16)
If Left(sPKey,4) = "90"&OVERSIONMAJOR Then
If NOT GetProductID(Mid(sPKey,5,4)) = "CLICK2RUN" Then Exit Sub
Else
Exit Sub
End If
Else
Exit Sub
End If
Next 'Key
Else
Exit Sub
End If
'If we got here it's only Click2Run apps
fRemoveAppV = True
End Sub 'CheckRemoveSG
'=======================================================================================================
'Check if OSE service can be scrubbed
Sub CheckRemoveOSE
Const O11 = "6000-11D3-8CFE-0150048383C9}"
Dim Product
If fRemoveOse Then Exit Sub
For Each Product in oMsi.Products
If Len(Product) = 38 Then
If UCase(Right(Product, 28)) = O11 Then
'Found Office 2003 Product. Set flag to not remove the OSE service
Exit Sub
End If
If UCase(Right(Product, PRODLEN))= OFFICEID Then
Select Case Mid(Product, 4, 2)
Case "12","14","15","16","17"
If NOT Mid(Product, 4, 2) = OVERSIONMAJOR Then
'Found another Office product. Set flag to keep the OSE service
fRemoveOse = False
Exit Sub
End If
Case Else
End Select
End If
End If '38
Next 'Product
fRemoveOse = True
End Sub 'CheckRemoveOSE
'=======================================================================================================
'Check if OSPP service can be scrubbed
Sub CheckRemoveOSPP
Dim Product
If NOT CInt(OVERSIONMAJOR) > 12 Then
fRemoveOspp = False
Exit Sub
End If
If fRemoveOspp Then Exit Sub
If fC2rInstalled Then
fRemoveOspp = False
Exit Sub
End If
For Each Product in oMsi.Products
If Len(Product) = 38 Then
If UCase(Right(Product, PRODLEN)) = OFFICEID Then
Select Case Mid(Product, 4, 2)
Case "14","15","16","17"
If NOT Mid(Product, 4, 2) = OVERSIONMAJOR Then
'Found another Office product. Set flag to keep the OSPP service
fRemoveOspp = False
Exit Sub
End If
Case Else
End Select
End If
End If '38
Next 'Product
fRemoveOspp = True
End Sub 'CheckRemoveOSPP
'=======================================================================================================
'Cache .msi files for products that will be removed in case they are needed for later file detection
Sub CacheMsiFiles
Dim Product
Dim sMsiFile
'Non critical routine for failures.
'Errors will be logged but must not fail the execution
On Error Resume Next
LogH1 "Cache .msi files to temporary Scrub folder"
'Cache the files
For Each Product in oMsi.Products
'Ensure valid GUID length
If CheckDeleteEx(Product) Then
CheckError "CacheMsiFiles"
sMsiFile = oMsi.ProductInfo(Product,"LocalPackage") : CheckError "CacheMsiFiles"
LogOnly " - " & Product & ".msi"
If oFso.FileExists(sMsiFile) Then oFso.CopyFile sMsiFile,sScrubDir & "\" & Product & ".msi",True
CheckError "CacheMsiFiles"
End If 'InScope
Next 'Product
Err.Clear
End Sub 'CacheMsiFiles
'=======================================================================================================
'Build a list of all files that will be deleted
Sub ScanComponents
Const MSIINSTALLSTATE_LOCAL = 3
Dim FileList, RegList, ComponentID, CompClient, Record, qView, MsiDb, CompVerbose
Dim Processes, Process, Prop, prod
Dim sQuery, sSubKeyName, sPath, sFile, sMsiFile, sCompClient, sComponent, sCompReg
Dim fRemoveComponent, fAffectedComponent, fIsPermanent, fIsFile, fIsFolder
Dim i, iProgress, iCompCnt, iRemCnt
Dim dicFLError, oDic, oFolderDic, dicCompPath
Dim hDefKey
'Logfile
Set FileList = oFso.OpenTextFile(sScrubDir & "\FileList.txt",FOR_WRITING,True,True)
Set RegList = oFso.OpenTextFile(sScrubDir & "\RegList.txt",FOR_WRITING,True,True)
Set CompVerbose = oFso.OpenTextFile(sScrubDir & "\CompVerbose.txt",FOR_WRITING,True,True)
'FileListError dic
Set dicFLError = CreateObject("Scripting.Dictionary")
Set oDic = CreateObject("Scripting.Dictionary")
Set oFolderDic = CreateObject("Scripting.Dictionary")
Set dicCompPath = CreateObject("Scripting.Dictionary")
'Prevent that API errors fail script execution
On Error Resume Next
iCompCnt = oMsi.Components.Count
If NOT Err = 0 Then
'API failure
Log "Error during components detection. Cannot complete this task."
Err.Clear
Exit Sub
End If
'Ensure to not divide by zero
If iCompCnt = 0 Then iCompCnt = 1
LogOnly " Scanning " & iCompCnt & " components"
'Enum all Components
If Not fLogInitialized Then CreateLog
For Each ComponentID In oMsi.Components
CompVerbose.WriteLine vbCrLf & "Checking Component: " & ComponentID
'Progress bar
i = i + 1
If iProgress < (i / iCompCnt) * 100 Then
If fCScript Then wscript.stdout.write "." : LogStream.Write "."
iProgress = iProgress + 1
If iProgress = 35 OR iProgress = 70 Then Log ""
End If
'Check if all ComponentClients will be removed
sCompClient = ""
iRemCnt = 0
fIsPermanent = False
fRemoveComponent = False 'Flag to track if the component will be completely removed
fAffectedComponent = False 'Flag to track if some clients remain installed who have a none shared location
dicCompPath.RemoveAll
Err.Clear
For Each CompClient In oMsi.ComponentClients(ComponentID)
CompVerbose.Write " CompClient " & CompClient & "-> "
If Err = 0 Then
'Ensure valid guid length
If Len(CompClient) = 38 Then
fRemoveComponent = InScope(CompClient)
If fRemoveComponent OR (CompClient = "{00000000-0000-0000-0000-000000000000}") Then
sPath = ""
sPath = LCase(oMsi.ComponentPath(CompClient,ComponentID))
sPath = Replace(sPath,"?",":")
'Scan for msidbComponentAttributesPermanent flag
If CompClient = "{00000000-0000-0000-0000-000000000000}" Then
fIsPermanent = True
iRemCnt = iRemCnt + 1
End If
If fRemoveComponent Then fRemoveComponent = CheckDelete(CompClient)
CompVerbose.Write "CheckDelete: " & fRemoveComponent & "; "
If fRemoveComponent Then
iRemCnt = iRemCnt + 1
fAffectedComponent = True
'Since the scope remains within one Office family the keypath for the component
'is assumed to be identical
If sCompClient = "" Then sCompClient = CompClient
' flag the CompClient entry for removal
sCompReg = "Installer\Components\"&GetCompressedGuid(ComponentID)&"\"&GetCompressedGuid(CompClient)
If NOT dicDelRegKey.Exists(sCompReg) Then
dicDelRegKey.Add sCompReg,HKCR
RegList.WriteLine HiveString(HKCR)&"\"&sCompReg
End If
sCompReg = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components\"&GetCompressedGuid(ComponentID)&"\"&GetCompressedGuid(CompClient)
If NOT dicDelRegKey.Exists(sCompReg) Then
dicDelRegKey.Add sCompReg,HKLM
RegList.WriteLine HiveString(HKCR)&"\"&sCompReg
End If
Else