 przez banior 12 Cze 2006, 20:57
przez banior 12 Cze 2006, 20:57 
						zaznaczam i usuwam wpis ale on ciagle pozostaje...
oto log
[code]
'Silent Runners.vbs -- find out what programs start up with Windows!
'
'DO NOT REMOVE THIS HEADER!
'
'Copyright Andrew ARONOFF 24 April 2006, 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 = "45"
Public flagTest : flagTest = False  'True if testing
'flagTest = True  'Uncomment to test
'This script is divided into 28 sections.
'malware launch points:
' registry keys (I-XII, XV)
' INI/INF-files (XVI-XVIII)
' folders (XIX)
' enabled scheduled tasks (XX)
' Winsock2 service provider DLLs (XXI)
' IE toolbars, explorer bars, extensions (XXII)
' started services (XXVI)
' keyboard driver filters (XXVII)
' printer monitors (XXVIII)
'hijack points:
' System/Group Policies (XIV)
' prefixes for IE URLs (XXIII)
' misc IE points (XXIV)
' HOSTS file (XXV)
'Output is suppressed if deemed normal unless the -all parameter is used 
'Sections XVIII & XXII-dormant Explorer Bars are skipped unless the -supp/-all 
' parameters are used or the first message box is answered "No" 
'     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/ShellExecuteHooks
'    VI. HKCU/HKLM... ShellServiceObjectDelayLoad\ 
'   VII. HKCU... Command Processor\AutoRun ((default) <> "")
'        HKCU... Policies\System\Shell (W2K & WXP only)
'        HKCU... Windows\load & run ((default) <> "")
'        HKCU... Command Processor\AutoRun ((default) <> "")
'        HKLM... Windows\AppInit_DLLs ((default) <> "")
'        HKLM... Winlogon\Shell/Userinit/System/Ginadll/Taskman
'         ((default) <> explorer.exe, userinit.exe, "", "", "")
'        HKLM... Control\SafeBoot\Option\UseAlternateShell
'        HKLM... Control\Session Manager\BootExecute 
'        HKLM... Control\Session Manager\WOW\cmdline, wowcmdline 
'  VIII. HKLM... Winlogon\Notify\ (subkey names/DLLName values <> O/S-specific dictionary data) 
'    IX. HKLM... Image File Execution Options\ (subkeys with name = "Debugger")
'     X. HKCU/HKLM... Policies... Startup/Shutdown, Logon/Logoff
'    XI. HKCU/HKLM Protocols\Filter
'   XII. Context menu shell extensions
'  XIII. HKCR executable file type (bat/cmd/com/exe/hta/pif/scr)
'         (shell\open\command data <> "%1" %*; hta <> mshta.exe "%1" %*; scr <> "%1" /S)
'   XIV. System/Group Policies
'    XV. Enabled Wallpaper & Screen Saver
'   XVI. WIN.INI (load/run <> ""), SYSTEM.INI (shell <> explorer.exe, scrnsave.exe), WINSTART.BAT 
'  XVII. AUTORUN.INF in root of fixed drive (open/shellexecute <> "")
' XVIII. DESKTOP.INI in any local fixed disk directory (section skipped by default) 
'   XIX. %WINDIR%... Startup & All Users... Startup (W98/WME) or
'        %USERNAME%... Startup & All Users... Startup folder contents
'    XX. Scheduled Tasks
'   XXI. Winsock2 Service Provider DLLs
'  XXII. Internet Explorer Toolbars, Explorer Bars, Extensions (dormant 
'         Explorer Bars section skipped by default) 
' XXIII. Internet Explorer URL Prefixes
'  XXIV. Misc. IE Hijack Points
'   XXV. HOSTS file
'  XXVI. Started Services
' XXVII. Keyboard Driver Filters
'XXVIII. Printer Monitors
Dim Wshso : Set Wshso = WScript.CreateObject("WScript.Shell")
Dim WshoArgs : Set WshoArgs = WScript.Arguments
Dim intErrNum, intMB  'Err.Number, MsgBox return value
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 MS = " [MS]"
Const DQ = """"
'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
Dim flagGP : flagGP = False  'assume Group Policies cannot be set in the O/S
Dim intCLL : intCLL = 1  'CLSID Lower Limit, default is for O/S <= NT4
'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 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  '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
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" &_
   "<%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%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 Or WXP, explain how to start the WMI service
 ElseIf strOS = "W2K" Or strOS = "WXP" Then
  If strOS = "W2K" Then strLine = "Settings, "
  '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 &_
    "Control Panel, 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 & "Control Panel, 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, Protocol filters
Dim arNames(), arKeys(), arSubKeys(), arType, arFilter()
'Sub-Directory DeskTop.Ini array, Sub-Directory Error array
Public arSDDTI(), arSDErr()
'DeskTop.Ini counter, Error counter, Classes data Hive counter
Public ctrArDTI, ctrArErr, 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, intValue 
'name, single character, startup folder name, startup folder, array member, temp var 
Dim strName, strChr, arSUFN, oSUF, strArMember, strTmp
'output string x 3
Public strOut, strOut1, strOut2
'output file msg x 2, warning string, title line
Dim strLine, strLine1, strLine2, strWarn, strTitleLine
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
                                    'or for dormant Explorer Bars
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 and all Registry CLSIDs for dormant" &_
 vbCRLF & strLSp & "Explorer Bars" &_
 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 and of " &_
    "all Registry CLSIDs for dormant Explorer Bars" & 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 searches?" &_
  vbCRLF & "(They typically take several minutes.)" & vbCRLF & vbCRLF &_
  "Press " & Chr(34) & "Yes" & Chr(34) & Space(5) &_
  " to skip the supplementary searches (default)" & vbCRLF & vbCRLF &_ 
  Space(10) & Chr(34) & "No" & Chr(34) & Space(6) &_
  " to perform them, 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 searches?",_
  vbYesNoCancel + vbQuestion + vbDefaultButton1 + vbSystemModal) 
 If intMB = vbNo Then
  flagSupp = True
 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 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 & ", http://www.silentrunners.org/" &_
 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
'I. Examine HKCU/HKLM... Run/RunOnce/RunOnceEx/RunServices/RunServicesOnce
'   and HKCU/HKLM... Policies\Explorer\Run
If Not flagTest Then  'skip if testing
'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
'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
'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: " 
   '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"       --
   'WXP    False      "Null"       --
   'WS2K3  True     "Variant()"    --
   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 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
   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?
'II. Examine HKLM... Active Setup\Installed Components
If Not flagTest Then  'skip if testing
'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
 'Default Value not set:
 'W98/WME:     returns 0,        strValue = ""
 'NT4/W2K/WXP: returns non-zero, strValue = Null
 'Non-Default name inexistent:
 'W98/WME/NT4/W2K/WXP: returns non-zero, strValue = Null
 'Non-Default Value not set:
 'W2K:             returns 0, strValue = unwritable string 
 'W98/WME/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 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  'flagTest?
'III. Examine HKLM... Explorer\Browser Helper Objects
If Not flagTest Then  'skip if testing
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  'flagTest?
'IV. Examine HKLM... Shell Extensions\Approved\
If Not flagTest Then  'skip if testing
'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(243,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) = &q
			Jeszcze tu Wrócę