Jump to content


 


Register a free account to unlock additional features at BleepingComputer.com
Welcome to BleepingComputer, a free community where people like yourself come together to discuss and learn how to use their computers. Using the site is easy and fun. As a guest, you can browse and view the various discussions in the forums, but can not create a new topic or reply to an existing one unless you are logged in. Other benefits of registering an account are subscribing to topics and forums, creating a blog, and having no ads shown anywhere on the site.


Click here to Register a free account now! or read our Welcome Guide to learn how to use this site.

Photo

T.j. - Winantiviruspro 2007 Popups, Then Adware.virtumonde Warnings


  • Please log in to reply
4 replies to this topic

#1 T.J.

T.J.

  • Members
  • 16 posts
  • OFFLINE
  •  
  • Local time:09:07 AM

Posted 14 July 2007 - 10:33 PM

Good evening,

Mt problems started last night with winantiviruspro 2007 popups in IE. I ran a virus scan with Symantec over night with no results and today Ive been getting Symantec warnings about Adware.Virtumonde repeatedly. I have followed the Prep guide and still get the Symantec warning about Virtumonde every 3-5 seconds. Spybot S&D found several items, but seemed to clean them all, then it started again. My Proc is pegged at 100% almost all the time...

HijackThis Log:

Logfile of HijackThis v1.99.1
Scan saved at 11:31:02 PM, on 07/14/2007
Platform: Unknown Windows (WinNT 6.00.1904)
MSIE: Internet Explorer v7.00 (7.00.6000.16473)

Running processes:
C:\Program Files\Common Files\LogiShrd\LVCOMSER\LVComSer.exe
C:\Windows\system32\taskeng.exe
C:\Windows\system32\Dwm.exe
C:\Windows\Explorer.EXE
C:\Program Files\Adobe\Acrobat 7.0\Distillr\acrotray.exe
C:\Program Files\Common Files\Symantec Shared\ccApp.exe
C:\Program Files\Common Files\logishrd\LComMgr\Communications_Helper.exe
C:\Windows\System32\CTHELPER.EXE
C:\Windows\System32\CTXFIHLP.EXE
C:\Windows\System32\rundll32.exe
C:\Program Files\Windows Sidebar\sidebar.exe
C:\Windows\ehome\ehtray.exe
C:\Windows\System32\rundll32.exe
C:\Program Files\Steam\Steam.exe
C:\Program Files\Logitech\SetPoint\SetPoint.exe
C:\Windows\ehome\ehmsas.exe
C:\Windows\System32\CTxfispi.exe
C:\Program Files\Windows Sidebar\sidebar.exe
C:\Program Files\Common Files\Logitech\KhalShared\KHALMNPR.EXE
C:\Program Files\Common Files\Logishrd\LQCVFX\COCIManager.exe
C:\Program Files\Windows Media Player\wmpnscfg.exe
C:\Windows\system32\rundll32.exe
C:\Program Files\Adobe\Acrobat 7.0\Acrobat\Acrobat.exe
C:\Users\TJY\AppData\Local\Temp\Adobelm_Cleanup.0001
C:\Users\TJY\AppData\Local\Temp\Adobelm_Cleanup.0001
C:\Program Files\Windows Defender\MSASCui.exe
C:\Program Files\Internet Explorer\iexplore.exe
C:\Program Files\Spybot - Search & Destroy\TeaTimer.exe
C:\Windows\system32\SearchFilterHost.exe
C:\Users\TJY\Desktop\HijackThis.exe

R1 - HKCU\Software\Microsoft\Internet Explorer\Main,Search Bar = file://C:\WINDOWS\system32\SearchBar.htm
R1 - HKLM\Software\Microsoft\Internet Explorer\Main,Default_Page_URL = http://go.microsoft.com/fwlink/?LinkId=69157
R1 - HKLM\Software\Microsoft\Internet Explorer\Main,Default_Search_URL = http://go.microsoft.com/fwlink/?LinkId=54896
R1 - HKLM\Software\Microsoft\Internet Explorer\Main,Search Page = http://go.microsoft.com/fwlink/?LinkId=54896
R0 - HKLM\Software\Microsoft\Internet Explorer\Main,Start Page = http://go.microsoft.com/fwlink/?LinkId=69157
R0 - HKLM\Software\Microsoft\Internet Explorer\Search,SearchAssistant =
R0 - HKLM\Software\Microsoft\Internet Explorer\Search,CustomizeSearch =
R0 - HKCU\Software\Microsoft\Internet Explorer\Toolbar,LinksFolderName =
O1 - Hosts: ::1 localhost
O2 - BHO: Adobe PDF Reader Link Helper - {06849E9F-C8D7-4D59-B87D-784B7D6BE0B3} - C:\Program Files\Adobe\Acrobat 7.0\ActiveX\AcroIEHelper.dll
O2 - BHO: (no name) - {53707962-6F74-2D53-2644-206D7942484F} - C:\PROGRA~1\SPYBOT~1\SDHelper.dll
O2 - BHO: (no name) - {5A9B0095-9097-427D-ABE6-74FAA079938B} - C:\Windows\system32\xxyyw.dll
O2 - BHO: Windows Live Sign-in Helper - {9030D464-4C02-4ABF-8ECC-5164760863C6} - C:\Program Files\Common Files\Microsoft Shared\Windows Live\WindowsLiveLogin.dll
O2 - BHO: (no name) - {938A8A03-A938-4019-B764-03FF8D167D79} - C:\Windows\system32\ddgiyfew.dll
O2 - BHO: (no name) - {941508F8-CCD9-44E0-AC29-4F1E141373F7} - C:\Windows\system32\nnnlijg.dll
O2 - BHO: Adobe PDF Conversion Toolbar Helper - {AE7CD045-E861-484f-8273-0445EE161910} - C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll
O3 - Toolbar: Adobe PDF - {47833539-D0C5-4125-9FA8-0819E2EAAC93} - C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll
O4 - HKLM\..\Run: [Windows Defender] %ProgramFiles%\Windows Defender\MSASCui.exe -hide
O4 - HKLM\..\Run: [Acrobat Assistant 7.0] "C:\Program Files\Adobe\Acrobat 7.0\Distillr\Acrotray.exe"
O4 - HKLM\..\Run: [ccApp] "C:\Program Files\Common Files\Symantec Shared\ccApp.exe"
O4 - HKLM\..\Run: [LogitechCommunicationsManager] "C:\Program Files\Common Files\LogiShrd\LComMgr\Communications_Helper.exe"
O4 - HKLM\..\Run: [Symantec PIF AlertEng] "C:\Program Files\Common Files\Symantec Shared\PIF\{B8E1DD85-8582-4c61-B58F-2F227FCA9A08}\PIFSvc.exe" /a /m "C:\Program Files\Common Files\Symantec Shared\PIF\{B8E1DD85-8582-4c61-B58F-2F227FCA9A08}\AlertEng.dll"
O4 - HKLM\..\Run: [Logitech Hardware Abstraction Layer] KHALMNPR.EXE
O4 - HKLM\..\Run: [EzBackup Manager] C:\Program Files\EZ-Backup\EZ-Backup Manager\ezbackupmanager.exe
O4 - HKLM\..\Run: [JMB36X Configure] C:\Windows\system32\JMRaidTool.exe boot
O4 - HKLM\..\Run: [CTHelper] CTHELPER.EXE
O4 - HKLM\..\Run: [CTxfiHlp] CTXFIHLP.EXE
O4 - HKLM\..\Run: [LogitechQuickCamRibbon] "C:\Program Files\Logitech\QuickCam10\QuickCam10.exe" /hide
O4 - HKLM\..\Run: [NvSvc] RUNDLL32.EXE C:\Windows\system32\nvsvc.dll,nvsvcStart
O4 - HKLM\..\Run: [NvCplDaemon] RUNDLL32.EXE C:\Windows\system32\NvCpl.dll,NvStartup
O4 - HKLM\..\Run: [NvMediaCenter] RUNDLL32.EXE C:\Windows\system32\NvMcTray.dll,NvTaskbarInit
O4 - HKLM\..\Run: [UltraMon] "C:\Program Files\UltraMon\UltraMon.exe" /auto
O4 - HKLM\..\Run: [icq.com] rundll32.exe "C:\Windows\system32\ixkrlicr.dll",forkonce
O4 - HKCU\..\Run: [Sidebar] C:\Program Files\Windows Sidebar\sidebar.exe /autoRun
O4 - HKCU\..\Run: [ehTray.exe] C:\Windows\ehome\ehTray.exe
O4 - HKCU\..\Run: [msnmsgr] "C:\Program Files\MSN Messenger\msnmsgr.exe" /background
O4 - HKCU\..\Run: [Steam] "C:\Program Files\Steam\Steam.exe" -silent
O4 - HKCU\..\Run: [Start WingMan Profiler] "C:\Program Files\Logitech\Profiler\lwemon.exe" /noui
O4 - HKCU\..\Run: [SpybotSD TeaTimer] C:\Program Files\Spybot - Search & Destroy\TeaTimer.exe
O4 - Global Startup: Adobe Acrobat Speed Launcher.lnk = ?
O4 - Global Startup: AutoStart IR.lnk = C:\Program Files\WinTV\Ir.exe
O4 - Global Startup: Logitech SetPoint.lnk = C:\Program Files\Logitech\SetPoint\SetPoint.exe
O8 - Extra context menu item: Convert link target to Adobe PDF - res://C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll/AcroIECapture.html
O8 - Extra context menu item: Convert link target to existing PDF - res://C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll/AcroIEAppend.html
O8 - Extra context menu item: Convert selected links to Adobe PDF - res://C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll/AcroIECaptureSelLinks.html
O8 - Extra context menu item: Convert selected links to existing PDF - res://C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll/AcroIEAppendSelLinks.html
O8 - Extra context menu item: Convert selection to Adobe PDF - res://C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll/AcroIECapture.html
O8 - Extra context menu item: Convert selection to existing PDF - res://C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll/AcroIEAppend.html
O8 - Extra context menu item: Convert to Adobe PDF - res://C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll/AcroIECapture.html
O8 - Extra context menu item: Convert to existing PDF - res://C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll/AcroIEAppend.html
O8 - Extra context menu item: E&xport to Microsoft Excel - res://C:\PROGRA~1\MICROS~2\Office12\EXCEL.EXE/3000
O9 - Extra button: Research - {92780B25-18CC-41C8-B9BE-3C9C571A8263} - C:\PROGRA~1\MICROS~2\Office12\REFIEBAR.DLL
O10 - Unknown file in Winsock LSP: c:\windows\system32\nlaapi.dll
O10 - Unknown file in Winsock LSP: c:\windows\system32\napinsp.dll
O11 - Options group: [INTERNATIONAL] International*
O13 - Gopher Prefix:
O15 - Trusted Zone: www.bensbargains.net
O15 - Trusted Zone: *.ebay.com
O15 - Trusted Zone: *.fairbankscapital.com
O15 - Trusted Zone: www.fetchfido.co.uk
O15 - Trusted Zone: *.live.com
O15 - Trusted Zone: *.timothyjyoung.net
O15 - Trusted Zone: *.windowsmedia.com
O18 - Protocol: livecall - {828030A1-22C1-4009-854F-8E305202313F} - C:\PROGRA~1\MSNMES~1\MSGRAP~1.DLL
O18 - Protocol: ms-help - {314111C7-A502-11D2-BBCA-00C04F8EC294} - C:\Program Files\Common Files\Microsoft Shared\Help\hxds.dll
O18 - Protocol: msnim - {828030A1-22C1-4009-854F-8E305202313F} - C:\PROGRA~1\MSNMES~1\MSGRAP~1.DLL
O18 - Filter hijack: text/xml - {807563E5-5146-11D5-A672-00B0D022E945} - C:\PROGRA~1\COMMON~1\MICROS~1\OFFICE12\MSOXMLMF.DLL
O20 - Winlogon Notify: nnnlijg - C:\Windows\SYSTEM32\nnnlijg.dll
O20 - Winlogon Notify: winjgf32 - winjgf32.dll (file missing)
O20 - Winlogon Notify: xxyyw - C:\Windows\system32\xxyyw.dll
O23 - Service: Ad-Aware 2007 Service (aawservice) - Lavasoft AB - C:\Program Files\Lavasoft\Ad-Aware 2007\aawservice.exe
O23 - Service: Adobe LM Service - Adobe Systems - C:\Program Files\Common Files\Adobe Systems Shared\Service\Adobelmsvc.exe
O23 - Service: Automatic LiveUpdate Scheduler - Symantec Corporation - C:\Program Files\Symantec\LiveUpdate\ALUSchedulerSvc.exe
O23 - Service: Symantec Event Manager (ccEvtMgr) - Unknown owner - C:\Program Files\Common Files\Symantec Shared\ccSvcHst.exe" /h ccCommon (file missing)
O23 - Service: Symantec Settings Manager (ccSetMgr) - Unknown owner - C:\Program Files\Common Files\Symantec Shared\ccSvcHst.exe" /h ccCommon (file missing)
O23 - Service: Symantec Lic NetConnect service (CLTNetCnService) - Unknown owner - C:\Program Files\Common Files\Symantec Shared\ccSvcHst.exe" /h cltCommon (file missing)
O23 - Service: @%SystemRoot%\ehome\ehstart.dll,-101 (ehstart) - Unknown owner - %windir%\system32\svchost.exe (file missing)
O23 - Service: EZ-Backup Manager - Unknown owner - C:\Program Files\EZ-Backup\EZ-Backup Manager\EzBackup.exe
O23 - Service: HauppaugeTVServer - Hauppauge Computer Works - C:\PROGRA~1\WinTV\HCWTVS~1.EXE
O23 - Service: Symantec IS Password Validation (ISPwdSvc) - Symantec Corporation - C:\Program Files\Norton AntiVirus\isPwdSvc.exe
O23 - Service: LiveUpdate - Symantec Corporation - C:\PROGRA~1\Symantec\LIVEUP~1\LUCOMS~1.EXE
O23 - Service: LiveUpdate Notice Service Ex (LiveUpdate Notice Ex) - Unknown owner - C:\Program Files\Common Files\Symantec Shared\ccSvcHst.exe" /h ccCommon (file missing)
O23 - Service: LiveUpdate Notice Service - Unknown owner - C:\Program Files\Common Files\Symantec Shared\PIF\{B8E1DD85-8582-4c61-B58F-2F227FCA9A08}\PIFSvc.exe" /m "C:\Program Files\Common Files\Symantec Shared\PIF\{B8E1DD85-8582-4c61-B58F-2F227FCA9A08}\PifEng.dll (file missing)
O23 - Service: LVCOMSer - Logitech Inc. - C:\Program Files\Common Files\LogiShrd\LVCOMSER\LVComSer.exe
O23 - Service: Process Monitor (LVPrcSrv) - Logitech Inc. - C:\Program Files\Common Files\LogiShrd\LVMVFM\LVPrcSrv.exe
O23 - Service: LVSrvLauncher - Logitech Inc. - C:\Program Files\Common Files\LogiShrd\SrvLnch\SrvLnch.exe
O23 - Service: @%SystemRoot%\system32\qwave.dll,-1 (QWAVE) - Unknown owner - %windir%\system32\svchost.exe (file missing)
O23 - Service: @%SystemRoot%\system32\seclogon.dll,-7001 (seclogon) - Unknown owner - %windir%\system32\svchost.exe (file missing)
O23 - Service: Symantec Core LC - Symantec Corporation - C:\Program Files\Common Files\Symantec Shared\CCPD-LC\symlcsvc.exe
O23 - Service: Symantec AppCore Service (SymAppCore) - Symantec Corporation - C:\Program Files\Common Files\Symantec Shared\AppCore\AppSvc32.exe
O23 - Service: @%ProgramFiles%\Windows Media Player\wmpnetwk.exe,-101 (WMPNetworkSvc) - Unknown owner - %ProgramFiles%\Windows Media Player\wmpnetwk.exe (file missing)

BC AdBot (Login to Remove)

 


#2 YounGun

YounGun

    The malware-fighting kid


  • Members
  • 244 posts
  • OFFLINE
  •  
  • Gender:Male
  • Location:Romania, Bucharest
  • Local time:03:07 PM

Posted 15 July 2007 - 10:55 AM

Hi :thumbsup:

Please click Here to download HijackThis to your desktop.

Click the Download button. When the Trend Micro HJT install box appears, double click on the HJTInstall.exe. Click on Install.

It will be installed by default here: C:\Program Files\Trend Micro\HijackThis

A shortcut to the application will also be placed on your Desktop.

The program will open automatically after installation.

You can double-click the icon that was placed on the Desktop to run subsequent HijackThis scans or you can use the icon inside the folder. The folder HijackThis is where you will find the HJT logs that you save. When you use the application to remove anything, you will also find the backup copies made by HJT inside this folder.

Click on "Do a system scan and save logfile" When the log pops up in Notepad, copy and paste that file back here.

I would like to see if any other startups are involved. To do this, I need to see another type of log please. Go here and download Silent Runners.vbs to a new folder on your Desktop (Clicking the the download link works if you use IE. If you use FireFox, rightclick on the link and choose "Save Link As") and run it. It generates a log too. It takes a minute or two and it will notify you with a popup when your log is ready (make sure you wait for the popups please) Please post the information back in this thread too (you may need to make a couple of posts). If your antivirus program queries the script, allow it to run. It's not malicious.

#3 T.J.

T.J.
  • Topic Starter

  • Members
  • 16 posts
  • OFFLINE
  •  
  • Local time:09:07 AM

Posted 15 July 2007 - 02:59 PM

First, I am now getting killed with Sbyboy S&D messages about registry changes after running the last scans.

Here is the new Sbybot S&D Log:

Logfile of HijackThis v1.99.1
Scan saved at 3:55:57 PM, on 07/15/2007
Platform: Unknown Windows (WinNT 6.00.1904)
MSIE: Internet Explorer v7.00 (7.00.6000.16473)

Running processes:
C:\Windows\system32\Dwm.exe
C:\Windows\Explorer.EXE
C:\Program Files\Common Files\LogiShrd\LVCOMSER\LVComSer.exe
C:\Program Files\Windows Defender\MSASCui.exe
C:\Program Files\Adobe\Acrobat 7.0\Distillr\acrotray.exe
C:\Program Files\Common Files\Symantec Shared\ccApp.exe
C:\Program Files\Common Files\logishrd\LComMgr\Communications_Helper.exe
C:\Program Files\EZ-Backup\EZ-Backup Manager\EzBackupManager.exe
C:\Windows\System32\CTHELPER.EXE
C:\Windows\System32\CTXFIHLP.EXE
C:\Program Files\Logitech\QuickCam10\QuickCam10.exe
C:\Windows\System32\rundll32.exe
C:\Program Files\UltraMon\UltraMon.exe
C:\Windows\system32\taskeng.exe
C:\Program Files\Windows Sidebar\sidebar.exe
C:\Windows\ehome\ehtray.exe
C:\Program Files\ASUS\AASP\1.00.25\aaCenter.exe
C:\Program Files\MSN Messenger\msnmsgr.exe
C:\Program Files\Steam\Steam.exe
C:\Program Files\Logitech\Profiler\LWEMon.exe
C:\Windows\ehome\ehmsas.exe
C:\Program Files\WinTV\Ir.exe
C:\Program Files\Logitech\SetPoint\SetPoint.exe
C:\Windows\System32\rundll32.exe
C:\Windows\System32\CTxfispi.exe
C:\Program Files\Windows Sidebar\sidebar.exe
C:\Program Files\Common Files\Logitech\KhalShared\KHALMNPR.EXE
C:\Program Files\UltraMon\UltraMonTaskbar.exe
C:\Program Files\Internet Explorer\iexplore.exe
C:\Program Files\Common Files\Microsoft Shared\Windows Live\WLLoginProxy.exe
C:\Program Files\Common Files\Logishrd\LQCVFX\COCIManager.exe
C:\Windows\System32\mobsync.exe
C:\Program Files\Norton AntiVirus\NAVW32.exe
C:\Windows\System32\Notepad.exe
C:\Windows\system32\rundll32.exe
c:\Windows\System32\rundll32.exe
C:\Program Files\HijackThis\HijackThis.exe

R1 - HKCU\Software\Microsoft\Internet Explorer\Main,Search Bar = file://C:\WINDOWS\system32\SearchBar.htm
R1 - HKLM\Software\Microsoft\Internet Explorer\Main,Default_Page_URL = http://go.microsoft.com/fwlink/?LinkId=69157
R1 - HKLM\Software\Microsoft\Internet Explorer\Main,Default_Search_URL = http://go.microsoft.com/fwlink/?LinkId=54896
R1 - HKLM\Software\Microsoft\Internet Explorer\Main,Search Page = http://go.microsoft.com/fwlink/?LinkId=54896
R0 - HKLM\Software\Microsoft\Internet Explorer\Main,Start Page = http://go.microsoft.com/fwlink/?LinkId=69157
R0 - HKLM\Software\Microsoft\Internet Explorer\Search,SearchAssistant =
R0 - HKLM\Software\Microsoft\Internet Explorer\Search,CustomizeSearch =
R0 - HKCU\Software\Microsoft\Internet Explorer\Toolbar,LinksFolderName =
O1 - Hosts: ::1 localhost
O3 - Toolbar: Adobe PDF - {47833539-D0C5-4125-9FA8-0819E2EAAC93} - C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll
O4 - HKLM\..\Run: [Windows Defender] %ProgramFiles%\Windows Defender\MSASCui.exe -hide
O4 - HKLM\..\Run: [Acrobat Assistant 7.0] "C:\Program Files\Adobe\Acrobat 7.0\Distillr\Acrotray.exe"
O4 - HKLM\..\Run: [ccApp] "C:\Program Files\Common Files\Symantec Shared\ccApp.exe"
O4 - HKLM\..\Run: [LogitechCommunicationsManager] "C:\Program Files\Common Files\LogiShrd\LComMgr\Communications_Helper.exe"
O4 - HKLM\..\Run: [Symantec PIF AlertEng] "C:\Program Files\Common Files\Symantec Shared\PIF\{B8E1DD85-8582-4c61-B58F-2F227FCA9A08}\PIFSvc.exe" /a /m "C:\Program Files\Common Files\Symantec Shared\PIF\{B8E1DD85-8582-4c61-B58F-2F227FCA9A08}\AlertEng.dll"
O4 - HKLM\..\Run: [Logitech Hardware Abstraction Layer] KHALMNPR.EXE
O4 - HKLM\..\Run: [EzBackup Manager] C:\Program Files\EZ-Backup\EZ-Backup Manager\ezbackupmanager.exe
O4 - HKLM\..\Run: [JMB36X Configure] C:\Windows\system32\JMRaidTool.exe boot
O4 - HKLM\..\Run: [CTHelper] CTHELPER.EXE
O4 - HKLM\..\Run: [CTxfiHlp] CTXFIHLP.EXE
O4 - HKLM\..\Run: [LogitechQuickCamRibbon] "C:\Program Files\Logitech\QuickCam10\QuickCam10.exe" /hide
O4 - HKLM\..\Run: [NvSvc] RUNDLL32.EXE C:\Windows\system32\nvsvc.dll,nvsvcStart
O4 - HKLM\..\Run: [NvCplDaemon] RUNDLL32.EXE C:\Windows\system32\NvCpl.dll,NvStartup
O4 - HKLM\..\Run: [NvMediaCenter] RUNDLL32.EXE C:\Windows\system32\NvMcTray.dll,NvTaskbarInit
O4 - HKLM\..\Run: [UltraMon] "C:\Program Files\UltraMon\UltraMon.exe" /auto
O4 - HKLM\..\Run: [icq.com] rundll32.exe "C:\Windows\system32\ixkrlicr.dll",forkonce
O4 - HKCU\..\Run: [Sidebar] C:\Program Files\Windows Sidebar\sidebar.exe /autoRun
O4 - HKCU\..\Run: [ehTray.exe] C:\Windows\ehome\ehTray.exe
O4 - HKCU\..\Run: [msnmsgr] "C:\Program Files\MSN Messenger\msnmsgr.exe" /background
O4 - HKCU\..\Run: [Steam] "C:\Program Files\Steam\Steam.exe" -silent
O4 - HKCU\..\Run: [Start WingMan Profiler] "C:\Program Files\Logitech\Profiler\lwemon.exe" /noui
O4 - HKCU\..\Run: [SpybotSD TeaTimer] C:\Program Files\Spybot - Search & Destroy\TeaTimer.exe
O4 - Global Startup: Adobe Acrobat Speed Launcher.lnk = ?
O4 - Global Startup: AutoStart IR.lnk = C:\Program Files\WinTV\Ir.exe
O4 - Global Startup: Logitech SetPoint.lnk = C:\Program Files\Logitech\SetPoint\SetPoint.exe
O8 - Extra context menu item: Convert link target to Adobe PDF - res://C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll/AcroIECapture.html
O8 - Extra context menu item: Convert link target to existing PDF - res://C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll/AcroIEAppend.html
O8 - Extra context menu item: Convert selected links to Adobe PDF - res://C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll/AcroIECaptureSelLinks.html
O8 - Extra context menu item: Convert selected links to existing PDF - res://C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll/AcroIEAppendSelLinks.html
O8 - Extra context menu item: Convert selection to Adobe PDF - res://C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll/AcroIECapture.html
O8 - Extra context menu item: Convert selection to existing PDF - res://C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll/AcroIEAppend.html
O8 - Extra context menu item: Convert to Adobe PDF - res://C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll/AcroIECapture.html
O8 - Extra context menu item: Convert to existing PDF - res://C:\Program Files\Adobe\Acrobat 7.0\Acrobat\AcroIEFavClient.dll/AcroIEAppend.html
O8 - Extra context menu item: E&xport to Microsoft Excel - res://C:\PROGRA~1\MICROS~2\Office12\EXCEL.EXE/3000
O9 - Extra button: Research - {92780B25-18CC-41C8-B9BE-3C9C571A8263} - C:\PROGRA~1\MICROS~2\Office12\REFIEBAR.DLL
O10 - Unknown file in Winsock LSP: c:\windows\system32\nlaapi.dll
O10 - Unknown file in Winsock LSP: c:\windows\system32\napinsp.dll
O11 - Options group: [INTERNATIONAL] International*
O13 - Gopher Prefix:
O15 - Trusted Zone: www.bensbargains.net
O15 - Trusted Zone: *.ebay.com
O15 - Trusted Zone: *.fairbankscapital.com
O15 - Trusted Zone: www.fetchfido.co.uk
O15 - Trusted Zone: *.live.com
O15 - Trusted Zone: *.timothyjyoung.net
O15 - Trusted Zone: *.windowsmedia.com
O18 - Protocol: livecall - {828030A1-22C1-4009-854F-8E305202313F} - C:\PROGRA~1\MSNMES~1\MSGRAP~1.DLL
O18 - Protocol: ms-help - {314111C7-A502-11D2-BBCA-00C04F8EC294} - C:\Program Files\Common Files\Microsoft Shared\Help\hxds.dll
O18 - Protocol: msnim - {828030A1-22C1-4009-854F-8E305202313F} - C:\PROGRA~1\MSNMES~1\MSGRAP~1.DLL
O18 - Filter hijack: text/xml - {807563E5-5146-11D5-A672-00B0D022E945} - C:\PROGRA~1\COMMON~1\MICROS~1\OFFICE12\MSOXMLMF.DLL
O23 - Service: Ad-Aware 2007 Service (aawservice) - Lavasoft AB - C:\Program Files\Lavasoft\Ad-Aware 2007\aawservice.exe
O23 - Service: Adobe LM Service - Adobe Systems - C:\Program Files\Common Files\Adobe Systems Shared\Service\Adobelmsvc.exe
O23 - Service: Automatic LiveUpdate Scheduler - Symantec Corporation - C:\Program Files\Symantec\LiveUpdate\ALUSchedulerSvc.exe
O23 - Service: Symantec Event Manager (ccEvtMgr) - Unknown owner - C:\Program Files\Common Files\Symantec Shared\ccSvcHst.exe" /h ccCommon (file missing)
O23 - Service: Symantec Settings Manager (ccSetMgr) - Unknown owner - C:\Program Files\Common Files\Symantec Shared\ccSvcHst.exe" /h ccCommon (file missing)
O23 - Service: Symantec Lic NetConnect service (CLTNetCnService) - Unknown owner - C:\Program Files\Common Files\Symantec Shared\ccSvcHst.exe" /h cltCommon (file missing)
O23 - Service: @%SystemRoot%\ehome\ehstart.dll,-101 (ehstart) - Unknown owner - %windir%\system32\svchost.exe (file missing)
O23 - Service: EZ-Backup Manager - Unknown owner - C:\Program Files\EZ-Backup\EZ-Backup Manager\EzBackup.exe
O23 - Service: HauppaugeTVServer - Hauppauge Computer Works - C:\PROGRA~1\WinTV\HCWTVS~1.EXE
O23 - Service: Symantec IS Password Validation (ISPwdSvc) - Symantec Corporation - C:\Program Files\Norton AntiVirus\isPwdSvc.exe
O23 - Service: LiveUpdate - Symantec Corporation - C:\PROGRA~1\Symantec\LIVEUP~1\LUCOMS~1.EXE
O23 - Service: LiveUpdate Notice Service Ex (LiveUpdate Notice Ex) - Unknown owner - C:\Program Files\Common Files\Symantec Shared\ccSvcHst.exe" /h ccCommon (file missing)
O23 - Service: LiveUpdate Notice Service - Unknown owner - C:\Program Files\Common Files\Symantec Shared\PIF\{B8E1DD85-8582-4c61-B58F-2F227FCA9A08}\PIFSvc.exe" /m "C:\Program Files\Common Files\Symantec Shared\PIF\{B8E1DD85-8582-4c61-B58F-2F227FCA9A08}\PifEng.dll (file missing)
O23 - Service: LVCOMSer - Logitech Inc. - C:\Program Files\Common Files\LogiShrd\LVCOMSER\LVComSer.exe
O23 - Service: Process Monitor (LVPrcSrv) - Logitech Inc. - C:\Program Files\Common Files\LogiShrd\LVMVFM\LVPrcSrv.exe
O23 - Service: LVSrvLauncher - Logitech Inc. - C:\Program Files\Common Files\LogiShrd\SrvLnch\SrvLnch.exe
O23 - Service: @%SystemRoot%\system32\qwave.dll,-1 (QWAVE) - Unknown owner - %windir%\system32\svchost.exe (file missing)
O23 - Service: @%SystemRoot%\system32\seclogon.dll,-7001 (seclogon) - Unknown owner - %windir%\system32\svchost.exe (file missing)
O23 - Service: Symantec Core LC - Symantec Corporation - C:\Program Files\Common Files\Symantec Shared\CCPD-LC\symlcsvc.exe
O23 - Service: Symantec AppCore Service (SymAppCore) - Symantec Corporation - C:\Program Files\Common Files\Symantec Shared\AppCore\AppSvc32.exe
O23 - Service: @%ProgramFiles%\Windows Media Player\wmpnetwk.exe,-101 (WMPNetworkSvc) - Unknown owner - %ProgramFiles%\Windows Media Player\wmpnetwk.exe (file missing)



Silent Runners Log Part 1:

'Silent Runners.vbs -- find out what starts up with Windows!
'(compatible with Windows 95/98/Millennium/NT 4.0/2000 Pro/XP Home & Pro/Vista RC1)
'
'DO NOT REMOVE THIS HEADER!
'
'Copyright Andrew ARONOFF 14 January 2007, http://www.silentrunners.org/
'This script is provided without any warranty, either express or implied
'It may not be copied or distributed without permission
'
'** YOU RUN THIS SCRIPT AT YOUR OWN RISK! ** (END OF HEADER)


Option Explicit

Dim strRevNo : strRevNo = "R50"

Public flagTest : flagTest = False 'True if in testing mode
'flagTest = True 'Uncomment to put in testing mode
Public arSecTest : arSecTest = Array() 'array of section numbers to test

Public intSection : intSection = 0 'section counter

'This script is divided into 28 sections.

'malware launch points:
' registry keys (1-12, 15)
' INI/INF-files (16-18)
' folders (19)
' enabled scheduled tasks (20)
' Winsock2 service provider DLLs (21)
' IE toolbars, explorer bars, extensions (22)
' started services (26)
' keyboard driver filters (27)
' printer monitors (28)

'hijack points:
' System/Group Policies (14)
' prefixes for IE URLs (23)
' misc IE points (24)
' HOSTS file (25)

'Output is suppressed if deemed normal unless the -all parameter is used
'Section XVIII is skipped unless the -supp/-all parameters are used or
'the first message box is answered "No" and the next message box "Yes"

' 1. HKCU/HKLM... Run/RunOnce/RunOnce\Setup/RunOnceEx
' HKLM... RunServices/RunServicesOnce
' HKCU/HKLM... Policies\Explorer\Run
' 2. HKLM... Active Setup\Installed Components\
' HKCU... Active Setup\Installed Components\
' (StubPath <> "" And HKLM version # > HKCU version #)
' 3. HKLM... Explorer\Browser Helper Objects\
' 4. HKLM... Shell Extensions\Approved\
' 5. HKLM... Explorer\SharedTaskScheduler/ShellExecuteHooks
' 6. HKCU/HKLM... ShellServiceObjectDelayLoad\
' 7. HKCU/HKLM... Command Processor\AutoRun
' HKCU... Policies\System\Shell (W2K/WXP/WVa only)
' HKCU... Windows\load & run
' HKLM... Windows\AppInit_DLLs
' HKCU/HKLM... Winlogon\Shell
' HKLM... Winlogon\Userinit, System, Ginadll, Taskman
' HKLM... Control\SafeBoot\Option\UseAlternateShell
' HKLM... Control\SecurityProviders\SecurityProviders
' HKLM... Control\Session Manager\BootExecute
' HKLM... Control\Session Manager\WOW\cmdline, wowcmdline
' 8. HKLM... Winlogon\Notify\ (subkey names/DLLName values <> O/S-specific dictionary data)
' 9. HKLM... Image File Execution Options ("Debugger" subkeys)
'10. HKCU/HKLM... Policies... Startup/Shutdown, Logon/Logoff scripts (W2K/WXP/WVa)
'11. HKCU/HKLM Protocols\Filter
'12. Context menu shell extensions
'13. HKCU/HKLM executable file type (bat/cmd/com/exe/hta/pif/scr)
'14. System/Group Policies
'15. Enabled Wallpaper & Screen Saver
'16. WIN.INI (load/run <> ""), SYSTEM.INI (shell <> explorer.exe, scrnsave.exe), WINSTART.BAT
'17. AUTORUN.INF in root directory of local fixed disks
'18. DESKTOP.INI in any local fixed disk directory (section skipped by default)
'19. %WINDIR%... Startup & All Users... Startup (W98/WMe) or
' %USERNAME%... Startup & All Users... Startup folder contents
'20. Enabled Scheduled Tasks
'21. Winsock2 Service Provider DLLs
'22. Internet Explorer Toolbars, Explorer Bars, Extensions
'23. Internet Explorer URL Prefixes
'24. Misc. IE Hijack Points
'25. HOSTS file
'26. Started Services
'27. Keyboard Driver Filters
'28. Print Monitors

Dim Wshso : Set Wshso = WScript.CreateObject("WScript.Shell")
Dim WshoArgs : Set WshoArgs = WScript.Arguments
Dim intErrNum, intMB, intMB1 'Err.Number, MsgBox return value x 2

Dim strflagTest : strflagTest = ""
If flagTest Then
strflagTest = "TEST "
Wshso.Popup "Silent Runners is in testing mode.",1, _
"Testing, testing, 1-2-3...", vbOKOnly + vbExclamation
End If

'Configuration Detection Section

' FileSystemObject creation error (112)
' CScript/WScript (147)
' Dim (161)
' GetFileVersion(WinVer.exe) (VBScript 5.1) (182)
' OS version (223)
' WMI (279)
' Dim (364)
' command line arguments (440)
' supplementary search MsgBox (532)
' startup MsgBox (557)
' CreateTextFile error (583)
' output file header (625)
' WXP SP2 (629)

On Error Resume Next
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
intErrNum = Err.Number : Err.Clear
On Error Goto 0

If intErrNum <> 0 Then

strURL = "http://tinyurl.com/7nn6"

intMB = MsgBox (Chr(34) & "Silent Runners" & Chr(34) &_
" cannot access file services critical to" & vbCRLF &_
"proper script operation." & vbCRLF & vbCRLF &_
"If you are running Windows XP, make sure that the" &_
vbCRLF & Chr(34) & "Cryptographic Services" & Chr(34) &_
" service is started." & vbCRLF & vbCRLF &_
"You can also try reinstalling the latest version of the MS" &_
vbCRLF & "Windows Script Host." & vbCRLF & vbCRLF &_
"Press " & Chr(34) & "OK" & Chr(34) & " to direct your browser to " &_
"the download site or" & vbCRLF & Space(10) & Chr(34) & "Cancel" &_
Chr(34) & " to quit.", vbOKCancel + vbCritical, _
"Can't access the FileSystemObject!")

'if dl wanted now, send browser to dl site
If intMB = 1 Then Wshso.Run strURL

WScript.Quit

End If

Dim oNetwk : Set oNetwk = WScript.CreateObject("WScript.Network")

Const HKLM = &H80000002, HKCU = &H80000001
Const REG_SZ=1, REG_EXPAND_SZ=2, REG_BINARY=3, REG_DWORD=4, REG_MULTI_SZ=7
Const REG_QWORD = 11
Const MS = " [MS]"
Const DQ = """", LBr = "{"
Const IWarn = "<<!>> ", HWarn = "<<H>> "

'determine whether output is via MsgBox/PopUp or Echo
Dim flagOut
If InStr(LCase(WScript.FullName),"wscript.exe") > 0 Then
flagOut = "W" 'WScript
ElseIf InStr(LCase(WScript.FullName),"cscript.exe") > 0 Then
flagOut = "C" 'CScript
Else 'echo and continue if it works
flagOut = "C" 'assume CScript-compatible
WScript.Echo "Neither " & Chr(34) & "WSCRIPT.EXE" & Chr(34) & " nor " &_
Chr(34) & "CSCRIPT.EXE" & Chr(34) & " was detected as " &_
"the script host." & vbCRLF & Chr(34) & "Silent Runners" & Chr(34) &_
" will assume that the script host is CSCRIPT-compatible and will" & vbCRLF &_
"use WScript.Echo for all messages."
End If 'script host

Const SysFolder = 1 : Const WinFolder = 0
Dim strOS : strOS = "Unknown"
Dim strOSLong : strOSLong = "Unknown"
Dim strOSXP : strOSXP = "Windows XP Home" 'XP Home or Pro
Public strFPSF : strFPSF = Fso.GetSpecialFolder(SysFolder).Path 'FullPathSystemFolder
Public strFPWF : strFPWF = Fso.GetSpecialFolder(WinFolder).Path 'FullPathWindowsFolder
Public strExeBareName 'bare file name w/o windows or system folder prefixes
Dim strSysVer 'Winver.exe version number
Dim intErrNum1, intErrNum2, intErrNum3, intErrNum4, intErrNum5, intErrNum6 'error number
Dim intLenValue 'value length
Dim strURL 'download URL
'assume Group Policies cannot be set in the O/S
Dim flagGP : flagGP = False
'HKCU/HKLM CLSID Lower Limit, default is HKLM for O/S <= NT4
Dim intCLL : intCLL = 1

'Winver.exe is in \Windows under W98, but in \System32 for other O/S's
'trap GetFileVersion error for VBScript version < 5.1
On Error Resume Next
If Fso.FileExists (strFPSF & "\Winver.exe") Then
strSysVer = Fso.GetFileVersion(strFPSF & "\Winver.exe")
Else
strSysVer = Fso.GetFileVersion(strFPWF & "\Winver.exe")
End If
intErrNum = Err.Number : Err.Clear
On Error Goto 0

'if GetFileVersion returns error due to old WSH version
If intErrNum <> 0 Then

'store dl URL
strURL = "http://tinyurl.com/7zh0"

'if using WScript
If flagOut = "W" Then

'explain the problem
intMB = MsgBox ("This script requires Windows Script Host (WSH) 5.1 " &_
"or higher to run." & vbCRLF & vbCRLF & "Press " & Chr(34) & "OK" &_
Chr(34) & " to direct your browser to the WSH download site or " &_
Chr(34) & "Cancel" & Chr(34) & " to quit." & vbCRLF & vbCRLF &_
"(WMI is also required. If it's missing, download instructions " &_
"will appear later.)", vbOKCancel + vbExclamation, _
"Unsupported Windows Script Host Version!")

'if dl wanted now, send browser to dl site
If intMB = 1 Then Wshso.Run strURL

'if using CScript
Else 'flagOut = "C"

'explain the problem
WScript.Echo Chr(34) & "Silent Runners" & Chr(34) & " requires " &_
"Windows Script Host 5.1 or higher to run." & vbCRLF & vbCRLF &_
"It can be downloaded at: " & strURL

End If 'WScript or CScript?

'quit the script
WScript.Quit

End If 'VBScript version error encountered?

'use WINVER.EXE file version to determine O/S
If Instr(Left(strSysVer,3),"4.1") > 0 Then
strOS = "W98" : strOSLong = "Windows 98"

ElseIf Instr(Left(strSysVer,5),"4.0.1") > 0 Then
strOS = "NT4" : strOSLong = "Windows NT 4.0"

ElseIf Instr(Left(strSysVer,8),"4.0.0.95") > 0 Then
strOS = "W98" : strOSLong = "Windows 95"

ElseIf Instr(Left(strSysVer,8),"4.0.0.11") > 0 Then
strOS = "W98" : strOSLong = "Windows 95 SR2 (OEM)"

ElseIf Instr(Left(strSysVer,3),"5.0") > 0 Then
strOS = "W2K" : strOSLong = "Windows 2000" : : intCLL = 0 : flagGP = True

ElseIf Instr(Left(strSysVer,3),"5.1") > 0 Then
'SP0 & SP1 = 5.1.2600.0, SP2 = 5.1.2600.2180
strOS = "WXP" : strOSLong = "Windows XP" : intCLL = 0

If Instr(strSysVer,".2180") > 0 Then strOSLong = "Windows XP SP2"

ElseIf Instr(Left(strSysVer,3),"4.9") > 0 Then
strOS = "WME" : strOSLong = "Windows Me (Millennium Edition)"

ElseIf Instr(Left(strSysVer,3),"5.2") > 0 Then
strOS = "WXP" : strOSLong = "Windows Server 2003 (interpreted as Windows XP)"
flagGP = True : intCLL = 0

ElseIf Instr(Left(strSysVer,3),"6.0") > 0 Then
strOS = "WVA" : strOSLong = "Windows Vista RC1"
flagGP = True : intCLL = 0

Else 'unknown strSysVer

If flagOut = "W" Then

intMB = MsgBox ("The " & Chr(34) & "Silent Runners" & Chr(34) &_
" script cannot determine the operating system." & vbCRLF & vbCRLF &_
"Click " & Chr(34) & "OK" & Chr(34) & " to send an e-mail to the " &_
"author, providing the following information:" & vbCRLF & vbCRLF &_
"WINVER.EXE file version = " & strSysVer & vbCRLF & vbCRLF &_
"or click " & Chr(34) & "Cancel" & Chr(34) & " to quit.", _
49,"O/S Unknown!")

If intMB = 1 Then Wshso.Run "mailto:Andrew%20Aronoff%20" &_
"<%6F%73.%76%65%72.%65%72%72%6F%72@%73%69%6C%65%6E%74%72%75%6E%6E%65%72%73.%6F%72%67>?" &_
"subject=Silent%20Runners%20OS%20Version%20Error&body=WINVER.EXE" &_
"%20file%20version%20=%20" & strSysVer

Else 'flagOut = "C"

WScript.Echo Chr(34) & "Silent Runners" & Chr(34) & " cannot " &_
"determine the operating system." & vbCRLF & vbCRLF & "This script will exit."

End If 'flagOut?

WScript.Quit

End If 'OS id'd from strSysVer?

'use WMI to connect to the registry
On Error Resume Next
Dim oReg : Set oReg = GetObject("winmgmts:\root\default:StdRegProv")
intErrNum = Err.Number : Err.Clear
On Error Goto 0

'detect WMI connection error
If intErrNum <> 0 Then

strURL = ""

'for W98/NT4, assume WMI not installed and direct to d/l URL
If strOS = "W98" Or strOS = "NT4" Then

If strOS = "W98" Then strURL = "http://tinyurl.com/jbxe"
If strOS = "NT4" Then strURL = "http://tinyurl.com/7wd7"

'invite user to download WMI & quit
If flagOut = "W" Then

intMB = MsgBox ("This script requires " & Chr(34) & "WMI" &_
Chr(34) & ", Windows Management Instrumentation, to run." &_
vbCRLF & vbCRLF & "It can be downloaded at: " & strURL &_
vbCRLF & vbCRLF & "Press " & Chr(34) & "OK" & Chr(34) &_
" to direct your browser to the download site or " &_
Chr(34) & "Cancel" & Chr(34) & " to quit.",_
vbOKCancel + vbCritical,"WMI Not Installed!")

If intMB = 1 Then Wshso.Run strURL

'at command line, explain & quit
Else 'flagOut = "C"

WScript.Echo Chr(34) & "Silent Runners" & Chr(34) & " requires " &_
Chr(34) & "WMI" & Chr(34) & ", Windows Management Instrumentation, " &_
"to run." & vbCRLF & vbCRLF & "It can be downloaded at: " & strURL

End If

'for W2K/WXP/WVa, explain how to start the WMI service
ElseIf strOS = "W2K" Or strOS = "WXP" or strOS = "WVA" Then

If strOS = "W2K" Then strLine = "Settings | Control Panel | "
If strOS = "WXP" Then strLine = "Control Panel | "
If strOS = "WVA" Then strLine = "Control Panel | Classic View | "

'explain how to turn on WMI service
If flagOut = "W" Then

MsgBox "This script requires Windows Management Instrumentation" &_
" to run." & vbCRLF & vbCRLF & "Click on Start | " & strLine &_
"Administrative Tools | Services," & vbCRLF &_
"and start the " & Chr(34) & "Windows Management Instrumentation" &_
Chr(34) & " service.",vbOKOnly + vbCritical,"WMI Service not running!"

'at command line, explain & quit
Else 'flagOut = "C"

WScript.Echo Chr(34) & "Silent Runners" & Chr(34) & " requires " &_
"Windows Management Instrumentation to run." & vbCRLF & vbCRLF &_
"Click on Start | " & strLine & "Administrative " &_
"Tools | Services" & vbCRLF & "and start the " & Chr(34) &_
"Windows Management Instrumentation" & Chr(34) & " service."

End If 'flagOut?

Else 'WMe

'say there's a WMI problem
If flagOut = "W" Then

MsgBox "This script requires WMI (Windows Management Instrumentation)" &_
" to run," & vbCRLF & "but WMI is not running correctly.", _
vbOKOnly + vbCritical,"WMI problem!"

'at command line, explain & quit
Else 'flagOut = "C"

WScript.Echo Chr(34) & "Silent Runners" & Chr(34) & " requires " &_
"WMI (Windows Management Instrumentation) to run," & vbCRLF &_
"but WMI is not running correctly."

End If 'flagOut?

End If 'which O/S?

WScript.Quit

End If 'WMI execution error

'array of Run keys, counter x 5, hive member, startup folder file,
'startup file shortcut, IERESET.INF file
Dim arRunKeys, i, ii, j, k, l, oHiveElmt, oSUFi, oSUSC
'dictionary, keys, items, hard disk collection
Dim arSK, arSKk, arSKi, colDisks

'arrays: Run key names, keys, sub-keys, value type, SecurityProviders,
' Protocol filters, values
Dim arNames(), arKeys(), arSubKeys(), arType, arSP, arFilter(), arValues
'Sub-Directory DeskTop.Ini array, Sub-Directory Error array, Error array
'Recognized GP names, allowed GP names
Public arSDDTI(), arSDErr(), arErr(), arRecNames(), arAllowedNames()

'DeskTop.Ini counter, Error counter x 2, Classes data Hive counter
Public ctrArDTI, ctrArErr, ctrErr, ctrCH
Public ctrFo : ctrFo = 0 'folder counter

'name member, key array member x 4, O/S, drive root directory, work file
Dim oName, oKey, oKey2, strMemKey, strMemSubKey, oOS, oRoot, oFileWk
'values x 7
Dim strValue, strValue1, strValue2, strValue3, strValue4, strValue5, strValue6
Dim strVal, intValue, strCmd
'name, single character, startup folder name, startup folder, array member, temp var
Dim strName, strChr, arSUFN, oSUF, strArMember, strTmp, strTmp2
'output string x 3
Public strOut, strOut1, strOut2

'output file msg x 2, warning string, title line
Dim strLine, strLine1, strLine2, strWarn, strTitleLine
'infection/hijack warning detection flags -- add footer note if True
Public flagIWarn : flagIWarn = False
Public flagHWarn : flagHWarn = False
Dim strKey, strKey1, strKey2, strKey3, strSubKey 'register key x 4, sub-key
'output file name string (incl. path), file name (wo path),
'PIF path string, single binary character
Dim strFN, strFNNP, strPIFTgt, bin1C
Public datLaunch : datLaunch = Now 'script launch time
Public intCnt 'counter
'ref time, time taken by 2 pop-up boxes
Public datRef : datRef = 0
Public datPUB1 : datPUB1 = 0 : Public datPUB2 : datPUB2 = 0

'TRUE if show all output (default values not filtered)
Public flagShowAll : flagShowAll = False
Dim strRptOutput : strRptOutput = "Output limited to non-default values, " &_
"except where indicated by " & Chr(34) & "{++}" & Chr(34) 'output file string
Public strTitle : strTitle = ""
Public strSubTitle : strSubTitle = ""
Public strSubSubTitle : strSubSubTitle = ""
Public flagNVP : flagNVP = False 'existence of name/value pairs in a key
Public flagInfect : flagInfect = False 'flag infected condition
Dim flagMatch 'flag matching keys
Dim flagAllow 'flag key on approved list
Dim flagFound 'flag key that exists in Registry
Dim flagDirArg : flagDirArg = False 'presence of output directory argument
Dim flagIsCLSID : flagIsCLSID = False 'true if argument in CLSID format
Dim flagTitle 'True if title has already been written
Dim flagAllArg : flagAllArg = False 'presence of all output argument
Dim flagArray 'flag array containing elements
Public flagSupp : flagSupp = False 'do *not* check for DESKTOP.INI in all
'directories of local fixed disks
Dim intLBSP 'Last BackSlash Position in path string
Dim intSS 'lowest sort subscript
Dim intType 'value type
Dim strDLL, strCN 'DLL name, company name
'string to signal all output by default
Public strAllOutDefault : strAllOutDefault = ""

Dim ScrPath : ScrPath = Fso.GetParentFolderName(WScript.ScriptFullName)
If Right(ScrPath,1) <> "\" Then ScrPath = ScrPath & "\"
'initialize Path of Output File Folder to script path
Dim strPathOFFo : strPathOFFo = ScrPath

'hive array
Public arHives(1,1)
arHives(0,0) = "HKCU" : arHives(1,0) = "HKLM"
arHives(0,1) = &H80000001 : arHives(1,1) = &H80000002

'set up argument usage message string

Dim strLSp, strCSp 'Leading Spaces, Centering Spaces
strLSp = Space(4) : strCSp = Space(33) 'WScript spacing
If flagOut = "C" Then 'CScript spacing
strLsp = Space(3) : strCSp = Space(28)
End If

Dim strMsg : strMsg = "Only two arguments are permitted:" &_
vbCRLF & vbCRLF &_
"1. the name of an existing directory for the output report" &_
vbCRLF & strLSp & "(embed in quotes if it contains spaces)" &_
vbCRLF & vbCRLF & strCSp & "AND:" & vbCRLF & vbCRLF &_
"2. " & Chr(34) & "-supp" & Chr(34) & " to search " &_
"all directories for DESKTOP.INI DLL" & vbCRLF &_
strLSp & "launch points" &_
vbCRLF & vbCRLF & strCSp & "-OR-" & vbCRLF & vbCRLF &_
"3. " & Chr(34) & "-all" & Chr(34) & " to output all non-empty " &_
"values and all launch" & vbCRLF & strLSp & "points checked"

'check if output directory or "-all" or "-supp" was supplied as argument
If WshoArgs.length > 0 And WshoArgs.length <= 2 Then

For i = 0 To WshoArgs.length-1

'if directory arg not already passed and arg directory exists
If Not flagDirArg And Fso.FolderExists(WshoArgs(i)) Then

'get the path & toggle the directory arg flag
Dim oOFFo : Set oOFFo = Fso.GetFolder(WshoArgs(i))
strPathOFFo = oOFFo.Path : flagDirArg = True
If Right(strPathOFFo,1) <> "\" Then strPathOFFo = strPathOFFo & "\"
Set oOFFo=Nothing

'if -all arg not already passed and is this arg
ElseIf Not flagAllArg And LCase(WshoArgs(i)) = "-all" Then

'toggle ShowAll flag, toggle the all arg flag, fill report string
flagShowAll = True : flagAllArg = True
strRptOutput = "Output of all locations checked and all values found."

'if -all arg not already passed and is this arg
ElseIf Not flagAllArg And LCase(WshoArgs(i)) = "-supp" Then
flagSupp = True : flagAllArg = True
strRptOutput = "Search enabled of all directories on local fixed " &_
"drives for DESKTOP.INI" & vbCRLF & " DLL launch points" &_
vbCRLF & strRptOutput

'argument can't be interpreted, so explain & quit
Else

If flagOut = "W" Then 'pop up a message window

Wshso.Popup "The argument:" & vbCRLF &_
Chr(34) & UCase(WshoArgs(i)) & Chr(34) & vbCRLF &_
"... can't be interpreted." & vbCRLF & vbCRLF &_
strMsg,10,"Bad Script Argument", vbOKOnly + vbExclamation

Else 'flagOut = "C" 'write the message to the console

WScript.Echo vbCRLF & "The argument: " &_
Chr(34) & UCase(WshoArgs(i)) & Chr(34) &_
" can't be interpreted." & vbCRLF & vbCRLF &_
strMsg & vbCRLF

End If 'WScript host?

WScript.Quit

End If 'argument can be interpreted?

Next 'argument

'too many args passed
ElseIf WshoArgs.length > 2 Then

'explain & quit
If flagOut = "W" Then 'pop up a message window

Wshso.Popup "Too many arguments (" & WshoArgs.length & ") were passed." &_
vbCRLF & vbCRLF & strMsg,10,"Too Many Arguments",_
vbOKOnly + vbCritical

Else 'flagOut = "C" 'write the message to the console

WScript.Echo "Too many arguments (" & WshoArgs.length & ") were passed." &_
vbCRLF & vbCRLF & strMsg & vbCRLF

End If 'WScript host?

WScript.Quit

End If 'directory arguments passed?

Set WshoArgs=Nothing

datRef = Now

'if no cmd line argument for flagSupp and not testing, show popup
If Not flagTest And Not flagShowAll And Not flagSupp And flagOut = "W" Then

intMB = Wshso.Popup ("Do you want to skip the supplementary search?" &_
vbCRLF & "(It typically takes several minutes.)" & vbCRLF & vbCRLF &_
"Press " & Chr(34) & "Yes" & Chr(34) & Space(5) &_
" to skip the supplementary search (default)" & vbCRLF & vbCRLF &_
Space(10) & Chr(34) & "No" & Chr(34) & Space(6) &_
" to perform it, or" & vbCRLF & vbCRLF &_
Space(10) & Chr(34) & "Cancel" & Chr(34) &_
" to get more information at the web site" & vbCRLF &_
Space(25) & "and exit the script.",_
15,"Skip supplementary search?",_
vbYesNoCancel + vbQuestion + vbDefaultButton1 + vbSystemModal)

If intMB = vbNo Then

flagSupp = True

intMB1 = MsgBox ("Are you SURE you want to run the supplementary " &_
"search?" & vbCRLF & vbCRLF & "It's _rarely_ necessary " &_
"and it takes a *long* time." & vbCRLF & vbCRLF & "Press " & DQ &_
"Yes" & DQ & " to confirm running the supplementary search, " &_
"or" & vbCRLF & Space(10) & DQ & "No" & DQ & " to run without it.", _
vbYesNo + vbQuestion + vbDefaultButton2 + vbSystemModal,"Are you sure?")

If intMB1 = vbNo Then flagSupp = False

ElseIf intMB = vbCancel Then
Wshso.Run "http://www.silentrunners.org/sr_thescript.html#supp"
WScript.Quit
End If

End If

datPUB1 = DateDiff("s",datRef,Now) : datRef = Now

'inform user that script has started
If Not flagTest Then
If flagOut = "W" Then
Wshso.PopUp Chr(34) & "Silent Runners" & Chr(34) & " has started." &_
vbCRLF & vbCRLF & "A message box like this one will appear " &_
"when it's done." & vbCRLF & vbCRLF & "Please be patient...",3,_
"Silent Runners R" & strRevNo & " startup", _
vbOKOnly + vbInformation + vbSystemModal
Else
WScript.Echo Chr(34) & "Silent Runners" & Chr(34) & " has started." &_
" Please be patient..."
End If 'flagOut?
End If 'flagTest?

datPUB2 = DateDiff("s",datRef,Now)

'create output file name with computer name & today's date
'Startup Programs (pc_name_here) yyyy-mm-dd.txt

strFNNP = "Startup Programs (" & oNetwk.ComputerName & ") " &_
FmtDate(datLaunch) & " " & FmtHMS(datLaunch) & ".txt"
strFN = strPathOFFo & strflagTest & strFNNP
On Error Resume Next
If Fso.FileExists(strFN) Then Fso.DeleteFile(strFN)
Err.Clear
Public oFN : Set oFN = Fso.CreateTextFile(strFN,True)
intErrNum = Err.Number : Err.Clear
On Error Goto 0

'if can't create report file
If intErrNum > 0 Then

strURL = "http://www.silentrunners.org/Silent%20Runners%20RED.vbs"

'invite user to run RED version & quit
If flagOut = "W" Then

intMB = MsgBox ("The script cannot create its report file. " &_
"This is a known, intermittent" & vbCRLF & "problem under " &_
strOSLong & "." & vbCRLF & vbCRLF &_
"An alternative script version is available for download. " &_
"After it runs, " & vbCRLF & "the script you're using now will " &_
"run correctly." & vbCRLF & vbCRLF &_
"Press " & Chr(34) & "OK" & Chr(34) & " to direct your browser " &_
"to the alternate script location, or" & vbCRLF & Space(10) &_
Chr(34) & "Cancel" & Chr(34) & " to quit.",49,"CreateTextFile Error!")

'if alternative script wanted now, send browser to dl site
If intMB = 1 Then Wshso.Run strURL

'explain & quit
Else 'flagOut = "C"

WScript.Echo Chr(34) & "Silent Runners" & Chr(34) & " cannot " &_
"create the report file." & vbCRLF & vbCRLF &_
"An alternative script is available. Run it, then rerun this version." &_
vbCRLF & "The alternative script can be downloaded at: " & vbCRLF &_
vbCRLF & strURL

End If

WScript.Quit

End If 'report file creation error?

'add report header
Set oNetwk=Nothing

oFN.WriteLine Chr(34) & "Silent Runners.vbs" & Chr(34) &_
", revision " & strRevNo & ", [url="http://www.silentrunners.org/""]http://www.silentrunners.org/"[/url] &_
vbCRLF & "Operating System: " & strOSLong & vbCRLF & strRptOutput

'test for WMI corruption and use WMI to differentiate between
'WXP Home & WXP Pro

'get the O/S collection
Dim colOS : Set colOS = GetObject("winmgmts:\root\cimv2").ExecQuery _
("Select * from Win32_OperatingSystem")

On Error Resume Next

Err.Clear

For Each oOS in colOS

If strOS = "WXP" Then

'modify strOSXP if O/S = Pro
If InStr(1,LCase(oOS.Name),"professional",1) > 0 Then
strOSXP = "Windows XP Professional"
flagGP = True
End If
'modify strOSXP if SP2
If Right(strOSLong,3) = "SP2" Then strOSXP = strOSXP & " SP2"

End If 'WXP?

Next 'oOS

If Err.Number <> 0 Then

strURL = "http://go.microsoft.com/fwlink/?LinkId=62562"

oFN.WriteLine vbCRLF & "FATAL ERROR!" & vbCRLF & String(12,"-") &_
vbCRLF & vbCRLF & DQ & "Silent Runners" & DQ &_
" cannot use WMI to identify the operating system." &_
vbCRLF & "This is caused by corruption of the WMI installation." &_
vbCRLF & vbCRLF &_
"WMI is complex and it is recommended that you use a Microsoft" &_
vbCRLF & "tool, " & DQ & "WMIDiag.vbs," & DQ & " to diagnose WMI " &_
"on your system." & vbCRLF & vbCRLF & "It can be downloaded here:" &_
vbCRLF & vbCRLF & strURL

intMB = MsgBox (DQ & "Silent Runners" & DQ & " cannot use WMI to " &_
"identify the operating system." & vbCRLF & "This is caused by " &_
"corruption of the WMI installation." &_
vbCRLF & vbCRLF &_
"WMI is complex and it is recommended that you use a Microsoft" &_
vbCRLF & "tool, " & DQ & "WMIDiag.vbs," & DQ & " to diagnose WMI " &_
"on your system." &_
vbCRLF & vbCRLF &_
"Press " & DQ & "OK" & DQ & " to direct your browser to the " &_
"WMIDiag download site or" &_
vbCRLF & Space(10) & DQ & "Cancel" & DQ & " to quit.",_
vbOKCancel + vbCritical + + vbSystemModal + vbDefaultButton2,_
"Can't iterate Win32_OperatingSystem!")

'if dl wanted now, send browser to dl site
If intMB = 1 Then Wshso.Run strURL

WScript.Quit

End If 'Err.Number<>0?

On Error Goto 0

Set colOS=Nothing




'#1. HKCU/HKLM... Run/RunOnce/RunOnce\Setup/RunOnceEx
' HKLM... RunServices/RunServicesOnce
' HKCU/HKLM... Policies\Explorer\Run

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

'write registry header lines to file
strTitle = "Startup items buried in registry:"
TitleLineWrite

'put keys in array (Key Index 0 - 6)
arRunKeys = Array ("Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run", _
"Software\Microsoft\Windows\CurrentVersion\Run", _
"Software\Microsoft\Windows\CurrentVersion\RunOnce", _
"Software\Microsoft\Windows\CurrentVersion\RunOnce\Setup", _
"Software\Microsoft\Windows\CurrentVersion\RunOnceEx", _
"Software\Microsoft\Windows\CurrentVersion\RunServices", _
"Software\Microsoft\Windows\CurrentVersion\RunServicesOnce")

'Key Execution Flag/Subkey Recursion Flag array
'
'first number in the ordered pair in the array immediately below
' pertains to execution of the key:
'0: not executed (ignore)
'1: may be executed so display with EXECUTION UNLIKELY warning
'2: executable
'
'second number in the ordered pair pertains to subkey recursion
'0: subkeys not used
'1: subkey recursion necessary

'0 Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run
'1 Software\Microsoft\Windows\CurrentVersion\Run
'2 Software\Microsoft\Windows\CurrentVersion\RunOnce
'3 Software\Microsoft\Windows\CurrentVersion\RunOnce\Setup
'4 Software\Microsoft\Windows\CurrentVersion\RunOnceEx
'5 Software\Microsoft\Windows\CurrentVersion\RunServices
'6 Software\Microsoft\Windows\CurrentVersion\RunServicesOnce

'Hive HKCU - 0 HKLM - 1
'
'Key 0 1 2 3 4 5 6 0 1 2 3 4 5 6
'Index

'O/S:
'W95 0,0 2,0 2,0 0,0 2,1 0,0 0,0 0,0 2,0 2,0 0,0 2,1 2,0 2,0
'W98 0,0 2,0 2,0 0,0 2,1 0,0 0,0 0,0 2,0 2,0 2,0 2,1 2,0 2,0
'WMe 2,1 2,1 2,0 2,0 2,1 0,0 0,0 2,1 2,1 2,0 2,0 2,1 2,0 2,0
'NT4 0,0 2,0 2,0 0,0 2,1 0,0 0,0 0,0 2,0 2,0 0,0 2,1 0,0 0,0
'W2K 2,1 2,1 2,1 0,0 2,1 0,0 0,0 2,1 2,1 2,1 0,0 2,1 0,0 0,0
'WXP 2,0 2,0 2,0 0,0 2,1 0,0 0,0 2,0 2,0 2,0 0,0 2,1 0,0 0,0
'WS2K3 ??? <-------------------- ??? --------------------> ???
'WVa 2,0 2,0 2,0 0,0 2,1 0,0 0,0 2,0 2,0 2,0 0,0 2,1 0,0 0,0

'arRegFlag(i,j,k): put flags in array by O/S:
'hive = i (0 or 1), key_# = j (0-6),
' flags (key execution/subkey recursion) = k (0 or 1)
' k = 0 holds key execution value = 0/1/2
' 1 holds subkey recursion value = 0/1
Dim arRegFlag()
ReDim arRegFlag(1,6,1)

'initialize entire array to zero
For i = 0 To 1 : For j = 0 To 6 : For k = 0 To 1
arRegFlag(i,j,k) = 0
Next : Next : Next

'add data to array for O/S that's running

'W98
If strOS = "W98" Then
arRegFlag(0,1,0) = 2 'HKCU,Run = no-warn
arRegFlag(0,2,0) = 2 'HKCU,RunOnce = no-warn
arRegFlag(0,4,0) = 2 'HKCU,RunOnceEx = no-warn
arRegFlag(0,4,1) = 1 'HKCU,RunOnceEx = sub-keys
arRegFlag(1,1,0) = 2 'HKLM,Run = no-warn
arRegFlag(1,2,0) = 2 'HKLM,RunOnce = no-warn
'don't set HKLM,RunOnce\Setup for W95
If strOSLong = "Windows 98" Then _
arRegFlag(1,3,0) = 2 'HKLM,RunOnce\Setup = no-warn
arRegFlag(1,4,0) = 2 'HKLM,RunOnceEx = no-warn
arRegFlag(1,4,1) = 1 'HKLM,RunOnceEx = sub-keys
arRegFlag(1,5,0) = 2 'HKLM,RunServices = no-warn
arRegFlag(1,6,0) = 2 'HKLM,RunServicesOnce = no-warn
End If

If strOS = "WME" Then
arRegFlag(0,0,0) = 2 'HKCU,Explorer\Run = no-warn
arRegFlag(0,0,1) = 1 'HKCU,Explorer\Run = sub-keys
arRegFlag(0,1,0) = 2 'HKCU,Run = no-warn
arRegFlag(0,1,1) = 1 'HKCU,Run = sub-keys
arRegFlag(0,2,0) = 2 'HKCU,RunOnce = no-warn
arRegFlag(0,3,0) = 2 'HKCU,RunOnce\Setup = no-warn
arRegFlag(0,4,0) = 2 'HKCU,RunOnceEx = no-warn
arRegFlag(0,4,1) = 1 'HKCU,RunOnceEx = sub-keys
arRegFlag(1,0,0) = 2 'HKLM,Explorer\Run = no-warn
arRegFlag(1,0,1) = 1 'HKLM,Explorer\Run = sub-keys
arRegFlag(1,1,0) = 2 'HKLM,Run = no-warn
arRegFlag(1,1,1) = 1 'HKLM,Run = sub-keys
arRegFlag(1,2,0) = 2 'HKLM,RunOnce = no-warn
arRegFlag(1,3,0) = 2 'HKLM,RunOnce\Setup = no-warn
arRegFlag(1,4,0) = 2 'HKLM,RunOnceEx = no-warn
arRegFlag(1,4,1) = 1 'HKLM,RunOnceEx = sub-keys
arRegFlag(1,5,0) = 2 'HKLM,RunServices = no-warn
arRegFlag(1,6,0) = 2 'HKLM,RunServicesOnce = no-warn
End If

'NT4
If strOS = "NT4" Then
arRegFlag(0,1,0) = 2 'HKCU,Run = no-warn
arRegFlag(0,2,0) = 2 'HKCU,RunOnce = no-warn
arRegFlag(0,4,0) = 2 'HKCU,RunOnceEx = no-warn
arRegFlag(0,4,1) = 1 'HKCU,RunOnceEx = sub-keys
arRegFlag(1,1,0) = 2 'HKLM,Run = no-warn
arRegFlag(1,2,0) = 2 'HKLM,RunOnce = no-warn
arRegFlag(1,4,0) = 2 'HKLM,RunOnceEx = no-warn
arRegFlag(1,4,1) = 1 'HKLM,RunOnceEx = sub-keys
End If

'W2K
If strOs = "W2K" Then
arRegFlag(0,0,0) = 2 'HKCU,Explorer\Run = no-warn
arRegFlag(0,0,1) = 1 'HKCU,Explorer\Run = sub-keys
arRegFlag(0,1,0) = 2 'HKCU,Run = no-warn
arRegFlag(0,1,1) = 1 'HKCU,Run = sub-keys
arRegFlag(0,2,0) = 2 'HKCU,RunOnce = no-warn
arRegFlag(0,2,1) = 1 'HKCU,RunOnce = sub-keys (incl. Setup)
arRegFlag(0,4,0) = 2 'HKCU,RunOnceEx = no-warn
arRegFlag(0,4,1) = 1 'HKCU,RunOnceEx = sub-keys
arRegFlag(1,0,0) = 2 'HKLM,Explorer\Run = no-warn
arRegFlag(1,0,1) = 1 'HKLM,Explorer\Run = sub-keys
arRegFlag(1,1,0) = 2 'HKLM,Run = no-warn
arRegFlag(1,1,1) = 1 'HKLM,Run = sub-keys
arRegFlag(1,2,0) = 2 'HKLM,RunOnce = no-warn
arRegFlag(1,2,1) = 1 'HKLM,RunOnce = sub-keys (incl. Setup)
arRegFlag(1,4,0) = 2 'HKLM,RunOnceEx = no-warn
arRegFlag(1,4,1) = 1 'HKLM,RunOnceEx = sub-keys
End If

'WXP/WVa
If strOs = "WXP" Or strOS = "WVA" Then
arRegFlag(0,0,0) = 2 'HKCU,Explorer\Run = no-warn
arRegFlag(0,1,0) = 2 'HKCU,Run = no-warn
arRegFlag(0,2,0) = 2 'HKCU,RunOnce = no-warn
arRegFlag(0,4,0) = 2 'HKLM,RunOnceEx = no-warn
arRegFlag(0,4,1) = 1 'HKLM,RunOnceEx = sub-keys
arRegFlag(1,0,0) = 2 'HKLM,Explorer\Run = no-warn
arRegFlag(1,1,0) = 2 'HKLM,Run = no-warn
arRegFlag(1,2,0) = 2 'HKLM,RunOnce = no-warn
arRegFlag(1,4,0) = 2 'HKLM,RunOnceEx = no-warn
arRegFlag(1,4,1) = 1 'HKLM,RunOnceEx = sub-keys
End If

'for each hive
For i = 0 To 1

'for each key
For j = 0 To 6

'if not ShowAll, show all output for Run keys
If j = 1 And Not flagShowAll Then strAllOutDefault = " {++}"

'if key is not ignored
If arRegFlag(i,j,0) > 0 Then

flagNVP = False

'intialize string with warning if necessary
strWarn = ""
If arRegFlag(i,j,0) = 1 Then strWarn = "EXECUTION UNLIKELY: "

'INFO
'with no name/value pairs (sub-keys are identical)
' IsArray TypeName UBound
'W98 True "Variant()" -1
'WMe True "Variant()" -1
'NT4 True "Variant()" -1
'W2K False "Null" error (--)
'WXP False "Null" error (--)
'WS2K3 True "Variant()" error (--)
'WVa False "Null" error (--)

EnumNVP arHives(i,1), arRunKeys(j), arNames, arType

If flagNVP Then 'name/value pairs exist

'write the full key name
oFN.WriteLine vbCRLF & arHives(i,0) & "\" & arRunKeys(j) & "\" & strAllOutDefault

'for each data type in the names array
For k = LBound(arNames) To UBound(arNames)

'use the type to find the value
strValue = RtnValue (arHives(i,1), arRunKeys(j), arNames(k), arType(k))
'write the name & value
WriteValueData arNames(k), strValue, arType(k), strWarn

Next 'member of names array

Else 'no name/value pairs

If flagShowAll Then _
oFN.WriteLine vbCRLF & arHives(i,0) & "\" & arRunKeys(j) & "\"

End If 'flagNVP?

'recurse subkeys if necessary
If arRegFlag(i,j,1) = 1 Then

'put all subkeys into array
oReg.EnumKey arHives(i,1),arRunKeys(j),arKeys

'excludes W2K/WXP/WVa with no sub-keys
If IsArray(arKeys) Then

'excludes W98/WMe/NT4/WS2K3 with no sub-keys
For Each strMemKey in arKeys

flagNVP = False
strSubKey = arRunKeys(j) & "\" & strMemKey

EnumNVP arHives(i,1), arRunKeys(j) & "\" & strMemKey,arNames,arType

If flagNVP Then 'if name/value pairs exist

'write the full key name
oFN.WriteLine vbCRLF & arHives(i,0) & "\" & strSubKey &_
"\" & strAllOutDefault

'for each data type in the names array
For k = LBound(arNames) To UBound(arNames)

'use the type to find the value
strValue = RtnValue (arHives(i,1), strSubKey, arNames(k), arType(k))
'write the name & value
WriteValueData arNames(k), strValue, arType(k), strWarn

Next 'member of names array

Else 'no name/value pairs

If flagShowAll Then _
oFN.WriteLine vbCRLF & arHives(i,0) & "\" & strSubKey & "\"

End If 'flagNVP?

Next 'sub-key

End If 'sub-keys exist? W2K/WXP/WS2K3/WVa

End If 'enum sub-keys?

End If 'arRegFlag(i,j,0) > 0

Next 'Run key

Next 'Hive

strAllOutDefault = "" : flagNVP = False

'recover array memory
ReDim arRunKeys(0)
ReDim arKeys(0)
ReDim arRegFlag(0)

End If 'flagTest And SecTest?




'#2. HKLM... Active Setup\Installed Components\
' HKCU... Active Setup\Installed Components\

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

'flags True if only numeric & comma chrs in Version values
Dim flagHKLMVer, flagHKCUVer
'StubPath Value string, HKLM Version value, HKCU Version value, HKLM program name
Dim strSPV, strHKLMVer, strHKCUVer, strPgmName
Dim arHKLMKeys, arHKCUKeys, strHKLMKey, strHKCUKey

strKey = "Software\Microsoft\Active Setup\Installed Components"

strSubTitle = "HKLM" & "\" & strKey & "\"

'find all the subkeys
oReg.EnumKey HKLM, strKey, arHKLMKeys 'HKLM
oReg.EnumKey HKCU, strKey, arHKCUKeys 'HKCU

'enumerate HKLM keys if present
If IsArray(arHKLMKeys) Then

'for each HKLM key
For Each strHKLMKey In arHKLMKeys

'INFO
'Default Value not set:
'W98/WMe: returns 0, strValue = ""
'NT4/W2K/WXP/WVa: returns non-zero, strValue = Null

'Non-Default name inexistent:
'W98/WMe/NT4/W2K/WXP/WVa: returns non-zero, strValue = Null

'Non-Default Value not set:
'W2K: returns 0, strValue = unwritable string
'W98/WMe/NT4/WXP/WVa: returns 0, strValue = ""

'get the StubPath value
intErrNum = oReg.GetStringValue (HKLM,strKey & "\" & strHKLMKey,"StubPath",strSPV)

'if the StubPath name exists And value set (exc for W2K!)
If intErrNum = 0 And strSPV <> "" Then

flagMatch = False

'if HKCU keys present
If IsArray(arHKCUKeys) Then

'for each HKCU key
For Each strHKCUKey in arHKCUKeys

'if identical HKLM key exists
If LCase(strHKLMKey) = LCase(strHKCUKey) Then

'assume Version fmts are OK
flagHKLMVer = True : flagHKCUVer = True

'get HKLM & HKCU Version values
intErrNum1 = oReg.GetStringValue (HKLM,strKey & "\" & strHKLMKey, _
"Version",strHKLMVer) 'HKLM Version #
intErrNum2 = oReg.GetStringValue (HKCU,strKey & "\" & strHKCUKey, _
"Version",strHKCUVer) 'HKCU Version #

'if HKLM Version name exists And value set (exc for W2K!)
If intErrNum1 = 0 And strHKLMVer <> "" Then

'the next two loops check for allowed chars (numeric & comma)
' in returned Version values

For i = 1 To Len(strHKLMVer)
strChr = Mid(strHKLMVer,i,1)
If Not IsNumeric(strChr) And strChr <> "," Then flagHKLMVer = False
Next

'if HKCU Version name exists And value set (exc for W2K!)
If intErrNum2 = 0 And strHKCUVer <> "" Then

'check that value consists only of numeric & comma chrs
For i = 1 To Len(strHKCUVer)
strChr = Mid(strHKCUVer,i,1)
If Not IsNumeric(strChr) And strChr <> "," Then flagHKCUVer = False
Next

End If 'HKCU Version null or MT?

'if HKLM Ver # has illegal fmt (i.e., is not assigned) or doesn't exist (is Null)
' or is empty, match = True
'if HKCU/HKLM Ver # fmts OK And HKCU Ver # >= HKLM Ver #, match = True
'if HKLM Ver # = "0,0" and HKCU Ver # = "", key will output
' but StubPath will not launch
If Not flagHKLMVer Then flagMatch = True
If flagHKLMVer And flagHKCUVer And strHKCUVer >= strHKLMVer Then flagMatch = True

Else 'HKLM Version name doesn't exist Or value not set (exc for W2K!)

flagMatch = True

End If 'HKLM Version name exists And value set (exc for W2K!)?

End If 'HKCU key=HKLM key?

Next 'HKCU Installed Components key

End If 'HKCU Installed Components subkeys exist?

'if the StubPath will launch
If Not flagMatch Then

flagAllow = False 'assume StubPath DLL not on approved list
strCN = CoName(IDExe(strSPV))

'test for approved StubPath DLL
If LCase(strHKLMKey) = ">{22d6f312-b0f6-11d0-94ab-0080c74c7e95}" And _
(InStr(LCase(strSPV),"wmpocm.exe") > 0 Or _
InStr(LCase(strSPV),"unregmp2.exe") > 0) And _
strCN = MS And Not flagShowAll Then flagAllow = True

'StubPath DLL not approved
If Not flagAllow Then

'get the default value (program name)
intErrNum3 = oReg.GetStringValue (HKLM,strKey & "\" & strHKLMKey,"",strPgmName)
'enclose pgm name in quotes if name exists and default value isn't empty
If intErrNum3 = 0 And strPgmName <> "" Then
strPgmName = Chr(34) & strPgmName & Chr(34)
Else
strPgmName = "(no title provided)"
End If

TitleLineWrite

'output the CLSID & pgm name
oFN.WriteLine strHKLMKey & "\(Default) = " & StringFilter(strPgmName,False)

On Error Resume Next
'output the StubPath value
oFN.WriteLine Space(Len(strHKLMKey)+1) & "\StubPath = " &_
Chr(34) & strSPV & Chr(34) & strCN
'error check for W2K if StubPath value not set
If Err.Number <> 0 Then oFN.WriteLine Space(Len(strHKLMKey)+1) & "\StubPath = " &_
"(value not set)"
Err.Clear
On Error GoTo 0

End If 'flagAllow false?

End If 'flagMatch false?

End If 'StubPath value exists?

Next 'HKLM Installed Components subkey

End If 'HKLM Installed Components subkeys exist?

If flagShowAll Then TitleLineWrite

'recover array memory
ReDim arHKLMKeys(0)
ReDim arHKCUKeys(0)

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

End If 'SecTest?




'#3. HKLM... Explorer\Browser Helper Objects

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

strKey = "Software\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects"
strSubTitle = "HKLM" & "\" & strKey & "\"

'find all the subkeys
oReg.EnumKey HKLM, strKey, arSubKeys

'enumerate data if present
If IsArray(arSubKeys) Then

'for each key
For Each strSubKey In arSubKeys

flagTitle = False

CLSIDLocTitle HKLM, strKey & "\" & strSubKey, "", strLocTitle

For ctrCH = intCLL To 1

ResolveCLSID strSubKey, arHives(ctrCH,1), strCLSIDTitle, strIPSDLL

If strIPSDLL <> "" Then

'output the title line if not already done
TitleLineWrite

If Not flagTitle Then

'error check for W2K if value not set
On Error Resume Next
oFN.WriteLine strSubKey & "\(Default) = " & strLocTitle
intErrNum = Err.Number : Err.Clear
If intErrNum <> 0 Then oFN.WriteLine strSubKey &_
"\(Default) = (no title provided)"
flagTitle = True
On Error GoTo 0

End If

'output CLSID title, InProcServer32 DLL & CoName
oFN.WriteLine " -> {" & arHives(ctrCH,0) & "...CLSID} = " &_
strCLSIDTitle & vbCRLF & Space(19) & "\InProcServer32\(Default) = " &_
StringFilter(strIPSDLL,True) & CoName(IDExe(strIPSDLL))

End If 'strIPSDLL exists?

Next 'CLSID hive

Next 'BHO subkey

End If 'BHO subkeys exist?

'if ShowAll, output the key name if not already done
If flagShowAll Then TitleLineWrite
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

'recover array memory
ReDim arSubKeys(0)

End If 'SecTest?




'#4. HKLM... Shell Extensions\Approved\

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

'CLSID value, InProcessServer32 DLL name & output file version,
'CLSID Key Title display flag
Dim strCLSID, strIPSDLL, strIPSDLLOut, strCLSIDTitle, strLocTitle

'Shell Extension Approved array
Dim arSEA()
ReDim arSEA(388,1)
'WXP
arSEA(0,0) = "{00022613-0000-0000-C000-000000000046}" : arSEA(0,1) = "mmsys.cpl"
arSEA(1,0) = "{176d6597-26d3-11d1-b350-080036a75b03}" : arSEA(1,1) = "icmui.dll"
arSEA(2,0) = "{1F2E5C40-9550-11CE-99D2-00AA006E086C}" : arSEA(2,1) = "rshx32.dll"
arSEA(3,0) = "{3EA48300-8CF6-101B-84FB-666CCB9BCD32}" : arSEA(3,1) = "docprop.dll"
arSEA(4,0) = "{40dd6e20-7c17-11ce-a804-00aa003ca9f6}" : arSEA(4,1) = "ntshrui.dll"
arSEA(5,0) = "{41E300E0-78B6-11ce-849B-444553540000}" : arSEA(5,1) = "themeui.dll"
arSEA(6,0) = "{42071712-76d4-11d1-8b24-00a0c9068ff3}" : arSEA(6,1) = "deskadp.dll"
arSEA(7,0) = "{42071713-76d4-11d1-8b24-00a0c9068ff3}" : arSEA(7,1) = "deskmon.dll"
arSEA(8,0) = "{42071714-76d4-11d1-8b24-00a0c9068ff3}" : arSEA(8,1) = "deskpan.dll"
arSEA(9,0) = "{4E40F770-369C-11d0-8922-00A024AB2DBB}" : arSEA(9,1) = "dssec.dll"
arSEA(10,0) = "{513D916F-2A8E-4F51-AEAB-0CBC76FB1AF8}" : arSEA(10,1) = "SlayerXP.dll"
arSEA(11,0) = "{56117100-C0CD-101B-81E2-00AA004AE837}" : arSEA(11,1) = "shscrap.dll"
arSEA(12,0) = "{59099400-57FF-11CE-BD94-0020AF85B590}" : arSEA(12,1) = "diskcopy.dll"
arSEA(13,0) = "{59be4990-f85c-11ce-aff7-00aa003ca9f6}" : arSEA(13,1) = "ntlanui2.dll"
arSEA(14,0) = "{5DB2625A-54DF-11D0-B6C4-0800091AA605}" : arSEA(14,1) = "icmui.dll"
arSEA(15,0) = "{675F097E-4C4D-11D0-B6C1-0800091AA605}" : arSEA(15,1) = "icmui.dll"
arSEA(16,0) = "{764BF0E1-F219-11ce-972D-00AA00A14F56}" : arSEA(16,1) = ""
arSEA(17,0) = "{77597368-7b15-11d0-a0c2-080036af3f03}" : arSEA(17,1) = "printui.dll"
arSEA(18,0) = "{7988B573-EC89-11cf-9C00-00AA00A14F56}" : arSEA(18,1) = "dskquoui.dll"
arSEA(19,0) = "{853FE2B1-B769-11d0-9C4E-00C04FB6C6FA}" : arSEA(19,1) = ""
arSEA(20,0) = "{85BBD920-42A0-1069-A2E4-08002B30309D}" : arSEA(20,1) = "syncui.dll"
arSEA(21,0) = "{88895560-9AA2-1069-930E-00AA0030EBC8}" : arSEA(21,1) = "hticons.dll"
arSEA(22,0) = "{BD84B380-8CA2-1069-AB1D-08000948F534}" : arSEA(22,1) = "fontext.dll"
arSEA(23,0) = "{DBCE2480-C732-101B-BE72-BA78E9AD5B27}" : arSEA(23,1) = "icmui.dll"
arSEA(24,0) = "{F37C5810-4D3F-11d0-B4BF-00AA00BBB723}" : arSEA(24,1) = "rshx32.dll"
arSEA(25,0) = "{f81e9010-6ea4-11ce-a7ff-00aa003ca9f6}" : arSEA(25,1) = "ntshrui.dll"
arSEA(26,0) = "{f92e8c40-3d33-11d2-b1aa-080036a75b03}" : arSEA(26,1) = "deskperf.dll"
arSEA(27,0) = "{7444C717-39BF-11D1-8CD9-00C04FC29D45}" : arSEA(27,1) = "cryptext.dll"
arSEA(28,0) = "{7444C719-39BF-11D1-8CD9-00C04FC29D45}" : arSEA(28,1) = "cryptext.dll"
arSEA(29,0) = "{7007ACC7-3202-11D1-AAD2-00805FC1270E}" : arSEA(29,1) = "NETSHELL.dll"
arSEA(30,0) = "{992CFFA0-F557-101A-88EC-00DD010CCC48}" : arSEA(30,1) = "NETSHELL.dll"
arSEA(31,0) = "{E211B736-43FD-11D1-9EFB-0000F8757FCD}" : arSEA(31,1) = "wiashext.dll"
arSEA(32,0) = "{FB0C9C8A-6C50-11D1-9F1D-0000F8757FCD}" : arSEA(32,1) = "wiashext.dll"
arSEA(33,0) = "{905667aa-acd6-11d2-8080-00805f6596d2}" : arSEA(33,1) = "wiashext.dll"
arSEA(34,0) = "{3F953603-1008-4f6e-A73A-04AAC7A992F1}" : arSEA(34,1) = "wiashext.dll"
arSEA(35,0) = "{83bbcbf3-b28a-4919-a5aa-73027445d672}" : arSEA(35,1) = "wiashext.dll"
arSEA(36,0) = "{F0152790-D56E-4445-850E-4F3117DB740C}" : arSEA(36,1) = "remotepg.dll"
arSEA(37,0) = "{5F327514-6C5E-4d60-8F16-D07FA08A78ED}" : arSEA(37,1) = "wuaucpl.cpl"
arSEA(38,0) = "{60254CA5-953B-11CF-8C96-00AA00B8708C}" : arSEA(38,1) = "wshext.dll"
arSEA(39,0) = "{2206CDB2-19C1-11D1-89E0-00C04FD7A829}" : arSEA(39,1) = "oledb32.dll"
arSEA(40,0) = "{DD2110F0-9EEF-11cf-8D8E-00AA0060F5BF}" : arSEA(40,1) = "mstask.dll"
arSEA(41,0) = "{797F1E90-9EDD-11cf-8D8E-00AA0060F5BF}" : arSEA(41,1) = "mstask.dll"
arSEA(42,0) = "{D6277990-4C6A-11CF-8D87-00AA0060F5BF}" : arSEA(42,1) = "mstask.dll"
arSEA(43,0) = "{0DF44EAA-FF21-4412-828E-260A8728E7F1}" : arSEA(43,1) = ""
arSEA(44,0) = "{2559a1f0-21d7-11d4-bdaf-00c04f60b9f0}" : arSEA(44,1) = "shdocvw.dll"
arSEA(45,0) = "{2559a1f1-21d7-11d4-bdaf-00c04f60b9f0}" : arSEA(45,1) = "shdocvw.dll"
arSEA(46,0) = "{2559a1f2-21d7-11d4-bdaf-00c04f60b9f0}" : arSEA(46,1) = "shdocvw.dll"
arSEA(47,0) = "{2559a1f3-21d7-11d4-bdaf-00c04f60b9f0}" : arSEA(47,1) = "shdocvw.dll"
arSEA(48,0) = "{2559a1f4-21d7-11d4-bdaf-00c04f60b9f0}" : arSEA(48,1) = "shdocvw.dll"
arSEA(49,0) = "{2559a1f5-21d7-11d4-bdaf-00c04f60b9f0}" : arSEA(49,1) = "shdocvw.dll"
arSEA(50,0) = "{D20EA4E1-3957-11d2-A40B-0C5020524152}" : arSEA(50,1) = "shdocvw.dll"
arSEA(51,0) = "{D20EA4E1-3957-11d2-A40B-0C5020524153}" : arSEA(51,1) = "shdocvw.dll"
arSEA(52,0) = "{875CB1A1-0F29-45de-A1AE-CFB4950D0B78}" : arSEA(52,1) = "shmedia.dll"
arSEA(53,0) = "{40C3D757-D6E4-4b49-BB41-0E5BBEA28817}" : arSEA(53,1) = "shmedia.dll"
arSEA(54,0) = "{E4B29F9D-D390-480b-92FD-7DDB47101D71}" : arSEA(54,1) = "shmedia.dll"
arSEA(55,0) = "{87D62D94-71B3-4b9a-9489-5FE6850DC73E}" : arSEA(55,1) = "shmedia.dll"
arSEA(56,0) = "{A6FD9E45-6E44-43f9-8644-08598F5A74D9}" : arSEA(56,1) = "shmedia.dll"
arSEA(57,0) = "{c5a40261-cd64-4ccf-84cb-c394da41d590}" : arSEA(57,1) = "shmedia.dll"
arSEA(58,0) = "{5E6AB780-7743-11CF-A12B-00AA004AE837}" : arSEA(58,1) = "browseui.dll"
arSEA(59,0) = "{22BF0C20-6DA7-11D0-B373-00A0C9034938}" : arSEA(59,1) = "browseui.dll"
arSEA(60,0) = "{91EA3F8B-C99B-11d0-9815-00C04FD91972}" : arSEA(60,1) = "browseui.dll"
arSEA(61,0) = "{6413BA2C-B461-11d1-A18A-080036B11A03}" : arSEA(61,1) = "browseui.dll"
arSEA(62,0) = "{F61FFEC1-754F-11d0-80CA-00AA005B4383}" : arSEA(62,1) = "browseui.dll"
arSEA(63,0) = "{7BA4C742-9E81-11CF-99D3-00AA004AE837}" : arSEA(63,1) = "browseui.dll"
arSEA(64,0) = "{30D02401-6A81-11d0-8274-00C04FD5AE38}" : arSEA(64,1) = "browseui.dll"
arSEA(65,0) = "{32683183-48a0-441b-a342-7c2a440a9478}" : arSEA(65,1) = "browseui.dll"
arSEA(66,0) = "{169A0691-8DF9-11d1-A1C4-00C04FD75D13}" : arSEA(66,1) = "browseui.dll"
arSEA(67,0) = "{07798131-AF23-11d1-9111-00A0C98BA67D}" : arSEA(67,1) = "browseui.dll"
arSEA(68,0) = "{AF4F6510-F982-11d0-8595-00AA004CD6D8}" : arSEA(68,1) = "browseui.dll"
arSEA(69,0) = "{01E04581-4EEE-11d0-BFE9-00AA005B4383}" : arSEA(69,1) = "browseui.dll"
arSEA(70,0) = "{A08C11D2-A228-11d0-825B-00AA005B4383}" : arSEA(70,1) = "browseui.dll"
arSEA(71,0) = "{00BB2763-6A77-11D0-A535-00C04FD7D062}" : arSEA(71,1) = "browseui.dll"
arSEA(72,0) = "{7376D660-C583-11d0-A3A5-00C04FD706EC}" : arSEA(72,1) = "browseui.dll"
arSEA(73,0) = "{6756A641-DE71-11d0-831B-00AA005B4383}" : arSEA(73,1) = "browseui.dll"
arSEA(74,0) = "{6935DB93-21E8-4ccc-BEB9-9FE3C77A297A}" : arSEA(74,1) = "browseui.dll"
arSEA(75,0) = "{7e653215-fa25-46bd-a339-34a2790f3cb7}" : arSEA(75,1) = "browseui.dll"
arSEA(76,0) = "{acf35015-526e-4230-9596-becbe19f0ac9}" : arSEA(76,1) = "browseui.dll"
arSEA(77,0) = "{E0E11A09-5CB8-4B6C-8332-E00720A168F2}" : arSEA(77,1) = "browseui.dll"
arSEA(78,0) = "{00BB2764-6A77-11D0-A535-00C04FD7D062}" : arSEA(78,1) = "browseui.dll"
arSEA(79,0) = "{03C036F1-A186-11D0-824A-00AA005B4383}" : arSEA(79,1) = "browseui.dll"
arSEA(80,0) = "{00BB2765-6A77-11D0-A535-00C04FD7D062}" : arSEA(80,1) = "browseui.dll"
arSEA(81,0) = "{ECD4FC4E-521C-11D0-B792-00A0C90312E1}" : arSEA(81,1) = "browseui.dll"
arSEA(82,0) = "{3CCF8A41-5C85-11d0-9796-00AA00B90ADF}" : arSEA(82,1) = "browseui.dll"
arSEA(83,0) = "{ECD4FC4C-521C-11D0-B792-00A0C90312E1}" : arSEA(83,1) = "browseui.dll"
arSEA(84,0) = "{ECD4FC4D-521C-11D0-B792-00A0C90312E1}" : arSEA(84,1) = "browseui.dll"
arSEA(85,0) = "{DD313E04-FEFF-11d1-8ECD-0000F87A470C}" : arSEA(85,1) = "browseui.dll"
arSEA(86,0) = "{EF8AD2D1-AE36-11D1-B2D2-006097DF8C11}" : arSEA(86,1) = "browseui.dll"
arSEA(87,0) = "{EFA24E61-B078-11d0-89E4-00C04FC9E26E}" : arSEA(87,1) = "shdocvw.dll"
arSEA(88,0) = "{0A89A860-D7B1-11CE-8350-444553540000}" : arSEA(88,1) = "shdocvw.dll"
arSEA(89,0) = "{E7E4BC40-E76A-11CE-A9BB-00AA004AE837}" : arSEA(89,1) = "shdocvw.dll"
arSEA(90,0) = "{A5E46E3A-8849-11D1-9D8C-00C04FC99D61}" : arSEA(90,1) = "shdocvw.dll"
arSEA(91,0) = "{FBF23B40-E3F0-101B-8488-00AA003E56F8}" : arSEA(91,1) = "shdocvw.dll"
arSEA(92,0) = "{3C374A40-BAE4-11CF-BF7D-00AA006946EE}" : arSEA(92,1) = "shdocvw.dll"
arSEA(93,0) = "{FF393560-C2A7-11CF-BFF4-444553540000}" : arSEA(93,1) = "shdocvw.dll"
arSEA(94,0) = "{7BD29E00-76C1-11CF-9DD0-00A0C9034933}" : arSEA(94,1) = "shdocvw.dll"
arSEA(95,0) = "{7BD29E01-76C1-11CF-9DD0-00A0C9034933}" : arSEA(95,1) = "shdocvw.dll"
arSEA(96,0) = "{CFBFAE00-17A6-11D0-99CB-00C04FD64497}" : arSEA(96,1) = "shdocvw.dll"
arSEA(97,0) = "{A2B0DD40-CC59-11d0-A3A5-00C04FD706EC}" : arSEA(97,1) = "shdocvw.dll"
arSEA(98,0) = "{67EA19A0-CCEF-11d0-8024-00C04FD75D13}" : arSEA(98,1) = "shdocvw.dll"
arSEA(99,0) = "{131A6951-7F78-11D0-A979-00C04FD705A2}" : arSEA(99,1) = "shdocvw.dll"
arSEA(100,0) = "{9461b922-3c5a-11d2-bf8b-00c04fb93661}" : arSEA(100,1) = "shdocvw.dll"
arSEA(101,0) = "{3DC7A020-0ACD-11CF-A9BB-00AA004AE837}" : arSEA(101,1) = "shdocvw.dll"
arSEA(102,0) = "{871C5380-42A0-1069-A2EA-08002B30309D}" : arSEA(102,1) = "shdocvw.dll"
arSEA(103,0) = "{EFA24E64-B078-11d0-89E4-00C04FC9E26E}" : arSEA(103,1) = "shdocvw.dll"
arSEA(104,0) = "{9E56BE60-C50F-11CF-9A2C-00A0C90A90CE}" : arSEA(104,1) = "sendmail.dll"
arSEA(105,0) = "{9E56BE61-C50F-11CF-9A2C-00A0C90A90CE}" : arSEA(105,1) = "sendmail.dll"
arSEA(106,0) = "{88C6C381-2E85-11D0-94DE-444553540000}" : arSEA(106,1) = "occache.dll"
arSEA(107,0) = "{E6FB5E20-DE35-11CF-9C87-00AA005127ED}" : arSEA(107,1) = "webcheck.dll"
arSEA(108,0) = "{ABBE31D0-6DAE-11D0-BECA-00C04FD940BE}" : arSEA(108,1) = "webcheck.dll"
arSEA(109,0) = "{F5175861-2688-11d0-9C5E-00AA00A45957}" : arSEA(109,1) = "webcheck.dll"
arSEA(110,0) = "{08165EA0-E946-11CF-9C87-00AA005127ED}" : arSEA(110,1) = "webcheck.dll"
arSEA(111,0) = "{E3A8BDE6-ABCE-11d0-BC4B-00C04FD929DB}" : arSEA(111,1) = "webcheck.dll"
arSEA(112,0) = "{E8BB6DC0-6B4E-11d0-92DB-00A0C90C2BD7}" : arSEA(112,1) = "webcheck.dll"
arSEA(113,0) = "{7D559C10-9FE9-11d0-93F7-00AA0059CE02}" : arSEA(113,1) = "webcheck.dll"
arSEA(114,0) = "{E6CC6978-6B6E-11D0-BECA-00C04FD940BE}" : arSEA(114,1) = "webcheck.dll"
arSEA(115,0) = "{D8BD2030-6FC9-11D0-864F-00AA006809D9}" : arSEA(115,1) = "webcheck.dll"
arSEA(116,0) = "{7FC0B86E-5FA7-11d1-BC7C-00C04FD929DB}" : arSEA(116,1) = "webcheck.dll"
arSEA(117,0) = "{352EC2B7-8B9A-11D1-B8AE-006008059382}" : arSEA(117,1) = "appwiz.cpl"
arSEA(118,0) = "{0B124F8F-91F0-11D1-B8B5-006008059382}" : arSEA(118,1) = "appwiz.cpl"
arSEA(119,0) = "{CFCCC7A0-A282-11D1-9082-006008059382}" : arSEA(119,1) = "appwiz.cpl"
arSEA(120,0) = "{e84fda7c-1d6a-45f6-b725-cb260c236066}" : arSEA(120,1) = "shimgvw.dll"
arSEA(121,0) = "{66e4e4fb-f385-4dd0-8d74-a2efd1bc6178}" : arSEA(121,1) = "shimgvw.dll"
arSEA(122,0) = "{3F30C968-480A-4C6C-862D-EFC0897BB84B}" : arSEA(122,1) = "shimgvw.dll"
arSEA(123,0) = "{9DBD2C50-62AD-11d0-B806-00C04FD706EC}" : arSEA(123,1) = "shimgvw.dll"
arSEA(124,0) = "{EAB841A0-9550-11cf-8C16-00805F1408F3}" : arSEA(124,1) = "shimgvw.dll"
arSEA(125,0) = "{eb9b1153-3b57-4e68-959a-a3266bc3d7fe}" : arSEA(125,1) = "shimgvw.dll"
arSEA(126,0) = "{CC6EEFFB-43F6-46c5-9619-51D571967F7D}" : arSEA(126,1) = "netplwiz.dll"
arSEA(127,0) = "{add36aa8-751a-4579-a266-d66f5202ccbb}" : arSEA(127,1) = "netplwiz.dll"
arSEA(128,0) = "{6b33163c-76a5-4b6c-bf21-45de9cd503a1}" : arSEA(128,1) = "netplwiz.dll"
arSEA(129,0) = "{58f1f272-9240-4f51-b6d4-fd63d1618591}" : arSEA(129,1) = "netplwiz.dll"
arSEA(130,0) = "{7A9D77BD-5403-11d2-8785-2E0420524153}" : arSEA(130,1) = ""
arSEA(131,0) = "{E88DCCE0-B7B3-11d1-A9F0-00AA0060FA31}" : arSEA(131,1) = "zipfldr.dll"
arSEA(132,0) = "{BD472F60-27FA-11cf-B8B4-444553540000}" : arSEA(132,1) = "zipfldr.dll"
arSEA(133,0) = "{888DCA60-FC0A-11CF-8F0F-00C04FD7D062}" : arSEA(133,1) = "zipfldr.dll"
arSEA(134,0) = "{f39a0dc0-9cc8-11d0-a599-00c04fd64433}" : arSEA(134,1) = "cdfview.dll"
arSEA(135,0) = "{f3aa0dc0-9cc8-11d0-a599-00c04fd64434}" : arSEA(135,1) = "cdfview.dll"
arSEA(136,0) = "{f3ba0dc0-9cc8-11d0-a599-00c04fd64435}" : arSEA(136,1) = "cdfview.dll"
arSEA(137,0) = "{f3da0dc0-9cc8-11d0-a599-00c04fd64437}" : arSEA(137,1) = "cdfview.dll"
arSEA(138,0) = "{f3ea0dc0-9cc8-11d0-a599-00c04fd64438}" : arSEA(138,1) = "cdfview.dll"
arSEA(139,0) = "{63da6ec0-2e98-11cf-8d82-444553540000}" : arSEA(139,1) = "msieftp.dll"
arSEA(140,0) = "{883373C3-BF89-11D1-BE35-080036B11A03}" : arSEA(140,1) = "docprop2.dll"
arSEA(141,0) = "{A9CF0EAE-901A-4739-A481-E35B73E47F6D}" : arSEA(141,1) = "docprop2.dll"
arSEA(142,0) = "{8EE97210-FD1F-4B19-91DA-67914005F020}" : arSEA(142,1) = "docprop2.dll"
arSEA(143,0) = "{0EEA25CC-4362-4A12-850B-86EE61B0D3EB}" : arSEA(143,1) = "docprop2.dll"
arSEA(144,0) = "{6A205B57-2567-4A2C-B881-F787FAB579A3}" : arSEA(144,1) = "docprop2.dll"
arSEA(145,0) = "{28F8A4AC-BBB3-4D9B-B177-82BFC914FA33}" : arSEA(145,1) = "docprop2.dll"
arSEA(146,0) = "{8A23E65E-31C2-11d0-891C-00A024AB2DBB}" : arSEA(146,1) = "dsquery.dll"
arSEA(147,0) = "{9E51E0D0-6E0F-11d2-9601-00C04FA31A86}" : arSEA(147,1) = "dsquery.dll"
arSEA(148,0) = "{163FDC20-2ABC-11d0-88F0-00A024AB2DBB}" : arSEA(148,1) = "dsquery.dll"
arSEA(149,0) = "{F020E586-5264-11d1-A532-0000F8757D7E}" : arSEA(149,1) = "dsquery.dll"
arSEA(150,0) = "{0D45D530-764B-11d0-A1CA-00AA00C16E65}" : arSEA(150,1) = "dsuiext.dll"
arSEA(151,0) = "{62AE1F9A-126A-11D0-A14B-0800361B1103}" : arSEA(151,1) = "dsuiext.dll"
arSEA(152,0) = "{ECF03A33-103D-11d2-854D-006008059367}" : arSEA(152,1) = "mydocs.dll"
arSEA(153,0) = "{ECF03A32-103D-11d2-854D-006008059367}" : arSEA(153,1) = "mydocs.dll"
arSEA(154,0) = "{4a7ded0a-ad25-11d0-98a8-0800361b1103}" : arSEA(154,1) = "mydocs.dll"
arSEA(155,0) = "{750fdf0e-2a26-11d1-a3ea-080036587f03}" : arSEA(155,1) = "cscui.dll"
arSEA(156,0) = "{10CFC467-4392-11d2-8DB4-00C04FA31A66}" : arSEA(156,1) = "cscui.dll"
arSEA(157,0) = "{AFDB1F70-2A4C-11d2-9039-00C04F8EEB3E}" : arSEA(157,1) = "cscui.dll"
arSEA(158,0) = "{143A62C8-C33B-11D1-84FE-00C04FA34A14}" : arSEA(158,1) = "agentpsh.dll"
arSEA(159,0) = "{ECCDF543-45CC-11CE-B9BF-0080C87CDBA6}" : arSEA(159,1) = "dfsshlex.dll"
arSEA(160,0) = "{60fd46de-f830-4894-a628-6fa81bc0190d}" : arSEA(160,1) = "photowiz.dll"
arSEA(161,0) = "{7A80E4A8-8005-11D2-BCF8-00C04F72C717}" : arSEA(161,1) = "mmcshext.dll"
arSEA(162,0) = "{0CD7A5C0-9F37-11CE-AE65-08002B2E1262}" : arSEA(162,1) = "cabview.dll"
arSEA(163,0) = "{32714800-2E5F-11d0-8B85-00AA0044F941}" : arSEA(163,1) = "wabfind.dll"
arSEA(164,0) = "{8DD448E6-C188-4aed-AF92-44956194EB1F}" : arSEA(164,1) = "wmpshell.dll"
arSEA(165,0) = "{CE3FB1D1-02AE-4a5f-A6E9-D9F1B4073E6C}" : arSEA(165,1) = "wmpshell.dll"
arSEA(166,0) = "{F1B9284F-E9DC-4e68-9D7E-42362A59F0FD}" : arSEA(166,1) = "wmpshell.dll"
'W2K
arSEA(167,0) = "{41E300E0-78B6-11ce-849B-444553540000}" : arSEA(167,1) = "plustab.dll"
arSEA(168,0) = "{1A9BA3A0-143A-11CF-8350-444553540000}" : arSEA(168,1) = "shell32.dll"
arSEA(169,0) = "{20D04FE0-3AEA-1069-A2D8-08002B30309D}" : arSEA(169,1) = "shell32.dll"
arSEA(170,0) = "{86747AC0-42A0-1069-A2E6-08002B30309D}" : arSEA(170,1) = "shell32.dll"
arSEA(171,0) = "{0AFACED1-E828-11D1-9187-B532F1E9575D}" : arSEA(171,1) = "shell32.dll"
arSEA(172,0) = "{12518493-00B2-11d2-9FA5-9E3420524153}" : arSEA(172,1) = "shell32.dll"
arSEA(173,0) = "{21B22460-3AEA-1069-A2DC-08002B30309D}" : arSEA(173,1) = "shell32.dll"
arSEA(174,0) = "{B091E540-83E3-11CF-A713-0020AFD79762}" : arSEA(174,1) = "shell32.dll"
arSEA(175,0) = "{FBF23B41-E3F0-101B-8488-00AA003E56F8}" : arSEA(175,1) = "shell32.dll"
arSEA(176,0) = "{C2FBB630-2971-11d1-A18C-00C04FD75D13}" : arSEA(176,1) = "shell32.dll"
arSEA(177,0) = "{C2FBB631-2971-11d1-A18C-00C04FD75D13}" : arSEA(177,1) = "shell32.dll"
arSEA(178,0) = "{13709620-C279-11CE-A49E-444553540000}" : arSEA(178,1) = "shell32.dll"
arSEA(179,0) = "{62112AA1-EBE4-11cf-A5FB-0020AFE7292D}" : arSEA(179,1) = "shell32.dll"
arSEA(180,0) = "{4622AD11-FF23-11d0-8D34-00A0C90F2719}" : arSEA(180,1) = "shell32.dll"
arSEA(181,0) = "{7BA4C740-9E81-11CF-99D3-00AA004AE837}" : arSEA(181,1) = "shell32.dll"
arSEA(182,0) = "{D969A300-E7FF-11d0-A93B-00A0C90F2719}" : arSEA(182,1) = "shell32.dll"
arSEA(183,0) = "{09799AFB-AD67-11d1-ABCD-00C04FC30936}" : arSEA(183,1) = "shell32.dll"
arSEA(184,0) = "{3FC0B520-68A9-11D0-8D77-00C04FD70822}" : arSEA(184,1) = "shell32.dll"
arSEA(185,0) = "{75048700-EF1F-11D0-9888-006097DEACF9}" : arSEA(185,1) = "shell32.dll"
arSEA(186,0) = "{6D5313C0-8C62-11D1-B2CD-006097DF8C11}" : arSEA(186,1) = "shell32.dll"
arSEA(187,0) = "{57651662-CE3E-11D0-8D77-00C04FC99D61}" : arSEA(187,1) = "shell32.dll"
arSEA(188,0) = "{4657278A-411B-11d2-839A-00C04FD918D0}" : arSEA(188,1) = "shell32.dll"
arSEA(189,0) = "{A470F8CF-A1E8-4f65-8335-227475AA5C46}" : arSEA(189,1) = "shell32.dll"
arSEA(190,0) = "{568804CA-CBD7-11d0-9816-00C04FD91972}" : arSEA(190,1) = "browseui.dll"
arSEA(191,0) = "{5b4dae26-b807-11d0-9815-00c04fd91972}" : arSEA(191,1) = "browseui.dll"
arSEA(192,0) = "{8278F931-2A3E-11d2-838F-00C04FD918D0}" : arSEA(192,1) = "browseui.dll"
arSEA(193,0) = "{E13EF4E4-D2F2-11d0-9816-00C04FD91972}" : arSEA(193,1) = "browseui.dll"
arSEA(194,0) = "{ECD4FC4F-521C-11D0-B792-00A0C90312E1}" : arSEA(194,1) = "browseui.dll"
arSEA(195,0) = "{D82BE2B0-5764-11D0-A96E-00C04FD705A2}" : arSEA(195,1) = "browseui.dll"
arSEA(196,0) = "{0E5CBF21-D15F-11d0-8301-00AA005B4383}" : arSEA(196,1) = "browseui.dll"
arSEA(197,0) = "{7487cd30-f71a-11d0-9ea7-00805f714772}" : arSEA(197,1) = "browseui.dll"
arSEA(198,0) = "{8BEBB290-52D0-11D0-B7F4-00C04FD706EC}" : arSEA(198,1) = "thumbvw.dll"
arSEA(199,0) = "{EAB841A0-9550-11CF-8C16-00805F1408F3}" : arSEA(199,1) = "thumbvw.dll"
arSEA(200,0) = "{1AEB1360-5AFC-11D0-B806-00C04FD706EC}" : arSEA(200,1) = "thumbvw.dll"
arSEA(201,0) = "{9DBD2C50-62AD-11D0-B806-00C04FD706EC}" : arSEA(201,1) = "thumbvw.dll"
arSEA(202,0) = "{500202A0-731E-11D0-B829-00C04FD706EC}" : arSEA(202,1) = "thumbvw.dll"
arSEA(203,0) = "{0B124F8C-91F0-11D1-B8B5-006008059382}" : arSEA(203,1) = "appwiz.cpl"
arSEA(204,0) = "{fe1290f0-cfbd-11cf-a330-00aa00c16e65}" : arSEA(204,1) = "dsfolder.dll"
arSEA(205,0) = "{9E51E0D0-6E0F-11d2-9601-00C04FA31A86}" : arSEA(205,1) = "dsfolder.dll"
arSEA(206,0) = "{450D8FBA-AD25-11D0-98A8-0800361B1103}" : arSEA(206,1) = "mydocs.dll"
'WXP SP2
arSEA(207,0) = "{2559a1f7-21d7-11d4-bdaf-00c04f60b9f0}" : arSEA(207,1) = "shdocvw.dll"
arSEA(208,0) = "{596AB062-B4D2-4215-9F74-E9109B0A8153}" : arSEA(208,1) = "twext.dll"
arSEA(209,0) = "{9DB7A13C-F208-4981-8353-73CC61AE2783}" : arSEA(209,1) = "twext.dll"
arSEA(210,0) = "{692F0339-CBAA-47e6-B5B5-3B84DB604E87}" : arSEA(210,1) = "extmgr.dll"
'NT4
arSEA(211,0) = "{764BF0E1-F219-11ce-972D-00AA00A14F56}" : arSEA(211,1) = "shcompui.dll"
arSEA(212,0) = "{8DE56A0D-E58B-41FE-9F80-3563CDCB2C22}" : arSEA(212,1) = "thumbvw.dll"
arSEA(213,0) = "{13709620-C279-11CE-A49E-444553540000}" : arSEA(213,1) = "SHDOC401.DLL"
arSEA(214,0) = "{62112AA1-EBE4-11cf-A5FB-0020AFE7292D}" : arSEA(214,1) = "SHDOC401.DLL"
arSEA(215,0) = "{7BA4C740-9E81-11CF-99D3-00AA004AE837}" : arSEA(215,1) = "SHDOC401.DLL"
arSEA(216,0) = "{D969A300-E7FF-11d0-A93B-00A0C90F2719}" : arSEA(216,1) = "SHDOC401.DLL"
arSEA(217,0) = "{4622AD11-FF23-11d0-8D34-00A0C90F2719}" : arSEA(217,1) = "SHDOC401.DLL"
arSEA(218,0) = "{3AD1E410-AAB9-11d0-89D7-00C04FC9E26E}" : arSEA(218,1) = "SHDOCVW.DLL"
arSEA(219,0) = "{57651662-CE3E-11D0-8D77-00C04FC99D61}" : arSEA(219,1) = "SHDOC401.DLL"
arSEA(220,0) = "{B091E540-83E3-11CF-A713-0020AFD79762}" : arSEA(220,1) = "SHDOC401.DLL"
arSEA(221,0) = "{3FC0B520-68A9-11D0-8D77-00C04FD70822}" : arSEA(221,1) = "SHDOC401.DLL"
arSEA(222,0) = "{7D688A77-C613-11D0-999B-00C04FD655E1}" : arSEA(222,1) = "SHELL32.dll"
arSEA(223,0) = "{BDEADF00-C265-11d0-BCED-00A0C90AB50F}" : arSEA(223,1) = "MSONSEXT.DLL"
arSEA(224,0) = "{C2FBB630-2971-11d1-A18C-00C04FD75D13}" : arSEA(224,1) = "SHDOC401.DLL"
arSEA(225,0) = "{C2FBB631-2971-11d1-A18C-00C04FD75D13}" : arSEA(225,1) = "SHDOC401.DLL"
arSEA(226,0) = "{75048700-EF1F-11D0-9888-006097DEACF9}" : arSEA(226,1) = "SHDOC401.DLL"
arSEA(227,0) = "{6D5313C0-8C62-11D1-B2CD-006097DF8C11}" : arSEA(227,1) = "SHDOC401.DLL"
arSEA(228,0) = "{FBF23B41-E3F0-101B-8488-00AA003E56F8}" : arSEA(228,1) = "SHDOC401.DLL"
arSEA(229,0) = "{5a61f7a0-cde1-11cf-9113-00aa00425c62}" : arSEA(229,1) = "w3ext.dll"
'WMe
arSEA(230,0) = "{3F30C968-480A-4C6C-862D-EFC0897BB84B}" : arSEA(230,1) = "THUMBVW.DLL" 'see (122)
arSEA(231,0) = "{53C74826-AB99-4d33-ACA4-3117F51D3788}" : arSEA(231,1) = "SHELL32.DLL"
arSEA(232,0) = "{992CFFA0-F557-101A-88EC-00DD010CCC48}" : arSEA(232,1) = "rnaui.dll" 'see (30)
arSEA(233,0) = "{FEF10FA2-355E-4e06-9381-9B24D7F7CC88}" : arSEA(233,1) = "SHELL32.DLL"
'MS PowerToys
arSEA(234,0) = "{AA7C7080-860A-11CE-8424-08002B2CFF76}" : arSEA(234,1) = "SENDTOX.DLL"
arSEA(235,0) = "{7BB70120-6C78-11CF-BFC7-444553540000}" : arSEA(235,1) = "SENDTOX.DLL"
arSEA(236,0) = "{7BB70122-6C78-11CF-BFC7-444553540000}" : arSEA(236,1) = "SENDTOX.DLL"
arSEA(237,0) = "{7BB70121-6C78-11CF-BFC7-444553540000}" : arSEA(237,1) = "SENDTOX.DLL"
arSEA(238,0) = "{7BB70123-6C78-11CF-BFC7-444553540000}" : arSEA(238,1) = "SENDTOX.DLL"
arSEA(239,0) = "{9E56BE62-C50F-11CF-9A2C-00A0C90A90CE}" : arSEA(239,1) = "SENDTOX.DLL"
arSEA(240,0) = "{90A756E0-AFCF-11CE-927B-0800095AE340}" : arSEA(240,1) = "target.dll"
arSEA(241,0) = "{afc638f0-e8a4-11ce-9ade-00aa00a42d2e}" : arSEA(241,1) = "TTFExtNT.dll"
'etc
arSEA(242,0) = "{1D2680C9-0E2A-469d-B787-065558BC7D43}" : arSEA(242,1) = "mscoree.dll"
arSEA(243,0) = "{5F327514-6C5E-4d60-8F16-D07FA08A78ED}" : arSEA(243,1) = "wuaueng.dll"
'WXP IE 7
arSEA(244,0) = "{07C45BB1-4A8C-4642-A1F5-237E7215FF66}" : arSEA(244,1) = "ieframe.dll"
arSEA(245,0) = "{1C1EDB47-CE22-4bbb-B608-77B48F83C823}" : arSEA(245,1) = "ieframe.dll"
arSEA(246,0) = "{205D7A97-F16D-4691-86EF-F3075DCCA57D}" : arSEA(246,1) = "ieframe.dll"
arSEA(247,0) = "{3028902F-6374-48b2-8DC6-9725E775B926}" : arSEA(247,1) = "ieframe.dll"
arSEA(248,0) = "{30D02401-6A81-11d0-8274-00C04FD5AE38}" : arSEA(248,1) = "ieframe.dll"
arSEA(249,0) = "{3C374A40-BAE4-11CF-BF7D-00AA006946EE}" : arSEA(249,1) = "ieframe.dll"
arSEA(250,0) = "{3DC7A020-0ACD-11CF-A9BB-00AA004AE837}" : arSEA(250,1) = "ieframe.dll"
arSEA(251,0) = "{43886CD5-6529-41c4-A707-7B3C92C05E68}" : arSEA(251,1) = "ieframe.dll"
arSEA(252,0) = "{44C76ECD-F7FA-411c-9929-1B77BA77F524}" : arSEA(252,1) = "ieframe.dll"
arSEA(253,0) = "{4B78D326-D922-44f9-AF2A-07805C2A3560}" : arSEA(253,1) = "ieframe.dll"
arSEA(254,0) = "{6038EF75-ABFC-4e59-AB6F-12D397F6568D}" : arSEA(254,1) = "ieframe.dll"
arSEA(255,0) = "{6B4ECC4F-16D1-4474-94AB-5A763F2A54AE}" : arSEA(255,1) = "ieframe.dll"
arSEA(256,0) = "{6CF48EF8-44CD-45d2-8832-A16EA016311B}" : arSEA(256,1) = "ieframe.dll"
arSEA(257,0) = "{73CFD649-CD48-4fd8-A272-2070EA56526B}" : arSEA(257,1) = "ieframe.dll"
arSEA(258,0) = "{7BD29E00-76C1-11CF-9DD0-00A0C9034933}" : arSEA(258,1) = "ieframe.dll"
arSEA(259,0) = "{7BD29E01-76C1-11CF-9DD0-00A0C9034933}" : arSEA(259,1) = "ieframe.dll"
arSEA(260,0) = "{871C5380-42A0-1069-A2EA-08002B30309D}" : arSEA(260,1) = "ieframe.dll"
arSEA(261,0) = "{98FF6D4B-6387-4b0a-8FBD-C5C4BB17B4F8}" : arSEA(261,1) = "ieframe.dll"
arSEA(262,0) = "{9a096bb5-9dc3-4d1c-8526-c3cbf991ea4e}" : arSEA(262,1) = "ieframe.dll"
arSEA(263,0) = "{9D958C62-3954-4b44-8FAB-C4670C1DB4C2}" : arSEA(263,1) = "ieframe.dll"
arSEA(264,0) = "{B31C5FAE-961F-415b-BAF0-E697A5178B94}" : arSEA(264,1) = "ieframe.dll"
arSEA(265,0) = "{BC476F4C-D9D7-4100-8D4E-E043F6DEC409}" : arSEA(265,1) = "ieframe.dll"
arSEA(266,0) = "{BFAD62EE-9D54-4b2a-BF3B-76F90697BD2A}" : arSEA(266,1) = "ieframe.dll"
arSEA(267,0) = "{CFBFAE00-17A6-11D0-99CB-00C04FD64497}" : arSEA(267,1) = "ieframe.dll"
arSEA(268,0) = "{E6EE9AAC-F76B-4947-8260-A9F136138E11}" : arSEA(268,1) = "ieframe.dll"
arSEA(269,0) = "{E7E4BC40-E76A-11CE-A9BB-00AA004AE837}" : arSEA(269,1) = "ieframe.dll"
arSEA(270,0) = "{F0353E1D-FEEC-474e-A984-1E5C6865E380}" : arSEA(270,1) = "ieframe.dll"
arSEA(271,0) = "{F2CF5485-4E02-4f68-819C-B92DE9277049}" : arSEA(271,1) = "ieframe.dll"
arSEA(272,0) = "{F83DAC1C-9BB9-4f2b-B619-09819DA81B0E}" : arSEA(272,1) = "ieframe.dll"
arSEA(273,0) = "{FAC3CBF6-8697-43d0-BAB9-DCD1FCE19D75}" : arSEA(273,1) = "ieframe.dll"
arSEA(274,0) = "{FBF23B40-E3F0-101B-8488-00AA003E56F8}" : arSEA(274,1) = "ieframe.dll"
arSEA(275,0) = "{FDE7673D-2E19-4145-8376-BBD58C4BC7BA}" : arSEA(275,1) = "ieframe.dll"
arSEA(276,0) = "{FF393560-C2A7-11CF-BFF4-444553540000}" : arSEA(276,1) = "ieframe.dll"
'WVa
arSEA(277,0) = "{00021401-0000-0000-C000-000000000046}" : arSEA(277,1) = "shell32.dll"
arSEA(278,0) = "{025A5937-A6BE-4686-A844-36FE4BEC8B6D}" : arSEA(278,1) = "shdocvw.dll"
arSEA(279,0) = "{056440FD-8568-48e7-A632-72157243B55B}" : arSEA(279,1) = "browseui.dll"
arSEA(280,0) = "{0AFCCBA6-BF90-4A4E-8482-0AC960981F5B}" : arSEA(280,1) = "shell32.dll"
arSEA(281,0) = "{0BFCF7B7-E7B6-433a-B205-2904FCF040DD}" : arSEA(281,1) = "appwiz.cpl"
arSEA(282,0) = "{11dbb47c-a525-400b-9e80-a54615a090c0}" : arSEA(282,1) = "ExplorerFrame.dll"
arSEA(283,0) = "{13D3C4B8-B179-4ebb-BF62-F704173E7448}" : arSEA(283,1) = "wab32.dll"
arSEA(284,0) = "{1531d583-8375-4d3f-b5fb-d23bbd169f22}" : arSEA(284,1) = "shell32.dll"
arSEA(285,0) = "{15eae92e-f17a-4431-9f28-805e482dafd4}" : arSEA(285,1) = "appwiz.cpl"
arSEA(286,0) = "{176d6597-26d3-11d1-b350-080036a75b03}" : arSEA(286,1) = "colorui.dll"
arSEA(287,0) = "{17cd9488-1228-4b2f-88ce-4298e93e0966}" : arSEA(287,1) = "shdocvw.dll"
arSEA(288,0) = "{1FA9085F-25A2-489B-85D4-86326EEDCD87}" : arSEA(288,1) = "wlanpref.dll"
arSEA(289,0) = "{21569614-B795-46b1-85F4-E737A8DC09AD}" : arSEA(289,1) = "browseui.dll"
arSEA(290,0) = "{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}" : arSEA(290,1) = "shdocvw.dll"
arSEA(291,0) = "{2781761E-28E0-4109-99FE-B9D127C57AFE}" : arSEA(291,1) = "MpOav.dll"
arSEA(292,0) = "{289978AC-A101-4341-A817-21EBA7FD046D}" : arSEA(292,1) = "SyncCenter.dll"
arSEA(293,0) = "{2BC0DA0E-F1BC-43AB-B4B5-738EB6B51E7E}" : arSEA(293,1) = "fontext.dll"
arSEA(294,0) = "{2E9E59C0-B437-4981-A647-9C34B9B90891}" : arSEA(294,1) = "SyncCenter.dll"
arSEA(295,0) = "{3080F90D-D7AD-11D9-BD98-0000947B0257}" : arSEA(295,1) = "shdocvw.dll"
arSEA(296,0) = "{3080F90E-D7AD-11D9-BD98-0000947B0257}" : arSEA(296,1) = "shdocvw.dll"
arSEA(297,0) = "{328B0346-7EAF-4BBE-A479-7CB88A095F5B}" : arSEA(297,1) = "shell32.dll"
arSEA(298,0) = "{335a31dd-f04b-4d76-a925-d6b47cf360df}" : arSEA(298,1) = "shdocvw.dll"
arSEA(299,0) = "{35786D3C-B075-49b9-88DD-029876E11C01}" : arSEA(299,1) = "wpdshext.dll"
arSEA(300,0) = "{36eef7db-88ad-4e81-ad49-0e313f0c35f8}" : arSEA(300,1) = "shdocvw.dll"
arSEA(301,0) = "{3c2654c6-7372-4f6b-b310-55d6128f49d2}" : arSEA(301,1) = "shell32.dll"
arSEA(302,0) = "{3F30C968-480A-4C6C-862D-EFC0897BB84B}" : arSEA(302,1) = "PhotoMetadataHandler.dll"
arSEA(303,0) = "{40C3D757-D6E4-4b49-BB41-0E5BBEA28817}" : arSEA(303,1) = "mediametadatahandler.dll"
arSEA(304,0) = "{4336a54d-038b-4685-ab02-99bb52d3fb8b}" : arSEA(304,1) = "shdocvw.dll"
arSEA(305,0) = "{437ff9c0-a07f-4fa0-af80-84b6c6440a16}" : arSEA(305,1) = "shell32.dll"
arSEA(306,0) = "{44121072-A222-48f2-A58A-6D9AD51EBBE9}" : arSEA(306,1) = "XPSSHHDR.DLL"
arSEA(307,0) = "{45670FA8-ED97-4F44-BC93-305082590BFB}" : arSEA(307,1) = "XPSSHHDR.DLL"
arSEA(308,0) = "{474C98EE-CF3D-41f5-80E3-4AAB0AB04301}" : arSEA(308,1) = "cscui.dll"
arSEA(309,0) = "{4B534112-3AF6-4697-A77C-D62CE9B9E7CF}" : arSEA(309,1) = "SyncCenter.dll"
arSEA(310,0) = "{4D1209BD-36E2-4e2f-840D-6C7FB879DD9E}" : arSEA(310,1) = "shdocvw.dll"
arSEA(311,0) = "{4E77131D-3629-431c-9818-C5679DC83E81}" : arSEA(311,1) = "cscui.dll"
arSEA(312,0) = "{4F58F63F-244B-4c07-B29F-210BE59BE9B4}" : arSEA(312,1) = "wab32.dll"
arSEA(313,0) = "{513D916F-2A8E-4F51-AEAB-0CBC76FB1AF8}" : arSEA(313,1) = "acppage.dll"
arSEA(314,0) = "{53BEDF0B-4E5B-4183-8DC9-B844344FA104}" : arSEA(314,1) = "mssvp.dll"
arSEA(315,0) = "{576C9E85-1300-4EF5-BF6B-D00509F4EDCD}" : arSEA(315,1) = "SyncCenter.dll"
arSEA(316,0) = "{58E3C745-D971-4081-9034-86E34B30836A}" : arSEA(316,1) = "shdocvw.dll"
arSEA(317,0) = "{596742A5-1393-4e13-8765-AE1DF71ACAFB}" : arSEA(317,1) = "browseui.dll"
arSEA(318,0) = "{5DB2625A-54DF-11D0-B6C4-0800091AA605}" : arSEA(318,1) = "colorui.dll"
arSEA(319,0) = "{5FA29220-36A1-40f9-89C6-F4B384B7642E}" : arSEA(319,1) = "inetcomm.dll"
arSEA(320,0) = "{60632754-c523-4b62-b45c-4172da012619}" : arSEA(320,1) = "shdocvw.dll"
arSEA(321,0) = "{640167b4-59b0-47a6-b335-a6b3c0695aea}" : arSEA(321,1) = "audiodev.dll"
arSEA(322,0) = "{66742402-F9B9-11D1-A202-0000F81FEDEE}" : arSEA(322,1) = "shell32.dll"
arSEA(323,0) = "{675F097E-4C4D-11D0-B6C1-0800091AA605}" : arSEA(323,1) = "colorui.dll"
arSEA(324,0) = "{6b33163c-76a5-4b6c-bf21-45de9cd503a1}" : arSEA(324,1) = "shwebsvc.dll"
arSEA(325,0) = "{6D8BB3D3-9D87-4a91-AB56-4F30CFFEFE9F}" : arSEA(325,1) = "browseui.dll"
arSEA(326,0) = "{708e1662-b832-42a8-bbe1-0a77121e3908}" : arSEA(326,1) = "shell32.dll"
arSEA(327,0) = "{71D99464-3B6B-475C-B241-E15883207529}" : arSEA(327,1) = "SyncCenter.dll"
arSEA(328,0) = "{71f96385-ddd6-48d3-a0c1-ae06e8b055fb}" : arSEA(328,1) = "shell32.dll"
arSEA(329,0) = "{78F3955E-3B90-4184-BD14-5397C15F1EFC}" : arSEA(329,1) = "shdocvw.dll"
arSEA(330,0) = "{7b81be6a-ce2b-4676-a29e-eb907a5126c5}" : arSEA(330,1) = "appwiz.cpl"
arSEA(331,0) = "{7EFA68C6-086B-43e1-A2D2-55A113531240}" : arSEA(331,1) = "cscui.dll"
arSEA(332,0) = "{8082C5E6-4C27-48ec-A809-B8E1122E8F97}" : arSEA(332,1) = "wab32.dll"
arSEA(333,0) = "{875CB1A1-0F29-45de-A1AE-CFB4950D0B78}" : arSEA(333,1) = "mediametadatahandler.dll"
arSEA(334,0) = "{877ca5ac-cb41-4842-9c69-9136e42d47e2}" : arSEA(334,1) = "sdshext.dll"
arSEA(335,0) = "{89D83576-6BD1-4c86-9454-BEB04E94C819}" : arSEA(335,1) = "mssvp.dll"
arSEA(336,0) = "{8E25992B-373E-486E-80E5-BD23AE417E66}" : arSEA(336,1) = "SyncCenter.dll"
arSEA(337,0) = "{8E908FC9-BECC-40f6-915B-F4CA0E70D03D}" : arSEA(337,1) = "shdocvw.dll"
arSEA(338,0) = "{90f8c90b-04e0-4e92-a186-e6e9c125d664}" : arSEA(338,1) = "shdocvw.dll"
arSEA(339,0) = "{92dbad9f-5025-49b0-9078-2d78f935e341}" : arSEA(339,1) = "inetcomm.dll"
arSEA(340,0) = "{96AE8D84-A250-4520-95A5-A47A7E3C548B}" : arSEA(340,1) = "shdocvw.dll"
arSEA(341,0) = "{97e467b4-98c6-4f19-9588-161b7773d6f6}" : arSEA(341,1) = "propsys.dll"
arSEA(342,0) = "{9C60DE1E-E5FC-40f4-A487-460851A8D915}" : arSEA(342,1) = "shdocvw.dll"
arSEA(343,0) = "{9C73F5E5-7AE7-4E32-A8E8-8D23B85255BF}" : arSEA(343,1) = "SyncCenter.dll"
arSEA(344,0) = "{9DBD2C50-62AD-11d0-B806-00C04FD706EC}" : arSEA(344,1) = "shell32.dll"
arSEA(345,0) = "{a38b883c-1682-497e-97b0-0a3a9e801682}" : arSEA(345,1) = "PhotoMetadataHandler.dll"
arSEA(346,0) = "{a42c2ccb-67d3-46fa-abe6-7d2f3488c7a3}" : arSEA(346,1) = "shell32.dll"
arSEA(347,0) = "{a542e116-8088-4146-a352-b0d06e7f6af6}" : arSEA(347,1) = "browseui.dll"
arSEA(348,0) = "{add36aa8-751a-4579-a266-d66f5202ccbb}" : arSEA(348,1) = "shwebsvc.dll"
arSEA(349,0) = "{b155bdf8-02f0-451e-9a26-ae317cfd7779}" : arSEA(349,1) = "shdocvw.dll"
arSEA(350,0) = "{b2952b16-0e07-4e5a-b993-58c52cb94cae}" : arSEA(350,1) = "shell32.dll"
arSEA(351,0) = "{B32D3949-ED98-4DBB-B347-17A144969BBA}" : arSEA(351,1) = "SyncCenter.dll"
arSEA(352,0) = "{b8cdcb65-b1bf-4b42-9428-1dfdb7ee92af}" : arSEA(352,1) = "zipfldr.dll"
arSEA(353,0) = "{b9815375-5d7f-4ce2-9245-c9d4da436930}" : arSEA(353,1) = "inetcomm.dll"
arSEA(354,0) = "{BB06C0E4-D293-4f75-8A90-CB05B6477EEE}" : arSEA(354,1) = "shdocvw.dll"
arSEA(355,0) = "{BC48B32F-5910-47F5-8570-5074A8A5636A}" : arSEA(355,1) = "SyncCenter.dll"
arSEA(356,0) = "{BD7A2E7B-21CB-41b2-A086-B309680C6B7E}" : arSEA(356,1) = "mssvp.dll"
arSEA(357,0) = "{C0B4E2F3-BA21-4773-8DBA-335EC946EB8B}" : arSEA(357,1) = "comdlg32.dll"
arSEA(358,0) = "{C4EC38BD-4E9E-4b5e-935A-D1BFF237D980}" : arSEA(358,1) = "browseui.dll"
arSEA(359,0) = "{c5a40261-cd64-4ccf-84cb-c394da41d590}" : arSEA(359,1) = "mediametadatahandler.dll"
arSEA(360,0) = "{C73F6F30-97A0-4AD1-A08F-540D4E9BC7B9}" : arSEA(360,1) = "shdocvw.dll"
arSEA(361,0) = "{C7657C4A-9F68-40fa-A4DF-96BC08EB3551}" : arSEA(361,1) = "PhotoMetadataHandler.dll"
arSEA(362,0) = "{CB1B7F8C-C50A-4176-B604-9E24DEE8D4D1}" : arSEA(362,1) = "oobefldr.dll"
arSEA(363,0) = "{CC6EEFFB-43F6-46c5-9619-51D571967F7D}" : arSEA(363,1) = "shwebsvc.dll"
arSEA(364,0) = "{ceefea1b-3e29-4ef1-b34c-fec79c4f70af}" : arSEA(364,1) = "appwiz.cpl"
arSEA(365,0) = "{d450a8a1-9568-45c7-9c0e-b4f9fb4537bd}" : arSEA(365,1) = "appwiz.cpl"
arSEA(366,0) = "{D555645E-D4F8-4c29-A827-D93C859C4F2A}" : arSEA(366,1) = "shdocvw.dll"
arSEA(367,0) = "{D6791A63-E7E2-4fee-BF52-5DED8E86E9B8}" : arSEA(367,1) = "wpdshext.dll"
arSEA(368,0) = "{D9EF8727-CAC2-4e60-809E-86F80A666C91}" : arSEA(368,1) = "shdocvw.dll"
arSEA(369,0) = "{DBCE2480-C732-101B-BE72-BA78E9AD5B27}" : arSEA(369,1) = "colorui.dll"
arSEA(370,0) = "{DC1C5A9C-E88A-4dde-A5A1-60F82A20AEF7}" : arSEA(370,1) = "comdlg32.dll"
arSEA(371,0) = "{DFFACDC5-679F-4156-8947-C5C76BC0B67F}" : arSEA(371,1) = "shdocvw.dll"
arSEA(372,0) = "{E37E2028-CE1A-4f42-AF05-6CEABC4E5D75}" : arSEA(372,1) = "dfshim.dll"
arSEA(373,0) = "{E413D040-6788-4C22-957E-175D1C513A34}" : arSEA(373,1) = "SyncCenter.dll"
arSEA(374,0) = "{E598560B-28D5-46aa-A14A-8A3BEA34B576}" : arSEA(374,1) = "PhotoViewer.dll"
arSEA(375,0) = "{e82a2d71-5b2f-43a0-97b8-81be15854de8}" : arSEA(375,1) = "dfshim.dll"
arSEA(376,0) = "{E95A4861-D57A-4be1-AD0F-35267E261739}" : arSEA(376,1) = "shdocvw.dll"
arSEA(377,0) = "{eb124705-128b-40d4-8dd8-d93ed12589a4}" : arSEA(377,1) = "shdocvw.dll"
arSEA(378,0) = "{ECDD6472-2B9B-4b4b-AE36-F316DF3C8D60}" : arSEA(378,1) = "gameux.dll"
arSEA(379,0) = "{ED228FDF-9EA8-4870-83B1-96B02CFE0D52}" : arSEA(379,1) = "gameux.dll"
arSEA(380,0) = "{ed50fc29-b964-48a9-afb3-15ebb9b97f36}" : arSEA(380,1) = "shdocvw.dll"
arSEA(381,0) = "{ED834ED6-4B5A-4bfe-8F11-A626DCB6A921}" : arSEA(381,1) = "shdocvw.dll"
arSEA(382,0) = "{ed9d80b9-d157-457b-9192-0e7280313bf0}" : arSEA(382,1) = "zipfldr.dll"
arSEA(383,0) = "{F02C1A0D-BE21-4350-88B0-7367FC96EF3C}" : arSEA(383,1) = "NetworkExplorer.dll"
arSEA(384,0) = "{F04CC277-03A2-4277-96A9-77967471BDFF}" : arSEA(384,1) = "SyncCenter.dll"
arSEA(385,0) = "{f8b8412b-dea3-4130-b36c-5e8be73106ac}" : arSEA(385,1) = "inetcomm.dll"
arSEA(386,0) = "{F1390A9A-A3F4-4E5D-9C5F-98F3BD8D935C}" : arSEA(386,1) = "SyncCenter.dll"
arSEA(387,0) = "{fccf70c8-f4d7-4d8b-8c17-cd6715e37fff}" : arSEA(387,1) = "browseui.dll"
arSEA(388,0) = "{FFE2A43C-56B9-4bf5-9A79-CC6D4285608A}" : arSEA(388,1) = "PhotoViewer.dll"

'set up key name to query
strKey = "Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved"
strSubTitle = "HKLM" & "\" & strKey & "\"

'find all the names in the key
intErrNum1 = oReg.EnumValues (HKLM, strKey, arNames, arType)

'enumerate data if present
If intErrNum1 = 0 And IsArray(arNames) Then

'for each CLSID
For Each strCLSID in arNames

flagTitle = False

'find CLSID title
CLSIDLocTitle HKLM, strKey, strCLSID, strLocTitle

For ctrCH = intCLL To 1

'assume CLSID unapproved
flagMatch = False

ResolveCLSID strCLSID, arHives(ctrCH,1), strCLSIDTitle, strIPSDLL

If strIPSDLL <> "" Then

strCN = CoName(IDExe(strIPSDLL))

'for every member of approved shellex array in HKLM hive
For i = 0 To UBound(arSEA,1)

'if not ShowAll And CLSID's & DLL's identical And CoName = MS, shellex is known
If Not flagShowAll And (LCase(strCLSID) = LCase(arSEA(i,0))) And _
(Fso.GetFileName(LCase(strIPSDLL)) = LCase(arSEA(i,1))) And _
(strCN = MS) And ctrCH = 1 Then

'toggle flag & exit for
flagMatch = True : Exit For

End If

Next 'arSEA member

'for ShowAll Or unknown shellex
If flagShowAll Or Not flagMatch Then

TitleLineWrite

If Not flagTitle Then

On Error Resume Next
'output CLSID & title
oFN.WriteLine Chr(34) & strCLSID & Chr(34) & " = " & strLocTitle
intErrNum = Err.Number : Err.Clear
'error check for W2K if title (Approved CLSID) value not set
If intErrNum <> 0 Then _
oFN.WriteLine Chr(34) & strCLSID & Chr(34) & " = (no title provided)"
flagTitle = True
On Error GoTo 0

End If

'output CLSID title, InProcServer32 DLL & CoName
oFN.WriteLine " -> {" & arHives(ctrCH,0) & "...CLSID} = " &_
strCLSIDTitle & vbCRLF & Space(19) & "\InProcServer32\(Default) = " &_
StringFilter(strIPSDLL,True) & CoName(IDExe(strIPSDLL))

End If 'flagMatch Or flagShowAll?

End If 'strIPSDLL <> ""?

Next 'CLSID Hive

Next 'strCLSID

Else 'arNames array not returned

'if ShowAll, output key name
If flagShowAll Then TitleLineWrite

End If 'intErrNum1 = 0 & arNames array exists?

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

'recover array memory
ReDim arSEA(0,0)

End If 'SecTest?




'#5. HKLM... Explorer\SharedTaskScheduler/ShellExecuteHooks

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

Dim arAllowedCLSID()

ReDim arKeys(1)
arKeys(0) = "Software\Microsoft\Windows\CurrentVersion\Explorer\SharedTaskScheduler"
arKeys(1) = "Software\Microsoft\Windows\CurrentVersion\Explorer\ShellExecuteHooks"

'for each Explorer sub-key
For i = 0 To UBound(arKeys)

strSubTitle = "HKLM" & "\" & arKeys(i) & "\"

'set up allowed CLSID's & IPS names for each sub-key
If i = 0 Then 'SharedTaskScheduler

ReDim arAllowedCLSID(2,1)
arAllowedCLSID(0,0) = "{438755C2-A8BA-11D1-B96B-00A0C90312E1}"
arAllowedCLSID(0,1) = "browseui.dll"
arAllowedCLSID(1,0) = "{8C7461EF-2B13-11d2-BE35-3078302C2030}"
arAllowedCLSID(1,1) = "browseui.dll"
arAllowedCLSID(2,0) = "{553858A7-4922-4e7e-B1C1-97140C1C16EF}" 'IE 7
arAllowedCLSID(2,1) = "ieframe.dll"

ElseIf i = 1 Then 'ShellExecuteHooks

ReDim arAllowedCLSID(0,1)
arAllowedCLSID(0,0) = "{AEB6717E-7E19-11d0-97EE-00C04FD91972}"
arAllowedCLSID(0,1) = "shell32.dll"

End If 'which Explorer sub-key?

'find all the names in the Explorer key
oReg.EnumValues HKLM, arKeys(i), arNames, arType

'enumerate data if present
If IsArray(arNames) Then

'for each name
For Each strName In arNames

flagTitle = False

CLSIDLocTitle HKLM, arKeys(i), strName, strLocTitle

For ctrCH = intCLL To 1

ResolveCLSID strName, arHives(ctrCH,1), strCLSIDTitle, strIPSDLL

If strIPSDLL <> "" Then

flagFound = False
strCN = CoName(IDExe(strIPSDLL))

'for every CLSID
'see if CLSID, IPS filename are allowed & IPS CoName = "MS" & hive = HKLM
For j = 0 To UBound(arAllowedCLSID,1)

If LCase(strName) = LCase(arAllowedCLSID(j,0)) And _
LCase(Fso.GetFileName(strIPSDLL)) = LCase(arAllowedCLSID(j,1)) And _
strCN = MS And ctrCH = 1 Then
flagFound = True : strWarn = "" : Exit For
End If

Next 'allowed CLSID & IPS file name

If Not flagFound Then
strWarn = IWarn : flagIWarn = True
End If

'if IPS not allowed or ShowAll, output name & value
If Not flagFound Or flagShowAll Then

'output the title line if not already done
TitleLineWrite

If Not flagTitle Then

On Error Resume Next
oFN.WriteLine strWarn & Chr(34) & strName & Chr(34) &_
" = " & strLocTitle
'error check for W2K if SharedTaskScheduler value not set
intErrNum = Err.Number : Err.Clear
If intErrNum <> 0 Then oFN.WriteLine Chr(34) & strName & Chr(34) &_
" = (no title provided)"
flagTitle = True
On Error GoTo 0

End If

'output CLSID title, InProcServer32 DLL & CoName
oFN.WriteLine " -> {" & arHives(ctrCH,0) & "...CLSID} = " &_
strCLSIDTitle & vbCRLF & Space(19) & "\InProcServer32\(Default) = " &_
StringFilter(strIPSDLL,True) & strCN

End If 'unexpected data or ShowAll?

End If 'IPS exists?

Next 'CLSID Hive

Next 'arNames array member

Else 'arNames array not returned

'if ShowAll, output key name
If flagShowAll Then TitleLineWrite

End If 'arNames array exists

Next 'Explorer sub-key

'reset flags
flagFound = False

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

'recover array memory
ReDim arAllowedCLSID(0)
ReDim arKeys(0)
ReDim arNames(0)

End If 'SecTest?




'#6. HKCU/HKLM... ShellServiceObjectDelayLoad

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

strKey = "Software\Microsoft\Windows\CurrentVersion\ShellServiceObjectDelayLoad"

Dim arSSODL() 'array of allowable SSODL values
'flagMatch = TRUE if SSODL value is allowable

'form array of allowable SSODL values
ReDim arSSODL(6,1)
arSSODL(0,0) = "{35cec8a3-2be6-11d2-8773-92e220524153}" : arSSODL(0,1) = "stobject.dll"
arSSODL(1,0) = "{7007accf-3202-11d1-aad2-00805fc1270e}" : arSSODL(1,1) = "netshell.dll"
arSSODL(2,0) = "{7849596a-48ea-486e-8937-a2a3009f31a9}" : arSSODL(2,1) = "shell32.dll"
arSSODL(3,0) = "{e57ce738-33e8-4c51-8354-bb4de9d215d1}" : arSSODL(3,1) = "upnpui.dll"
arSSODL(4,0) = "{e6fb5e20-de35-11cf-9c87-00aa005127ed}" : arSSODL(4,1) = "webcheck.dll"
arSSODL(5,0) = "{fbeb8a05-beee-4442-804e-409d6c4515e9}" : arSSODL(5,1) = "shell32.dll"
arSSODL(6,0) = "{bcbcd383-3e06-11d3-91a9-00c04f68105c}" : arSSODL(6,1) = "auhook.dll"

For i = 0 To 1 'for each hive

strSubTitle = arHives(i,0) & "\" & strKey & "\"

'find all the names in the key
oReg.EnumValues arHives(i,1), strKey, arNames, arType

'enumerate data if present
If IsArray(arNames) Then

'for each text name
For Each strName In arNames

flagMatch = False 'SSODL entry is not allowable

'get the SSODL value = {CLSID}
oReg.GetStringValue arHives(i,1),strKey,strName,strCLSID

flagTitle = False

For ctrCH = intCLL To 1

ResolveCLSID strCLSID, arHives(ctrCH,1), strCLSIDTitle, strIPSDLL

'if IPS value exists And is not empty
If strIPSDLL <> "" Then

strCN = CoName(IDExe(strIPSDLL))
strDLL = Fso.GetFileName(strIPSDLL)

'only look for allowable values if output not ShowAll
If Not flagShowAll Then

'for every arSSODL member for this O/S
For j = 0 To UBound(arSSODL,1)

'check the CLSID, DLL filename, CoName, CLSID hive
If LCase(arSSODL(j,0)) = LCase(strCLSID) And _
LCase(arSSODL(j,1)) = LCase(strDLL) And _
LCase(strCN) = " [ms]" And _
ctrCH = 1 Then
flagMatch = True 'toggle flag if all four criteria satisfied
Exit For
End If

Next 'arSSODL member

End If 'flagShowAll?

'write the quote-delimited name and value to the file if unallowable
If Not flagMatch Then

'output title line if not already done
TitleLineWrite

If Not flagTitle Then
'output SSODL value
oFN.WriteLine Chr(34) & strName & Chr(34) & " = " &_
Chr(34) & strCLSID & Chr(34)
flagTitle = True
End If

oFN.WriteLine " -> {" & arHives(ctrCH,0) & "...CLSID} = " &_
strCLSIDTitle & vbCRLF & Space(19) & "\InProcServer32\(Default) = " &_
StringFilter(strIPSDLL,True) & strCN

End If 'flagMatch?

End If 'IPS exists?

Next 'CLSID hive

Next 'SSODL value (strName) in array

End If 'arNames array exists

'if ShowAll, output key name
If flagShowAll Then TitleLineWrite

Next 'hive

'reset flags
flagMatch = False

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
strLine = ""

'recover array memory
ReDim arType(0)
ReDim arNames(0)
ReDim arSSOLD(0,0)

End If 'SecTest?




'#7. HKCU/HKLM... Command Processor\AutoRun
' HKCU... Policies\System\Shell (W2K/WXP/WVa only)
' HKCU... Windows\load & run
' HKLM... Windows\AppInit_DLLs
' HKCU/HKLM... Winlogon\Shell
' HKLM... Winlogon\Userinit, System, Ginadll, Taskman
' HKLM... Control\SafeBoot\Option\UseAlternateShell
' HKLM... Control\SecurityProviders\SecurityProviders
' HKLM... Control\Session Manager\BootExecute
' HKLM... Control\Session Manager\WOW\cmdline, wowcmdline

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

'value length, pos'n of space/comma in value, member of SecurityProviders array
Dim intSpacePosn, intCommaPosn, strSP

If strOS <> "W98" And strOS <> "WME" Then

'HKCU\Software\Microsoft\Command Processor\AutoRun
strSubTitle = "HKCU\Software\Microsoft\Command Processor\"
RegDataChk HKCU, "Software\Microsoft\Command Processor", "AutoRun", strValue, ""

If strOS = "W2K" Or strOS = "WXP" Or strOS = "WVA" Then
'HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System
'"Shell" = ""
strSubTitle = "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\"
RegDataChk HKCU, "Software\Microsoft\Windows\CurrentVersion\Policies\System", "Shell", strValue, ""
End If 'W2K/WXP/WVa?

'HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows\load & run
strSubTitle = "HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows\"
RegDataChk HKCU, "Software\Microsoft\Windows NT\CurrentVersion\Windows", "load", strValue, ""
RegDataChk HKCU, "Software\Microsoft\Windows NT\CurrentVersion\Windows", "run", strValue, ""

'HKCU\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell
'"Shell" = "Explorer.exe"
strSubTitle = "HKCU\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\"
RegDataChk HKCU, "Software\Microsoft\Windows NT\CurrentVersion\Winlogon", "Shell", strValue, "explorer.exe"

'HKLM\Software\Microsoft\Command Processor\AutoRun
strSubTitle = "HKLM\Software\Microsoft\Command Processor\"
RegDataChk HKLM, "Software\Microsoft\Command Processor", "AutoRun", strValue, ""

'HKLM\Software\Microsoft\Windows NT\CurrentVersion\Windows\AppInit_DLLs
strSubTitle = "HKLM\Software\Microsoft\Windows NT\CurrentVersion\Windows\"
RegDataChk HKLM, "Software\Microsoft\Windows NT\CurrentVersion\Windows", "AppInit_DLLs", strValue, ""

'HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\GinaDLL
'"GinaDLL" = "MSGina.dll"
strSubTitle = "HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\"
RegDataChk HKLM, "Software\Microsoft\Windows NT\CurrentVersion\Winlogon", "GinaDLL", strValue, "msgina.dll"

'HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell
'"Shell" = "Explorer.exe"
RegDataChk HKLM, "Software\Microsoft\Windows NT\CurrentVersion\Winlogon", "Shell", strValue, "explorer.exe"

'HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Taskman
'"Taskman" = ""
RegDataChk HKLM, "Software\Microsoft\Windows NT\CurrentVersion\Winlogon", "Taskman", strValue, ""

'HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Userinit
'"Userinit" = "%SystemRoot%\system32\userinit.exe,"
'find value for "Userinit" name

flagInfect = False

strKey = "Software\Microsoft\Windows NT\CurrentVersion\Winlogon"
intErrNum = oReg.GetStringValue (HKLM,strKey,"Userinit",strValue)

'if Userinit name exists And value set (exc for W2K!)
If intErrNum = 0 And strValue <> "" Then

'save default output line
strOut = Chr(34) & "Userinit" & Chr(34) & " = " & Chr(34) &_
strValue & Chr(34) & LRParse(strValue)

'remove trailing space or comma
strValue = Trim(strValue)
If InStrRev(strValue,",") = Len(strValue) Then _
strValue = Left(strValue,Len(strValue)-1)

'if NT4 And Userinit value <> expected string, toggle infection flag & fill warning string
If strOS = "NT4" And LCase(strValue) <> "userinit,nddeagnt.exe" And _
LCase(strValue) <> "userinit nddeagnt.exe" Then

flagInfect = True

'if W2K/WXP/WVa
ElseIf strOS <> "NT4" Then

'find pos'n of space & comma in value
intLenValue = Len(strValue)
intSpacePosn = InStr(strValue," ")
If intSpacePosn = 0 Then intSpacePosn = intLenValue
intCommaPosn = InStr(strValue,",")
If intCommaPosn = 0 Then intCommaPosn = intLenValue

'if string doesn't contain userinit.exe Or extends beyond space or comma
If InStr(LCase(strValue),"userinit.exe") = 0 Or _
intLenValue > intSpacePosn + 1 Or intLenValue > intCommaPosn + 1 Then _
flagInfect = True

End If 'userinit string test

If flagInfect Then
strOut = IWarn & strOut : flagIWarn = True
End If

'if infected or ShowAll
If flagInfect Or flagShowAll Then

'output key name
TitleLineWrite

'write name and value to file
On Error Resume Next
oFN.WriteLine strOut
intErrNum = Err.Number : Err.Clear
On Error GoTo 0

'error check for W2K if Userinit value not set
If intErrNum <> 0 Then _
oFN.WriteLine Chr(34) & "Userinit" & Chr(34) & " = (value not set)"

End If 'flagInfect/flagShowAll

End If 'Userinit value exists?

flagInfect = False

'HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\System
'"System" = ""
'if NT4, check for expected value
If strOS = "NT4" Then
RegDataChk HKLM, "Software\Microsoft\Windows NT\CurrentVersion\Winlogon", "System", strValue, "lsass.exe"
'if W2K/WXP/WVa, check for empty string
Else
RegDataChk HKLM, "Software\Microsoft\Windows NT\CurrentVersion\Winlogon", "System", strValue, ""
End If


If strOS = "W2K" Or strOS = "WXP" Or strOS = "WVA" Then

'HKLM\System\CurrentControlSet\Control\SafeBoot\Option\UseAlternateShell
strKey = "System\CurrentControlSet\Control\SafeBoot\Option"
strSubTitle = "HKLM" & "\" & strKey & "\"

flagArray = False : flagInfect = False : strValue = ""
intType = -1 : strWarn = ""

'enumerate name/value pairs
EnumNVP HKLM,strKey,arNames,arType

'check for all OS's (esp WS2K3) if name/value pairs exist
If IsArray(arNames) Then

For Each strName In arNames
flagArray = True : Exit For
Next 'arNames member

'if name/value pairs exist
If flagArray Then

For i = 0 To UBound(arNames)

'check for UseAlternateShell name
If Trim(LCase(arNames(i))) = "usealternateshell" Then

'find its type & value, then exit For
flagInfect = True : strWarn = IWarn : flagIWarn = True : intType = arType(i)
strValue = RtnValue (HKLM, strKey, "UseAlternateShell", intType)
Exit For

End If 'UseAlternateShell?

Next 'arName member

End If 'flagArray?

End If 'IsArray(arNames)?

'output UseAlternateShell value
If flagInfect Then

'write name and value to file
On Error Resume Next
TitleLineWrite
'output final line
WriteValueData "UseAlternateShell", strValue, intType, strWarn
intErrNum = Err.Number : Err.Clear
On Error GoTo 0

'if write error, output warning
If intErrNum <> 0 Then _
oFN.WriteLine DQ & "UseAlternateShell" & DQ & " = (value not set)"

strKey = "System\CurrentControlSet\Control\SafeBoot"
strSubTitle = "HKLM" & "\" & strKey & "\"
TitleLineWrite
intErrNum = oReg.GetStringValue (HKLM,strKey,"AlternateShell",strValue)

If intErrNum = 0 Then
On Error Resume Next
oFN.WriteLine DQ & "AlternateShell" & DQ & " = " & DQ & strValue & DQ
intErrNum1 = Err.Number : Err.Clear
On Error Goto 0
'if write error, output warning
If intErrNum1 <> 0 Then oFN.WriteLine Chr(34) &_
"AlternateShell" & Chr(34) & " = ** WARNING -- empty or invalid data! **"
Else
oFN.WriteLine DQ & "AlternateShell" & DQ & " = (value not set)"
End If 'intErrNum=0?

ElseIf flagShowAll Then

TitleLineWrite
oFN.WriteLine DQ & "UseAlternateShell" & DQ & " = (value not found)"

End If 'flagInfect Or flagShowAll?

flagArray = False : flagInfect = False : strWarn = ""

End If 'W2K/WXP/WVa?


'HKLM\System\CurrentControlSet\Control\SecurityProviders\SecurityProviders
strKey = "System\CurrentControlSet\Control\SecurityProviders"
strSubTitle = "HKLM" & "\" & strKey & "\"
strWarn = ""

'set the SecurityProviders array per the OS version
If strOS = "W2K" Or strOS = "WXP" Or strOS = "NT4" Then
arSP = Array ("msapsspc.dll","schannel.dll","digest.dll","msnsspc.dll")
ElseIf strOS = "WVA" Then
arSP = Array ("credssp.dll")
Else
arSP = Array ("msapsspc.dll","digest.dll","msnsspc.dll")
End IF

'read the value, split into array
intErrNum = oReg.GetStringValue (HKLM,strKey,"SecurityProviders",strValue)

'if value exists (except for W2K!)
If intErrNum = 0 And strValue <> "" Then

'split the value into an array using comma delimiters
arValues = Split(strValue, ",", -1, vbTextCompare) 'vbTextCompare = 1

flagInfect = False 'assume all DLL's allowed

'for every member of the value array
For Each strVal In arValues

flagFound = False 'assume DLL is not allowed

'for every member of the allowed SP array
For Each strSP In arSP

'if names match And CoName is MS
If LCase(Trim(strSP)) = LCase(Trim(strVal)) And _
CoName(IDExe(strVal)) = MS Then
flagFound = True : Exit For 'toggle flag to allowed for this DLL
End If

Next 'SP array member

'if this DLL not allowed
If Not flagFound Then

flagInfect = True 'toggle infected flag for entire value

If strWarn = "" Then 'if this is 1st unallowed value
strWarn = IWarn & "(" & DQ & Trim(strVal) & DQ & CoName(IDExe(strVal))
flagIWarn = True
Else 'not the 1st unallowed value
strWarn = strWarn & ", " & DQ & Trim(strVal) & DQ & CoName(IDExe(strVal))
End If

End If 'DLL allowed?

Next 'value array member

'if infection present, terminate warning message
If strWarn <> "" Then strWarn = strWarn & ") "

'output if infected or ShowAll
If flagInfect Or flagShowAll Then
On Error Resume Next
TitleLineWrite
oFN.WriteLine strWarn & DQ & "SecurityProviders" & DQ & " = " &_
DQ & strValue & DQ
intErrNum = Err.Number : Err.Clear
On Error Goto 0
If intErrNum <> 0 Then oFN.WriteLine DQ & "SecurityProviders" & DQ &_
" = (value not set)"
End If

Else 'value not found

TitleLineWrite
oFN.WriteLine DQ & "SecurityProviders" & DQ & " = (value not set)"

End If


'HKLM\System\CurrentControlSet\Control\Session Manager\BootExecute
strKey = "System\CurrentControlSet\Control\Session Manager"

intErrNum = oReg.GetMultiStringValue (HKLM,strKey,"BootExecute",arNames)
strSubTitle = "HKLM" & "\" & strKey & "\"

'initialize output strings
strLine = "" : strCN = "" : flagInfect = False : strWarn = ""

If intErrNum = 0 Then 'BootExecute value exists

'alert if autocheck not in every line of multi-string
For i = 0 To UBound(arNames)

'if autocheck not in a line, trim, surround in quotes, look for CoName
If InStr(LCase(arNames(i)),"autocheck") = 0 Then
strWarn = IWarn : flagInfect = True : flagIWarn = True
strLine = StrOutSep(strLine,StringFilter(Trim(arNames(i)),True) & CoName(IDExe(arNames(i))),"|")
Else
'otherwise, trim and surround in quotes
strLine = StrOutSep(strLine,StringFilter(Trim(arNames(i)),True),"|")
End If

Next 'arNames member

Else 'BootExecute value doesn't exist or not set

strLine = "(value not set)"

End If 'BootExecute value exists?

'output bootexecute value
If flagInfect Or flagShowAll Then

'write name and value to file
On Error Resume Next
TitleLineWrite

'output final line
oFN.WriteLine strWarn & DQ & "BootExecute" & DQ & " = " & strLine
intErrNum = Err.Number : Err.Clear
On Error GoTo 0

'if write error, output warning
If intErrNum <> 0 Then oFN.WriteLine DQ & "BootExecute" & DQ &_
" = (value not set)"

End If 'flagInfect Or flagShowAll?


'HKLM\System\CurrentControlSet\Control\WOW

'WVa does not contain these values by default
If strOS <> "WVA" Then

strKey = "System\CurrentControlSet\Control\WOW"
strSubTitle = "HKLM" & "\" & strKey & "\"

strValue1 = Wshso.ExpandEnvironmentStrings("%SystemRoot%\system32\ntvdm.exe")
RegDataChk HKLM, "System\CurrentControlSet\Control\WOW", "cmdline", strValue, strValue1

strValue1 = Wshso.ExpandEnvironmentStrings("%SystemRoot%\system32\ntvdm.exe -a %SystemRoot%\system32\krnl386")
RegDataChk HKLM, "System\CurrentControlSet\Control\WOW", "wowcmdline", strValue, strValue1

End if 'WVa?

End If 'not W98/WMe

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
strLine = "" : strWarn = ""

End If 'SecTest?




'#8. Examine HKLM... Winlogon\Notify\ subkey DLLName values

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

Set arSK = CreateObject("Scripting.Dictionary") 'key, item

If strOS = "W2K" Then

arSK.Add "crypt32chain", "crypt32.dll"
arSK.Add "cryptnet", "cryptnet.dll"
arSK.Add "cscdll", "cscdll.dll"
arSK.Add "sclgntfy", "sclgntfy.dll"
arSK.Add "senslogn", "wlnotify.dll"
arSK.Add "termsrv", "wlnotify.dll"
arSK.Add "wzcnotif", "wzcdlg.dll"

ElseIf strOS = "WXP" Then

arSK.Add "crypt32chain", "crypt32.dll"
arSK.Add "cryptnet", "cryptnet.dll"
arSK.Add "cscdll", "cscdll.dll"
arSK.Add "sccertprop", "wlnotify.dll"
arSK.Add "schedule", "wlnotify.dll"
arSK.Add "sclgntfy", "sclgntfy.dll"
arSK.Add "senslogn", "wlnotify.dll"
arSK.Add "termsrv", "wlnotify.dll"
arSK.Add "wlballoon", "wlnotify.dll"
arSK.Add "wgalogon", "wgalogon.dll"

End If

arSKk = arSK.Keys
arSKi = arSK.Items

If strOS <> "W98" And strOS <> "WME" And strOS <> "WVA" Then

strKey = "Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Notify"
strSubTitle = "HKLM" & "\" & strKey & "\"

'find all the subkeys
oReg.EnumKey HKLM, strKey, arKeys

'enumerate data if present
If IsArray(arKeys) Then

'for each key
For Each oKey In arKeys

'initialize variables
flagInfect = True : strWarn = IWarn

'get the DLLName data
intErrNum = oReg.GetStringValue (HKLM,strKey & "\" & oKey,"DLLName",strValue)

'if sub-key DLLName name exists And value set (exc for W2K!)
If intErrNum = 0 And strValue <> "" Then

'check dictionary for allowed entry
For i = 0 To arSK.Count-1

'if key = dictionary key & value = dictionary item
If LCase(oKey) = arSKk(i) And LCase(strValue) = arSKi(i) Then
'toggle flag & exit -- no output necessary
flagInfect = False : strWarn = "" : Exit For
End If

Next 'dictionary key

'if DLL not allowed, toggle IWarn flag
If flagInfect Then flagIWarn = True

'if flag not found in O/S-specific dictionary or ShowAll
If flagInfect Or flagShowAll Then

'output title lines if not already done
TitleLineWrite

On Error Resume Next
'write the key, name and value to a file
oFN.WriteLine strWarn & oKey & "\DLLName = " & Chr(34) &_
strValue & Chr(34) & CoName(IDExe(strValue))
intErrNum = Err.Number : Err.Clear
On Error GoTo 0
'error check for W2K if DLLName value not set
If intErrNum <> 0 Then oFN.WriteLine oKey & "\DLLName" &_
" = (value not set)"

End If 'flag not found in dictionary or ShowAll?

End If 'value missing?

Next 'Notify subkey

Else 'Notify subkeys don't exist

'output title line
If flagShowAll Then TitleLineWrite

End If 'Notify subkeys exist?

End If 'not W98/WMe/WVa

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
strWarn = "" : strCN = ""

'recover array memory
arSK.RemoveAll : Set arSK=Nothing : ReDim arKeys(0)

End If 'SecTest?




'#9. HKLM... Image File Execution Options ("Debugger" subkeys)

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

'ignore W98/WMe/WVa
If strOS <> "W98" And strOS <> "WME" And strOS <> "WVA" Then

strKey = "Software\Microsoft\Windows NT\CurrentVersion\Image File Execution Options"
strSubTitle = "HKLM\" & strKey & "\"

'get executable name sub-keys
oReg.EnumKey HKLM,strKey,arSubKeys

If IsArray(arSubKeys) Then

'for each sub-key
For Each strSubKey in arSubKeys

strWarn = ""

'skip allowed sub-key unless ShowAll
If LCase(strSubKey) <> LCase("Your Image File Name Here without a path") Or _
flagShowAll Then

'look for Debugger value
intErrNum = oReg.GetStringValue (HKLM,strKey & "\" & strSubKey,"Debugger",strValue)

'if Debugger value exists
If intErrNum = 0 And strValue <> "" Then

'if sub-key is not allowed, set warning
If LCase(strSubKey) <> LCase("Your Image File Name Here without a path") Then
strWarn = IWarn : flagIWarn = True
End If

'output title line if not already done
TitleLineWrite

'output sub-key, warning, Debugger value
oFN.WriteLine strWarn & strSubKey & "\Debugger = " &_
Chr(34) & strValue & Chr(34) & CoName(IDExe(strValue))

End If 'Debugger value exists?

End If 'not allowed sub-key or ShowAll?

Next 'IFEO sub-key

'recover array memory
ReDim arSubKeys(0)

End If 'IFEO sub-key array exists?

End If 'not W98/WMe?

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

End If 'SecTest?

Silent Runners Log Part 2




'#10. HKCU/HKLM... Policies... Startup/Shutdown, Logon/Logoff scripts (W2K/WXP/WVa)

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

strCmd = "" 'script command line string
Dim arScrName() : ReDim arScrName(1,1)
arScrName(0,0) = "Logon" : arScrName(0,1) = "Logoff"
arScrName(1,0) = "Startup" : arScrName(1,1) = "Shutdown"

'treat WVa analogously to WXP
Dim strOSEq : strOSEQ = strOS
If strOS = "WXP" Or strOS = "WVA" Then strOSEq = "WXP-WVA"

Dim strScrDir : strScrDir = strFSP & "\Scripts\"
If strOS = "WVA" Then strScrDir = strFSP & "\GroupPolicy\"

Select Case strOSEq

Case "W2K"

'collection flag
Dim flagColl : flagColl = False

'for HKCU, then HKLM
For i = 0 To 1

strKey = "Software\Policies\Microsoft\Windows\System\Scripts"
strSubTitle = arHives(i,0) & "\" & strKey & "\"

'for every script type for the hive
For j = 0 To 1

intErrNum = oReg.GetStringValue(arHives(i,1), strKey, arScrName(i,j), strValue)

If intErrNum = 0 And strValue <> "" Then

'if value points to SCRIPTS.INI, parse the file
If Fso.FileExists(strValue & "\scripts.ini") Then

ScrIFP strValue, arScrName(i,j)

'value is not empty, so output a warning, or value is not set
ElseIf strValue <> "" Then

On Error Resume Next
TitleLineWrite
oFN.WriteLine "WARNING! Either " & Chr(34) & strValue &_
"\scripts.ini" & Chr(34) & vbCRLF & Space(9) & "doesn't " &_
"exist or there " & "is insufficient permission to " &_
"read it!"
intErrNum = Err.Number : Err.Clear
On Error Goto 0

If intErrNum <> 0 Then
TitleLineWrite
oFN.WriteLine strName & " = (value not set)"
End If

End If 'value points to SCRIPTS.INI or is not empty

End If 'HKCU logon/logoff Or HKLM startup/shutdown value exists?

Next 'name in Scripts key

'if ShowAll, output title line
If flagShowAll Then TitleLineWrite

Next 'hive type

Case "WXP-WVA"

'Base Key string
Dim strBK : strBK = "Software\Policies\Microsoft\Windows\System\Scripts\"
'modify script location for WVa
If strOS = "WVA" Then strBK = "Software\Microsoft\Windows\CurrentVersion\Group Policy\Scripts\"

Dim arNKSE 'Numbered (master) Keys containing Script Executable values
'values: DisplayName, FileSysPath, Script, Parameter
Dim strSPXP, strDispName, strFSP, strScript, strParam

'for every hive
For i = 0 To 1

'for every script type
For j = 0 To 1

strSubTitle = arHives(i,0) & "\" & strBK & arScrName(i,j) & "\"

'look for script type subkeys
oReg.EnumKey arHives(i,1),strBK & arScrName(i,j),arKeys

'enumerate data if present
If IsArray(arKeys) Then

'for each numbered key header (containing numbered script keys)
For Each strKey in arKeys

strSubTitle = arHives(i,0) & "\" & strBK & arScrName(i,j) &_
"\" & strKey & "\"

'find DisplayName & FileSysPath
intErrNum1 = oReg.GetStringValue (arHives(i,1),strBK & arScrName(i,j) &_
"\" & strKey,"DisplayName",strDispName)

'embed existing, non-empty value in quotes
If intErrNum1 = 0 And strDispName <> "" Then
strDispName = Chr(34) & strDispName & Chr(34)
'for missing or empty value
Else
strDispName = "(value not set)"
End If 'DisplayName exists?

intErrNum2 = oReg.GetStringValue (arHives(i,1),strBK & arScrName(i,j) &_
"\" & strKey,"FileSysPath",strFSP)

'if FileSysPath value exists And not empty
If intErrNum2 = 0 And strFSP <> "" Then

'look for numbered script subkeys
oReg.EnumKey arHives(i,1),strBK & arScrName(i,j) & "\" & strKey,arNKSE

'enumerate data if present
If IsArray(arNKSE) Then

'for each numbered script key
For Each strKey2 in arNKSE

strSPXP = "" 'empty the script path

'find Parameter value
intErrNum3 = oReg.GetStringValue (arHives(i,1),strBK & arScrName(i,j) &_
"\" & strKey & "\" & strKey2,"Parameters",strParam)

'if Parameters name doesn't exist, set value to empty string
If intErrNum3 <> 0 Then strParam = ""

'find Script value
intErrNum4 = oReg.GetStringValue (arHives(i,1),strBK & arScrName(i,j) &_
"\" & strKey & "\" & strKey2,"Script",strScript)

'if Script value exists And not empty
If intErrNum4 = 0 And strScript <> "" Then

'form script executable string
'if script string has no backslash, use
'FileSysPath\Scripts\[script type]\ to locate executable
'if executable not found, it will not launch
If InStr(strScript,"\") = 0 Then _
strSPXP = strFSP & "\Scripts\" & arScrName(i,j) & "\"

strCmd = strSPXP & strScript

'if parameter string is not empty, append it
If Trim(strParam) <> "" Then strScript = strScript & " " & strParam

'write title lines if necessary for this master key
TitleLineWrite
oFN.WriteLine "DisplayName = " & strDispName

'write script executable
oFN.WriteLine strKey2 & "\" & " -> launches: " & DQ &_
strCmd & DQ & CoName(IDExe(strCmd))

End If 'Script value exists And not empty?

Next 'numbered script executable key

End If 'script executable key array exists?

End If 'FileSysPath exists?

Next 'master key

End If 'master key array exists?

'if ShowAll and no prior output, output key
If flagShowAll Then TitleLineWrite

Next 'script type

Next 'hive type

'recover array memory
ReDim arScrName(0)

End Select 'W2K or WXP-WVA?

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

End If 'SecTest?




'#11. HKCU/HKLM Protocols\Filter

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

Dim strSKey 'sub-key

'10 x 3 arFilter array: filter title, CLSID value, CLSID\InProcServer32 default value
ReDim arFilter(9,2)

arFilter(0,0) = "Class Install Handler"
arFilter(0,1) = "{32B533BB-EDAE-11d0-BD5A-00AA00B92AF1}"
arFilter(0,2) = "urlmon.dll"

arFilter(1,0) = "deflate"
arFilter(1,1) = "{8f6b0360-b80d-11d0-a9b3-006097942311}"
arFilter(1,2) = "urlmon.dll"

arFilter(2,0) = "gzip"
arFilter(2,1) = "{8f6b0360-b80d-11d0-a9b3-006097942311}"
arFilter(2,2) = "urlmon.dll"

arFilter(3,0) = "lzdhtml"
arFilter(3,1) = "{8f6b0360-b80d-11d0-a9b3-006097942311}"
arFilter(3,2) = "urlmon.dll"

arFilter(4,0) = "text/webviewhtml"
arFilter(4,1) = "{733AC4CB-F1A4-11d0-B951-00A0C90312E1}"
arFilter(4,2) = "shell32.dll"

arFilter(5,0) = "text/webviewhtml"
arFilter(5,1) = "{733AC4CB-F1A4-11d0-B951-00A0C90312E1}"
arFilter(5,2) = "shdoc401.dll"

arFilter(6,0) = "text/webviewhtml"
arFilter(6,1) = "{733AC4CB-F1A4-11d0-B951-00A0C90312E1}"
arFilter(6,2) = "shdocvw.dll"

arFilter(7,0) = "application/octet-stream"
arFilter(7,1) = "{1E66F26B-79EE-11D2-8710-00C04F79ED0D}"
arFilter(7,2) = "mscoree.dll"

arFilter(8,0) = "application/x-complus"
arFilter(8,1) = "{1E66F26B-79EE-11D2-8710-00C04F79ED0D}"
arFilter(8,2) = "mscoree.dll"

arFilter(9,0) = "application/x-msdownload"
arFilter(9,1) = "{1E66F26B-79EE-11D2-8710-00C04F79ED0D}"
arFilter(9,2) = "mscoree.dll"

strKey = "Software\Classes\PROTOCOLS\Filter"

'for HKCU & HKLM
For i = 0 To 1

strSubTitle = arHives(i,0) & "\" & strKey & "\"

'find all the subkeys
oReg.EnumKey arHives(i,1), strKey, arKeys

'enumerate data if present
If IsArray(arKeys) Then

'for each sub-key
For Each strSKey In arKeys

'set default values:
'flagMatch = True if filter name, CLSID, InProcServer32 DLL, &
' DLL CoName match allowed values
flagMatch = False

'get the Filter CLSID value
intErrNum1 = oReg.GetStringValue (arHives(i,1),strKey & "\" & strSKey, _
"CLSID",strCLSID)

'if CLSID name exists And value set (exc for W2K!)
If intErrNum1 = 0 And strCLSID <> "" Then

flagTitle = False

'for each CLSID hive
For ctrCH = intCLL To 1

'retrieve CLSID title & IPSDLL
ResolveCLSID strCLSID, arHives(ctrCH,1), strCLSIDTitle, strIPSDLL

'if IPSDLL retrieved
If strIPSDLL <> "" Then

strCN = CoName(IDExe(strIPSDLL)) 'find CoName for matching

'check array for allowed entry
For j = 0 To UBound(arFilter,1)

'if filter name, CLSID value, DLL match arFilter & CoName = MS & hive = HKLM
If LCase(strSKey) = LCase(arFilter(j,0)) And _
LCase(strCLSID) = LCase(arFilter(j,1)) And _
LCase(IDExe(strIPSDLL)) = LCase(strFPSF & "\" & arFilter(j,2)) And _
strCN = MS And ctrCH = 1 Then

'toggle flag, empty warning string
flagMatch = True : strWarn = "" : Exit For

End If 'filter name & CLSID match arFilter?

Next 'arFilter member

If Not flagMatch Then
strWarn = IWarn : flagIWarn = True
End If

'if filter not in allowed array Or ShowAll
If Not flagMatch Or flagShowAll Then

TitleLineWrite

If Not flagTitle Then
On Error Resume Next
'write the quote-delimited filter name and CLSID value
oFN.WriteLine strWarn & strSKey & "\CLSID = " & DQ & strCLSID & DQ
intErrNum = Err.Number : Err.Clear : flagTitle = True
On Error Goto 0
End If

If intErrNum = 0 Then
oFN.WriteLine " -> {" & arHives(ctrCH,0) & "...CLSID} = " &_
strCLSIDTitle & vbCRLF & Space(19) & "\InProcServer32\(Default) = " &_
StringFilter(strIPSDLL,True) & strCN
Else
oFN.WriteLine strSKey & "\CLSID = (value not set)"
End If

End If 'Not flagMatch Or ShowAll?

End If 'strIPSDLL exists?

Next 'CLSID hive

ElseIf flagShowAll Then 'strCLSID doesn't exist & flagShowAll

oFN.WriteLine vbCRLF & strSKey & "\CLSID = (value not set)"

End If 'strCLSID exists?

Next 'Filter subkey

End If 'Filter subkeys exist?

Next 'PROTOCOLS/Filter hive

If flagShowAll Then TitleLineWrite

'reset flag
flagMatch = False

'reset strings
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
strWarn = ""

'recover array memory
ReDim arFilter(0)

End If 'SecTest?




'#12. Context menu shell extensions

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

Dim arClasses() : ReDim arClasses(3)
arClasses(0) = "*" : arClasses(1) = "Directory" : arClasses(2) = "Folder"
arClasses(3) = "AllFilesystemObjects"
Dim arAllowedDlls ()

'ColumnHandlers

ReDim arAllowedDlls(2)
arAllowedDlls(0) = "docprop2.dll" : arAllowedDlls(1) = "faxshell.dll"
arAllowedDlls(2) = "shell32.dll"

For i = 0 To UBound(arClasses)

strSubTitle = "HKLM\Software\Classes\" & arClasses(i) &_
"\shellex\ColumnHandlers\"
strKey = "Software\Classes\" & arClasses(i) & "\shellex\ColumnHandlers"
intErrNum = oReg.EnumKey(HKLM,strKey,arSubKeys)

If intErrNum = 0 And IsArray(arSubKeys) Then

For Each strSubKey In arSubKeys

flagTitle = False

For ctrCH = intCLL To 1

CLSIDLocTitle arHives(ctrCH,1), strKey & "\" & strSubKey, "", strLocTitle
ResolveCLSID strSubKey, arHives(ctrCH,1), strCLSIDTitle, strIPSDLL

If strIPSDLL <> "" Then 'IPS exists?

flagAllow = False

For j = 0 To UBound(arAllowedDlls)

strCN = CoName(IDExe(strIPSDLL))
If LCase(Trim(Fso.GetFileName(strIPSDLL))) = LCase(arAllowedDlls(j)) And _
strCN = MS And ctrCH = 1 Then
flagAllow = True : Exit For
End If

Next 'arAllowedDlls element

If Not flagAllow Or flagShowAll Then

TitleLineWrite

If Not flagTitle Then
oFN.WriteLine strSubKey & "\(Default) = " & strLocTitle
flagTitle = True
End If

oFN.WriteLine " -> {" & arHives(ctrCH,0) & "...CLSID} = " &_
strCLSIDTitle & vbCRLF & Space(19) & "\InProcServer32\(Default) = " &_
StringFilter(strIPSDLL,True) & CoName(IDExe(strIPSDLL))

End If 'Not flagAllow Or ShowAll?

End If 'strIPSDLL not empty?

Next 'CLSID hive

Next 'sub-key

End If 'sub-keys exist?

Next 'class


'ContextMenuHandlers

ReDim arAllowedDlls(7)
arAllowedDlls(0) = "syncui.dll" : arAllowedDlls(1) = "cscui.dll"
arAllowedDlls(2) = "shell32.dll" : arAllowedDlls(3) = "runext.dll"
arAllowedDlls(4) = "ntshrui.dll" : arAllowedDlls(5) = "msshrui.dll"
arAllowedDlls(6) = "shcompui.dll" : arAllowedDlls(7) = "shdoc401.dll"

'layout.dll, CoName = "Microsoft"

For i = 0 To UBound(arClasses)

strSubTitle = "HKLM\Software\Classes\" & arClasses(i) &_
"\shellex\ContextMenuHandlers\"
strKey = "Software\Classes\" & arClasses(i) & "\shellex\ContextMenuHandlers"
intErrNum = oReg.EnumKey(HKLM,strKey,arSubKeys)

If intErrNum = 0 And IsArray(arSubKeys) Then

For Each strSubKey In arSubKeys

intErrNum2 = oReg.GetStringValue(HKLM,strKey & "\" & strSubKey,"",strCLSID)
If intErrNum2 = 0 And strCLSID <> "" Then

flagTitle = False

For ctrCH = intCLL To 1

ResolveCLSID strCLSID, arHives(ctrCH,1), strCLSIDTitle, strIPSDLL

If strIPSDLL <> "" Then 'IPS exists?

flagAllow = False

For j = 0 To UBound(arAllowedDlls)

strCN = CoName(IDExe(strIPSDLL))
If LCase(Trim(Fso.GetFileName(strIPSDLL))) = LCase(arAllowedDlls(j)) And _
strCN = MS And ctrCH = 1 Then
flagAllow = True : Exit For
End If

Next 'arAllowedDlls element

If Not flagAllow Or flagShowAll Then

TitleLineWrite

If Not flagTitle Then
oFN.WriteLine strSubKey & "\(Default) = " & Chr(34) & strCLSID & Chr(34)
flagTitle = True
End If

oFN.WriteLine " -> {" & arHives(ctrCH,0) & "...CLSID} = " &_
strCLSIDTitle & vbCRLF & Space(19) & "\InProcServer32\(Default) = " &_
StringFilter(strIPSDLL,True) & CoName(IDExe(strIPSDLL))

End If 'Not flagAllow Or ShowAll?

End If 'strIPSDLL exists?

Next 'CLSID hive

End If 'CLSID exists?

Next 'sub-key

End If 'sub-keys exist?

Next 'class

'recover array memory
ReDim arClasses(0)

'reset strings
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

End If 'SecTest?




'#13. HKCU/HKLM executable file type (bat/cmd/com/exe/hta/pif/scr)

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

'set up executables/executable file type/expected value arrays
Dim arExeExt, arExeFT, arExpVal

If strOS = "W98" Or strOS = "WME" Then
arExeExt = Array("bat","com","exe","hta","pif","scr")
arExeFT = Array("batfile","comfile","exefile","htafile","piffile","scrfile")
arExpVal = Array("""%1"" %*","""%1"" %*","""%1"" %*", _
LCase(Fso.GetSpecialFolder(1)) & "\mshta.exe ""%1"" %*", _
"""%1"" %*","""%1"" /s")
Else
arExeExt = Array("bat","cmd","com","exe","hta","pif","scr")
arExeFT = Array("batfile","cmdfile","comfile","exefile","htafile","piffile","scrfile")
arExpVal = Array("""%1"" %*","""%1"" %*","""%1"" %*","""%1"" %*", _
LCase(Fso.GetSpecialFolder(1)) & "\mshta.exe ""%1"" %*", _
"""%1"" %*","""%1"" /s")

End If

'does base key exist?, alternate hive counter
Dim flagKeyExists, ctrCH2

'HKCU/HKLM file types
Dim arFT : arFT = Array("","")

strTitle = "Default executables:"

'for each ext
For i = 0 To UBound(arExeExt)

strOut = ""

'for each hive
For ctrCH = intCLL To 1

'construct ext key
strKey = "Software\Classes\." & arExeExt(i)

'look for ext key default value (file type)
intErrNum = oReg.GetStringValue (arHives(ctrCH,1),strKey,"",strValue)

'if ext key file type exists
If intErrNum = 0 And strValue <> "" Then

'save file type for this hive
arFT(ctrCH) = strValue

'output if in HKCU hive or unexpected file type
If ctrCH = 0 Or LCase(arFT(ctrCH)) <> LCase(arExeFT(i)) Or flagShowAll Then

strOut = StrOutSep(strOut,arHives(ctrCH,0) & "\" & strKey &_
"\(Default) = " & StringFilter(strValue,True),vbCRLF)

'if O/S = W2K/WXP and unexpected file type, check *other* hive
If intCLL = 0 And LCase(arFT(ctrCH)) <> LCase(arExeFT(i)) Then

'calculate index of other hive
ctrCH2 = ABS(ctrCH-1)
'find file type SOC value in other hive
SOCValue arFT(ctrCH),ctrCH2,"",False

End If 'W2K/WXP with unexpected file type?

End if 'HKCU or unexpected file type?

'look for ext SOC value/key
SOCValue "." & arExeExt(i), ctrCH, arExeFT(i), False

'look for file type SOC value/key (current hive)/file type base key
SOCValue arFT(ctrCH), ctrCH, arExpVal(i), True

'ext key default value (file type) not set
Else

'look for ext key
intErrNum = oReg.EnumValues (arHives(ctrCH,1),strKey,arNames,arType)

'if ext key exists
If intErrNum = 0 Then

'output ext key
strOut = StrOutSep(strOut,arHives(ctrCH,0) & "\" & strKey &_
"\(Default) = (value not set)",vbCRLF)

'look for ext key SOC value/key
SOCValue "." & arExeExt(i), ctrCH, "", False

Else 'ext key doesn't exist

If ctrCH = 1 Then strOut = StrOutSep(strOut,arHives(ctrCH,0) &_
"\" & strKey & "\ = (key not found)",vbCRLF)

End If 'ext key?

'look for default file type SOC/file type base key
SOCValue arExeFT(i), ctrCH, arExpVal(i), True

End If 'ext key file type exists?

Next 'Class hive

'write output
If strOut <> "" Or flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & strOut
End If

Next 'ext

strTitle = ""

'recover array memory
ReDim arExeExt(0) : ReDim arExtFT(0) : ReDim arExpVal(0)

End If 'SecTest?




'#14. System/Group Policies

' Checked Keys:
'
' HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\ActiveDesktop
' HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Assocations
' HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Attachments
' HKCU/HKLM\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer
' HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\DisallowCpl
' HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System
' HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\WindowsUpdate
' HKCU/HKLM\Software\Policies\Microsoft\Internet Explorer\Control Panel
' HKCU/HKLM\Software\Policies\Microsoft\Internet Explorer\Download
' HKCU/HKLM\Software\Policies\Microsoft\Internet Explorer\Infodelivery\Restrictions
' HKCU/HKLM\Software\Policies\Microsoft\Internet Explorer\Main
' HKCU/HKLM\Software\Policies\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_WINDOW_RESTRICTIONS
' HKCU/HKLM\Software\Policies\Microsoft\Internet Explorer\PhishingFilter
' HKCU/HKLM\Software\Policies\Microsoft\Internet Explorer\Restrictions
' HKCU/HKLM\Software\Policies\Microsoft\Internet Explorer\Security
' HKCU\Software\Policies\Microsoft\MMC\{8FC0B734-A0E1-11D1-A7D3-0000F87571E3}
' HKCU/HKLM\Software\Policies\Microsoft\Windows\CurrentVersion\Internet Settings\Lockdown_Zones\2
' HKCU/HKLM\Software\Policies\Microsoft\Windows\CurrentVersion\Internet Settings\Lockdown_Zones\3
' HKCU/HKLM\Software\Policies\Microsoft\Windows\CurrentVersion\Internet Settings\Lockdown_Zones\4
' HKCU/HKLM\Software\Policies\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2
' HKCU/HKLM\Software\Policies\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3
' HKCU/HKLM\Software\Policies\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\4
' HKCU\Software\Policies\Microsoft\Windows\Network Connections
' HKCU\Software\Policies\Microsoft\Windows\System
' HKCU\Software\Policies\Microsoft\Windows\Task Scheduler5.0
' HKLM\Software\Microsoft\Windows\CurrentVersion\Policies\System
' HKLM\Software\Policies\Microsoft\Windows NT\SystemRestore

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

Const ATPL = "Administrative Templates|"
Const WSSSLP = "Windows Settings|Security Settings|Local Policies|"
Const WC = "Windows Components|"
Const IEX = "Internet Explorer|"
Const MMC = "Microsoft Management Console|"
Const WEX = "Windows Explorer|"
Const SMTB = "Start Menu and Taskbar|"
Const DT = "Desktop|"
Const DAD = "Desktop / Active Desktop|"
Const CP = "Control Panel|"
Const NWK = "Network|"
Const SYS = "System|"

'assign System or Group Policy name
Dim strPolName : strPolName = "System "
If strOS = "W2K" Or strOS = "WXP" Or strOS = "WVA" Then strPolName = "Group "

Dim arDisCplNames, strDisCplName, strDisCplValue


'set title line
strTitle = strPolName & "Policies {policy setting}:"
'add GPEdit location to title if GP used (W2K, WXP Pro, WVa)
If flagGP Then strTitle = "Group Policies {GPedit.msc branch and setting}:"
strSubTitle = "Note: detected settings may not have any effect."


strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\ActiveDesktop"

ReDim arRecNames(3,2)

arRecNames(0,0) = "NoChangingWallPaper" : arRecNames(0,1) = ATPL & CP & "Display|"
arRecNames(0,2) = "Disable changing wallpaper}"
If strOS = "WXP" Or strOS = "WVA" Then arRecNames(0,2) = "Prevent changing wallpaper}"

arRecNames(1,0) = "NoClosingComponents" : arRecNames(1,1) = ATPL & DT & DAD
arRecNames(1,2) = "Prohibit closing items}"

arRecNames(2,0) = "NoDeletingComponents" : arRecNames(2,1) = ATPL & DT & DAD
arRecNames(2,2) = "Prohibit deleting items}"

arRecNames(3,0) = "NoEditingComponents" : arRecNames(3,1) = ATPL & DT & DAD
arRecNames(3,2) = "Prohibit editing items}"

GPRecognizer HKCU, strKey : ReDimGPOArrays


strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\Associations"

ReDim arRecNames(0,2)

arRecNames(0,0) = "DefaultFileTypeRisk"
arRecNames(0,1) = ATPL & WC & "Attachment Manager|"
arRecNames(0,2) = "Default risk level for file attachments}"

GPRecognizer HKCU, strKey : ReDimGPOArrays


strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\Attachments"

ReDim arRecNames(0,2)

arRecNames(0,0) = "ScanWithAntiVirus"
arRecNames(0,1) = ATPL & WC & "Attachment Manager|"
arRecNames(0,2) = "Notify antivirus programs when opening attachments}"

GPRecognizer HKCU, strKey : ReDimGPOArrays


strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer"

ReDim arRecNames(27,2)

arRecNames(0,0) = "ClassicShell" : arRecNames(0,1) = ATPL & WC & WEX
arRecNames(0,2) = "Enable Classic Shell / Turn on Classic Shell}"

arRecNames(1,0) = "ForceActiveDesktopOn"
arRecNames(1,1) = ATPL & DT & DAD : arRecNames(1,2) = "Enable Active Desktop}"
If strOS = "W98" Or strOS = "NT4" Then
arRecNames(1,1) = "" : arRecNames(1,2) = "unrecognized setting}"
End If

arRecNames(2,0) = "NoActiveDesktop" : arRecNames(2,1) = ATPL & DT & DAD
arRecNames(2,2) = "Disable Active Desktop}"

arRecNames(3,0) = "NoActiveDesktopChanges" : arRecNames(3,1) = ATPL & DT & DAD
arRecNames(3,2) = "Prohibit changes}"

'added by GP, but ignored in practice, presence of DisallowCpl subkey name/value pairs
'sufficient to hide applets, even if this DWORD = 0 or absent
arRecNames(4,0) = "DisallowCpl" : arRecNames(4,1) = ATPL & CP
arRecNames(4,2) = "Hide specified control panel applets / items}"

arRecNames(5,0) = "NoToolbarCustomize" : arRecNames(5,1) = ATPL & WC & IEX & "Toolbars|"
arRecNames(5,2) = "Disable customizing browser toolbar buttons}"

arRecNames(6,0) = "NoBandCustomize" : arRecNames(6,1) = ATPL & WC & IEX & "Toolbars|"
arRecNames(6,2) = "Disable customizing browser toolbars}"

arRecNames(7,0) = "NoFolderOptions" : arRecNames(7,1) = ATPL & WC & WEX
arRecNames(7,2) = "Removes the Folder Options menu item from the Tools menu}"

arRecNames(8,0) = "NoWindowsUpdate" : arRecNames(8,1) = ATPL & SMTB
arRecNames(8,2) = "Remove links and access to Windows Update}"

arRecNames(9,0) = "NoTrayItemsDisplay" : arRecNames(9,1) = ATPL & SMTB
arRecNames(9,2) = "Hide the notification area}"

arRecNames(10,0) = "NoSetTaskbar" : arRecNames(10,1) = ATPL & SMTB
arRecNames(10,2) = "Prevent changes to Taskbar and Start Menu Settings}"

arRecNames(11,0) = "TaskbarLockAll" : arRecNames(11,1) = ATPL & SMTB
arRecNames(11,2) = "Lock all taskbar settings}"

arRecNames(12,0) = "TaskbarNoAddRemoveToolbar" : arRecNames(12,1) = ATPL & SMTB
arRecNames(12,2) = "Prevent users from adding or removing toolbars}"

arRecNames(13,0) = "TaskbarNoDragToolbar" : arRecNames(13,1) = ATPL & SMTB
arRecNames(13,2) = "Prevent users from rearranging toolbars}"

arRecNames(14,0) = "NoStartMenuMorePrograms" : arRecNames(14,1) = ATPL & SMTB
arRecNames(14,2) = "Remove All Programs list from the Start menu}"

arRecNames(15,0) = "NoSMHelp" : arRecNames(15,1) = ATPL & SMTB
arRecNames(15,2) = "Remove Help menu from Start Menu}"

arRecNames(16,0) = "NoAutoUpdate" : arRecNames(16,1) = ATPL & SYS
arRecNames(16,2) = "Windows Automatic Updates}"

arRecNames(17,0) = "NoSecurityTab" : arRecNames(17,1) = ATPL & WC & WEX
arRecNames(17,2) = "Remove Security tab}"

arRecNames(18,0) = "NoSaveSettings" : arRecNames(18,1) = ATPL & DT
arRecNames(18,2) = "Don't save settings at exit}"

arRecNames(19,0) = "NoStartBanner" : arRecNames(19,1) = ""
arRecNames(19,2) = "Remove " & DQ & "Click here to begin" & DQ & " from Start button}"

arRecNames(20,0) = "NoFavoritesMenu" : arRecNames(20,1) = ATPL & SMTB
arRecNames(20,2) = "Remove Favorites menu from Start Menu}"

arRecNames(21,0) = "NoWinKeys" : arRecNames(21,1) = ""
arRecNames(21,2) = "Disable Windows+X hotkeys}"

arRecNames(22,0) = "NoSMMyDocs" : arRecNames(22,1) = ATPL & SMTB
arRecNames(22,2) = "Remove Documents menu from Start Menu}"

arRecNames(23,0) = "NoSMMyPictures" : arRecNames(23,1) = ATPL & SMTB
arRecNames(23,2) = "Remove My Pictures icon from Start Menu}"

arRecNames(24,0) = "NoNetworkConnections" : arRecNames(24,1) = ATPL & SMTB
arRecNames(24,2) = "Remove Network & Dial-up Connections from Start Menu}"
If strOS = "WXP" Then arRecNames(24,2) = "Remove Network Connections from Start Menu}"

arRecNames(25,0) = "NoSharedDocuments" : arRecNames(25,1) = ATPL & WC & WEX
arRecNames(25,2) = "Remove Shared Documents from My Computer}"

arRecNames(26,0) = "NoLogoff" : arRecNames(26,1) = ATPL & SYS & "Logon/Logoff|"
arRecNames(26,2) = "Disable Logoff}"

arRecNames(27,0) = "NoInternetIcon" : arRecNames(27,1) = ATPL & DT
arRecNames(27,2) = "Hide Internet Explorer icon on desktop}"

ReDim arAllowedNames(2,3)

arAllowedNames(0,0) = "NoDriveTypeAutoRun" : arAllowedNames(0,1) = ATPL & WC & "AutoPlay Policies|"
arAllowedNames(0,2) = "Turn off Autoplay}"
arAllowedNames(0,3) = "***"

arAllowedNames(1,0) = "NoDriveAutoRun" : arAllowedNames(1,1) = ""
arAllowedNames(1,2) = "Turn off autoplay for drive letter}"
arAllowedNames(1,3) = "***"

arAllowedNames(2,0) = "MaxRecentDocs" : arAllowedNames(2,1) = ATPL & WC & WEX
arAllowedNames(2,2) = "Maximum number of recent documents}"
arAllowedNames(2,3) = "***"

GPRecognizer HKCU, strKey : ReDimGPOArrays


ReDim arAllowedNames(1,3)

arAllowedNames(0,0) = "NoDriveTypeAutoRun" : arAllowedNames(0,1) = ATPL & WC & "AutoPlay Policies|"
arAllowedNames(0,2) = "Turn off Autoplay}"
arAllowedNames(0,3) = "***"

arAllowedNames(1,0) = "NoDriveAutoRun" : arAllowedNames(1,1) = ""
arAllowedNames(1,2) = "Turn off autoplay for drive letter}"
arAllowedNames(1,3) = "***"

GPRecognizer HKLM, strKey : ReDimGPOArrays

'omitted Control Panel applets
strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\DisallowCpl"

GPRecognizer HKCU, strKey : ReDimGPOArrays


strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\System"

ReDim arRecNames(5,2)

arRecNames(0,0) = "DisableRegistryTools" : arRecNames(0,1) = ATPL & SYS
arRecNames(0,2) = "Disable registry editing tools}"
If strOS = "WXP" Or strOS = "WVA" Then arRecNames(0,2) = "Prevent access to " &_
"registry editing tools}"

arRecNames(1,0) = "NoDispBackgroundPage" : arRecNames(1,1) = ATPL & CP & "Display|"
arRecNames(1,2) = "Hide Background tab}"
If strOS = "WXP" Or strOS = "WVA" Then arRecNames(1,2) = "Hide Desktop tab}"

arRecNames(2,0) = "NoDispCpl"
arRecNames(2,1) = ATPL & CP & "Display|"
arRecNames(2,2) = "Disable Display in Control Panel}"
If strOS = "WXP" Or strOS = "WVA" Then arRecNames(2,2) = "Remove Display in Control Panel}"

arRecNames(3,0) = "Wallpaper" : arRecNames(3,1) = ATPL & DT & DAD
arRecNames(3,2) = "Active Desktop Wallpaper|Wallpaper Name:}"
If strOS = "WVA" Then arRecNames(3,2) = "Desktop Wallpaper|Wallpaper Name:}"

arRecNames(4,0) = "WallpaperStyle" : arRecNames(4,1) = ATPL & DT & DAD
arRecNames(4,2) = "Active Desktop Wallpaper|Wallpaper Style:}"
If strOS = "WVA" Then arRecNames(4,2) = "Desktop Wallpaper|Wallpaper Style:}"

arRecNames(5,0) = "DisableTaskMgr"
arRecNames(5,1) = ATPL & SYS & "Ctrl+Alt+Del Options|"
If strOS = "W2K" Then arRecNames(5,1) = ATPL & SYS & "Logon/Logoff|"
arRecNames(5,2) = "Remove Task Manager}"

GPRecognizer HKCU, strKey : ReDimGPOArrays


strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\WindowsUpdate"

ReDim arRecNames(0,2)

arRecNames(0,0) = "DisableWindowsUpdateAccess"
arRecNames(0,1) = ATPL & WC & "Windows Update|"
arRecNames(0,2) = "Remove access to use all Windows Update features}"

GPRecognizer HKCU, strKey : ReDimGPOArrays


strKey = "Software\Policies\Microsoft\Internet Explorer\Control Panel"

ReDim arRecNames(13,2)

arRecNames(1,0) = "Advanced" : arRecNames(1,1) = ATPL & WC & IEX
arRecNames(1,2) = "Disable changing Advanced page settings}"

arRecNames(2,0) = "AdvancedTab" 'HKLM
arRecNames(2,1) = ATPL & WC & IEX & "Internet Control Panel|"
arRecNames(2,2) = "Disable the Advanced page}"

arRecNames(3,0) = "Connection Settings" 'HKLM
arRecNames(3,1) = ATPL & WC & IEX
arRecNames(3,2) = "Disable changing connection settings}"

arRecNames(4,0) = "ConnectionsTab" 'HKLM
arRecNames(4,1) = ATPL & WC & IEX & "Internet Control Panel|"
arRecNames(4,2) = "Disable the Connections page}"

arRecNames(5,0) = "ContentTab" 'HKLM
arRecNames(5,1) = ATPL & WC & IEX & "Internet Control Panel|"
arRecNames(5,2) = "Disable the Content page}"

arRecNames(6,0) = "DisableRIED" 'HKLM
arRecNames(6,1) = ATPL & WC & IEX & "Internet Control Panel|Advanced Page|"
arRecNames(6,2) = "Do not allow resetting Internet Explorer settings}"

arRecNames(7,0) = "GeneralTab" 'HKLM
arRecNames(7,1) = ATPL & WC & IEX & "Internet Control Panel|"
arRecNames(7,2) = "Disable the General page}"

arRecNames(8,0) = "HomePage" : arRecNames(8,1) = ATPL & WC & IEX
arRecNames(8,2) = "Disable changing home page settings}"

arRecNames(9,0) = "PrivacyTab" 'HKLM
arRecNames(9,1) = ATPL & WC & IEX & "Internet Control Panel|"
arRecNames(9,2) = "Disable the Privacy page}"

arRecNames(10,0) = "Proxy" 'HKLM
arRecNames(10,1) = ATPL & WC & IEX
arRecNames(10,2) = "Disable changing proxy settings}"

arRecNames(11,0) = "ResetWebSettings" : arRecNames(11,1) = ATPL & WC & IEX
arRecNames(11,2) = "Disable the Reset Web Settings feature}"

arRecNames(12,0) = "SecurityTab" 'HKLM
arRecNames(12,1) = ATPL & WC & IEX & "Internet Control Panel|"
arRecNames(12,2) = "Disable the Security page}"

arRecNames(13,0) = "Settings" : arRecNames(13,1) = ATPL & WC & IEX
arRecNames(13,2) = "Prevent the deletion of temporary Internet files and cookies}"

GPRecognizer HKCU, strKey : GPRecognizer HKLM, strKey : ReDimGPOArrays


strKey = "Software\Policies\Microsoft\Internet Explorer\Download"

ReDim arRecNames(1,2)

arRecNames(0,0) = "RunInvalidSignatures" 'HKLM
arRecNames(0,1) = ATPL & WC & IEX & "Internet Control Panel|Advanced Page|"
arRecNames(0,2) = "Allow software to run or install even if the signature is invalid}"

arRecNames(1,0) = "CheckExeSignatures" 'HKLM
arRecNames(1,1) = ATPL & WC & IEX & "Internet Control Panel|Advanced Page|"
arRecNames(1,2) = "Check for signatures on downloaded programs}"

GPRecognizer HKCU, strKey : GPRecognizer HKLM, strKey : ReDimGPOArrays


strKey = "Software\Policies\Microsoft\Internet Explorer\Infodelivery\Restrictions"

ReDim arRecNames(1,2)

arRecNames(0,0) = "NoChangeDefaultSearchProvider" 'HKLM
arRecNames(0,1) = ATPL & WC & IEX
arRecNames(0,2) = "Restrict changing the default search provider}"

arRecNames(1,0) = "NoSearchCustomization"
arRecNames(1,1) = ATPL & WC & IEX
arRecNames(1,2) = "Search: Disable Search Customization}"

GPRecognizer HKCU, strKey : GPRecognizer HKLM, strKey : ReDimGPOArrays


strKey = "Software\Policies\Microsoft\Internet Explorer\Main"

ReDim arRecNames(1,2)

arRecNames(0,0) = "Enable Browser Extensions" 'HKLM
arRecNames(0,1) = ATPL & WC & IEX & "Internet Control Panel|Advanced Page|"
arRecNames(0,2) = "Allow third-party browser extensions}"

arRecNames(1,0) = "Start Page"
arRecNames(1,1) = ATPL & WC & IEX
arRecNames(1,2) = "Disable changing home page settings -- Home Page imposed by this setting}"

GPRecognizer HKCU, strKey : GPRecognizer HKLM, strKey : ReDimGPOArrays


strKey = "Software\Policies\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_WINDOW_RESTRICTIONS"

ReDim arRecNames(0,2)

arRecNames(0,0) = "*" 'HKLM
arRecNames(0,1) = ATPL & WC & IEX & "Security Features|Scripted Window Security Restrictions|"
arRecNames(0,2) = "Internet Explorer Processes}"

GPRecognizer HKCU, strKey : GPRecognizer HKLM, strKey : ReDimGPOArrays


strKey = "Software\Policies\Microsoft\Internet Explorer\PhishingFilter"

ReDim arRecNames(0,2)

arRecNames(0,0) = "Enabled" 'HKLM
arRecNames(0,1) = ATPL & WC & IEX
arRecNames(0,2) = "Turn off Managing Phishing filter}"

GPRecognizer HKCU, strKey : GPRecognizer HKLM, strKey : ReDimGPOArrays


strKey = "Software\Policies\Microsoft\Internet Explorer\Restrictions"

ReDim arRecNames(2,2)

arRecNames(0,0) = "NoExtensionManagement" 'HKLM
arRecNames(0,1) = ATPL & WC & IEX
arRecNames(0,2) = "Do not allow users to enable or disable add-ons}"

arRecNames(1,0) = "NoPopupManagement" 'HKLM
arRecNames(1,1) = ATPL & WC & IEX
arRecNames(1,2) = "Turn off pop-up management}"

arRecNames(2,0) = "NoBrowserOptions"
arRecNames(2,1) = ATPL & WC & IEX & "Browser Menus|"
arRecNames(2,2) = "Tools menu: Disable Internet Options... menu option}"

GPRecognizer HKCU, strKey : GPRecognizer HKLM, strKey : ReDimGPOArrays


strKey = "Software\Policies\Microsoft\Internet Explorer\Security"

ReDim arRecNames(1,2)

arRecNames(0,0) = "DisableFixSecuritySettings" 'HKLM
arRecNames(0,1) = ATPL & WC & IEX
arRecNames(0,2) = "Do not allow users to enable or disable add-ons}"

arRecNames(1,0) = "DisableSecuritySettingsCheck" 'HKLM
arRecNames(1,1) = ATPL & WC & IEX
arRecNames(1,2) = "Turn off the Security Settings Check feature}"

GPRecognizer HKCU, strKey : GPRecognizer HKLM, strKey : ReDimGPOArrays


strKey = "Software\Policies\Microsoft\MMC\{8FC0B734-A0E1-11D1-A7D3-0000F87571E3}"

ReDim arRecNames(0,2)

arRecNames(0,0) = "Restrict_Run"
arRecNames(0,1) = ATPL & WC & MMC & "Restricted/Permitted snap-ins|Group Policy|"
arRecNames(0,2) = "Group Policy Object Editor}"

GPRecognizer HKCU, strKey : ReDimGPOArrays


strKey = "Software\Policies\Microsoft\Windows\CurrentVersion\Internet Settings\Lockdown_Zones\2"

ReDim arRecNames(1,2)

arRecNames(0,0) = "1004" 'HKLM
arRecNames(0,1) = ATPL & WC & IEX & "Internet Control Panel|Security Page|Locked-Down Trusted Sites Zone|"
arRecNames(0,2) = "Download unsigned ActiveX controls}"

arRecNames(1,0) = "1201" 'HKLM
arRecNames(1,1) = ATPL & WC & IEX & "Internet Control Panel|Security Page|Locked-Down Trusted Sites Zone|"
arRecNames(1,2) = "Initialize and script ActiveX controls not marked as safe}"

GPRecognizer HKCU, strKey : GPRecognizer HKLM, strKey : ReDimGPOArrays


strKey = "Software\Policies\Microsoft\Windows\CurrentVersion\Internet Settings\Lockdown_Zones\3"

ReDim arRecNames(1,2)

arRecNames(0,0) = "1004" 'HKLM
arRecNames(0,1) = ATPL & WC & IEX & "Internet Control Panel|Security Page|Locked-Down Internet Zone|"
arRecNames(0,2) = "Download unsigned ActiveX controls}"

arRecNames(1,0) = "1201" 'HKLM
arRecNames(1,1) = ATPL & WC & IEX & "Internet Control Panel|Security Page|Locked-Down Internet Zone|"
arRecNames(1,2) = "Initialize and script ActiveX controls not marked as safe}"

GPRecognizer HKCU, strKey : GPRecognizer HKLM, strKey : ReDimGPOArrays


strKey = "Software\Policies\Microsoft\Windows\CurrentVersion\Internet Settings\Lockdown_Zones\4"

ReDim arRecNames(1,2)

arRecNames(0,0) = "1004" 'HKLM
arRecNames(0,1) = ATPL & WC & IEX & "Internet Control Panel|Security Page|Locked-Down Restricted Sites Zone|"
arRecNames(0,2) = "Download unsigned ActiveX controls}"

arRecNames(1,0) = "1201" 'HKLM
arRecNames(1,1) = ATPL & WC & IEX & "Internet Control Panel|Security Page|Locked-Down Restricted Sites Zone|"
arRecNames(1,2) = "Initialize and script ActiveX controls not marked as safe}"

GPRecognizer HKCU, strKey : GPRecognizer HKLM, strKey : ReDimGPOArrays


strKey = "Software\Policies\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2"

ReDim arRecNames(1,2)

arRecNames(0,0) = "1004" 'HKLM
arRecNames(0,1) = ATPL & WC & IEX & "Internet Control Panel|Security Page|Trusted Sites Zone|"
arRecNames(0,2) = "Download unsigned ActiveX controls}"

arRecNames(1,0) = "1201" 'HKLM
arRecNames(1,1) = ATPL & WC & IEX & "Internet Control Panel|Security Page|Trusted Sites Zone|"
arRecNames(1,2) = "Initialize and script ActiveX controls not marked as safe}"

GPRecognizer HKCU, strKey : GPRecognizer HKLM, strKey : ReDimGPOArrays


strKey = "Software\Policies\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3"

ReDim arRecNames(1,2)

arRecNames(0,0) = "1004" 'HKLM
arRecNames(0,1) = ATPL & WC & IEX & "Internet Control Panel|Security Page|Internet Zone|"
arRecNames(0,2) = "Download unsigned ActiveX controls}"

arRecNames(1,0) = "1201" 'HKLM
arRecNames(1,1) = ATPL & WC & IEX & "Internet Control Panel|Security Page|Internet Zone|"
arRecNames(1,2) = "Initialize and script ActiveX controls not marked as safe}"

GPRecognizer HKCU, strKey : GPRecognizer HKLM, strKey : ReDimGPOArrays


strKey = "Software\Policies\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\4"

ReDim arRecNames(1,2)

arRecNames(0,0) = "1004" 'HKLM
arRecNames(0,1) = ATPL & WC & IEX & "Internet Control Panel|Security Page|Restricted Sites Zone|"
arRecNames(0,2) = "Download unsigned ActiveX controls}"

arRecNames(1,0) = "1201" 'HKLM
arRecNames(1,1) = ATPL & WC & IEX & "Internet Control Panel|Security Page|Restricted Sites Zone|"
arRecNames(1,2) = "Initialize and script ActiveX controls not marked as safe}"

GPRecognizer HKCU, strKey : GPRecognizer HKLM, strKey : ReDimGPOArrays


strKey = "Software\Policies\Microsoft\Windows\Network Connections"

ReDim arRecNames(5,2)

arRecNames(0,0) = "NC_LanProperties"
arRecNames(0,1) = ATPL & NWK & "Network and Dial-up Connections|"
If strOS = "WVA" Then arRecNames(0,1) = ATPL & NWK & "Network Connections|"
arRecNames(0,2) = "Prohibit access to properties of a LAN connection}"

arRecNames(1,0) = "NC_LanChangeProperties"
arRecNames(1,1) = ATPL & NWK & "Network and Dial-up Connections|"
If strOS = "WVA" Then arRecNames(1,1) = ATPL & NWK & "Network Connections|"
arRecNames(1,2) = "Prohibit access to properties of components of a LAN connection}"

arRecNames(2,0) = "NC_RasChangeProperties"
arRecNames(2,1) = ATPL & NWK & "Network and Dial-up Connections|"
If strOS = "WVA" Then arRecNames(2,1) = ATPL & NWK & "Network Connections|"
arRecNames(2,2) = "Prohibit access to properties of components of a remote access connection}"

arRecNames(3,0) = "NC_AddRemoveComponents"
arRecNames(3,1) = ATPL & NWK & "Network and Dial-up Connections|"
If strOS = "WVA" Then arRecNames(3,1) = ATPL & NWK & "Network Connections|"
arRecNames(3,2) = "Prohibit adding and removing components for a LAN or remote access connection}"

arRecNames(4,0) = "NC_DeleteConnection"
arRecNames(4,1) = ATPL & NWK & "Network and Dial-up Connections|"
If strOS = "WVA" Then arRecNames(4,1) = ATPL & NWK & "Network Connections|"
arRecNames(4,2) = "Prohibit deletion of remote access connections}"

arRecNames(5,0) = "NC_Statistics"
arRecNames(5,1) = ATPL & NWK & "Network and Dial-up Connections|"
If strOS = "WVA" Then arRecNames(5,1) = ATPL & NWK & "Network Connections|"
arRecNames(5,2) = "Prohibit viewing of status for an active connection}"

GPRecognizer HKCU, strKey : ReDimGPOArrays


strKey = "Software\Policies\Microsoft\Windows\System"

ReDim arRecNames(0,2)

arRecNames(0,0) = "DisableCMD"
arRecNames(0,1) = ATPL & SYS
arRecNames(0,2) = "Disable the command prompt}"
If strOS = "WVA" Then arRecNames(0,2) = "Prevent access to the command prompt}"

GPRecognizer HKCU, strKey : ReDimGPOArrays


strKey = "Software\Policies\Microsoft\Windows\Task Scheduler5.0"

ReDim arRecNames(0,2)

arRecNames(0,0) = "Task Deletion" 'HKLM
arRecNames(0,1) = ATPL & WC & "Task Scheduler|"
arRecNames(0,2) = "Prohibit Task deletion}"

GPRecognizer HKCU, strKey : GPRecognizer HKLM, strKey : ReDimGPOArrays


strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\System"

ReDim arAllowedNames(15,3)

arAllowedNames(0,0) = "ConsentPromptBehaviorAdmin" : arAllowedNames(0,1) = WSSSLP & "Security Options|"
arAllowedNames(0,2) = "User Account Control: Behavior Of The Elevation " &_
"Prompt For Administrators In Admin Approval Mode}" : arAllowedNames(0,3) = "2"

arAllowedNames(1,0) = "ConsentPromptBehaviorUser" : arAllowedNames(1,1) = WSSSLP & "Security Options|"
arAllowedNames(1,2) = "User Account Control: Behavior Of The Elevation " &_
"Prompt For Standard Users}" : arAllowedNames(1,3) = "1"

arAllowedNames(2,0) = "dontdisplaylastusername" : arAllowedNames(2,1) = WSSSLP & "Security Options|"
arAllowedNames(2,2) = "Interactive logon: Do not display last user name}" : arAllowedNames(2,3) = "***"

arAllowedNames(3,0) = "EnableInstallerDetection" : arAllowedNames(3,1) = WSSSLP & "Security Options|"
arAllowedNames(3,2) = "User Account Control: Detect Application " &_
"Installations And Prompt For Elevation}" : arAllowedNames(3,3) = "1"

arAllowedNames(4,0) = "EnableLUA" : arAllowedNames(4,1) = WSSSLP & "Security Options|"
arAllowedNames(4,2) = "User Account Control: Run All Administrators " &_
"In Admin Approval Mode}" : arAllowedNames(4,3) = "1"

arAllowedNames(5,0) = "EnableSecureUIAPaths" : arAllowedNames(5,1) = WSSSLP & "Security Options|"
arAllowedNames(5,2) = "User Account Control: Only elevate UIAccess " &_
"applications that are installed in secure locations}" : arAllowedNames(5,3) = "1"

arAllowedNames(6,0) = "EnableVirtualization" : arAllowedNames(6,1) = WSSSLP & "Security Options|"
arAllowedNames(6,2) = "User Account Control: Virtualize file and registry " &_
"write failures to per-user locations}" : arAllowedNames(6,3) = "1"

arAllowedNames(7,0) = "FilterAdministratorToken" : arAllowedNames(7,1) = WSSSLP & "Security Options|"
arAllowedNames(7,2) = "User Account Control: Admin Approval Mode for " &_
"the Built-in Administrator Account}" : arAllowedNames(7,3) = "1"

arAllowedNames(8,0) = "legalnoticecaption" : arAllowedNames(8,1) = WSSSLP & "Security Options|"
arAllowedNames(8,2) = "Interactive logon: Message title for users " &_
"attempting to log on}" : arAllowedNames(8,3) = "***"

arAllowedNames(9,0) = "legalnoticetext" : arAllowedNames(9,1) = WSSSLP & "Security Options|"
arAllowedNames(9,2) = "Interactive logon: Message text for users " &_
"attempting to log on}" : arAllowedNames(9,3) = "***"

arAllowedNames(10,0) = "PromptOnSecureDesktop" : arAllowedNames(10,1) = WSSSLP & "Security Options|"
arAllowedNames(10,2) = "User Account Conrol: Switch to the secure " & _
"desktop when prompting for elevation}" : arAllowedNames(10,3) = "1"

arAllowedNames(11,0) = "scforceoption" : arAllowedNames(11,1) = WSSSLP & "Security Options|"
arAllowedNames(11,2) = "Interactive logon: Require smart card}" : arAllowedNames(11,3) = "***"

arAllowedNames(12,0) = "shutdownwithoutlogon" : arAllowedNames(12,1) = WSSSLP & "Security Options|"
arAllowedNames(12,2) = "Shutdown: Allow system to be shut down without " &_
"having to log on}" : arAllowedNames(12,3) = "1"

arAllowedNames(13,0) = "undockwithoutlogon" : arAllowedNames(13,1) = WSSSLP & "Security Options|"
arAllowedNames(13,2) = "Devices: Allow undock without having to log on}" : arAllowedNames(13,3) = "1"

arAllowedNames(14,0) = "ValidateAdminCodeSignatures" : arAllowedNames(14,1) = WSSSLP & "Security Options|"
arAllowedNames(14,2) = "User Account Control: Only elevate executables " &_
"that are signed and validated}" : arAllowedNames(14,3) = "***"

GPRecognizer HKLM, strKey : ReDimGPOArrays


'has no effect in WMe
If strOS = "WXP" Or strOS = "WVA" Then

strKey = "Software\Policies\Microsoft\Windows NT\SystemRestore"

ReDim arRecNames(1,2)

arRecNames(0,0) = "DisableSR" : arRecNames(0,1) = ATPL & SYS & "System Restore|"
arRecNames(0,2) = "Turn off System Restore}"

arRecNames(1,0) = "DisableConfig" : arRecNames(1,1) = ATPL & SYS & "System Restore|"
arRecNames(1,2) = "Turn off Configuration}"

GPRecognizer HKLM, strKey : ReDimGPOArrays

End If 'WXP/WVa?

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

End If 'SecTest?




'#15. Active Desktop, wallpaper & screen saver

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

Dim arBValue()

'title line string
strTitle = "Active Desktop and Wallpaper:"


'Active Desktop

'Active Desktop flag key
strKey = "Software\Microsoft\Windows\CurrentVersion\Explorer"

'get the ShellState binary array
intErrNum = oReg.GetBinaryValue (HKCU,strKey,"ShellState",arBValue)

'if array returned
If intErrNum = 0 And IsArray(arBValue) Then

'if array contains Active Desktop flag
If UBound(arBValue) >= 4 Then

'if 0-based 4th array element contains 64 (AD flag set)
If (arBValue(4) And 64) = 64 Then
ReDim arBValue(0) 'recover array memory
TitleLineWrite
oFN.WriteLine vbCRLF & "Active Desktop may be enabled at this entry:" &_
vbCRLF & "HKCU\" & strKey & "\ShellState"
Else
TitleLineWrite
oFN.WriteLine vbCRLF & "Active Desktop may be disabled at this entry:" &_
vbCRLF & "HKCU\" & strKey & "\ShellState"
End If 'AD enabled?

End If 'UBound>=4?

Else 'binary value not found

If flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & "Active Desktop is not enabled."
End If

End If 'binary value exists?


'Wallpaper

'check for AD wallpaper
strKey = "Software\Microsoft\Internet Explorer\Desktop\General"
strSubTitle = "Displayed if Active Desktop enabled and wallpaper not set by " &_
strPolName & "Policy:" & vbCRLF & "HKCU\" & strKey & "\"

intErrNum = oReg.GetStringValue (HKCU,strKey,"Wallpaper",strValue)

'if AD wallpaper value set
If intErrNum = 0 And strValue <> "" Then 'exc for W2K!

'write value
On Error Resume Next
TitleLineWrite
oFN.WriteLine Chr(34) & "Wallpaper" & Chr(34) & " = " &_
Chr(34) & strValue & Chr(34)
intErrNum1 = Err.Number : Err.Clear
On Error Goto 0
If intErrNum1 <> 0 Then oFN.WriteLine Chr(34) & "Wallpaper" &_
Chr(34) & " = (value not set)"

End If 'AD wallpaper value set?


'retrieve Wallpaper value
strKey = "Control Panel\Desktop"
strSubTitle = "Displayed if Active Desktop disabled and wallpaper not set by " &_
strPolName & "Policy:" & vbCRLF & "HKCU\" & strKey & "\"

intErrNum = oReg.GetStringValue (HKCU,strKey,"Wallpaper",strValue)

'if value set (exc for W2K!)
If intErrNum = 0 And strValue <> "" Then 'exc for W2K!

TitleLineWrite
'output wallpaper value
On Error Resume Next
oFN.WriteLine Chr(34) & "Wallpaper" & Chr(34) & " = " &_
Chr(34) & strValue & Chr(34)
intErrNum2 = Err.Number : Err.Clear
On Error Goto 0
If intErrNum2 <> 0 Then oFN.WriteLine Chr(34) & "Wallpaper" &_
Chr(34) & " = (value not set)"

Else 'WP value not present

If flagShowAll Then
TitleLineWrite
oFN.WriteLine Chr(34) & "Wallpaper" & Chr(34) & " = (value not set)"
End If

End If 'wallpaper value set?


'web content

'look for web content
strKey = "Software\Microsoft\Internet Explorer\Desktop\Components"
intErrNum = oReg.EnumKey(HKCU,strKey,arKeys)

'if sub-keys exist
If IsArray(arKeys) Then

strSubTitle = "Active Desktop web content (hidden if disabled):"

'for each subkey
For Each oKey in arKeys

strSubSubTitle = "HKCU\" & strKey & "\" & oKey & "\"

'retrieve DWORD containing web content activation flag
intErrNum1 = oReg.GetDWORDValue (HKCU,strKey & "\" & oKey,"Flags",intValue)

'if DWORD value set
If intErrNum = 0 And intValue <> 0 Then

'if DWORD contains 8192 (web content activation flag set)
If (intValue And 8192) = 8192 Then

'get web content descriptive values
oReg.GetStringValue HKCU,strKey & "\" & oKey,"FriendlyName",strValue1
oReg.GetStringValue HKCU,strKey & "\" & oKey,"Source",strValue2
oReg.GetStringValue HKCU,strKey & "\" & oKey,"SubscribedURL",strValue3

TitleLineWrite

'write web content descriptive values
On Error Resume Next
oFN.WriteLine Chr(34) & "FriendlyName" & Chr(34) & " = " &_
Chr(34) & strValue1 & Chr(34)
intErrNum2 = Err.Number : Err.Clear
If intErrNum2 <> 0 Then oFN.WriteLine Chr(34) & "FriendlyName" &_
Chr(34) & " = (value not set)"

oFN.WriteLine Chr(34) & "Source" & Chr(34) & " = " &_
Chr(34) & strValue2 & Chr(34)
intErrNum2 = Err.Number : Err.Clear
If intErrNum2 <> 0 Then oFN.WriteLine Chr(34) & "Source" &_
Chr(34) & " = (value not set)"

oFN.WriteLine Chr(34) & "SubscribedURL" & Chr(34) & " = " &_
Chr(34) & strValue3 & Chr(34)
intErrNum2 = Err.Number : Err.Clear
If intErrNum2 <> 0 Then oFN.WriteLine Chr(34) & "SubscribedURL" &_
Chr(34) & " = (value not set)"
On Error Goto 0

End If 'web content active?

End If 'web content DWORD value set?

Next 'web content subkey

End If 'web content subkeys exist

strSubTitle = "" : strSubSubTitle = ""


'Screen Saver

If strOS <> "W98" And strOS <> "WME" Then

Dim strLFN : strLFN = "" 'screen saver LFN
Dim strExt : strExt = "" 'wallpaper file extension
strWarn = ""

strTitle = "Enabled Screen Saver:"

strKey = "Control Panel\Desktop"
strSubTitle = "HKCU\" & strKey & "\"

'get the screen saver name
intErrNum = oReg.GetStringValue (HKCU,strKey,"Scrnsave.exe",strValue)

'if Scrnsave.exe value exists And value set (exc for W2K!)
' And value <> "(NONE)" (NT4 default)
If intErrNum = 0 And strValue <> "" And LCase(strValue) <> "(none)" Then

'get screen saver LFN if file exists
If Fso.FileExists(strValue) Then

'create (but don't save) shortcut
Dim oSC : Set oSC = Wshso.CreateShortcut("getLFN.lnk")
'set & retrieve target path
oSC.TargetPath = strValue
strLFN = Fso.GetFile(oSC.TargetPath).Name
Set oSC=Nothing

'set up LFN string if SFN <> LFN
If LCase(strLFN) = LCase(Fso.GetFileName(strValue)) Then
strLFN = ""
Else
strLFN = " (" & strLFN & ")"
End If

End If 'screen saver file exists?

TitleLineWrite

On Error Resume Next
oFN.WriteLine Chr(34) & "SCRNSAVE.EXE" & Chr(34) & " = " &_
Chr(34) & strValue & Chr(34) & strLFN & CoName(IDExe(strValue))
intErrNum = Err.Number : Err.Clear
On Error Goto 0

If intErrNum <> 0 Then oFN.WriteLine Chr(34) & "SCRNSAVE.EXE" &_
Chr(34) & " = (value not set)"

Else 'Scrnsave.exe value doesn't exist

'if ShowAll, output title line
If flagShowAll Then

TitleLineWrite
oFN.WriteLine Chr(34) & "SCRNSAVE.EXE" & Chr(34) & " = (value not set)"

End If 'flagShowAll

End If 'Scrnsave.exe value exists?

End If 'strOS <> W98/WME?

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

End If 'SecTest?




'#16. For W98/WMe, check inside WIN.INI (load=, run=), SYSTEM.INI (shell=) &
' for W98 only, list contents of non-empty WINSTART.BAT

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

If strOS = "W98" Or strOS = "WME" Then

strTitle = "WIN.INI & SYSTEM.INI launch points:"

Dim oSCF 'System Configuration File
'true if in INI-file section containing targeted lines
Dim flagSection : flagSection = False

strSubTitle = "WIN.INI" & vbCRLF & "[windows]"

'open WIN.INI
Set oSCF = Fso.OpenTextFile (strFPWF & "\WIN.INI",1)

'for each line of WIN.INI
Do While Not oSCF.AtEndOfStream

'read a line
strLine = oSCF.ReadLine

'if not a blank/comment line And inside [windows] section
If Trim(strLine) <> "" And Left(LTrim(strLine),1) <> ";" Then

If flagSection Then

'if line is beginning of another section
If Left(LTrim(strLine),1) = "[" Then
'toggle flag to false and exit Do
flagSection = False : Exit Do
End If 'next section?

'input line, verb, expected contents, disk
IniInfParse strLine, "load", "", ""
IniInfParse strLine, "run", "", ""

End If 'flagSection?

'if first 9 chars of line = [windows], then in the right section
'so toggle flagSection to True
If LCase(Left(LTrim(strLine),9)) = "[windows]" Then flagSection = True

End If 'blank/comment line?

Loop 'next line of WIN.INI

oSCF.Close 'close WIN.INI
flagSection = False

strSubTitle = "SYSTEM.INI" & vbCRLF & "[boot]"

'open SYSTEM.INI
Set oSCF = Fso.OpenTextFile (strFPWF & "\SYSTEM.INI",1)

'for each line of SYSTEM.INI
Do While Not oSCF.AtEndOfStream

strLine = oSCF.ReadLine

'if not a blank/comment line And inside [windows] section
If Trim(strLine) <> "" And Left(LTrim(strLine),1) <> ";" Then

'if inside [boot] section
If flagSection Then

If Left(LTrim(strLine),1) = "[" Then
'toggle flagSection and exit
flagSection = False : Exit Do
End If 'shell line?

IniInfParse strLine, "shell", "explorer.exe", ""
IniInfParse strLine, "scrnsave.exe", "anything", ""

End If 'inside boot section?

'if first 6 chars of line = [boot], then in the right section
'so toggle flagSection to True
If LCase(Left(LTrim(strLine),6)) = "[boot]" Then flagSection = True

End If 'blank/comment line?

Loop

oSCF.Close

strSubTitle = ""

'for W98 only
If strOS = "W98" Then

strTitle = "WINSTART.BAT contents:"

'open WINSTART.BAT if it exists
If Fso.FileExists(strFPWF & "\WINSTART.BAT") Then

Set oSCF = Fso.OpenTextFile (strFPWF & "\WINSTART.BAT",1)

'for each line of WINSTART.BAT
Do While Not oSCF.AtEndOfStream

strLine = oSCF.ReadLine
If strLine <> "" Then 'examine line if it's not a CR

If Len(strLine) >= 3 Then 'test against REM if long enough

'if not REM, then output
If LCase(Left(LTrim(strLine),3)) <> "rem" Then
If strTitle <> "" Then
TitleLineWrite : oFN.WriteBlankLines(1)
End If
oFN.WriteLine strLine
End If

Else 'len 1-2

TitleLineWrite : oFN.WriteLine strLine

End If 'len < 3?

End If 'carriage return?

Loop 'WINSTART.BAT lines

oSCF.Close : Set oSCF=Nothing

Else 'WINSTART.BAT doesn't exist

'if ShowAll, write title lines
If flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & "(file not found)"
End If

End If 'WINSTART.BAT exists?

End If 'W98?

End If 'strOS = W98/WME

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

End If 'SecTest?




'#17. AUTORUN.INF in root directory of local fixed disks

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

'WMe & WXP SP2 do not launch AUTORUN.INF on local fixed disks
If strOS <> "WME" And strOSLong <> "Windows XP SP2" Then

'fixed disk, DWORD value, binary value array, AutoRun.Inf file,
Dim oDisk, hVal, arBVal, oARI

strTitle = "Autostart via AUTORUN.INF on local fixed drives:"

'array of fixed disks
Public arFixedDisks()

'Disk Letter dictionary (needed to calculate power of 2)
'dictDL.Item(6) returns "G:"
Public dictDL : Set dictDL = CreateObject("Scripting.Dictionary")
dictDL.Add 0, "A:" : dictDL.Add 1, "B:" : dictDL.Add 2, "C:"
dictDL.Add 3, "D:" : dictDL.Add 4, "E:" : dictDL.Add 5, "F:"
dictDL.Add 6, "G:" : dictDL.Add 7, "H:" : dictDL.Add 8, "I:"
dictDL.Add 9, "J:" : dictDL.Add 10, "K:" : dictDL.Add 11, "L:"
dictDL.Add 12, "M:" : dictDL.Add 13, "N:" : dictDL.Add 14, "O:"
dictDL.Add 15, "P:" : dictDL.Add 16, "Q:" : dictDL.Add 17, "R:"
dictDL.Add 18, "S:" : dictDL.Add 19, "T:" : dictDL.Add 20, "U:"
dictDL.Add 21, "V:" : dictDL.Add 22, "W:" : dictDL.Add 23, "X:"
dictDL.Add 24, "Y:" : dictDL.Add 25, "Z:"

'assume HKLM NoDriveTypeAutoRun Fixed Disks Enabled
Public flagHKLM_NDTAR_FDE : flagHKLM_NDTAR_FDE = True
'assume HKCU NoDriveTypeAutoRun Fixed Disks Enabled
Public flagHKCU_NDTAR_FDE : flagHKCU_NDTAR_FDE = True

'assume HKLM NoDriveTypeAutoRun value does NOT exist
Public flagHKLM_NDTAR : flagHKLM_NDTAR = False
'assume HKCU NoDriveTypeAutoRun value does NOT exist (unused, passed for consistency)
Public flagHKCU_NDTAR : flagHKCU_NDTAR = False

'assume HKLM NoDriveAutoRun value does NOT exist
Public flagHKLM_NDAR : flagHKLM_NDAR = False
'assume HKCU NoDriveAutoRun value does NOT exist (unused, passed for consistency)
Public flagHKCU_NDAR : flagHKCU_NDAR = False

strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer"

'WVa RC1 ignores NDTAR/NDAR values in HKCU/HKLM
If strOS <> "WVA" Then

'check NDTAR/NDTAR_FDE values in HKLM, toggle flag if needed
NDTAR HKLM, flagHKLM_NDTAR, flagHKLM_NDTAR_FDE
'if HKLM NDTAR value not found, check NDTAR/NDTAR_FDE values in HKCU
If Not flagHKLM_NDTAR Then NDTAR HKCU, flagHKCU_NDTAR, flagHKCU_NDTAR_FDE

Else 'strOS = "WVA"

flagHKLM_NDTAR = True : flagHKCU_NDTAR = True
flagHKLM_NDTAR_FDE = True : flagHKCU_NDTAR_FDE = True

End If

'if NoDriveTypeAutoRun permits autorun on fixed disks, look at
'individual disks
If flagHKLM_NDTAR_FDE And flagHKCU_NDTAR_FDE Then

'enumerate fixed disks
Set colDisks = GetObject("winmgmts:\root\cimv2")._
ExecQuery("SELECT * FROM Win32_LogicalDisk WHERE DriveType = 3")

j = 0

'fmt of DeviceID & Name is "A:"
For Each oDisk in colDisks

'for every dict entry
For i = 0 To 25

'find dictionary element number for drive letter
If dictDL.Item(i) = oDisk.DeviceID Then

'store disk letter, power of two for that letter,
'set autorun flag to True, increment counter
ReDim Preserve arFixedDisks(2,j)
arFixedDisks(0,j) = oDisk.DeviceID
arFixedDisks(1,j) = 2^i
arFixedDisks(2,j) = True
j = j + 1

End If 'dict drive letter located?

Next 'dict entry

Next 'disk in colDisks

'WVa RC1 ignores NDAR values
If strOS <> "WVA" Then
NDAR HKLM, flagHKLM_NDAR
Else
flagHKLM_NDAR = True : flagHKCU_NDAR = True
End if

If Not flagHKLM_NDAR Then NDAR HKCU, flagHKCU_NDAR

'for every fixed disk
For i = 0 To UBound(arFixedDisks,2)

strSubTitle = arFixedDisks(0,i) & "\"

'if autorun enabled
If arFixedDisks(2,i) Then

'look for AUTORUN.INF in the root
If Fso.FileExists(arFixedDisks(0,i) & "\autorun.inf") Then

'open AUTORUN.INF if found
Set oARI = Fso.OpenTextFile (arFixedDisks(0,i) & "\autorun.inf",1)

'for each line of AUTORUN.INF
Do While Not oARI.AtEndOfStream

'read a line
strLine = oARI.ReadLine

'look for "open" or "shellexecute" statements
IniInfParse strLine, "open", "", arFixedDisks(0,i)
IniInfParse strLine, "shellexecute", "", arFixedDisks(0,i)

Loop 'next AUTORUN.INF line

oARI.Close : Set oARI=Nothing 'close AUTORUN.INF

'if no verbs found And ShowAll
If strSubTitle <> "" And flagShowAll Then

TitleLineWrite

oFN.WriteLine "AUTORUN.INF -> (" & Chr(34) & "open" & Chr(34) &_
" & " & Chr(34) & "shellexecute" & Chr(34) & " lines not found)"

End If 'ShowAll?

Else 'AUTORUN.INF not found in root

'if ShowAll
If flagShowAll Then

TitleLineWrite

'output file not found message
oFN.WriteLine "AUTORUN.INF -> (file not found)"

End If 'ShowAll?

End If 'AUTORUN.INF exists in root?

End If 'autorun enabled on drive?

Next 'fixed disk

End If 'NoDriveTypeAutoRun enables autorun on fixed disks?

dictDL.RemoveAll : Set dictDL=Nothing

End If 'strOS <> WME/WXP SP2?

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

End If 'SecTest?




'#18. Check for DESKTOP.INI in local hard disk directories

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

'skip unless -supp or -all command line parameters used
If flagShowAll Or flagSupp Then

Dim datDTIStart : datDTIStart = Now
Public strDTITime

'array of allowed CLSID DLLs
Dim arOKDLLs : arOKDLLs = Array("shdocvw.dll", "occache.dll", _
"mstask.dll", "cdfview.dll", "shell32.dll", "fontext.dll", _
"mscoree.dll", "ieframe.dll")

strTitle = "DESKTOP.INI DLL launch in local fixed drive directories:"

'enumerate fixed disks
Set colDisks = GetObject("winmgmts:\root\cimv2")._
ExecQuery("SELECT * FROM Win32_LogicalDisk WHERE DriveType = 3")

For Each oDisk in colDisks

'initialize DeskTop.Ini output & error arrays & counters
ReDim arSDDTI(0) : ctrArDTI = 0
ReDim arSDErr(0) : ctrArErr = 0

'check for unreadable partition
On Error Resume Next
'root format: C:\
Set oRoot = Fso.GetDrive(oDisk.DeviceID).RootFolder
intErrNum = Err.Number : Err.Clear
On Error Goto 0

If intErrNum = 0 Then 'if partition readable

'find directories with System attribute containing DESKTOP.INI
'with .ShellClassInfo section and CLSID statement
'fill arSDDTI array with output & arSDErr with (permission) errors
DirSysAtt oRoot

'output DLL launch points if found
If ctrArDTI > 0 Then
TitleLineWrite
'output array contents
For i = 0 To UBound(arSDDTI) : oFN.WriteLine arSDDTI(i) : Next
ElseIf flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & oRoot.Drive & " (no DLL launch points found)"
End If

'output errors if ShowAll
If ctrArErr > 0 And flagShowAll Then

strSubTitle = "Permission Errors on " & oRoot.Drive : TitleLineWrite : strOut = ""

For i = 0 To UBound(arSDErr)

'limit line length to 100
If strOut <> "" Then

If Len(strOut & arSDErr(i)) >= 100 Then
oFN.WriteLine strOut : strOut = arSDErr(i)
Else
strOut = strOut & ", " & arSDErr(i)
End If 'this error & prev errors>100?

Else 'strOut empty

If Len(arSDErr(i)) >= 100 Then
oFN.WriteLine arSDErr(i)
Else
strOut = arSDErr(i)
End If 'this error>100?

End If 'strOut empty?

Next 'arSDErr member

'write out final error string
If strOut <> "" Then oFN.WriteLine strOut : strOut = ""

End If

Set oRoot=Nothing

Else 'partition not readable (may be Linux)

TitleLineWrite
oFN.WriteLine vbCRLF & "WARNING! " & oDisk.DeviceID & " is an unreadable partition!"

End If 'partition readable?

Next 'disk in colDisks

'determine -supp seconds used
strDTITime = DateDiff("s",datDTIStart,Now) & " seconds"

Set colDisks=Nothing
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

'recover array memory
ReDim arSDDTI(0) : ReDim arSDErr(0)

End If 'flagShowAll Or flagSupp?

End If 'SecTest?




'#19. Enumerate contents of startup directories

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

'All Users StartUp Folder title string (empty by default)
Dim flagAUSUF : flagAUSUF = False
Dim flagFE : flagFE = True 'folder exists flag

'in W98/WMe, see if local-language-specific All Users startup folder location
'appears in registry and form title string if it does
If strOS = "W98" Or strOS = "WME" Then

'look for Common Startup value
strKey = "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
oReg.GetStringValue HKLM,strKey,"Common Startup",strValue

'if Common Startup name exists and value not empty, toggle flag
If Not IsNull(strValue) And strValue <> "" Then flagAUSUF = True

End If

'startup folder short names
If strOS = "W98" Or strOS = "WME" Then
arSUFN = Array("Startup")
Else
arSUFN = Array("Startup","AllUsersStartup")
End If

'form output file section title string
strLine = "Startup items in "

'in W98/WMe, omit username & "All Users" folder if absent from registry
If strOS = "W98" Or strOS = "WME" Then
strLine = strLine & Chr(34) & "Startup" & Chr(34)
If flagAUSUF Then
strLine = strLine & " & " & Chr(34) & "All Users...Startup" &_
Chr(34) & " folders:"
Else
strLine = strLine & " folder:"
End If
Else 'all other O/S's
strLine = strLine & Chr(34) & Wshso.ExpandEnvironmentStrings("%USERNAME%") &_
Chr(34) & " & " & Chr(34) & "All Users" & Chr(34) & " startup folders:"
End If

strTitle = strLine

'for each startup folder name
For i = 0 To 1 '0 = user folder, 1 = All Users folder

'get the startup folder
'in W98/WMe, set flagFE to False if "All Users" folder doesn't exist
If i = 1 And (strOS = "W98" Or strOS = "WME") Then
If flagAUSUF Then
If Fso.FolderExists(strValue) Then
Set oSUF = Fso.GetFolder(strValue)
Else
flagFE = False 'folder doesn't exist
End If
Else
flagFE = False 'registry key doesn't exist
End If
Else 'all other O/S's at all times
Set oSUF = Fso.GetFolder(Wshso.SpecialFolders(arSUFN(i)))
End If

strSubTitle = oSUF.Path

'if startup folder exists
If flagFE Then

'for each file in the startup folder
For Each oSUFi in oSUF.Files

strLine = "" 'empty the line

'treat file as a shortcut
On Error Resume Next
Set oSUSC = Wshso.CreateShortcut(oSUFi)
intErrNum = Err.Number : Err.Clear
On Error Goto 0

'if file is a shortcut
If intErrNum = 0 Then

If LCase(Fso.GetExtensionName(oSUFi)) = "url" Then 'shortcut is URL

'prepare the shortcut file base name and the target path & arguments
strLine = Chr(34) & Fso.GetBaseName (oSUFi.Path) & Chr(34) & " -> URL shortcut to: " &_
Chr(34) & oSUSC.TargetPath

Else

'prepare the shortcut file base name and the target path & arguments
strLine = Chr(34) & Fso.GetBaseName (oSUFi.Path) & Chr(34) & " -> shortcut to: " &_
Chr(34) & oSUSC.TargetPath

If oSUSC.Arguments <> "" Then
strLine = strLine & " " & oSUSC.Arguments & Chr(34)
Else
strLine = strLine & Chr(34)
End If

'add co-name
strLine = strLine & CoName(IDExe(oSUSC.TargetPath))

End If 'URL or shortcut?

'if file is a PIF
ElseIf LCase(Fso.GetExtensionName(oSUFi)) = "pif" Then

'write out pif file target
strPIFTgt = ""
Dim oFi : Set oFi = Fso.OpenTextFile(oSUFi, 1)
oFi.Skip(36) 'target starts after 36 bytes

'target size is up to 63 bytes
For ii = 1 To 63
bin1C = oFi.Read(1)
'end of target is single "00" byte
If AscB(bin1C) = 0 Then Exit For
'otherwise convert binary to ASCII and append to string
strPIFTgt = strPIFTgt & Chr(AscB(bin1C))
Next

oFi.Close
Set oFi=Nothing

strLine = Chr(34) & Fso.GetBaseName(oSUFi.Path) & Chr(34) &_
" -> PIF to: " & Chr(34) & strPIFTgt & Chr(34) &_
CoName(IDExe(strPIFTgt))

'file is neither shortcut nor PIF
Else

'file is probably an executable so include an IWarn and
' the file name, using the full path as IDExe argument
If LCase(Fso.GetFileName(oSUFi)) <> "desktop.ini" Then
strLine = IWarn & DQ & oSUFi.Name & DQ & CoName(IDExe(oSUFi.Path))
flagIWarn = True
End If

End If 'file is shortcut

Set oSUSC=Nothing

'if there's something to output
If strLine <> "" Then

'output the section title line if not already done
TitleLineWrite

'output the line
oFN.WriteLine strLine

End If

Next 'file in startup folder

Set oSUF=Nothing

'if ShowAll
If flagShowAll Then TitleLineWrite

End If 'flagFE?

Next 'startup folder name

strTitle = "" : strSubTitle = "" : strSubSubTitle = "" : strWarn = ""

'recover array memory
ReDim arSUFN(0)

End If 'SecTest?




'#20. Enabled Scheduled Tasks

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

'Enabled Scheduled Tasks Directory/Folder object
Dim strESTDir, oESTFo

'prepare section title lines
strTitle = "Enabled Scheduled Tasks:"
If strOS = "WVA" Then strTitle = "Non-disabled Scheduled Tasks:"

If strOS <> "WVA" Then

' Byte Disabled Enabled
'00000030: #####1## #####0## <--

'file in Tasks directory
Dim oFi2

'if the tasks directory exists in the Windows directory
If Fso.FolderExists(Fso.GetSpecialFolder(WinFolder) & "\Tasks") Then

'get the tasks folder
Dim oJobF : Set oJobF = Fso.GetFolder(Fso.GetSpecialFolder(WinFolder) & "\Tasks")

'for each file
For Each oFi2 in oJobF.Files

'if file in Tasks directory is a task (has a .JOB extension)
If LCase(Fso.GetExtensionName(oFi2)) = "job" Then

'try to open the task file
On Error Resume Next
Dim oJobFi : Set oJobFi = Fso.OpenTextFile(oFi2,1,False,-1)
intErrNum = Err.Number : Err.Clear
On Error Goto 0

'if file could be opened
If intErrNum = 0 Then

'read the file, determine enabled status, extract the executable name
JobFileRead oFi2, oJobFi

'close the .JOB file
oJobFi.Close : Set oJobFi=Nothing

Else 'file couldn't be opened

TitleLineWrite

'write error message
oFN.WriteLine vbCRLF & Chr(34) & oFi2.Name & Chr(34) &_
" -- insufficient permission to read this file!"

End If '.JOB file opened successfully?

End If '.JOB file extension selected?

Next 'file in TASKS directory

'if ShowAll, output title line if not already done
If flagShowAll Then TitleLineWrite

Else 'Tasks directory can't be found

'write titles and error message
TitleLineWrite
oFN.WriteLine vbCRLF & "WARNING! The " & Chr(34) &_
Wshso.ExpandEnvironmentStrings("%WINDIR%") & "\Tasks" & Chr(34) &_
" directory cannot be found."

End If 'Tasks directory exists?

Set oJobF=Nothing

Else 'WVa -- Non-Disabled Scheduled Tasks

'initialize error array & counter
ReDim arErr(0) : ctrErr = 0 : strOut = ""

'fill strOut with output & arErr with (permission) errors

strESTDir = Wshso.ExpandEnvironmentStrings("%WINDIR%\system32\Tasks")

Set oESTFo = Fso.GetFolder(strESTDir)

'initiate recursion into ST folder to find enabled XML-format tasks
DirEST oESTFo

'output EST's if found
If strOut <> "" Then
TitleLineWrite : oFN.WriteLine strOut
ElseIf flagShowAll Then
TitleLineWrite
oFN.WriteLine vbCRLF & "(no enabled scheduled tasks found)"
End If

'output directory permission errors if ShowAll
If ctrErr > 0 And flagShowAll Then

strSubTitle = "Directory Permission Errors:" & vbCRLF
TitleLineWrite : strOut = ""

For i = 0 To UBound(arErr)

'limit line length to 100
If strOut <> "" Then

If Len(strOut & arErr(i)) >= 100 Then
oFN.WriteLine strOut : strOut = arErr(i)
Else
strOut = strOut & ", " & arErr(i)
End If 'this error & prev errors>100?

Else 'strOut empty

If Len(arErr(i)) >= 100 Then
oFN.WriteLine arErr(i)
Else
strOut = arErr(i)
End If 'this error>100?

End If 'strOut not empty?

Next 'arErr member

'write out final error string
If strOut <> "" Then oFN.WriteLine strOut : strOut = ""

End If 'show errors?

End If 'WVa?

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

End If 'SecTest?




'#21. Winsock2 Service Provider DLLs

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

strTitle = "Winsock2 Service Provider DLLs:"

Dim strNSCatKey 'NameSpace Catalog Key
Dim strProCatKey 'Protocol Catalog Key
Dim strNSSP 'NameSpace Service Provider
Dim arTSP '(returned) Transport Service Provider array
Dim int1C 'single chr binary (integer) code

'TSP output array for numeric keys, key #, strlen of key #, work var
Dim arTSPFi(), intKN, intL, intT
'TSP output array for alpha (illegal) keys
Dim arATSPFi()
'arTSPFi is 4 x n array
ReDim arTSPFi(3,0)
ReDim arATSPFi(1,0)
'number of numbered TSP keys
Dim intNumKeys : intNumKeys = 0
intCnt = 0 'arTSPFi UBound - 1
Dim intACnt : intACnt = 0 'arATSPFi UBound - 1
strAllOutDefault = " {++}"

'NameSpace Providers

strKey = "System\CurrentControlSet\Services\Winsock2\Parameters"

'find name of NameSpace Catalog key
intErrNum1 = oReg.GetStringValue (HKLM,strKey,"Current_NameSpace_Catalog",strNSCatKey)

'if the Current_NameSpace_Catalog name exists And value set (exc for W2K!)
If intErrNum1 = 0 And strNSCatKey <> "" Then

strSubTitle = "Namespace Service Providers" & vbCRLF & vbCRLF &_
"HKLM\" & strKey & "\" & strNSCatKey & "\Catalog_Entries\" &_
strAllOutDefault

'find NameSpace catalog entry subkeys
oReg.EnumKey HKLM,strKey & "\" & strNSCatKey & "\Catalog_Entries",arKeys

'if sub-keys exist
If IsArray(arKeys) Then

'for each subkey
For Each oKey in arKeys

'find LibraryPath
intErrNum2 = oReg.GetStringValue (HKLM,strKey & "\" & strNSCatKey &_
"\Catalog_Entries\" & oKey,"LibraryPath",strNSSP)

'if the LibraryPath name exists And value set (exc for W2K!)
If intErrNum2 = 0 And strNSSP <> "" Then

TitleLineWrite

On Error Resume Next
oFN.WriteLine oKey & "\LibraryPath" & " = " & Chr(34) &_
strNSSP & Chr(34) & CoName(IDExe(strNSSP))
intErrNum3 = Err.Number : Err.Clear
On Error Goto 0
If intErrNum3 <> 0 Then oFN.WriteLine oKey & "\LibraryPath" &_
" = (value not set)"

End If 'LibaryPath value set?

Next 'subkey

'IsArray = True, but array is empty
If strSubTitle <> "" And flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & "HKLM\" & strKey &_
"\" & strNSCatKey & "\Catalog_Entries\" & " = (sub-keys not found)"
End If

Else 'Catalog_Entries subkeys do not exist

If flagShowAll Then
TitleLineWrite : oFN.WriteLine "(sub-keys not found)"
End If

End If 'Catalog_Entries subkeys exist?

Else 'Current_NameSpace_Catalog value doesn't exist Or value not set

If flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & "HKLM\" & strKey &_
"\Current_Namespace_Catalog = (value not found)"
End If

End If 'Current_NameSpace_Catalog value exists?


'Transport Service Providers (Layered Service Providers = LSP's)

intErrNum1 = oReg.GetStringValue (HKLM,strKey,"Current_Protocol_Catalog",strProCatKey)

'if the Current_Protocol_Catalog name exists And value set (exc for W2K!)
If intErrNum1 = 0 And strProCatKey <> "" Then

strSubTitle = "Transport Service Providers" & vbCRLF & vbCRLF &_
"HKLM\" & strKey & "\" & strProCatKey & "\Catalog_Entries\" &_
strAllOutDefault

'find Protocol catalog entry subkeys
oReg.EnumKey HKLM,strKey & "\" & strProCatKey & "\Catalog_Entries",arKeys

'if sub-keys exist
If IsArray(arKeys) Then

'for each subkey
For Each oKey in arKeys

'can only take UBound if subkeys exist
'find number of keys in array & # digits
intNumKeys = UBound(arKeys) + 1

'determine # digits
intL = Len(CStr(intNumKeys))

'convert key name to integer
On Error Resume Next
intKN = CInt(oKey)
intErrNum = Err.Number : Err.Clear
On Error Goto 0

If intErrNum <> 0 Then intKN = -1 'key not in numeric format

'find PackedCatalogItem
intErrNum2 = oReg.GetBinaryValue (HKLM,strKey & "\" & strProCatKey &_
"\Catalog_Entries\" & oKey,"PackedCatalogItem",arTSP)

'if the PackedCatalogItem name exists And value set (exc for W2K!)
If intErrNum2 = 0 And IsArray(arTSP) Then

strDLL = "" 'clear strDLL

'reform strDLL from binary data array
For i = 0 To UBound(arTSP)

int1C = arTSP(i)
'end of target is single "0" byte
If int1C = 0 Then Exit For
'otherwise convert binary to ASCII and append to string
strDLL = strDLL & Chr(int1C)

Next 'binary data array element

'if key number numeric
If intKN <> -1 Then

'if file array populated
If intCnt > 0 Then

flagMatch = False

'for every arTSPFi member
For i = 0 To UBound(arTSPFi,2)

'if array file matches DLL, store array subscript
If arTSPFi(0,i) = strDLL Then
flagMatch = True : intSS = i : Exit For
End If

Next 'arTSPFi member

'if DLL is new
If Not flagMatch Then

'initialize output array for DLL
ReDim Preserve arTSPFi(3,intCnt)
arTSPFi(0,intCnt) = strDLL 'FN path\file name
arTSPFi(1,intCnt) = Right("0" & CStr(intKN),intL) 'OS output string
arTSPFi(2,intCnt) = intKN 'LA last added key number
arTSPFi(3,intCnt) = intKN 'UL upper limit key number

'increment output array for next pass
intCnt = intCnt + 1

Else 'flagMatch = True

'this key # consecutive to DLL UL
If intKN - arTSPFi(3,intSS) = 1 Then

'set DLL UL to this key #
arTSPFi(3,intSS) = intKN

Else 'this key # not consecutive to DLL UL

'if last added = upper limit, add comma and key # for new range
If arTSPFi(2,intSS) = arTSPFi(3,intSS) Then

arTSPFi(1,intSS) = arTSPFi(1,intSS) & ", " &_
Right("0" & CStr(intKN),intL)
arTSPFi(2,intSS) = intKN
arTSPFi(3,intSS) = intKN

'last added < upper limit, add hyphen, upper limit, comma and
'key # for new range
Else 'LA <> UL

arTSPFi(1,intSS) = arTSPFi(1,intSS) & " - " &_
Right("0" & CStr(arTSPFi(3,intSS)),intL) & ", " &_
Right("0" & CStr(intKN),intL)
arTSPFi(2,intSS) = intKN
arTSPFi(3,intSS) = intKN

End If 'LA = UL?

End If 'consecutive occurrence?

End If 'flagMatch?

Else 'intCnt = 0

'add first DLL to array
ReDim arTSPFi(3,intCnt)
arTSPFi(0,intCnt) = strDLL 'FN
arTSPFi(1,intCnt) = Right("0" & CStr(intKN),intL) 'OS
arTSPFi(2,intCnt) = intKN 'LA
arTSPFi(3,intCnt) = intKN 'UL

intCnt = intCnt + 1

End If 'intCnt > 0?

Else 'intKN not numeric

ReDim Preserve ATSPFi(1,intACnt)
arATSPFi(0,intACnt) = oKey
arATSPFi(1,intACnt) = strDLL
intACnt = intACnt + 1

End If 'intKN numeric?

End If 'PackedCatalogItem value exists?

Next 'subkey


'output results

'if Catalog_Entries sub-keys exist
If intNumKeys > 0 Then

'finalize output strings
For i = 0 To UBound(arTSPFi,2)

'last added < upper limit, add upper limit
If arTSPFi(2,i) < arTSPFi(3,i) Then

arTSPFi(1,i) = arTSPFi(1,i) & " - " & Right("0" & arTSPFi(3,i),intL)

End If 'LA = UL?

Next 'TSP array member

TitleLineWrite

'write out non-numeric sub-keys
If intACnt > 0 Then

For i = 0 To UBound(arATSPFi,2)

oFN.WriteLine vbCRLF & arATSPFi(0,i) & " = " & Chr(34) &_
arATSPFi(1,i) & Chr(34) & CoName(IDExe(arATSPFi(1,i))) & vbCRLF

Next

End If 'non-numeric sub-keys exist?

'write out numeric sub-keys

'0000000000##\PackedCatalogItem contains (DLL [Company Name], ##):
'%SystemRoot%\system32\xxxxxx.dll [CN] ##-##, ##-##
'%SystemRoot%\system32\yyyyyy.dll [CN] ##-##

oFN.WriteLine String(12-intL,"0") &_
String(intL,"#") & "\PackedCatalogItem (contains) DLL " &_
"[Company Name], (at) " & String(intL,"#") & " range:"

For i = 0 To UBound(arTSPFi,2)

oFN.WriteLine arTSPFi(0,i) & CoName(IDExe(arTSPFi(0,i))) & ", " &_
arTSPFi(1,i)

Next

Else 'intNumKeys=0 (no Catalog_Entries sub-keys)

If flagShowAll Then
TitleLineWrite : oFN.WriteLine "(sub-keys not found)"
End If

End If 'arKeys subkeys exist?

Else 'Catalog_Entries sub-keys do not exist

If flagShowAll Then
TitleLineWrite : oFN.WriteLine "(sub-keys not found)"
End If

End If 'Catalog_Entries array exists?

Else 'Current_Protocol_Catalog name doesn't exist Or value not set

If flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & "HKLM\" & strKey &_
"\Current_Protocol_Catalog = (value not found)"
End If

End If 'Current_Protocol_Catalog value exists?

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

'recover array memory
ReDim arTSPFi(0)
ReDim arATSPFi(0)

End If 'SecTest?




'#22. Internet Explorer Toolbars, Explorer Bars, Extensions

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

strTitle = "Toolbars, Explorer Bars, Extensions:"

'HKCU/HKLM Explorer Bars, combined array of existing explorer bars
Dim arHKExplorerBars(), arListedExplorerBars()
Dim arAllowedExplorerBars() 'allowed explorer bars
Dim strHKExplorerBar 'single explorer bar
'all CLSIDs, CLSID\Implemented Categories sub-keys, single CLSID, single Impl Cat sub-key
Dim arCLSIDKeys(), arCLSIDImpCatSubKey(), strCLSIDKey, strImpCatSubKey
'count of HKCU/HKLM explorer bars needed for ReDim statement
Dim cntExplorerBars : cntExplorerBars = 0
Dim arHKExtensions() 'HKCU/HKLM extension keys
Dim arAllowedExtensions() 'allowed extensions
Dim strHKExtension 'single extension key name
Dim arAllowedToolbars() 'allowed toolbars
Dim strHKToolbar 'single toolbar value name
Dim arHKCUTbSK() 'HKCU toolbar sub-keys
Dim strSKName 'single toolbar subkey name
Dim arSKValName() 'toolbar sub-key value names
Dim arHKToolbarVals() 'toolbar value names
Dim flagTBTLW : flagTBTLW = False 'toolbar title lines


'Toolbars

strSubTitle = "Toolbars"

ReDim arAllowedToolbars(4) 'must be in upper case!
arAllowedToolbars(0) = "{01E04581-4EEE-11D0-BFE9-00AA005B4383}" '&Address
arAllowedToolbars(1) = "{0E5CBF21-D15F-11D0-8301-00AA005B4383}" '&Links
arAllowedToolbars(2) = "{1E796980-9CC5-11D1-A83F-00C04FC99D61}" 'displayed toolbar buttons (non-CLSID)
arAllowedToolbars(3) = "{710EB7A1-45ED-11D0-924A-0020AFC7AC4D}" 'unknown default (non-CLSID)
arAllowedToolbars(4) = "{8E718888-423F-11D2-876E-00A0C9082467}" '... &Radio

strKey = "Software\Microsoft\Internet Explorer\Toolbar"

'for HKCU & HKLM hives
For i = 0 To 1

strSubSubTitle = arHives(i,0) & "\" & strKey & "\"

'get toolbar key values
oReg.EnumValues arHives(i,1),strKey,arHKToolbarVals,arType

'if values exist
If IsArray(arHKToolbarVals) Then

'for each value
For Each strCLSID in arHKToolbarVals

'change to UCase
strCLSID = Trim(UCase(strCLSID))

'assume not on allowed list
flagAllow = False

'is Toolbar on allowed list?
For j = 0 To UBound(arAllowedToolbars)
If arAllowedToolbars(j) = UCase(strCLSID) Then
flagAllow = True : Exit For 'toggle allowed flag
End If
Next

'if not allowed Or ShowAll
If Not flagAllow Or flagShowAll Then

flagTitle = False

CLSIDLocTitle arHives(i,1), strKey, strCLSID, strLocTitle

For ctrCH = intCLL To 1

ResolveCLSID strCLSID, arHives(ctrCH,1), strCLSIDTitle, strIPSDLL

If strIPSDLL <> "" Then 'IPS exists?

If Not flagTitle Then

'output toolbar CLSID value name
On Error Resume Next
If strSubSubTitle <> "" Then
TitleLineWrite : oFN.WriteLine Chr(34) & strCLSID & Chr(34) &_
" = " & strLocTitle
intErrNum = Err.Number : Err.Clear
If intErrNum <> 0 Then oFN.WriteLine Chr(34) & strCLSID & Chr(34) &_
" = (no title provided)"
Else
oFN.WriteLine Chr(34) & strCLSID & Chr(34) & " = " & strLocTitle
intErrNum = Err.Number : Err.Clear
If intErrNum <> 0 Then oFN.WriteLine Chr(34) & strCLSID & Chr(34) &_
" = (no title provided)"
End If
flagTitle = True
On Error Goto 0

End If

'output InProcServer32 value
oFN.WriteLine " -> {" & arHives(ctrCH,0) & "...CLSID} = " &_
strCLSIDTitle & vbCRLF & Space(19) & "\InProcServer32\(Default) = " &_
StringFilter(strIPSDLL,True) & CoName(IDExe(strIPSDLL))

End If 'strIPSDLL <> ""?

Next 'CLSID hive

End If 'flagAllow Or ShowAll?

Next 'HKCU/HKLM toolbar key value

End If 'toolbar key has values

'for HKCU Toolbar key only
If arHives(i,0) = "HKCU" Then

'get HKCU toolbar subkeys
oReg.EnumKey HKCU,strKey,arHKCUTbSK

'if key array exists
If IsArray(arHKCUTbSK) Then

'for each sub-key
For Each strSKName in arHKCUTbSK

strSubSubTitle = "HKCU\" & strKey & "\" & strSKName & "\"

'if one of three targeted sub-keys
If LCase(strSKName) = "explorer" Or LCase(strSKName) = "shellbrowser" Or _
LCase(strSKName) = "webbrowser" Then

'get toolbar subkey values
oReg.EnumValues HKCU,strKey & "\" & strSKName,arSKValName,arType

'if array of values exists
If IsArray(arSKValName) Then

'for each value
For Each strValue in arSKValName

'assume not on allowed list
flagAllow = False

'is Toolbar on allowed list?
For j = 0 To UBound(arAllowedToolbars)
If arAllowedToolbars(j) = UCase(strValue) Then
flagAllow = True : Exit For 'toggle allowed flag
End If
Next

'if not allowed Or ShowAll
If Not flagAllow Or flagShowAll Then

flagTitle = False

For ctrCH = intCLL To 1

ResolveCLSID strValue, arHives(ctrCH,1), strCLSIDTitle, strIPSDLL

'if InProcServer32 value exists
If strIPSDLL <> "" Then

'output toolbar CLSID
If strSubSubTitle <> "" Then TitleLineWrite
If Not flagTitle Then
oFN.WriteLine DQ & strValue & DQ : flagTitle = True
End If
oFN.WriteLine " -> {" & arHives(ctrCH,0) & "...CLSID} = " &_
strCLSIDTitle & vbCRLF & Space(19) & "\InProcServer32\(Default) = " &_
StringFilter(strIPSDLL,True) & CoName(IDExe(strIPSDLL))

End If 'IPS exists?

Next

End If 'flagAllow Or ShowAll?

Next 'strValue

End If 'IsArray(arSKValName)?

End If 'targeted sub-key

Next 'toolbar sub-key

End If 'toolbar sub-key array exists

End If 'HKCU hive?

'if ShowAll, output title lines if not already done
If flagShowAll Then TitleLineWrite

Next 'hive


'Explorer Bars

strSubTitle = "Explorer Bars"

ReDim arAllowedExplorerBars(9) 'must be in upper case!
arAllowedExplorerBars(0) = "{30D02401-6A81-11D0-8274-00C04FD5AE38}" 'Search Band
arAllowedExplorerBars(1) = "{32683183-48A0-441B-A342-7C2A440A9478}" 'Media Band
arAllowedExplorerBars(2) = "{4D5C8C25-D075-11D0-B416-00C04FB90376}" '&Tip of the Day
arAllowedExplorerBars(3) = "{BDEADE7F-C265-11D0-BCED-00A0C90AB50F}" '&Discuss
arAllowedExplorerBars(4) = "{C4EE31F3-4768-11D2-BE5C-00A0C9A83DA1}" 'File and Folders Search ActiveX Control
arAllowedExplorerBars(5) = "{EFA24E61-B078-11D0-89E4-00C04FC9E26E}" 'Favorites Band
arAllowedExplorerBars(6) = "{EFA24E62-B078-11D0-89E4-00C04FC9E26E}" 'History Band
arAllowedExplorerBars(7) = "{EFA24E64-B078-11D0-89E4-00C04FC9E26E}" 'Explorer Band
arAllowedExplorerBars(8) = "{21569614-B795-46B1-85F4-E737A8DC09AD}" 'Search Band (WVa)
arAllowedExplorerBars(9) = "{5D60981B-2654-09E1-085A-6B546CA52169}" 'Favories Band (W98)

strKey = "Software\Microsoft\Internet Explorer\Explorer Bars"

'for HKCU & HKLM hives
For i = 0 To 1

strSubSubTitle = arHives(i,0) & "\" & strKey & "\"

'get explorer bar subkeys
oReg.EnumKey arHives(i,1),strKey,arHKExplorerBars

'if subkeys exist
If IsArray(arHKExplorerBars) Then

'for each subkey
For Each strHKExplorerBar in arHKExplorerBars

'convert subkey name (CLSID) to uppercase
strHKExplorerBar= UCase(strHKExplorerBar)

'assume not on allowed list
flagAllow = False

'add to ListedExplorerBars array
ReDim Preserve arListedExplorerBars(cntExplorerBars)
arListedExplorerBars(cntExplorerBars) = strHKExplorerBar
cntExplorerBars = cntExplorerBars + 1 'cnt = UBound + 1

'is Explorer Bar on allowed list?
For j = 0 To UBound(arAllowedExplorerBars)
If arAllowedExplorerBars(j) = UCase(strHKExplorerBar) Then
flagAllow = True : Exit For 'toggle allowed flag
End If
Next

'if not allowed Or ShowAll
If Not flagAllow Or flagShowAll Then

flagTitle = False

CLSIDLocTitle arHives(i,1), strKey, strHKExplorerBar, strLocTitle

For ctrCH = intCLL To 1

ResolveCLSID strHKExplorerBar, arHives(ctrCH,1), strCLSIDTitle, strIPSDLL

'if InProcServer32 value exists
If strIPSDLL <> "" Then

'output explorer bar CLSID
If strSubSubTitle <> "" Then TitleLineWrite

If Not flagTitle Then
oFN.WriteLine strHKExplorerBar & "\(Default) = " & strLocTitle
flagTitle = True
End If

'output InProcServer32 value
oFN.WriteLine " -> {" & arHives(ctrCH,0) & "...CLSID} = " &_
strCLSIDTitle & vbCRLF & Space(19) & "\InProcServer32\(Default) = " &_
StringFilter(strIPSDLL,True) & CoName(IDExe(strIPSDLL))

End If 'IPS exists?

Next

End If 'not on allowed list Or ShowAll

Next 'HKCU/HKLM explorer bar subkey

End If 'explorer bar key has subkeys

'if ShowAll, output sub-title lines if not already done
If flagShowAll Then TitleLineWrite

Next 'hive


'check CLSIDs for Explorer Bars

Dim datDEBStart : datDEBStart = Now

strKey = "Software\Classes\CLSID"

For ctrCH = intCLL To 1

'get CLSIDs
oReg.EnumKey arHives(ctrCH,1),strKey,arCLSIDKeys

If IsArray(arCLSIDKeys) Then

'for each CLSID
For Each strCLSIDKey in arCLSIDKeys

'convert to uppercase
strCLSIDKey = UCase(strCLSIDKey)

'look for Implemented Categories subkeys
intErrNum = oReg.EnumKey (arHives(ctrCH,1),strKey & "\" & strCLSIDKey &_
"\Implemented Categories",arCLSIDImpCatSubKey)

'if Implemented Categories subkeys exist
If intErrNum = 0 And IsArray(arCLSIDImpCatSubKey) Then

'for each Implemented Categories subkey
For Each strImpCatSubKey in arCLSIDImpCatSubKey

'convert to uppercase
strImpCatSubKey = UCase(strImpCatSubKey)

'if subkey name is vertical or horizontal explorer bar
If strImpCatSubKey = "{00021494-0000-0000-C000-000000000046}" Or _
strImpCatSubKey = "{00021493-0000-0000-C000-000000000046}" Then

flagFound = False 'assume CLSID is not listed in HKCU/HKLM explorer bars

If IsArray(arListedExplorerBars) Then

'search explorer bar array for CLSID
For Each strArMember in arListedExplorerBars
If strArMember = strCLSIDKey Then
flagFound = True : Exit For
End If
Next

End If 'IsArray(arListedExplorerBars)?

'if CLSID not listed
If Not flagFound Then

'assume not allowed
flagAllow = False

'see if on allowed list
For j = 0 To UBound(arAllowedExplorerBars)
If arAllowedExplorerBars(j) = UCase(strCLSIDKey) Then
flagAllow = True : Exit For
End If
Next

'if not allowed Or ShowAll
If Not flagAllow Or flagShowAll Then

'look for InProcServer32
intErrNum3 = oReg.GetExpandedStringValue(arHives(ctrCH,1),"Software\Classes\CLSID\" &_
strCLSIDKey & "\InProcServer32","",strValue3)

'if InProcServer32 value exists
If intErrNum3 = 0 And strValue3 <> "" Then

'get CLSID title
oReg.GetStringValue arHives(ctrCH,1),"Software\Classes\CLSID\" &_
strCLSIDKey,"",strValue4

TitleLineWrite

'output CLSID + title, prepare output string,
'output Implemented Categories key, InProcServer32
If strValue4 <> "" Then
oFN.WriteLine vbCRLF & arHives(ctrCH,0) & "\Software\Classes\CLSID\" &_
strCLSIDKey & "\(Default) = " & StringFilter(strValue4,True)
Else
oFN.WriteLine vbCRLF & arHives(ctrCH,0) & "\Software\Classes\CLSID\" &_
strCLSIDKey & "\(Default) = (title not found)"
End If
If Mid(strImpCatSubKey,9,1) = "3" Then
strOut = " [vertical bar]"
Else
strOut = " [horizontal bar]"
End If
oFN.WriteLine "Implemented Categories\" & strImpCatSubKey & "\" & strOut
oFN.WriteLine "InProcServer32\(Default) = " &_
Chr(34) & strvalue3 & Chr(34) & CoName(IDExe(strValue3))

End If 'CLSID InProcServer32 exists?

End If 'CLSID not allowed Or ShowAll?

End If 'CLSID not already found in HKCU/HKLM?

End If 'strImpCatSubKey designates scroll bar?

Next 'arCLSIDImpCatSubKey

End If 'Implemented Categories sub-key exists?

Next 'CLSID sub-key

End If 'CLSID array exists?

Next 'CLSID hive

'determine -supp seconds used
Dim strDEBTime : strDEBTime = DateDiff("s",datDEBStart,Now) & " seconds"




'Extensions (Tools menu items, toolbar buttons)

strSubTitle = "Extensions (Tools menu items, main toolbar menu buttons)"

ReDim arAllowedExtensions(4) 'must be in upper case!
arAllowedExtensions(0) = "{438AFBA1-B0CB-11D2-9214-00104B3BCE5F}" '&Document Tree
arAllowedExtensions(1) = "{B06300D0-CCDE-11D2-92D3-0000F87A4A55}" 'Add to R&estricted Zone
arAllowedExtensions(2) = "{BF80219A-CCDD-11D2-92D3-0000F87A4A55}" 'Add to Tr&usted Zone
arAllowedExtensions(3) = "{C95FE080-8F5D-11D2-A20B-00AA003C157A}" 'Show &Related Links
arAllowedExtensions(4) = "{FC09D8A3-C85A-11D2-92D0-0000F87A4A55}" 'Offline
'{FB5F1910-F110-11D2-BB9E-00C04F795683} MSN Messenger Service

strKey = "Software\Microsoft\Internet Explorer\Extensions"

'for HKCU & HKLM hives
For i = 0 To 1

strSubSubTitle = arHives(i,0) & "\" & strKey & "\"

'get extension subkeys
oReg.EnumKey arHives(i,1),strKey,arHKExtensions

'if subkeys exist
If IsArray(arHKExtensions) Then

'for each subkey
For Each strHKExtension in arHKExtensions

If Len(strHKExtension) = 38 And Left(strHKExtension,1) = "{" And _
Right(strHKExtension,1) = "}" Then

'convert subkey name (CLSID) to uppercase
strHKExtension= UCase(strHKExtension)

'assume not on allowed list
flagAllow = False

'is Extension on allowed list?
For j = 0 To UBound(arAllowedExtensions)
If arAllowedExtensions(j) = UCase(strHKExtension) Then
flagAllow = True : Exit For 'toggle allowed flag
End If
Next

'if not allowed Or ShowAll
If Not flagAllow Or flagShowAll Then

'look for ButtonText/MenuText/CLSIDExtension/Exec values
intErrNum1 = oReg.GetStringValue(arHives(i,1),strKey & "\" &_
strHKExtension,"ButtonText",strValue1)
intErrNum2 = oReg.GetStringValue(arHives(i,1),strKey & "\" &_
strHKExtension,"MenuText",strValue2)
intErrNum3 = oReg.GetStringValue(arHives(i,1),strKey & "\" &_
strHKExtension,"CLSIDExtension",strValue3)
intErrNum4 = oReg.GetStringValue(arHives(i,1),strKey &_
"\" & strHKExtension,"Script",strValue4)
intErrNum5 = oReg.GetStringValue(arHives(i,1),strKey &_
"\" & strHKExtension,"Exec",strValue5)

If strSubSubTitle <> "" Then
TitleLineWrite : oFN.WriteLine strHKExtension & "\"
Else
oFN.WriteLine vbCRLF & strHKExtension & "\"
End If

'most output is optional (on error, do nothing)
On Error Resume Next
If intErrNum1 = 0 And strValue1 <> "" Then _
oFN.WriteLine Chr(34) & "ButtonText" & Chr(34) & " = " &_
Chr(34) & strValue1 & Chr(34)
If intErrNum2 = 0 And strValue2 <> "" Then _
oFN.WriteLine Chr(34) & "MenuText" & Chr(34) & " = " & Chr(34) &_
strValue2 & Chr(34)

If intErrNum3 = 0 And strValue3 <> "" Then

Err.Clear 'required to reset Err if ButtonText or MenuText missing

flagTitle = False
For ctrCH = intCLL To 1

ResolveCLSID strValue3, arHives(ctrCH,1), strCLSIDTitle, strValue6

If Not flagTitle Then
oFN.WriteLine Chr(34) & "CLSIDExtension" & Chr(34) & " = " &_
Chr(34) & strValue3 & Chr(34)
flagTitle = True
End If

If strValue6 <> "" Then
oFN.WriteLine " -> {" & arHives(ctrCH,0) & "...CLSID} = " &_
strCLSIDTitle & vbCRLF & Space(19) & "\InProcServer32\(Default) = " &_
StringFilter(strValue6,True) & CoName(IDExe(strValue6))
End If

Next 'CLSID hive

End If 'CLSIDExtension value exists

If intErrNum4 = 0 And strValue4 <> "" Then oFN.WriteLine Chr(34) &_
"Script" & Chr(34) & " = " & Chr(34) & strValue4 & Chr(34) &_
CoName(IDExe(strValue4))
If intErrNum5 = 0 And strValue5 <> "" Then oFN.WriteLine Chr(34) &_
"Exec" & Chr(34) & " = " & Chr(34) & strValue5 & Chr(34) &_
CoName(IDExe(strValue5))
Err.Clear
On Error Goto 0

End If 'flagAllow Or flagAll?

End If 'CLSID format?

Next 'Extension subkey

End If 'Extension subkeys exist

'if ShowAll, output sub-title lines if not already done
If flagShowAll Then TitleLineWrite

Next 'hive

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

'recover array memory
ReDim arCLSIDKeys(0)
ReDim arCLSIDImpCatSubKey(0)
ReDim arExplorerBars(0)
ReDim arAllowedExplorerBars(0)
ReDim arListedExplorerBars(0)
ReDim arHKExtensions(0)
ReDim arAllowedExtensions(0)
ReDim arAllowedToolbars(0)
ReDim arHKCUTbSK(0)
ReDim arSKValName(0)
ReDim arHKToolbarVals(0)

End If 'SecTest?




'#23. Internet Explorer URL Prefixes

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

strTitle = "Internet Explorer Address Prefixes:"

'prefix used if bare domain ("microsoft.com") entered into IE address box
strKey = "Software\Microsoft\Windows\CurrentVersion\URL"

strSubTitle = "Prefix for bare domain (" & Chr(34) &_
"domain-name-here.com" & Chr(34) & ")" & vbCRLF & vbCRLF & "HKLM\" &_
strKey & "\Default Prefix\"

'get DefaultPrefix default value
intErrNum = oReg.GetStringValue (HKLM,strKey & "\DefaultPrefix","",strValue)

'assume not infected
strWarn = ""

'value exists and is not empty
If intErrNum = 0 And strValue <> "" Then

'if default value not OK, toggle warning & flagHWarn
If Trim(LCase(strValue)) <> "http://" Then
strWarn = HWarn : flagHWarn = True
End If

If strWarn <> "" Or flagShowAll Then

TitleLineWrite : oFN.Writeline strWarn & "(Default) = " &_
StringFilter(strValue,True)

End If

Else 'value doesn't exist

If flagShowAll Then
TitleLineWrite
oFN.WriteLine "(Default) = (value not set)"
End If

End If 'default value exists?


'prefix used with specific service
'2 x 5 array
Dim arPrefix()
ReDim arPrefix(1,4)
arPrefix(0,0) = "ftp" : arPrefix(1,0) = "ftp://"
arPrefix(0,1) = "gopher" : arPrefix(1,1) = "gopher://"
arPrefix(0,2) = "home" : arPrefix(1,2) = "http://"
arPrefix(0,3) = "mosaic" : arPrefix(1,3) = "http://"
arPrefix(0,4) = "www" : arPrefix(1,4) = "http://"

'find all the names in the key
intErrNum1 = oReg.EnumValues (HKLM, strKey & "\Prefixes", arNames, arType)

strSubTitle = "Prefix for specific service (i.e., " & Chr(34) & "www" &_
Chr(34) & ")" & vbCRLF & vbCRLF & "HKLM\" & strKey & "\Prefixes\"

'enumerate data if present
If intErrNum1 = 0 And IsArray(arNames) Then

'for each name
For Each strName in arNames

'assume infected
flagMatch = False : strWarn = HWarn

'for each prefix type
For i = 0 To UBound(arPrefix,2)

'if name = prefix Or name = prefix.
If Trim(LCase(strName)) = arPrefix(0,i) Or _
Trim(LCase(strName)) = arPrefix(0,i) & "." Then

'get value
intErrNum2 = oReg.GetStringValue(HKLM,strKey & "\Prefixes", _
strName,strValue)

'if value exists (exc. for W2K!)
If intErrNum2 = 0 And strValue <> "" Then

'toggle flags if value = default value
If Trim(LCase(strValue)) = arPrefix(1,i) Then
flagMatch = True : strWarn = "" : Exit For
End If 'value = arPrefix member?

End If 'strValue exists And not empty?

End If 'name = arPrefix member?

Next 'arPrefix member

'get value if name not in arPrefix
If Not flagMatch Then oReg.GetStringValue HKLM, _
strKey & "\Prefixes",strName,strValue

'output if flagMatch Or flagShowAll
If Not flagMatch Or flagShowAll Then

TitleLineWrite

If strWarn <> "" Then flagHWarn = True

On Error Resume Next

'output warning, name, value
oFN.WriteLine strWarn & StringFilter(strName,True) & " = " &_
Chr(34) & strValue & Chr(34)
intErrNum = Err.Number : Err.Clear
'error check for W2K if value not set
If intErrNum <> 0 Then oFN.WriteLine StringFilter(strName,True) &_
" = (value not set)"

On Error Goto 0

End If 'flagMatch or flagShowAll?

Next 'prefix key name array member

If strSubTitle <> "" And flagShowAll Then
TitleLineWrite : oFN.WriteLine "(values not found)"
End If

Else 'prefix key name array doesn't exist

If flagShowAll Then
TitleLineWrite : oFN.WriteLine "(values not found)"
End If

End If 'prefix key name array exists

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

'recover array memory
ReDim arPrefix(0,0)

End If 'SecTest?




'#24. Misc. IE Hijack Points

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

'IERESET Text File, IERESET file name, INF-file section name,
'array of count of missing phrase lines by section
Dim oIERTF, strSection, arSectionCount(), intTFF
Dim intAsc1Chr, intAsc2Chr 'ASCII code of 1st & 2nd chr of IERESET.INF
'zero-based number of sections in phrase array with lines missing from disk file
Public intSectionCount : intSectionCount = -1
'one-based number of lines in each section of phrase array with lines missing from disk file
Public intSectionLineCount : intSectionLineCount = 0

strTitle = "Miscellaneous IE Hijack Points"
strWarn = HWarn

'parse IERESET.INF, look for added and missing lines
Dim strIERFN : strIERFN = UCase(strFPWF) & "\INF\IERESET.INF"

'read the IE version from the registry

'IE version reg value, work string
Dim strIELVer, strIELVWK
'short string version, non-numeric if dec symbol not "."
Dim strIEShVer : strIEShVer = "0"
'numeric IE version: 0 if IE version not in registry or value not set
'otherwise, number using single local dec symbol
Dim intIELVer : intIELVer = 0
Dim strDecSym : strDecSym = "." 'dec symbol

strKey = "Software\Microsoft\Internet Explorer"
intErrNum = oReg.GetStringValue(HKLM,strKey,"Version",strIELVer)

strSubTitle = "HKLM\" & strKey & "\Version = " & strIELVer
strSubSubTitle = strIERFN & " (used to " & Chr(34) & "Reset Web " &_
"Settings" & Chr(34) & ")"

'in W2K, if value not set, strIELVer will be garbage
If intErrNum = 0 And Len(Trim(strIELVer)) > 3 Then

'read the decimal symbol from the registry
strKey1 = "Control Panel\International"
intErrNum1 = oReg.GetStringValue(HKCU,strKey1,"sDecimal",strValue1)
'if the symbol exists, store it
If intErrNum1 = 0 And strValue1 <> "" Then strDecSym = strValue1

'replace 1st dec pt in the IE ver with XXX
strIELVWK = Replace (Trim(strIELVer),".","XXX",1,1,1)
'delete all succeeding dec pts
strIELVWK = Replace (Trim(strIELVWK),".","",1,-1,1)
'restore dec symbol to pos'n of first dec pt and call it an integer
intIELVer = Replace (Trim(strIELVWK),"XXX",strDecSym,1,1,1)

If IsNumeric(intIELVer) Then 'should exclude W2K value not set garbage

strIEShVer = Left(LTrim(strIELVer),3)

If strIEShVer <> "5.5" Then 'for 5.5, retain 3 chrs

'use left-most chr
strIEShVer = Left(LTrim(strIELVer),1)

'if IE ver < 5, advise that INF file doesn't exist
If intIELVer < 5 Then
TitleLineWrite
oFN.WriteLine vbCRLF & "IERESET.INF does not exist for this Internet " &_
"Explorer version."
End If 'intIELVer<5?

End If 'strIEShVer=5.5?

Else 'intIELVer not numeric, so advise about bad IE version and reset to 0

strSubTitle = "HKLM\" & strKey & "\Version = (invalid data)" &_
vbCRLF & "The Internet Explorer version cannot be found!"
TitleLineWrite
oFN.WriteLine "The contents of IERESET.INF cannot be reliably checked!"
intIELVer = 0

End If 'intIELVer numeric?

Else 'IE ver not found or value corrupt

strSubTitle = "HKLM\" & strKey & "\Version = (invalid data)" &_
vbCRLF & "The Internet Explorer version cannot be found!"
TitleLineWrite
oFN.WriteLine "The contents of IERESET.INF cannot be reliably checked!"

End If 'IE ver exists?

'change titles if not already written
If strTitle <> "" Then
strSubTitle = strIERFN & " (used to " & Chr(34) & "Reset Web Settings" &_
Chr(34) & ")"
strSubSubTitle = ""
End If

If strIEShVer <> "7" Then 'IE 7

Dim arIER() 'common IERESET.INF lines & phrases
ReDim arIER(31,2) 'section, phrase, found-in-file-on-disk?
arIER(0,0)="[Version]" : arIER(0,1)="Signature=""$CHICAGO$"""
arIER(1,0)="[Version]" : arIER(1,1)="AdvancedINF=2.5,""You need a new version of advpack.dll"""
arIER(2,0)="[RestoreHomePage]" : arIER(2,1)="AddReg=RestoreHomePage.reg"
arIER(3,0)="[RestoreHomePage.reg]" : arIER(3,1)="HKCU,""Software\Microsoft\Internet Explorer\Main"",""Start Page"",0,%START_PAGE_URL%"
arIER(4,0)="[RestoreBrowserSettings.reg]" : arIER(4,1)="HKLM,""Software\Microsoft\Internet Explorer\Main"",""Default_Page_URL"",0,%START_PAGE_URL%"
arIER(5,0)="[RestoreBrowserSettings.reg]" : arIER(5,1)="HKLM,""Software\Microsoft\Internet Explorer\Main"",""Default_Search_URL"",0,%SEARCH_PAGE_URL%"
arIER(6,0)="[RestoreBrowserSettings.reg]" : arIER(6,1)="HKLM,""Software\Microsoft\Internet Explorer\Main"",""Search Page"",0,%SEARCH_PAGE_URL%"
arIER(7,0)="[RestoreBrowserSettings.reg]" : arIER(7,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""1"",0,""www.%s.com"""
arIER(8,0)="[RestoreBrowserSettings.reg]" : arIER(8,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""2"",0,""www.%s.org"""
arIER(9,0)="[RestoreBrowserSettings.reg]" : arIER(9,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""3"",0,""www.%s.net"""
arIER(10,0)="[RestoreBrowserSettings.reg]" : arIER(10,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""4"",0,""www.%s.edu"""
arIER(11,0)="[RestoreBrowserSettings.reg]" : arIER(11,1)="HKCU,""Software\Microsoft\Internet Explorer\Main"",""Search Page"",0,%SEARCH_PAGE_URL%"
arIER(12,0)="[RestoreBrowserSettings.reg]" : arIER(12,1)="HKCU,""Software\Microsoft\Internet Explorer\SearchUrl"",""Provider"",0,"""""
arIER(13,0)="[RestoreBrowserSettings.reg]" : arIER(13,1)="HKLM,""Software\Microsoft\Internet Explorer\Search"",""SearchAssistant"",0,""http://ie.search.msn.com/{SUB_RFC1766}/srchasst/srchasst.htm"""
arIER(14,0)="[RestoreBrowserSettings.reg]" : arIER(14,1)="HKLM,""Software\Microsoft\Internet Explorer\Search"",""CustomizeSearch"",0,""http://ie.search.msn.com/{SUB_RFC1766}/srchasst/srchcust.htm"""
arIER(15,0)="[RestoreBrowserSettings.reg]" : arIER(15,1)="HKLM,""Software\Microsoft\Windows\CurrentVersion\Internet Settings\SafeSites"",%SAFESITE_VALUE%,0,""http://ie.search.msn.com/*"""
arIER(16,0)="[DeleteTemplates.reg]" : arIER(16,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""5"""
arIER(17,0)="[DeleteTemplates.reg]" : arIER(17,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""6"""
arIER(18,0)="[DeleteTemplates.reg]" : arIER(18,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""7"""
arIER(19,0)="[DeleteTemplates.reg]" : arIER(19,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""8"""
arIER(20,0)="[DeleteTemplates.reg]" : arIER(20,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""9"""
arIER(21,0)="[DeleteAutosearch.reg]" : arIER(21,1)="HKCU,""Software\Microsoft\Internet Explorer\Main"",""AutoSearch"""
arIER(22,0)="[Strings]" : arIER(22,1)="SEARCH_PAGE_URL=""http://www.microsoft.com/isapi/redir.dll?prd=ie&ar=iesearch"""
arIER(23,0)="[RestoreBrowserSettings]" : arIER(23,1)="AddReg=RestoreBrowserSettings.reg"

arIER(24,0)="[RestoreBrowserSettings]" : arIER(24,1)="DelReg=DeleteTemplates.reg"
arIER(25,0)="[RestoreBrowserSettings]" : arIER(25,1)="DelReg=DeleteTemplates.reg, DeleteAutosearch.reg"
arIER(26,0)="[Strings]" : arIER(26,1)="START_PAGE_URL=""http://www.microsoft.com/isapi/redir.dll?prd=ie&pver=" & strIEShVer & "&ar=msnhome"""
arIER(27,0)="[Strings]" : arIER(27,1)="START_PAGE_URL=""http://www.msn.com"""
arIER(28,0)="[Strings]" : arIER(28,1)="SAFESITE_VALUE=""http://home.microsoft.com/"""
arIER(29,0)="[Strings]" : arIER(29,1)="SAFESITE_VALUE=""ie.search.msn.com"""
arIER(30,0)="[Strings]" : arIER(30,1)="MS_START_PAGE_URL=""http://www.microsoft.com/isapi/redir.dll?prd=ie&pver=" & strIEShVer & "&ar=msnhome"""
arIER(31,0)="[Strings]" : arIER(31,1)="MS_START_PAGE_URL=""http://www.msn.com"""

'set found-in-file-on-disk flag to False
For i = 0 To UBound(arIER,1) : arIER(i,2) = False : Next

'if IERESET.INF exists
If Fso.FileExists(strIERFN) Then

'open the file for reading/don't create/ASCII format
Set oIERTF = Fso.OpenTextFile (strIERFN,1,False,0)

'get the file size
Dim intFileSize : intFileSize = Fso.GetFile(strIERFN).Size

If intFileSize > 100 Then

'read 1st 2 chrs, find Asc code (not AscW code)
intAsc1Chr = Asc(oIERTF.Read(1)) : intAsc2Chr = Asc(oIERTF.Read(1))

oIERTF.Close

'if Asc codes = 255 & 254, file is Unicode
'ASCII file read as Unicode: 1st Unicode line is entire file
'Unicode file read as ASCII: 1st ASCII line is variable length
'TriStateDefault appears to distinguish between ASCII & Unicode on file open
'VBS internally allots 2 bytes per ASCII chr

intTFF = 0 'ASCII fmt
If intAsc1Chr = 255 And intAsc2Chr = 254 Then intTFF = -1 'Unicode fmt

Set oIERTF = Fso.OpenTextFile (strIERFN,1,False,intTFF)

strSubSubTitle = "Added lines (compared with English-language version):"

flagInfect = False

'for each line
Do Until oIERTF.AtEndOfStream

strLine = Trim(oIERTF.ReadLine) 'read a line

flagMatch = False 'line doesn't match phrase array

'if line not empty And not a comment
If Len(strLine) > 0 And Left(strLine,1) <> ";" Then

If Left(strLine,1) = "[" Then 'if line is section title

strSection = strLine 'save the section name

Else 'line not a section title, so it's a data line

For i = 0 To UBound(arIER,1) 'for every line in phrase array

'if section's identical and phrase found in line,
'toggle line match flag & found-in-file-on-disk flag
If LCase(arIER(i,0)) = LCase(strSection) And _
LCase(strLine) = LCase(arIER(i,1)) Then
flagMatch = True : arIER(i,2) = True : Exit For
Exit For
End If

Next

If Not flagMatch Then 'if line not matched
flagInfect = True
TitleLineWrite
On Error Resume Next
'output section name & line
oFN.WriteLine strSection & ": " & strLine
intErrNum = Err.Number : Err.Clear
On Error Goto 0
If intErrNum <> 0 Then oFN.WriteLine "(unwritable string)"
End If 'line matched?

End If 'section title line?

End If 'data line?

Loop 'next file line

'close IERESET.INf
oIERTF.Close : Set oIERTF=Nothing

'initialize section title for phrases missing from file
strSection = ""
strSubSubTitle = "Missing lines (compared with English-language version):"
flagFound = True 'False if found-in-file-on-disk = False

For i = 0 To 23 'for single-option phrases
If Not arIER(i,2) Then
flagFound = False : flagInfect = True 'toggle flags
'increment counters
IERESETCounter strSection, arIER(i,0), arSectionCount
End If
Next 'single-option phrase

'check double-option phrases
For i = 24 To 30 Step 2
'if neither option found-in-file-on-disk
If Not arIER(i,2) And Not arIER(i+1,2) Then
flagFound = False : flagInfect = True 'toggle flags
'increment counters
IERESETCounter strSection, arIER(i,0), arSectionCount
End If
Next 'double-option phrase

If Not flagFound Then 'if lines missing

TitleLineWrite

'output contents of arSectionCount (section title: # missing lines)
For i = 0 To UBound(arSectionCount,2)
strOut = " line"
If arSectionCount(1,i) > 1 Then strOut = " lines"
oFN.WriteLine arSectionCount(0,i) & ": " & arSectionCount(1,i) & strOut
Next

End If 'lines missing?

strSubSubTitle = "" 'reset title line (no longer needed)

If strTitle <> "" And flagShowAll Then
strSubTitle = strIERFN & " (used to " & Chr(34) &_
"Reset Web Settings" & Chr(34) & " -- no anomalies found)"
TitleLineWrite
End If

Else 'IERESET.INF<100 bytes

oIERTF.Close

'file should always exist if IE ver > 5 Or if in one of these OS's
If intIELVer > 5 Or strOS = "WXP" Or strOS = "W2K" Or strOS = "WME" Then

TitleLineWrite
oFN.WriteLine strWarn & strIERFN & " is *much* too small and is " &_
"probably corrupt!"
flagHWarn = True

End If 'should file exist?

End If 'IERSET.INF>100 bytes?

Else 'IERESET.INF not found

'file should always exist if IE ver > 5 Or if in one of these OS's
If intIELVer > 5 Or strOS = "WXP" Or strOS = "W2K" Or strOS = "WME" Then

TitleLineWrite
oFN.WriteLine strWarn & strIERFN & " was not found!"
flagHWarn = True

End If 'should file exist?

End If 'IERESET.INF found?

End If 'strIEShVer<>7?

'URLSearchHooks
strKey = "Software\Microsoft\Internet Explorer\URLSearchHooks"
strSubTitle = "HKCU\" & strKey & "\"

intErrNum = oReg.EnumValues (HKCU, strKey, arNames, arType)

If IsArray(arNames) Then

For Each strCLSID In arNames

If UCase(strCLSID) <> "{CFBFAE00-17A6-11D0-99CB-00C04FD64497}" Or _
flagShowAll Then

flagTitle = False

CLSIDLocTitle HKCU, strKey, strCLSID, strLocTitle

For ctrCH = intCLL To 1

ResolveCLSID strCLSID, arHives(ctrCH,1), strCLSIDTitle, strIPSDLL

If strIPSDLL <> "" Then

strWarn = ""
If UCase(strCLSID) <> "{CFBFAE00-17A6-11D0-99CB-00C04FD64497}" Then
strWarn = HWarn : flagHWarn = True
End If

TitleLineWrite

If Not flagTitle Then
oFN.WriteLine strWarn & DQ & strCLSID & DQ & " = " & strLocTitle
flagTitle = True
End If

oFN.WriteLine " -> {" & arHives(ctrCH,0) & "...CLSID} = " &_
strCLSIDTitle & vbCRLF & Space(19) & "\InProcServer32\(Default) = " &_
StringFilter(strIPSDLL,True) & CoName(IDExe(strIPSDLL))

End If 'IPS exists?

Next 'CLSID hive

End If 'match Or flagShowAll?

Next 'strCLSID

Else

If flagShowAll Then
TitleLineWrite
oFN.WriteLine "(URLSearchHooks key not found!)"
End If

End If 'IsArray?


'AboutURLs
strKey = "Software\Microsoft\Internet Explorer\AboutURLs"
strSubTitle = "HKLM\" & strKey & "\"

EnumNVP HKLM, strKey, arNames, arType

If flagNVP Then 'name/value pairs exist

Set arSK = CreateObject("Scripting.Dictionary") 'key, item

'add dictionary pairs (universal elements)
arSK.Add "blank", "res://mshtml.dll/blank.htm"
arSK.Add "Home", "hex:0x0000010E"
arSK.Add "mozilla", "res://mshtml.dll/about.moz"

'value not set or IE 5-7
If intIELVer >= 7 Then 'IE 7
arSK.Add "DesktopItemNavigationFailure", "res://ieframe.dll/navcancl.htm"
arSK.Add "NavigationCanceled", "res://ieframe.dll/navcancl.htm"
arSK.Add "NavigationFailure", "res://ieframe.dll/navcancl.htm"
arSK.Add "OfflineInformation", "res://ieframe.dll/offcancl.htm"
arSK.Add "NoAdd-ons", "res://ieframe.dll/noaddon.htm"
arSK.Add "NoAdd-onsInfo", "res://ieframe.dll/noaddoninfo.htm"
arSK.Add "PostNotCached", "res://ieframe.dll/repost.htm"
arSK.Add "SecurityRisk", "res://ieframe.dll/securityatrisk.htm"
arSK.Add "Tabs", "res://ieframe.dll/tabswelcome.htm"
ElseIf intIELVer = 0 Or intIELVer >= 5 Then
arSK.Add "DesktopItemNavigationFailure", "res://shdoclc.dll/navcancl.htm"
arSK.Add "NavigationCanceled", "res://shdoclc.dll/navcancl.htm"
arSK.Add "NavigationFailure", "res://shdoclc.dll/navcancl.htm"
arSK.Add "OfflineInformation", "res://shdoclc.dll/offcancl.htm"
arSK.Add "PostNotCached", "res://mshtml.dll/repost.htm"
Else 'IE < 5
arSK.Add "DesktopItemNavigationFailure", "res://shdocvw.dll/navcancl.htm"
arSK.Add "NavigationCanceled", "res://shdocvw.dll/navcancl.htm"
arSK.Add "NavigationFailure", "res://shdocvw.dll/navcancl.htm"
arSK.Add "OfflineInformation", "res://shdocvw.dll/offcancl.htm"
arSK.Add "PostNotCached", "res://mshtml.dll/repost.htm"
End If 'IE>7?

arSKk = arSK.Keys : arSKi = arSK.Items

For i = 0 To UBound(arNames)

strWarn = HWarn

'use the type to find the value
strValue = RtnValue (HKLM, strKey, arNames(i), arType(i))

For j = 0 To arSK.Count-1

flagFound = False

If LCase(arNames(i)) = LCase(arSKk(j)) And _
LCase(strValue) = LCase(arSKi(j)) Then
flagFound = True : strWarn = "" : Exit For
End If

Next 'dictionary pair

If Not flagFound Or flagShowAll Then

TitleLineWrite
WriteValueData arNames(i), strValue, arType(i), strWarn
If strWarn <> "" Then flagHWarn = True

End If

Next 'arNames member

arSK.RemoveAll : Set arSK=Nothing 'recover dictionary memory

Else

If flagShowAll Then
TitleLineWrite
oFN.WriteLine "(AboutURLs key not found!)"
End If

End If 'flagNVP?

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

End If 'SecTest?

Silent Runners Part 3



'#25. HOSTS file

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

'left-trimmed HOSTS line, IP address, HOSTS Path, tab pos'n
Dim strLineWk, strIP, strHP, intTabPosn
Dim intWSPosn : intWSPosn = 0 'white space posn
Dim intMapCtr : intMapCtr = 0 'map ctr
Dim intNLHMapCtr : intNLHMapCtr = 0 'non-localhost map ctr

'prepare section title
strTitle = "HOSTS file"

'determine HOSTS file location
If strOS <> "W98" And strOS <> "WME" Then

'find HOSTS directory from registry, compare to default value
strKey = "System\CurrentControlSet\Services\Tcpip\Parameters"
intErrNum = oReg.GetExpandedStringValue (HKLM,strKey,"DataBasePath",strValue)

'if registry value exists
If intErrNum = 0 And strValue <> "" Then

'trim it & expand path string
strTmp = Wshso.ExpandEnvironmentStrings(Trim(strValue))
'lop off trailing backslash
If Right(strTmp,1) = "\" Then strTmp = Left(strTmp,Len(strTmp)-1)

'set HOSTS path from registry value
strHP = strTmp & "\HOSTS"

'output warning if not identical to default value
strWarn = ""
If LCase(strTmp) <> LCase(strFPSF) & "\drivers\etc" Then
strWarn = HWarn : flagHWarn = True
End If

If LCase(strTmp) <> LCase(strFPSF) & "\drivers\etc" Or flagShowAll Then

TitleLineWrite

oFN.WriteLine vbCRLF & "HKLM\" & strKey & "\" & vbCRLF & strWarn &_
Chr(34) & "DataBasePath" & Chr(34) & " = " & Chr(34) & strValue &_
Chr(34)

End If 'value <> default?

Else 'registry value doesn't exist

'set HOSTS location to default
strHP = strFPSF & "\Drivers\Etc\HOSTS"

End If 'HOSTS directory registry value exists?

Else 'W98/WMe

strHP = strFPWF & "\HOSTS"

End If 'O/S?

'if HOSTS exists
If Fso.FileExists(strHP) Then

'open it for reading
Set oSCF = Fso.OpenTextFile (strHP,1)

Do While Not oSCF.AtEndOfStream

'read a line
strLine = oSCF.ReadLine
strLineWk = Trim(strLine) 'trim the line

'if line not CR And not a comment
If Len(strLineWk) > 0 And InStr(1,strLineWk,"#",1) <> 1 Then

'increment the mapped domain name count
intMapCtr = intMapCtr + 1

'find an interior space/tab
intSpacePosn = InStr(1,strLineWk," ",1)
intTabPosn = InStr(1,strLineWk,Chr(09),1)

If intSpacePosn > 0 Then intWSPosn = intSpacePosn
If intSpacePosn = 0 Or (intTabPosn > 0 And intTabPosn < intSpacePosn) _
Then intWSPosn = intTabPosn

'if a space or tab exists
If intWSPosn > 0 Then

'extract the IP address left of the space
strIP = Left(strLineWk,intWSPosn-1)

'if not localhost, increment the mapped non localhost count
If strIP <> "127.0.0.1" Then
intNLHMapCtr = intNLHMapCtr + 1 : TitleLineWrite
End If

End If 'line has embedded space?

End If 'line not CR/comment?

Loop 'read another line

oSCF.Close : Set oSCF=Nothing

'output if more than one IP mapped Or any IP mapped to non-localhost
'Or ShowAll
If (intMapCtr >= 1 And intNLHMapCtr > 0) Or flagShowAll Then

'set up output strings

'total number of mappings
If intMapCtr = 0 Then 'none
strOut1 = "maps: no domain names to IP addresses"
ElseIf intMapCtr = 1 Then 'one
strOut1 = "maps: 1 domain name to an IP address," & vbCRLF
Else '> 1
strOut1 = "maps: " & intMapCtr &_
" domain names to IP addresses," & vbCRLF
End If

'non-localhost mappings
If intNLHMapCtr = 0 Then 'none
If intMapCtr = 0 Then 'no maps found
strOut2 = ""
ElseIf intMapCtr = 1 Then 'one map found
strOut2 = Space(6) & "and this is the localhost IP address"
Else
strOut2 = Space(6) & "and all are the localhost IP address" '> 1 map found
End If
ElseIf intNLHMapCtr = 1 Then 'one
strOut2 = Space(6) & "1 of the IP addresses is *not* localhost!"
Else '> 1
strOut2 = Space(6) & intNLHMapCtr & " of the IP addresses are *not* localhost!"
End If

'output mapped & non-localhost counts
TitleLineWrite

oFN.WriteLine vbCRLF & strHP & vbCRLF & vbCRLF & strOut1 & strOut2

End If '>= 1 IP mapped And at least 1 IP mapped to non-localhost

Else 'HOSTS doesn't exist

If flagShowAll Then

TitleLineWrite
'say file not found
oFN.WriteLine vbCRLF & strHP & " (file not found)"

End If 'flagShowAll?

End If 'HOSTS exists?

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

End If 'SecTest?




'#26. Started Services

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

'for NT-type O/S's
If strOS <> "W98" And strOS <> "WME" Then

'MS default services array, subscript number in MS default services array
'CoName string, optionally quote-delimited path name
Dim arMSSvc(), intMSSvcNo, strExeName, strPathNameOut

'set up MS default services array for WVa/WXP/W2K/NT4
'service name, service executable, DLL file name for svchost.exe-dependent service

If strOS = "WXP" Then

ReDim arMSSvc(92,2)
arMSSvc(0,0) = "alerter" : arMSSvc(0,1) = "svchost.exe" : arMSSvc(0,2) = "alrsvc.dll"
arMSSvc(1,0) = "alg" : arMSSvc(1,1) = "alg.exe" : arMSSvc(1,2) = ""
arMSSvc(2,0) = "appmgmt" : arMSSvc(2,1) = "svchost.exe" : arMSSvc(2,2) = "appmgmts.dll"
arMSSvc(3,0) = "wuauserv" : arMSSvc(3,1) = "svchost.exe" : arMSSvc(3,2) = "wuauserv.dll"
arMSSvc(4,0) = "bits" : arMSSvc(4,1) = "svchost.exe" : arMSSvc(4,2) = "qmgr.dll"
arMSSvc(5,0) = "clipsrv" : arMSSvc(5,1) = "clipsrv.exe" : arMSSvc(5,2) = ""
arMSSvc(6,0) = "eventsystem" : arMSSvc(6,1) = "svchost.exe" : arMSSvc(6,2) = "es.dll"
arMSSvc(7,0) = "comsysapp" : arMSSvc(7,1) = "dllhost.exe" : arMSSvc(7,2) = ""
arMSSvc(8,0) = "browser" : arMSSvc(8,1) = "svchost.exe" : arMSSvc(8,2) = "browser.dll"
arMSSvc(9,0) = "cryptsvc" : arMSSvc(9,1) = "svchost.exe" : arMSSvc(9,2) = "cryptsvc.dll"
arMSSvc(10,0) = "dhcp" : arMSSvc(10,1) = "svchost.exe" : arMSSvc(10,2) = "dhcpcsvc.dll"
arMSSvc(11,0) = "trkwks" : arMSSvc(11,1) = "svchost.exe" : arMSSvc(11,2) = "trkwks.dll"
arMSSvc(12,0) = "msdtc" : arMSSvc(12,1) = "msdtc.exe" : arMSSvc(12,2) = ""
arMSSvc(13,0) = "dnscache" : arMSSvc(13,1) = "svchost.exe" : arMSSvc(13,2) = "dnsrslvr.dll"
arMSSvc(14,0) = "eventlog" : arMSSvc(14,1) = "services.exe" : arMSSvc(14,2) = ""
arMSSvc(15,0) = "ersvc" : arMSSvc(15,1) = "svchost.exe" : arMSSvc(15,2) = "ersvc.dll"
arMSSvc(16,0) = "fastuserswitchingcompatibility" : arMSSvc(16,1) = "svchost.exe" : arMSSvc(16,2) = "shsvcs.dll"
arMSSvc(17,0) = "helpsvc" : arMSSvc(17,1) = "svchost.exe" : arMSSvc(17,2) = "pchsvc.dll"
arMSSvc(18,0) = "hidserv" : arMSSvc(18,1) = "svchost.exe" : arMSSvc(18,2) = "hidserv.dll"
arMSSvc(19,0) = "imapiservice" : arMSSvc(19,1) = "imapi.exe" : arMSSvc(19,2) = ""
arMSSvc(20,0) = "iisadmin" : arMSSvc(20,1) = "inetinfo.exe" : arMSSvc(20,2) = ""
arMSSvc(21,0) = "cisvc" : arMSSvc(21,1) = "cisvc.exe" : arMSSvc(21,2) = ""
arMSSvc(22,0) = "sharedaccess" : arMSSvc(22,1) = "svchost.exe" : arMSSvc(22,2) = "ipnathlp.dll"
arMSSvc(23,0) = "policyagent" : arMSSvc(23,1) = "lsass.exe" : arMSSvc(23,2) = ""
arMSSvc(24,0) = "dmserver" : arMSSvc(24,1) = "svchost.exe" : arMSSvc(24,2) = "dmserver.dll"
arMSSvc(25,0) = "dmadmin" : arMSSvc(25,1) = "dmadmin.exe" : arMSSvc(25,2) = ""
arMSSvc(26,0) = "messenger" : arMSSvc(26,1) = "svchost.exe" : arMSSvc(26,2) = "msgsvc.dll"
arMSSvc(27,0) = "swprv" : arMSSvc(27,1) = "dllhost.exe" : arMSSvc(27,2) = ""
arMSSvc(28,0) = "netlogon" : arMSSvc(28,1) = "lsass.exe" : arMSSvc(28,2) = ""
arMSSvc(29,0) = "mnmsrvc" : arMSSvc(29,1) = "mnmsrvc.exe" : arMSSvc(29,2) = ""
arMSSvc(30,0) = "netman" : arMSSvc(30,1) = "svchost.exe" : arMSSvc(30,2) = "netman.dll"
arMSSvc(31,0) = "netdde" : arMSSvc(31,1) = "netdde.exe" : arMSSvc(31,2) = ""
arMSSvc(32,0) = "netddedsdm" : arMSSvc(32,1) = "netdde.exe" : arMSSvc(32,2) = ""
arMSSvc(33,0) = "nla" : arMSSvc(33,1) = "svchost.exe" : arMSSvc(33,2) = "mswsock.dll"
arMSSvc(34,0) = "ntlmssp" : arMSSvc(34,1) = "lsass.exe" : arMSSvc(34,2) = ""
arMSSvc(35,0) = "sysmonlog" : arMSSvc(35,1) = "smlogsvc.exe" : arMSSvc(35,2) = ""
arMSSvc(36,0) = "plugplay" : arMSSvc(36,1) = "services.exe" : arMSSvc(36,2) = ""
arMSSvc(37,0) = "wmdmpmsp" : arMSSvc(37,1) = "svchost.exe" : arMSSvc(37,2) = "mspmspsv.dll"
arMSSvc(38,0) = "spooler" : arMSSvc(38,1) = "spoolsv.exe" : arMSSvc(38,2) = ""
arMSSvc(39,0) = "protectedstorage" : arMSSvc(39,1) = "lsass.exe" : arMSSvc(39,2) = ""
arMSSvc(40,0) = "rsvp" : arMSSvc(40,1) = "rsvp.exe" : arMSSvc(40,2) = ""
arMSSvc(41,0) = "rasauto" : arMSSvc(41,1) = "svchost.exe" : arMSSvc(41,2) = "rasauto.dll"
arMSSvc(42,0) = "rasman" : arMSSvc(42,1) = "svchost.exe" : arMSSvc(42,2) = "rasmans.dll"
arMSSvc(43,0) = "rdsessmgr" : arMSSvc(43,1) = "sessmgr.exe" : arMSSvc(43,2) = ""
arMSSvc(44,0) = "rpcss" : arMSSvc(44,1) = "svchost.exe" : arMSSvc(44,2) = "rpcss.dll"
arMSSvc(45,0) = "rpclocator" : arMSSvc(45,1) = "locator.exe" : arMSSvc(45,2) = ""
arMSSvc(46,0) = "remoteregistry" : arMSSvc(46,1) = "svchost.exe" : arMSSvc(46,2) = "regsvc.dll"
arMSSvc(47,0) = "ntmssvc" : arMSSvc(47,1) = "svchost.exe" : arMSSvc(47,2) = "ntmssvc.dll"
arMSSvc(48,0) = "remoteaccess" : arMSSvc(48,1) = "svchost.exe" : arMSSvc(48,2) = "mprdim.dll"
arMSSvc(49,0) = "seclogon" : arMSSvc(49,1) = "svchost.exe" : arMSSvc(49,2) = "seclogon.dll"
arMSSvc(50,0) = "samss" : arMSSvc(50,1) = "lsass.exe" : arMSSvc(50,2) = ""
arMSSvc(51,0) = "lanmanserver" : arMSSvc(51,1) = "svchost.exe" : arMSSvc(51,2) = "srvsvc.dll"
arMSSvc(52,0) = "smtpsvc" : arMSSvc(52,1) = "inetinfo.exe" : arMSSvc(52,2) = ""
arMSSvc(53,0) = "shellhwdetection" : arMSSvc(53,1) = "svchost.exe" : arMSSvc(53,2) = "shsvcs.dll"
arMSSvc(54,0) = "scardsvr" : arMSSvc(54,1) = "scardsvr.exe" : arMSSvc(54,2) = ""
arMSSvc(55,0) = "scarddrv" : arMSSvc(55,1) = "scardsvr.exe" : arMSSvc(55,2) = ""
arMSSvc(56,0) = "ssdpsrv" : arMSSvc(56,1) = "svchost.exe" : arMSSvc(56,2) = "ssdpsrv.dll"
arMSSvc(57,0) = "sens" : arMSSvc(57,1) = "svchost.exe" : arMSSvc(57,2) = "sens.dll"
arMSSvc(58,0) = "srservice" : arMSSvc(58,1) = "svchost.exe" : arMSSvc(58,2) = "srsvc.dll"
arMSSvc(59,0) = "schedule" : arMSSvc(59,1) = "svchost.exe" : arMSSvc(59,2) = "schedsvc.dll"
arMSSvc(60,0) = "lmhosts" : arMSSvc(60,1) = "svchost.exe" : arMSSvc(60,2) = "lmhsvc.dll"
arMSSvc(61,0) = "tapisrv" : arMSSvc(61,1) = "svchost.exe" : arMSSvc(61,2) = "tapisrv.dll"
arMSSvc(62,0) = "tlntsvr" : arMSSvc(62,1) = "tlntsvr.exe" : arMSSvc(62,2) = ""
arMSSvc(63,0) = "termservice" : arMSSvc(63,1) = "svchost.exe" : arMSSvc(63,2) = "termsrv.dll"
arMSSvc(64,0) = "themes" : arMSSvc(64,1) = "svchost.exe" : arMSSvc(64,2) = "shsvcs.dll"
arMSSvc(65,0) = "ups" : arMSSvc(65,1) = "ups.exe" : arMSSvc(65,2) = ""
arMSSvc(66,0) = "upnphost" : arMSSvc(66,1) = "svchost.exe" : arMSSvc(66,2) = "upnphost.dll"
arMSSvc(67,0) = "uploadmgr" : arMSSvc(67,1) = "svchost.exe" : arMSSvc(67,2) = "pchsvc.dll"
arMSSvc(68,0) = "vss" : arMSSvc(68,1) = "vssvc.exe" : arMSSvc(68,2) = ""
arMSSvc(69,0) = "webclient" : arMSSvc(69,1) = "svchost.exe" : arMSSvc(69,2) = "webclnt.dll"
arMSSvc(70,0) = "audiosrv" : arMSSvc(70,1) = "svchost.exe" : arMSSvc(70,2) = "audiosrv.dll"
arMSSvc(71,0) = "stisvc" : arMSSvc(71,1) = "svchost.exe" : arMSSvc(71,2) = "wiaservc.dll"
arMSSvc(72,0) = "msiserver" : arMSSvc(72,1) = "msiexec.exe" : arMSSvc(72,2) = ""
arMSSvc(73,0) = "winmgmt" : arMSSvc(73,1) = "svchost.exe" : arMSSvc(73,2) = "wmisvc.dll"
arMSSvc(74,0) = "wmi" : arMSSvc(74,1) = "svchost.exe" : arMSSvc(74,2) = "advapi32.dll"
arMSSvc(75,0) = "w32time" : arMSSvc(75,1) = "svchost.exe" : arMSSvc(75,2) = "w32time.dll"
arMSSvc(76,0) = "wzcsvc" : arMSSvc(76,1) = "svchost.exe" : arMSSvc(76,2) = "wzcsvc.dll"
arMSSvc(77,0) = "wmiapsrv" : arMSSvc(77,1) = "svchost.exe" : arMSSvc(77,2) = "wmiapsrv.dll"
arMSSvc(78,0) = "lanmanworkstation" : arMSSvc(78,1) = "svchost.exe" : arMSSvc(78,2) = "wkssvc.dll"
arMSSvc(79,0) = "w3svc" : arMSSvc(79,1) = "inetinfo.exe" : arMSSvc(79,2) = ""
arMSSvc(80,0) = "dcomlaunch" : arMSSvc(80,1) = "svchost.exe" : arMSSvc(80,2) = "rpcss.dll"
arMSSvc(81,0) = "irmon" : arMSSvc(81,1) = "svchost.exe" : arMSSvc(81,2) = "irmon.dll"
arMSSvc(82,0) = "ip6fwhlp" : arMSSvc(82,1) = "svchost.exe" : arMSSvc(82,2) = "ip6fwhlp.dll"
arMSSvc(83,0) = "wscsvc" : arMSSvc(83,1) = "svchost.exe" : arMSSvc(83,2) = "wscsvc.dll"
arMSSvc(84,0) = "wmiapsrv" : arMSSvc(84,1) = "wmiapsrv.exe" : arMSSvc(84,2) = ""
arMSSvc(85,0) = "httpfilter" : arMSSvc(85,1) = "svchost.exe" : arMSSvc(85,2) = "w3ssl.dll"

'WS2K3 only
arMSSvc(86,0) = "dfs" : arMSSvc(86,1) = "dfssvc.exe" : arMSSvc(86,2) = ""
arMSSvc(87,0) = "httpfilter" : arMSSvc(87,1) = "lsass.exe" : arMSSvc(87,2) = ""
arMSSvc(88,0) = "srvcsurg" : arMSSvc(88,1) = "srvcsurg.exe" : arMSSvc(88,2) = ""
arMSSvc(89,0) = "appmgr" : arMSSvc(89,1) = "appmgr.exe" : arMSSvc(89,2) = ""
arMSSvc(90,0) = "snmp" : arMSSvc(90,1) = "snmp.exe" : arMSSvc(90,2) = ""
arMSSvc(91,0) = "elementmgr" : arMSSvc(91,1) = "elementmgr.exe" : arMSSvc(91,2) = ""
arMSSvc(92,0) = "w3svc" : arMSSvc(92,1) = "svchost.exe" : arMSSvc(92,2) = "iisw3adm.dll"

ElseIf strOS = "W2K" Then

ReDim arMSSvc(66,2)
arMSSvc(0,0) = "alerter" : arMSSvc(0,1) = "services.exe" : arMSSvc(0,2) = ""
arMSSvc(1,0) = "appmgmt" : arMSSvc(1,1) = "services.exe" : arMSSvc(1,2) = ""
arMSSvc(2,0) = "wuauserv" : arMSSvc(2,1) = "svchost.exe" : arMSSvc(2,2) = "wuauserv.dll"
arMSSvc(3,0) = "bits" : arMSSvc(3,1) = "svchost.exe" : arMSSvc(3,2) = "qmgr.dll"
arMSSvc(4,0) = "clipsrv" : arMSSvc(4,1) = "clipsrv.exe" : arMSSvc(4,2) = ""
arMSSvc(5,0) = "eventsystem" : arMSSvc(5,1) = "svchost.exe" : arMSSvc(5,2) = "es.dll"
arMSSvc(6,0) = "browser" : arMSSvc(6,1) = "services.exe" : arMSSvc(6,2) = ""
arMSSvc(7,0) = "dhcp" : arMSSvc(7,1) = "services.exe" : arMSSvc(7,2) = ""
arMSSvc(8,0) = "trkwks" : arMSSvc(8,1) = "services.exe" : arMSSvc(8,2) = ""
arMSSvc(9,0) = "msdtc" : arMSSvc(9,1) = "msdtc.exe" : arMSSvc(9,2) = ""
arMSSvc(10,0) = "dnscache" : arMSSvc(10,1) = "services.exe" : arMSSvc(10,2) = ""
arMSSvc(11,0) = "eventlog" : arMSSvc(11,1) = "services.exe" : arMSSvc(11,2) = ""
arMSSvc(12,0) = "fax" : arMSSvc(12,1) = "faxsvc.exe" : arMSSvc(12,2) = ""
arMSSvc(13,0) = "iisadmin" : arMSSvc(13,1) = "inetinfo.exe" : arMSSvc(13,2) = ""
arMSSvc(14,0) = "cisvc" : arMSSvc(14,1) = "cisvc.exe" : arMSSvc(14,2) = ""
arMSSvc(15,0) = "sharedaccess" : arMSSvc(15,1) = "svchost.exe" : arMSSvc(15,2) = "ipnathlp.dll"
arMSSvc(16,0) = "policyagent" : arMSSvc(16,1) = "lsass.exe" : arMSSvc(16,2) = ""
arMSSvc(17,0) = "dmserver" : arMSSvc(17,1) = "services.exe" : arMSSvc(17,2) = ""
arMSSvc(18,0) = "dmadmin" : arMSSvc(18,1) = "dmadmin.exe" : arMSSvc(18,2) = ""
arMSSvc(19,0) = "messenger" : arMSSvc(19,1) = "services.exe" : arMSSvc(19,2) = ""
arMSSvc(20,0) = "netlogon" : arMSSvc(20,1) = "lsass.exe" : arMSSvc(20,2) = ""
arMSSvc(21,0) = "mnmsrvc" : arMSSvc(21,1) = "mnmsrvc.exe" : arMSSvc(21,2) = ""
arMSSvc(22,0) = "netman" : arMSSvc(22,1) = "svchost.exe" : arMSSvc(22,2) = "netman.dll"
arMSSvc(23,0) = "netdde" : arMSSvc(23,1) = "netdde.exe" : arMSSvc(23,2) = ""
arMSSvc(24,0) = "ntlmssp" : arMSSvc(24,1) = "lsass.exe" : arMSSvc(24,2) = ""
arMSSvc(25,0) = "sysmonlog" : arMSSvc(25,1) = "smlogsvc.exe" : arMSSvc(25,2) = ""
arMSSvc(26,0) = "plugplay" : arMSSvc(26,1) = "services.exe" : arMSSvc(26,2) = ""
arMSSvc(27,0) = "wmdmpmsn" : arMSSvc(27,1) = "svchost.exe" : arMSSvc(27,2) = "mspmsnsv.dll"
arMSSvc(28,0) = "spooler" : arMSSvc(28,1) = "spoolsv.exe" : arMSSvc(28,2) = ""
arMSSvc(29,0) = "protectedstorage" : arMSSvc(29,1) = "services.exe" : arMSSvc(29,2) = ""
arMSSvc(30,0) = "rsvp" : arMSSvc(30,1) = "rsvp.exe" : arMSSvc(30,2) = ""
arMSSvc(31,0) = "rasauto" : arMSSvc(31,1) = "svchost.exe" : arMSSvc(31,2) = "rasauto.dll"
arMSSvc(32,0) = "rasman" : arMSSvc(32,1) = "svchost.exe" : arMSSvc(32,2) = "rasmans.dll"
arMSSvc(33,0) = "rpcss" : arMSSvc(33,1) = "svchost.exe" : arMSSvc(33,2) = "rpcss.dll"
arMSSvc(34,0) = "rpclocator" : arMSSvc(34,1) = "locator.exe" : arMSSvc(34,2) = ""
arMSSvc(35,0) = "remoteregistry" : arMSSvc(35,1) = "regsvc.exe" : arMSSvc(35,2) = ""
arMSSvc(36,0) = "ntmssvc" : arMSSvc(36,1) = "svchost.exe" : arMSSvc(36,2) = "ntmssvc.dll"
arMSSvc(37,0) = "remoteaccess" : arMSSvc(37,1) = "svchost.exe" : arMSSvc(37,2) = "mprdim.dll"
arMSSvc(38,0) = "seclogon" : arMSSvc(38,1) = "services.exe" : arMSSvc(38,2) = ""
arMSSvc(39,0) = "samss" : arMSSvc(39,1) = "lsass.exe" : arMSSvc(39,2) = ""
arMSSvc(40,0) = "lanmanserver" : arMSSvc(40,1) = "services.exe" : arMSSvc(40,2) = ""
arMSSvc(41,0) = "smtpsvc" : arMSSvc(41,1) = "inetinfo.exe" : arMSSvc(41,2) = ""
arMSSvc(42,0) = "scardsvr" : arMSSvc(42,1) = "scardsvr.exe" : arMSSvc(42,2) = ""
arMSSvc(43,0) = "scarddrv" : arMSSvc(43,1) = "scardsvr.exe" : arMSSvc(43,2) = ""
arMSSvc(44,0) = "stisvc" : arMSSvc(44,1) = "stisvc.exe" : arMSSvc(44,2) = ""
arMSSvc(45,0) = "sens" : arMSSvc(45,1) = "svchost.exe" : arMSSvc(45,2) = "sens.dll"
arMSSvc(46,0) = "schedule" : arMSSvc(46,1) = "mstask.exe" : arMSSvc(46,2) = ""
arMSSvc(47,0) = "lmhosts" : arMSSvc(47,1) = "services.exe" : arMSSvc(47,2) = ""
arMSSvc(48,0) = "tapisrv" : arMSSvc(48,1) = "svchost.exe" : arMSSvc(48,2) = "tapisrv.dll"
arMSSvc(49,0) = "tlntsvr" : arMSSvc(49,1) = "tlntsvr.exe" : arMSSvc(49,2) = ""
arMSSvc(50,0) = "ups" : arMSSvc(50,1) = "ups.exe" : arMSSvc(50,2) = ""
arMSSvc(51,0) = "utilman" : arMSSvc(51,1) = "utilman.exe" : arMSSvc(51,2) = ""
arMSSvc(52,0) = "msiserver" : arMSSvc(52,1) = "msiexec.exe" : arMSSvc(52,2) = ""
arMSSvc(53,0) = "winmgmt" : arMSSvc(53,1) = "winmgmt.exe" : arMSSvc(53,2) = ""
arMSSvc(54,0) = "wmi" : arMSSvc(54,1) = "services.exe" : arMSSvc(54,2) = ""
arMSSvc(55,0) = "w32time" : arMSSvc(55,1) = "services.exe" : arMSSvc(55,2) = ""
arMSSvc(56,0) = "wzcsvc" : arMSSvc(56,1) = "svchost.exe" : arMSSvc(56,2) = "wzcsvc.dll"
arMSSvc(57,0) = "lanmanworkstation" : arMSSvc(57,1) = "services.exe" : arMSSvc(57,2) = ""
arMSSvc(58,0) = "w3svc" : arMSSvc(58,1) = "inetinfo.exe" : arMSSvc(58,2) = ""
arMSSvc(59,0) = "wmdm pmsp service" : arMSSvc(59,1) = "mspmspsv.exe" : arMSSvc(59,2) = ""
arMSSvc(60,0) = "msftpsvc" : arMSSvc(60,1) = "inetinfo.exe" : arMSSvc(60,2) = ""
arMSSvc(61,0) = "irmon" : arMSSvc(61,1) = "svchost.exe" : arMSSvc(61,2) = "irmon.dll"

'W2KS
arMSSvc(62,0) = "dhcpServer" : arMSSvc(62,1) = "tcpsvcs.exe" : arMSSvc(62,2) = ""
arMSSvc(63,0) = "dfs" : arMSSvc(63,1) = "dfssvc.exe" : arMSSvc(63,2) = ""
arMSSvc(64,0) = "dns" : arMSSvc(64,1) = "dns.exe" : arMSSvc(64,2) = ""
arMSSvc(65,0) = "ias" : arMSSvc(65,1) = "svchost.exe" : arMSSvc(65,2) = "ias.dll"
arMSSvc(66,0) = "licenseservice" : arMSSvc(66,1) = "llssrv.exe" : arMSSvc(66,2) = ""

ElseIf strOs = "NT4" Then

ReDim arMSSvc(27,2)
arMSSvc(0,0) = "alerter" : arMSSvc(0,1) = "services.exe" : arMSSvc(0,2) = ""
arMSSvc(1,0) = "clipsrv" : arMSSvc(1,1) = "clipsrv.exe" : arMSSvc(1,2) = ""
arMSSvc(2,0) = "eventsystem" : arMSSvc(2,1) = "esserver.exe" : arMSSvc(2,2) = ""
arMSSvc(3,0) = "browser" : arMSSvc(3,1) = "services.exe" : arMSSvc(3,2) = ""
arMSSvc(4,0) = "dhcp" : arMSSvc(4,1) = "services.exe" : arMSSvc(4,2) = ""
arMSSvc(5,0) = "replicator" : arMSSvc(5,1) = "lmrepl.exe" : arMSSvc(5,2) = ""
arMSSvc(6,0) = "eventlog" : arMSSvc(6,1) = "services.exe" : arMSSvc(6,2) = ""
arMSSvc(7,0) = "messenger" : arMSSvc(7,1) = "services.exe" : arMSSvc(7,2) = ""
arMSSvc(8,0) = "netlogon" : arMSSvc(8,1) = "lsass.exe" : arMSSvc(8,2) = ""
arMSSvc(9,0) = "netdde" : arMSSvc(9,1) = "netdde.exe" : arMSSvc(9,2) = ""
arMSSvc(10,0) = "netddedsdm" : arMSSvc(10,1) = "netdde.exe" : arMSSvc(10,2) = ""
arMSSvc(11,0) = "ntlmssp" : arMSSvc(11,1) = "services.exe" : arMSSvc(11,2) = ""
arMSSvc(12,0) = "plugplay" : arMSSvc(12,1) = "services.exe" : arMSSvc(12,2) = ""
arMSSvc(13,0) = "protectedstorage" : arMSSvc(13,1) = "pstores.exe" : arMSSvc(13,2) = ""
arMSSvc(14,0) = "rasauto" : arMSSvc(14,1) = "rasman.exe" : arMSSvc(14,2) = ""
arMSSvc(15,0) = "rasman" : arMSSvc(15,1) = "rasman.exe" : arMSSvc(15,2) = ""
arMSSvc(16,0) = "rpclocator" : arMSSvc(16,1) = "locator.exe" : arMSSvc(16,2) = ""
arMSSvc(17,0) = "rpcss" : arMSSvc(17,1) = "rpcss.exe" : arMSSvc(17,2) = ""
arMSSvc(18,0) = "lanmanserver" : arMSSvc(18,1) = "services.exe" : arMSSvc(18,2) = ""
arMSSvc(19,0) = "spooler" : arMSSvc(19,1) = "spoolss.exe" : arMSSvc(19,2) = ""
arMSSvc(20,0) = "sens" : arMSSvc(20,1) = "sens.exe" : arMSSvc(20,2) = ""
arMSSvc(21,0) = "schedule" : arMSSvc(21,1) = "mstask.exe" : arMSSvc(21,2) = ""
arMSSvc(22,0) = "lmhosts" : arMSSvc(22,1) = "services.exe" : arMSSvc(22,2) = ""
arMSSvc(23,0) = "tapisrv" : arMSSvc(23,1) = "tapisrv.exe" : arMSSvc(23,2) = ""
arMSSvc(24,0) = "ups" : arMSSvc(24,1) = "ups.exe" : arMSSvc(24,2) = ""
arMSSvc(25,0) = "msiserver" : arMSSvc(25,1) = "msiexec.exe" : arMSSvc(25,2) = ""
arMSSvc(26,0) = "winmgmt" : arMSSvc(26,1) = "winmgmt.exe" : arMSSvc(26,2) = ""
arMSSvc(27,0) = "lanmanworkstation" : arMSSvc(27,1) = "services.exe" : arMSSvc(27,2) = ""

ElseIf strOS = "WVA" Then

ReDim arMSSvc(74,2)
arMSSvc(0,0) = "aelookupsvc" : arMSSvc(0,1) = "svchost.exe" : arMSSvc(0,2) = "aelupsvc.dll"
arMSSvc(1,0) = "appinfo" : arMSSvc(1,1) = "svchost.exe" : arMSSvc(1,2) = "appinfo.dll"
arMSSvc(2,0) = "AudioEndpointBuilder" : arMSSvc(2,1) = "svchost.exe" : arMSSvc(2,2) = "Audiosrv.dll"
arMSSvc(3,0) = "Audiosrv" : arMSSvc(3,1) = "svchost.exe" : arMSSvc(3,2) = "Audiosrv.dll"
arMSSvc(4,0) = "BITS" : arMSSvc(4,1) = "svchost.exe" : arMSSvc(4,2) = "qmgr.dll"
arMSSvc(5,0) = "bfe" : arMSSvc(5,1) = "svchost.exe" : arMSSvc(5,2) = "bfe.dll"
arMSSvc(6,0) = "CryptSvc" : arMSSvc(6,1) = "svchost.exe" : arMSSvc(6,2) = "cryptsvc.dll"
arMSSvc(7,0) = "CscService" : arMSSvc(7,1) = "svchost.exe" : arMSSvc(7,2) = "cscsvc.dll"
arMSSvc(8,0) = "DcomLaunch" : arMSSvc(8,1) = "svchost.exe" : arMSSvc(8,2) = "rpcss.dll"
arMSSvc(9,0) = "Dhcp" : arMSSvc(9,1) = "svchost.exe" : arMSSvc(9,2) = "dhcpcsvc.dll"
arMSSvc(10,0) = "Dnscache" : arMSSvc(10,1) = "svchost.exe" : arMSSvc(10,2) = "dnsrslvr.dll"
arMSSvc(11,0) = "dps" : arMSSvc(11,1) = "svchost.exe" : arMSSvc(11,2) = "dps.dll"
arMSSvc(12,0) = "EMDMgmt" : arMSSvc(12,1) = "svchost.exe" : arMSSvc(12,2) = "emdmgmt.dll"
arMSSvc(13,0) = "Eventlog" : arMSSvc(13,1) = "svchost.exe" : arMSSvc(13,2) = "wevtsvc.dll" 'ServiceDll value in main key
arMSSvc(14,0) = "EventSystem" : arMSSvc(14,1) = "svchost.exe" : arMSSvc(14,2) = "es.dll"
arMSSvc(15,0) = "fdphost" : arMSSvc(15,1) = "svchost.exe" : arMSSvc(15,2) = "fdphost.dll"
arMSSvc(16,0) = "gpsvc" : arMSSvc(16,1) = "svchost.exe" : arMSSvc(16,2) = "gpsvc.dll"
arMSSvc(17,0) = "ikeext" : arMSSvc(17,1) = "svchost.exe" : arMSSvc(17,2) = "ikeext.dll"
arMSSvc(18,0) = "iphlpsvc" : arMSSvc(18,1) = "svchost.exe" : arMSSvc(18,2) = "iphlpsvc.dll" 'missing data!
arMSSvc(19,0) = "KtmRm" : arMSSvc(19,1) = "svchost.exe" : arMSSvc(19,2) = "msdtckrm.dll"
arMSSvc(20,0) = "LanmanServer" : arMSSvc(20,1) = "svchost.exe" : arMSSvc(20,2) = "srvsvc.dll"
arMSSvc(21,0) = "LanmanWorkstation" : arMSSvc(21,1) = "svchost.exe" : arMSSvc(21,2) = "wkssvc.dll"
arMSSvc(22,0) = "lmhosts" : arMSSvc(22,1) = "svchost.exe" : arMSSvc(22,2) = "lmhsvc.dll" 'missing data!
arMSSvc(23,0) = "MMCSS" : arMSSvc(23,1) = "svchost.exe" : arMSSvc(23,2) = "mmcss.dll"
arMSSvc(24,0) = "MpsSvc" : arMSSvc(24,1) = "svchost.exe" : arMSSvc(24,2) = "mpssvc.dll"
arMSSvc(25,0) = "Netman" : arMSSvc(25,1) = "svchost.exe" : arMSSvc(25,2) = "netman.dll"
arMSSvc(26,0) = "netprofm" : arMSSvc(26,1) = "svchost.exe" : arMSSvc(26,2) = "netprofm.dll"
arMSSvc(27,0) = "NlaSvc" : arMSSvc(27,1) = "svchost.exe" : arMSSvc(27,2) = "nlasvc.dll"
arMSSvc(28,0) = "nsi" : arMSSvc(28,1) = "svchost.exe" : arMSSvc(28,2) = "nsisvc.dll" 'missing data!
arMSSvc(29,0) = "PcaSvc" : arMSSvc(29,1) = "svchost.exe" : arMSSvc(29,2) = "pcasvc.dll"
arMSSvc(30,0) = "PlugPlay" : arMSSvc(30,1) = "svchost.exe" : arMSSvc(30,2) = "umpnpmgr.dll"
arMSSvc(31,0) = "PolicyAgent" : arMSSvc(31,1) = "svchost.exe" : arMSSvc(31,2) = "ipsecsvc.dll"
arMSSvc(32,0) = "ProfSvc" : arMSSvc(32,1) = "svchost.exe" : arMSSvc(32,2) = "profsvc.dll"
arMSSvc(33,0) = "RasMan" : arMSSvc(33,1) = "svchost.exe" : arMSSvc(33,2) = "rasmans.dll"
arMSSvc(34,0) = "RpcSs" : arMSSvc(34,1) = "svchost.exe" : arMSSvc(34,2) = "rpcss.dll"
arMSSvc(35,0) = "SamSs" : arMSSvc(35,1) = "lsass.exe" : arMSSvc(35,2) = ""
arMSSvc(36,0) = "Schedule" : arMSSvc(36,1) = "svchost.exe" : arMSSvc(36,2) = "schedsvc.dll"
arMSSvc(37,0) = "seclogon" : arMSSvc(37,1) = "svchost.exe" : arMSSvc(37,2) = "seclogon.dll"
arMSSvc(38,0) = "SENS" : arMSSvc(38,1) = "svchost.exe" : arMSSvc(38,2) = "sens.dll"
arMSSvc(39,0) = "ShellHWDetection" : arMSSvc(39,1) = "svchost.exe" : arMSSvc(39,2) = "shsvcs.dll"
arMSSvc(40,0) = "slsvc" : arMSSvc(40,1) = "SLsvc.exe" : arMSSvc(40,2) = ""
arMSSvc(41,0) = "Spooler" : arMSSvc(41,1) = "spoolsv.exe" : arMSSvc(41,2) = ""
arMSSvc(42,0) = "SSDPSRV" : arMSSvc(42,1) = "svchost.exe" : arMSSvc(42,2) = "ssdpsrv.dll"
arMSSvc(43,0) = "SysMain" : arMSSvc(43,1) = "svchost.exe" : arMSSvc(43,2) = "sysmain.dll"
arMSSvc(44,0) = "TabletInputService" : arMSSvc(44,1) = "svchost.exe" : arMSSvc(44,2) = "TabSvc.dll"
arMSSvc(45,0) = "TapiSrv" : arMSSvc(45,1) = "svchost.exe" : arMSSvc(45,2) = "tapisrv.dll"
arMSSvc(46,0) = "TermService" : arMSSvc(46,1) = "svchost.exe" : arMSSvc(46,2) = "termsrv.dll"
arMSSvc(47,0) = "Themes" : arMSSvc(47,1) = "svchost.exe" : arMSSvc(47,2) = "shsvcs.dll"
arMSSvc(48,0) = "THREADORDER" : arMSSvc(48,1) = "svchost.exe" : arMSSvc(48,2) = "mmcss.dll"
arMSSvc(49,0) = "TrkWks" : arMSSvc(49,1) = "svchost.exe" : arMSSvc(49,2) = "trkwks.dll"
arMSSvc(50,0) = "TrustedInstaller" : arMSSvc(50,1) = "TrustedInstaller.exe" : arMSSvc(50,2) = ""
arMSSvc(51,0) = "uxsms" : arMSSvc(51,1) = "svchost.exe" : arMSSvc(51,2) = "uxsms.dll"
arMSSvc(52,0) = "W32Time" : arMSSvc(52,1) = "svchost.exe" : arMSSvc(52,2) = "w32time.dll"
arMSSvc(53,0) = "wdisystemhost" : arMSSvc(53,1) = "svchost.exe" : arMSSvc(53,2) = "wdi.dll"
arMSSvc(54,0) = "WebClient" : arMSSvc(54,1) = "svchost.exe" : arMSSvc(54,2) = "webclnt.dll"
arMSSvc(55,0) = "WerSvc" : arMSSvc(55,1) = "svchost.exe" : arMSSvc(55,2) = "WerSvc.dll"
arMSSvc(56,0) = "WinDefend" : arMSSvc(56,1) = "svchost.exe" : arMSSvc(56,2) = "mpsvc.dll"
arMSSvc(57,0) = "WinHttpAutoProxySvc" : arMSSvc(57,1) = "svchost.exe" : arMSSvc(57,2) = "winhttp.dll"
arMSSvc(58,0) = "Winmgmt" : arMSSvc(58,1) = "svchost.exe" : arMSSvc(58,2) = "WMIsvc.dll"
arMSSvc(59,0) = "WPDBusEnum" : arMSSvc(59,1) = "svchost.exe" : arMSSvc(59,2) = "wpdbusenum.dll"
arMSSvc(60,0) = "wscsvc" : arMSSvc(60,1) = "svchost.exe" : arMSSvc(60,2) = "wscsvc.dll"
arMSSvc(61,0) = "WSearch" : arMSSvc(61,1) = "SearchIndexer.exe" : arMSSvc(61,2) = ""
arMSSvc(62,0) = "wuauserv" : arMSSvc(62,1) = "svchost.exe" : arMSSvc(62,2) = "wuaueng.dll"
arMSSvc(63,0) = "ProtectedStorage" : arMSSvc(63,1) = "lsass.exe" : arMSSvc(63,2) = ""
arMSSvc(64,0) = "NfsClnt" : arMSSvc(64,1) = "nfsclnt.exe" : arMSSvc(64,2) = ""
arMSSvc(65,0) = "IISADMIN" : arMSSvc(65,1) = "inetinfo.exe" : arMSSvc(65,2) = ""
arMSSvc(66,0) = "MSMQ" : arMSSvc(66,1) = "mqsvc.exe" : arMSSvc(66,2) = ""
arMSSvc(67,0) = "MSMQTriggers" : arMSSvc(67,1) = "mqtgsvc.exe" : arMSSvc(67,2) = ""
arMSSvc(68,0) = "iprip" : arMSSvc(68,1) = "svchost.exe" : arMSSvc(68,2) = "iprip.dll"
arMSSvc(69,0) = "SNMP" : arMSSvc(69,1) = "snmp.exe" : arMSSvc(69,2) = ""
arMSSvc(70,0) = "LPDSVC" : arMSSvc(70,1) = "tcpsvcs.exe" : arMSSvc(70,2) = ""
arMSSvc(71,0) = "WAS" : arMSSvc(71,1) = "svchost.exe" : arMSSvc(71,2) = "iisw3adm.dll"
arMSSvc(72,0) = "W3SVC" : arMSSvc(72,1) = "svchost.exe" : arMSSvc(72,2) = "iisw3adm.dll"
arMSSvc(73,0) = "swprv" : arMSSvc(73,1) = "svchost.exe" : arMSSvc(73,2) = "swprv.dll"
arMSSvc(74,0) = "VSS" : arMSSvc(74,1) = "vssvc.exe" : arMSSvc(74,2) = ""

' arMSSvc(75,0) = "" : arMSSvc(75,1) = "svchost.exe" : arMSSvc(75,2) = ""

End If 'filling MS default services array

'Services collection, Service object,
Dim colSvce, oSvce
'lowest-sort name holder, temp variables x 3
Dim intLSS, str1stName, strT0, strT1, strT2
Dim flagSM : flagSM = False 'Safe Mode flag

'for W2K/WXP/WVa, determine if running in Safe Mode
If strOS <> "NT4" Then

strKey = "System\CurrentControlSet\Control"
intErrNum = oReg.GetStringValue (HKLM,strKey,"SystemStartOptions",strValue)
'if name exists
If intErrNum = 0 Then
'check if in Safe Mode
If InStr(LCase(strValue),"safeboot") <> 0 Then flagSM = True
End If

End If 'W2K/WXP/WVa?

'set up title line for normal, ShowAll, Safe Mode operation
strTitle = "Running Services (Display Name, Service Name, Path {Service DLL}):"
If flagShowAll Then strTitle = "All Running Services (Display Name, Service Name, Path {Service DLL}):"
If flagSM Then strTitle = "All Non-Disabled Services (Display Name, " &_
"Service Name, Path {Service DLL}):"

'if in Safe Mode
If flagSM Then

'get collection of services with Auto or Manual "Startup type"
Set colSvce = GetObject("winmgmts:\root\cimv2").ExecQuery("SELECT DisplayName, " &_
"Name, PathName FROM Win32_Service WHERE StartMode = ""Manual"" " &_
"Or StartMode = ""Auto""")

'not in Safe Mode
Else

'get collection of started services
Set colSvce = GetObject("winmgmts:\root\cimv2").ExecQuery("SELECT DisplayName, " &_
"Name, PathName FROM Win32_Service WHERE Started = True")

End If 'safe mode?

'sort services by display name

'get the count
On Error Resume Next
intCnt = colSvce.Count
intErrNum = Err.Number : Err.Clear
On Error Goto 0

'output warning and exit if count impeded
If intErrNum <> 0 Then
flagIWarn = True
TitleLineWrite
oFN.WriteLine vbCRLF & IWarn &_
"The running services cannot be counted." & vbCRLF &_
"Presence of a spyware service is suspected." & vbCRLF &_
"The script has been forced to exit."
SRClose
WScript.Quit
End If

'set up two arrays: work array & sorted array
Dim arSvces()
ReDim arSvces(intCnt-1, 2) 'services array

i = 0

'transfer data from collection to array
For Each oSvce in colSvce

arSvces(i,0) = oSvce.DisplayName : arSvces(i,1) = oSvce.Name

'check for null values or empty strings returned by WMI
If IsNull(oSvce.PathName) Then
arSvces(i,2) = "(null value)"
ElseIf oSvce.PathName = "" Then
arSvces(i,2) = "(empty string)"
Else
arSvces(i,2) = oSvce.PathName
End If

i = i + 1

Next 'service in collection

Set colSvce=Nothing

'for every service in array up to the next to last one
For i = 0 To UBound(arSvces,1) - 1

'store array row in temp variables
strT0 = arSvces(i,0)
strT1 = arSvces(i,1)
strT2 = arSvces(i,2)

'initialize the sorted name & lowest-sort subscript
str1stName = arSvces(i,0)
intLSS = i

'for every subsequent service in array up to the last one
For j = i + 1 To UBound(arSvces,1)

'if current array name < saved lowest-sort name,
'reset sorted array data and
'set lowest-sort subscript = current array subscript
If LCase(arSvces(j,0)) < LCase(str1stName) Then
str1stName = arSvces(j,0)
intLSS = j
End If

Next 'j array element

'set current array position = lowest-sort subscript element
arSvces(i,0) = arSvces(intLSS,0)
arSvces(i,1) = arSvces(intLSS,1)
arSvces(i,2) = arSvces(intLSS,2)
'save data formerly in current array position to array position just vacated
arSvces(intLSS,0) = strT0
arSvces(intLSS,1) = strT1
arSvces(intLSS,2) = strT2

Next 'i sorted name array element

'for every service sorted by display name
For i = 0 To UBound(arSvces,1)

'format path name for output
If arSvces(i,2) = "(null value)" Then
strPathNameOut = "(null value)"
ElseIf arSvces(i,2) = "(empty string)" Then
strPathNameOut = "(empty string)"
Else
strPathNameOut = StringFilter(arSvces(i,2),True)
End If

intMSSvcNo = -1 'assume not an MS Service

'find company name
strCN = CoName(IDExe(arSvces(i,2)))

'if service name found in MS default services array, save array subscript
For j = 0 To UBound(arMSSvc,1)
If LCase(arSvces(i,1)) = LCase(arMSSvc(j,0)) Then
intMSSvcNo = j : Exit For
End If
Next 'arMSSvc (MS Service)

'for services with unique file names
If InStr(LCase(arSvces(i,2)),"services.exe") = 0 And _
InStr(LCase(arSvces(i,2)),"svchost") = 0 Then

'find last backslash in service executable path
intLBSP = InStrRev(arSvces(i,2),"\")
'set position to 0 if no backslash present
If IsNull(intLBSP) Then intLBSP = 0
'extract service executable
strExeName = Mid(IDExe(arSvces(i,2)),intLBSP+1)

'if not MS default service Or ShowAll
If intMSSvcNo < 0 Or flagShowAll Then

If strTitle <> "" Then
TitleLineWrite : oFN.WriteBlankLines (1)
End If

'output display name, service name, path
oFN.WriteLine StringFilter(arSvces(i,0),False) & ", " &_
StringFilter(arSvces(i,1),False) & ", " &_
strPathNameOut & strCN

'if MS default service And (executable name or CoName doesn't match expected value)
ElseIf intMSSvcNo >= 0 And _
(LCase(strExeName) <> LCase(arMSSvc(intMSSvcNo,1)) Or _
strCN <> MS) Then

If strTitle <> "" Then
TitleLineWrite : oFN.WriteBlankLines (1)
End If

'output display name, service name, path
oFN.WriteLine StringFilter(arSvces(i,0),False) & ", " &_
StringFilter(arSvces(i,1),False) & ", " &_
strPathNameOut & strCN

End If 'MS default service with unexpected executable/CoName?

'shared process -- look for ServiceDLL value in Parameter subkey
ElseIf InStr(LCase(arSvces(i,2)),"svchost") > 0 And _
InStr(LCase(arSvces(i,2))," -k") > 0 Then

strKey = "System\CurrentControlSet\Services\"
intErrNum = oReg.GetExpandedStringValue (HKLM,strKey & arSvces(i,1) &_
"\Parameters","ServiceDll",strValue)

'prepare output for missing Parameters key or ServiceDLL value
strLine = " {(missing data)}"
strCN = CoName(IDExe(strValue))

If intErrNum = 0 And strValue <> "" Then

strLine = " {" & Chr(34) & strValue & Chr(34) & strCN & "}"

'find last backslash in ServiceDLL
intLBSP = InStrRev(strValue,"\")
'set position to 0 if no backslash present
If IsNull(intLBSP) Then intLBSP = 0
'extract ServiceDLL
strDLL = Mid(IDExe(strValue),intLBSP+1)

flagMatch = True
'if ShowAll Or DLL name/CoName have unexpected values
If flagShowAll Or LCase(strCN) <> " [ms]" Or intMSSvcNo = -1 Then
flagMatch = False
ElseIf LCase(strDLL) <> LCase(arMSSvc(intMSSvcNo,2)) Then
flagMatch = False
End If

If Not flagMatch Then

If strTitle <> "" Then
TitleLineWrite : oFN.WriteBlankLines (1)
End If

'output display name, service name, path
oFN.WriteLine StringFilter(arSvces(i,0),False) & ", " &_
StringFilter(arSvces(i,1),False) & ", " &_
strPathNameOut & strLine

End If 'flagMatch?

Else 'ServiceDll not available

If strTitle <> "" Then
TitleLineWrite : oFN.WriteBlankLines (1)
End If

oFN.WriteLine StringFilter(arSvces(i,0),False) & ", " &_
StringFilter(arSvces(i,1),False) & ", " &_
strPathNameOut & strLine

End If 'Parameters\ServiceDll exists

'services.exe
Else

'find last backslash in ServiceDLL
intLBSP = InStrRev(arSvces(i,2),"\")
'set position to 0 if no backslash present
If IsNull(intLBSP) Then intLBSP = 0
'extract service executable
strExeName = Mid(IDExe(arSvces(i,2)),intLBSP+1)

flagMatch = True
'if ShowAll Or service name <> Services.exe or CoName <> MS
If flagShowAll Or LCase(strCN) <> " [ms]" Or intMSSvcNo = -1 Then
flagMatch = False
ElseIf LCase(strExeName) <> LCase(arMSSvc(intMSSvcNo,1)) Then
flagMatch = False
End If

If Not flagMatch Then
If strTitle <> "" Then
TitleLineWrite : oFN.WriteBlankLines (1)
End If

'output display name, service name, path
oFN.WriteLine StringFilter(arSvces(i,0),False) & ", " &_
StringFilter(arSvces(i,1),False) & ", " &_
strPathNameOut & strCN
End If

End If 'independent file, svchost, or services?

Next 'service file

'recover array memory
ReDim arSvces(0,0)
ReDim arMSSvc(0,0)

End If 'NT4-type O/S?

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

End If 'SecTest?




'#27. Keyboard Driver Filters

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

'prepare title line
strTitle = "Keyboard Driver Filters:"

Dim arValue() 'multi-string value
strOut = "" 'empty output string
flagInfect = False

'for W2K/WXP/WVa
If strOS = "W2K" Or strOS = "WXP" Or strOS = "WVA" Then

strKey = "System\CurrentControlSet\Control\Class\{4D36E96B-E325-11CE-BFC1-08002BE10318}"
intErrNum = oReg.GetMultiStringValue (HKLM,strKey,"UpperFilters",arValue)

'if value exists
If intErrNum = 0 And IsArray(arValue) Then

'if array is not empty
If UBound(arValue) >= 0 Then

'for every UpperFilter
For i = 0 To UBound(arValue)

'if not default value
If LCase(Trim(arValue(i))) <> "kbdclass" Then

'toggle infection flag
flagInfect = True : flagIWarn = True

'if no extension, look in Drivers
If Fso.GetExtensionName(arValue(i)) = "" Then
strCN = CoName(strFPSF & "\Drivers\" & arValue(i) & ".sys")
Else 'use IDExe for CoName
strCN = CoName(IDExe(arValue(i)))
End If 'extension?

'if output string not empty, use leading comma
If strOut <> "" Then
strOut = strOut & ", " & IWarn & DQ & arValue(i) & DQ & strCN
Else 'skip leading comma if output string empty
strOut = IWarn & DQ & arValue(i) & DQ & strCN
End If

'set up output for ShowAll
ElseIf flagShowAll Then

'if no extension, look in Drivers
If Fso.GetExtensionName(arValue(i)) = "" Then
strCN = CoName(strFPSF & "\Drivers\" & arValue(i) & ".sys")
Else 'use IDExe for CoName
strCN = CoName(IDExe(arValue(i)))
End If 'extension?

'if output string not empty, use leading comma
If strOut <> "" Then
strOut = strOut & ", " & Chr(34) & arValue(i) & Chr(34) & strCN
Else 'skip leading comma if output string empty
strOut = Chr(34) & arValue(i) & Chr(34) & strCN
End If

End If 'kbdclass Or flagShowAll?

Next 'multi-string value element

'output if necessary
If flagInfect Or flagShowAll Then

TitleLineWrite
oFN.WriteLine vbCRLF & "HKLM\" & strKey & "\" & vbCRLF & Chr(34) &_
"UpperFilters" & Chr(34) & " = " & strOut

End If 'output necessary?

End If 'arValue empty?

Else 'arValue not returned

If flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & "HKLM\" & strKey & "\" & vbCRLF & Chr(34) &_
"UpperFilters" & Chr(34) & " = (value not found)"
End If

End If 'arValue returned?

'recover array memory
ReDim arValue(0)

End If 'W2K/WXP/WVa?

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

End If 'SecTest?




'#28. Print Monitors

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)
If Not flagTest Or (flagTest And SecTest) Then

Dim arPMon(), intMSPMonNo
'assume monitor drivers don't exist
Dim flagMonDrvExist : flagMonDrvExist = False

If strOS = "NT4" Then
ReDim arPMon(1,1)
arPMon(0,0) = "Local Port" : arPMon(0,1) = "localmon.dll"
arPMon(1,0) = "PJL Language Monitor" : arPMon(1,1) = "pjlmon.dll"
ElseIf strOS = "W2K" Or strOS = "WXP" Then
ReDim arPMon(5,1)
arPMon(0,0) = "BJ Language Monitor" : arPMon(0,1) = "cnbjmon.dll"
arPMon(1,0) = "Local Port" : arPMon(1,1) = "localspl.dll"
arPMon(2,0) = "PJL Language Monitor" : arPMon(2,1) = "pjlmon.dll"
arPMon(3,0) = "Standard TCP/IP Port" : arPMon(3,1) = "tcpmon.dll"
arPMon(4,0) = "USB Monitor" : arPMon(4,1) = "usbmon.dll"
arPMon(5,0) = "Windows NT Fax Monitor" : arPMon(5,1) = "msfaxmon.dll"
ElseIf strOS = "WVA" Then
ReDim arPMon(5,1)
arPMon(0,0) = "Local Port" : arPMon(0,1) = "localspl.dll"
arPMon(1,0) = "Microsoft Shared Fax Monitor" : arPMon(1,1) = "FXSMON.DLL"
arPMon(2,0) = "Standard TCP/IP Port" : arPMon(2,1) = "tcpmon.dll"
arPMon(3,0) = "USB Monitor" : arPMon(3,1) = "usbmon.dll"
arPMon(4,0) = "WSD Port" : arPMon(4,1) = "WSDMon.dll"
arPMon(5,0) = "LPR Port" : arPMon(5,1) = "lprmon.dll"
ElseIf strOS = "WME" Then
ReDim arPMon(0,1)
arPMon(0,0) = "usbmon" : arPMon(0,1) = "usbmon.dll"
End If

strTitle = "Print Monitors:"
strKey = "System\CurrentControlSet\Control\Print\Monitors"
strSubTitle = "HKLM" & "\" & strKey & "\"

'find all the subkeys
oReg.EnumKey HKLM, strKey, arSubKeys

'enumerate data if present
If IsArray(arSubKeys) Then

'for each key
For Each strSubKey In arSubKeys

'set default values
intMSPMonNo = -1 : strCN = "" : flagAllow = False

'get the driver value
intErrNum = oReg.GetStringValue (HKLM,strKey & "\" & strSubKey,"Driver",strValue)

'if the driver value exists (exc for W2K!)
If intErrNum = 0 And strValue <> "" Then

flagMonDrvExist = True 'monitor drivers exist

'check for allowed values
If strOS <> "W98" Then

'set intMSPMonNo if subkey name & drive name are on approved list
For j = 0 To UBound(arPMon,1)
If LCase(strSubKey) = LCase(arPMon(j,0)) And _
LCase(strValue) = LCase(arPMon(j,1)) Then
intMSPMonNo = j : Exit For
End If

Next 'arPMon

End If 'strOS?

'find CoName
strCN = CoName(IDExe(strValue))

'toggle flag if subkey name/driver name/CoName OK
If intMSPMonNo >= 0 And strCN = MS Then flagAllow = True

'output if driver unapproved or showall
If Not flagAllow Or flagShowAll Then

TitleLineWrite

'output the quote-delimited names and values
On Error Resume Next
oFN.WriteLine StringFilter(strSubKey,False) & "\Driver = " &_
Chr(34) & strValue & Chr(34) & strCN
intErrNum = Err.Number : Err.Clear
On Error Goto 0
If intErrNum <> 0 Then oFN.WriteLine StringFilter(strSubKey,False) &_
"\Driver = (value not set)"

End If 'output?

End If 'driver value exists?

Next 'Monitors subkey

End If 'no Monitors subkeys found

If Not flagMonDrvExist And flagShowAll Then
strSubTitle = strSubTitle & vbCRLF & "(no drivers found)"
TitleLineWrite
End If

strTitle = "" : strSubTitle = "" : strSubSubTitle = ""

'recover array memory
ReDim arSubKeys(0)
ReDim arPMon(0,0)

End If 'SecTest?


'run closing sub
SRClose


'clean up
Set oReg=Nothing
Set Fso=Nothing
Set Wshso=Nothing




Sub SRClose

'find the number of seconds spent replying to popups
Dim datPUBsec : datPUBsec = datPUB1 + datPUB2
'find the words for the message box duration
Dim strPUBSec
Dim strOut
If flagShowAll Or flagSupp Or flagOut = "C" Then
strPUBsec = ""
ElseIf datPUBsec < 2 Then
strPUBsec = ", including " & datPUBsec & " second for message boxes"
Else
strPUBsec = ", including " & datPUBsec & " seconds for message boxes"
End if

'form the run time phrase
Dim strRunTime : strRunTime = " (total run time: " &_
DateDiff("s",datLaunch,Now) & " seconds" & strPUBsec & ")"
Dim intClosePUBSec 'script close announcement popup display seconds

Dim strBody : strBody = ""
Dim strSpacer : strSpacer = vbCRLF
Dim strHeader : strHeader = vbCRLF & vbCRLF & String(10,"-")
Dim strFooter : strFooter = vbCRLF & String(10,"-") &_
strRunTime

'explain <<!>> & <<H>> symbols if present
'precede HWarn symbol by new line if IWarn also present
If flagIWarn And flagHWarn Then strSpacer = ""

If flagIWarn Then strBody = strBody & vbCRLF & "<<!>>: " &_
"Suspicious data at a malware launch point." & vbCRLF

If flagHWarn Then strBody = strBody & strSpacer & "<<H>>: " &_
"Suspicious data at a browser hijack point." & vbCRLF

If Not flagShowAll Then
strBody = strBody &_
vbCRLF & "+ This report excludes default entries except where indicated." &_
vbCRLF & "+ To see *everywhere* the script checks and *everything* it finds," &_
vbCRLF & " launch it from a command prompt or a shortcut with the -all parameter."
If Not flagSupp Then
strBody = strBody &_
vbCRLF & "+ To search all directories of local fixed drives for DESKTOP.INI" &_
vbCRLF & " DLL launch points, use the -supp parameter or answer " & DQ & "No" & DQ &_
" at the" & vbCRLF & " first message box and " & DQ & "Yes" & DQ &_
" at the second message box."
Else 'flagSupp=True
strBody = strBody &_
vbCRLF & "+ The search for DESKTOP.INI DLL launch points on all local fixed drives" &_
vbCRLF & " took " & strDTITime & "."
End If
Else 'flagShowAll=True
strHeader = vbCRLF & vbCRLF & "--" & strRunTime : strFooter = ""
End If

oFN.WriteLine strHeader & strBody & strFooter

oFN.Close : Set oFN=Nothing

'inform user that script is complete
If flagOut = "W" Then

intClosePUBSec = 20 : If flagTest Then intClosePUBSec = 1

'include path if report file directory specified via cmd-line parameter
If flagDirArg Then

strOut = "All Done! The results are in the file:" & vbCRLF & vbCRLF &_
strFN

Else 'directory not specified via cmd-line parameter

strOut = "All Done! The results are in the file:" & vbCRLF & vbCRLF &_
strFNNP & vbCRLF & vbCRLF & "This file is in the same directory as the script."

End if 'report file path?

Wshso.PopUp strOut,intClosePUBSec,"Silent Runners R" & strRevNo & " Complete", _
vbOKOnly + vbInformation + vbSystemModal

Else 'console output

'include path if report file directory specified via cmd-line parameter
If flagDirArg Then

strOut = "Silent Runners R" & strRevNo & " is done! The results " &_
"are in the file:" & vbCRLF & vbCRLF & strFN

Else 'directory not specified via cmd-line parameter

strOut = "Silent Runners R" & strRevNo & " is done! The results " &_
"are in the file:" & vbCRLF & vbCRLF & strFNNP & vbCRLF & vbCRLF &_
"This file is in the same directory as the script."

End If 'report file path?

WScript.Echo strOut

End If 'flagout?

End Sub




'YYYY-MM-DD
Function FmtDate (datIn)

FmtDate = Year(datIn) & "-" & Right("0" & Month(datIn),2) & "-" &_
Right("0" & Day(datIn),2)

End Function




'hh.mm.ss
Function FmtHMS (datIn)

FmtHMS = Right("0" & Hour(datIn),2) & "." & Right("0" & Minute(datIn),2) &_
"." & Right("0" & Second(datIn),2)

End Function




'enumerate Name/Value Pairs
Sub EnumNVP (hexHive,strRunKey,arNames,arType)

Dim intUB, intErrNum, i

flagNVP = False

'find all the names in the key
oReg.EnumValues hexHive, strRunKey, arNames, arType

'excludes W2K/WXP/WVa with no name/value pairs
If IsArray(arNames) Then

'try to get array UBound
On Error Resume Next
intUB = UBound(arNames)
intErrNum = Err.Number : Err.Clear
On Error Goto 0

'excludes WS2K3 with no name/value pairs
If intErrNum = 0 Then

'excludes W98/WMe/NT4 with no name/value pairs
If intUB >= 0 Then flagNVP = True

End If 'UBound exists?

End If 'names array exists?

End Sub




'return Name given value Type
Function RtnValue (hexHive, strKey, strName, intType)

'value as string/integer/array, counter, string variable, error number
Dim strFValue, intFValue, arFValue, i, strFMsg, intFErrNum

Select Case intType

'string value
Case REG_SZ

'return the string-type value
oReg.GetStringValue hexHive,strKey,strName,strFValue
If IsNull(strFValue) Then strFValue = "(null value)"
If strFValue = "" Then strFValue = "(empty string)"
RtnValue = strFValue

'expandable-string value
Case REG_EXPAND_SZ

'return the expanded string-type value
oReg.GetExpandedStringValue hexHive,strKey,strName,strFValue
If IsNull(strFValue) Then strFValue = "(null value)"
If strFValue = "" Then strFValue = "(empty string)"
RtnValue = strFValue

'binary value
Case REG_BINARY

'return the binary-type value as array
intFErrNum = oReg.GetBinaryValue (hexHive,strKey,strName,arFValue)

If intFErrNum = 0 And IsArray(arFValue) Then

'delimit every two-bytes by space
strFMsg = ""
For i = 0 To UBound(arFValue)
strFMsg = strFMsg & Right("00" & CStr(Hex(arFValue(i))),2) & " "
Next
strFMsg = "hex:" & RTrim(strFMsg)

RtnValue = strFMsg

Else

RtnValue = "(value not set)"

End If 'value array exists?

'4-byte (32-bit) value
Case REG_DWORD

'return the DWORD-type value
oReg.GetDWORDValue hexHive,strKey,strName,intFValue
RtnValue = "hex:0x" & Right("00000000" & CStr(Hex(intFValue)),8)

'multiple-string value
Case REG_MULTI_SZ

'return the multiple-string-type value
intFErrNum = oReg.GetMultiStringValue (hexHive,strKey,strName,arFValue)

If intFErrNum = 0 And IsArray(arFValue) Then

'delimit every quote-enclosed string by "|"
strFMsg = ""
For i = 0 To UBound(arFValue)
strFMsg = strFMsg & DQ & arFValue(i) & DQ & "|"
Next

strFMsg = Left(strFMsg,Len(strFMsg)-1) 'lop off trailing "|"
RtnValue = strFMsg

Else

RtnValue = "(value not set)"

End If 'value array exists?

'8-byte (64-bit) value
Case REG_QWORD

'return the QWORD-type value
oReg.GetQWORDValue hexHive,strKey,strName,intFValue
RtnValue = "hex:0x" & Right("0000000000000000" & CStr(Hex(intFValue)),16)


Case Else

'admit we don't know what it is
RtnValue = "(unknown data type)"

End Select 'data type

End Function




'return Type as string given Type as integer
Function RtnType (intType)

Select Case intType

'string value
Case REG_SZ

RtnType = "REG_SZ"

'expandable-string value
Case REG_EXPAND_SZ

RtnType = "REG_EXPAND_SZ"

'binary value
Case REG_BINARY

RtnType = "REG_BINARY"

'4-byte value
Case REG_DWORD

RtnType = "REG_DWORD"

'multiple-string-type value
Case REG_MULTI_SZ

RtnType = "REG_MULTI_SZ"

Case REG_QWORD

RtnType = "REG_QWORD"

'any other type
Case Else

RtnType = "(unknown data type)"

End Select

End Function




'write name/value pair to file
Function WriteValueData (strName, strValue, intType, strWarn)

Dim strOQEC 'Optionally Quote-Enclosed Comment"

'enclose REG_SZ strings in quotes and append CoName,
If intType = REG_SZ Then
strOQEC = StringFilter(strValue,True) & CoName(IDExe(strValue))
ElseIf intType = REG_EXPAND_SZ Then
strOQEC = StringFilter(strValue,True)
Else
strOQEC = strValue
End If

'output the quote-delimited name and value
If strName = "" Then
oFN.WriteLine strWarn & DQ & "(Default)" & DQ & " = " & strOQEC
Else 'name is non-empty string
oFN.WriteLine strWarn & StringFilter(strName,True) & " = " & strOQEC
End If

End Function




'output registry name/value if value <> ref
Function RegDataChk (cHive, strKey, strName, strValue, strRef)

Dim strHive, strValWrk
Dim strWarn : strWarn = ""
Dim strCoName : strCoName = ""
Dim strQVal : strQVal = ""
Dim intErrNum, intErrNum1

If cHive = HKCU Then strHive = "HKCU"
If cHive = HKLM Then strHive = "HKLM"

intErrNum = oReg.GetStringValue (cHive,strKey,strName,strValue)

'if name exists And value set (exc for W2K!)
If intErrNum = 0 And strValue <> "" Then

'store work value
strValWrk = Trim(LCase(strValue))

'fill warning if necessary
If strValWrk <> LCase(strRef) Then
strWarn = IWarn : flagIWarn = True
End If

'output if value <> reference Or ShowAll
If (strValWrk <> LCase(strRef)) Or flagShowAll Then

'output title lines if not already done
TitleLineWrite

'if value <> reference, parse load/run/shell lines to set up output strings
If (strValWrk <> LCase(strRef)) And _
(LCase(strName) = "load" Or LCase(strName) = "run" Or _
LCase(strName) = "shell") Then

strCoName = LRParse(strValue)
strQVal = DQ & strValue & DQ & strCoName

'if any other value not empty, set up output strings
ElseIf strValue <> "" Then

strCoName = CoName(IDExe(strValue))
strQVal = Chr(34) & strValue & Chr(34) & strCoName

End If

'write name and value to file
On Error Resume Next
oFN.WriteLine strWarn & DQ & strName & DQ &_
" = " & strQVal
intErrNum1 = Err.Number : Err.Clear
On Error Goto 0
If intErrNum1 <> 0 Then oFN.WriteLine DQ & strName & DQ &_
" = (value not set)"

End If 'value <> reference Or ShowAll

ElseIf intErrNum = 0 And strValue = "" Then 'name exists And value empty (exc for W2K!)

'output title lines & key & value names if ShowAll
If flagShowAll Then
TitleLineWrite
oFN.WriteLine DQ & strName & DQ & " = (empty string)"
End If

Else 'name/value pair doesn't exist

'output title lines & key & value names if ShowAll
If flagShowAll Then
TitleLineWrite
oFN.WriteLine DQ & strName & DQ & " = (value not found)"
End If

End If 'value exists

End Function




'set NoDriveTypeAutoRun flag
Function NDTAR (cHive, flagValueExists, flagFDEnabled)

'DWORD or BINARY value, binary value array
Dim hVal, arBVal

strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer"

'if cHive NoDriveTypeAutoRun DWORD value exists
If oReg.GetDWORDValue(cHive,strKey,"NoDriveTypeAutoRun",hVal) = 0 Then

flagValueExists = True

'if autorun for fixed drives is disabled, set flag
If (hVal And 8) = 8 Then flagFDEnabled = False

'if cHive NoDriveTypeAutoRun BINARY value exists
ElseIf oReg.GetBinaryValue(cHive,strKey,"NoDriveTypeAutoRun",arBVal) = 0 Then

'UBound = -1 if value not set (zero-length binary value)
If UBound(arBVal) = -1 Then

'if O/S = W2K/WXP SP0/1, "value not set" interpreted by O/S as
'0 for NDTAR instead of null!
If strOS = "W2K" Or strOS = "WXP" Then
flagValueExists = True
End If 'W2K/WXP?

Else 'UBound <> -1, so value set

flagValueExists = True : hVal = 0

'binary value retrieved as array in increments of 16^2
For i = 0 To UBound(arBVal)
hVal = hVal + arBVal(i) * 256^i
Next

'if autorun for fixed drives is disabled, set flag
If (hVal And 8) = 8 Then flagFDEnabled = False

End If 'UBound = -1?

End If 'NoDriveTypeAutoRun value exists?

End Function




'detect if autorun disabled for individual drives
Function NDAR (cHive, flagValueExists)

'DWORD or BINARY value, binary value array
Dim hVal, arBVal

strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer"

'if cHive NoDriveAutoRun DWORD value exists
If oReg.GetDWORDValue(cHive,strKey,"NoDriveAutoRun",hVal) = 0 Then

flagValueExists = True

'for every fixed disk
For i = 0 To UBound(arFixedDisks,2)

'if autorun for fixed drive is disabled, set flag
If (hVal And arFixedDisks(1,i)) = arFixedDisks(1,i) Then

arFixedDisks(2,i) = False

End If 'autorun disabled for this drive?

Next 'fixed disk

'if cHive NoDriveAutoRun BINARY value exists
ElseIf oReg.GetBinaryValue(cHive,strKey,"NoDriveAutoRun",arBVal) = 0 Then

'UBound = -1 if value not set (zero-length binary value)
If UBound(arBVal) = -1 Then

'if O/S = W2K/WXP SP0/1, "value not set" interpreted by O/S as
'0 instead of null!
If strOS = "W2K" Or strOS = "WXP" Then

flagValueExists = True

'set all NDAR flags to True
For i = 0 To UBound(arFixedDisks,2)
arFixedDisks(2,i) = True
Next

End If 'W2K/WXP?

Else 'UBound <> -1, so value set

flagValueExists = True

hVal = 0

'binary value retrieved as array in increments of 16^2
For i = 0 To UBound(arBVal)
hVal = hVal + arBVal(i) * 256^i
Next

'for every fixed disk
For i = 0 To UBound(arFixedDisks,2)

'if autorun for the fixed disk is disabled, set flag
If (hVal And arFixedDisks(1,i)) = arFixedDisks(1,i) Then

arFixedDisks(2,i) = False

End If 'autorun disabled for fixed disk?

Next 'fixed disk

End If 'hive NoDriveAutoRun value set?

End If 'hive NoDriveAutoRun value exists?

End Function




'INI/INF-file parser
Function IniInfParse (strInput, strVerb, strEquiv, strDisk)

Dim strOutput 'report line
Dim strWarn : strWarn = "" 'warning string
Dim strExe : strExe = "" 'executable after "="
Dim strLFN : strLFN = "" 'screen saver LFN
Dim intEqu

'if verb is first non-space chars (if line is populated)
If Left(LCase(LTrim(strInput)),Len(strVerb)) = strVerb Then

'find pos'n of equals sign
intEqu = InStr(strInput,"=")

'find executable statement after equals sign
strExe = Trim(Mid(strInput,intEqu+1))

'if chrs to right of equals sign different from argument or ShowAll
If (LCase(strExe) <> strEquiv) Or flagShowAll Then

'fill warning string if chrs to right of equals sign different from argument
If LCase(strExe) <> strEquiv And strEquiv <> "anything" Then
strWarn = IWarn : flagIWarn = True
End If

'concatenate line for load or run
If LCase(strVerb) = "load" Or LCase(strVerb) = "run" Then

strOutput = strWarn & Chr(34) & strInput & Chr(34) & LRParse(strExe)

'concatenate line for open or shellexecute
ElseIf LCase(strVerb) = "open" Or LCase(strVerb) = "shellexecute" Then

strOutput = strWarn & strDisk & "\AUTORUN.INF -> " &_
Chr(34) & strInput & Chr(34) & CoName(IDExe(strDisk & "\" & strExe))

'if screensaver = None then no line exists in INI-file
'if flagShowAll, nothing will be written since no line exists
ElseIf LCase(strVerb) = "scrnsave.exe" Then

'get screen saver LFN if file exists
If Fso.FileExists(strExe) Then

'create (but don't save) shortcut
Dim oSC : Set oSC = Wshso.CreateShortcut("getLFN.lnk")
'set & retrieve target path
oSC.TargetPath = strExe
strLFN = Fso.GetFile(oSC.TargetPath).Name
Set oSC=Nothing

'set up LFN string if SFN <> LFN
If LCase(strLFN) = LCase(Fso.GetFileName(strExe)) Then
strLFN = ""
Else
strLFN = " (" & strLFN & ")"
End If

End If 'screen saver file exists?

strOutput = strWarn & Chr(34) & strInput & Chr(34) & strLFN &_
CoName(IDExe(strExe))

'concatenate line for all other verbs
Else

strOutput = strWarn & Chr(34) & strInput & Chr(34) & LRParse(strExe)

End If 'load/run, open/shellexecute, scrnsave.exe, other?

TitleLineWrite : oFN.WriteLine strOutput

End If 'verb populated?

End If 'line populated

End Function




'trim the parameters from a string to isolate the executable and
'then locate the executable on the hard disk
Function IDExe (strPath)

'check for empty string
If IsNull(strPath) Or strPath = "" Then
IDExe = "file not found" : Exit Function
End If

'work path: trimmed, lower case, expanded env strings
Dim strPWk : strPWk = Trim(LCase(Wshso.ExpandEnvironmentStrings(strPath)))

Dim intFS 'forward slash pos'n

'check for "res://"
If Left(strPWk,6) = "res://" Then

'look for forword slash after "res://"
intFS = InStr(7,strPWk,"/",1)
'if no trailing fs, annex one's position at end of string
If intFS = 0 Then intFS = Len(strPWk) + 1
'extract string between "res://" and trailing fs
strPWk = Mid(strPWk,7,intFS-7)

End If 'string starts with "res://"?

If Fso.FileExists(strPWk) Then
IDExe = Fso.GetFile(strPWk).Path : Exit Function
End If 'as-is?

'dissect input string

'work path & TmpExe strings, loc'n of decimal pt, second quote, backslash, counter
Dim strTEx, intDP, int2Q, intBS, i
Dim flagFileFound : flagFileFound = False 'TRUE if file found in called function
Dim flagSpaceExists : flagSpaceExists = True 'FALSE if no space in work path
'Executable Extension array
Dim arExeExt : arExeExt = Array (".exe", ".com", ".cmd", ".bat", ".pif")

'look for leading double quote, embedded " /", " """ (parameter prefixes)
If Left(strPWk,1) = Chr(34) Then
'if find it, then look for second quote
int2Q = InStr(2, strPWk, """")
'if find it, reset the path string to what was between the quotes
If int2Q > 0 Then strPWk = Trim(Mid(strPWk, 2, int2Q - 2))
'look for embedded " /"
ElseIf InStr(strPWk," /") > 0 Then
'if find it, reset the path string
strPWk = Trim(Mid(strPWk,1,InStr(strPWk," /")-1))
'look for embedded space + double quote
ElseIf InStr(strPWk," """) > 0 Then
'if find it, reset the path string
strPWk = Trim(Mid(strPWk,1,InStr(strPWk," """)-1))
End If

Do While flagSpaceExists

'look for trailing dot & backslash
intDP = InStrRev(strPWk,".")
intBS = InStrRev(strPWk,"\")

'if dot found And dot after backslash And string contains extension
If (intDP > 0) And (intDP > intBS) And (intDP < Len(strPWk)) Then

'look for entire string on hard disk
strTEx = WSL(strPWk, flagFileFound)

'if found, return it
If flagFileFound Then
IDExe = strTEx : Exit Function
End if

Else 'either dot not found Or dot in string Or string has no extension

'try adding executable extension
For i = 0 To UBound(arExeExt)

'look for string on hard disk
strTEx = WSL(strPWk & arExeExt(i), flagFileFound)

'if found, return it with executable extension appended
If flagFileFound Then
IDExe = strTEx : Exit Function
End if

Next 'executable extension

End If 'dot found And dot after BS And string has extension?

'trim chrs after space
If InStrRev(strPWk," ") = 0 Then
flagSpaceExists = False
Else
strPWk = Trim(Left(strPWk,InStrRev(strPWk," ") - 1))
End If

Loop 'flagSpaceExists

'last chance: look for AppPath of space-less executable

strPWk = Trim(AppPath(strPWk))
strTEx = WSL(strPWk,flagFileFound)

If flagFileFound Then
IDExe = strTEx
Else
IDExe = "file not found"
End if

End Function




'WinSysLocate
Function WSL (strIn, logFound)

'set default results
WSL = strIn : logFound = False

'if strIn exists, exit
If Fso.FileExists(strIn) Then

WSL = Fso.GetFile(strIn).Path
logFound = True

'if strIn doesn't contain drive or UNC network path
ElseIf InStr(strIn,":") = 0 And InStr(strIn,"\\") <> 1 Then

'check for file in Windows directory
If Fso.FileExists(strFPWF & "\" & strIn) Then

WSL = strFPWF & "\" & strIn : logFound = True

'check for file in System directory
ElseIf Fso.FileExists(strFPSF & "\" & strIn) Then

WSL = strFPSF & "\" & strIn : logFound = True

End If 'prefixed strIn exists?

End If 'strIn contains path?

End Function




'find company name in existing file
Function CoName (strFN)

If strFN = "file not found" Or IsNull(strFN) Or strFN = "" _
Or Not Fso.FileExists(strFN) Then
CoName = " [file not found]"
Exit Function
End If

'WMI file object, co-name, error number, working file name
Dim oFile, strMftr, intErrNum, strFNWk

'R44 -- removed StringFilter added in R40 -- findable Unicode file
' name added "unwritable string", which automatically threw a
' WMI GetObject Error
strFNWk = strFN

'if there are already escaped backslashes, unescape them
If InStr(strFNWk,"\\") <> 0 Then strFNWk = Replace(strFNWk,"\\","\")
'now reescape all of them
strFNWk = Replace(strFNWk,"\","\\")

'get the file object with filename delimited by double quotes
'(couldn't get single quotes to work with single quote embedded in path)
On Error Resume Next
Set oFile = GetObject("winmgmts:\root\cimv2").Get _
("CIM_DataFile.Name=""" & strFNWk & """")
intErrNum = Err.Number : Err.Clear
On Error Goto 0
If intErrNum <> 0 Then
CoName = " [** WMI GetObject error **]"
Exit Function
End If

'find the co-name
strMftr = oFile.Manufacturer

Set oFile=Nothing

'if null, say so
If IsNull(strMftr) Then

CoName = " [null data]"

'if empty, say so
ElseIf strMftr = "" Then

CoName = " [empty string]"

'if some company, say it
Else

'if MS, say it with 2 letters
If strMftr = "Microsoft Corporation" Or strMftr = "Microsoft Corp." Then

CoName = MS

'if some other company, provide all the data, which may take up several lines
Else

CoName = " [" & StringFilter(Replace(strMftr,Chr(13) & Chr(10),Space(1)), _
True) & "]"

End If 'MS or not?

End If 'null, mt, MS or not?

End Function




'SCRipts.Ini-File Parser
'file name to open, action for which scripts must be parsed
Function ScrIFP (strValue, strAction)

'form scripts.ini path\FileName
Dim strScrFN : strScrFN = strValue & "\scripts.ini"
'default path
Dim strDefPath : strDefPath = ""

'error number, line read from file, pos'n of CmdLine & equals sign,
'parameter string, line intro ("arrow") string
Dim intErrNum, strLine, intCS, intEq, strParam, strArrow
Dim strSC : strSC = "" 'script command
Dim intSN : intSN = 0 'script number
Dim strCmd : strCmd = "" 'command string
Dim flagSection : flagSection = False 'True if in strAction section
Dim flagActionWritten : flagActionWritten = False 'True if Action written once
Dim intActL : intActL = Len(strAction) 'action length (used for spacing of output)

'open the SCRIPTS.INI file For Reading
On Error Resume Next
Dim oSI : Set oSI = Fso.OpenTextFile(strScrFN, 1, False,-1)
intErrNum = Err.Number : Err.Clear
On Error Goto 0

'if couldn't open file, output a warning & quit
If intErrNum <> 0 Then
TitleLineWrite
oFN.WriteLine "WARNING! Insufficient permission to read " &_
Chr(34) & strScrFN & Chr(34)
Exit Function
End If

'for every line of file
Do Until oSI.AtEndOfStream

strLine = oSI.ReadLine

'if know already in right section
If flagSection Then

'exit if find beginning of next section
If InStr(strLine, "[") Then Exit Do

'[Logon]
'0CmdLine=path\filename.ext
'0Parameters=

'find pos'n of equals sign
intEq = InStr(strLine,"=")

'if equals sign found in the line
If intEq > 0 Then

'output saved info if the script number has changed
If intSN <> FLN(strLine) Then

TitleLineWrite
strArrow = Chr(34) & strAction & Chr(34) & " -> launches: "
If flagActionWritten = True Then strArrow = Space(intActL+2) & " -> launches: "

'output script command, reset script command & saved script number
oFN.WriteLine strArrow & Chr(34) & strSC & Chr(34) & CoName(IDExe(strCmd))
strSC = "" : strCmd = "" : flagActionWritten = True
intSN = FLN(strLine)

End If 'new script number?

'current line is cmdline
If InStr(LCase(strLine), "cmdline") > 0 Then

'if cmdline doesn't contain backslash, form script path from
'function parameters
If InStr(strLine,"\") = 0 Then strDefPath = strValue & "\" & strAction & "\"

'add script command to command string
strSC = strDefPath & Mid(strLine, intEQ + 1) & strSC
strCmd = strDefPath & Mid(strLine, intEQ + 1) 'store cmdline field for co-name id

'if parameters line
ElseIf InStr(LCase(strLine), "parameters") > 0 Then

'extract parameters string
strParam = Mid(strLine, intEq + 1)

'add non-empty parameters command to command string
If Trim(strParam) <> "" Then strSC = strSC & " " & strParam

End If 'line is cmdline or parameter

End If '"=" in this line

End If 'inside action section

'if action found in current line, set flag to True
If InStr(LCase(strLine), LCase(strAction)) > 0 Then flagSection = True

Loop 'next line in SCRIPTS.INI

oSI.Close : Set oSI=Nothing

'if a script was located, output last script command found
If strSC <> "" Then

strArrow = Chr(34) & strAction & Chr(34) & " -> launches: "
If flagActionWritten = True Then strArrow = Space(intActL+2) & " -> launches: "
TitleLineWrite
oFN.WriteLine strArrow & Chr(34) & strSC & Chr(34) & CoName(IDExe(strCmd))

End If 'script located?

End Function




'Find Leading Number
Function FLN (strLine)

'save the input in a trimmed work variable
Dim strWork : strWork = LTrim(strLine)
'initialize the output number
Dim intNumber : intNumber = 0

'counter, single character
Dim i, str1C
'find length of work variable
Dim intLen : intLen = Len(strWork)

'for the length of the work variable
For i = 1 To intLen

'take the left-most chr
str1C = Left(strWork,1)
'if it's numeric
If IsNumeric(str1C) Then
'concatenate the digit
intNumber = intNumber + CInt(str1C)
'remove 1st chr from the work variable
strWork = Right(strWork,Len(strWork)-1)
Else 'left-most chr isn't numeric
FLN = intNumber 'output the leading number & exit
Exit For
End IF

Next 'work variable chr

End Function




'look for the App Path default value for an executable
Function AppPath (strFN)

Dim strKey, strValue, intErrNum

strKey = "Software\Microsoft\Windows\CurrentVersion\App Paths"

intErrNum = oReg.GetStringValue (HKLM,strKey & "\" & strFN,"",strValue)

'return the value or an empty string (or garbage if value not set under W2K!)
If intErrNum = 0 And strValue <> "" Then
AppPath = strValue
Else
AppPath = ""
End If

End Function




'parse HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows\load
'HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows\run for executables
'and return co-name for each executable
'executables are delimited by spaces and/or commas
Function LRParse (strLine)

Dim i, strLRSeg 'counter, line segment
Dim strIn : strIn = Trim(strLine) 'input string
Dim intSLLI : intSLLI = Len(strIn) 'Input String Line Length
Dim strOut : strOut = "" 'output string
Dim arOut() 'dynamic executable output array
Dim cntAr : cntAr = -1 'output array UBound
Dim cntChr : cntChr = 0 'number of chrs in executable string
Dim intStartChr : intStartChr = 1 'start of executable string in input string

'for every chr in input string
For i = 1 To intSLLI

'if the chr is a delimiter
If Mid(strIn,i,1) = " " Or Mid(strIn,i,1) = "," Then

'if at least one non-delimiter chr has been encountered
If cntChr > 0 Then

'extract the executable from the input string
strLRSeg = Mid(strIn,intStartChr,cntChr)
'if executable has no extension, add ".exe"

If Fso.GetExtensionName(strLRSeg) = "" Then _
strLRSeg = strLRSeg & ".exe"
cntChr = 0 'reset the executable counter
cntAr = cntAr + 1 'increment the output array UBound
ReDim Preserve arOut(cntAr) 'redim the output array
arOut(cntAr) = strLRseg 'add the executable to the output array

End If 'non-delimiter chr encountered?

intStartChr = i + 1 'reset the executable string start to next chr

Else 'chr not a delimiter

cntChr = cntChr + 1 'increment the exec string counter

End If 'chr a delimiter?

Next 'line chr

'check the end-string
If cntChr > 0 Then

'extract the executable
strLRSeg = Mid(strIn,intStartChr,cntChr)
cntAr = cntAr + 1 'increment the output array UBound
ReDim Preserve arOut(cntAr) 'redim the output array
arOut(cntAr) = strLRSeg 'add the executable to the output array

End If 'exec string found at end of line?

'if exec strings found
If cntAr >= 0 Then

'for every string
For i = 0 To UBound(arOut)

If strOut = "" Then
strOut = CoName(IDExe(arOut(i)))
Else
'concatenate a comma & co-name (with leading space)
strOut = strOut & "," & CoName(IDExe(arOut(i)))
End If

Next

End If

'return delimited string
LRParse = strOut

End Function




'read JOB file & output error if file corrupt
Function JobFileRead (oFile, oJobFi)

'number of Unicode chrs in Run field executable statements,
'decimal value of enabled byte, command string, error number
Dim intUChrCtr, int1C, strCmd, intErrNum
Dim strJobExe : strJobExe = "" 'concatenated executable string
Dim flagEnStatus : flagEnStatus = False 'task enabled status

'check for minimum length
If oFile.Size <= 80 Then
JobFileReadError oFile, " (too small)" : Exit Function
End If

On Error Resume Next

'determine enabled/disabled status by reading one Unicode chr
oJobFi.Skip(24)

int1C = AscB(oJobFi.Read(1))

'for a DISabled task: byte 48 (30h), 0-based-bit 2 (4-bit) = 1
If (int1C And 4) = 0 Then flagEnStatus = True

'if an enabled task
If flagEnStatus Then

'write titles & skip one line if not already done
If strTitle <> "" Then
TitleLineWrite
oFN.WriteBlankLines (1)
End If

'skip to the counter for the number of chrs in the first executable statement
oJobFi.Skip(10) 'no of bytes at unicode chr 35 (byte 70)

'no of chrs includes final zero chr so subtract one chr
intUChrCtr = AscW(oJobFi.Read(1))-1

'check for 0 or negative executable length
If intUChrCtr <= 0 Then
JobFileReadError oFile, " (no executable)"
Exit Function
End If

'read the chrs and convert to ASCII
strJobExe = MidB(oJobFi.Read(intUChrCtr),1)
intErrNum = Err.Number : Err.Clear

'check for truncated executable
If intErrNum <> 0 Then
JobFileReadError oFile, " (truncated executable)"
Exit Function
End If

strCmd = strJobExe 'store executable for co-name ID
'add ".exe" extension to bare executables
If Fso.GetExtensionName(strCmd) = "" Then strCmd = strCmd & ".exe"

'skip to parameters counter
oJobFi.Skip(1)
intErrNum = Err.Number : Err.Clear

'check for truncated file
If intErrNum <> 0 Then
JobFileReadError oFile, " (too small)"
Exit Function
End If

'read the parameters counter
intUChrCtr = AscW(oJobFi.Read(1))
intErrNum = Err.Number : Err.Clear

'check for absence of parameters counter
If intErrNum <> 0 Then
JobFileReadError oFile, " (parameter string size missing)"
Exit Function
End If

'if parameters exist, concatenate the executable
If intUChrCtr <> 0 Then _
strJobExe = strJobExe & Space(1) & MidB(oJobFi.Read(intUChrCtr-1),1)
intErrNum = Err.Number : Err.Clear

'check for truncated parameter string
If intErrNum <> 0 Then
JobFileReadError oFile, " (truncated parameter string)"
Exit Function
End If

'write out the .JOB file name & executable string
oFN.WriteLine Chr(34) & Fso.GetBaseName(oFile.Path) & Chr(34) &_
" -> launches: " & StringFilter(strJobExe,True) &_
CoName(IDExe(strCmd))

End If 'enabled task?

On Error Goto 0

End Function




'output reason for JOB file corruption
Function JobFileReadError (oFile, strReason)

'write titles if not already done
TitleLineWrite

'write out the .JOB file name & error
oFN.WriteLine Chr(34) & Fso.GetBaseName(oFile.Path) & Chr(34) &_
" -> " & "WARNING -- The file " & Chr(34) & oFile.Name & Chr(34) &_
" is corrupt!" & strReason

End Function




'filter unwritable chrs from output strings
'flagEmbedQ : if True, embed output string in quotes
Function StringFilter (strIn, flagEmbedQ)

'exit if string is null or empty
If IsNull(strIn) Then
StringFilter = "(null value)" : Exit Function
ElseIf strIn = Asc(0) Then
StringFilter = "(null value)" : Exit Function
ElseIf strIn = "" Then
StringFilter = "" : Exit Function
End If

Dim flagCorrupt : flagCorrupt = False 'unwritable chr encountered
Dim i, strChr 'counter, single chr
Dim intLen : intLen = Len(strIn) 'string length
Dim strOut : strOut = "" 'output string

'for every chr in argument
For i = 1 To intLen

'take ith chr
strChr = Mid(strIn,i,1)

'undocumented Asc behavior: certain chrs will return 63 ("?")
'if the chr really is a "?", then AscW will return the same thing
'otherwise, the chr is not a "?" and is unwritable

'if Asc < 32 Or (Asc returns "?" but AscW doesn't)
If Asc(strChr) < 32 Or (Asc(strChr) = 63 And AscW(strChr) <> 63) Then
flagCorrupt = True
strOut = strOut & "*"
Else 'chr is legitimate ASCII
strOut = strOut & strChr
End If

Next

'say if string unwritable and enclose in quotes
If flagCorrupt Then

If flagEmbedQ Then
StringFilter = Chr(34) & strOut & Chr(34) & " (unwritable string)"
Else
StringFilter = strOut & " (unwritable string)"
End If 'flagEmbedQ?

Else 'input string is writable

If flagEmbedQ Then
StringFilter = Chr(34) & strOut & Chr(34)
Else
StringFilter = strOut
End If 'flagEmbedQ?

End If 'flagCorrupt?

End Function




'increment counters when IERESET.INF found-in-file-on-disk flag is False
Sub IERESETCounter (strSection, arIERSectionName, arSectionCount)

'if current INF section <> section for last not-found line
If strSection <> arIERSectionName Then 'if new section title

'increment # sections, reset # lines in section
'intSectionCount is an array index and initializes at -1
'intSectionLineCount initializes at 0 for new section
intSectionCount = intSectionCount + 1 : intSectionLineCount = 0

'1st row = section name; 2nd row = # not-found lines in section
'add column for new section to array, add title to array column
ReDim Preserve arSectionCount(1,intSectionCount)
arSectionCount(0,intSectionCount) = arIERSectionName
'set current section = section for last-found line
strSection = arIERSectionName

End If

'increment # lines not found in this section
intSectionLineCount = intSectionLineCount + 1

'increment # not-found lines in section
arSectionCount(1,intSectionCount) = intSectionLineCount

End Sub




'write title, sub-title, and sub-sub-title lines
Sub TitleLineWrite

If strTitle <> "" Then 'output title line if necessary
oFN.WriteLine vbCRLF & vbCRLF & strTitle & vbCRLF &_
String(Len(strTitle),"-")
strTitle = ""
End If

If strSubTitle <> "" Then 'output sub-title line if necessary
oFN.WriteLine vbCRLF & strSubTitle
strSubTitle = ""
End If

If strSubSubTitle <> "" Then 'output sub-title line if necessary
oFN.WriteLine vbCRLF & strSubSubTitle
strSubSubTitle = ""
End If

End Sub




Sub CLSIDLocTitle (hLocHive, strKeyLoc, strCLSID, strLocTitle)

'assign default values
flagIsCLSID = False : strLocTitle = ""

'toggle flag if strCLSID in correct format
If Len(strCLSID) = 38 And Left(strCLSID,1) = "{" And _
Right(strCLSID,1) = "}" Then flagIsCLSID = True

'get title from value
'title retrieved successfully even if value of type REG_EXPAND_SZ
intErrNum = oReg.GetStringValue (hLocHive,strKeyLoc,strCLSID,strValue)
If intErrNum = 0 And strValue <> "" Then
strLocTitle = StringFilter(strValue, True)
Else
strLocTitle = "(no title provided)"
End If 'strValue returned?

End Sub




'for CLSID name, recover CLSID title, CLSID\InProcServer32 DLL name
Sub ResolveCLSID (strCLSID, hCLSIDHive, strCLSIDTitle, strIPSDLL)

Dim strValue_1, strValue_2, strKey_1, strKey_2
Dim intErrNum_1, intErrNum_2, intErrNum_3
Dim arN(), arT()

'assign default values
strCLSIDTitle = "" : strIPSDLL = ""

strKey_1 = "Software\Classes\CLSID\" & strCLSID
strKey_2 = "Software\Classes\CLSID\" & strCLSID & "\InProcServer32"

'look for key
intErrNum_1 = oReg.EnumValues (hCLSIDHive,strKey_1,arN,arT)

'if key exists
If intErrNum_1 = 0 Then

'look for title
intErrNum_2 = oReg.GetStringValue (hCLSIDHive,strKey_1,"",strValue_1)

'set CLSID key title
strCLSIDTitle = "(no title provided)"
If intErrNum_2 = 0 And strValue_1 <> "" Then _
strCLSIDTitle = StringFilter(strValue_1, True)

'look for IPSDLL
intErrNum_3 = oReg.GetExpandedStringValue (hCLSIDHive,strKey_2,"",strValue_2)
If intErrNum_3 = 0 And strValue_2 <> "" Then strIPSDLL = strValue_2

End If 'CLSID key exists?

End Sub




'find directories with System attribute and DESKTOP.INI file
'with .ShellClassInfo section and CLSID statement
Sub DirSysAtt (oDir)

'sub-dir collection & count, single sub-dir, error number
Dim colSF, cntSF, oSF, intErrNum
'DeskTop.Ini path string & Parse return string,
Dim strDTI, strDTIP

'avoid "RECYCLER" And "System Volume Information" directories
If InStr(LCase(oDir),"recycler") > 0 Or _
InStr(LCase(oDir),"recycled") > 0 Or _
InStr(LCase(oDir),"system volume information") > 0 Then Exit Sub

'increment folder count
ctrFo = ctrFo + 1

'form DESKTOP.INI path string
strDTI = oDir.Path & "\DESKTOP.INI"
'if root directory, backslash is present by default
If oDir.IsRootFolder Then strDTI = oDir.Path & "DESKTOP.INI"

'if System attribute present And DESKTOP.INI CLSID exists,
'add path to array & increment count
If (oDir.Attributes And 4) And Fso.FileExists(strDTI) Then
strDTIP = DTIParse(strDTI)
If strDTIP <> "" Then
ReDim Preserve arSDDTI(ctrArDTI) : arSDDTI(ctrArDTI) = strDTIP
ctrArDTI = ctrArDTI + 1
End If 'return string not empty?
End If 'S And DTI exists?

'count the sub-folders, trap any error (prob. due to permissions)
On Error Resume Next
Set colSF = oDir.SubFolders : cntSF = colSF.Count
intErrNum = Err.Number : Err.Clear
On Error Goto 0

'if no error, recurse the sub-folders
If intErrNum = 0 Then
For Each oSF In colSF : DirSysAtt oSF : Next
Set colSF=Nothing
Else 'add (permissions) error to array & increment count
ReDim Preserve arSDErr(ctrArErr) : arSDErr(ctrArErr) = oDir.Path
ctrArErr = ctrArErr + 1
End If

End Sub




'return output string for DESKTOP.INI with CLSID statement
'consisting of CLSID and InProcServer32 DLL
Function DTIParse (strDTIFN)

'DESKTOP.INI file, error number, CoName
Dim oDTIFi, intErrNum, strIPSDLL, strCN
Dim strOut : strOut = "" 'output string
'file line, Lower-Case Left-Trimmed line, pos'n of equals sign
'CLSID, key string, counter
Dim strLine, strLCLT, intEq, strCLSID, strKey, i
Dim flagSection : flagSection = False 'in [.ShellClassInfo]?
Dim flagAllow 'IPS DLL on allowed list?
Dim flagTitle 'hive title line written?

DTIParse = "" 'by default, return empty string

'try to open DESKTOP.INI
On Error Resume Next
Set oDTIFi = Fso.OpenTextFile(strDTIFN,1,False,0)
intErrNum = Err.Number : Err.Clear
On Error Goto 0

'return error if file can't be opened
If intErrNum <> 0 Then
DTIParse = strDTIFN & " -- cannot be opened!" : Exit Function
End If

'[.shellclassinfo]
'CLSID=
'UICLSID=

'for every line
Do While Not oDTIFi.AtEndOfStream

strLine = oDTIFi.ReadLine
strLCLT = LCase(LTrim(strLine))

'detect [.ShellClassInfo]
If Left(strLCLT,1) = "[" And InStr(strLCLT,".shellclassinfo") > 0 Then

flagSection = True

'toggle flag if encountered another section before CLSID statement
ElseIf Left(strLCLT,1) = "[" And InStr(strLCLT,".shellclassinfo") = 0 Then

flagSection = False

'detect "CLSID=" or "UICLSID="
ElseIf flagSection And (Left(strLCLT,5) = "clsid" Or _
Left(strLCLT,7) = "uiclsid") Then

'find "="
intEq = InStr(1,strLCLT,"=",1)

'if "=" past "CLSID"
If intEq > 5 Then

strCLSID = RTrim(Mid(strLCLT,intEq + 1)) 'save the string past the equals
strKey = "Software\Classes\CLSID\" & strCLSID & "\InProcServer32"

flagTitle = False

For ctrCH = intCLL To 1

'get the CLSID IPS from the registry
intErrNum = oReg.GetExpandedStringValue (arHives(ctrCH,1),strKey,"", strIPSDLL)

'if the IPS DLL exists, check if it's allowed, CoName = MS & CLSID hive = HKLM
If intErrNum = 0 And strIPSDLL <> "" Then

flagAllow = False : strCN = CoName(IDExe(strIPSDLL))

For i = 0 To UBound(arOKDLLs)
If LCase(Fso.GetFileName(strIPSDLL)) = LCase(arOKDLLs(i)) And _
strCN = MS And ctrCH = 1 Then
flagAllow = True : Exit For
End If 'allowed?
Next 'allowed IPS DLL

'form string if DLL not allowed Or ShowAll
If Not flagAllow Or flagShowAll Then

If strOut = "" Then 'if no output yet, write full headers

strOut = vbCRLF & strDTIFN & vbCRLF & "[.ShellClassInfo]" &_
vbCRLF & strLine & vbCRLF & " -> {" & arHives(ctrCH,0) & "...CLSID}\" &_
"InProcServer32\(Default) = " & DQ & strIPSDLL & DQ & strCN
flagTitle = True

Else 'concatenate add'l text

If Not flagTitle Then 'no output for this line, so write line

strOut = strOut & vbCRLF & strLine & vbCRLF &_
" -> {" & arHives(ctrCH,0) & "...CLSID}\InProcServer32\(Default) = " &_
DQ & strIPSDLL & DQ & strCN
flagTitle = True

Else 'flagTitle True - current file line has generated output,
'so just append CLSID info

strOut = strOut & vbCRLF &_
" -> {" & arHives(ctrCH,0) & "...CLSID}\InProcServer32\(Default) = " &_
DQ & strIPSDLL & DQ & strCN

End If 'flagTitle?

End If 'strOut empty?

End If 'DLL not allowed?

End If 'IPS DLL exists?

Next 'CLSID hive

End If 'equals sign past "CLSID" or "UICLSID"?

End If 'in [.ShellClassInfo] section?

Loop 'DESKTOP.INI line

oDTIFi.Close : Set oDTIFi=Nothing

'set function value & exit
DTIParse = strOut

End Function




'file type, hive number, SOC default value
'check existence of file type key if SOC key not found? (True = Yes)
Sub SOCValue (strFT, ctrCH, strDefVal, flagFTKey)

'key string, error, returned value, array of key values/value types,
'company name, ddeexec key name
Dim strKey, intErrNum, strValue, arNames(), arType(), strCN, strKeyDDEX
Dim strWarn : strWarn = ""

'initialize company name
strCN = ""

'form file type S
strKey = "Software\Classes\" & strFT & "\shell"

'look for shell default value
intErrNum = oReg.GetStringValue (arHives(ctrCH,1),strKey,"",strValue)

'if file type shell value exists And not empty And <> "open"
If intErrNum = 0 And strValue <> "" And LCase(strValue <> "open") Then

flagIWarn = True

'output shell default value
strOut = StrOutSep (strOut,IWarn & arHives(ctrCH,0) & "\" &_
StringFilter(strKey,False) & "\(Default) = " &_
StringFilter(strValue,True),vbCRLF)

'form ddeexec key
strKeyDDEX = strKey & "\" & strValue & "\ddeexec"

'form command key
strKey = strKey & "\" & strValue & "\command"

'look for command value
intErrNum = oReg.GetStringValue (arHives(ctrCH,1),strKey,"",strValue1)

'if command value exists
If intErrNum = 0 And strValue1 <> "" Then

'find CoName
strCN = CoName(IDExe(strValue1))

'output command value
strOut = StrOutSep(strOut,arHives(ctrCH,0) & "\" &_
StringFilter(strKey,False) & "\(Default) = " &_
StringFilter(strValue1,True) & strCN,vbCRLF)

End If 'command value exists?

'look for ddeexec value
DDEX strKeyDDEX

Else 'shell value empty Or = "open"

'form ddeexec key
strKeyDDEX = strKey & "\open\ddeexec"

'form SOC key
strKey = strKey & "\open\command"

'look for file type SOC
intErrNum = oReg.GetStringValue (arHives(ctrCH,1),strKey,"",strValue)

'if file type SOC value exists
If intErrNum = 0 And strValue <> "" Then

'if SOC value not expected, look for company name
If LCase(strValue) <> LCase(strDefVal) Then
strCN = CoName(IDExe(strValue))
strWarn = IWarn : flagIWarn = True
End If

'output if HKCU or default value not expected or show all
If ctrCH = 0 Or (LCase(strValue) <> LCase(strDefVal)) Or flagShowAll Then
strOut = StrOutSep(strOut,strWarn & arHives(ctrCH,0) & "\" &_
StringFilter(strKey,False) & "\(Default) = " &_
StringFilter(strValue,True) & strCN,vbCRLF)
End If

'file type SOC default value doesn't exist, does SOC key exist?
Else

'look for SOC key
intErrNum = oReg.EnumValues (arHives(ctrCH,1),strKey,arNames,arType)

'output SOC key status
If intErrNum = 0 Then

strOut = StrOutSep(strOut,arHives(ctrCH,0) & "\" &_
StringFilter(strKey,False) & "\(Default) = (value not set)",vbCRLF)

'SOC key doesn't exist, check for file type key if requested
ElseIf flagFTKey Then

'output missing HKLM key
If ctrCH = 1 Then strOut = StrOutSep (strOut,arHives(ctrCH,0) &_
"\" & StringFilter(strKey,False) & "\ = (key not found)",vbCRLF)

'form file type key
strKey = "Software\Classes\" & strFT

'look for file type key
intErrNum = oReg.EnumValues (arHives(ctrCH,1),strKey,arNames,arType)

'output file type key status
If intErrNum = 0 Then
strOut = StrOutSep (strOut,arHives(ctrCH,0) & "\" &_
StringFilter(strKey,False) & "\",vbCRLF)
ElseIf ctrCH = 1 Then
strOut = StrOutSep (strOut,arHives(ctrCH,0) & "\" &_
StringFilter(strKey,False) & "\ = (key not found)",vbCRLF)
End If

End If 'check file type key?

End If 'file type SOC exists?

'look for ddeexec value
DDEX strKeyDDEX

End If 'file type shell exists?

End Sub




'look for shell\open\ddeexec default values
Sub DDEX (strKey)

'error x 2, returned value, arrays of key values/value types
Dim intErrNum, intErrNum1, strValue, arNames(), arType()
Dim strWarn : strWarn = IWarn

'look for ddeexec key
intErrNum = oReg.EnumValues (arHives(ctrCH,1),strKey,"",arNames,arType)

'if ddeexec key exists
If intErrNum = 0 Then

flagIWarn = True

'get default value
oReg.GetStringValue arHives(ctrCH,1),strKey,"",strValue

'form output string
strOut = StrOutSep (strOut, strWarn & arHives(ctrCH,0) & "\" &_
StringFilter(strKey,False) & "\(Default) = " &_
StringFilter(strValue,True),vbCRLF)

'look for Application key
intErrNum1 = oReg.EnumValues (arHives(ctrCH,1),strKey & "\Application","",arNames,arType)

'if Application key exists, get default value
If intErrNum1 = 0 Then

oReg.GetStringValue arHives(ctrCH,1),strKey & "\Application","",strValue1

strOut = StrOutSep (strOut, strWarn & arHives(ctrCH,0) & "\" &_
StringFilter(strKey,False) & "\Application\(Default) = " &_
StringFilter(strValue1,True),vbCRLF)

End If 'Application key exists?

End If 'ddeexec key exists?

End Sub




'initial output string, string to add, Separator string
Function StrOutSep (strOut, strAdd, strSep)

'if output string not empty, separate added string with strSep
If strOut <> "" Then
StrOutSep = strOut & strSep & strAdd
Else 'output string empty, set output to input
StrOutSep = strAdd
End If

End Function




'recurse sub-directories for WVa Scheduled Tasks, run ESTParse sub on contents
Sub DirEST (oDir)

Dim strOutFo : strOutFo = "" 'output string for the folder

'File/Sub-Folder collections & count, single file/sub-dir
Dim colFi, colSF, oFi, oSF

'avoid "RECYCLER" And "System Volume Information" directories
If InStr(LCase(oDir.Name),"recycler") > 0 Or _
InStr(LCase(oDir.Name),"recycled") > 0 Or _
InStr(LCase(oDir.Name),"system volume information") > 0 Then Exit Sub

Set colFi = oDir.Files 'get the file collection

'trap any file access errors in the directory
'parse each file for EST info and append info to output string
On Error Resume Next

For Each oFi In colFi

strTmp = ESTParse(oFi.Path)
If strTmp <> "" Then 'if EST found

If strOutFo <> "" Then 'if output string not MT
strOutFo = strOutFo & vbCRLF & strTmp 'add EST to next line
Else 'output string still MT
strOutFo = strTmp 'don't precede EST string with CR
End If 'output string MT?

End If 'EST found?

Next 'next file in directory
intErrNum = Err.Number : Err.Clear

On Error Goto 0

'in case of access error, save the directory path in the error array
' increment the error count & exit
If intErrNum <> 0 Then
ReDim Preserve arErr(ctrErr) : arErr(ctrErr) = oDir.Path
ctrErr = ctrErr + 1 : Exit Sub
End If

'if EST's found, prefix the output string with the directory path
If strOutFo <> "" Then
If strOut = "" Then 'if first directory with output
'skip line and place EST's below directory path
strOut = vbCRLF & oDir.Path & vbCRLF & strOutFo
Else 'not first directory with output
'put blank line between old and new strings, then follow with
'directory path and new EST's
strOut = strOut & vbCRLF & vbCRLF & oDir.Path & vbCRLF & strOutFo
End If 'first directory with output?
End If 'EST's found in directory?

'get the sub-folder collection, trap any error (prob. due to permissions)
On Error Resume Next
Set colSF = oDir.SubFolders
intErrNum = Err.Number : Err.Clear
On Error Goto 0

'if no error, recurse the sub-folders
If intErrNum = 0 Then
For Each oSF In colSF : DirEST oSF : Next
Set colSF=Nothing
Else 'add (permissions) error to array & increment count
ReDim Preserve arErr(ctrErr) : arErr(ctrErr) = oDir.Path
ctrErr = ctrErr + 1
End If

End Sub




'WVa Enabled Scheduled Task (XML file) Parser
Function ESTParse (strESTFN)

Dim strCLSID, strCLSIDTitle, strIPSDLL, strNodeText
Dim strArg, flagIPSFnd
Dim flagDisabled : flagDisabled = False 'disabled flag

Dim strHidden : strHidden = ""

ESTParse = "" 'by default, return empty string

'create XML document
Dim oXMLFi: Set oXMLFi = CreateObject("MSXML2.DOMDocument")

'try to open argument (task file)
On Error Resume Next
oXMLFi.Load strESTFN
intErrNum = Err.Number : Err.Clear
On Error Goto 0

'exit if file can't be opened
If intErrNum <> 0 Then Exit Function

'exit if not a valid XML file or if file cannot be opened due to
'insufficient permissions
'also available: oXMLFi.ParseError.ErrorCode, oXMLFi.ParseError.Reason
If oXMLFi.ParseError.ErrorCode <> 0 Then Exit Function

On Error Resume Next
strNodeText = LCase(oXMLFi.SelectSingleNode("//Settings/Enabled").text)
intErrNum = Err.Number : Err.Clear
On Error Goto 0

If intErrNum = 0 Then
If strNodeText = "false" Then flagDisabled = True
End If

'if task is not disabled
If Not flagDisabled Then

'check if hidden
'*MUST* enclose within On Error, set .text property, save error number,
'test error number subsequently and *then* set dependent variable value
On Error Resume Next
strNodeText = LCase(oXMLFi.SelectSingleNode("//Settings/Hidden").text)
intErrNum = Err.Number : Err.Clear
On Error Goto 0

If intErrNum = 0 Then
If strNodeText = "true" Then strHidden = "(HIDDEN!)"
End If

'look for Custom Handler
'removal of "On Error Resume Next" generated error if CLSID not
' present and caused Function to return, but script did not abort
On Error Resume Next
strCLSID = oXMLFi.SelectSingleNode("//ComHandler/ClassId").text
intErrNum = Err.Number : Err.Clear
On Error Goto 0

If intErrNum = 0 Then 'Custom Handler present

'add CLSID to output string
ESTParse = DQ & Fso.GetFileName(strESTFN) & DQ &_
" -> " & strHidden & " launches: " & DQ & strCLSID & DQ

flagIPSFnd = False 'assume IPS DLL doesn't exist

'look for InProcServer32 in HKCU/HKLM
For ctrCH = 0 To 1

ResolveCLSID strCLSID, arHives(ctrCH,1), strCLSIDTitle, strIPSDLL

'if IPS found
If strIPSDLL <> "" Then

flagIPSFnd = True 'toggle flag

'append IPS string to output string
ESTParse = ESTParse & vbCRLF &_
" -> {" & arHives(ctrCH,0) & "...CLSID} = " &_
strCLSIDTitle & vbCRLF & Space(19) & "\InProcServer32\(Default) = " &_
StringFilter(strIPSDLL,True) & CoName(IDExe(strIPSDLL))

End If 'strIPSDLL exists?

Next 'CLSID hive

'if IPS not found, say it and return
If Not flagIPSFnd Then ESTParse = ESTParse & DQ &_
" [InProcServer32 entry not found]"

End If 'Custom Handler present?

'look for executable command
'removal of "On Error Resume Next" generated error if CLSID not
' present and caused Function to return, but script did not abort
On Error Resume Next
strCmd = oXMLFi.SelectSingleNode("//Command").text
intErrNum = Err.Number : Err.Clear
On Error Goto 0

'if command exists, save to output
If intErrNum = 0 Then
ESTParse = DQ & Fso.GetFileName(strESTFN) & DQ &_
" -> " & strHidden & " launches: " & DQ & strCmd

strCN = CoName(IDExe(strCmd)) 'find CoName

'look for executable arguments
'removal of "On Error Resume Next" generated error if CLSID not
' present and caused Function to return, but script did not abort
On Error Resume Next
strArg = oXMLFi.SelectSingleNode("//Arguments").text
intErrNum1 = Err.Number : Err.Clear
On Error Goto 0

'if arguments exist, add to output and return
If intErrNum1 = 0 Then
ESTParse = ESTParse & Space(1) & strArg & DQ & strCN
ElseIf ESTParse <> "" Then 'otherwise terminate output string
ESTParse = ESTParse & DQ & strCN
End If

End If 'command exists?

End If 'task not disabled?

End Function




'hex hive, registry key
Sub GPRecognizer (hHive, strKey)

'error number, counters x 2, Known Setting Index,
'Group Policy setting location string, value type
Dim intErrNum, i, j, intKSI, intISI, strGPLoc, strType
Dim flagIgnore
Dim arNames(), arType() 'returned array of value names/types

Const UCFG = "{User Configuration|"
Const CCFG = "{Computer Configuration|"

strSubSubTitle = "HKCU\" & strKey & "\"
If hHive = HKLM Then strSubSubTitle = "HKLM\" & strKey & "\"

'set up GPO type
Dim strGPOT : strGPOT = UCFG 'GPO Type
If hHive = HKLM Then strGPOT = CCFG

'obtain arrays of value names & types
intErrNum = oReg.EnumValues (hHive, strKey, arNames, arType)

'if array returned (exc for WS2K3)
If intErrNum = 0 And IsArray(arNames) Then

On Error Resume Next 'WS2K3 will throw error if no values exist

'for every member of the names array
For i = 0 To UBound(arNames)

'if not default value
If arNames(i) <> "" Then

flagIgnore = False 'assume name not approved

'retrieve the value as a string
strValue = RtnValue (hHive, strKey, arNames(i), arType(i))
'save the value type as a string
strType = RtnType (arType(i))

'compare name/value pair to approved names/values
For j = 0 To UBound(arAllowedNames,1)

'for approved names and equivalent or any values,
'toggle flag and exit
If LCase(Trim(arNames(i))) = LCase(arAllowedNames(j,0)) Then

If ((LCase(strValue) = LCase(arAllowedNames(j,3))) Or _
arAllowedNames(j,3) = "***") And Not flagShowAll Then

flagIgnore = True : intISI = j : Exit For

Else 'approved name, but unapproved value or ShowAll

'form output string and write to file, avoid add'l output
strGPLoc = strGPOT & arAllowedNames(j,1) & vbCRLF
'if GP not used here or GP editor doesn't contain this value,
'set location string to LBr
If Not flagGP Or arAllowedNames(j,1) = "" Then strGPLoc = LBr
TitleLineWrite
oFN.WriteLine vbCRLF & DQ & arNames(i) & DQ & " = (" & strType & ") " &_
strValue & vbCRLF & strGPLoc & arAllowedNames(j,2)
flagIgnore = True

End If 'approved value?

End If 'approved name?

Next 'arAllowedNames member

'if name/value not approved
If Not flagIgnore Then

flagFound = False 'assume name not recognized

'for every recognized name
For j = 0 To UBound(arRecNames,1)

'if name on recognized list, toggle flag and save array index
If LCase(Trim(arNames(i))) = LCase(arRecNames(j,0)) Then
flagFound = True : intKSI = j : Exit For
End If

Next 'recognized name array member

If flagFound Then 'if name recognized

'form output string and write to file
strGPLoc = strGPOT & arRecNames(intKSI,1) & vbCRLF
'if GP not used here or GP editor doesn't contain this value,
'set location string to LBr
If Not flagGP Or arRecNames(intKSI,1) = "" Then strGPLoc = LBr
TitleLineWrite
oFN.WriteLine vbCRLF & DQ & arNames(i) & DQ & " = (" & strType & ") " &_
strValue & vbCRLF & strGPLoc & arRecNames(intKSI,2)

Else 'name not recognized

TitleLineWrite
oFN.WriteLine vbCRLF & DQ & arNames(i) & DQ & " = (" & strType & ") " &_
strValue & vbCRLF & "{unrecognized setting}"

End If 'name recognized?

End If 'not approved name/value?

End If 'default name?

Next 'next arNames member

On Error Goto 0

'output reg-key title if absent or empty and ShowAll
ElseIf flagShowAll Then

TitleLineWrite

End If 'reg key has values?

End Sub




Sub ReDimGPOArrays

ReDim arRecNames(0,0) : arRecNames(0,0) = ""
ReDim arAllowedNames(0,0) : arAllowedNames(0,0) = ""

End Sub




Function SecTest

Dim i

SecTest = False

'check section status if in testing mode
If flagTest Then

For i = 0 To UBound(arSecTest)

'if section number in arSecTest, toggle function
If arSecTest(i) = intSection Then
SecTest = True : Exit For
End If 'this section in arSecTest?

Next

End If 'flagTest?

End Function




'R00
'initial rev. 2004-04-20

'R01
'avoided trailing backslash for ScrPath if path is drive root; added
'detection of W98 and HKLM... RunOnceEx, RunServices, RunServicesOnce;
'enumeration of RunOnceEx keys; error if WMI not installed with launch
'of browser to download site & message in text file

'R02
'minor report enhancements

'R03
'added computer name to report file name

'R04
'added:
'HKCU-HKLM\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run
'HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows\load & run
'HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell & Userinit
'HKLM\Software\Classes\[exe-type]file\shell\open\command
'WIN.INI [windows] load= & run=
'SYSTEM.INI [boot] shell=

'R05
'added:
'HKLM\Software\Microsoft\Windows\CurrentVersion\RunOnceEx
'HKLM\Software\Microsoft\Windows\CurrentVersion\ShellServiceObjectDelayLoad
' value of name is CLSID whose InProcServer32 default name's value = executable
'omitted output if keys empty

'R06
'omitted all output if anomalies absent; added W98Titles & DefExeTitles
'functions

'R07
'added RegDataChk sub
'added:
'HKLM\Software\Microsoft\Active Setup\Installed Components\
'HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\SharedTaskScheduler\
'HKCU & HKLM\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains\
'HKCU & HKLM\Software\Microsoft\Command Processor\AutoRun
'HKLM\Software\Microsoft\Windows NT\CurrentVersion\Windows\AppInit_DLLs
'HKLM\System\CurrentControlSet\Control\Session Manager\BootExecute

'R08
'removed:
'HKCU & HKLM\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains\
'manages restricted/trusted sites, but not an executable launch point
'added MsgBox at script completion

'R09
'added identification of PIF target, converted script completion
'MsgBox to PopUp

'R10
'added VIII. shortcut parameters

'R11
'added length check for CLSID data, error handling for bad values
' & missing BHO InprocServer32 key
'added:
'WINSTART.BAT contents listing
'HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\

'R12
'added 10-line "unalterable" comments header
'added detected O/S to output file (incl. WMe & WS2K3)
'changed terminology from "value/data" to "name/value"
'added to section I:
' arRegFlag array (for each O/S: hive,key,execution applicability & warning flags)
' W98,WMe,NT4,W2K,WXP arRegFlag data
' EnumKeyData function for parsing of all value data types & display
' in output file
' subkey recursion (for handling of W2K bug & HKCU/HKLM... RunOnce\Setup)
'removed from Section I:
' HKCU...RunServices & RunServicesOnce for W98
' HKCU... / HKLM... Explorer\Run for NT4

'R13
'added MsgBox to quit if WS2K3 detected
'added HKLM... Winlogon\Notify
'encoded MsgBox e-mail address in hex

'R14
'added INFECTION WARNING! for non-default Winlogon\Notify entry

'R15
'added default value as program's title to HKLM...Active
'Setup\Installed Components section

'R16
'corrected R07 comments concerning HKLM...BootExecute

'R17
'added detection of URL shortcuts in Start Menu folders

'R18
'changed attribution header to accommodate SE results
'added Echo output for CScript host
'added revision number to output file
'modified section II:
' list HKLM\Software\Microsoft\Active Setup\Installed Components\ if
' StubPath value exists and HKCU... Active Setup\Installed Components
' key does not exist, or if HKLM comma-delimited version number > HKCU
' version number
'added to section VI:
' HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\Shell
' HKCU\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell
'modified section X: suppressed startup folder title in output file if folder empty
'added section XI - enabled Scheduled Tasks
'redimmed arrays to 0 to recover memory at end of every section

'R19
'added to section X:
' %WINDIR%\All Users... Startup for W98
'in section XI:
' fixed executable statement parsing bug due to use of Asc instead of AscW
' changed enabled criterion to single byte (44)
'added revision number to MsgBox/Echo at EOJ

'R20
'added output file directory via argument
'added two sections & renumbered existing sections
'added tests for WMe in sections VI, VII, X, XI
'in section III:
' obtained BHO names from CLSID key if unavailable from BHO key
'added section VIII for W2K/WXP:
' HKCU/HKLM\Software\Policies\Microsoft\Windows\System\Scripts
'in section XI:
' excluded DESKTOP.INI files when present in startup directories,
' revised startup folder name title output to only occur if shortcut,
' PIF or executable found in folder
'in section XII:
' changed enabled criteria to single byte: 30h (48),
' bit 2 (0-based) = 0
'added section XIII: started service name, display name, path,
' CompanyName != Microsoft
'added functions: IDExe - extract service executable from path
' FLN - find leading script executable number
' ScrIP - SCRIPTS.INI parser
' CoName - find CompanyName in file

'R21
'added trap for VBScript version for W98/NT4
'added detection of W95 (interpreted as W98)
'added Err.Clear statement after every invocation of On Error Resume Next
'added script name to report header
'added namespace to WMI connection statement
'revised CoName function to concatenate several path strings and call
' 2nd function that uses WMI to retrieve co-name
'added functions: LRParse - parse load/run lines for executables
' CNCall - locate file in initial string, windows,
' system, app paths; retrieve co-name via WMI
'added co-name ID to all pgm sections
'removed output of value type from section I
'fixed bug in section VI - HKLM\...Winlogon\Userinit, infection alert
' was being issued when no comma in string
'changed BootExecute output in VI from output line for every
' multistring entry to single line

'R22
'fixed CNCall malformed path (leading backslash) bug, improved CNCall
'error handling; protected CoName from null or empty ImagePath strings
'due to deleted service left running

'R23
'changed strAUSUF to flagAUSUF in section XI
'added error handling for corrupt JOB file in section XII
'added function: JobFileRead
'changed "empty data" to "empty string" in CNCall
'added ".exe" to extension-less executable in JobFileRead

'R24
'revised R23 changes
'added back strTitleLine assignment in section XII

'R25
'added test for arHKCUKeys array in HKCU... Active Setup\Installed
' Components (section II)
'DIMed local variables in AppPath to avoid conflict with strValue used
' in Section VI; fixed same bug in IniLRS
'suppressed section title if both startup folders empty in section XI

'R26
'changed endpoint in services sort in section XIII so that sort
' included last service in initial array

'R27
'declared strFPSF & strFPWF Public (used in CoName sub)
'script host bug workaround: in some script versions,
' CreateTextFile/OpenTextFile with Create parameter=True overwrites
' file contents line by line instead of overwriting file, so now delete
' output file if it exists before writing to it
'added trap for CreateTextFile error
'added colons to all section titles
'added comments to better explain array in section I
'added to section V: HKCU...ShellServiceObjectDelayLoad
'added to section VI: GinaDLL
'added to section VII: Notify values for W2K (termsrv) & WS2K3 (=WXP)
'new section XI: AUTORUN.INF in root of fixed disks, renumbered XII-XIV
'added functions: NDTAR, NDAR, FmtTime
'changed function titles: W98Titles -> IniInfTitles; IniLRS -> IniInfParse
'modified function RegDataChk to handle no value or empty+expected value
'added script launch time to output file header

'R28
'new section IV: HKLM...Shell Extensions\Approved, renumbered V-XV
'restricted output in sections II, V, XIV
'added flagShowAll and "-all" command line parameter
'added header and footer comments, {++} indicator in non-default mode
' for HKCU/HKLM...Run keys
'subkey enumeration (EnumKey) via IsArray followed by For Each
'enabled WS2K3 operation, extended final popup to 5 seconds

'R29
'redirected browser to RED version in case of CreateTextFile error
'appended wscsvc to arMSSvc for WXP
'checked for null string returned by oReg.GetStringValue
'fixed bug under XP for script not stored in default script directory --
' CoName was always "file not found"
'in Section II (HKLM... Active Setup\Installed Components), avoid code
' section if HKLM Version name doesn't exist or value not set (exc for (W2K!)
'in Section III (HKLM... Explorer\Browser Helper Objects\), avoid
' output if InProcServer32 default value not set
'in Section V (HKLM... Explorer\SharedTaskScheduler), avoid code if
' IPS doesn't exist
'rewrote IDExe & revised CoName functions, eliminated CNCall

'R30
'added FmtHMS function, removed FmtTime function
'added hh.mm.ss to report file name
'use unique time for report title, removed launch time from report header
'default flagOut = "C" if neither WSCRIPT nor CSCRIPT detected
'in Section XIII, for executable in SU directory, send Path to IDExe
' instead of Name
'in IDExe & WSL functions, return Path property of GetFile object so path
' included if file located in VBS CurrentDirectory
'standardized CLSID InProcServer32 output line in Sections III, IV, V, VI to:
' " -> {CLSID}\InProcServer32\(Default) = "

'R31
'added instructions for WXP if Fso connection fails
'added instructions for W2K/WXP if WMI connection fails
'added StringFilter function to filter unwritable default values
'added to section VII: Policies\System\Shell for W2K
'added to section X: cmd, scr; added arExpVal (expected value array);
' get filetype from extension default value and check filetype
' shell\open\command
'removed DefExeTitles function
'added section XI: scrnsave.exe for NT4/W2K/WXP
'added to section XII: scrnsave.exe in SYSTEM.INI
'added section XVII: Winsock2 Service Provider DLLs
'modified IDExe to use common environment variables
'added section XVIII: IE URL prefixes

'R31.1
'added home page URL to report header

'R32
'removed quotes surrounding key\value name output in following sections:
' HKLM... Active Setup\Installed Components
' HKLM...Winlogon\Notify\
'added section X: HKCR\Protocols\Filter
'modified output format in Screen Saver section

'R33
'section II: HKLM-to-HKCU Active Setup/Installed Components key names
' made non-case-specific
'added to section VII: Winlogon\Taskman
'added to section XII: Wallpaper
'allowed URL\Prefixes names to contain trailing periods
'moved Services to next-to-last section (XX)
'trapped error & quit if running services can't be counted
'added section XIX: HOSTS
'added section XXI: Keyboard Driver Filters
'added sub: SRClose

'R34
'added section XVIII: Toolbars, Explorer Bars (active & dormant), Extensions
'section XX: detect tabs [Chr(09)] in addition to spaces as HOSTS file delimiter
'section XXI: moved DIM of two variables to main (errors not thrown
' by Option Explicit!)
'added flagPad to StringFilter function
'retrieved all InProcServer32 default values via GetExpandedStringValue
' instead of GetStringValue

'R35
'revised R34 notes
'introduced MS constant
'section V: added HKLM...Explorer\ShellExecuteHooks, modified allowed
' logic
'section VIII: added "&Discuss" to allowed Explorer Bars
'section XV: added INFECTION WARNING if executable located in startup directory
'changed flagPad to flagEmbedQ in StringFilter function

'R36
'added flagTest
'added section IX: HKLM...Windows NT\CurrentVersion\Image File Execution Options
'section XXI: checked HOSTS file location at HKLM...Tcpip\Parameters\DataBasePath

'R37
'added W95 & WMe compatibility
'sections III & XX: if ShowAll, write section titles if hive keys absent
'added section XIII: System/Group Policies
'moved wallpaper ahead of screen saver in section XIV
'in RegDataChk, sent "shell" line to LRParse for ID of malware CoName

'R38
'added script startup popup
'replaced EnumKeyData with EnumNVP and RtnValue functions, renamed
' ScrIP to ScrIFP
'added IERESETCounter, ResolveCLSID, TitleLineWrite functions
'section XIII: added Control Panel applet removal + 2 toolbar entries
' to Explorer values; added Policies\Microsoft\Internet Explorer
' subsection
'section XX (IE Toolbars, Explorer Bars, Extensions): moved CLSID
' titles (default values) to the CLSID line
'added section XXII: misc IE hijack points (IERESET.INF,
' URLSearchHooks, AboutURLS)
'section XXIII: detect tabs preceding spaces as HOST file delimiters
'added "--" tail to ShowAll report
'removed Messenger from allowed IE extensions (Messenger has
' vulnerable versions)

'R38.1
'section XXII: determined IERESET.INF format by reading 1st 2 chrs
'before opening to compare with local copy

'R39
'performed housekeeping on all opened objects
'section XIII: added Explorer\NoFolderOptions, NoWindowsUpdate,
' and DisableWindowsUpdateAccess; HKLM... Windows NT\SystemRestore
'added section XII: context menu shell extensions
'added section XVIII: DESKTOP.INI in local fixed drive directory
'added -supp command line parameter to skip DESKTOP.INI and dormant
' Explorer Bar sections
'SRClose: added -supp advisory and reformatted
'section XXIV: added IERESET.INF minimum size requirement
'section XXVI: added 5 services for W2KS & 1 for WXP
'report footer: added total run time, DESKTOP.INI folder search time,
' dormant Explorer Bar search time
'added popup to select -supp parameter
'fixed intMB Dim placement bug

'R40
'moved WMI installation detection after VBScript version & OS version
' detection
'switched supp search msgbox buttons so that "Yes" is default instead of "No"
'suppressed menu display time when using CSCRIPT.EXE
'section XIV: for WXP SP2, added NoExtensionManagement
'section XVIII: trapped error if letter assigned to RAW data
' (ex: Linux) partition
'section XXIV: added On Error trap for IERESET.INF lines
'function IDExe: simplified use of ExpandEnvironmentStrings
'function CoName: added StringFilter for Unicode names

'R40.1
'edited SRClose footer to cite pressing "No" instead of "Yes" at first
'msgbox for -supp option

'R41
'section VII: check for existence of BootExecute value before
' validating
'added section XXVIII: Print Monitors

'R42
'added WINVER.EXE file version for W95 SR2 (OEM)
'lengthened final Popup time from 5 to 20 seconds

'R43
'section XII: added HKLM... Control\SafeBoot\Option\UseAlternateShell

'R44
'sections III-IV-V-VI-XI-XII-XVIII-XXII-XXIV: modified CLSID\InProcServer32
' search to use HKCU, then HKLM
'section XI: modified Classes\PROTOCOLS\Filter search to use HKCU, then HKLM
'section XII: added ColumnHandlers
'section XIII: rewrote to output non-default values in HKCU/HKLM
'section XXV: improved function logic, added ExpandEnvironmentStrings
' to DataBasePath value
'added SOCValue sub and StrOutCR function
'WriteValueData function: protected strName with StringFilter
'CoName function: removed StringFilter for findable file with Unicode name

'R45
'added colOS WMI error trap
'section VII: added WOW\cmdline and WOW\wowcmdline values
'modified function RegDataChk to handle empty string or missing
' name/value pair
'changed "(no data)" to "(value not found)"

'R46
'section VII: removed output of BootExecute strLine on WriteLine error
'section XIII, SOCValue sub: added check for shell default value
'added DDEX sub to look for open\ddeexec value in SOCValue sub

'R47
'section VIII: added wgalogon to Winlogon\Notify allowed entries
'section XIII: output default executable string via StringFilter
'section XXI: arTSPFi (TSP output array) initial REDIM statement
' changed from (2,0) to (3,0)
'section XXVI: tested service pathname returned by WMI for null or
' empty string before storing in array
'for compatibility with IE 7 RC1, modified sections:
' IV (Shell Extensions)
' V (SharedTaskScheduler)
' XXIV (bypass of IERESET.INF check, AboutURLs)

'R48
'section VII: added HKLM\System\CurrentControlSet\Control\SecurityProviders\SecurityProviders

'R49
'added message box to confirm choice of supplementary search
'added IWarn/HWarn strings with explanatory footer note if present
'abandoned roman numerals for section numbers
'added SecTest for section testing
'changed OS version error e-mail address
'section 1: added W95-specific matrix; HKCU...RunOnceEx for all OS's
' Policies/Explorer/Run for WMe, Run/RunOnce subkey launch for WMe,
' removed Policies/Explorer/Run & RunOnce/Setup warnings for NT4
'section 12: added AllFilesystemObjects
'section 14: removed Policy hierarchization, added registry
' keys, added GPRCaller and GPReconizer subs
'section 15: due to Policy hierarchization changes, lost detection of
' Active Desktop status
'section 20: added XML parsing for WVa
'section 22: restored "dormant" IE explorer bars to default
' operation, removed "dormant" label
'RtnValue function fixed for REG_BINARY & REG_MULTI_SZ, added REG_QWORD
'StrOutCR function renamed to StrOutSep, 3rd arg is sep character
'all sections: ensured compatibility with Vista RC1

'R50
'section 10: added FileSysPath to script directory even if script file
' not found (due to disconnection from domain)
'section 13: added StringFilter to every occurrence of strOut in
' SOCValue & DDEX subs
'section 26: added WXP httpfilter service


'** Update Revision Number on line #15 **

#4 T.J.

T.J.
  • Topic Starter

  • Members
  • 16 posts
  • OFFLINE
  •  
  • Local time:09:07 AM

Posted 15 July 2007 - 03:07 PM

FYI, I also just started seeing a Symantec message about Adware.CPush... FYI.

#5 YounGun

YounGun

    The malware-fighting kid


  • Members
  • 244 posts
  • OFFLINE
  •  
  • Gender:Male
  • Location:Romania, Bucharest
  • Local time:03:07 PM

Posted 16 July 2007 - 02:20 AM

You have posted the silentrunners.vbs - that is the file you need to run, and it will produce a log that you need to post here.




0 user(s) are reading this topic

0 members, 0 guests, 0 anonymous users