Here is the log from silentrunnner:
Regards,
Saksham
'Silent Runners.vbs -- find out what programs start up with Windows!
'
'DO NOT REMOVE THIS HEADER!
'
'Copyright Andrew ARONOFF 21 January 2005,
http://www.silentrunners.org/
'This script is provided without any warranty, either expressed or implied
'It may not be copied or distributed without permission
'
'** YOU RUN THIS SCRIPT AT YOUR OWN RISK! **
'HEADER ENDS HERE
Option Explicit
Dim strRevNo : strRevNo = "30"
'This script is divided into 15 sections.
'Each section outputs the contents of
'registry keys (I-X), INI/INF-files (XI-XII), folders (XIII),
'enabled scheduled tasks (XIV) and started services (XV)
'which may harbor malware.
'Output is suppressed if registry key or file contents are deemed
'to be normal.
' I. HKCU/HKLM... Run/RunOnce/RunOnce\Setup
' HKLM... RunOnceEx/RunServices/RunServicesOnce
' HKCU/HKLM... Policies\Explorer\Run
' II. HKLM... Active Setup\Installed Components\
' HKCU... Active Setup\Installed Components\
' (StubPath <> "" And HKLM version # > HKCU version #)
' III. HKLM... Explorer\Browser Helper Objects\
' IV. HKLM... Shell Extensions\Approved\
' V. HKLM... Explorer\SharedTaskScheduler\ (InProcServer32 <> "browseui.dll")
' VI. HKCU/HKLM... ShellServiceObjectDelayLoad\
' VII. HKCU... Command Processor\AutoRun ((default) <> "")
' HKCU... Windows\load & run ((default) <> "")
' HKCU... Command Processor\AutoRun ((default) <> "")
' HKLM... Windows\AppInit_DLLs ((default) <> "")
' HKLM... Winlogon\Shell/Userinit/System/Ginadll ((default) <> explorer.exe, userinit.exe, "", "")
'VIII. HKLM... Winlogon\Notify\ (subkey names/DLLName values <> O/S-specific dictionary data)
' IX. HKCU/HKLM... Policies... Startup/Shutdown, Logon/Logoff
' X. HKCR executable file type (bat/com/exe/hta/pif)
' (shell\open\command data <> "%1" %*; hta <> mshta.exe "%1" %*)
' XI. WIN.INI (load/run <> ""), SYSTEM.INI (shell <> explorer.exe), WINSTART.BAT
' XII. AUTORUN.INF in root of fixed drive (open/shellexecute <> "")
'XIII. %WINDIR%... Startup & All Users... Startup (W98/WME) or
' %USERNAME%... Startup & All Users... Startup folder contents
' XIV. Scheduled Tasks
' XV. Started Services
Dim Wshso : Set Wshso = WScript.CreateObject("WScript.Shell")
Dim WshoArgs : Set WshoArgs = WScript.Arguments
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
Dim oNetwk : Set oNetwk = WScript.CreateObject("WScript.Network")
Const HKLM = &H80000002 : Const HKCU = &H80000001
Const REG_SZ = 1 : Const REG_EXPAND_SZ = 2 : Const REG_BINARY = 3
Const REG_DWORD = 4 : Const REG_MULTI_SZ = 7
'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 intMB 'MsgBox return value
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 intErrNum, intErrNum1, intErrNum2, intErrNum3, intErrNum4 'error number
Dim strURL 'download URL
'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
On Error Goto 0
Err.Clear
'if old VBScript 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 VBScript 5.1 or higher " &_
"to run." & vbCRLF & vbCRLF & "The latest version of VBScript 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." & vbCRLF & vbCRLF & "(WMI is also required. If it's " &_
"missing, download instructions will appear later.)", _
vbOKCancel + vbExclamation,"Unsupported VBScript 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 " &_
"VBScript 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 '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 (interpreted as Windows 98)"
ElseIf Instr(Left(strSysVer,3),"5.0") > 0 Then
strOS = "W2K" : strOSLong = "Windows 2000"
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"
If Instr(strSysVer,".2180") > 0 Then strOSLong = "Windows XP SP2"
ElseIf Instr(Left(strSysVer,3),"4.9") > 0 Then
strOS = "WME" : strOSLong = "Windows Millennium"
ElseIf Instr(Left(strSysVer,3),"5.2") > 0 Then
strOS = "WXP" : strOSLong = "Windows Server 2003 (interpreted as Windows XP)" 'WS2K3
Else
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" &_
"<%73%72.%6F%73.%76%65%72.%65%72%72%6F%72@%61%61%72%6F%6E%6F%66%66.%63%6F%6D>?subject=Silent%20Runners%20" &_
"OS%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
WScript.Quit
End If
'array of Run keys, counter x 5, hive member, startup folder file, startup file shortcut
Dim arRunKeys, i, ii, j, k, l, oHiveElmt, oSUFi, oSUSC
'Run key names, keys, sub-keys, value type, name member, key member x 2, sub-key
Dim arNames(), arKeys(), arSubKeys(), arType, oName, oKey, oKey2, strSubKey
'values x 3, name, output string, single character, startup folder name, startup folder
Dim strValue, strValue2, strValue3, strName, strOut, strChr, arSUFN, oSUF
'output file msg x 2, warning string, title line, register key x 3, executable extension array
Dim strLine, strLine1, strLine2, strWarn, strTitleLine, strKey, strKey2, strKey3, arExeExt
'output file name string, PIF path string, single binary character, script launch time
Dim strFN, strPIFTgt, bin1C, datLaunch
Public flagShowAll : flagShowAll = False 'TRUE if show all output (default values not filtered)
Dim strRptOutput : strRptOutput = "Output limited to non-default values, " &_
"except where indicated by " & Chr(34) & "{++}" & Chr(34) 'output file string
Public flagTLW : flagTLW = False 'flag Title Line Written
Public flagSTLW : flagSTLW = False 'flag Sub-Title Line Written
Dim flagInfect : flagInfect = False 'flag infected condition
Dim flagMatch 'flag matching keys
Dim flagAllow 'flag key on approved list
Dim flagDirArg : flagDirArg = False 'presence of output directory argument
Dim flagAllArg : flagAllArg = False 'presence of all output argument
Dim intLBSP 'Last BackSlash Position in path string
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
'constant dictionary
Dim arHives(1,1)
arHives(0,0) = "HKCU" : arHives(1,0) = "HKLM"
arHives(0,1) = &H80000001 : arHives(1,1) = &H80000002
'check if output directory or "-all" 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."
'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 &_
"Only two arguments are permitted:" & vbCRLF & vbCRLF &_
"1. the name of an existing directory" & vbCRLF &_
Space(4) & "(embed in quotes if it contains spaces)" & vbCRLF & vbCRLF &_
"2. " & Chr(34) & "-all" & Chr(34) & " to output all non-empty values.",10, _
"Bad Script Argument", vbOKOnly + vbExclamation
Else 'flagOut = "C" 'write the message to the console
WScript.Echo "The argument: " &_
Chr(34) & UCase(WshoArgs(i)) & Chr(34) &_
" can't be interpreted." & vbCRLF & vbCRLF &_
"Only two arguments are permitted:" & vbCRLF & vbCRLF &_
"1. the name of an existing directory (embed in quotes if it " &_
"contains spaces)" & vbCRLF &_
"2. " & Chr(34) & "-all" & Chr(34) & " to output all non-empty values." & 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 & "Only two arguments are permitted:" & vbCRLF & vbCRLF &_
"1. the name of an existing directory" & vbCRLF &_
Space(4) & "(embed in quotes if it contains spaces)" & vbCRLF & vbCRLF &_
"2. " & Chr(34) & "-all" & Chr(34) & " to output all non-empty values.",_
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 & "Only two arguments are permitted:" & vbCRLF &_
"1. the name of an existing directory (embed in quotes if it contains spaces)" & vbCRLF &_
"2. " & Chr(34) & "-all" & Chr(34) & " to output all non-empty values." & vbCRLF
End If 'WScript host?
WScript.Quit
End If 'directory arguments passed?
'create output file name with computer name & today's date
'Startup Programs (pc_name_here) yyyy-mm-dd.txt
datLaunch = Now
strFN = strPathOFFo & "Startup Programs (" & oNetwk.ComputerName & ") " &_
FmtDate(datLaunch) & " " & FmtHMS(datLaunch) & ".txt"
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
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 e-mail me & 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 & vbCRLF & "Operating System: " & strOSLong & vbCRLF &_
strRptOutput & vbCRLF & vbCRLF
'use WMI to connect to the registry
On Error Resume Next
Dim oReg : Set oReg = GetObject("winmgmts:root\default:StdRegProv")
intErrNum = Err.Number
On Error Goto 0
Err.Clear
'WMI connection error
If intErrNum <> 0 Then
strURL = "http://tinyurl.com/7wd7"
If strOS = "W98" Then strURL = "http://tinyurl.com/jbxe"
'add to report file
oFN.WriteLine "This script requires WMI, which can be downloaded at: " & strURL
oFN.Close
'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 + vbExclamation,"WMI Not Installed!")
If intMB = 1 Then Wshso.Run strURL
'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
WScript.Quit
End If 'WMI execution error
'I. Examine HKCU/HKLM... Run/RunOnce/RunOnceEx/RunServices/RunServicesOnce
' and HKCU/HKLM... Policies\Explorer\Run
'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
'Hive HKCU - 0 HKLM - 1
'
'Key 0 1 2 3 4 5 6 0 1 2 3 4 5 6
'Index
'
'O/S:
'W98 0,0 2,0 2,0 0,0 0,0 0,0 0,0 0,0 2,0 2,0 2,0 2,1 2,0 2,0
'WME 0,0 2,0 2,0 0,0 0,0 0,0 0,0 0,0 2,0 2,0 2,0 2,1 2,0 2,0
'NT4 1,0 2,0 2,0 0,0 0,0 0,0 0,0 1,0 2,0 2,0 1,0 2,1 0,0 0,0
'W2K 2,1 2,1 2,1 0,0 0,0 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 0,0 0,0 0,0 2,0 2,0 2,0 1,0 2,1 0,0 0,0
'WS2K3 ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ???
'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 0,0 2,0 2,0 0,0 0,0 0,0 0,0 0,0 2,0 2,0 2,0 2,1 2,0 2,0
If strOS = "W98" Or strOS = "WME" Then
arRegFlag(0,1,0) = 2 'HKCU,Run = no-warn
arRegFlag(0,2,0) = 2 'HKCU,RunOnce = no-warn
arRegFlag(1,1,0) = 2 'HKLM,Run = no-warn
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 1,0 2,0 2,0 0,0 0,0 0,0 0,0 1,0 2,0 2,0 1,0 2,1 0,0 0,0
If strOS = "NT4" Then
arRegFlag(0,0,0) = 1 'HKCU,Explorer\Run = warning
arRegFlag(0,1,0) = 2 'HKCU,Run = no-warn
arRegFlag(0,2,0) = 2 'HKCU,RunOnce = no-warn
arRegFlag(1,0,0) = 1 'HKLM,Explorer\Run = warning
arRegFlag(1,1,0) = 2 'HKLM,Run = no-warn
arRegFlag(1,2,0) = 2 'HKLM,RunOnce = no-warn
arRegFlag(1,3,0) = 1 'HKLM,RunOnce\Setup = warning
arRegFlag(1,4,0) = 2 'HKLM,RunOnceEx = no-warn
arRegFlag(1,4,1) = 1 'HKLM,RunOnceEx = sub-keys
End If
'W2K 2,1 2,1 2,1 0,0 0,0 0,0 0,0 2,1 2,1 2,1 0,0 2,1 0,0 0,0
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
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
arRegFlag(1,4,0) = 2 'HKLM,RunOnceEx = no-warn
arRegFlag(1,4,1) = 1 'HKLM,RunOnceEx = sub-keys
End If
'WXP 2,0 2,0 2,0 0,0 0,0 0,0 0,0 2,0 2,0 2,0 1,0 2,1 0,0 0,0
If strOs = "WXP" 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(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,3,0) = 1 'HKLM,RunOnce\Setup = warning
arRegFlag(1,4,0) = 2 'HKLM,RunOnceEx = no-warn
arRegFlag(1,4,1) = 1 'HKLM,RunOnceEx = sub-keys
End If
'write registry header lines to file
strLine = "Startup items buried in registry:"
oFN.WriteLine strLine
oFN.WriteLine String(Len(strLine),"-")
oFN.WriteBlankLines (1)
'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
'intialize string with warning if necessary
strWarn = ""
If arRegFlag(i,j,0) = 1 Then strWarn = "EXECUTION UNLIKELY: "
'find key's entries
EnumKeyData arHives(i,1), arHives(i,0), arRunKeys(j), strWarn
'recurse subkeys if necessary
If arRegFlag(i,j,1) = 1 Then
'put all subkeys into array
oReg.EnumKey arHives(i,1),arRunKeys(j),arKeys
'with no sub-keys:
' IsArray TypeName UBound
'W98 True "Variant()" -1
'NT4 True "Variant()" -1
'W2K False "Null" --
'WXP False "Null" --
'WS2K3 True "Variant()" --
'if sub-keys exist (W2K/WXP)
If IsArray(arKeys) Then
'for each subkey (W98/NT4/WXP will not iterate)
For Each oKey in arKeys
'find key's entries
EnumKeyData arHives(i,1), arHives(i,0), arRunKeys(j) & "\" & oKey, strWarn
Next
End If 'sub-keys exist? W2K/WXP/WS2K3
End If 'enum sub-keys?
End If 'arRegFlag(i,j,0) > 0
Next 'Run key
Next 'Hive
'recover array memory
ReDim arRunKeys(0)
ReDim arKeys(0)
ReDim arRegFlag(0,0,0)
'II. Examine HKLM... Active Setup\Installed Components
'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"
'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
'Default Value not set:
'W98: returns 0, strValue = ""
'NT4/W2K/WXP: returns non-zero, strValue = Null
'Non-Default name inexistent:
'W98/NT4/W2K/WXP: returns non-zero, strValue = Null
'Non-Default Value not set:
'W2K: returns 0, strValue = unwriteable string
'W98/NT4/WXP: 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 strHKLMKey = 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
'output the title line if not already done
If Not flagTLW Then
oFN.WriteLine "HKLM" & "\" & strKey & "\"
flagTLW = True
End If
'output the CLSID & pgm name
oFN.WriteLine Chr(34) & strHKLMKey & "\(Default)" & Chr(34) & " = " &_
strPgmName
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 output occurred in this section, add a blank line
If flagTLW Then
oFN.WriteBlankLines (1)
'if no output occurred, but ShowAll, output the key name
ElseIf flagShowAll Then
oFN.WriteLine "HKLM" & "\" & strKey & "\" & vbCRLF
End If
flagTLW = False
'recover array memory
ReDim arHKLMKeys(0)
ReDim arHKCUKeys(0)
'III. Examine HKLM... Explorer\Browser Helper Objects
strKey = "Software\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects"
'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
If Not flagTLW Then
oFN.WriteLine "HKLM" & "\" & strKey & "\"
flagTLW = True
End If
If Len(strSubKey) = 38 Then 'strSubKey is CLSID
'get the default value
intErrNum1 = oReg.GetStringValue (HKLM,strKey & "\" & strSubKey,"",strValue)
'if the BHO title exists, embed it in quotes
If intErrNum1 = 0 And strValue <> "" Then
strValue = Chr(34) & strValue & Chr(34)
Else 'check the CLSID default value
strKey2 = "Software\Classes\CLSID\" & strSubKey
intErrNum2 = oReg.GetStringValue (HKLM,strKey2,"",strValue2)
'if the CLSID default value exists, embed it in quotes and say where it came from
If intErrNum2 = 0 And strValue2 <> "" Then
strValue = Chr(34) & strValue2 & Chr(34) & " [from CLSID]"
Else 'use a standard string
strValue = "(no title provided)"
End If 'CLSID title exists?
End If 'BHO title exists?
'resolve the data via HKLM\Software\Classes\CLSID\{data}\InProcServer32
strKey3 = "Software\Classes\CLSID\" & strSubKey & "\InProcServer32"
intErrNum3 = oReg.GetExpandedStringValue (HKLM,strKey3,"",strValue3)
'if InProcServer32 key exists and default value set
If intErrNum3 = 0 And strValue3 <> "" Then
strValue3 = Chr(34) & strValue3 & Chr(34) & CoName(IDExe(strValue3))
'write the quote-delimited name and value to a file
oFN.WriteLine strSubKey & "\(Default) = " & strValue
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " & strValue3
End If 'InProcServer32 key exists And default value set?
End If 'strSubKey CSID?
Next 'BHO subkey
Else 'BHO subkeys don't exist
'if ShowAll, output the key name
If flagShowAll Then
oFN.WriteLine "HKLM" & "\" & strKey & "\"
flagTLW = True
End if
End If 'BHO subkeys exist?
If flagTLW Then oFN.WriteBlankLines (1)
flagTLW = False
'recover array memory
ReDim arSubKeys(0)
'IV. Examine HKLM... Shell Extensions\Approved\
'CLSID value, InProcessServer32 DLL name & output file version
Dim strCLSID, strIPSDLL, strIPSDLLOut
'Shell Extension Approved array
Dim arSEA()
ReDim arSEA(239,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"
'MS PowerToys
arSEA(230,0) = "{AA7C7080-860A-11CE-8424-08002B2CFF76}" : arSEA(230,1) = "SENDTOX.DLL"
arSEA(231,0) = "{7BB70120-6C78-11CF-BFC7-444553540000}" : arSEA(231,1) = "SENDTOX.DLL"
arSEA(232,0) = "{7BB70122-6C78-11CF-BFC7-444553540000}" : arSEA(232,1) = "SENDTOX.DLL"
arSEA(233,0) = "{7BB70121-6C78-11CF-BFC7-444553540000}" : arSEA(233,1) = "SENDTOX.DLL"
arSEA(234,0) = "{7BB70123-6C78-11CF-BFC7-444553540000}" : arSEA(234,1) = "SENDTOX.DLL"
arSEA(235,0) = "{9E56BE62-C50F-11CF-9A2C-00A0C90A90CE}" : arSEA(235,1) = "SENDTOX.DLL"
arSEA(236,0) = "{90A756E0-AFCF-11CE-927B-0800095AE340}" : arSEA(236,1) = "target.dll"
arSEA(237,0) = "{afc638f0-e8a4-11ce-9ade-00aa00a42d2e}" : arSEA(237,1) = "TTFExtNT.dll"
'etc
arSEA(238,0) = "{1D2680C9-0E2A-469d-B787-065558BC7D43}" : arSEA(238,1) = "mscoree.dll"
arSEA(239,0) = "{5F327514-6C5E-4d60-8F16-D07FA08A78ED}" : arSEA(239,1) = "wuaueng.dll"
'set up key name to query
strKey = "Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved"
'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
'assume CLSID unapproved, empty warning string
flagMatch = False
'if retrieved string in CLSID format
If Len(strCLSID) = 38 And Left(strCLSID,1) = "{" Then
'try getting shellex title from Shell Extensions\Approved value
'title retrieved successfully even if value of type REG_EXPAND_SZ
oReg.GetStringValue HKLM,strKey,strCLSID,strValue
'for W98/NT4/WXP: if value not set, may be able to obtain title from the CLSID
If strValue = "" Then
strKey2 = "Software\Classes\CLSID\" & strCLSID
intErrNum2 = oReg.GetStringValue (HKLM,strKey2,"",strValue2)
'if CLSID key exists And default value set
If intErrNum2 = 0 And strValue2 <> "" Then
strValue = Chr(34) & strValue2 & Chr(34) & " [from CLSID]"
Else 'either CLSID key doesn't exist or title not present
strValue = "(no title provided)"
End If
Else 'title obtained from Approved name (for W2K, may be garbage)
strValue = Chr(34) & strValue & Chr(34)
End If 'strValue empty?
'strIPSDLL = InProcServer32 DLL
'resolve the name via HKLM\Software\Classes\CLSID\{name}\InProcServer32
strKey3 = "Software\Classes\CLSID\" & strCLSID & "\InProcServer32"
intErrNum3 = oReg.GetStringValue (HKLM,strKey3,"",strIPSDLL)
'if InProcServer32 name exists And not empty
If intErrNum3 = 0 And strIPSDLL <> "" Then
'find CoName
strCN = CoName(IDExe(strIPSDLL))
'for every member of approved shellex array
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]" 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
'output the title line if not already done
If Not flagTLW Then
oFN.WriteLine "HKLM" & "\" & strKey & "\"
flagTLW = True
End If
On Error Resume Next
'output CLSID & title
oFN.WriteLine Chr(34) & strCLSID & Chr(34) & " = " & strValue
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)"
On Error GoTo 0
'output InProcServer32 DLL & CoName
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " &_
Chr(34) & strIPSDLL & Chr(34) & CoName(IDExe(strIPSDLL))
End If 'flagMatch?
End If 'InProcServerDLL name exists?
End If 'strCLSID is CLSID?
Next 'arNames array member
Else 'arNames array not returned
'if ShowAll, output key name
If flagShowAll Then
oFN.WriteLine "HKLM" & "\" & strKey & "\"
flagTLW = True
End If
End If 'intErrNum1 = 0 & arNames array exists?
If flagTLW Then oFN.WriteBlankLines (1)
flagTLW = False
'recover array memory
ReDim arSEA(0,0)
'V. Examine HKLM... Explorer\SharedTaskScheduler
strKey = "Software\Microsoft\Windows\CurrentVersion\Explorer\SharedTaskScheduler"
'find all the names in the key
oReg.EnumValues HKLM, strKey, arNames, arType
'enumerate data if present
If IsArray(arNames) Then
'for each name
For Each strName In arNames
If Len(strName) = 38 And Left(strName,1) = "{" Then 'strName is CLSID
strWarn = ""
'get the value for the title
oReg.GetStringValue HKLM,strKey,strName,strValue
'detect if value not set for W98/NT4/WXP
If strValue = "" Then
strValue = "(no title provided)"
Else 'embed title (may be garbage in W2K) in quotes
strValue = Chr(34) & strValue & Chr(34)
End If
'resolve the data via HKLM\Software\Classes\CLSID\{data}\InProcServer32
strKey2 = "Software\Classes\CLSID\" & strName & "\InProcServer32"
intErrNum = oReg.GetExpandedStringValue (HKLM,strKey2,"",strValue2)
'if IPS value exists and is not empty
If intErrNum = 0 And strValue2 <> "" Then
'embed IPS value in quotes & append coname
strOut = Chr(34) & strValue2 & Chr(34) & CoName(IDExe(strValue2))
'fill warning if unexpected value found
strLine = LCase(Fso.GetSpecialFolder(SysFolder).Path)
If InStr(LCase(strValue2),strLine & "\browseui.dll") = 0 Then _
strWarn = "INFECTION WARNING! "
'if value unexpected or ShowAll, output name & value
If InStr(LCase(strValue2),strLine & "\browseui.dll") = 0 Or flagShowAll Then
'output the title line if not already done
If Not flagTLW Then
oFN.WriteLine "HKLM" & "\" & strKey & "\"
flagTLW = True
End If
On Error Resume Next
oFN.WriteLine strWarn & Chr(34) & strName & Chr(34) &_
" = " & strValue
'error check for W2K if SharedTaskScheduler value not set
If Err.Number <> 0 Then oFN.WriteLine Chr(34) & strName & Chr(34) &_
" = (no title provided)"
Err.Clear
On Error GoTo 0
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " &_
strOut
End If 'unexpected data or ShowAll?
End If 'IPS value exists?
Else 'strName is _not_ CLSID
'output the title line if not already done
If Not flagTLW Then
oFN.WriteLine "HKLM" & "\" & strKey & "\"
flagTLW = True
End If
oFN.WriteLine Chr(34) & strName & Chr(34) & " = ** INVALID DATA (not CLSID) **"
End If 'strName CLSID?
Next 'arNames array member
Else 'arNames array not returned
'if ShowAll, output key name
If flagShowAll Then
oFN.WriteLine "HKLM" & "\" & strKey & "\"
flagTLW = True
End If
End If 'arNames array exists
If flagTLW Then oFN.WriteBlankLines (1)
flagTLW = False
'recover array memory
ReDim arNames(0)
'VI. Examine HKCU/HKLM... ShellServiceObjectDelayLoad
strKey = "Software\Microsoft\Windows\CurrentVersion\ShellServiceObjectDelayLoad"
'Dim arHives(1,1)
'arHives(0,0) = "HKCU" : arHives(1,0) = "HKLM"
'arHives(0,1) = &H80000001 : arHives(1,1) = &H80000002
Dim arSSODL() 'array of allowable SSODL values
'flagMatch = TRUE if SSODL value is allowable
'form array of allowable SSODL values
ReDim arSSODL(5,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"
For i = 0 To 1 'for each hive
'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 name
For Each strName In arNames
flagMatch = False 'SSODL entry is not allowable
'get the CLSID value
oReg.GetStringValue arHives(i,1),strKey,strName,strValue
If Len(strValue) = 38 And Left(strValue,1) = "{" Then 'value is CLSID
'find the data for HKLM\Software\Classes\CLSID\{this data}\InProcServer32
strKey2 = "Software\Classes\CLSID\" & strValue & "\InProcServer32"
intErrNum = oReg.GetStringValue (HKLM,strKey2,"",strValue2)
'if IPS value exists And is not empty
If intErrNum = 0 And strValue2 <> "" Then
strCN = CoName(IDExe(strValue2))
strDLL = Fso.GetFileName(strValue2)
'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
If LCase(arSSODL(j,0)) = LCase(strValue) And _
LCase(arSSODL(j,1)) = LCase(strDLL) And _
LCase(strCN) = " [ms]" Then _
flagMatch = True 'toggle flag if all three match known values
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
If Not flagTLW Then
'write the full key name
oFN.WriteLine arHives(i,0) & "\" & strKey & "\"
flagTLW = True
End If
'output SSODL value
oFN.WriteLine Chr(34) & strName & Chr(34) & " = " & Chr(34) & strValue & Chr(34)
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " &_
Chr(34) & strValue2 & Chr(34) & strCN
End If 'unknown SSODL value?
Else 'IPS does not exist or is empty
'output title line if not already done
If Not flagTLW Then
'write the full key name
oFN.WriteLine arHives(i,0) & "\" & strKey & "\"
flagTLW = True
End If
'output SSODL value
oFN.WriteLine Chr(34) & strName & Chr(34) & " = " & Chr(34) & strValue & Chr(34)
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " &_
"(value not set)"
End If
Else 'corrupt CLSID
'output title line if not already done
If Not flagTLW Then
'write the full key name
oFN.WriteLine arHives(i,0) & "\" & strKey & "\"
flagTLW = True
End If
'write the quote-delimited name and bad data warning to the file
oFN.WriteLine Chr(34) & strName & Chr(34) & " = ** INVALID DATA (not CLSID) **"
End If 'CLSID?
Next 'SSODL value
Else 'arNames not returned
'if ShowAll, output key name
If flagShowAll Then
oFN.WriteLine arHives(i,0) & "\" & strKey & "\"
flagTLW = True
End If
End If 'arNames array exists
If flagTLW Then oFN.WriteBlankLines (1)
flagTLW = False
Next 'hive
'clean up
strLine = ""
flagMatch = False
'recover array memory
ReDim arType(0)
ReDim arNames(0)
ReDim arSSOLD(0,0)
'VII. Find values of specific names:
' HKCU... Command Processor\AutoRun
' HKCU... Policies\System\Shell (XP only!)
' HKCU... Windows\load & run
' HKCU... Command Processor\AutoRun
' HKCU... Winlogon\Shell
' HKLM... Windows\AppInit_DLLs
' HKLM... Winlogon\Shell & Userinit & System & Ginadll
'value length, pos'n of space/comma in value
Dim intLenValue, intSpacePosn, intCommaPosn
If strOS <> "W98" And strOS <> "WME" Then
'HKCU\Software\Microsoft\Command Processor\AutoRun
RegDataChk HKCU, "SOFTWARE\Microsoft\Command Processor", "AutoRun", strValue, ""
If flagTLW Then oFN.WriteBlankLines (1)
flagTLW = False
If strOS = "WXP" Then
'HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\Shell
'"Shell" = ""
RegDataChk HKCU, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System", "Shell", strValue, ""
If flagTLW Then oFN.WriteBlankLines (1)
flagTLW = False
End If 'WXP?
'HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows\load & run
RegDataChk HKCU, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows", "load", strValue, ""
RegDataChk HKCU, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows", "run", strValue, ""
If flagTLW Then oFN.WriteBlankLines (1)
flagTLW = False
'HKCU\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell
'"Shell" = "Explorer.exe"
RegDataChk HKCU, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "Shell", strValue, "explorer.exe"
If flagTLW Then oFN.WriteBlankLines (1)
flagTLW = False
'HKLM\Software\Microsoft\Command Processor\AutoRun
RegDataChk HKLM, "SOFTWARE\Microsoft\Command Processor", "AutoRun", strValue, ""
If flagTLW Then oFN.WriteBlankLines (1)
flagTLW = False
'HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows\AppInit_DLLs
RegDataChk HKLM, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows", "AppInit_DLLs", strValue, ""
If flagTLW Then oFN.WriteBlankLines (1)
flagTLW = False
'HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\GinaDLL
'"GinaDLL" = "MSGina.dll"
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\Userinit
'"Userinit" = "%SystemRoot%\system32\userinit.exe,"
'find value for "Userinit"
Stumble It!
Tweet This
Bookmark on Delicious
Share on Facebook
Share on MySpace