Trojan
jojo
-
green day Messages postés 26722 Statut Modérateur, Contributeur sécurité -
green day Messages postés 26722 Statut Modérateur, Contributeur sécurité -
Salut, J' ai besoin d' aide, mon pc est infecté par des trojans, Avast detecte :
- trojan 1728
- trojan 3298
SVp aidez moi, j' a besoin d' aide, j' ai eu mon pc pour noel, je n' arrive plus à rien faire, ma barre de tache est caché, je ne peut pas allez sur mon pste de travil je ne peut pas installé d' autre logiciel, je suis perdu aidez moi je suis pret à donner mon numéro de téléphone portable, j' a tres peur pour mmon pc, svp j' ai peur je veux pas qu 'il soit détruit, Aidez moi, aidez je vous en supplie, SVP
- trojan 1728
- trojan 3298
SVp aidez moi, j' a besoin d' aide, j' ai eu mon pc pour noel, je n' arrive plus à rien faire, ma barre de tache est caché, je ne peut pas allez sur mon pste de travil je ne peut pas installé d' autre logiciel, je suis perdu aidez moi je suis pret à donner mon numéro de téléphone portable, j' a tres peur pour mmon pc, svp j' ai peur je veux pas qu 'il soit détruit, Aidez moi, aidez je vous en supplie, SVP
A voir également:
- Trojan
- Trojan remover - Télécharger - Antivirus & Antimalwares
- Anti trojan - Télécharger - Antivirus & Antimalwares
- Virus trojan al11 ✓ - Forum Virus
- Csrss.exe trojan fr ✓ - Forum Virus
- Trojan win32 - Forum Virus
229 réponses
Résumé de la discussion
Avast détecte deux trojans (1728 et 3298) et le poste présente des symptômes importants, comme la barre des tâches cachée et l’impossibilité d’installer de nouveaux logiciels.
Les réponses proposent diverses mesures de nettoyage: mise à jour de Windows après nettoyage, utilisation d’outils anti-malware (Spybot, Ewido) et recours à SmitRem pour purger l’infection avec génération d’un rapport.
Un élément technique évoqué est un rapport HijackThis détaillant des entrées de démarrage et des composants suspects, utile pour guider le diagnostic.
La discussion aborde aussi des ajustements de paramètres (barre de lancement rapide, page d’accueil) et d’autres conseils techniques sans aboutir à une solution unique.
Voici le rapport de Smitfraudfix :
SmitFraudFix v2.15
Rapport fait à 16:47:19,56 le 29/01/2006
Executé à partir de C:\Documents and Settings\Attila\Mes documents\Anti-virus-spywares-etc\SmitfraudFix\SmitfraudFix
OS: Microsoft Windows XP [version 5.1.2600]
»»»»»»»»»»»»»»»»»»»»»»»» Recherche C:\
»»»»»»»»»»»»»»»»»»»»»»»» Recherche C:\WINDOWS
»»»»»»»»»»»»»»»»»»»»»»»» Recherche C:\WINDOWS\system
»»»»»»»»»»»»»»»»»»»»»»»» Recherche C:\WINDOWS\Web
»»»»»»»»»»»»»»»»»»»»»»»» Recherche C:\WINDOWS\system32
»»»»»»»»»»»»»»»»»»»»»»»» Recherche C:\Documents and Settings\Attila\Application Data
C:\Documents and Settings\Attila\Application Data\Install.dat PRESENT !
»»»»»»»»»»»»»»»»»»»»»»»» Recherche Menu Démarrer
»»»»»»»»»»»»»»»»»»»»»»»» Recherche Bureau
»»»»»»»»»»»»»»»»»»»»»»»» Recherche C:\Program Files
»»»»»»»»»»»»»»»»»»»»»»»» Recherche présence de clés corrompues
»»»»»»»»»»»»»»»»»»»»»»»» Recherche éléments du bureau
[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Desktop\Components\0]
"Source"="About:Home"
"SubscribedURL"="About:Home"
"FriendlyName"="Ma page d'accueil"
»»»»»»»»»»»»»»»»»»»»»»»» Recherche Sharedtaskscheduler
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\SharedTaskScheduler]
"{438755C2-A8BA-11D1-B96B-00A0C90312E1}"="Pr‚-chargeur Browseui"
"{8C7461EF-2B13-11d2-BE35-3078302C2030}"="D‚mon de cache des cat‚gories de composant"
»»»»»»»»»»»»»»»»»»»»»»»» Recherche infection wininet.dll
»»»»»»»»»»»»»»»»»»»»»»»» Fin du rapport
SmitFraudFix v2.15
Rapport fait à 16:47:19,56 le 29/01/2006
Executé à partir de C:\Documents and Settings\Attila\Mes documents\Anti-virus-spywares-etc\SmitfraudFix\SmitfraudFix
OS: Microsoft Windows XP [version 5.1.2600]
»»»»»»»»»»»»»»»»»»»»»»»» Recherche C:\
»»»»»»»»»»»»»»»»»»»»»»»» Recherche C:\WINDOWS
»»»»»»»»»»»»»»»»»»»»»»»» Recherche C:\WINDOWS\system
»»»»»»»»»»»»»»»»»»»»»»»» Recherche C:\WINDOWS\Web
»»»»»»»»»»»»»»»»»»»»»»»» Recherche C:\WINDOWS\system32
»»»»»»»»»»»»»»»»»»»»»»»» Recherche C:\Documents and Settings\Attila\Application Data
C:\Documents and Settings\Attila\Application Data\Install.dat PRESENT !
»»»»»»»»»»»»»»»»»»»»»»»» Recherche Menu Démarrer
»»»»»»»»»»»»»»»»»»»»»»»» Recherche Bureau
»»»»»»»»»»»»»»»»»»»»»»»» Recherche C:\Program Files
»»»»»»»»»»»»»»»»»»»»»»»» Recherche présence de clés corrompues
»»»»»»»»»»»»»»»»»»»»»»»» Recherche éléments du bureau
[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Desktop\Components\0]
"Source"="About:Home"
"SubscribedURL"="About:Home"
"FriendlyName"="Ma page d'accueil"
»»»»»»»»»»»»»»»»»»»»»»»» Recherche Sharedtaskscheduler
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\SharedTaskScheduler]
"{438755C2-A8BA-11D1-B96B-00A0C90312E1}"="Pr‚-chargeur Browseui"
"{8C7461EF-2B13-11d2-BE35-3078302C2030}"="D‚mon de cache des cat‚gories de composant"
»»»»»»»»»»»»»»»»»»»»»»»» Recherche infection wininet.dll
»»»»»»»»»»»»»»»»»»»»»»»» Fin du rapport
Rah pour ewido j' ai toutjours le meme probleme :
http://img91.imageshack.us/my.php?image=blemruntime4uu.jpg
http://img91.imageshack.us/my.php?image=blemruntime4uu.jpg
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Telecharge ceci
http://www.silentrunners.org/Silent%20Runners.vbs
Execute le,atends quelques minutes, il va creer ensuite un dossier juste a coté de silent runner sous format texte, copie/colle ce qu il te donnera
A+
http://www.silentrunners.org/Silent%20Runners.vbs
Execute le,atends quelques minutes, il va creer ensuite un dossier juste a coté de silent runner sous format texte, copie/colle ce qu il te donnera
A+
Il ne m' a pas créer de dossiers, lorsque je clique dessus, un texte
s' affiche le voici (sans que je télécharge quoi que ce soit):
'Silent Runners.vbs -- find out what programs start up with Windows!
'
'DO NOT REMOVE THIS HEADER!
'
'Copyright Andrew ARONOFF 09 January 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 = "43"
Public flagTest : flagTest = False 'True if testing
'flagTest = True 'Uncomment to test
'This script is divided into 27 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)
'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
' 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. HKCR 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]"
'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
'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" : 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"
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
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
Public ctrArDTI, ctrArErr
Public cntFo : cntFo = 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
Dim 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, PIF path string, single binary character
Dim strFN, 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
Dim 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 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
Dim 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
strFN = strPathOFFo & strflagTest & "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 : 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
'use WMI to differentiate between WXP Home & WXP Pro
If strOS = "WXP" Then
'get the O/S collection
Dim colOS : Set colOS = GetObject("winmgmts:\root\cimv2").ExecQuery _
("Select * from Win32_OperatingSystem")
For Each oOS in colOS
'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"
Next
Set colOS=Nothing
End If 'WXP?
'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
TitleLineWrite
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 = StringFilter(strValue,True)
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 = StringFilter(strValue2,True) & " [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 = StringFilter(strValue3,True) & CoName(IDExe(strValue3))
'output the quote-delimited names and values
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
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
Dim strCLSID, strIPSDLL, strIPSDLLOut, strCLSIDTitle
'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) = "{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
s' affiche le voici (sans que je télécharge quoi que ce soit):
'Silent Runners.vbs -- find out what programs start up with Windows!
'
'DO NOT REMOVE THIS HEADER!
'
'Copyright Andrew ARONOFF 09 January 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 = "43"
Public flagTest : flagTest = False 'True if testing
'flagTest = True 'Uncomment to test
'This script is divided into 27 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)
'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
' 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. HKCR 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]"
'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
'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" : 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"
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
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
Public ctrArDTI, ctrArErr
Public cntFo : cntFo = 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
Dim 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, PIF path string, single binary character
Dim strFN, 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
Dim 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 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
Dim 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
strFN = strPathOFFo & strflagTest & "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 : 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
'use WMI to differentiate between WXP Home & WXP Pro
If strOS = "WXP" Then
'get the O/S collection
Dim colOS : Set colOS = GetObject("winmgmts:\root\cimv2").ExecQuery _
("Select * from Win32_OperatingSystem")
For Each oOS in colOS
'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"
Next
Set colOS=Nothing
End If 'WXP?
'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
TitleLineWrite
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 = StringFilter(strValue,True)
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 = StringFilter(strValue2,True) & " [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 = StringFilter(strValue3,True) & CoName(IDExe(strValue3))
'output the quote-delimited names and values
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
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
Dim strCLSID, strIPSDLL, strIPSDLLOut, strCLSIDTitle
'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) = "{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
Il y a du avoir un problème, le rapport dans haut n' est pas entier, le voici en entier
'Silent Runners.vbs -- find out what programs start up with Windows!
'
'DO NOT REMOVE THIS HEADER!
'
'Copyright Andrew ARONOFF 09 January 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 = "43"
Public flagTest : flagTest = False 'True if testing
'flagTest = True 'Uncomment to test
'This script is divided into 27 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)
'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
' 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. HKCR 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]"
'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
'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" : 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"
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
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
Public ctrArDTI, ctrArErr
Public cntFo : cntFo = 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
Dim 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, PIF path string, single binary character
Dim strFN, 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
Dim 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 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
Dim 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
strFN = strPathOFFo & strflagTest & "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 : 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
'use WMI to differentiate between WXP Home & WXP Pro
If strOS = "WXP" Then
'get the O/S collection
Dim colOS : Set colOS = GetObject("winmgmts:\root\cimv2").ExecQuery _
("Select * from Win32_OperatingSystem")
For Each oOS in colOS
'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"
Next
Set colOS=Nothing
End If 'WXP?
'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
TitleLineWrite
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 = StringFilter(strValue,True)
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 = StringFilter(strValue2,True) & " [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 = StringFilter(strValue3,True) & CoName(IDExe(strValue3))
'output the quote-delimited names and values
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
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
Dim strCLSID, strIPSDLL, strIPSDLLOut, strCLSIDTitle
'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) = "{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
'Silent Runners.vbs -- find out what programs start up with Windows!
'
'DO NOT REMOVE THIS HEADER!
'
'Copyright Andrew ARONOFF 09 January 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 = "43"
Public flagTest : flagTest = False 'True if testing
'flagTest = True 'Uncomment to test
'This script is divided into 27 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)
'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
' 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. HKCR 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]"
'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
'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" : 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"
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
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
Public ctrArDTI, ctrArErr
Public cntFo : cntFo = 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
Dim 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, PIF path string, single binary character
Dim strFN, 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
Dim 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 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
Dim 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
strFN = strPathOFFo & strflagTest & "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 : 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
'use WMI to differentiate between WXP Home & WXP Pro
If strOS = "WXP" Then
'get the O/S collection
Dim colOS : Set colOS = GetObject("winmgmts:\root\cimv2").ExecQuery _
("Select * from Win32_OperatingSystem")
For Each oOS in colOS
'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"
Next
Set colOS=Nothing
End If 'WXP?
'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
TitleLineWrite
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 = StringFilter(strValue,True)
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 = StringFilter(strValue2,True) & " [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 = StringFilter(strValue3,True) & CoName(IDExe(strValue3))
'output the quote-delimited names and values
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
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
Dim strCLSID, strIPSDLL, strIPSDLLOut, strCLSIDTitle
'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) = "{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
Oui il y a bien un problème, donc voici la suite :
arSEA(161,0) = "{7A80E4A8-8005-11D2-BCF8-00C04F72C717}" : arSEA(161,1) = "mmcshext.dll"
arSEA(162,0) = "{0CD7A5C0-9F37-11CE-AE65-08002B2E1262}" : arSEA(162,1) = "cabview.dll"
arSEA(163,0) = "{32714800-2E5F-11d0-8B85-00AA0044F941}" : arSEA(163,1) = "wabfind.dll"
arSEA(164,0) = "{8DD448E6-C188-4aed-AF92-44956194EB1F}" : arSEA(164,1) = "wmpshell.dll"
arSEA(165,0) = "{CE3FB1D1-02AE-4a5f-A6E9-D9F1B4073E6C}" : arSEA(165,1) = "wmpshell.dll"
arSEA(166,0) = "{F1B9284F-E9DC-4e68-9D7E-42362A59F0FD}" : arSEA(166,1) = "wmpshell.dll"
'W2K
arSEA(167,0) = "{41E300E0-78B6-11ce-849B-444553540000}" : arSEA(167,1) = "plustab.dll"
arSEA(168,0) = "{1A9BA3A0-143A-11CF-8350-444553540000}" : arSEA(168,1) = "shell32.dll"
arSEA(169,0) = "{20D04FE0-3AEA-1069-A2D8-08002B30309D}" : arSEA(169,1) = "shell32.dll"
arSEA(170,0) = "{86747AC0-42A0-1069-A2E6-08002B30309D}" : arSEA(170,1) = "shell32.dll"
arSEA(171,0) = "{0AFACED1-E828-11D1-9187-B532F1E9575D}" : arSEA(171,1) = "shell32.dll"
arSEA(172,0) = "{12518493-00B2-11d2-9FA5-9E3420524153}" : arSEA(172,1) = "shell32.dll"
arSEA(173,0) = "{21B22460-3AEA-1069-A2DC-08002B30309D}" : arSEA(173,1) = "shell32.dll"
arSEA(174,0) = "{B091E540-83E3-11CF-A713-0020AFD79762}" : arSEA(174,1) = "shell32.dll"
arSEA(175,0) = "{FBF23B41-E3F0-101B-8488-00AA003E56F8}" : arSEA(175,1) = "shell32.dll"
arSEA(176,0) = "{C2FBB630-2971-11d1-A18C-00C04FD75D13}" : arSEA(176,1) = "shell32.dll"
arSEA(177,0) = "{C2FBB631-2971-11d1-A18C-00C04FD75D13}" : arSEA(177,1) = "shell32.dll"
arSEA(178,0) = "{13709620-C279-11CE-A49E-444553540000}" : arSEA(178,1) = "shell32.dll"
arSEA(179,0) = "{62112AA1-EBE4-11cf-A5FB-0020AFE7292D}" : arSEA(179,1) = "shell32.dll"
arSEA(180,0) = "{4622AD11-FF23-11d0-8D34-00A0C90F2719}" : arSEA(180,1) = "shell32.dll"
arSEA(181,0) = "{7BA4C740-9E81-11CF-99D3-00AA004AE837}" : arSEA(181,1) = "shell32.dll"
arSEA(182,0) = "{D969A300-E7FF-11d0-A93B-00A0C90F2719}" : arSEA(182,1) = "shell32.dll"
arSEA(183,0) = "{09799AFB-AD67-11d1-ABCD-00C04FC30936}" : arSEA(183,1) = "shell32.dll"
arSEA(184,0) = "{3FC0B520-68A9-11D0-8D77-00C04FD70822}" : arSEA(184,1) = "shell32.dll"
arSEA(185,0) = "{75048700-EF1F-11D0-9888-006097DEACF9}" : arSEA(185,1) = "shell32.dll"
arSEA(186,0) = "{6D5313C0-8C62-11D1-B2CD-006097DF8C11}" : arSEA(186,1) = "shell32.dll"
arSEA(187,0) = "{57651662-CE3E-11D0-8D77-00C04FC99D61}" : arSEA(187,1) = "shell32.dll"
arSEA(188,0) = "{4657278A-411B-11d2-839A-00C04FD918D0}" : arSEA(188,1) = "shell32.dll"
arSEA(189,0) = "{A470F8CF-A1E8-4f65-8335-227475AA5C46}" : arSEA(189,1) = "shell32.dll"
arSEA(190,0) = "{568804CA-CBD7-11d0-9816-00C04FD91972}" : arSEA(190,1) = "browseui.dll"
arSEA(191,0) = "{5b4dae26-b807-11d0-9815-00c04fd91972}" : arSEA(191,1) = "browseui.dll"
arSEA(192,0) = "{8278F931-2A3E-11d2-838F-00C04FD918D0}" : arSEA(192,1) = "browseui.dll"
arSEA(193,0) = "{E13EF4E4-D2F2-11d0-9816-00C04FD91972}" : arSEA(193,1) = "browseui.dll"
arSEA(194,0) = "{ECD4FC4F-521C-11D0-B792-00A0C90312E1}" : arSEA(194,1) = "browseui.dll"
arSEA(195,0) = "{D82BE2B0-5764-11D0-A96E-00C04FD705A2}" : arSEA(195,1) = "browseui.dll"
arSEA(196,0) = "{0E5CBF21-D15F-11d0-8301-00AA005B4383}" : arSEA(196,1) = "browseui.dll"
arSEA(197,0) = "{7487cd30-f71a-11d0-9ea7-00805f714772}" : arSEA(197,1) = "browseui.dll"
arSEA(198,0) = "{8BEBB290-52D0-11D0-B7F4-00C04FD706EC}" : arSEA(198,1) = "thumbvw.dll"
arSEA(199,0) = "{EAB841A0-9550-11CF-8C16-00805F1408F3}" : arSEA(199,1) = "thumbvw.dll"
arSEA(200,0) = "{1AEB1360-5AFC-11D0-B806-00C04FD706EC}" : arSEA(200,1) = "thumbvw.dll"
arSEA(201,0) = "{9DBD2C50-62AD-11D0-B806-00C04FD706EC}" : arSEA(201,1) = "thumbvw.dll"
arSEA(202,0) = "{500202A0-731E-11D0-B829-00C04FD706EC}" : arSEA(202,1) = "thumbvw.dll"
arSEA(203,0) = "{0B124F8C-91F0-11D1-B8B5-006008059382}" : arSEA(203,1) = "appwiz.cpl"
arSEA(204,0) = "{fe1290f0-cfbd-11cf-a330-00aa00c16e65}" : arSEA(204,1) = "dsfolder.dll"
arSEA(205,0) = "{9E51E0D0-6E0F-11d2-9601-00C04FA31A86}" : arSEA(205,1) = "dsfolder.dll"
arSEA(206,0) = "{450D8FBA-AD25-11D0-98A8-0800361B1103}" : arSEA(206,1) = "mydocs.dll"
'WXP SP2
arSEA(207,0) = "{2559a1f7-21d7-11d4-bdaf-00c04f60b9f0}" : arSEA(207,1) = "shdocvw.dll"
arSEA(208,0) = "{596AB062-B4D2-4215-9F74-E9109B0A8153}" : arSEA(208,1) = "twext.dll"
arSEA(209,0) = "{9DB7A13C-F208-4981-8353-73CC61AE2783}" : arSEA(209,1) = "twext.dll"
arSEA(210,0) = "{692F0339-CBAA-47e6-B5B5-3B84DB604E87}" : arSEA(210,1) = "extmgr.dll"
'NT4
arSEA(211,0) = "{764BF0E1-F219-11ce-972D-00AA00A14F56}" : arSEA(211,1) = "shcompui.dll"
arSEA(212,0) = "{8DE56A0D-E58B-41FE-9F80-3563CDCB2C22}" : arSEA(212,1) = "thumbvw.dll"
arSEA(213,0) = "{13709620-C279-11CE-A49E-444553540000}" : arSEA(213,1) = "SHDOC401.DLL"
arSEA(214,0) = "{62112AA1-EBE4-11cf-A5FB-0020AFE7292D}" : arSEA(214,1) = "SHDOC401.DLL"
arSEA(215,0) = "{7BA4C740-9E81-11CF-99D3-00AA004AE837}" : arSEA(215,1) = "SHDOC401.DLL"
arSEA(216,0) = "{D969A300-E7FF-11d0-A93B-00A0C90F2719}" : arSEA(216,1) = "SHDOC401.DLL"
arSEA(217,0) = "{4622AD11-FF23-11d0-8D34-00A0C90F2719}" : arSEA(217,1) = "SHDOC401.DLL"
arSEA(218,0) = "{3AD1E410-AAB9-11d0-89D7-00C04FC9E26E}" : arSEA(218,1) = "SHDOCVW.DLL"
arSEA(219,0) = "{57651662-CE3E-11D0-8D77-00C04FC99D61}" : arSEA(219,1) = "SHDOC401.DLL"
arSEA(220,0) = "{B091E540-83E3-11CF-A713-0020AFD79762}" : arSEA(220,1) = "SHDOC401.DLL"
arSEA(221,0) = "{3FC0B520-68A9-11D0-8D77-00C04FD70822}" : arSEA(221,1) = "SHDOC401.DLL"
arSEA(222,0) = "{7D688A77-C613-11D0-999B-00C04FD655E1}" : arSEA(222,1) = "SHELL32.dll"
arSEA(223,0) = "{BDEADF00-C265-11d0-BCED-00A0C90AB50F}" : arSEA(223,1) = "MSONSEXT.DLL"
arSEA(224,0) = "{C2FBB630-2971-11d1-A18C-00C04FD75D13}" : arSEA(224,1) = "SHDOC401.DLL"
arSEA(225,0) = "{C2FBB631-2971-11d1-A18C-00C04FD75D13}" : arSEA(225,1) = "SHDOC401.DLL"
arSEA(226,0) = "{75048700-EF1F-11D0-9888-006097DEACF9}" : arSEA(226,1) = "SHDOC401.DLL"
arSEA(227,0) = "{6D5313C0-8C62-11D1-B2CD-006097DF8C11}" : arSEA(227,1) = "SHDOC401.DLL"
arSEA(228,0) = "{FBF23B41-E3F0-101B-8488-00AA003E56F8}" : arSEA(228,1) = "SHDOC401.DLL"
arSEA(229,0) = "{5a61f7a0-cde1-11cf-9113-00aa00425c62}" : arSEA(229,1) = "w3ext.dll"
'WME
arSEA(230,0) = "{3F30C968-480A-4C6C-862D-EFC0897BB84B}" : arSEA(230,1) = "THUMBVW.DLL" 'see (122)
arSEA(231,0) = "{53C74826-AB99-4d33-ACA4-3117F51D3788}" : arSEA(231,1) = "SHELL32.DLL"
arSEA(232,0) = "{992CFFA0-F557-101A-88EC-00DD010CCC48}" : arSEA(232,1) = "rnaui.dll" 'see (30)
arSEA(233,0) = "{FEF10FA2-355E-4e06-9381-9B24D7F7CC88}" : arSEA(233,1) = "SHELL32.DLL"
'MS PowerToys
arSEA(234,0) = "{AA7C7080-860A-11CE-8424-08002B2CFF76}" : arSEA(234,1) = "SENDTOX.DLL"
arSEA(235,0) = "{7BB70120-6C78-11CF-BFC7-444553540000}" : arSEA(235,1) = "SENDTOX.DLL"
arSEA(236,0) = "{7BB70122-6C78-11CF-BFC7-444553540000}" : arSEA(236,1) = "SENDTOX.DLL"
arSEA(237,0) = "{7BB70121-6C78-11CF-BFC7-444553540000}" : arSEA(237,1) = "SENDTOX.DLL"
arSEA(238,0) = "{7BB70123-6C78-11CF-BFC7-444553540000}" : arSEA(238,1) = "SENDTOX.DLL"
arSEA(239,0) = "{9E56BE62-C50F-11CF-9A2C-00A0C90A90CE}" : arSEA(239,1) = "SENDTOX.DLL"
arSEA(240,0) = "{90A756E0-AFCF-11CE-927B-0800095AE340}" : arSEA(240,1) = "target.dll"
arSEA(241,0) = "{afc638f0-e8a4-11ce-9ade-00aa00a42d2e}" : arSEA(241,1) = "TTFExtNT.dll"
'etc
arSEA(242,0) = "{1D2680C9-0E2A-469d-B787-065558BC7D43}" : arSEA(242,1) = "mscoree.dll"
arSEA(243,0) = "{5F327514-6C5E-4d60-8F16-D07FA08A78ED}" : arSEA(243,1) = "wuaueng.dll"
'set up key name to query
strKey = "Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved"
strSubTitle = "HKLM" & "\" & strKey & "\"
'find all the names in the key
intErrNum1 = oReg.EnumValues (HKLM, strKey, arNames, arType)
'enumerate data if present
If intErrNum1 = 0 And IsArray(arNames) Then
'for each CLSID
For Each strCLSID in arNames
'assume CLSID unapproved
flagMatch = False
ResolveCLSID HKLM, strKey, strCLSID, strValue, strIPSDLL
If strIPSDLL <> "" Then
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
'find CoName
strCN = CoName(IDExe(strIPSDLL))
TitleLineWrite
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) = " &_
StringFilter(strIPSDLL,True) & CoName(IDExe(strIPSDLL))
End If 'flagMatch Or flagShowAll?
End If 'strIPSDLL <> ""?
Next 'strCLSID
Else 'arNames array not returned
'if ShowAll, output key name
If flagShowAll Then TitleLineWrite
End If 'intErrNum1 = 0 & arNames array exists?
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
'recover array memory
ReDim arSEA(0,0)
End If 'flagTest?
'V. Examine HKLM... Explorer\SharedTaskScheduler/ShellExecuteHooks
If Not flagTest Then 'skip if testing
Dim arAllowedCLSID()
ReDim arKeys(1)
arKeys(0) = "Software\Microsoft\Windows\CurrentVersion\Explorer\SharedTaskScheduler"
arKeys(1) = "Software\Microsoft\Windows\CurrentVersion\Explorer\ShellExecuteHooks"
'for each Explorer sub-key
For i = 0 To UBound(arKeys)
strSubTitle = "HKLM" & "\" & arKeys(i) & "\"
'set up allowed CLSID's & IPS names for each sub-key
If i = 0 Then 'SharedTaskScheduler
ReDim arAllowedCLSID(1,1)
arAllowedCLSID(0,0) = "{438755C2-A8BA-11D1-B96B-00A0C90312E1}"
arAllowedCLSID(0,1) = "browseui.dll"
arAllowedCLSID(1,0) = "{8C7461EF-2B13-11d2-BE35-3078302C2030}"
arAllowedCLSID(1,1) = "browseui.dll"
ElseIf i = 1 Then 'ShellExecuteHooks
ReDim arAllowedCLSID(0,1)
arAllowedCLSID(0,0) = "{AEB6717E-7E19-11d0-97EE-00C04FD91972}"
arAllowedCLSID(0,1) = "shell32.dll"
End If 'which Explorer sub-key?
'find all the names in the Explorer key
oReg.EnumValues HKLM, arKeys(i), arNames, arType
'enumerate data if present
If IsArray(arNames) Then
'for each name
For Each strName In arNames
ResolveCLSID HKLM, arKeys(i), strName, strValue1, strValue3
If strValue3 <> "" Then
flagFound = False : strWarn = "INFECTION WARNING! "
strCN = CoName(IDExe(strValue3))
'for every CLSID
'see if CLSID, IPS filename are allowed & IPS CoName = "MS"
For j = 0 To UBound(arAllowedCLSID,1)
If LCase(strName) = LCase(arAllowedCLSID(j,0)) And _
LCase(Fso.GetFileName(strValue3)) = LCase(arAllowedCLSID(j,1)) And _
strCN = MS Then
flagFound = True : strWarn = "" : Exit For
End If
Next 'allowed CLSID & IPS file name
'if IPS not allowed or ShowAll, output name & value
If Not flagFound Or flagShowAll Then
'output the title line if not already done
TitleLineWrite
On Error Resume Next
oFN.WriteLine strWarn & Chr(34) & strName & Chr(34) &_
" = " & strValue1
'error check for W2K if SharedTaskScheduler value not set
intErrNum = Err.Number : Err.Clear
On Error GoTo 0
If intErrNum <> 0 Then oFN.WriteLine Chr(34) & strName & Chr(34) &_
" = (no title provided)"
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " &_
StringFilter(strValue3,True) & strCN
End If 'unexpected data or ShowAll?
End If 'IPS exists?
Next 'arNames array member
Else 'arNames array not returned
'if ShowAll, output key name
If flagShowAll Then TitleLineWrite
End If 'arNames array exists
Next 'Explorer sub-key
'reset flags
flagFound = False
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
'recover array memory
ReDim arAllowedCLSID(0)
ReDim arKeys(0)
ReDim arNames(0)
End If 'flagTest?
'VI. Examine HKCU/HKLM... ShellServiceObjectDelayLoad
If Not flagTest Then 'skip if testing
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(6,1)
arSSODL(0,0) = "{35cec8a3-2be6-11d2-8773-92e220524153}" : arSSODL(0,1) = "stobject.dll"
arSSODL(1,0) = "{7007accf-3202-11d1-aad2-00805fc1270e}" : arSSODL(1,1) = "netshell.dll"
arSSODL(2,0) = "{7849596a-48ea-486e-8937-a2a3009f31a9}" : arSSODL(2,1) = "shell32.dll"
arSSODL(3,0) = "{e57ce738-33e8-4c51-8354-bb4de9d215d1}" : arSSODL(3,1) = "upnpui.dll"
arSSODL(4,0) = "{e6fb5e20-de35-11cf-9c87-00aa005127ed}" : arSSODL(4,1) = "webcheck.dll"
arSSODL(5,0) = "{fbeb8a05-beee-4442-804e-409d6c4515e9}" : arSSODL(5,1) = "shell32.dll"
arSSODL(6,0) = "{bcbcd383-3e06-11d3-91a9-00c04f68105c}" : arSSODL(6,1) = "auhook.dll"
For i = 0 To 1 'for each hive
strSubTitle = arHives(i,0) & "\" & strKey & "\"
'find all the names in the key
oReg.EnumValues arHives(i,1), strKey, arNames, arType
'enumerate data if present
If IsArray(arNames) Then
'for each name
For Each strName In arNames
flagMatch = False 'SSODL entry is not allowable
'get the SSODL value = CLSID name
oReg.GetStringValue arHives(i,1),strKey,strName,strValue
'find the IPS at HKLM\Software\Classes\CLSID\{this data}\InProcServer32
strKey2 = "Software\Classes\CLSID\" & strValue & "\InProcServer32"
intErrNum = oReg.GetExpandedStringValue (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
Exit For
End If
Next 'arSSODL member
End If 'flagShowAll?
'write the quote-delimited name and value to the file if unallowable
If Not flagMatch Then
'output title line if not already done
TitleLineWrite
'output SSODL value
oFN.WriteLine Chr(34) & strName & Chr(34) & " = " & Chr(34) & strValue & Chr(34)
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " &_
StringFilter(strValue2,True) & strCN
End If 'flagMatch?
End If 'IPS exists?
Next 'SSODL value (strName) in array
End If 'arNames array exists
'if ShowAll, output key name
If flagShowAll Then TitleLineWrite
Next 'hive
'reset flags
flagMatch = False
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
strLine = ""
'recover array memory
ReDim arType(0)
ReDim arNames(0)
ReDim arSSOLD(0,0)
End If 'flagTest?
'VII. Find values of specific names:
' HKCU... Command Processor\AutoRun
' HKCU... Policies\System\Shell (W2K & WXP only)
' HKCU... Windows\load & run
' HKCU... Command Processor\AutoRun
' HKCU... Winlogon\Shell
' HKLM... Windows\AppInit_DLLs
' HKLM... Winlogon\Shell & Userinit & System & Ginadll & Taskman
' HKLM... Control\SafeBoot\Option\UseAlternateShell
' HKLM... Control\Session Manager\BootExecute
If Not flagTest Then 'skip if testing
'value length, pos'n of space/comma in value
Dim intSpacePosn, intCommaPosn
If strOS <> "W98" And strOS <> "WME" Then
'HKCU\Software\Microsoft\Command Processor\AutoRun
strSubTitle = "HKCU\SOFTWARE\Microsoft\Command Processor\"
RegDataChk HKCU, "SOFTWARE\Microsoft\Command Processor", "AutoRun", strValue, ""
If strOS = "W2K" Or strOS = "WXP" Then
'HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System
'"Shell" = ""
strSubTitle = "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\"
RegDataChk HKCU, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System", "Shell", strValue, ""
End If 'WXP?
'HKCU\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows\load & run
strSubTitle = "HKCU\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows\"
RegDataChk HKCU, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows", "load", strValue, ""
RegDataChk HKCU, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows", "run", strValue, ""
'HKCU\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell
'"Shell" = "Explorer.exe"
strSubTitle = "HKCU\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\"
RegDataChk HKCU, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "Shell", strValue, "explorer.exe"
'HKLM\Software\Microsoft\Command Processor\AutoRun
strSubTitle = "HKLM\SOFTWARE\Microsoft\Command Processor\"
RegDataChk HKLM, "SOFTWARE\Microsoft\Command Processor", "AutoRun", strValue, ""
'HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows\AppInit_DLLs
strSubTitle = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows\"
RegDataChk HKLM, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows", "AppInit_DLLs", strValue, ""
'HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\GinaDLL
'"GinaDLL" = "MSGina.dll"
strSubTitle = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\"
RegDataChk HKLM, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "GinaDLL", strValue, "msgina.dll"
'HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell
'"Shell" = "Explorer.exe"
RegDataChk HKLM, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "Shell", strValue, "explorer.exe"
'HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Taskman
'"Taskman" = ""
RegDataChk HKLM, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "Taskman", strValue, ""
'HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Userinit
'"Userinit" = "%SystemRoot%\system32\userinit.exe,"
'find value for "Userinit" name
flagInfect = False
strKey = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon"
intErrNum = oReg.GetStringValue (HKLM,strKey,"Userinit",strValue)
'if Userinit name exists And value set (exc for W2K!)
If intErrNum = 0 And strValue <> "" Then
'save default output line
strOut = Chr(34) & "Userinit" & Chr(34) & " = " & Chr(34) &_
strValue & Chr(34) & LRParse(strValue)
'remove trailing space or comma
strValue = Trim(strValue)
If InStrRev(strValue,",") = Len(strValue) Then strValue = _
Left(strValue,Len(strValue)-1)
'if NT4 And Userinit value <> expected string, toggle infection flag & fill warning string
If strOS = "NT4" And LCase(strValue) <> "userinit,nddeagnt.exe" And _
LCase(strValue) <> "userinit nddeagnt.exe" Then
flagInfect = True
'if W2K/WXP
ElseIf strOS <> "NT4" Then
'find pos'n of space & comma in value
intLenValue = Len(strValue)
intSpacePosn = InStr(strValue," ")
If intSpacePosn = 0 Then intSpacePosn = intLenValue
intCommaPosn = InStr(strValue,",")
If intCommaPosn = 0 Then intCommaPosn = intLenValue
'if string doesn't contain userinit.exe Or extends beyond space or comma
If InStr(LCase(strValue),"userinit.exe") = 0 Or _
intLenValue > intSpacePosn + 1 Or intLenValue > intCommaPosn + 1 Then _
flagInfect = True
End If 'userinit string test
If flagInfect Then strOut = "INFECTION WARNING! " & strOut
'if infected or ShowAll
If flagInfect Or flagShowAll Then
'output key name
TitleLineWrite
'write name and value to file
On Error Resume Next
oFN.WriteLine strOut
intErrNum = Err.Number : Err.Clear
On Error GoTo 0
'error check for W2K if Userinit value not set
If intErrNum <> 0 Then _
oFN.WriteLine Chr(34) & "Userinit" & Chr(34) & " = (value not set)"
End If 'flagInfect/flagShowAll
End If 'Userinit value exists?
flagInfect = False
'HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\System
'"System" = ""
'if NT4, check for expected value
If strOS = "NT4" Then
RegDataChk HKLM, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "System", strValue, "lsass.exe"
'if W2K/WXP, check for empty string
Else
RegDataChk HKLM, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "System", strValue, ""
End If
'*****
If strOS = "W2K" Or strOS = "WXP" Then
'HKLM\SYSTEM\CurrentControlSet\Control\SafeBoot\Option\UseAlternateShell
strKey = "System\CurrentControlSet\Control\SafeBoot\Option"
strSubTitle = "HKLM" & "\" & strKey & "\"
flagArray = False : flagInfect = False : strValue = "" : intType = -1 : strWarn = ""
'enumerate name/value pairs
EnumNVP HKLM,strKey,arNames,arType
'check for all OS's (esp WS2K3) if name/value pairs exist
If IsArray(arNames) Then
For Each strName In arNames
flagArray = True : Exit For
Next 'arNames member
'if name/value pairs exist
If flagArray Then
For i = 0 To UBound(arNames)
'check for UseAlternateShell name
If Trim(LCase(arNames(i))) = "usealternateshell" Then
'find its type & value, then exit For
flagInfect = True : strWarn = "INFECTION WARNING! "
intType = arType(i)
strValue = RtnValue (HKLM, strKey, "UseAlternateShell", intType)
Exit For
End If 'UseAlternateShell?
Next 'arName member
End If 'flagArray?
End If 'IsArray(arNames)?
'output UseAlternateShell value
If flagInfect Then
'write name and value to file
On Error Resume Next
TitleLineWrite
'output final line
oFN.WriteLine strWarn & Chr(34) & "UseAlternateShell" &_
Chr(34) & " = " & Chr(34) & strValue & Chr(34)
intErrNum = Err.Number : Err.Clear
On Error GoTo 0
'if write error, output warning
If intErrNum <> 0 Then oFN.WriteLine Chr(34) &_
"UseAlternateShell" & Chr(34) & " = ** WARNING -- empty or invalid data! **"
strKey = "System\CurrentControlSet\Control\SafeBoot"
strSubTitle = "HKLM" & "\" & strKey & "\"
TitleLineWrite
intErrNum = oReg.GetStringValue (HKLM,strKey,"AlternateShell",strValue)
If intErrNum = 0 Then
On Error Resume Next
oFN.WriteLine Chr(34) & "AlternateShell" & Chr(34) & " = " &_
Chr(34) & strValue & Chr(34)
intErrNum1 = Err.Number : Err.Clear
On Error Goto 0
'if write error, output warning
If intErrNum1 <> 0 Then oFN.WriteLine Chr(34) &_
"AlternateShell" & Chr(34) & " = ** WARNING -- empty or invalid data! **"
Else
oFN.WriteLine Chr(34) & "AlternateShell" & Chr(34) &_
" = (value not set)"
End If 'intErrNum=0?
ElseIf flagShowAll Then
TitleLineWrite
oFN.WriteLine Chr(34) & "UseAlternateShell" & Chr(34) & " = (no data)"
End If 'flagInfect Or flagShowAll?
flagArray = False : flagInfect = False : strWarn = ""
End If 'W2K or WXP?
'HKLM\System\CurrentControlSet\Control\Session Manager\BootExecute
strKey = "System\CurrentControlSet\Control\Session Manager"
intErrNum = oReg.GetMultiStringValue (HKLM,strKey,"BootExecute",arNames)
strSubTitle = "HKLM" & "\" & strKey & "\"
'initialize output strings
strLine = "" : strCN = "" : flagInfect = False : strWarn = ""
If intErrNum = 0 Then 'BootExecute value exists
'alert if autocheck not in every line of multi-string
For i = 0 To UBound(arNames)
'concatenate line
strLine = strLine & arNames(i) & " "
'if autocheck not in a line
If InStr(LCase(arNames(i)),"autocheck") = 0 Then
strWarn = "INFECTION WARNING! " : flagInfect = True
End If
Next 'arNames member
strLine = Chr(34) & RTrim(strLine) & Chr(34) 'embed in quotes
Else 'BootExecute value doesn't exist or not set
strLine = "(no data)"
End If 'BootExecute value exists?
'output bootexecute value
If flagInfect Or flagShowAll Then
'write name and value to file
On Error Resume Next
'if warning string not empty, parse line and find CoNames
If flagInfect Then strCN = LRParse(strLine)
TitleLineWrite
'output final line
oFN.WriteLine strWarn & Chr(34) & "BootExecute" &_
Chr(34) & " = " & strLine & strCN
intErrNum = Err.Number : Err.Clear
On Error GoTo 0
'if write error, output warning
If intErrNum <> 0 Then oFN.WriteLine strLine & Chr(34) &_
"BootExecute" & Chr(34) & " = ** WARNING -- empty or invalid data! **"
End If 'flagInfect Or flagShowAll?
End If 'not W98/WME
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
strLine = "" : strWarn = ""
End If 'flagTest?
'VIII. Examine HKLM... Winlogon\Notify\ subkey DLLName values
If Not flagTest Then 'skip if testing
Set arSK = CreateObject("Scripting.Dictionary") 'key, item
If strOS = "W2K" Then
arSK.Add "crypt32chain", "crypt32.dll"
arSK.Add "cryptnet", "cryptnet.dll"
arSK.Add "cscdll", "cscdll.dll"
arSK.Add "sclgntfy", "sclgntfy.dll"
arSK.Add "senslogn", "wlnotify.dll"
arSK.Add "termsrv", "wlnotify.dll"
arSK.Add "wzcnotif", "wzcdlg.dll"
ElseIf strOS = "WXP" Then
arSK.Add "crypt32chain", "crypt32.dll"
arSK.Add "cryptnet", "cryptnet.dll"
arSK.Add "cscdll", "cscdll.dll"
arSK.Add "sccertprop", "wlnotify.dll"
arSK.Add "schedule", "wlnotify.dll"
arSK.Add "sclgntfy", "sclgntfy.dll"
arSK.Add "senslogn", "wlnotify.dll"
arSK.Add "termsrv", "wlnotify.dll"
arSK.Add "wlballoon", "wlnotify.dll"
End If
arSKk = arSK.Keys
arSKi = arSK.Items
If strOS <> "W98" And strOS <> "WME" Then
strKey = "Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Notify"
strSubTitle = "HKLM" & "\" & strKey & "\"
'find all the subkeys
oReg.EnumKey HKLM, strKey, arKeys
'enumerate data if present
If IsArray(arKeys) Then
'for each key
For Each oKey In arKeys
'get the DLLName data
intErrNum = oReg.GetStringValue (HKLM,strKey & "\" & oKey,"DLLName",strValue)
'if sub-key DLLName name exists And value set (exc for W2K!)
If intErrNum = 0 And strValue <> "" Then
flagInfect = True : strWarn = "INFECTION WARNING! "
'check dictionary for allowed entry
For i = 0 To arSK.Count-1
'if key = dictionary key & value = dictionary item
If LCase(oKey) = arSKk(i) And LCase(strValue) = arSKi(i) Then
'empty warning string, toggle flag & exit -- no output necessary
flagInfect = False : strWarn = "" : Exit For
End If
Next 'dictionary key
'if flag not found in O/S-specific dictionary or ShowAll
If flagInfect Or flagShowAll Then
'output title lines if not already done
TitleLineWrite
On Error Resume Next
'write the key, name and value to a file
oFN.WriteLine strWarn & oKey & "\DLLName = " & Chr(34) &_
strValue & Chr(34) & CoName(IDExe(strValue))
intErrNum = Err.Number : Err.Clear
On Error GoTo 0
'error check for W2K if DLLName value not set
If intErrNum <> 0 Then oFN.WriteLine oKey & "\DLLName" &_
" = (value not set)"
End If 'flag not found in dictionary or ShowAll?
End If 'value missing?
Next 'Notify subkey
Else 'Notify subkeys don't exist
'output title line
If flagShowAll Then TitleLineWrite
End If 'Notify subkeys exist?
End If 'not W98/WME
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
strWarn = "" : strCN = ""
'recover array memory
arSK.RemoveAll : Set arSK=Nothing : ReDim arKeys(0)
End If 'flagTest?
'IX. Examine HKLM... Windows NT\CurrentVersion\Image File Execution Options
' subkey\Debugger value
If Not flagTest Then 'skip if testing
'ignore W98/WME
If strOS <> "W98" And strOS <> "WME" Then
strKey = "Software\Microsoft\Windows NT\CurrentVersion\Image File Execution Options"
strSubTitle = "HKLM\" & strKey & "\"
'get executable name sub-keys
oReg.EnumKey HKLM,strKey,arSubKeys
If IsArray(arSubKeys) Then
'for each sub-key
For Each strSubKey in arSubKeys
strWarn = ""
'skip allowed sub-key unless ShowAll
If LCase(strSubKey) <> LCase("Your Image File Name Here without a path") Or _
flagShowAll Then
'look for Debugger value
intErrNum = oReg.GetStringValue (HKLM,strKey & "\" & strSubKey,"Debugger",strValue)
'if Debugger value exists
If intErrNum = 0 And strValue <> "" Then
'if sub-key is not allowed, set warning
If LCase(strSubKey) <> LCase("Your Image File Name Here without a path") Then _
strWarn = "INFECTION WARNING! "
'output title line if not already done
TitleLineWrite
'output sub-key, warning, Debugger value
oFN.WriteLine strWarn & strSubKey & "\Debugger = " &_
Chr(34) & strValue & Chr(34) & CoName(IDExe(strValue))
End If 'Debugger value exists?
End If 'not allowed sub-key or ShowAll?
Next 'IFEO sub-key
'recover array memory
ReDim arSubKeys(0)
End If 'IFEO sub-key array exists?
End If 'not W98/WME?
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
End If 'flagTest?
'X. For W2K & WXP, check for startup/shutdown & logon/logoff scripts
If Not flagTest Then 'skip if testing
Dim strCmd : strCmd = "" 'script command line string
Dim arScrName() : ReDim arScrName(1,1)
arScrName(0,0) = "Logon" : arScrName(0,1) = "Logoff"
arScrName(1,0) = "Startup" : arScrName(1,1) = "Shutdown"
Select Case strOS
Case "W2K"
'collection flag
Dim flagColl : flagColl = False
'for HKCU, then HKLM
For i = 0 To 1
strKey = "Software\Policies\Microsoft\Windows\System\Scripts"
strSubTitle = arHives(i,0) & "\" & strKey & "\"
'for every script type for the hive
For j = 0 To 1
intErrNum = oReg.GetStringValue(arHives(i,1), strKey, arScrName(i,j), strValue)
If intErrNum = 0 And strValue <> "" Then
'if value points to SCRIPTS.INI, parse the file
If Fso.FileExists(strValue & "\scripts.ini") Then
ScrIFP strValue, arScrName(i,j)
'value is not empty, so output a warning, or value is not set
ElseIf strValue <> "" Then
On Error Resume Next
TitleLineWrite
oFN.WriteLine "WARNING! Either " & Chr(34) & strValue &_
"\scripts.ini" & Chr(34) & vbCRLF & Space(9) & "doesn't " &_
"exist or there " & "is insufficient permission to " &_
"read it!"
intErrNum = Err.Number : Err.Clear
On Error Goto 0
If intErrNum <> 0 Then
TitleLineWrite
oFN.WriteLine strName & " = (value not set)"
End If
End If 'value points to SCRIPTS.INI or is not empty
End If 'HKCU logon/logoff Or HKLM startup/shutdown value exists?
Next 'name in Scripts key
'if ShowAll, output title line
If flagShowAll Then TitleLineWrite
Next 'hive type
Case "WXP"
'Base Key string
Dim strBK : strBK = "Software\Policies\Microsoft\Windows\System\Scripts\"
Dim arNKSE 'Numbered (master) Keys containing Script Executable values
Dim strSPXP : strSPXP = "" 'Script Path XP string
'values: DisplayName, FileSysPath, Script, Parameter
Dim strDispName, strFSP, strScript, strParam
'for every hive
For i = 0 To 1
'for every script type
For j = 0 To 1
strSubTitle = arHives(i,0) & "\" & strBK & arScrName(i,j) & "\"
'look for script type subkeys
oReg.EnumKey arHives(i,1),strBK & arScrName(i,j),arKeys
'enumerate data if present
If IsArray(arKeys) Then
'for each numbered key header (containing numbered script keys)
For Each strKey in arKeys
strSubTitle = arHives(i,0) & "\" & strBK & arScrName(i,j) &_
"\" & strKey & "\"
'find DisplayName & FileSysPath
intErrNum1 = oReg.GetStringValue (arHives(i,1),strBK & arScrName(i,j) &_
"\" & strKey,"DisplayName",strDispName)
'embed existing, non-empty value in quotes
If intErrNum1 = 0 And strDispName <> "" Then
strDispName = Chr(34) & strDispName & Chr(34)
'for missing or empty value
Else
strDispName = "(value not set)"
End If 'DisplayName exists?
intErrNum2 = oReg.GetStringValue (arHives(i,1),strBK & arScrName(i,j) &_
"\" & strKey,"FileSysPath",strFSP)
'if value exists And not empty
If intErrNum2 = 0 And strFSP <> "" Then
'look for numbered script subkeys
oReg.EnumKey arHives(i,1),strBK & arScrName(i,j) & "\" & strKey,arNKSE
'enumerate data if present
If IsArray(arNKSE) Then
'for each numbered script key
For Each strKey2 in arNKSE
'find Parameter value
intErrNum3 = oReg.GetStringValue (arHives(i,1),strBK & arScrName(i,j) &_
"\" & strKey & "\" & strKey2,"Parameters",strParam)
'if Parameters name doesn't exist, set value to empty string
If intErrNum3 <> 0 Then strParam = ""
'find Script value
intErrNum4 = oReg.GetStringValue (arHives(i,1),strBK & arScrName(i,j) &_
"\" & strKey & "\" & strKey2,"Script",strScript)
'if Script value exists And not empty
If intErrNum4 = 0 And strScript <> "" Then
'form script executable string
'if script string has no backslash, use FileSysPath for directory
'and append \Scripts\[script type]\
If InStr(strScript,"\") = 0 Then
strSPXP = strFSP & "\Scripts\" & arScrName(i,j) & "\"
strCmd = strSPXP & strScript
Else 'script has backslash, so is full path to script
strCmd = strScript
End If
'if parameter string is not empty, append it
If Trim(strParam) <> "" Then strScript = strScript & " " & strParam
'write title lines if necessary for this master key
TitleLineWrite
oFN.WriteLine "DisplayName = " & strDispName
'write script executable
oFN.WriteLine strKey2 & "\" & " -> launches: " & Chr(34) &_
strSPXP & strScript & Chr(34) & CoName(IDExe(strCmd))
strSPXP = "" 'reset script path
End If 'Script value exists And not empty?
Next 'numbered script executable key
End If 'script executable key array exists?
End If 'FileSysPath exists?
Next 'master key
End If 'master key array exists?
'if ShowAll and no prior output, output key
If flagShowAll Then TitleLineWrite
Next 'script type
Next 'hive type
'recover array memory
ReDim arScrName(0)
End Select 'W2K or WXP?
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
End If 'flagTest?
'XI. HKCR Protocols\Filter
If Not flagTest Then 'skip if testing
'filter counter
Dim intFilterCnt : intFilterCnt = 0
'10 x 3 arFilter array: filter title, CLSID value, CLSID\InProcServer32 default value
ReDim arFilter(9,2)
arFilter(0,0) = "Class Install Handler"
arFilter(0,1) = "{32B533BB-EDAE-11d0-BD5A-00AA00B92AF1}"
arFilter(0,2) = "\urlmon.dll"
arFilter(1,0) = "deflate"
arFilter(1,1) = "{8f6b0360-b80d-11d0-a9b3-006097942311}"
arFilter(1,2) = "\urlmon.dll"
arFilter(2,0) = "gzip"
arFilter(2,1) = "{8f6b0360-b80d-11d0-a9b3-006097942311}"
arFilter(2,2) = "\urlmon.dll"
arFilter(3,0) = "lzdhtml"
arFilter(3,1) = "{8f6b0360-b80d-11d0-a9b3-006097942311}"
arFilter(3,2) = "\urlmon.dll"
arFilter(4,0) = "text/webviewhtml"
arFilter(4,1) = "{733AC4CB-F1A4-11d0-B951-00A0C90312E1}"
arFilter(4,2) = "\shell32.dll"
arFilter(5,0) = "text/webviewhtml"
arFilter(5,1) = "{733AC4CB-F1A4-11d0-B951-00A0C90312E1}"
arFilter(5,2) = "\shdoc401.dll"
arFilter(6,0) = "text/webviewhtml"
arFilter(6,1) = "{733AC4CB-F1A4-11d0-B951-00A0C90312E1}"
arFilter(6,2) = "\shdocvw.dll"
arFilter(7,0) = "application/octet-stream"
arFilter(7,1) = "{1E66F26B-79EE-11D2-8710-00C04F79ED0D}"
arFilter(7,2) = "\mscoree.dll"
arFilter(8,0) = "application/x-complus"
arFilter(8,1) = "{1E66F26B-79EE-11D2-8710-00C04F79ED0D}"
arFilter(8,2) = "\mscoree.dll"
arFilter(9,0) = "application/x-msdownload"
arFilter(9,1) = "{1E66F26B-79EE-11D2-8710-00C04F79ED0D}"
arFilter(9,2) = "\mscoree.dll"
strKey = "Software\Classes\PROTOCOLS\Filter"
strSubTitle = "HKLM" & "\" & strKey & "\"
'find all the subkeys
oReg.EnumKey HKLM, strKey, arKeys
'enumerate data if present
If IsArray(arKeys) Then
'for each key
For Each oKey In arKeys
'count number of filters
intFilterCnt = intFilterCnt + 1
'set default values:
'flagFound = True if CLSID & InProcServer32 values set
'flagMatch = True if filter name, CLSID, InProcServer32 DLL, &
' DLL CoName match allowed values
flagFound = True : flagMatch = False : flagInfect = True
strWarn = "INFECTION WARNING! "
'get the Filter CLSID value
intErrNum1 = oReg.GetStringValue (HKLM,strKey & "\" & oKey,"CLSID",strValue1)
'if CLSID name exists And value set (exc for W2K!)
If intErrNum1 = 0 And strValue1 <> "" Then
'prepare quote-embedded output string
strOut1 = Chr(34) & strValue1 & Chr(34)
'find CLSID InProcServer32 value and its CoName
intErrNum2 = oReg.GetExpandedStringValue (HKLM,"Software\Classes\CLSID\" &_
strValue1 & "\InProcServer32","",strValue2)
'if InProcServer32 value exists And value set
If intErrNum2 = 0 And strValue2 <> "" Then
strCN = CoName(IDExe(strValue2)) 'find CoName
'store output string
strOut2 = StringFilter(strValue2,True) & strCN
Else 'InProcServer32 value not set or empty
'toggle flags, empty warning string
flagFound = False : flagInfect = False
strWarn = "" : strOut2 = "(value not set)"
End If 'InProcServer32 value set?
Else 'CLSID value not set or empty
'toggle flags, empty warning string
flagFound = False : flagInfect = False
strWarn = "" : strOut1 = "(value not set)" : strOut2 = ""
End If 'CLSID value set?
'if both values set, check if filter is allowed
If flagFound Then
'check array for allowed entry
For i = 0 To UBound(arFilter,1)
'if filter name, CLSID value, DLL match arFilter & CoName = MS
If LCase(oKey) = LCase(arFilter(i,0)) And _
LCase(strValue1) = LCase(arFilter(i,1)) And _
LCase(IDExe(strValue2)) = LCase(strFPSF & arFilter(i,2)) And _
strCN = MS Then
'toggle flag, empty warning string
flagInfect = False : strWarn = "" : flagMatch = True : Exit For
End If 'filter name & CLSID match arFilter?
Next 'arFilter member
End If 'flagFound?
'if filter not in allowed array Or ShowAll
If flagInfect Or flagShowAll Then
TitleLineWrite
On Error Resume Next
'write the quote-delimited filter name and CLSID value
oFN.WriteLine strWarn & oKey & "\CLSID = " & strOut1
intErrNum = Err.Number : Err.Clear
'not W2K: if Filter CLSID not set, intErrNum = 0 & strOut2 = ""
'W2K : , intErrNum <> 0 & strOut2 = "(value not set)"
If intErrNum = 0 And strOut2 <> "" Then
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " & strOut2
ElseIf intErrNum <> 0 Then 'WriteLine error, so just write first line
oFN.WriteLine strWarn & oKey & "\CLSID = (value not set)"
End If 'WriteLine error?
On Error Goto 0
End If 'flagInfect Or ShowAll?
Next 'Filter subkey
End If 'Filter subkeys exist?
If flagShowAll Then TitleLineWrite
'reset flags
flagFound = False : flagMatch = False : flagInfect = False
'reset strings
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
strWarn = ""
'recover array memory
ReDim arFilter(0)
End If 'flagTest?
'XII. Check file & folder context menu shell extensions
If Not flagTest Then 'skip if testing
Dim arClasses() : ReDim arClasses(2)
arClasses(0) = "*" : arClasses(1) = "Directory" : arClasses(2) = "Folder"
Dim arAllowedDLLs : arAllowedDLLs = Array("syncui.dll", "cscui.dll", _
"shell32.dll", "runext.dll", "ntshrui.dll", "msshrui.dll", _
"shcompui.dll")
' layout.dll, CoName = "Microsoft"
For i = 0 To UBound(arClasses)
strSubTitle = "HKLM\Software\Classes\" & arClasses(i) &_
"\shellex\ContextMenuHandlers\"
strKey = "Software\Classes\" & arClasses(i) & "\shellex\ContextMenuHandlers"
intErrNum = oReg.EnumKey(HKLM,strKey,arSubKeys)
If intErrNum = 0 And IsArray(arSubKeys) Then
For Each strSubKey In arSubKeys
intErrNum2 = oReg.GetStringValue(HKLM,strKey & "\" & strSubKey,"",strCLSID)
If intErrNum2 = 0 And strCLSID <> "" Then
ResolveCLSID HKLM, "", strCLSID, strCLSIDTitle, strIPSDLL
If strIPSDLL <> "" Then 'IPS exists?
flagAllow = False
For j = 0 To UBound(arAllowedDLLs)
strCN = CoName(IDExe(strIPSDLL))
If LCase(Trim(Fso.GetFileName(strIPSDLL))) = LCase(arAllowedDlls(j)) And _
strCN = MS Then
flagAllow = True : Exit For
End If
Next 'arAllowedDLLs element
If Not flagAllow Or flagShowAll Then
TitleLineWrite
oFN.WriteLine strSubKey & "\(Default) = " & Chr(34) & strCLSID &_
Chr(34) & vbCRLF & " -> {CLSID}\InProcServer32\(Default) = " &_
Chr(34) & strIPSDLL & Chr(34) & CoName(IDExe(strIPSDLL))
End If 'Not flagAllow Or ShowAll?
End If 'strIPSDLL exists?
End If 'CLSID exists?
Next 'sub-key
End If 'sub-keys exist?
Next 'class
'recover array memory
ReDim arClasses(0)
'reset strings
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
End If 'flagTest?
'XIII. Check default executables for default strings
If Not flagTest Then 'skip if testing
'set up executables array
Dim arExeExt : arExeExt = Array("bat","cmd","com","exe","hta","pif","scr")
'set up expected value array
Dim arExpVal : arExpVal = Array("""%1"" %*","""%1"" %*","""%1"" %*","""%1"" %*", _
LCase(Fso.GetSpecialFolder(1)) & "\mshta.exe ""%1"" %*", _
"""%1"" %*","""%1"" /s")
Dim strExeDef 'default executable string
strTitle = "Default executables:"
'for each executable type
For i = 0 To UBound(arExeExt)
'initialize strings: warning, CoName, default executable, output
strWarn = "" : strCN = ""
strExeDef = "" : strOut = ""
'find the extension key to check
strKey1 = "SOFTWARE\Classes\." & arExeExt(i)
'find the file type at the default value
intErrNum1 = oReg.GetStringValue (HKLM,strKey1,"",strValue1)
'if file type exists And not empty
If intErrNum1 = 0 And strValue1 <> "" Then
'form the file type shell\open\command (S-O-C) string
strKey2 = "SOFTWARE\Classes\" & strValue1 & "\shell\open\command"
'look for the file type S-O-C value
intErrNum2 = oReg.GetStringValue (HKLM,strKey2,"",strValue2)
'if file type S-O-C value exists And not empty
If intErrNum2 = 0 And strValue2 <> "" Then
'set default executable & output strings
strExeDef = strValue2 : strOut = strKey2
'pointer value doesn't exist And O/S <> W98/WME/NT4
'W98G/W98SE/NT4 ignore ext shell\open\cmd if file type doesn't exist
'WME/W2K/WXP (incl SP2) interpret ext shell\open\cmd if file type doesn't exist
ElseIf strOS = "WXP" Or strOS = "W2K" Or strOS = "WME" Then
'look for ext S-O-C
strKey3 = "SOFTWARE\Classes\." & arExeExt(i) & "\shell\open\command"
intErrNum3 = oReg.GetStringValue (HKLM,strKey3,"",strValue3)
'if ext S-O-C exists And not empty
If intErrNum3 = 0 And strValue3 <> "" Then
'set default executable & output strings
strExeDef = strValue3 : strOut = strKey3
End If 'ext S-O-C value exists?
End If 'file type S-O-C exists?
Else 'extension doesn't point to file type
'look for ext S-O-C
strKey3 = "SOFTWARE\Classes\." & arExeExt(i) & "\shell\open\command"
intErrNum3 = oReg.GetStringValue (HKLM,strKey3,"",strValue3)
'if ext S-O-C exists And not empty
If intErrNum3 = 0 And strValue3 <> "" Then
strExeDef = strValue3 : strOut = strKey3
End If 'ext S-O-C exists?
End If 'file type exists?
'check against expected value, ShowAll
If (strExeDef <> "" And Trim(LCase(strExeDef)) <> arExpVal(i)) Or flagShowAll Then
'if not expected value, fill warnings & CoName
If strExeDef <> "" And Trim(LCase(strExeDef)) <> arExpVal(i) Then
strWarn = "INFECTION WARNING! " : strCN = CoName(IDExe(strExeDef))
'if exec default string doesn't have ID'd coname, don't show it
If strCN = " [file not found]" Then strCN = ""
End If
'output section titles if not done already
TitleLineWrite
'write exec extension name and key to file
If strOut <> "" Then
oFN.WriteLine vbCRLF & "." & UCase(arExeExt(i)) & ": " & "HKLM" &_
"\" & strOut & "\"
'output default executable value
oFN.WriteLine strWarn & Chr(34) & "Default" & Chr(34) & " = " &_
StringFilter(strExeDef,True) & strCN
End If 'strOut empty?
End If 'expected value found?
Next 'next executable in array
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
'recover array memory
ReDim arExeExt(0)
ReDim arExpVal(0)
End If 'flagTest?
'XIV. System/Group Policies
If Not flagTest Then 'skip if testing
'assign System or Group Policy name
Dim strPolName : strPolName = "System "
If strOS = "W2K" Or strOS = "WXP" Then strPolName = "Group "
Dim flagADClassicShell : flagADClassicShell = False 'True if ClassicShell disables AD
Dim flagADEnabled : flagADEnabled = False 'True if AD is enabled by GP
Dim flagADDisabled : flagADDisabled = False 'True if AD is disabled by GP
Dim flagFADO : flagFADO = False 'True if ForceActiveDesktopOn is set
Dim flagNAD : flagNAD = False 'True if NoActiveDesktop is set
Dim flagNADC : flagNADC = False 'True if NoActiveDesktopChanges is set
'True if ShellState setting should be examined
'HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\ShellState
Dim flagADviaSS : flagADviaSS = True
Dim flagGPWPEntry : flagGPWPEntry = False 'True if GP wallpaper value sets WP
Dim flagSkip : flagSkip = False 'True if skip write to output file
Dim arDisCplNames, strDisCplName, strDisCplValue
'set title line
strTitle = strPolName & "Policies [Description]:"
'add GPEdit location to title if GP used (W2K, WXP Pro)
If flagGP Then strTitle = "Group Policies [Description] {enabled Group Policy setting}:"
'examine Policies at Explorer & WindowsUpdate keys
strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer"
strSubTitle = "HKCU\" & strKey & "\"
ReDim arNames(9,2)
arNames(0,0) = "ClassicShell"
arNames(0,1) = "[disables Active Desktop (overrides all other " &_
"settings);" & vbCRLF & "removes the Display Properties|Web (tab); " &_
"sets options in" & vbCRLF & "Windows Explorer|Tools|Folder Options...]"
If strOS = "WXP" Then arNames(0,1) = "[removes the Display Properties|" &_
"Desktop (tab); disables Active Desktop;" & vbCRLF & "(overrides " &_
"all other settings); sets options in Windows Explorer|Tools|" &_
vbCRLF & "Folder Options...]"
If strOS = "W98" Or strOS = "NT4" Then arNames(0,1) = "[selects " &_
"Classic style in Windows Explorer|View|Folder Options...]"
arNames(0,2) = "{User Configuration|Administrative Templates|Windows " &_
"Components|" & vbCRLF & "Windows Explorer|Enable Classic Shell}"
If strOS = "WXP" Then arNames(0,2) = "{User Configuration|" &_
"Administrative Templates|Windows Components|" & vbCRLF &_
"Windows Explorer|Turn on Classic Shell}"
arNames(1,0) = "ForceActiveDesktopOn"
arNames(1,1) = "[enables Active Desktop and prevents disabling it]"
arNames(1,2) = "{User Configuration|Administrative Templates|Desktop" &_
"|Active Desktop|" & vbCRLF & "Enable Active Desktop}"
arNames(2,0) = "NoActiveDesktop"
arNames(2,1) = "[disables Active Desktop; removes Display Properties|" &_
"Web (tab)]"
If strOS = "WXP" Then arNames(2,1) = "[disables Active Desktop; " &_
"removes Web tab from Display Properties|" & vbCRLF & "Desktop (tab)|" &_
"Customize Desktop... (button)|Desktop Items (window)]"
arNames(2,2) = "{User Configuration|Administrative Templates|Desktop" &_
"|Active Desktop|" & vbCRLF & "Disable Active Desktop}"
arNames(3,0) = "NoActiveDesktopChanges"
arNames(3,1) = "[prevents changes to Active Desktop configuration;" &_
" removes" & vbCRLF & "Display Properties|Web (tab)]"
If strOS = "WXP" Then arNames(3,1) = "[prevents changes to Active Desktop; " &_
"removes Web tab from Display Properties|" & vbCRLF & "Desktop (tab)|" &_
"Customize Desktop... (button)|Desktop Items (window)]"
arNames(3,2) = "{User Configuration|Administrative Templates|Desktop" &_
"|Active Desktop|" & vbCRLF & "Prohibit changes}"
'added by GP, but ignored in practice, presence of DisallowCpl subkey name/value pairs
'sufficient to hide applets, even if this DWORD = 0 or absent
arNames(4,0) = "DisallowCpl"
arNames(4,1) = "[omits specific applets in Control Panel]"
arNames(4,2) = "{User Configuration|Administrative Templates|Control Panel|" &_
"Hide" & vbCRLF & "specified control panel applets|Policy (tab)|" &_
"Show... (button)"
If strOS = "WXP" Then arNames(4,2) = "{User Configuration|" &_
"Administrative Templates|Control Panel|Hide" & vbCRLF &_
"specified Control Panel applets|Setting (tab)|" &_
"Show... (button)"
arNames(5,0) = "NoToolbarCustomize"
arNames(5,1) = "[removes the " & Chr(34) & "Customize..." & Chr(34) &_
" menu option in Internet Explorer|View|Toolbars]"
arNames(5,2) = "{User Configuration|Administrative Templates|Windows " &_
"Components|" & vbCRLF & "Internet Explorer|Toolbars|Disable " &_
"customizing browser toolbar buttons}"
arNames(6,0) = "NoBandCustomize"
arNames(6,1) = "[disables toolbar status changes in Internet Explorer|" &_
"View|Toolbars]"
arNames(6,2) = "{User Configuration|Administrative Templates|Windows " &_
"Components|" & vbCRLF & "Internet Explorer|Toolbars|Disable " &_
"customizing browser toolbars}"
arNames(7,0) = "NoFolderOptions"
'strOS = "WXP"/"WME"
arNames(7,1) = "[removes Folder Options... from Windows Explorer|Tools " &_
"menu and from" & vbCRLF & "Control Panel]"
If strOS = "W98" Or strOS = "NT4" Then
arNames(7,1) = "[removes Folder Options... from Windows Explorer|View menu]"
ElseIf strOS = "W2K" Then
arNames(7,1) = "[removes Folder Options... from Windows Explorer|Tools menu]"
End If
arNames(7,2) = "{User Configuration|Administrative Templates|Windows " &_
"Components|" & vbCRLF & "Windows Explorer|Removes the Folder Options " &_
"menu item from the Tools menu}"
arNames(8,0) = "NoWindowsUpdate"
arNames(8,1) = "[removes Windows Update GUI links and disables " &_
"web site functionality]"
If strOS = "W98" Or strOS = "WME" Or strOS = "NT4" Then _
arNames(8,1) = "[removes Windows Update from Internet Explorer|Tools menu]"
arNames(8,2) = "{User Configuration|Administrative Templates|Start " &_
"Menu and Taskbar|" & vbCRLF & "Remove links and access to Windows " &_
"Update}"
'THIS MUST BE THE LAST ARRAY ROW
arNames(9,0) = "DisableWindowsUpdateAccess"
arNames(9,1) = "[disables Windows Update web site functionality]"
arNames(9,2) = "{User Configuration|Administrative Templates|Windows " &_
"Components|" & vbCRLF & "Windows Update|Remove access to use all " &_
"Windows Update features}"
'for every array member
For i = 0 To UBound(arNames,1)
'reset key & sub-title for WindowsUpdate value
If i = 9 Then
strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\WindowsUpdate"
strSubTitle = "HKCU\" & strKey & "\"
End If
'try to retrieve the value
intErrNum = oReg.GetDWORDValue (HKCU,strKey,arNames(i,0),intValue)
'if value exists And sets GP
If intErrNum = 0 And (intValue And 1) = 1 Then
flagSkip = False 'assume not skipped
strWarn = "HIJACK WARNING! " : strOut = "" 'empty output string
Select Case i
Case 0 'ClassicShell disables
arSEA(161,0) = "{7A80E4A8-8005-11D2-BCF8-00C04F72C717}" : arSEA(161,1) = "mmcshext.dll"
arSEA(162,0) = "{0CD7A5C0-9F37-11CE-AE65-08002B2E1262}" : arSEA(162,1) = "cabview.dll"
arSEA(163,0) = "{32714800-2E5F-11d0-8B85-00AA0044F941}" : arSEA(163,1) = "wabfind.dll"
arSEA(164,0) = "{8DD448E6-C188-4aed-AF92-44956194EB1F}" : arSEA(164,1) = "wmpshell.dll"
arSEA(165,0) = "{CE3FB1D1-02AE-4a5f-A6E9-D9F1B4073E6C}" : arSEA(165,1) = "wmpshell.dll"
arSEA(166,0) = "{F1B9284F-E9DC-4e68-9D7E-42362A59F0FD}" : arSEA(166,1) = "wmpshell.dll"
'W2K
arSEA(167,0) = "{41E300E0-78B6-11ce-849B-444553540000}" : arSEA(167,1) = "plustab.dll"
arSEA(168,0) = "{1A9BA3A0-143A-11CF-8350-444553540000}" : arSEA(168,1) = "shell32.dll"
arSEA(169,0) = "{20D04FE0-3AEA-1069-A2D8-08002B30309D}" : arSEA(169,1) = "shell32.dll"
arSEA(170,0) = "{86747AC0-42A0-1069-A2E6-08002B30309D}" : arSEA(170,1) = "shell32.dll"
arSEA(171,0) = "{0AFACED1-E828-11D1-9187-B532F1E9575D}" : arSEA(171,1) = "shell32.dll"
arSEA(172,0) = "{12518493-00B2-11d2-9FA5-9E3420524153}" : arSEA(172,1) = "shell32.dll"
arSEA(173,0) = "{21B22460-3AEA-1069-A2DC-08002B30309D}" : arSEA(173,1) = "shell32.dll"
arSEA(174,0) = "{B091E540-83E3-11CF-A713-0020AFD79762}" : arSEA(174,1) = "shell32.dll"
arSEA(175,0) = "{FBF23B41-E3F0-101B-8488-00AA003E56F8}" : arSEA(175,1) = "shell32.dll"
arSEA(176,0) = "{C2FBB630-2971-11d1-A18C-00C04FD75D13}" : arSEA(176,1) = "shell32.dll"
arSEA(177,0) = "{C2FBB631-2971-11d1-A18C-00C04FD75D13}" : arSEA(177,1) = "shell32.dll"
arSEA(178,0) = "{13709620-C279-11CE-A49E-444553540000}" : arSEA(178,1) = "shell32.dll"
arSEA(179,0) = "{62112AA1-EBE4-11cf-A5FB-0020AFE7292D}" : arSEA(179,1) = "shell32.dll"
arSEA(180,0) = "{4622AD11-FF23-11d0-8D34-00A0C90F2719}" : arSEA(180,1) = "shell32.dll"
arSEA(181,0) = "{7BA4C740-9E81-11CF-99D3-00AA004AE837}" : arSEA(181,1) = "shell32.dll"
arSEA(182,0) = "{D969A300-E7FF-11d0-A93B-00A0C90F2719}" : arSEA(182,1) = "shell32.dll"
arSEA(183,0) = "{09799AFB-AD67-11d1-ABCD-00C04FC30936}" : arSEA(183,1) = "shell32.dll"
arSEA(184,0) = "{3FC0B520-68A9-11D0-8D77-00C04FD70822}" : arSEA(184,1) = "shell32.dll"
arSEA(185,0) = "{75048700-EF1F-11D0-9888-006097DEACF9}" : arSEA(185,1) = "shell32.dll"
arSEA(186,0) = "{6D5313C0-8C62-11D1-B2CD-006097DF8C11}" : arSEA(186,1) = "shell32.dll"
arSEA(187,0) = "{57651662-CE3E-11D0-8D77-00C04FC99D61}" : arSEA(187,1) = "shell32.dll"
arSEA(188,0) = "{4657278A-411B-11d2-839A-00C04FD918D0}" : arSEA(188,1) = "shell32.dll"
arSEA(189,0) = "{A470F8CF-A1E8-4f65-8335-227475AA5C46}" : arSEA(189,1) = "shell32.dll"
arSEA(190,0) = "{568804CA-CBD7-11d0-9816-00C04FD91972}" : arSEA(190,1) = "browseui.dll"
arSEA(191,0) = "{5b4dae26-b807-11d0-9815-00c04fd91972}" : arSEA(191,1) = "browseui.dll"
arSEA(192,0) = "{8278F931-2A3E-11d2-838F-00C04FD918D0}" : arSEA(192,1) = "browseui.dll"
arSEA(193,0) = "{E13EF4E4-D2F2-11d0-9816-00C04FD91972}" : arSEA(193,1) = "browseui.dll"
arSEA(194,0) = "{ECD4FC4F-521C-11D0-B792-00A0C90312E1}" : arSEA(194,1) = "browseui.dll"
arSEA(195,0) = "{D82BE2B0-5764-11D0-A96E-00C04FD705A2}" : arSEA(195,1) = "browseui.dll"
arSEA(196,0) = "{0E5CBF21-D15F-11d0-8301-00AA005B4383}" : arSEA(196,1) = "browseui.dll"
arSEA(197,0) = "{7487cd30-f71a-11d0-9ea7-00805f714772}" : arSEA(197,1) = "browseui.dll"
arSEA(198,0) = "{8BEBB290-52D0-11D0-B7F4-00C04FD706EC}" : arSEA(198,1) = "thumbvw.dll"
arSEA(199,0) = "{EAB841A0-9550-11CF-8C16-00805F1408F3}" : arSEA(199,1) = "thumbvw.dll"
arSEA(200,0) = "{1AEB1360-5AFC-11D0-B806-00C04FD706EC}" : arSEA(200,1) = "thumbvw.dll"
arSEA(201,0) = "{9DBD2C50-62AD-11D0-B806-00C04FD706EC}" : arSEA(201,1) = "thumbvw.dll"
arSEA(202,0) = "{500202A0-731E-11D0-B829-00C04FD706EC}" : arSEA(202,1) = "thumbvw.dll"
arSEA(203,0) = "{0B124F8C-91F0-11D1-B8B5-006008059382}" : arSEA(203,1) = "appwiz.cpl"
arSEA(204,0) = "{fe1290f0-cfbd-11cf-a330-00aa00c16e65}" : arSEA(204,1) = "dsfolder.dll"
arSEA(205,0) = "{9E51E0D0-6E0F-11d2-9601-00C04FA31A86}" : arSEA(205,1) = "dsfolder.dll"
arSEA(206,0) = "{450D8FBA-AD25-11D0-98A8-0800361B1103}" : arSEA(206,1) = "mydocs.dll"
'WXP SP2
arSEA(207,0) = "{2559a1f7-21d7-11d4-bdaf-00c04f60b9f0}" : arSEA(207,1) = "shdocvw.dll"
arSEA(208,0) = "{596AB062-B4D2-4215-9F74-E9109B0A8153}" : arSEA(208,1) = "twext.dll"
arSEA(209,0) = "{9DB7A13C-F208-4981-8353-73CC61AE2783}" : arSEA(209,1) = "twext.dll"
arSEA(210,0) = "{692F0339-CBAA-47e6-B5B5-3B84DB604E87}" : arSEA(210,1) = "extmgr.dll"
'NT4
arSEA(211,0) = "{764BF0E1-F219-11ce-972D-00AA00A14F56}" : arSEA(211,1) = "shcompui.dll"
arSEA(212,0) = "{8DE56A0D-E58B-41FE-9F80-3563CDCB2C22}" : arSEA(212,1) = "thumbvw.dll"
arSEA(213,0) = "{13709620-C279-11CE-A49E-444553540000}" : arSEA(213,1) = "SHDOC401.DLL"
arSEA(214,0) = "{62112AA1-EBE4-11cf-A5FB-0020AFE7292D}" : arSEA(214,1) = "SHDOC401.DLL"
arSEA(215,0) = "{7BA4C740-9E81-11CF-99D3-00AA004AE837}" : arSEA(215,1) = "SHDOC401.DLL"
arSEA(216,0) = "{D969A300-E7FF-11d0-A93B-00A0C90F2719}" : arSEA(216,1) = "SHDOC401.DLL"
arSEA(217,0) = "{4622AD11-FF23-11d0-8D34-00A0C90F2719}" : arSEA(217,1) = "SHDOC401.DLL"
arSEA(218,0) = "{3AD1E410-AAB9-11d0-89D7-00C04FC9E26E}" : arSEA(218,1) = "SHDOCVW.DLL"
arSEA(219,0) = "{57651662-CE3E-11D0-8D77-00C04FC99D61}" : arSEA(219,1) = "SHDOC401.DLL"
arSEA(220,0) = "{B091E540-83E3-11CF-A713-0020AFD79762}" : arSEA(220,1) = "SHDOC401.DLL"
arSEA(221,0) = "{3FC0B520-68A9-11D0-8D77-00C04FD70822}" : arSEA(221,1) = "SHDOC401.DLL"
arSEA(222,0) = "{7D688A77-C613-11D0-999B-00C04FD655E1}" : arSEA(222,1) = "SHELL32.dll"
arSEA(223,0) = "{BDEADF00-C265-11d0-BCED-00A0C90AB50F}" : arSEA(223,1) = "MSONSEXT.DLL"
arSEA(224,0) = "{C2FBB630-2971-11d1-A18C-00C04FD75D13}" : arSEA(224,1) = "SHDOC401.DLL"
arSEA(225,0) = "{C2FBB631-2971-11d1-A18C-00C04FD75D13}" : arSEA(225,1) = "SHDOC401.DLL"
arSEA(226,0) = "{75048700-EF1F-11D0-9888-006097DEACF9}" : arSEA(226,1) = "SHDOC401.DLL"
arSEA(227,0) = "{6D5313C0-8C62-11D1-B2CD-006097DF8C11}" : arSEA(227,1) = "SHDOC401.DLL"
arSEA(228,0) = "{FBF23B41-E3F0-101B-8488-00AA003E56F8}" : arSEA(228,1) = "SHDOC401.DLL"
arSEA(229,0) = "{5a61f7a0-cde1-11cf-9113-00aa00425c62}" : arSEA(229,1) = "w3ext.dll"
'WME
arSEA(230,0) = "{3F30C968-480A-4C6C-862D-EFC0897BB84B}" : arSEA(230,1) = "THUMBVW.DLL" 'see (122)
arSEA(231,0) = "{53C74826-AB99-4d33-ACA4-3117F51D3788}" : arSEA(231,1) = "SHELL32.DLL"
arSEA(232,0) = "{992CFFA0-F557-101A-88EC-00DD010CCC48}" : arSEA(232,1) = "rnaui.dll" 'see (30)
arSEA(233,0) = "{FEF10FA2-355E-4e06-9381-9B24D7F7CC88}" : arSEA(233,1) = "SHELL32.DLL"
'MS PowerToys
arSEA(234,0) = "{AA7C7080-860A-11CE-8424-08002B2CFF76}" : arSEA(234,1) = "SENDTOX.DLL"
arSEA(235,0) = "{7BB70120-6C78-11CF-BFC7-444553540000}" : arSEA(235,1) = "SENDTOX.DLL"
arSEA(236,0) = "{7BB70122-6C78-11CF-BFC7-444553540000}" : arSEA(236,1) = "SENDTOX.DLL"
arSEA(237,0) = "{7BB70121-6C78-11CF-BFC7-444553540000}" : arSEA(237,1) = "SENDTOX.DLL"
arSEA(238,0) = "{7BB70123-6C78-11CF-BFC7-444553540000}" : arSEA(238,1) = "SENDTOX.DLL"
arSEA(239,0) = "{9E56BE62-C50F-11CF-9A2C-00A0C90A90CE}" : arSEA(239,1) = "SENDTOX.DLL"
arSEA(240,0) = "{90A756E0-AFCF-11CE-927B-0800095AE340}" : arSEA(240,1) = "target.dll"
arSEA(241,0) = "{afc638f0-e8a4-11ce-9ade-00aa00a42d2e}" : arSEA(241,1) = "TTFExtNT.dll"
'etc
arSEA(242,0) = "{1D2680C9-0E2A-469d-B787-065558BC7D43}" : arSEA(242,1) = "mscoree.dll"
arSEA(243,0) = "{5F327514-6C5E-4d60-8F16-D07FA08A78ED}" : arSEA(243,1) = "wuaueng.dll"
'set up key name to query
strKey = "Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved"
strSubTitle = "HKLM" & "\" & strKey & "\"
'find all the names in the key
intErrNum1 = oReg.EnumValues (HKLM, strKey, arNames, arType)
'enumerate data if present
If intErrNum1 = 0 And IsArray(arNames) Then
'for each CLSID
For Each strCLSID in arNames
'assume CLSID unapproved
flagMatch = False
ResolveCLSID HKLM, strKey, strCLSID, strValue, strIPSDLL
If strIPSDLL <> "" Then
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
'find CoName
strCN = CoName(IDExe(strIPSDLL))
TitleLineWrite
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) = " &_
StringFilter(strIPSDLL,True) & CoName(IDExe(strIPSDLL))
End If 'flagMatch Or flagShowAll?
End If 'strIPSDLL <> ""?
Next 'strCLSID
Else 'arNames array not returned
'if ShowAll, output key name
If flagShowAll Then TitleLineWrite
End If 'intErrNum1 = 0 & arNames array exists?
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
'recover array memory
ReDim arSEA(0,0)
End If 'flagTest?
'V. Examine HKLM... Explorer\SharedTaskScheduler/ShellExecuteHooks
If Not flagTest Then 'skip if testing
Dim arAllowedCLSID()
ReDim arKeys(1)
arKeys(0) = "Software\Microsoft\Windows\CurrentVersion\Explorer\SharedTaskScheduler"
arKeys(1) = "Software\Microsoft\Windows\CurrentVersion\Explorer\ShellExecuteHooks"
'for each Explorer sub-key
For i = 0 To UBound(arKeys)
strSubTitle = "HKLM" & "\" & arKeys(i) & "\"
'set up allowed CLSID's & IPS names for each sub-key
If i = 0 Then 'SharedTaskScheduler
ReDim arAllowedCLSID(1,1)
arAllowedCLSID(0,0) = "{438755C2-A8BA-11D1-B96B-00A0C90312E1}"
arAllowedCLSID(0,1) = "browseui.dll"
arAllowedCLSID(1,0) = "{8C7461EF-2B13-11d2-BE35-3078302C2030}"
arAllowedCLSID(1,1) = "browseui.dll"
ElseIf i = 1 Then 'ShellExecuteHooks
ReDim arAllowedCLSID(0,1)
arAllowedCLSID(0,0) = "{AEB6717E-7E19-11d0-97EE-00C04FD91972}"
arAllowedCLSID(0,1) = "shell32.dll"
End If 'which Explorer sub-key?
'find all the names in the Explorer key
oReg.EnumValues HKLM, arKeys(i), arNames, arType
'enumerate data if present
If IsArray(arNames) Then
'for each name
For Each strName In arNames
ResolveCLSID HKLM, arKeys(i), strName, strValue1, strValue3
If strValue3 <> "" Then
flagFound = False : strWarn = "INFECTION WARNING! "
strCN = CoName(IDExe(strValue3))
'for every CLSID
'see if CLSID, IPS filename are allowed & IPS CoName = "MS"
For j = 0 To UBound(arAllowedCLSID,1)
If LCase(strName) = LCase(arAllowedCLSID(j,0)) And _
LCase(Fso.GetFileName(strValue3)) = LCase(arAllowedCLSID(j,1)) And _
strCN = MS Then
flagFound = True : strWarn = "" : Exit For
End If
Next 'allowed CLSID & IPS file name
'if IPS not allowed or ShowAll, output name & value
If Not flagFound Or flagShowAll Then
'output the title line if not already done
TitleLineWrite
On Error Resume Next
oFN.WriteLine strWarn & Chr(34) & strName & Chr(34) &_
" = " & strValue1
'error check for W2K if SharedTaskScheduler value not set
intErrNum = Err.Number : Err.Clear
On Error GoTo 0
If intErrNum <> 0 Then oFN.WriteLine Chr(34) & strName & Chr(34) &_
" = (no title provided)"
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " &_
StringFilter(strValue3,True) & strCN
End If 'unexpected data or ShowAll?
End If 'IPS exists?
Next 'arNames array member
Else 'arNames array not returned
'if ShowAll, output key name
If flagShowAll Then TitleLineWrite
End If 'arNames array exists
Next 'Explorer sub-key
'reset flags
flagFound = False
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
'recover array memory
ReDim arAllowedCLSID(0)
ReDim arKeys(0)
ReDim arNames(0)
End If 'flagTest?
'VI. Examine HKCU/HKLM... ShellServiceObjectDelayLoad
If Not flagTest Then 'skip if testing
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(6,1)
arSSODL(0,0) = "{35cec8a3-2be6-11d2-8773-92e220524153}" : arSSODL(0,1) = "stobject.dll"
arSSODL(1,0) = "{7007accf-3202-11d1-aad2-00805fc1270e}" : arSSODL(1,1) = "netshell.dll"
arSSODL(2,0) = "{7849596a-48ea-486e-8937-a2a3009f31a9}" : arSSODL(2,1) = "shell32.dll"
arSSODL(3,0) = "{e57ce738-33e8-4c51-8354-bb4de9d215d1}" : arSSODL(3,1) = "upnpui.dll"
arSSODL(4,0) = "{e6fb5e20-de35-11cf-9c87-00aa005127ed}" : arSSODL(4,1) = "webcheck.dll"
arSSODL(5,0) = "{fbeb8a05-beee-4442-804e-409d6c4515e9}" : arSSODL(5,1) = "shell32.dll"
arSSODL(6,0) = "{bcbcd383-3e06-11d3-91a9-00c04f68105c}" : arSSODL(6,1) = "auhook.dll"
For i = 0 To 1 'for each hive
strSubTitle = arHives(i,0) & "\" & strKey & "\"
'find all the names in the key
oReg.EnumValues arHives(i,1), strKey, arNames, arType
'enumerate data if present
If IsArray(arNames) Then
'for each name
For Each strName In arNames
flagMatch = False 'SSODL entry is not allowable
'get the SSODL value = CLSID name
oReg.GetStringValue arHives(i,1),strKey,strName,strValue
'find the IPS at HKLM\Software\Classes\CLSID\{this data}\InProcServer32
strKey2 = "Software\Classes\CLSID\" & strValue & "\InProcServer32"
intErrNum = oReg.GetExpandedStringValue (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
Exit For
End If
Next 'arSSODL member
End If 'flagShowAll?
'write the quote-delimited name and value to the file if unallowable
If Not flagMatch Then
'output title line if not already done
TitleLineWrite
'output SSODL value
oFN.WriteLine Chr(34) & strName & Chr(34) & " = " & Chr(34) & strValue & Chr(34)
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " &_
StringFilter(strValue2,True) & strCN
End If 'flagMatch?
End If 'IPS exists?
Next 'SSODL value (strName) in array
End If 'arNames array exists
'if ShowAll, output key name
If flagShowAll Then TitleLineWrite
Next 'hive
'reset flags
flagMatch = False
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
strLine = ""
'recover array memory
ReDim arType(0)
ReDim arNames(0)
ReDim arSSOLD(0,0)
End If 'flagTest?
'VII. Find values of specific names:
' HKCU... Command Processor\AutoRun
' HKCU... Policies\System\Shell (W2K & WXP only)
' HKCU... Windows\load & run
' HKCU... Command Processor\AutoRun
' HKCU... Winlogon\Shell
' HKLM... Windows\AppInit_DLLs
' HKLM... Winlogon\Shell & Userinit & System & Ginadll & Taskman
' HKLM... Control\SafeBoot\Option\UseAlternateShell
' HKLM... Control\Session Manager\BootExecute
If Not flagTest Then 'skip if testing
'value length, pos'n of space/comma in value
Dim intSpacePosn, intCommaPosn
If strOS <> "W98" And strOS <> "WME" Then
'HKCU\Software\Microsoft\Command Processor\AutoRun
strSubTitle = "HKCU\SOFTWARE\Microsoft\Command Processor\"
RegDataChk HKCU, "SOFTWARE\Microsoft\Command Processor", "AutoRun", strValue, ""
If strOS = "W2K" Or strOS = "WXP" Then
'HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System
'"Shell" = ""
strSubTitle = "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\"
RegDataChk HKCU, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System", "Shell", strValue, ""
End If 'WXP?
'HKCU\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows\load & run
strSubTitle = "HKCU\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows\"
RegDataChk HKCU, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows", "load", strValue, ""
RegDataChk HKCU, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows", "run", strValue, ""
'HKCU\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell
'"Shell" = "Explorer.exe"
strSubTitle = "HKCU\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\"
RegDataChk HKCU, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "Shell", strValue, "explorer.exe"
'HKLM\Software\Microsoft\Command Processor\AutoRun
strSubTitle = "HKLM\SOFTWARE\Microsoft\Command Processor\"
RegDataChk HKLM, "SOFTWARE\Microsoft\Command Processor", "AutoRun", strValue, ""
'HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows\AppInit_DLLs
strSubTitle = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows\"
RegDataChk HKLM, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows", "AppInit_DLLs", strValue, ""
'HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\GinaDLL
'"GinaDLL" = "MSGina.dll"
strSubTitle = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\"
RegDataChk HKLM, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "GinaDLL", strValue, "msgina.dll"
'HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell
'"Shell" = "Explorer.exe"
RegDataChk HKLM, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "Shell", strValue, "explorer.exe"
'HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Taskman
'"Taskman" = ""
RegDataChk HKLM, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "Taskman", strValue, ""
'HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Userinit
'"Userinit" = "%SystemRoot%\system32\userinit.exe,"
'find value for "Userinit" name
flagInfect = False
strKey = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon"
intErrNum = oReg.GetStringValue (HKLM,strKey,"Userinit",strValue)
'if Userinit name exists And value set (exc for W2K!)
If intErrNum = 0 And strValue <> "" Then
'save default output line
strOut = Chr(34) & "Userinit" & Chr(34) & " = " & Chr(34) &_
strValue & Chr(34) & LRParse(strValue)
'remove trailing space or comma
strValue = Trim(strValue)
If InStrRev(strValue,",") = Len(strValue) Then strValue = _
Left(strValue,Len(strValue)-1)
'if NT4 And Userinit value <> expected string, toggle infection flag & fill warning string
If strOS = "NT4" And LCase(strValue) <> "userinit,nddeagnt.exe" And _
LCase(strValue) <> "userinit nddeagnt.exe" Then
flagInfect = True
'if W2K/WXP
ElseIf strOS <> "NT4" Then
'find pos'n of space & comma in value
intLenValue = Len(strValue)
intSpacePosn = InStr(strValue," ")
If intSpacePosn = 0 Then intSpacePosn = intLenValue
intCommaPosn = InStr(strValue,",")
If intCommaPosn = 0 Then intCommaPosn = intLenValue
'if string doesn't contain userinit.exe Or extends beyond space or comma
If InStr(LCase(strValue),"userinit.exe") = 0 Or _
intLenValue > intSpacePosn + 1 Or intLenValue > intCommaPosn + 1 Then _
flagInfect = True
End If 'userinit string test
If flagInfect Then strOut = "INFECTION WARNING! " & strOut
'if infected or ShowAll
If flagInfect Or flagShowAll Then
'output key name
TitleLineWrite
'write name and value to file
On Error Resume Next
oFN.WriteLine strOut
intErrNum = Err.Number : Err.Clear
On Error GoTo 0
'error check for W2K if Userinit value not set
If intErrNum <> 0 Then _
oFN.WriteLine Chr(34) & "Userinit" & Chr(34) & " = (value not set)"
End If 'flagInfect/flagShowAll
End If 'Userinit value exists?
flagInfect = False
'HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\System
'"System" = ""
'if NT4, check for expected value
If strOS = "NT4" Then
RegDataChk HKLM, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "System", strValue, "lsass.exe"
'if W2K/WXP, check for empty string
Else
RegDataChk HKLM, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "System", strValue, ""
End If
'*****
If strOS = "W2K" Or strOS = "WXP" Then
'HKLM\SYSTEM\CurrentControlSet\Control\SafeBoot\Option\UseAlternateShell
strKey = "System\CurrentControlSet\Control\SafeBoot\Option"
strSubTitle = "HKLM" & "\" & strKey & "\"
flagArray = False : flagInfect = False : strValue = "" : intType = -1 : strWarn = ""
'enumerate name/value pairs
EnumNVP HKLM,strKey,arNames,arType
'check for all OS's (esp WS2K3) if name/value pairs exist
If IsArray(arNames) Then
For Each strName In arNames
flagArray = True : Exit For
Next 'arNames member
'if name/value pairs exist
If flagArray Then
For i = 0 To UBound(arNames)
'check for UseAlternateShell name
If Trim(LCase(arNames(i))) = "usealternateshell" Then
'find its type & value, then exit For
flagInfect = True : strWarn = "INFECTION WARNING! "
intType = arType(i)
strValue = RtnValue (HKLM, strKey, "UseAlternateShell", intType)
Exit For
End If 'UseAlternateShell?
Next 'arName member
End If 'flagArray?
End If 'IsArray(arNames)?
'output UseAlternateShell value
If flagInfect Then
'write name and value to file
On Error Resume Next
TitleLineWrite
'output final line
oFN.WriteLine strWarn & Chr(34) & "UseAlternateShell" &_
Chr(34) & " = " & Chr(34) & strValue & Chr(34)
intErrNum = Err.Number : Err.Clear
On Error GoTo 0
'if write error, output warning
If intErrNum <> 0 Then oFN.WriteLine Chr(34) &_
"UseAlternateShell" & Chr(34) & " = ** WARNING -- empty or invalid data! **"
strKey = "System\CurrentControlSet\Control\SafeBoot"
strSubTitle = "HKLM" & "\" & strKey & "\"
TitleLineWrite
intErrNum = oReg.GetStringValue (HKLM,strKey,"AlternateShell",strValue)
If intErrNum = 0 Then
On Error Resume Next
oFN.WriteLine Chr(34) & "AlternateShell" & Chr(34) & " = " &_
Chr(34) & strValue & Chr(34)
intErrNum1 = Err.Number : Err.Clear
On Error Goto 0
'if write error, output warning
If intErrNum1 <> 0 Then oFN.WriteLine Chr(34) &_
"AlternateShell" & Chr(34) & " = ** WARNING -- empty or invalid data! **"
Else
oFN.WriteLine Chr(34) & "AlternateShell" & Chr(34) &_
" = (value not set)"
End If 'intErrNum=0?
ElseIf flagShowAll Then
TitleLineWrite
oFN.WriteLine Chr(34) & "UseAlternateShell" & Chr(34) & " = (no data)"
End If 'flagInfect Or flagShowAll?
flagArray = False : flagInfect = False : strWarn = ""
End If 'W2K or WXP?
'HKLM\System\CurrentControlSet\Control\Session Manager\BootExecute
strKey = "System\CurrentControlSet\Control\Session Manager"
intErrNum = oReg.GetMultiStringValue (HKLM,strKey,"BootExecute",arNames)
strSubTitle = "HKLM" & "\" & strKey & "\"
'initialize output strings
strLine = "" : strCN = "" : flagInfect = False : strWarn = ""
If intErrNum = 0 Then 'BootExecute value exists
'alert if autocheck not in every line of multi-string
For i = 0 To UBound(arNames)
'concatenate line
strLine = strLine & arNames(i) & " "
'if autocheck not in a line
If InStr(LCase(arNames(i)),"autocheck") = 0 Then
strWarn = "INFECTION WARNING! " : flagInfect = True
End If
Next 'arNames member
strLine = Chr(34) & RTrim(strLine) & Chr(34) 'embed in quotes
Else 'BootExecute value doesn't exist or not set
strLine = "(no data)"
End If 'BootExecute value exists?
'output bootexecute value
If flagInfect Or flagShowAll Then
'write name and value to file
On Error Resume Next
'if warning string not empty, parse line and find CoNames
If flagInfect Then strCN = LRParse(strLine)
TitleLineWrite
'output final line
oFN.WriteLine strWarn & Chr(34) & "BootExecute" &_
Chr(34) & " = " & strLine & strCN
intErrNum = Err.Number : Err.Clear
On Error GoTo 0
'if write error, output warning
If intErrNum <> 0 Then oFN.WriteLine strLine & Chr(34) &_
"BootExecute" & Chr(34) & " = ** WARNING -- empty or invalid data! **"
End If 'flagInfect Or flagShowAll?
End If 'not W98/WME
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
strLine = "" : strWarn = ""
End If 'flagTest?
'VIII. Examine HKLM... Winlogon\Notify\ subkey DLLName values
If Not flagTest Then 'skip if testing
Set arSK = CreateObject("Scripting.Dictionary") 'key, item
If strOS = "W2K" Then
arSK.Add "crypt32chain", "crypt32.dll"
arSK.Add "cryptnet", "cryptnet.dll"
arSK.Add "cscdll", "cscdll.dll"
arSK.Add "sclgntfy", "sclgntfy.dll"
arSK.Add "senslogn", "wlnotify.dll"
arSK.Add "termsrv", "wlnotify.dll"
arSK.Add "wzcnotif", "wzcdlg.dll"
ElseIf strOS = "WXP" Then
arSK.Add "crypt32chain", "crypt32.dll"
arSK.Add "cryptnet", "cryptnet.dll"
arSK.Add "cscdll", "cscdll.dll"
arSK.Add "sccertprop", "wlnotify.dll"
arSK.Add "schedule", "wlnotify.dll"
arSK.Add "sclgntfy", "sclgntfy.dll"
arSK.Add "senslogn", "wlnotify.dll"
arSK.Add "termsrv", "wlnotify.dll"
arSK.Add "wlballoon", "wlnotify.dll"
End If
arSKk = arSK.Keys
arSKi = arSK.Items
If strOS <> "W98" And strOS <> "WME" Then
strKey = "Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Notify"
strSubTitle = "HKLM" & "\" & strKey & "\"
'find all the subkeys
oReg.EnumKey HKLM, strKey, arKeys
'enumerate data if present
If IsArray(arKeys) Then
'for each key
For Each oKey In arKeys
'get the DLLName data
intErrNum = oReg.GetStringValue (HKLM,strKey & "\" & oKey,"DLLName",strValue)
'if sub-key DLLName name exists And value set (exc for W2K!)
If intErrNum = 0 And strValue <> "" Then
flagInfect = True : strWarn = "INFECTION WARNING! "
'check dictionary for allowed entry
For i = 0 To arSK.Count-1
'if key = dictionary key & value = dictionary item
If LCase(oKey) = arSKk(i) And LCase(strValue) = arSKi(i) Then
'empty warning string, toggle flag & exit -- no output necessary
flagInfect = False : strWarn = "" : Exit For
End If
Next 'dictionary key
'if flag not found in O/S-specific dictionary or ShowAll
If flagInfect Or flagShowAll Then
'output title lines if not already done
TitleLineWrite
On Error Resume Next
'write the key, name and value to a file
oFN.WriteLine strWarn & oKey & "\DLLName = " & Chr(34) &_
strValue & Chr(34) & CoName(IDExe(strValue))
intErrNum = Err.Number : Err.Clear
On Error GoTo 0
'error check for W2K if DLLName value not set
If intErrNum <> 0 Then oFN.WriteLine oKey & "\DLLName" &_
" = (value not set)"
End If 'flag not found in dictionary or ShowAll?
End If 'value missing?
Next 'Notify subkey
Else 'Notify subkeys don't exist
'output title line
If flagShowAll Then TitleLineWrite
End If 'Notify subkeys exist?
End If 'not W98/WME
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
strWarn = "" : strCN = ""
'recover array memory
arSK.RemoveAll : Set arSK=Nothing : ReDim arKeys(0)
End If 'flagTest?
'IX. Examine HKLM... Windows NT\CurrentVersion\Image File Execution Options
' subkey\Debugger value
If Not flagTest Then 'skip if testing
'ignore W98/WME
If strOS <> "W98" And strOS <> "WME" Then
strKey = "Software\Microsoft\Windows NT\CurrentVersion\Image File Execution Options"
strSubTitle = "HKLM\" & strKey & "\"
'get executable name sub-keys
oReg.EnumKey HKLM,strKey,arSubKeys
If IsArray(arSubKeys) Then
'for each sub-key
For Each strSubKey in arSubKeys
strWarn = ""
'skip allowed sub-key unless ShowAll
If LCase(strSubKey) <> LCase("Your Image File Name Here without a path") Or _
flagShowAll Then
'look for Debugger value
intErrNum = oReg.GetStringValue (HKLM,strKey & "\" & strSubKey,"Debugger",strValue)
'if Debugger value exists
If intErrNum = 0 And strValue <> "" Then
'if sub-key is not allowed, set warning
If LCase(strSubKey) <> LCase("Your Image File Name Here without a path") Then _
strWarn = "INFECTION WARNING! "
'output title line if not already done
TitleLineWrite
'output sub-key, warning, Debugger value
oFN.WriteLine strWarn & strSubKey & "\Debugger = " &_
Chr(34) & strValue & Chr(34) & CoName(IDExe(strValue))
End If 'Debugger value exists?
End If 'not allowed sub-key or ShowAll?
Next 'IFEO sub-key
'recover array memory
ReDim arSubKeys(0)
End If 'IFEO sub-key array exists?
End If 'not W98/WME?
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
End If 'flagTest?
'X. For W2K & WXP, check for startup/shutdown & logon/logoff scripts
If Not flagTest Then 'skip if testing
Dim strCmd : strCmd = "" 'script command line string
Dim arScrName() : ReDim arScrName(1,1)
arScrName(0,0) = "Logon" : arScrName(0,1) = "Logoff"
arScrName(1,0) = "Startup" : arScrName(1,1) = "Shutdown"
Select Case strOS
Case "W2K"
'collection flag
Dim flagColl : flagColl = False
'for HKCU, then HKLM
For i = 0 To 1
strKey = "Software\Policies\Microsoft\Windows\System\Scripts"
strSubTitle = arHives(i,0) & "\" & strKey & "\"
'for every script type for the hive
For j = 0 To 1
intErrNum = oReg.GetStringValue(arHives(i,1), strKey, arScrName(i,j), strValue)
If intErrNum = 0 And strValue <> "" Then
'if value points to SCRIPTS.INI, parse the file
If Fso.FileExists(strValue & "\scripts.ini") Then
ScrIFP strValue, arScrName(i,j)
'value is not empty, so output a warning, or value is not set
ElseIf strValue <> "" Then
On Error Resume Next
TitleLineWrite
oFN.WriteLine "WARNING! Either " & Chr(34) & strValue &_
"\scripts.ini" & Chr(34) & vbCRLF & Space(9) & "doesn't " &_
"exist or there " & "is insufficient permission to " &_
"read it!"
intErrNum = Err.Number : Err.Clear
On Error Goto 0
If intErrNum <> 0 Then
TitleLineWrite
oFN.WriteLine strName & " = (value not set)"
End If
End If 'value points to SCRIPTS.INI or is not empty
End If 'HKCU logon/logoff Or HKLM startup/shutdown value exists?
Next 'name in Scripts key
'if ShowAll, output title line
If flagShowAll Then TitleLineWrite
Next 'hive type
Case "WXP"
'Base Key string
Dim strBK : strBK = "Software\Policies\Microsoft\Windows\System\Scripts\"
Dim arNKSE 'Numbered (master) Keys containing Script Executable values
Dim strSPXP : strSPXP = "" 'Script Path XP string
'values: DisplayName, FileSysPath, Script, Parameter
Dim strDispName, strFSP, strScript, strParam
'for every hive
For i = 0 To 1
'for every script type
For j = 0 To 1
strSubTitle = arHives(i,0) & "\" & strBK & arScrName(i,j) & "\"
'look for script type subkeys
oReg.EnumKey arHives(i,1),strBK & arScrName(i,j),arKeys
'enumerate data if present
If IsArray(arKeys) Then
'for each numbered key header (containing numbered script keys)
For Each strKey in arKeys
strSubTitle = arHives(i,0) & "\" & strBK & arScrName(i,j) &_
"\" & strKey & "\"
'find DisplayName & FileSysPath
intErrNum1 = oReg.GetStringValue (arHives(i,1),strBK & arScrName(i,j) &_
"\" & strKey,"DisplayName",strDispName)
'embed existing, non-empty value in quotes
If intErrNum1 = 0 And strDispName <> "" Then
strDispName = Chr(34) & strDispName & Chr(34)
'for missing or empty value
Else
strDispName = "(value not set)"
End If 'DisplayName exists?
intErrNum2 = oReg.GetStringValue (arHives(i,1),strBK & arScrName(i,j) &_
"\" & strKey,"FileSysPath",strFSP)
'if value exists And not empty
If intErrNum2 = 0 And strFSP <> "" Then
'look for numbered script subkeys
oReg.EnumKey arHives(i,1),strBK & arScrName(i,j) & "\" & strKey,arNKSE
'enumerate data if present
If IsArray(arNKSE) Then
'for each numbered script key
For Each strKey2 in arNKSE
'find Parameter value
intErrNum3 = oReg.GetStringValue (arHives(i,1),strBK & arScrName(i,j) &_
"\" & strKey & "\" & strKey2,"Parameters",strParam)
'if Parameters name doesn't exist, set value to empty string
If intErrNum3 <> 0 Then strParam = ""
'find Script value
intErrNum4 = oReg.GetStringValue (arHives(i,1),strBK & arScrName(i,j) &_
"\" & strKey & "\" & strKey2,"Script",strScript)
'if Script value exists And not empty
If intErrNum4 = 0 And strScript <> "" Then
'form script executable string
'if script string has no backslash, use FileSysPath for directory
'and append \Scripts\[script type]\
If InStr(strScript,"\") = 0 Then
strSPXP = strFSP & "\Scripts\" & arScrName(i,j) & "\"
strCmd = strSPXP & strScript
Else 'script has backslash, so is full path to script
strCmd = strScript
End If
'if parameter string is not empty, append it
If Trim(strParam) <> "" Then strScript = strScript & " " & strParam
'write title lines if necessary for this master key
TitleLineWrite
oFN.WriteLine "DisplayName = " & strDispName
'write script executable
oFN.WriteLine strKey2 & "\" & " -> launches: " & Chr(34) &_
strSPXP & strScript & Chr(34) & CoName(IDExe(strCmd))
strSPXP = "" 'reset script path
End If 'Script value exists And not empty?
Next 'numbered script executable key
End If 'script executable key array exists?
End If 'FileSysPath exists?
Next 'master key
End If 'master key array exists?
'if ShowAll and no prior output, output key
If flagShowAll Then TitleLineWrite
Next 'script type
Next 'hive type
'recover array memory
ReDim arScrName(0)
End Select 'W2K or WXP?
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
End If 'flagTest?
'XI. HKCR Protocols\Filter
If Not flagTest Then 'skip if testing
'filter counter
Dim intFilterCnt : intFilterCnt = 0
'10 x 3 arFilter array: filter title, CLSID value, CLSID\InProcServer32 default value
ReDim arFilter(9,2)
arFilter(0,0) = "Class Install Handler"
arFilter(0,1) = "{32B533BB-EDAE-11d0-BD5A-00AA00B92AF1}"
arFilter(0,2) = "\urlmon.dll"
arFilter(1,0) = "deflate"
arFilter(1,1) = "{8f6b0360-b80d-11d0-a9b3-006097942311}"
arFilter(1,2) = "\urlmon.dll"
arFilter(2,0) = "gzip"
arFilter(2,1) = "{8f6b0360-b80d-11d0-a9b3-006097942311}"
arFilter(2,2) = "\urlmon.dll"
arFilter(3,0) = "lzdhtml"
arFilter(3,1) = "{8f6b0360-b80d-11d0-a9b3-006097942311}"
arFilter(3,2) = "\urlmon.dll"
arFilter(4,0) = "text/webviewhtml"
arFilter(4,1) = "{733AC4CB-F1A4-11d0-B951-00A0C90312E1}"
arFilter(4,2) = "\shell32.dll"
arFilter(5,0) = "text/webviewhtml"
arFilter(5,1) = "{733AC4CB-F1A4-11d0-B951-00A0C90312E1}"
arFilter(5,2) = "\shdoc401.dll"
arFilter(6,0) = "text/webviewhtml"
arFilter(6,1) = "{733AC4CB-F1A4-11d0-B951-00A0C90312E1}"
arFilter(6,2) = "\shdocvw.dll"
arFilter(7,0) = "application/octet-stream"
arFilter(7,1) = "{1E66F26B-79EE-11D2-8710-00C04F79ED0D}"
arFilter(7,2) = "\mscoree.dll"
arFilter(8,0) = "application/x-complus"
arFilter(8,1) = "{1E66F26B-79EE-11D2-8710-00C04F79ED0D}"
arFilter(8,2) = "\mscoree.dll"
arFilter(9,0) = "application/x-msdownload"
arFilter(9,1) = "{1E66F26B-79EE-11D2-8710-00C04F79ED0D}"
arFilter(9,2) = "\mscoree.dll"
strKey = "Software\Classes\PROTOCOLS\Filter"
strSubTitle = "HKLM" & "\" & strKey & "\"
'find all the subkeys
oReg.EnumKey HKLM, strKey, arKeys
'enumerate data if present
If IsArray(arKeys) Then
'for each key
For Each oKey In arKeys
'count number of filters
intFilterCnt = intFilterCnt + 1
'set default values:
'flagFound = True if CLSID & InProcServer32 values set
'flagMatch = True if filter name, CLSID, InProcServer32 DLL, &
' DLL CoName match allowed values
flagFound = True : flagMatch = False : flagInfect = True
strWarn = "INFECTION WARNING! "
'get the Filter CLSID value
intErrNum1 = oReg.GetStringValue (HKLM,strKey & "\" & oKey,"CLSID",strValue1)
'if CLSID name exists And value set (exc for W2K!)
If intErrNum1 = 0 And strValue1 <> "" Then
'prepare quote-embedded output string
strOut1 = Chr(34) & strValue1 & Chr(34)
'find CLSID InProcServer32 value and its CoName
intErrNum2 = oReg.GetExpandedStringValue (HKLM,"Software\Classes\CLSID\" &_
strValue1 & "\InProcServer32","",strValue2)
'if InProcServer32 value exists And value set
If intErrNum2 = 0 And strValue2 <> "" Then
strCN = CoName(IDExe(strValue2)) 'find CoName
'store output string
strOut2 = StringFilter(strValue2,True) & strCN
Else 'InProcServer32 value not set or empty
'toggle flags, empty warning string
flagFound = False : flagInfect = False
strWarn = "" : strOut2 = "(value not set)"
End If 'InProcServer32 value set?
Else 'CLSID value not set or empty
'toggle flags, empty warning string
flagFound = False : flagInfect = False
strWarn = "" : strOut1 = "(value not set)" : strOut2 = ""
End If 'CLSID value set?
'if both values set, check if filter is allowed
If flagFound Then
'check array for allowed entry
For i = 0 To UBound(arFilter,1)
'if filter name, CLSID value, DLL match arFilter & CoName = MS
If LCase(oKey) = LCase(arFilter(i,0)) And _
LCase(strValue1) = LCase(arFilter(i,1)) And _
LCase(IDExe(strValue2)) = LCase(strFPSF & arFilter(i,2)) And _
strCN = MS Then
'toggle flag, empty warning string
flagInfect = False : strWarn = "" : flagMatch = True : Exit For
End If 'filter name & CLSID match arFilter?
Next 'arFilter member
End If 'flagFound?
'if filter not in allowed array Or ShowAll
If flagInfect Or flagShowAll Then
TitleLineWrite
On Error Resume Next
'write the quote-delimited filter name and CLSID value
oFN.WriteLine strWarn & oKey & "\CLSID = " & strOut1
intErrNum = Err.Number : Err.Clear
'not W2K: if Filter CLSID not set, intErrNum = 0 & strOut2 = ""
'W2K : , intErrNum <> 0 & strOut2 = "(value not set)"
If intErrNum = 0 And strOut2 <> "" Then
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " & strOut2
ElseIf intErrNum <> 0 Then 'WriteLine error, so just write first line
oFN.WriteLine strWarn & oKey & "\CLSID = (value not set)"
End If 'WriteLine error?
On Error Goto 0
End If 'flagInfect Or ShowAll?
Next 'Filter subkey
End If 'Filter subkeys exist?
If flagShowAll Then TitleLineWrite
'reset flags
flagFound = False : flagMatch = False : flagInfect = False
'reset strings
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
strWarn = ""
'recover array memory
ReDim arFilter(0)
End If 'flagTest?
'XII. Check file & folder context menu shell extensions
If Not flagTest Then 'skip if testing
Dim arClasses() : ReDim arClasses(2)
arClasses(0) = "*" : arClasses(1) = "Directory" : arClasses(2) = "Folder"
Dim arAllowedDLLs : arAllowedDLLs = Array("syncui.dll", "cscui.dll", _
"shell32.dll", "runext.dll", "ntshrui.dll", "msshrui.dll", _
"shcompui.dll")
' layout.dll, CoName = "Microsoft"
For i = 0 To UBound(arClasses)
strSubTitle = "HKLM\Software\Classes\" & arClasses(i) &_
"\shellex\ContextMenuHandlers\"
strKey = "Software\Classes\" & arClasses(i) & "\shellex\ContextMenuHandlers"
intErrNum = oReg.EnumKey(HKLM,strKey,arSubKeys)
If intErrNum = 0 And IsArray(arSubKeys) Then
For Each strSubKey In arSubKeys
intErrNum2 = oReg.GetStringValue(HKLM,strKey & "\" & strSubKey,"",strCLSID)
If intErrNum2 = 0 And strCLSID <> "" Then
ResolveCLSID HKLM, "", strCLSID, strCLSIDTitle, strIPSDLL
If strIPSDLL <> "" Then 'IPS exists?
flagAllow = False
For j = 0 To UBound(arAllowedDLLs)
strCN = CoName(IDExe(strIPSDLL))
If LCase(Trim(Fso.GetFileName(strIPSDLL))) = LCase(arAllowedDlls(j)) And _
strCN = MS Then
flagAllow = True : Exit For
End If
Next 'arAllowedDLLs element
If Not flagAllow Or flagShowAll Then
TitleLineWrite
oFN.WriteLine strSubKey & "\(Default) = " & Chr(34) & strCLSID &_
Chr(34) & vbCRLF & " -> {CLSID}\InProcServer32\(Default) = " &_
Chr(34) & strIPSDLL & Chr(34) & CoName(IDExe(strIPSDLL))
End If 'Not flagAllow Or ShowAll?
End If 'strIPSDLL exists?
End If 'CLSID exists?
Next 'sub-key
End If 'sub-keys exist?
Next 'class
'recover array memory
ReDim arClasses(0)
'reset strings
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
End If 'flagTest?
'XIII. Check default executables for default strings
If Not flagTest Then 'skip if testing
'set up executables array
Dim arExeExt : arExeExt = Array("bat","cmd","com","exe","hta","pif","scr")
'set up expected value array
Dim arExpVal : arExpVal = Array("""%1"" %*","""%1"" %*","""%1"" %*","""%1"" %*", _
LCase(Fso.GetSpecialFolder(1)) & "\mshta.exe ""%1"" %*", _
"""%1"" %*","""%1"" /s")
Dim strExeDef 'default executable string
strTitle = "Default executables:"
'for each executable type
For i = 0 To UBound(arExeExt)
'initialize strings: warning, CoName, default executable, output
strWarn = "" : strCN = ""
strExeDef = "" : strOut = ""
'find the extension key to check
strKey1 = "SOFTWARE\Classes\." & arExeExt(i)
'find the file type at the default value
intErrNum1 = oReg.GetStringValue (HKLM,strKey1,"",strValue1)
'if file type exists And not empty
If intErrNum1 = 0 And strValue1 <> "" Then
'form the file type shell\open\command (S-O-C) string
strKey2 = "SOFTWARE\Classes\" & strValue1 & "\shell\open\command"
'look for the file type S-O-C value
intErrNum2 = oReg.GetStringValue (HKLM,strKey2,"",strValue2)
'if file type S-O-C value exists And not empty
If intErrNum2 = 0 And strValue2 <> "" Then
'set default executable & output strings
strExeDef = strValue2 : strOut = strKey2
'pointer value doesn't exist And O/S <> W98/WME/NT4
'W98G/W98SE/NT4 ignore ext shell\open\cmd if file type doesn't exist
'WME/W2K/WXP (incl SP2) interpret ext shell\open\cmd if file type doesn't exist
ElseIf strOS = "WXP" Or strOS = "W2K" Or strOS = "WME" Then
'look for ext S-O-C
strKey3 = "SOFTWARE\Classes\." & arExeExt(i) & "\shell\open\command"
intErrNum3 = oReg.GetStringValue (HKLM,strKey3,"",strValue3)
'if ext S-O-C exists And not empty
If intErrNum3 = 0 And strValue3 <> "" Then
'set default executable & output strings
strExeDef = strValue3 : strOut = strKey3
End If 'ext S-O-C value exists?
End If 'file type S-O-C exists?
Else 'extension doesn't point to file type
'look for ext S-O-C
strKey3 = "SOFTWARE\Classes\." & arExeExt(i) & "\shell\open\command"
intErrNum3 = oReg.GetStringValue (HKLM,strKey3,"",strValue3)
'if ext S-O-C exists And not empty
If intErrNum3 = 0 And strValue3 <> "" Then
strExeDef = strValue3 : strOut = strKey3
End If 'ext S-O-C exists?
End If 'file type exists?
'check against expected value, ShowAll
If (strExeDef <> "" And Trim(LCase(strExeDef)) <> arExpVal(i)) Or flagShowAll Then
'if not expected value, fill warnings & CoName
If strExeDef <> "" And Trim(LCase(strExeDef)) <> arExpVal(i) Then
strWarn = "INFECTION WARNING! " : strCN = CoName(IDExe(strExeDef))
'if exec default string doesn't have ID'd coname, don't show it
If strCN = " [file not found]" Then strCN = ""
End If
'output section titles if not done already
TitleLineWrite
'write exec extension name and key to file
If strOut <> "" Then
oFN.WriteLine vbCRLF & "." & UCase(arExeExt(i)) & ": " & "HKLM" &_
"\" & strOut & "\"
'output default executable value
oFN.WriteLine strWarn & Chr(34) & "Default" & Chr(34) & " = " &_
StringFilter(strExeDef,True) & strCN
End If 'strOut empty?
End If 'expected value found?
Next 'next executable in array
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
'recover array memory
ReDim arExeExt(0)
ReDim arExpVal(0)
End If 'flagTest?
'XIV. System/Group Policies
If Not flagTest Then 'skip if testing
'assign System or Group Policy name
Dim strPolName : strPolName = "System "
If strOS = "W2K" Or strOS = "WXP" Then strPolName = "Group "
Dim flagADClassicShell : flagADClassicShell = False 'True if ClassicShell disables AD
Dim flagADEnabled : flagADEnabled = False 'True if AD is enabled by GP
Dim flagADDisabled : flagADDisabled = False 'True if AD is disabled by GP
Dim flagFADO : flagFADO = False 'True if ForceActiveDesktopOn is set
Dim flagNAD : flagNAD = False 'True if NoActiveDesktop is set
Dim flagNADC : flagNADC = False 'True if NoActiveDesktopChanges is set
'True if ShellState setting should be examined
'HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\ShellState
Dim flagADviaSS : flagADviaSS = True
Dim flagGPWPEntry : flagGPWPEntry = False 'True if GP wallpaper value sets WP
Dim flagSkip : flagSkip = False 'True if skip write to output file
Dim arDisCplNames, strDisCplName, strDisCplValue
'set title line
strTitle = strPolName & "Policies [Description]:"
'add GPEdit location to title if GP used (W2K, WXP Pro)
If flagGP Then strTitle = "Group Policies [Description] {enabled Group Policy setting}:"
'examine Policies at Explorer & WindowsUpdate keys
strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer"
strSubTitle = "HKCU\" & strKey & "\"
ReDim arNames(9,2)
arNames(0,0) = "ClassicShell"
arNames(0,1) = "[disables Active Desktop (overrides all other " &_
"settings);" & vbCRLF & "removes the Display Properties|Web (tab); " &_
"sets options in" & vbCRLF & "Windows Explorer|Tools|Folder Options...]"
If strOS = "WXP" Then arNames(0,1) = "[removes the Display Properties|" &_
"Desktop (tab); disables Active Desktop;" & vbCRLF & "(overrides " &_
"all other settings); sets options in Windows Explorer|Tools|" &_
vbCRLF & "Folder Options...]"
If strOS = "W98" Or strOS = "NT4" Then arNames(0,1) = "[selects " &_
"Classic style in Windows Explorer|View|Folder Options...]"
arNames(0,2) = "{User Configuration|Administrative Templates|Windows " &_
"Components|" & vbCRLF & "Windows Explorer|Enable Classic Shell}"
If strOS = "WXP" Then arNames(0,2) = "{User Configuration|" &_
"Administrative Templates|Windows Components|" & vbCRLF &_
"Windows Explorer|Turn on Classic Shell}"
arNames(1,0) = "ForceActiveDesktopOn"
arNames(1,1) = "[enables Active Desktop and prevents disabling it]"
arNames(1,2) = "{User Configuration|Administrative Templates|Desktop" &_
"|Active Desktop|" & vbCRLF & "Enable Active Desktop}"
arNames(2,0) = "NoActiveDesktop"
arNames(2,1) = "[disables Active Desktop; removes Display Properties|" &_
"Web (tab)]"
If strOS = "WXP" Then arNames(2,1) = "[disables Active Desktop; " &_
"removes Web tab from Display Properties|" & vbCRLF & "Desktop (tab)|" &_
"Customize Desktop... (button)|Desktop Items (window)]"
arNames(2,2) = "{User Configuration|Administrative Templates|Desktop" &_
"|Active Desktop|" & vbCRLF & "Disable Active Desktop}"
arNames(3,0) = "NoActiveDesktopChanges"
arNames(3,1) = "[prevents changes to Active Desktop configuration;" &_
" removes" & vbCRLF & "Display Properties|Web (tab)]"
If strOS = "WXP" Then arNames(3,1) = "[prevents changes to Active Desktop; " &_
"removes Web tab from Display Properties|" & vbCRLF & "Desktop (tab)|" &_
"Customize Desktop... (button)|Desktop Items (window)]"
arNames(3,2) = "{User Configuration|Administrative Templates|Desktop" &_
"|Active Desktop|" & vbCRLF & "Prohibit changes}"
'added by GP, but ignored in practice, presence of DisallowCpl subkey name/value pairs
'sufficient to hide applets, even if this DWORD = 0 or absent
arNames(4,0) = "DisallowCpl"
arNames(4,1) = "[omits specific applets in Control Panel]"
arNames(4,2) = "{User Configuration|Administrative Templates|Control Panel|" &_
"Hide" & vbCRLF & "specified control panel applets|Policy (tab)|" &_
"Show... (button)"
If strOS = "WXP" Then arNames(4,2) = "{User Configuration|" &_
"Administrative Templates|Control Panel|Hide" & vbCRLF &_
"specified Control Panel applets|Setting (tab)|" &_
"Show... (button)"
arNames(5,0) = "NoToolbarCustomize"
arNames(5,1) = "[removes the " & Chr(34) & "Customize..." & Chr(34) &_
" menu option in Internet Explorer|View|Toolbars]"
arNames(5,2) = "{User Configuration|Administrative Templates|Windows " &_
"Components|" & vbCRLF & "Internet Explorer|Toolbars|Disable " &_
"customizing browser toolbar buttons}"
arNames(6,0) = "NoBandCustomize"
arNames(6,1) = "[disables toolbar status changes in Internet Explorer|" &_
"View|Toolbars]"
arNames(6,2) = "{User Configuration|Administrative Templates|Windows " &_
"Components|" & vbCRLF & "Internet Explorer|Toolbars|Disable " &_
"customizing browser toolbars}"
arNames(7,0) = "NoFolderOptions"
'strOS = "WXP"/"WME"
arNames(7,1) = "[removes Folder Options... from Windows Explorer|Tools " &_
"menu and from" & vbCRLF & "Control Panel]"
If strOS = "W98" Or strOS = "NT4" Then
arNames(7,1) = "[removes Folder Options... from Windows Explorer|View menu]"
ElseIf strOS = "W2K" Then
arNames(7,1) = "[removes Folder Options... from Windows Explorer|Tools menu]"
End If
arNames(7,2) = "{User Configuration|Administrative Templates|Windows " &_
"Components|" & vbCRLF & "Windows Explorer|Removes the Folder Options " &_
"menu item from the Tools menu}"
arNames(8,0) = "NoWindowsUpdate"
arNames(8,1) = "[removes Windows Update GUI links and disables " &_
"web site functionality]"
If strOS = "W98" Or strOS = "WME" Or strOS = "NT4" Then _
arNames(8,1) = "[removes Windows Update from Internet Explorer|Tools menu]"
arNames(8,2) = "{User Configuration|Administrative Templates|Start " &_
"Menu and Taskbar|" & vbCRLF & "Remove links and access to Windows " &_
"Update}"
'THIS MUST BE THE LAST ARRAY ROW
arNames(9,0) = "DisableWindowsUpdateAccess"
arNames(9,1) = "[disables Windows Update web site functionality]"
arNames(9,2) = "{User Configuration|Administrative Templates|Windows " &_
"Components|" & vbCRLF & "Windows Update|Remove access to use all " &_
"Windows Update features}"
'for every array member
For i = 0 To UBound(arNames,1)
'reset key & sub-title for WindowsUpdate value
If i = 9 Then
strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\WindowsUpdate"
strSubTitle = "HKCU\" & strKey & "\"
End If
'try to retrieve the value
intErrNum = oReg.GetDWORDValue (HKCU,strKey,arNames(i,0),intValue)
'if value exists And sets GP
If intErrNum = 0 And (intValue And 1) = 1 Then
flagSkip = False 'assume not skipped
strWarn = "HIJACK WARNING! " : strOut = "" 'empty output string
Select Case i
Case 0 'ClassicShell disables
Suite:
Case 0 'ClassicShell disables AD (exc in W98; in WMe, stops WP value
' from choosing WP but allows WP value
' to disable Background tab)
flagADClassicShell = True : flagADviaSS = False
flagADDisabled = True : strWarn = ""
If strOS = "W98" Or strOS = "NT4" Then
flagADClassicShell = False : flagADviaSS = True
flagADDisabled = False
End If
Case 1 'ForceActiveDesktopOn
flagFADO = True
If (strOS <> "W98" And strOS <> "NT4" And Not flagADClassicShell) Then
flagADEnabled = True 'ForceActiveDesktopOn overrules NoActiveDesktop
flagADviaSS = False
ElseIf strOS = "W98" Or strOS = "NT4" Then
flagFADO = False : flagSkip = True 'value not used in these O/S's
End If
Case 2 'NoActiveDesktop
flagNAD = True : strWarn = ""
If Not flagFADO Then 'if FADO not set
flagADDisabled = True : flagADviaSS = False
Else 'FADO enabled
arNames(2,1) = "[normally disables Active Desktop, but overruled " &_
"by " & Chr(34) & "ForceActiveDesktopOn" & Chr(34) & "]"
If Not flagADClassicShell Then flagADDisabled = False
End If
Case 3 'NoActiveDesktopChanges
flagNADC = True
Case 4
flagSkip = True 'value ignored in W2K & WXP
Case 9
'DisableWindowsUpdateAccess has no effect in W9x
If strOS = "W98" Or strOS = "WME" Or strOS = "NT4" Then flagSkip = True
End Select
If Not flagSkip Then 'output title lines
If strTitle <> "" Then
TitleLineWrite
Else
oFN.WriteBlankLines(1)
End If
'output name=value, description, GP policy location
oFN.WriteLine strWarn & Chr(34) & arNames(i,0) & Chr(34) &_
"=dword:00000001 " & vbCRLF & arNames(i,1) & strOut
If flagGP Then oFN.WriteLine arNames(i,2)
End If 'flagSkip?
Else 'value doesn't exist or doesn't set GP
If flagShowAll Then TitleLineWrite
End If 'value = 1?
Next 'array member
'DisallowCpl"
'look for omitted Control Panel applets
strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\DisallowCpl"
strSubTitle = "HKCU\" & strKey & "\"
If strOS = "W2K" Or strOSXP = "Windows XP Home" Then 'only works in these O/S's
'.CPL file names & applet titles can be used to hide Control Panel applets
'script will not not detect applet exclusion via title on foreign-language versions
'detection of English-language title on foreign-language W2K version
'would provide false positive, so recognition of titles abandoned -- any
'unrecognized value string is output as suspect
Dim arCplets : Set arCplets = CreateObject("Scripting.Dictionary") 'key, item
'W2K: appwiz.cpl omits both Add/Remove Programs and Folder Options,
'but title allows individual exclusion (which will *not* be detected here)
'WXPH: appwiz.cpl only omits Add and Remove Programs
If strOS = "W2K" Then
arCplets.Add "appwiz.cpl", Chr(34) & "Add/Remove Programs" & Chr(34) &_
", " & Chr(34) & "Folder Options" & Chr(34)
ElseIf strOS = "WXP" Then
arCplets.Add "appwiz.cpl", Chr(34) & "Add or Remove Programs" & Chr(34)
End If
arCplets.Add "desk.cpl", Chr(34) & "Display Properties" & Chr(34)
arCplets.Add "inetcpl.cpl", Chr(34) & "Internet Options" & Chr(34)
If strOS = "WXP" Then
arCplets.Add "firewall.cpl", Chr(34) & "Windows Firewall" & Chr(34)
arCplets.Add "wscui.cpl", Chr(34) & "Windows Security Center" & Chr(34)
End If
Dim arCpletsk : arCpletsk = arCplets.Keys
Dim arCpletsi : arCpletsi = arCplets.Items
'retrieve list of hidden cpl names
intErrNum2 = oReg.EnumValues (HKCU,strKey,arDisCplNames,arType)
'if names exist
If intErrNum2 = 0 And IsArray(arDisCplNames) Then
strSubSubTitle = "HIJACK WARNING! The following applets are not " &_
"displayed in Control Panel:" & vbCRLF
'for each name
For Each strDisCplName In arDisCplNames
'retrieve the value
intErrNum3 = oReg.GetStringValue(HKCU, strKey, strDisCplName, strDisCplValue)
'if value exists
If intErrNum3 =0 And strDisCplValue <> "" Then
strOut = "" : flagMatch = False
'look for matching applet file name
For j = 0 To UBound(arCpletsk)
'if match found, output Control Panel applet name and title
If LCase(Trim(strDisCplValue)) = LCase(arCpletsk(j)) Then
strOut = Space(2) & arCpletsk(j) & " (" & arCpletsi(j) & ")"
flagMatch = True : Exit For
End If
Next 'cpl applet
If Not flagMatch Then strOut = Space(2) & strDisCplValue &_
" (unrecognized file name)"
TitleLineWrite
On Error Resume Next
oFN.WriteLine strOut : intErrNum = Err.Number : Err.Clear
On Error Goto 0
If intErrNum <> 0 Then oFN.WriteLine " (unwritable string)"
End If 'value exists?
Next 'value name
If flagGP Then oFN.WriteLine vbCRLF & arNames(4,2)
strSubSubTitle = ""
Else 'names don't exist
If flagShowAll Then TitleLineWrite
End If 'names exist?
'empty the dictionary
arCplets.RemoveAll : Set arCplets=Nothing
End If 'W2K/WXPH?
'examine Policies at System key
strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\System"
strWarn = "HIJACK WARNING! "
strSubTitle = "HKCU\" & strKey & "\"
ReDim arNames(4,2)
arNames(0,0) = "DisableRegistryTools"
If strOS = "W98" Or strOS = "WME" Or strOS = "WXP" Then
arNames(0,1) = "[prohibits launch of REGEDIT.EXE]"
Else 'NT4 or W2K
arNames(0,1) = "[prohibits launch of REGEDIT.EXE and REGEDT32.EXE]"
End If
arNames(0,2) = "{User Configuration|Administrative Templates|System|" &_
vbCRLF & "Disable registry editing tools}"
If strOS = "WXP" Then arNames(0,2) = "{User Configuration|" &_
"Administrative Templates|System|Prevent access to" & vbCRLF &_
"registry editing tools}"
arNames(1,0) = "NoDispBackgroundPage"
arNames(1,1) = "[removes Display Properties, Background (tab)]"
If strOS = "WXP" Then arNames(1,1) = "[removes Display Properties, Desktop (tab)]"
arNames(1,2) = "{User Configuration|Administrative Templates|Control Panel" &_
"|Display|" & vbCRLF & "Hide Background tab}"
If strOS = "WXP" Then arNames(1,2) = "{User Configuration|" &_
"Administrative Templates|Control Panel|Display|" & vbCRLF &_
"Hide Desktop tab}"
arNames(2,0) = "NoDispCpl"
arNames(2,1) = "[disables Display in Control Panel]"
arNames(2,2) = "{User Configuration|Administrative Templates|Control Panel" &_
"|Display|" & vbCRLF & "Disable Display in Control Panel}"
If strOS = "WXP" Then arNames(2,2) = "{User Configuration|" &_
"Administrative Templates|Control Panel|Display|" & vbCRLF &_
"Remove Display in Control Panel}"
arNames(3,0) = "Wallpaper"
arNames(3,1) = "[disables Display Properties|Background (tab); " &_
"selects wallpaper if" & vbCRLF & "Active Desktop is enabled]"
If strOS = "WXP" Then
arNames(3,1) = "[disables the Display Properties|Desktop (tab) " &_
"(except the " & Chr(34) & "Customize" & vbCRLF & "Desktop..." &_
Chr(34) & " button); selects wallpaper if Active Desktop is enabled]"
If strOSXP = "Windows XP Professional SP2" Then _
arNames(3,1) = "[disables the Display Properties|Desktop (tab) " &_
"(except the " & Chr(34) & "Customize" & vbCRLF & "Desktop..." &_
Chr(34) & " button); selects wallpaper and enables Active Desktop]"
Else 'for any non-XP O/S
If flagNAD And Not flagFADO Then
arNames(3,1) = "[normally disables Display Properties|" &_
"Background (tab) and" & vbCRLF & "selects wallpaper if Active " &_
"Desktop is enabled, but overruled" & vbCRLF & "by " & Chr(34) &_
"NoActiveDesktop" & Chr(34) & "]"
ElseIf flagNADC Then
arNames(3,1) = "[normally disables Display Properties|" &_
"Background (tab), but" & vbCRLF & "overruled by " & Chr(34) &_
"NoActiveDesktopChanges" & Chr(34) & "; selects wallpaper if" &_
vbCRLF & "Active Desktop is enabled]"
End If 'flagNAD/flagFADO/flagNADC?
End If 'WXP?
arNames(3,2) = "{User Configuration|Administrative Templates|Desktop" &_
"|Active Desktop|" & vbCRLF & "Active Desktop Wallpaper|Wallpaper Name:}"
arNames(4,0) = "WallpaperStyle"
arNames(4,1) = "[disables " & Chr(34) & "Picture Display:" & Chr(34) &_
" control only in Display Properties|" & vbCRLF & "Background (tab)]"
If strOS = "WXP" Then arNames(4,1) = "[selects " & Chr(34) & "Position:" &_
Chr(34) & " in Display Properties|Desktop (tab)" & vbCRLF &_
"if Active Desktop is enabled]"
arNames(4,2) = "{User Configuration|Administrative Templates|Desktop" &_
"|Active Desktop|" & vbCRLF & "Active Desktop Wallpaper|Wallpaper Style:}"
For i = 0 To UBound(arNames,1)
If i < 3 Then intErrNum = oReg.GetDWORDValue (HKCU,strKey,arNames(i,0),intValue)
'Wallpaper & WallpaperStyle values are strings
If i = 3 Or i = 4 Then intErrNum = oReg.GetStringValue (HKCU,strKey,arNames(i,0),strValue)
If intErrNum = 0 Then 'if value exists
flagSkip = True 'assume value not output
Select Case i
Case 0 'DisableRegistryTools
If (intValue And 1) = 1 Then flagSkip = False
strOut = "HIJACK WARNING! " & Chr(34) & arNames(i,0) & Chr(34) &_
"=dword:00000001 " & vbCRLF & arNames(i,1)
Case 1 'NoDispBackgroundPage
If (intValue And 1) = 1 Then flagSkip = False
strOut = "HIJACK WARNING! " & Chr(34) & arNames(i,0) & Chr(34) &_
"=dword:00000001 " & vbCRLF & arNames(i,1)
Case 2 'NoDispCpl
If (intValue And 1) = 1 Then flagSkip = False
strOut = "HIJACK WARNING! " & Chr(34) & arNames(i,0) & Chr(34) &_
"=dword:00000001 " & vbCRLF & arNames(i,1)
Case 3 'Wallpaper
If strOS = "W98" Or strOS = "NT4" Then
flagSkip = True 'value not used under W98 & NT4
Else 'any other O/S
flagSkip = False
If Not flagADDisabled Then
flagGPWPEntry = True 'value may be looked at unless GP already disabled
If strOSXP = "Windows XP Professional SP2" Then
'under WXP Pro SP2, value enables AD unless AD already disabled
flagADEnabled = True : flagADviaSS = False
End If 'strOSXP?
End If 'flagADDisabled?
strOut = "HIJACK WARNING! " & Chr(34) & arNames(i,0) & Chr(34) &_
" = " & Chr(34) & strValue & Chr(34) & vbCRLF & arNames(i,1)
End If 'strOS?
Case 4 'WallpaperStyle
If strOS = "W98" Or strOS = "NT4" Then
flagSkip = True
Else
If strValue <> "" Then flagSkip = False
intValue = CInt(strValue) 'convert to integer
'WallpaperStyle (0 centered, 1 tiled, 2 stretched)
If intValue = 0 Then
strLine1 = "Center"
ElseIf (intValue And 1) = 1 Then
strLine1 = "Tile"
ElseIf (intValue And 2) = 2 Then
strLine1 = "Stretch"
End If
strOut = "HIJACK WARNING! " & Chr(34) & arNames(i,0) & Chr(34) &_
" = " & Chr(34) & CStr(intValue) & Chr(34) &_
" [" & strLine1 & "]" & vbCRLF & arNames(i,1)
End If 'strOS?
End Select
If Not flagSkip Then
If strTitle <> "" Then
TitleLineWrite
Else
oFN.WriteBlankLines(1)
End If
On Error Resume Next
oFN.WriteLine strOut
intErrNum1 = Err.Number : Err.Clear
On Error Goto 0
If intErrNum1 <> 0 Then _
oFN.WriteLine Chr(34) & arNames(i,0) & Chr(34) &_
" = (value not set)" & vbCRLF & arNames(i,1)
If flagGP Then oFN.WriteLine arNames(i,2)
End If 'flagSkip?
Else 'value not found
If flagShowAll Then TitleLineWrite
End If 'value exists?
Next 'array value
'examine Policies at ActiveDesktop key
strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\ActiveDesktop"
strSubTitle = "HKCU\" & strKey & "\"
ReDim arNames(3,2)
arNames(0,0) = "NoChangingWallPaper"
arNames(0,1) = "[disables options on Display Properties|Background (tab)]"
If flagNADC Then arNames(0,1) = "[normally disables options on Display " &_
"Properties|Background (tab)," & vbCRLF & "but overruled by " &_
Chr(34) & "NoActiveDesktopChanges" & Chr(34) & "]"
If strOS = "WXP" Then arNames(0,1) = _
"[disables " & Chr(34) & "Background:" & Chr(34) & " list on Display " &_
"Properties|Desktop (tab)]"
arNames(0,2) = "{User Configuration|Administrative Templates|Control " &_
"Panel|Display|" & vbCRLF & "Disable changing wallpaper}"
If strOS = "WXP" Then arNames(0,2) = "{User Configuration|Administrative " &_
"Templates|Control Panel|Display|" & vbCRLF & "Prevent changing wallpaper}"
arNames(1,0) = "NoClosingComponents"
arNames(1,1) = "[disables close button for web content on desktop; " &_
"removes open/close" & vbCRLF & "check box from web content on " &_
"Display Properties|Web (tab)]"
If strOS = "WXP" Then arNames(1,1) = _
"[" & Chr(34) & "Web pages:" & Chr(34) & " list items on Display " &_
"Properties|Desktop (tab)|" & vbCRLF & "Customize Desktop... (button)|" &_
"Desktop Items (window)|Web (tab)" & vbCRLF & "have no check box]"
arNames(1,2) = "{User Configuration|Administrative Templates|Desktop" &_
"|Active Desktop|" & vbCRLF & "Prohibit closing items}"
arNames(2,0) = "NoDeletingComponents"
arNames(2,1) = "[disables " & Chr(34) & "Delete" & Chr(34) & " button " &_
"on Display Properties|Web (tab)]"
If strOS = "WXP" Then arNames(2,1) = _
"[disables " & Chr(34) & "Delete" & Chr(34) & " button on Display " &_
"Properties|Desktop (tab)|" & vbCRLF & "Customize Desktop... (button)|" &_
"Desktop Items (window)|Web (tab)]"
arNames(2,2) = "{User Configuration|Administrative Templates|Desktop" &_
"|Active Desktop|" & vbCRLF & "Prohibit deleting items}"
arNames(3,0) = "NoEditingComponents"
arNames(3,1) = "[disables " & Chr(34) & "Properties" & Chr(34) & " button " &_
"on Display Properties|Web (tab)]"
If strOS = "WXP" Then arNames(3,1) = _
"[disables " & Chr(34) & "Properties" & Chr(34) & " button on Display " &_
"Properties|Desktop (tab)|" & vbCRLF & "Customize Desktop... (button)|" &_
"Desktop Items (window)|Web (tab)]"
arNames(3,2) = "{User Configuration|Administrative Templates|Desktop" &_
"|Active Desktop|" & vbCRLF & "Prohibit editing items}"
For i = 0 To UBound(arNames,1)
'get the value
intErrNum = oReg.GetDWORDValue (HKCU,strKey,arNames(i,0),intValue)
'if value exists and GP set
If intErrNum = 0 And (intValue And 1) = 1 Then
If strTitle <> "" Then
TitleLineWrite
Else
oFN.WriteBlankLines(1)
End If
oFN.WriteLine "HIJACK WARNING! " & Chr(34) & arNames(i,0) & Chr(34) &_
"=dword:00000001 " & vbCRLF & arNames(i,1)
If flagGP Then oFN.WriteLine arNames(i,2)
Else 'value doesn't exist or doesn't set GP
If flagShowAll Then TitleLineWrite
End If 'value = 1?
Next 'array value
'examine Internet Explorer Policies
strKey = "Software\Policies\Microsoft\Internet Explorer\Control Panel"
strSubTitle = "HKCU\" & strKey & "\"
strWarn = "HIJACK WARNING! "
ReDim arNames(8,2)
arNames(0,0) = "GeneralTab"
arNames(0,1) = "[removes the Internet Options|General (tab)]"
arNames(0,2) = "{User Configuration|Administrative Templates|" &_
"Windows Components|" & vbCRLF & "Internet Explorer|Internet " &_
"Control Panel|Disable the General page}"
arNames(1,0) = "HomePage"
arNames(1,1) = "[disables the Home page field in Internet Options|" &_
"General (tab)]"
arNames(1,2) = "{User Configuration|Administrative Templates|" &_
"Windows Components|" & vbCRLF & "Internet Explorer|Disable " &_
"changing home page settings}"
arNames(2,0) = "ConnectionsTab"
arNames(2,1) = "[removes the Internet Options|Connections (tab)]"
arNames(2,2) = "{User Configuration|Administrative Templates|" &_
"Windows Components|" & vbCRLF & "Internet Explorer|Internet " &_
"Control Panel|Disable the Connections page}"
arNames(3,0) = "Connection Settings"
arNames(3,1) = "[disables all controls except the the " & Chr(34) &_
"Setup..." & Chr(34) & " button in" & vbCRLF & "Internet Options|" &_
"Connections (tab)]"
arNames(3,2) = "{User Configuration|Administrative Templates|" &_
"Windows Components|" & vbCRLF & "Internet Explorer|Disable " &_
"changing connection settings}"
arNames(4,0) = "Proxy"
arNames(4,1) = "[disables controls in Internet Options|Connections (tab)|" &_
vbCRLF & "LAN Settings...|Proxy server]"
arNames(4,2) = "{User Configuration|Administrative Templates|" &_
"Windows Components|" & vbCRLF & "Internet Explorer|Disable " &_
"changing proxy settings}"
arNames(5,0) = "SecurityTab"
arNames(5,1) = "[removes the Internet Options|Security (tab)]"
arNames(5,2) = "{User Configuration|Administrative Templates|" &_
"Windows Components|" & vbCRLF & "Internet Explorer|Internet " &_
"Control Panel|Disable the Security page}"
arNames(6,0) = "ResetWebSettings"
arNames(6,1) = "[disables the " & Chr(34) & "Reset Web Settings..." &_
Chr(34) & " button in Internet Options|" & vbCRLF & "Programs (tab)]"
arNames(6,2) = "{User Configuration|Administrative Templates|" &_
"Windows Components|" & vbCRLF & "Internet Explorer|Disable " &_
"the Reset Web Settings feature}"
'THIS ROW CHANGES THE POLICIES KEY
arNames(7,0) = "NoBrowserOptions"
arNames(7,1) = "[disables Tools|Internet Options... in Internet Explorer]"
arNames(7,2) = "{User Configuration|Administrative Templates|" &_
"Windows Components|" & vbCRLF & "Internet Explorer|Browser Menus|" &_
"Tools menu: Disable Internet" & vbCRLF & "Options... menu option}"
arNames(8,0) = "NoExtensionManagement"
arNames(8,1) = "[disables Settings radio buttons in Tools|Manage " &_
"Add-ons... in Internet Explorer]"
arNames(8,2) = "{User Configuration|Administrative Templates|" &_
"Windows Components|" & vbCRLF & "Internet Explorer|Do not allow " &_
"users to enable or disable add-ons}"
'for every array member
For i = 0 To UBound(arNames,1)
flagSkip = False
'set up different key for NoBrowserOptions & NoExtensionManagement
If i = 7 Then
strKey = "Software\Policies\Microsoft\Internet Explorer\Restrictions"
strSubTitle = "HKCU\" & strKey & "\"
End If
If i = 8 And strOSLong <> "Windows XP SP2" Then flagSkip = True
If Not flagSkip Then
'try to retrieve the value
intErrNum = oReg.GetDWORDValue (HKCU,strKey,arNames(i,0),intValue)
'if value exists And sets GP
If intErrNum = 0 And (intValue And 1) = 1 Then
'output titles
If strSubTitle <> "" Then
TitleLineWrite
Else
oFN.WriteBlankLines(1)
End If
'output name=value, description, GP location
oFN.WriteLine strWarn & Chr(34) & arNames(i,0) & Chr(34) &_
"=dword:00000001 " & vbCRLF & arNames(i,1)
If flagGP Then oFN.WriteLine arNames(i,2)
Else 'value doesn't exist or doesn't set GP
If flagShowAll Then TitleLineWrite
End If 'value = 1?
End If 'flagSkip?
Next 'array member
'has no effect in WMe
If strOS = "WXP" Then
'examine Policies at HKLM... Windows NT key
strKey = "Software\Policies\Microsoft\Windows NT\SystemRestore"
strSubTitle = "HKLM\" & strKey & "\"
ReDim arNames(1,2)
arNames(0,0) = "DisableSR"
arNames(0,1) = "[removes Control Panel|System|System Restore (tab) and disables applet]"
arNames(0,2) = "{Computer Configuration|Administrative Templates|System|" &_
"System Restore|" & vbCRLF & "Turn off System Restore}"
arNames(1,0) = "DisableConfig"
arNames(1,1) = "[disables options on Control Panel|System|System Restore (tab)]"
arNames(1,2) = "{Computer Configuration|Administrative Templates|System|" &_
"System Restore|" & vbCRLF & "Turn off Configuration}"
'for every array member
For i = 0 To UBound(arNames,1)
'try to retrieve the value
intErrNum = oReg.GetDWORDValue (HKLM,strKey,arNames(i,0),intValue)
'if value exists And sets GP
If intErrNum = 0 And (intValue And 1) Then
'output titles
If strSubTitle <> "" Then
TitleLineWrite
Else
oFN.WriteBlankLines(1)
End If
'output name=value, description, GP location
oFN.WriteLine strWarn & Chr(34) & arNames(i,0) & Chr(34) &_
"=dword:00000001 " & vbCRLF & arNames(i,1)
If flagGP Then oFN.WriteLine arNames(i,2)
Else 'value doesn't exist or doesn't set GP
If flagShowAll Then TitleLineWrite
End If 'value = 1?
Next 'array member
End If 'WXP?
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
'recover array memory
ReDim arNames(0)
End If 'flagTest?
'XV. Active Desktop, wallpaper & screen saver
If Not flagTest Then 'skip if testing
Dim arBValue()
Dim flagIEWPSet : flagIEWPSet = False
'title line string
strTitle = "Active Desktop and Wallpaper:"
'Active Desktop
If flagADviaSS Then
'Active Desktop flag key
strKey = "Software\Microsoft\Windows\CurrentVersion\Explorer"
'get the ShellState binary array
intErrNum = oReg.GetBinaryValue (HKCU,strKey,"ShellState",arBValue)
'if array returned
If intErrNum = 0 And IsArray(arBValue) Then
'if array contains Active Desktop flag
If UBound(arBValue) >= 4 Then
'if 0-based 4th array element contains 64 (AD flag set)
If (arBValue(4) And 64) = 64 Then
flagADEnabled = True
ReDim arBValue(0) 'recover array memory
TitleLineWrite
oFN.WriteLine vbCRLF & "Active Desktop is enabled at this entry:" &_
vbCRLF & "HKCU\" & strKey & "\ShellState"
Else
TitleLineWrite : flagADDisabled = True
oFN.WriteLine vbCRLF & "Active Desktop is disabled at this entry:" &_
vbCRLF & "HKCU\" & strKey & "\ShellState"
End If 'AD enabled?
End If 'UBound>=4?
Else 'binary value not found
If flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & "Active Desktop is not enabled."
End If
End If 'binary value exists?
ElseIf flagADEnabled Then
TitleLineWrite
oFN.WriteLine vbCRLF & "Active Desktop enabled via " & strPolName & "Policy."
ElseIf flagADDisabled Then
TitleLineWrite
oFN.WriteLine vbCRLF & "Active Desktop disabled via " & strPolName & "Policy."
End If 'flagADviaSS?
'Wallpaper
'if AD enabled And WP Not set in GP
If flagADEnabled And Not flagGPWPEntry Then
'check for AD wallpaper
strKey = "Software\Microsoft\Internet Explorer\Desktop\General"
strSubTitle = "HKCU\" & strKey & "\"
intErrNum = oReg.GetStringValue (HKCU,strKey,"Wallpaper",strValue)
'if AD wallpaper value set
If intErrNum = 0 And strValue <> "" Then 'exc for W2K!
'toggle flag
flagIEWPSet = True
'write value
On Error Resume Next
TitleLineWrite
oFN.WriteLine Chr(34) & "Wallpaper" & Chr(34) & " = " &_
Chr(34) & strValue & Chr(34)
intErrNum1 = Err.Number : Err.Clear
On Error Goto 0
If intErrNum1 <> 0 Then oFN.WriteLine Chr(34) & "Wallpaper" &_
Chr(34) & " = (value not set)"
End If 'AD wallpaper value set?
ElseIf flagADEnabled And flagGPWPEntry Then
oFN.WriteLine vbCRLF & "Wallpaper selected via " & strPolName & "Policy."
End If 'flagADEnabled And Not flagGPWPEntry?
'if WP not set via IE, look for it at HKCU\Control Panel\Desktop
If Not flagGPWPEntry And Not flagIEWPSet Then
'retrieve Wallpaper value
strKey = "Control Panel\Desktop"
strSubTitle = "HKCU\" & strKey & "\"
intErrNum = oReg.GetStringValue (HKCU,strKey,"Wallpaper",strValue)
'if value set (exc for W2K!)
If intErrNum = 0 And strValue <> "" Then 'exc for W2K!
TitleLineWrite
'output wallpaper value
On Error Resume Next
oFN.WriteLine Chr(34) & "Wallpaper" & Chr(34) & " = " &_
Chr(34) & strValue & Chr(34)
intErrNum2 = Err.Number : Err.Clear
On Error Goto 0
If intErrNum2 <> 0 Then oFN.WriteLine Chr(34) & "Wallpaper" &_
Chr(34) & " = (value not set)"
Else 'WP value not present
If flagShowAll Then
TitleLineWrite
oFN.WriteLine Chr(34) & "Wallpaper" & Chr(34) & " = (value not set)"
End If
End If 'wallpaper value set?
End If 'flagADDisabled Or W2K?
'web content
If flagADEnabled Then
'look for web content
strKey = "Software\Microsoft\Internet Explorer\Desktop\Components"
intErrNum = oReg.EnumKey(HKCU,strKey,arKeys)
'if sub-keys exist
If IsArray(arKeys) Then
strSubTitle = "Active Desktop web content:"
'for each subkey
For Each oKey in arKeys
strSubSubTitle = "HKCU\" & strKey & "\" & oKey & "\"
'retrieve DWORD containing web content activation flag
intErrNum1 = oReg.GetDWORDValue (HKCU,strKey & "\" & oKey,"Flags",intValue)
'if DWORD value set
If intErrNum = 0 And intValue <> 0 Then
'if DWORD contains 8192 (web content activation flag set)
If (intValue And 8192) = 8192 Then
'get web content descriptive values
oReg.GetStringValue HKCU,strKey & "\" & oKey,"FriendlyName",strValue1
oReg.GetStringValue HKCU,strKey & "\" & oKey,"Source",strValue2
oReg.GetStringValue HKCU,strKey & "\" & oKey,"SubscribedURL",strValue3
TitleLineWrite
'write web content descriptive values
On Error Resume Next
oFN.WriteLine Chr(34) & "FriendlyName" & Chr(34) & " = " &_
Chr(34) & strValue1 & Chr(34)
intErrNum2 = Err.Number : Err.Clear
If intErrNum2 <> 0 Then oFN.WriteLine Chr(34) & "FriendlyName" &_
Chr(34) & " = (value not set)"
oFN.WriteLine Chr(34) & "Source" & Chr(34) & " = " &_
Chr(34) & strValue2 & Chr(34)
intErrNum2 = Err.Number : Err.Clear
If intErrNum2 <> 0 Then oFN.WriteLine Chr(34) & "Source" &_
Chr(34) & " = (value not set)"
oFN.WriteLine Chr(34) & "SubscribedURL" & Chr(34) & " = " &_
Chr(34) & strValue3 & Chr(34)
intErrNum2 = Err.Number : Err.Clear
If intErrNum2 <> 0 Then oFN.WriteLine Chr(34) & "SubscribedURL" &_
Chr(34) & " = (value not set)"
On Error Goto 0
End If 'web content active?
End If 'web content DWORD value set?
Next 'web content subkey
End If 'web content subkeys exist
End If 'flagADEnabled?
strSubTitle = ""
'Screen Saver
If strOS <> "W98" And strOS <> "WME" Then
Dim strLFN : strLFN = "" 'screen saver LFN
Dim strExt : strExt = "" 'wallpaper file extension
strWarn = ""
strTitle = "Enabled Screen Saver:"
strKey = "Control Panel\Desktop"
strSubTitle = "HKCU\" & strKey & "\"
'get the screen saver name
intErrNum = oReg.GetStringValue (HKCU,strKey,"Scrnsave.exe",strValue)
'if Scrnsave.exe value exists And value set (exc for W2K!)
' And value <> "(NONE)" (NT4 default)
If intErrNum = 0 And strValue <> "" And LCase(strValue) <> "(none)" Then
'get screen saver LFN if file exists
If Fso.FileExists(strValue) Then
'create (but don't save) shortcut
Dim oSC : Set oSC = Wshso.CreateShortcut("getLFN.lnk")
'set & retrieve target path
oSC.TargetPath = strValue
strLFN = Fso.GetFile(oSC.TargetPath).Name
Set oSC=Nothing
'set up LFN string if SFN <> LFN
If LCase(strLFN) = LCase(Fso.GetFileName(strValue)) Then
strLFN = ""
Else
strLFN = " (" & strLFN & ")"
End If
End If 'screen saver file exists?
TitleLineWrite
On Error Resume Next
oFN.WriteLine Chr(34) & "SCRNSAVE.EXE" & Chr(34) & " = " &_
Chr(34) & strValue & Chr(34) & strLFN & CoName(IDExe(strValue))
intErrNum = Err.Number : Err.Clear
On Error Goto 0
If intErrNum <> 0 Then oFN.WriteLine Chr(34) & "SCRNSAVE.EXE" &_
Chr(34) & " = (value not set)"
Else 'Scrnsave.exe value doesn't exist
'if ShowAll, output title line
If flagShowAll Then
TitleLineWrite
oFN.WriteLine Chr(34) & "SCRNSAVE.EXE" & Chr(34) & " = (value not set)"
End If 'flagShowAll
End If 'Scrnsave.exe value exists?
End If 'strOS <> W98/WME?
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
End If 'flagTest?
'XVI. For W98/WME, check inside WIN.INI (load=, run=), SYSTEM.INI (shell=) &
' for W98 only, list contents of non-empty WINSTART.BAT
If Not flagTest Then 'skip if testing
If strOS = "W98" Or strOS = "WME" Then
strTitle = "WIN.INI & SYSTEM.INI launch points:"
Dim oSCF 'System Configuration File
'true if in INI-file section containing targeted lines
Dim flagSection : flagSection = False
strSubTitle = "WIN.INI" & vbCRLF & "[windows]"
'open WIN.INI
Set oSCF = Fso.OpenTextFile (strFPWF & "\WIN.INI",1)
'for each line of WIN.INI
Do While Not oSCF.AtEndOfStream
'read a line
strLine = oSCF.ReadLine
'if not a blank/comment line And inside [windows] section
If Trim(strLine) <> "" And Left(LTrim(strLine),1) <> ";" Then
If flagSection Then
'if line is beginning of another section
If Left(LTrim(strLine),1) = "[" Then
'toggle flag to false and exit Do
flagSection = False : Exit Do
End If 'next section?
'input line, verb, expected contents, disk
IniInfParse strLine, "load", "", ""
IniInfParse strLine, "run", "", ""
End If 'flagSection?
'if first 9 chars of line = [windows], then in the right section
'so toggle flagSection to True
If LCase(Left(LTrim(strLine),9)) = "[windows]" Then flagSection = True
End If 'blank/comment line?
Loop 'next line of WIN.INI
oSCF.Close 'close WIN.INI
flagSection = False
strSubTitle = "SYSTEM.INI" & vbCRLF & "[boot]"
'open SYSTEM.INI
Set oSCF = Fso.OpenTextFile (strFPWF & "\SYSTEM.INI",1)
'for each line of SYSTEM.INI
Do While Not oSCF.AtEndOfStream
strLine = oSCF.ReadLine
'if not a blank/comment line And inside [windows] section
If Trim(strLine) <> "" And Left(LTrim(strLine),1) <> ";" Then
'if inside [boot] section
If flagSection Then
If Left(LTrim(strLine),1) = "[" Then
'toggle flagSection and exit
flagSection = False : Exit Do
End If 'shell line?
IniInfParse strLine, "shell", "explorer.exe", ""
IniInfParse strLine, "scrnsave.exe", "anything", ""
End If 'inside boot section?
'if first 6 chars of line = [boot], then in the right section
'so toggle flagSection to True
If LCase(Left(LTrim(strLine),6)) = "[boot]" Then flagSection = True
End If 'blank/comment line?
Loop
oSCF.Close
strSubTitle = ""
'for W98 only
If strOS = "W98" Then
strTitle = "WINSTART.BAT contents:"
'open WINSTART.BAT if it exists
If Fso.FileExists(strFPWF & "\WINSTART.BAT") Then
Set oSCF = Fso.OpenTextFile (strFPWF & "\WINSTART.BAT",1)
'for each line of WINSTART.BAT
Do While Not oSCF.AtEndOfStream
strLine = oSCF.ReadLine
If strLine <> "" Then 'examine line if it's not a CR
If Len(strLine) >= 3 Then 'test against REM if long enough
'if not REM, then output
If LCase(Left(LTrim(strLine),3)) <> "rem" Then
If strTitle <> "" Then
TitleLineWrite : oFN.WriteBlankLines(1)
End If
oFN.WriteLine strLine
End If
Else 'len 1-2
TitleLineWrite : oFN.WriteLine strLine
End If 'len < 3?
End If 'carriage return?
Loop 'WINSTART.BAT lines
oSCF.Close : Set oSCF=Nothing
Else 'WINSTART.BAT doesn't exist
'if ShowAll, write title lines
If flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & "(file not found)"
End If
End If 'WINSTART.BAT exists?
End If 'W98?
End If 'strOS = W98/WME
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
End If 'flagTest?
'XVII. AUTORUN.INF in root directory of local fixed disks for which
' autorun is enabled
If Not flagTest Then 'skip if testing
'WME & WXP SP2 do not launch AUTORUN.INF on local fixed disks
If strOS <> "WME" And strOSLong <> "Windows XP SP2" Then
'fixed disk, DWORD value, binary value array, AutoRun.Inf file,
'integer work variable
Dim oDisk, hVal, arBVal, oARI
strTitle = "Autostart via AUTORUN.INF on local fixed drives:"
'array of fixed disks
Public arFixedDisks()
'Disk Letter dictionary (needed to calculate power of 2)
'dictDL.Item(6) returns "G:"
Public dictDL : Set dictDL = CreateObject("Scripting.Dictionary")
dictDL.Add 0, "A:" : dictDL.Add 1, "B:" : dictDL.Add 2, "C:"
dictDL.Add 3, "D:" : dictDL.Add 4, "E:" : dictDL.Add 5, "F:"
dictDL.Add 6, "G:" : dictDL.Add 7, "H:" : dictDL.Add 8, "I:"
dictDL.Add 9, "J:" : dictDL.Add 10, "K:" : dictDL.Add 11, "L:"
dictDL.Add 12, "M:" : dictDL.Add 13, "N:" : dictDL.Add 14, "O:"
dictDL.Add 15, "P:" : dictDL.Add 16, "Q:" : dictDL.Add 17, "R:"
dictDL.Add 18, "S:" : dictDL.Add 19, "T:" : dictDL.Add 20, "U:"
dictDL.Add 21, "V:" : dictDL.Add 22, "W:" : dictDL.Add 23, "X:"
dictDL.Add 24, "Y:" : dictDL.Add 25, "Z:"
'HKLM NoDriveTypeAutoRun Fixed Disks Enabled
Public flagHKLM_NDTAR_FDE : flagHKLM_NDTAR_FDE = True
'HKCU NoDriveTypeAutoRun Fixed Disks Enabled
Public flagHKCU_NDTAR_FDE : flagHKCU_NDTAR_FDE = True
'HKLM NoDriveTypeAutoRun value exists
Public flagHKLM_NDTAR : flagHKLM_NDTAR = False
'HKCU NoDriveTypeAutoRun value exists (unused, passed for consistency)
Public flagHKCU_NDTAR : flagHKCU_NDTAR = False
'HKLM NoDriveAutoRun value exists
Public flagHKLM_NDAR : flagHKLM_NDAR = False
'HKCU NoDriveAutoRun value exists (unused, passed for consistency)
Public flagHKCU_NDAR : flagHKCU_NDAR = False
strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer"
NDTAR HKLM, flagHKLM_NDTAR, flagHKLM_NDTAR_FDE
If Not flagHKLM_NDTAR Then NDTAR HKCU, flagHKCU_NDTAR, flagHKCU_NDTAR_FDE
'if NoDriveTypeAutoRun permits autorun on fixed disks, look at
'individual disks
If flagHKLM_NDTAR_FDE And flagHKCU_NDTAR_FDE Then
'enumerate fixed disks
Set colDisks = GetObject("winmgmts:\root\cimv2")._
ExecQuery("SELECT * FROM Win32_LogicalDisk WHERE DriveType = 3")
j = 0
'fmt of DeviceID & Name is "A:"
For Each oDisk in colDisks
'for every dict entry
For i = 0 To 25
'find dictionary element number for drive letter
If dictDL.Item(i) = oDisk.DeviceID Then
'store disk letter, power of two for that letter,
'set autorun flag to True, increment counter
ReDim Preserve arFixedDisks(2,j)
arFixedDisks(0,j) = oDisk.DeviceID
arFixedDisks(1,j) = 2^i
arFixedDisks(2,j) = True
j = j + 1
End If 'dict drive letter located?
Next 'dict entry
Next 'disk in colDisks
NDAR HKLM, flagHKLM_NDAR
If Not flagHKLM_NDAR Then NDAR HKCU, flagHKCU_NDAR
'for every fixed disk
For i = 0 To UBound(arFixedDisks,2)
strSubTitle = arFixedDisks(0,i) & "\"
'if autorun enabled
If arFixedDisks(2,i) Then
'look for AUTORUN.INF in the root
If Fso.FileExists(arFixedDisks(0,i) & "\autorun.inf") Then
'open AUTORUN.INF if found
Set oARI = Fso.OpenTextFile (arFixedDisks(0,i) & "\autorun.inf",1)
'for each line of AUTORUN.INF
Do While Not oARI.AtEndOfStream
'read a line
strLine = oARI.ReadLine
'look for "open" or "shellexecute" statements
IniInfParse strLine, "open", "", arFixedDisks(0,i)
IniInfParse strLine, "shellexecute", "", arFixedDisks(0,i)
Loop 'next AUTORUN.INF line
oARI.Close : Set oARI=Nothing 'close AUTORUN.INF
'if no verbs found And ShowAll
If strSubTitle <> "" And flagShowAll Then
TitleLineWrite
oFN.WriteLine "AUTORUN.INF -> (" & Chr(34) & "open" & Chr(34) &_
" & " & Chr(34) & "shellexecute" & Chr(34) & " lines not found)"
End If 'ShowAll?
Else 'AUTORUN.INF not found in root
'if ShowAll
If flagShowAll Then
TitleLineWrite
'output file not found message
oFN.WriteLine "AUTORUN.INF -> (file not found)"
End If 'ShowAll?
End If 'AUTORUN.INF exists in root?
End If 'autorun enabled on drive?
Next 'fixed disk
End If 'NoDriveTypeAutoRun enables autorun on fixed disks?
dictDL.RemoveAll : Set dictDL=Nothing
End If 'strOS<>WME/WXP SP2?
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
End If 'flagTest?
'XVIII. Check for DESKTOP.INI in local hard disk directories
If Not flagTest Then 'skip if testing
'skip unless -supp or -all command line parameters used
If flagShowAll Or flagSupp Then
Dim datDTIStart : datDTIStart = Now
Public strDTITime
'array of allowed CLSID DLLs
Dim arOKDLLs : arOKDLLs = Array("shdocvw.dll", "occache.dll", _
"mstask.dll", "cdfview.dll", "shell32.dll", "fontext.dll", _
"mscoree.dll")
strTitle = "DESKTOP.INI DLL launch in local fixed drive directories:"
'enumerate fixed disks
Set colDisks = GetObject("winmgmts:\root\cimv2")._
ExecQuery("SELECT * FROM Win32_LogicalDisk WHERE DriveType = 3")
For Each oDisk in colDisks
'initialize DeskTop.Ini output & error arrays & counters
ReDim arSDDTI(0) : ctrArDTI = 0
ReDim arSDErr(0) : ctrArErr = 0
'check for unreadable partition
On Error Resume Next
'root format: C:\
Set oRoot = Fso.GetDrive(oDisk.DeviceID).RootFolder
intErrNum = Err.Number : Err.Clear
On Error Goto 0
If intErrNum = 0 Then 'if partition readable
'find directories with System attribute containing DESKTOP.INI
'with .ShellClassInfo section and CLSID statement
'fill arSDDTI array with output & arSDErr with (permission) errors
DirSysAtt oRoot
'output DLL launch points if found
If ctrArDTI > 0 Then
TitleLineWrite
'output array contents
For i = 0 To UBound(arSDDTI) : oFN.WriteLine arSDDTI(i) : Next
ElseIf flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & oRoot.Drive & " (no DLL launch points found)"
End If
'output errors if ShowAll
If ctrArErr > 0 And flagShowAll Then
strSubTitle = "Permission Errors on " & oRoot.Drive : TitleLineWrite : strOut = ""
For i = 0 To UBound(arSDErr)
'limit line length to 100
If strOut <> "" Then
If Len(strOut & arSDErr(i)) >= 100 Then
oFN.WriteLine strOut : strOut = arSDErr(i)
Else
strOut = strOut & ", " & arSDErr(i)
End If 'this error & prev errors>100?
Else 'strOut empty
If Len(arSDErr(i)) >= 100 Then
oFN.WriteLine arSDErr(i)
Else
strOut = arSDErr(i)
End If 'this error>100?
End If 'strOut empty?
Next 'arSDErr member
'write out final error string
If strOut <> "" Then oFN.WriteLine strOut : strOut = ""
End If
Set oRoot=Nothing
Else 'partition not readable (may be Linux)
TitleLineWrite
oFN.WriteLine vbCRLF & "WARNING! " & oDisk.DeviceID & " is an unreadable partition!"
End If 'partition readable?
Next 'disk in colDisks
'determine -supp seconds used
strDTITime = DateDiff("s",datDTIStart,Now) & " seconds"
Set colDisks=Nothing
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
'recover array memory
ReDim arSDDTI(0) : ReDim arSDErr(0)
End If 'flagShowAll Or flagSupp?
End If 'flagTest?
'XIX. Enumerate contents of startup directories
If Not flagTest Then 'skip if testing
'All Users StartUp Folder title string (empty by default)
Dim flagAUSUF : flagAUSUF = False
Dim flagFE : flagFE = True 'folder exists flag
'in W98/WME, see if local-language-specific All Users startup folder location
'appears in registry and form title string if it does
If strOS = "W98" Or strOS = "WME" Then
'look for Common Startup value
strKey = "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
oReg.GetStringValue HKLM,strKey,"Common Startup",strValue
'if Common Startup name exists and value not empty, toggle flag
If Not IsNull(strValue) And strValue <> "" Then flagAUSUF = True
End If
'startup folder short names
If strOS = "W98" Or strOS = "WME" Then
arSUFN = Array("Startup")
Else
arSUFN = Array("Startup","AllUsersStartup")
End If
'form output file section title string
strLine = "Startup items in "
'in W98/WME, omit username & "All Users" folder if absent from registry
If strOS = "W98" Or strOS = "WME" Then
strLine = strLine & Chr(34) & "Startup" & Chr(34)
If flagAUSUF Then
strLine = strLine & " & " & Chr(34) & "All Users...Startup" &_
Chr(34) & " folders:"
Else
strLine = strLine & " folder:"
End If
Else 'all other O/S's
strLine = strLine & Chr(34) & Wshso.ExpandEnvironmentStrings("%USERNAME%") &_
Chr(34) & " & " & Chr(34) & "All Users" & Chr(34) & " startup folders:"
End If
strTitle = strLine
'for each startup folder name
For i = 0 To 1 '0 = user folder, 1 = All Users folder
'get the startup folder
'in W98/WME, set flagFE to False if "All Users" folder doesn't exist
If i = 1 And (strOS = "W98" Or strOS = "WME") Then
If flagAUSUF Then
If Fso.FolderExists(strValue) Then
Set oSUF = Fso.GetFolder(strValue)
Else
flagFE = False 'folder doesn't exist
End If
Else
flagFE = False 'registry key doesn't exist
End If
Else 'all other O/S's at all times
Set oSUF = Fso.GetFolder(Wshso.SpecialFolders(arSUFN(i)))
End If
strSubTitle = oSUF.Path
'if startup folder exists
If flagFE Then
'for each file in the startup folder
For Each oSUFi in oSUF.Files
strLine = "" 'empty the line
'treat file as a shortcut
On Error Resume Next
Set oSUSC = Wshso.CreateShortcut(oSUFi)
intErrNum = Err.Number : Err.Clear
On Error Goto 0
'if file is a shortcut
If intErrNum = 0 Then
If LCase(Fso.GetExtensionName(oSUFi)) = "url" Then 'shortcut is URL
'prepare the shortcut file base name and the target path & arguments
strLine = Chr(34) & Fso.GetBaseName (oSUFi.Path) & Chr(34) & " -> URL shortcut to: " &_
Chr(34) & oSUSC.TargetPath
Else
'prepare the shortcut file base name and the target path & arguments
strLine = Chr(34) & Fso.GetBaseName (oSUFi.Path) & Chr(34) & " -> shortcut to: " &_
Chr(34) & oSUSC.TargetPath
If oSUSC.Arguments <> "" Then
strLine = strLine & " " & oSUSC.Arguments & Chr(34)
Else
strLine = strLine & Chr(34)
End If
'add co-name
strLine = strLine & CoName(IDExe(oSUSC.TargetPath))
End If 'URL or shortcut?
'if file is a PIF
ElseIf LCase(Fso.GetExtensionName(oSUFi)) = "pif" Then
'write out pif file target
strPIFTgt = ""
Dim oFi : Set oFi = Fso.OpenTextFile(oSUFi, 1)
oFi.Skip(36) 'target starts after 36 bytes
'target size is up to 63 bytes
For ii = 1 To 63
bin1C = oFi.Read(1)
'end of target is single "00" byte
If AscB(bin1C) = 0 Then Exit For
'otherwise convert binary to ASCII and append to string
strPIFTgt = strPIFTgt & Chr(AscB(bin1C))
Next
oFi.Close
Set oFi=Nothing
strLine = Chr(34) & Fso.GetBaseName(oSUFi.Path) & Chr(34) &_
" -> PIF to: " & Chr(34) & strPIFTgt & Chr(34) &_
CoName(IDExe(strPIFTgt))
'file is neither shortcut nor PIF
Else
'file is probably an executable so write out an INFECTION WARNING and
' the file name, using the full path as IDExe argument
If LCase(Fso.GetFileName(oSUFi)) <> "desktop.ini" Then _
strLine = "INFECTION WARNING! " & Chr(34) & oSUFi.Name & Chr(34) &_
CoName(IDExe(oSUFi.Path))
End If 'file is shortcut
Set oSUSC=Nothing
'if there's something to output
If strLine <> "" Then
'output the section title line if not already done
TitleLineWrite
'output the line
oFN.WriteLine strLine
End If
Next 'file in startup folder
Set oSUF=Nothing
'if ShowAll
If flagShowAll Then TitleLineWrite
End If 'flagFE?
Next 'startup folder name
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
'recover array memory
ReDim arSUFN(0)
End If 'flagTest?
'XX. Enumerate enabled Scheduled Tasks
If Not flagTest Then 'skip if testing
' Byte Disabled Enabled
'00000030: #####1## #####0## <--
'file in Tasks directory
Dim oFi2
'prepare section title lines
strTitle = "Enabled Scheduled Tasks:"
'if the tasks directory exists in the Windows directory
If Fso.FolderExists(Fso.GetSpecialFolder(WinFolder) & "\Tasks") Then
'get the tasks folder
Dim oJobF : Set oJobF = Fso.GetFolder(Fso.GetSpecialFolder(WinFolder) & "\Tasks")
'for each file
For Each oFi2 in oJobF.Files
'if file in Tasks directory is a task (has a .JOB extension)
If LCase(Fso.GetExtensionName(oFi2)) = "job" Then
'try to open the task file
On Error Resume Next
Dim oJobFi : Set oJobFi = Fso.OpenTextFile(oFi2,1,False,-1)
intErrNum = Err.Number : Err.Clear
On Error Goto 0
'if file could be opened
If intErrNum = 0 Then
'read the file, determine enabled status, extract the executable name
JobFileRead oFi2, oJobFi
'close the .JOB file
oJobFi.Close : Set oJobFi=Nothing
Else 'file couldn't be opened
TitleLineWrite
'write error message
oFN.WriteLine vbCRLF & Chr(34) & oFi2.Name & Chr(34) &_
" -- insufficient permission to read this file!"
End If '.JOB file opened successfully?
End If '.JOB file extension selected?
Next 'file in TASKS directory
'if ShowAll, output title line if not already done
If flagShowAll Then TitleLineWrite
Else 'Tasks directory can't be found
'write titles and error message
TitleLineWrite
oFN.WriteLine vbCRLF & "WARNING! The " & Chr(34) &_
Wshso.ExpandEnvironmentStrings("%WINDIR%") & "\Tasks" & Chr(34) &_
" directory cannot be found."
End If 'Tasks directory exists?
Set oJobF=Nothing
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
End If 'flagTest?
'XXI. Enumerate Winsock2 Service Provider DLLs
If Not flagTest Then 'skip if testing
strTitle = "Winsock2 Service Provider DLLs:"
Dim strNSCatKey 'NameSpace Catalog Key
Dim strProCatKey 'Protocol Catalog Key
Dim strNSSP 'NameSpace Service Provider
Dim arTSP '(returned) Transport Service Provider array
Dim int1C 'single chr binary (integer) code
'TSP output array for numeric keys, key #, strlen of key #, work var
Dim arTSPFi(), intKN, intL, intT
'TSP output array for alpha (illegal) keys
Dim arATSPFi()
'arTSPFi is 3 x n array
ReDim arTSPFi(2,0)
ReDim arATSPFi(1,0)
'number of numbered TSP keys
Dim intNumKeys : intNumKeys = 0
intCnt = 0 'arTSPFi UBound - 1
Dim intACnt : intACnt = 0 'arATSPFi UBound - 1
strAllOutDefault = " {++}"
'NameSpace Providers
strKey = "System\CurrentControlSet\Services\Winsock2\Parameters"
'find name of NameSpace Catalog key
intErrNum1 = oReg.GetStringValue (HKLM,strKey,"Current_NameSpace_Catalog",strNSCatKey)
'if the Current_NameSpace_Catalog name exists And value set (exc for W2K!)
If intErrNum1 = 0 And strNSCatKey <> "" Then
strSubTitle = "Namespace Service Providers" & vbCRLF & vbCRLF &_
"HKLM\" & strKey & "\" & strNSCatKey & "\Catalog_Entries\" &_
strAllOutDefault
'find NameSpace catalog entry subkeys
oReg.EnumKey HKLM,strKey & "\" & strNSCatKey & "\Catalog_Entries",arKeys
'if sub-keys exist
If IsArray(arKeys) Then
'for each subkey
For Each oKey in arKeys
'find LibraryPath
intErrNum2 = oReg.GetStringValue (HKLM,strKey & "\" & strNSCatKey &_
"\Catalog_Entries\" & oKey,"LibraryPath",strNSSP)
'if the LibraryPath name exists And value set (exc for W2K!)
If intErrNum2 = 0 And strNSSP <> "" Then
TitleLineWrite
On Error Resume Next
oFN.WriteLine oKey & "\LibraryPath" & " = " & Chr(34) &_
strNSSP & Chr(34) & CoName(IDExe(strNSSP))
intErrNum3 = Err.Number : Err.Clear
On Error Goto 0
If intErrNum3 <> 0 Then oFN.WriteLine oKey & "\LibraryPath" &_
" = (value not set)"
End If 'LibaryPath value set?
Next 'subkey
'IsArray = True, but array is empty
If strSubTitle <> "" And flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & "HKLM\" & strKey &_
"\" & strNSCatKey & "\Catalog_Entries\" & " = (sub-keys not found)"
End If
Else 'Catalog_Entries subkeys do not exist
If flagShowAll Then
TitleLineWrite : oFN.WriteLine "(sub-keys not found)"
End If
End If 'Catalog_Entries subkeys exist?
Else 'Current_NameSpace_Catalog value doesn't exist Or value not set
If flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & "HKLM\" & strKey &_
"\Current_Namespace_Catalog = (value not found)"
End If
End If 'Current_NameSpace_Catalog value exists?
'Transport Service Providers (Layered Service Providers = LSP's)
intErrNum1 = oReg.GetStringValue (HKLM,strKey,"Current_Protocol_Catalog",strProCatKey)
'if the Current_Protocol_Catalog name exists And value set (exc for W2K!)
If intErrNum1 = 0 And strProCatKey <> "" Then
strSubTitle = "Transport Service Providers" & vbCRLF & vbCRLF &_
"HKLM\" & strKey & "\" & strProCatKey & "\Catalog_Entries\" &_
strAllOutDefault
'find Protocol catalog entry subkeys
oReg.EnumKey HKLM,strKey & "\" & strProCatKey & "\Catalog_Entries",arKeys
'if sub-keys exist
If IsArray(arKeys) Then
'for each subkey
For Each oKey in arKeys
'can only take UBound if subkeys exist
'find number of keys in array & # digits
intNumKeys = UBound(arKeys) + 1
'determine # digits
intL = Len(CStr(intNumKeys))
'convert key name to integer
On Error Resume Next
intKN = CInt(oKey)
intErrNum = Err.Number : Err.Clear
On Error Goto 0
If intErrNum <> 0 Then intKN = -1 'key not in numeric format
'find PackedCatalogItem
intErrNum2 = oReg.GetBinaryValue (HKLM,strKey & "\" & strProCatKey &_
"\Catalog_Entries\" & oKey,"PackedCatalogItem",arTSP)
'if the PackedCatalogItem name exists And value set (exc for W2K!)
If intErrNum2 = 0 And IsArray(arTSP) Then
strDLL = "" 'clear strDLL
'reform strDLL from binary data array
For i = 0 To UBound(arTSP)
int1C = arTSP(i)
'end of target is single "0" byte
If int1C = 0 Then Exit For
'otherwise convert binary to ASCII and append to string
strDLL = strDLL & Chr(int1C)
Next 'binary data array element
'if key number numeric
If intKN <> -1 Then
'if file array populated
If intCnt > 0 Then
flagMatch = False
'for every arTSPFi member
For i = 0 To UBound(arTSPFi,2)
'if array file matches DLL, store array subscript
If arTSPFi(0,i) = strDLL Then
flagMatch = True : intSS = i : Exit For
End If
Next 'arTSPFi member
'if DLL is new
If Not flagMatch Then
'initialize output array for DLL
ReDim Preserve arTSPFi(3,intCnt)
arTSPFi(0,intCnt) = strDLL 'FN path\file name
arTSPFi(1,intCnt) = Right("0" & CStr(intKN),intL) 'OS output string
arTSPFi(2,intCnt) = intKN 'LA last added key number
arTSPFi(3,intCnt) = intKN 'UL upper limit key number
'increment output array for next pass
intCnt = intCnt + 1
Else 'flagMatch = True
'this key # consecutive to DLL UL
If intKN - arTSPFi(3,intSS) = 1 Then
'set DLL UL to this key #
arTSPFi(3,intSS) = intKN
Else 'this key # not consecutive to DLL UL
'if last added = upper limit, add comma and key # for new range
If arTSPFi(2,intSS) = arTSPFi(3,intSS) Then
arTSPFi(1,intSS) = arTSPFi(1,intSS) & ", " &_
Right("0" & CStr(intKN),intL)
arTSPFi(2,intSS) = intKN
arTSPFi(3,intSS) = intKN
'last added < upper limit, add hyphen, upper limit, comma and
'key # for new range
Else 'LA <> UL
arTSPFi(1,intSS) = arTSPFi(1,intSS) & " - " &_
Right("0" & CStr(arTSPFi(3,intSS)),intL) & ", " &_
Right("0" & CStr(intKN),intL)
arTSPFi(2,intSS) = intKN
arTSPFi(3,intSS) = intKN
End If 'LA = UL?
End If 'consecutive occurrence?
End If 'flagMatch?
Else 'intCnt = 0
'add first DLL to array
ReDim arTSPFi(3,intCnt)
arTSPFi(0,intCnt) = strDLL 'FN
arTSPFi(1,intCnt) = Right("0" & CStr(intKN),intL) 'OS
arTSPFi(2,intCnt) = intKN 'LA
arTSPFi(3,intCnt) = intKN 'UL
intCnt = intCnt + 1
End If 'intCnt > 0?
Else 'intKN not numeric
ReDim Preserve ATSPFi(1,intACnt)
arATSPFi(0,intACnt) = oKey
arATSPFi(1,intACnt) = strDLL
intACnt = intACnt + 1
End If 'intKN numeric?
End If 'PackedCatalogItem value exists?
Next 'subkey
'output results
'if Catalog_Entries sub-keys exist
If intNumKeys > 0 Then
'finalize output strings
For i = 0 To UBound(arTSPFi,2)
'last added < upper limit, add upper limit
If arTSPFi(2,i) < arTSPFi(3,i) Then
arTSPFi(1,i) = arTSPFi(1,i) & " - " & Right("0" & arTSPFi(3,i),intL)
End If 'LA = UL?
Case 0 'ClassicShell disables AD (exc in W98; in WMe, stops WP value
' from choosing WP but allows WP value
' to disable Background tab)
flagADClassicShell = True : flagADviaSS = False
flagADDisabled = True : strWarn = ""
If strOS = "W98" Or strOS = "NT4" Then
flagADClassicShell = False : flagADviaSS = True
flagADDisabled = False
End If
Case 1 'ForceActiveDesktopOn
flagFADO = True
If (strOS <> "W98" And strOS <> "NT4" And Not flagADClassicShell) Then
flagADEnabled = True 'ForceActiveDesktopOn overrules NoActiveDesktop
flagADviaSS = False
ElseIf strOS = "W98" Or strOS = "NT4" Then
flagFADO = False : flagSkip = True 'value not used in these O/S's
End If
Case 2 'NoActiveDesktop
flagNAD = True : strWarn = ""
If Not flagFADO Then 'if FADO not set
flagADDisabled = True : flagADviaSS = False
Else 'FADO enabled
arNames(2,1) = "[normally disables Active Desktop, but overruled " &_
"by " & Chr(34) & "ForceActiveDesktopOn" & Chr(34) & "]"
If Not flagADClassicShell Then flagADDisabled = False
End If
Case 3 'NoActiveDesktopChanges
flagNADC = True
Case 4
flagSkip = True 'value ignored in W2K & WXP
Case 9
'DisableWindowsUpdateAccess has no effect in W9x
If strOS = "W98" Or strOS = "WME" Or strOS = "NT4" Then flagSkip = True
End Select
If Not flagSkip Then 'output title lines
If strTitle <> "" Then
TitleLineWrite
Else
oFN.WriteBlankLines(1)
End If
'output name=value, description, GP policy location
oFN.WriteLine strWarn & Chr(34) & arNames(i,0) & Chr(34) &_
"=dword:00000001 " & vbCRLF & arNames(i,1) & strOut
If flagGP Then oFN.WriteLine arNames(i,2)
End If 'flagSkip?
Else 'value doesn't exist or doesn't set GP
If flagShowAll Then TitleLineWrite
End If 'value = 1?
Next 'array member
'DisallowCpl"
'look for omitted Control Panel applets
strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\DisallowCpl"
strSubTitle = "HKCU\" & strKey & "\"
If strOS = "W2K" Or strOSXP = "Windows XP Home" Then 'only works in these O/S's
'.CPL file names & applet titles can be used to hide Control Panel applets
'script will not not detect applet exclusion via title on foreign-language versions
'detection of English-language title on foreign-language W2K version
'would provide false positive, so recognition of titles abandoned -- any
'unrecognized value string is output as suspect
Dim arCplets : Set arCplets = CreateObject("Scripting.Dictionary") 'key, item
'W2K: appwiz.cpl omits both Add/Remove Programs and Folder Options,
'but title allows individual exclusion (which will *not* be detected here)
'WXPH: appwiz.cpl only omits Add and Remove Programs
If strOS = "W2K" Then
arCplets.Add "appwiz.cpl", Chr(34) & "Add/Remove Programs" & Chr(34) &_
", " & Chr(34) & "Folder Options" & Chr(34)
ElseIf strOS = "WXP" Then
arCplets.Add "appwiz.cpl", Chr(34) & "Add or Remove Programs" & Chr(34)
End If
arCplets.Add "desk.cpl", Chr(34) & "Display Properties" & Chr(34)
arCplets.Add "inetcpl.cpl", Chr(34) & "Internet Options" & Chr(34)
If strOS = "WXP" Then
arCplets.Add "firewall.cpl", Chr(34) & "Windows Firewall" & Chr(34)
arCplets.Add "wscui.cpl", Chr(34) & "Windows Security Center" & Chr(34)
End If
Dim arCpletsk : arCpletsk = arCplets.Keys
Dim arCpletsi : arCpletsi = arCplets.Items
'retrieve list of hidden cpl names
intErrNum2 = oReg.EnumValues (HKCU,strKey,arDisCplNames,arType)
'if names exist
If intErrNum2 = 0 And IsArray(arDisCplNames) Then
strSubSubTitle = "HIJACK WARNING! The following applets are not " &_
"displayed in Control Panel:" & vbCRLF
'for each name
For Each strDisCplName In arDisCplNames
'retrieve the value
intErrNum3 = oReg.GetStringValue(HKCU, strKey, strDisCplName, strDisCplValue)
'if value exists
If intErrNum3 =0 And strDisCplValue <> "" Then
strOut = "" : flagMatch = False
'look for matching applet file name
For j = 0 To UBound(arCpletsk)
'if match found, output Control Panel applet name and title
If LCase(Trim(strDisCplValue)) = LCase(arCpletsk(j)) Then
strOut = Space(2) & arCpletsk(j) & " (" & arCpletsi(j) & ")"
flagMatch = True : Exit For
End If
Next 'cpl applet
If Not flagMatch Then strOut = Space(2) & strDisCplValue &_
" (unrecognized file name)"
TitleLineWrite
On Error Resume Next
oFN.WriteLine strOut : intErrNum = Err.Number : Err.Clear
On Error Goto 0
If intErrNum <> 0 Then oFN.WriteLine " (unwritable string)"
End If 'value exists?
Next 'value name
If flagGP Then oFN.WriteLine vbCRLF & arNames(4,2)
strSubSubTitle = ""
Else 'names don't exist
If flagShowAll Then TitleLineWrite
End If 'names exist?
'empty the dictionary
arCplets.RemoveAll : Set arCplets=Nothing
End If 'W2K/WXPH?
'examine Policies at System key
strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\System"
strWarn = "HIJACK WARNING! "
strSubTitle = "HKCU\" & strKey & "\"
ReDim arNames(4,2)
arNames(0,0) = "DisableRegistryTools"
If strOS = "W98" Or strOS = "WME" Or strOS = "WXP" Then
arNames(0,1) = "[prohibits launch of REGEDIT.EXE]"
Else 'NT4 or W2K
arNames(0,1) = "[prohibits launch of REGEDIT.EXE and REGEDT32.EXE]"
End If
arNames(0,2) = "{User Configuration|Administrative Templates|System|" &_
vbCRLF & "Disable registry editing tools}"
If strOS = "WXP" Then arNames(0,2) = "{User Configuration|" &_
"Administrative Templates|System|Prevent access to" & vbCRLF &_
"registry editing tools}"
arNames(1,0) = "NoDispBackgroundPage"
arNames(1,1) = "[removes Display Properties, Background (tab)]"
If strOS = "WXP" Then arNames(1,1) = "[removes Display Properties, Desktop (tab)]"
arNames(1,2) = "{User Configuration|Administrative Templates|Control Panel" &_
"|Display|" & vbCRLF & "Hide Background tab}"
If strOS = "WXP" Then arNames(1,2) = "{User Configuration|" &_
"Administrative Templates|Control Panel|Display|" & vbCRLF &_
"Hide Desktop tab}"
arNames(2,0) = "NoDispCpl"
arNames(2,1) = "[disables Display in Control Panel]"
arNames(2,2) = "{User Configuration|Administrative Templates|Control Panel" &_
"|Display|" & vbCRLF & "Disable Display in Control Panel}"
If strOS = "WXP" Then arNames(2,2) = "{User Configuration|" &_
"Administrative Templates|Control Panel|Display|" & vbCRLF &_
"Remove Display in Control Panel}"
arNames(3,0) = "Wallpaper"
arNames(3,1) = "[disables Display Properties|Background (tab); " &_
"selects wallpaper if" & vbCRLF & "Active Desktop is enabled]"
If strOS = "WXP" Then
arNames(3,1) = "[disables the Display Properties|Desktop (tab) " &_
"(except the " & Chr(34) & "Customize" & vbCRLF & "Desktop..." &_
Chr(34) & " button); selects wallpaper if Active Desktop is enabled]"
If strOSXP = "Windows XP Professional SP2" Then _
arNames(3,1) = "[disables the Display Properties|Desktop (tab) " &_
"(except the " & Chr(34) & "Customize" & vbCRLF & "Desktop..." &_
Chr(34) & " button); selects wallpaper and enables Active Desktop]"
Else 'for any non-XP O/S
If flagNAD And Not flagFADO Then
arNames(3,1) = "[normally disables Display Properties|" &_
"Background (tab) and" & vbCRLF & "selects wallpaper if Active " &_
"Desktop is enabled, but overruled" & vbCRLF & "by " & Chr(34) &_
"NoActiveDesktop" & Chr(34) & "]"
ElseIf flagNADC Then
arNames(3,1) = "[normally disables Display Properties|" &_
"Background (tab), but" & vbCRLF & "overruled by " & Chr(34) &_
"NoActiveDesktopChanges" & Chr(34) & "; selects wallpaper if" &_
vbCRLF & "Active Desktop is enabled]"
End If 'flagNAD/flagFADO/flagNADC?
End If 'WXP?
arNames(3,2) = "{User Configuration|Administrative Templates|Desktop" &_
"|Active Desktop|" & vbCRLF & "Active Desktop Wallpaper|Wallpaper Name:}"
arNames(4,0) = "WallpaperStyle"
arNames(4,1) = "[disables " & Chr(34) & "Picture Display:" & Chr(34) &_
" control only in Display Properties|" & vbCRLF & "Background (tab)]"
If strOS = "WXP" Then arNames(4,1) = "[selects " & Chr(34) & "Position:" &_
Chr(34) & " in Display Properties|Desktop (tab)" & vbCRLF &_
"if Active Desktop is enabled]"
arNames(4,2) = "{User Configuration|Administrative Templates|Desktop" &_
"|Active Desktop|" & vbCRLF & "Active Desktop Wallpaper|Wallpaper Style:}"
For i = 0 To UBound(arNames,1)
If i < 3 Then intErrNum = oReg.GetDWORDValue (HKCU,strKey,arNames(i,0),intValue)
'Wallpaper & WallpaperStyle values are strings
If i = 3 Or i = 4 Then intErrNum = oReg.GetStringValue (HKCU,strKey,arNames(i,0),strValue)
If intErrNum = 0 Then 'if value exists
flagSkip = True 'assume value not output
Select Case i
Case 0 'DisableRegistryTools
If (intValue And 1) = 1 Then flagSkip = False
strOut = "HIJACK WARNING! " & Chr(34) & arNames(i,0) & Chr(34) &_
"=dword:00000001 " & vbCRLF & arNames(i,1)
Case 1 'NoDispBackgroundPage
If (intValue And 1) = 1 Then flagSkip = False
strOut = "HIJACK WARNING! " & Chr(34) & arNames(i,0) & Chr(34) &_
"=dword:00000001 " & vbCRLF & arNames(i,1)
Case 2 'NoDispCpl
If (intValue And 1) = 1 Then flagSkip = False
strOut = "HIJACK WARNING! " & Chr(34) & arNames(i,0) & Chr(34) &_
"=dword:00000001 " & vbCRLF & arNames(i,1)
Case 3 'Wallpaper
If strOS = "W98" Or strOS = "NT4" Then
flagSkip = True 'value not used under W98 & NT4
Else 'any other O/S
flagSkip = False
If Not flagADDisabled Then
flagGPWPEntry = True 'value may be looked at unless GP already disabled
If strOSXP = "Windows XP Professional SP2" Then
'under WXP Pro SP2, value enables AD unless AD already disabled
flagADEnabled = True : flagADviaSS = False
End If 'strOSXP?
End If 'flagADDisabled?
strOut = "HIJACK WARNING! " & Chr(34) & arNames(i,0) & Chr(34) &_
" = " & Chr(34) & strValue & Chr(34) & vbCRLF & arNames(i,1)
End If 'strOS?
Case 4 'WallpaperStyle
If strOS = "W98" Or strOS = "NT4" Then
flagSkip = True
Else
If strValue <> "" Then flagSkip = False
intValue = CInt(strValue) 'convert to integer
'WallpaperStyle (0 centered, 1 tiled, 2 stretched)
If intValue = 0 Then
strLine1 = "Center"
ElseIf (intValue And 1) = 1 Then
strLine1 = "Tile"
ElseIf (intValue And 2) = 2 Then
strLine1 = "Stretch"
End If
strOut = "HIJACK WARNING! " & Chr(34) & arNames(i,0) & Chr(34) &_
" = " & Chr(34) & CStr(intValue) & Chr(34) &_
" [" & strLine1 & "]" & vbCRLF & arNames(i,1)
End If 'strOS?
End Select
If Not flagSkip Then
If strTitle <> "" Then
TitleLineWrite
Else
oFN.WriteBlankLines(1)
End If
On Error Resume Next
oFN.WriteLine strOut
intErrNum1 = Err.Number : Err.Clear
On Error Goto 0
If intErrNum1 <> 0 Then _
oFN.WriteLine Chr(34) & arNames(i,0) & Chr(34) &_
" = (value not set)" & vbCRLF & arNames(i,1)
If flagGP Then oFN.WriteLine arNames(i,2)
End If 'flagSkip?
Else 'value not found
If flagShowAll Then TitleLineWrite
End If 'value exists?
Next 'array value
'examine Policies at ActiveDesktop key
strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\ActiveDesktop"
strSubTitle = "HKCU\" & strKey & "\"
ReDim arNames(3,2)
arNames(0,0) = "NoChangingWallPaper"
arNames(0,1) = "[disables options on Display Properties|Background (tab)]"
If flagNADC Then arNames(0,1) = "[normally disables options on Display " &_
"Properties|Background (tab)," & vbCRLF & "but overruled by " &_
Chr(34) & "NoActiveDesktopChanges" & Chr(34) & "]"
If strOS = "WXP" Then arNames(0,1) = _
"[disables " & Chr(34) & "Background:" & Chr(34) & " list on Display " &_
"Properties|Desktop (tab)]"
arNames(0,2) = "{User Configuration|Administrative Templates|Control " &_
"Panel|Display|" & vbCRLF & "Disable changing wallpaper}"
If strOS = "WXP" Then arNames(0,2) = "{User Configuration|Administrative " &_
"Templates|Control Panel|Display|" & vbCRLF & "Prevent changing wallpaper}"
arNames(1,0) = "NoClosingComponents"
arNames(1,1) = "[disables close button for web content on desktop; " &_
"removes open/close" & vbCRLF & "check box from web content on " &_
"Display Properties|Web (tab)]"
If strOS = "WXP" Then arNames(1,1) = _
"[" & Chr(34) & "Web pages:" & Chr(34) & " list items on Display " &_
"Properties|Desktop (tab)|" & vbCRLF & "Customize Desktop... (button)|" &_
"Desktop Items (window)|Web (tab)" & vbCRLF & "have no check box]"
arNames(1,2) = "{User Configuration|Administrative Templates|Desktop" &_
"|Active Desktop|" & vbCRLF & "Prohibit closing items}"
arNames(2,0) = "NoDeletingComponents"
arNames(2,1) = "[disables " & Chr(34) & "Delete" & Chr(34) & " button " &_
"on Display Properties|Web (tab)]"
If strOS = "WXP" Then arNames(2,1) = _
"[disables " & Chr(34) & "Delete" & Chr(34) & " button on Display " &_
"Properties|Desktop (tab)|" & vbCRLF & "Customize Desktop... (button)|" &_
"Desktop Items (window)|Web (tab)]"
arNames(2,2) = "{User Configuration|Administrative Templates|Desktop" &_
"|Active Desktop|" & vbCRLF & "Prohibit deleting items}"
arNames(3,0) = "NoEditingComponents"
arNames(3,1) = "[disables " & Chr(34) & "Properties" & Chr(34) & " button " &_
"on Display Properties|Web (tab)]"
If strOS = "WXP" Then arNames(3,1) = _
"[disables " & Chr(34) & "Properties" & Chr(34) & " button on Display " &_
"Properties|Desktop (tab)|" & vbCRLF & "Customize Desktop... (button)|" &_
"Desktop Items (window)|Web (tab)]"
arNames(3,2) = "{User Configuration|Administrative Templates|Desktop" &_
"|Active Desktop|" & vbCRLF & "Prohibit editing items}"
For i = 0 To UBound(arNames,1)
'get the value
intErrNum = oReg.GetDWORDValue (HKCU,strKey,arNames(i,0),intValue)
'if value exists and GP set
If intErrNum = 0 And (intValue And 1) = 1 Then
If strTitle <> "" Then
TitleLineWrite
Else
oFN.WriteBlankLines(1)
End If
oFN.WriteLine "HIJACK WARNING! " & Chr(34) & arNames(i,0) & Chr(34) &_
"=dword:00000001 " & vbCRLF & arNames(i,1)
If flagGP Then oFN.WriteLine arNames(i,2)
Else 'value doesn't exist or doesn't set GP
If flagShowAll Then TitleLineWrite
End If 'value = 1?
Next 'array value
'examine Internet Explorer Policies
strKey = "Software\Policies\Microsoft\Internet Explorer\Control Panel"
strSubTitle = "HKCU\" & strKey & "\"
strWarn = "HIJACK WARNING! "
ReDim arNames(8,2)
arNames(0,0) = "GeneralTab"
arNames(0,1) = "[removes the Internet Options|General (tab)]"
arNames(0,2) = "{User Configuration|Administrative Templates|" &_
"Windows Components|" & vbCRLF & "Internet Explorer|Internet " &_
"Control Panel|Disable the General page}"
arNames(1,0) = "HomePage"
arNames(1,1) = "[disables the Home page field in Internet Options|" &_
"General (tab)]"
arNames(1,2) = "{User Configuration|Administrative Templates|" &_
"Windows Components|" & vbCRLF & "Internet Explorer|Disable " &_
"changing home page settings}"
arNames(2,0) = "ConnectionsTab"
arNames(2,1) = "[removes the Internet Options|Connections (tab)]"
arNames(2,2) = "{User Configuration|Administrative Templates|" &_
"Windows Components|" & vbCRLF & "Internet Explorer|Internet " &_
"Control Panel|Disable the Connections page}"
arNames(3,0) = "Connection Settings"
arNames(3,1) = "[disables all controls except the the " & Chr(34) &_
"Setup..." & Chr(34) & " button in" & vbCRLF & "Internet Options|" &_
"Connections (tab)]"
arNames(3,2) = "{User Configuration|Administrative Templates|" &_
"Windows Components|" & vbCRLF & "Internet Explorer|Disable " &_
"changing connection settings}"
arNames(4,0) = "Proxy"
arNames(4,1) = "[disables controls in Internet Options|Connections (tab)|" &_
vbCRLF & "LAN Settings...|Proxy server]"
arNames(4,2) = "{User Configuration|Administrative Templates|" &_
"Windows Components|" & vbCRLF & "Internet Explorer|Disable " &_
"changing proxy settings}"
arNames(5,0) = "SecurityTab"
arNames(5,1) = "[removes the Internet Options|Security (tab)]"
arNames(5,2) = "{User Configuration|Administrative Templates|" &_
"Windows Components|" & vbCRLF & "Internet Explorer|Internet " &_
"Control Panel|Disable the Security page}"
arNames(6,0) = "ResetWebSettings"
arNames(6,1) = "[disables the " & Chr(34) & "Reset Web Settings..." &_
Chr(34) & " button in Internet Options|" & vbCRLF & "Programs (tab)]"
arNames(6,2) = "{User Configuration|Administrative Templates|" &_
"Windows Components|" & vbCRLF & "Internet Explorer|Disable " &_
"the Reset Web Settings feature}"
'THIS ROW CHANGES THE POLICIES KEY
arNames(7,0) = "NoBrowserOptions"
arNames(7,1) = "[disables Tools|Internet Options... in Internet Explorer]"
arNames(7,2) = "{User Configuration|Administrative Templates|" &_
"Windows Components|" & vbCRLF & "Internet Explorer|Browser Menus|" &_
"Tools menu: Disable Internet" & vbCRLF & "Options... menu option}"
arNames(8,0) = "NoExtensionManagement"
arNames(8,1) = "[disables Settings radio buttons in Tools|Manage " &_
"Add-ons... in Internet Explorer]"
arNames(8,2) = "{User Configuration|Administrative Templates|" &_
"Windows Components|" & vbCRLF & "Internet Explorer|Do not allow " &_
"users to enable or disable add-ons}"
'for every array member
For i = 0 To UBound(arNames,1)
flagSkip = False
'set up different key for NoBrowserOptions & NoExtensionManagement
If i = 7 Then
strKey = "Software\Policies\Microsoft\Internet Explorer\Restrictions"
strSubTitle = "HKCU\" & strKey & "\"
End If
If i = 8 And strOSLong <> "Windows XP SP2" Then flagSkip = True
If Not flagSkip Then
'try to retrieve the value
intErrNum = oReg.GetDWORDValue (HKCU,strKey,arNames(i,0),intValue)
'if value exists And sets GP
If intErrNum = 0 And (intValue And 1) = 1 Then
'output titles
If strSubTitle <> "" Then
TitleLineWrite
Else
oFN.WriteBlankLines(1)
End If
'output name=value, description, GP location
oFN.WriteLine strWarn & Chr(34) & arNames(i,0) & Chr(34) &_
"=dword:00000001 " & vbCRLF & arNames(i,1)
If flagGP Then oFN.WriteLine arNames(i,2)
Else 'value doesn't exist or doesn't set GP
If flagShowAll Then TitleLineWrite
End If 'value = 1?
End If 'flagSkip?
Next 'array member
'has no effect in WMe
If strOS = "WXP" Then
'examine Policies at HKLM... Windows NT key
strKey = "Software\Policies\Microsoft\Windows NT\SystemRestore"
strSubTitle = "HKLM\" & strKey & "\"
ReDim arNames(1,2)
arNames(0,0) = "DisableSR"
arNames(0,1) = "[removes Control Panel|System|System Restore (tab) and disables applet]"
arNames(0,2) = "{Computer Configuration|Administrative Templates|System|" &_
"System Restore|" & vbCRLF & "Turn off System Restore}"
arNames(1,0) = "DisableConfig"
arNames(1,1) = "[disables options on Control Panel|System|System Restore (tab)]"
arNames(1,2) = "{Computer Configuration|Administrative Templates|System|" &_
"System Restore|" & vbCRLF & "Turn off Configuration}"
'for every array member
For i = 0 To UBound(arNames,1)
'try to retrieve the value
intErrNum = oReg.GetDWORDValue (HKLM,strKey,arNames(i,0),intValue)
'if value exists And sets GP
If intErrNum = 0 And (intValue And 1) Then
'output titles
If strSubTitle <> "" Then
TitleLineWrite
Else
oFN.WriteBlankLines(1)
End If
'output name=value, description, GP location
oFN.WriteLine strWarn & Chr(34) & arNames(i,0) & Chr(34) &_
"=dword:00000001 " & vbCRLF & arNames(i,1)
If flagGP Then oFN.WriteLine arNames(i,2)
Else 'value doesn't exist or doesn't set GP
If flagShowAll Then TitleLineWrite
End If 'value = 1?
Next 'array member
End If 'WXP?
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
'recover array memory
ReDim arNames(0)
End If 'flagTest?
'XV. Active Desktop, wallpaper & screen saver
If Not flagTest Then 'skip if testing
Dim arBValue()
Dim flagIEWPSet : flagIEWPSet = False
'title line string
strTitle = "Active Desktop and Wallpaper:"
'Active Desktop
If flagADviaSS Then
'Active Desktop flag key
strKey = "Software\Microsoft\Windows\CurrentVersion\Explorer"
'get the ShellState binary array
intErrNum = oReg.GetBinaryValue (HKCU,strKey,"ShellState",arBValue)
'if array returned
If intErrNum = 0 And IsArray(arBValue) Then
'if array contains Active Desktop flag
If UBound(arBValue) >= 4 Then
'if 0-based 4th array element contains 64 (AD flag set)
If (arBValue(4) And 64) = 64 Then
flagADEnabled = True
ReDim arBValue(0) 'recover array memory
TitleLineWrite
oFN.WriteLine vbCRLF & "Active Desktop is enabled at this entry:" &_
vbCRLF & "HKCU\" & strKey & "\ShellState"
Else
TitleLineWrite : flagADDisabled = True
oFN.WriteLine vbCRLF & "Active Desktop is disabled at this entry:" &_
vbCRLF & "HKCU\" & strKey & "\ShellState"
End If 'AD enabled?
End If 'UBound>=4?
Else 'binary value not found
If flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & "Active Desktop is not enabled."
End If
End If 'binary value exists?
ElseIf flagADEnabled Then
TitleLineWrite
oFN.WriteLine vbCRLF & "Active Desktop enabled via " & strPolName & "Policy."
ElseIf flagADDisabled Then
TitleLineWrite
oFN.WriteLine vbCRLF & "Active Desktop disabled via " & strPolName & "Policy."
End If 'flagADviaSS?
'Wallpaper
'if AD enabled And WP Not set in GP
If flagADEnabled And Not flagGPWPEntry Then
'check for AD wallpaper
strKey = "Software\Microsoft\Internet Explorer\Desktop\General"
strSubTitle = "HKCU\" & strKey & "\"
intErrNum = oReg.GetStringValue (HKCU,strKey,"Wallpaper",strValue)
'if AD wallpaper value set
If intErrNum = 0 And strValue <> "" Then 'exc for W2K!
'toggle flag
flagIEWPSet = True
'write value
On Error Resume Next
TitleLineWrite
oFN.WriteLine Chr(34) & "Wallpaper" & Chr(34) & " = " &_
Chr(34) & strValue & Chr(34)
intErrNum1 = Err.Number : Err.Clear
On Error Goto 0
If intErrNum1 <> 0 Then oFN.WriteLine Chr(34) & "Wallpaper" &_
Chr(34) & " = (value not set)"
End If 'AD wallpaper value set?
ElseIf flagADEnabled And flagGPWPEntry Then
oFN.WriteLine vbCRLF & "Wallpaper selected via " & strPolName & "Policy."
End If 'flagADEnabled And Not flagGPWPEntry?
'if WP not set via IE, look for it at HKCU\Control Panel\Desktop
If Not flagGPWPEntry And Not flagIEWPSet Then
'retrieve Wallpaper value
strKey = "Control Panel\Desktop"
strSubTitle = "HKCU\" & strKey & "\"
intErrNum = oReg.GetStringValue (HKCU,strKey,"Wallpaper",strValue)
'if value set (exc for W2K!)
If intErrNum = 0 And strValue <> "" Then 'exc for W2K!
TitleLineWrite
'output wallpaper value
On Error Resume Next
oFN.WriteLine Chr(34) & "Wallpaper" & Chr(34) & " = " &_
Chr(34) & strValue & Chr(34)
intErrNum2 = Err.Number : Err.Clear
On Error Goto 0
If intErrNum2 <> 0 Then oFN.WriteLine Chr(34) & "Wallpaper" &_
Chr(34) & " = (value not set)"
Else 'WP value not present
If flagShowAll Then
TitleLineWrite
oFN.WriteLine Chr(34) & "Wallpaper" & Chr(34) & " = (value not set)"
End If
End If 'wallpaper value set?
End If 'flagADDisabled Or W2K?
'web content
If flagADEnabled Then
'look for web content
strKey = "Software\Microsoft\Internet Explorer\Desktop\Components"
intErrNum = oReg.EnumKey(HKCU,strKey,arKeys)
'if sub-keys exist
If IsArray(arKeys) Then
strSubTitle = "Active Desktop web content:"
'for each subkey
For Each oKey in arKeys
strSubSubTitle = "HKCU\" & strKey & "\" & oKey & "\"
'retrieve DWORD containing web content activation flag
intErrNum1 = oReg.GetDWORDValue (HKCU,strKey & "\" & oKey,"Flags",intValue)
'if DWORD value set
If intErrNum = 0 And intValue <> 0 Then
'if DWORD contains 8192 (web content activation flag set)
If (intValue And 8192) = 8192 Then
'get web content descriptive values
oReg.GetStringValue HKCU,strKey & "\" & oKey,"FriendlyName",strValue1
oReg.GetStringValue HKCU,strKey & "\" & oKey,"Source",strValue2
oReg.GetStringValue HKCU,strKey & "\" & oKey,"SubscribedURL",strValue3
TitleLineWrite
'write web content descriptive values
On Error Resume Next
oFN.WriteLine Chr(34) & "FriendlyName" & Chr(34) & " = " &_
Chr(34) & strValue1 & Chr(34)
intErrNum2 = Err.Number : Err.Clear
If intErrNum2 <> 0 Then oFN.WriteLine Chr(34) & "FriendlyName" &_
Chr(34) & " = (value not set)"
oFN.WriteLine Chr(34) & "Source" & Chr(34) & " = " &_
Chr(34) & strValue2 & Chr(34)
intErrNum2 = Err.Number : Err.Clear
If intErrNum2 <> 0 Then oFN.WriteLine Chr(34) & "Source" &_
Chr(34) & " = (value not set)"
oFN.WriteLine Chr(34) & "SubscribedURL" & Chr(34) & " = " &_
Chr(34) & strValue3 & Chr(34)
intErrNum2 = Err.Number : Err.Clear
If intErrNum2 <> 0 Then oFN.WriteLine Chr(34) & "SubscribedURL" &_
Chr(34) & " = (value not set)"
On Error Goto 0
End If 'web content active?
End If 'web content DWORD value set?
Next 'web content subkey
End If 'web content subkeys exist
End If 'flagADEnabled?
strSubTitle = ""
'Screen Saver
If strOS <> "W98" And strOS <> "WME" Then
Dim strLFN : strLFN = "" 'screen saver LFN
Dim strExt : strExt = "" 'wallpaper file extension
strWarn = ""
strTitle = "Enabled Screen Saver:"
strKey = "Control Panel\Desktop"
strSubTitle = "HKCU\" & strKey & "\"
'get the screen saver name
intErrNum = oReg.GetStringValue (HKCU,strKey,"Scrnsave.exe",strValue)
'if Scrnsave.exe value exists And value set (exc for W2K!)
' And value <> "(NONE)" (NT4 default)
If intErrNum = 0 And strValue <> "" And LCase(strValue) <> "(none)" Then
'get screen saver LFN if file exists
If Fso.FileExists(strValue) Then
'create (but don't save) shortcut
Dim oSC : Set oSC = Wshso.CreateShortcut("getLFN.lnk")
'set & retrieve target path
oSC.TargetPath = strValue
strLFN = Fso.GetFile(oSC.TargetPath).Name
Set oSC=Nothing
'set up LFN string if SFN <> LFN
If LCase(strLFN) = LCase(Fso.GetFileName(strValue)) Then
strLFN = ""
Else
strLFN = " (" & strLFN & ")"
End If
End If 'screen saver file exists?
TitleLineWrite
On Error Resume Next
oFN.WriteLine Chr(34) & "SCRNSAVE.EXE" & Chr(34) & " = " &_
Chr(34) & strValue & Chr(34) & strLFN & CoName(IDExe(strValue))
intErrNum = Err.Number : Err.Clear
On Error Goto 0
If intErrNum <> 0 Then oFN.WriteLine Chr(34) & "SCRNSAVE.EXE" &_
Chr(34) & " = (value not set)"
Else 'Scrnsave.exe value doesn't exist
'if ShowAll, output title line
If flagShowAll Then
TitleLineWrite
oFN.WriteLine Chr(34) & "SCRNSAVE.EXE" & Chr(34) & " = (value not set)"
End If 'flagShowAll
End If 'Scrnsave.exe value exists?
End If 'strOS <> W98/WME?
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
End If 'flagTest?
'XVI. For W98/WME, check inside WIN.INI (load=, run=), SYSTEM.INI (shell=) &
' for W98 only, list contents of non-empty WINSTART.BAT
If Not flagTest Then 'skip if testing
If strOS = "W98" Or strOS = "WME" Then
strTitle = "WIN.INI & SYSTEM.INI launch points:"
Dim oSCF 'System Configuration File
'true if in INI-file section containing targeted lines
Dim flagSection : flagSection = False
strSubTitle = "WIN.INI" & vbCRLF & "[windows]"
'open WIN.INI
Set oSCF = Fso.OpenTextFile (strFPWF & "\WIN.INI",1)
'for each line of WIN.INI
Do While Not oSCF.AtEndOfStream
'read a line
strLine = oSCF.ReadLine
'if not a blank/comment line And inside [windows] section
If Trim(strLine) <> "" And Left(LTrim(strLine),1) <> ";" Then
If flagSection Then
'if line is beginning of another section
If Left(LTrim(strLine),1) = "[" Then
'toggle flag to false and exit Do
flagSection = False : Exit Do
End If 'next section?
'input line, verb, expected contents, disk
IniInfParse strLine, "load", "", ""
IniInfParse strLine, "run", "", ""
End If 'flagSection?
'if first 9 chars of line = [windows], then in the right section
'so toggle flagSection to True
If LCase(Left(LTrim(strLine),9)) = "[windows]" Then flagSection = True
End If 'blank/comment line?
Loop 'next line of WIN.INI
oSCF.Close 'close WIN.INI
flagSection = False
strSubTitle = "SYSTEM.INI" & vbCRLF & "[boot]"
'open SYSTEM.INI
Set oSCF = Fso.OpenTextFile (strFPWF & "\SYSTEM.INI",1)
'for each line of SYSTEM.INI
Do While Not oSCF.AtEndOfStream
strLine = oSCF.ReadLine
'if not a blank/comment line And inside [windows] section
If Trim(strLine) <> "" And Left(LTrim(strLine),1) <> ";" Then
'if inside [boot] section
If flagSection Then
If Left(LTrim(strLine),1) = "[" Then
'toggle flagSection and exit
flagSection = False : Exit Do
End If 'shell line?
IniInfParse strLine, "shell", "explorer.exe", ""
IniInfParse strLine, "scrnsave.exe", "anything", ""
End If 'inside boot section?
'if first 6 chars of line = [boot], then in the right section
'so toggle flagSection to True
If LCase(Left(LTrim(strLine),6)) = "[boot]" Then flagSection = True
End If 'blank/comment line?
Loop
oSCF.Close
strSubTitle = ""
'for W98 only
If strOS = "W98" Then
strTitle = "WINSTART.BAT contents:"
'open WINSTART.BAT if it exists
If Fso.FileExists(strFPWF & "\WINSTART.BAT") Then
Set oSCF = Fso.OpenTextFile (strFPWF & "\WINSTART.BAT",1)
'for each line of WINSTART.BAT
Do While Not oSCF.AtEndOfStream
strLine = oSCF.ReadLine
If strLine <> "" Then 'examine line if it's not a CR
If Len(strLine) >= 3 Then 'test against REM if long enough
'if not REM, then output
If LCase(Left(LTrim(strLine),3)) <> "rem" Then
If strTitle <> "" Then
TitleLineWrite : oFN.WriteBlankLines(1)
End If
oFN.WriteLine strLine
End If
Else 'len 1-2
TitleLineWrite : oFN.WriteLine strLine
End If 'len < 3?
End If 'carriage return?
Loop 'WINSTART.BAT lines
oSCF.Close : Set oSCF=Nothing
Else 'WINSTART.BAT doesn't exist
'if ShowAll, write title lines
If flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & "(file not found)"
End If
End If 'WINSTART.BAT exists?
End If 'W98?
End If 'strOS = W98/WME
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
End If 'flagTest?
'XVII. AUTORUN.INF in root directory of local fixed disks for which
' autorun is enabled
If Not flagTest Then 'skip if testing
'WME & WXP SP2 do not launch AUTORUN.INF on local fixed disks
If strOS <> "WME" And strOSLong <> "Windows XP SP2" Then
'fixed disk, DWORD value, binary value array, AutoRun.Inf file,
'integer work variable
Dim oDisk, hVal, arBVal, oARI
strTitle = "Autostart via AUTORUN.INF on local fixed drives:"
'array of fixed disks
Public arFixedDisks()
'Disk Letter dictionary (needed to calculate power of 2)
'dictDL.Item(6) returns "G:"
Public dictDL : Set dictDL = CreateObject("Scripting.Dictionary")
dictDL.Add 0, "A:" : dictDL.Add 1, "B:" : dictDL.Add 2, "C:"
dictDL.Add 3, "D:" : dictDL.Add 4, "E:" : dictDL.Add 5, "F:"
dictDL.Add 6, "G:" : dictDL.Add 7, "H:" : dictDL.Add 8, "I:"
dictDL.Add 9, "J:" : dictDL.Add 10, "K:" : dictDL.Add 11, "L:"
dictDL.Add 12, "M:" : dictDL.Add 13, "N:" : dictDL.Add 14, "O:"
dictDL.Add 15, "P:" : dictDL.Add 16, "Q:" : dictDL.Add 17, "R:"
dictDL.Add 18, "S:" : dictDL.Add 19, "T:" : dictDL.Add 20, "U:"
dictDL.Add 21, "V:" : dictDL.Add 22, "W:" : dictDL.Add 23, "X:"
dictDL.Add 24, "Y:" : dictDL.Add 25, "Z:"
'HKLM NoDriveTypeAutoRun Fixed Disks Enabled
Public flagHKLM_NDTAR_FDE : flagHKLM_NDTAR_FDE = True
'HKCU NoDriveTypeAutoRun Fixed Disks Enabled
Public flagHKCU_NDTAR_FDE : flagHKCU_NDTAR_FDE = True
'HKLM NoDriveTypeAutoRun value exists
Public flagHKLM_NDTAR : flagHKLM_NDTAR = False
'HKCU NoDriveTypeAutoRun value exists (unused, passed for consistency)
Public flagHKCU_NDTAR : flagHKCU_NDTAR = False
'HKLM NoDriveAutoRun value exists
Public flagHKLM_NDAR : flagHKLM_NDAR = False
'HKCU NoDriveAutoRun value exists (unused, passed for consistency)
Public flagHKCU_NDAR : flagHKCU_NDAR = False
strKey = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer"
NDTAR HKLM, flagHKLM_NDTAR, flagHKLM_NDTAR_FDE
If Not flagHKLM_NDTAR Then NDTAR HKCU, flagHKCU_NDTAR, flagHKCU_NDTAR_FDE
'if NoDriveTypeAutoRun permits autorun on fixed disks, look at
'individual disks
If flagHKLM_NDTAR_FDE And flagHKCU_NDTAR_FDE Then
'enumerate fixed disks
Set colDisks = GetObject("winmgmts:\root\cimv2")._
ExecQuery("SELECT * FROM Win32_LogicalDisk WHERE DriveType = 3")
j = 0
'fmt of DeviceID & Name is "A:"
For Each oDisk in colDisks
'for every dict entry
For i = 0 To 25
'find dictionary element number for drive letter
If dictDL.Item(i) = oDisk.DeviceID Then
'store disk letter, power of two for that letter,
'set autorun flag to True, increment counter
ReDim Preserve arFixedDisks(2,j)
arFixedDisks(0,j) = oDisk.DeviceID
arFixedDisks(1,j) = 2^i
arFixedDisks(2,j) = True
j = j + 1
End If 'dict drive letter located?
Next 'dict entry
Next 'disk in colDisks
NDAR HKLM, flagHKLM_NDAR
If Not flagHKLM_NDAR Then NDAR HKCU, flagHKCU_NDAR
'for every fixed disk
For i = 0 To UBound(arFixedDisks,2)
strSubTitle = arFixedDisks(0,i) & "\"
'if autorun enabled
If arFixedDisks(2,i) Then
'look for AUTORUN.INF in the root
If Fso.FileExists(arFixedDisks(0,i) & "\autorun.inf") Then
'open AUTORUN.INF if found
Set oARI = Fso.OpenTextFile (arFixedDisks(0,i) & "\autorun.inf",1)
'for each line of AUTORUN.INF
Do While Not oARI.AtEndOfStream
'read a line
strLine = oARI.ReadLine
'look for "open" or "shellexecute" statements
IniInfParse strLine, "open", "", arFixedDisks(0,i)
IniInfParse strLine, "shellexecute", "", arFixedDisks(0,i)
Loop 'next AUTORUN.INF line
oARI.Close : Set oARI=Nothing 'close AUTORUN.INF
'if no verbs found And ShowAll
If strSubTitle <> "" And flagShowAll Then
TitleLineWrite
oFN.WriteLine "AUTORUN.INF -> (" & Chr(34) & "open" & Chr(34) &_
" & " & Chr(34) & "shellexecute" & Chr(34) & " lines not found)"
End If 'ShowAll?
Else 'AUTORUN.INF not found in root
'if ShowAll
If flagShowAll Then
TitleLineWrite
'output file not found message
oFN.WriteLine "AUTORUN.INF -> (file not found)"
End If 'ShowAll?
End If 'AUTORUN.INF exists in root?
End If 'autorun enabled on drive?
Next 'fixed disk
End If 'NoDriveTypeAutoRun enables autorun on fixed disks?
dictDL.RemoveAll : Set dictDL=Nothing
End If 'strOS<>WME/WXP SP2?
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
End If 'flagTest?
'XVIII. Check for DESKTOP.INI in local hard disk directories
If Not flagTest Then 'skip if testing
'skip unless -supp or -all command line parameters used
If flagShowAll Or flagSupp Then
Dim datDTIStart : datDTIStart = Now
Public strDTITime
'array of allowed CLSID DLLs
Dim arOKDLLs : arOKDLLs = Array("shdocvw.dll", "occache.dll", _
"mstask.dll", "cdfview.dll", "shell32.dll", "fontext.dll", _
"mscoree.dll")
strTitle = "DESKTOP.INI DLL launch in local fixed drive directories:"
'enumerate fixed disks
Set colDisks = GetObject("winmgmts:\root\cimv2")._
ExecQuery("SELECT * FROM Win32_LogicalDisk WHERE DriveType = 3")
For Each oDisk in colDisks
'initialize DeskTop.Ini output & error arrays & counters
ReDim arSDDTI(0) : ctrArDTI = 0
ReDim arSDErr(0) : ctrArErr = 0
'check for unreadable partition
On Error Resume Next
'root format: C:\
Set oRoot = Fso.GetDrive(oDisk.DeviceID).RootFolder
intErrNum = Err.Number : Err.Clear
On Error Goto 0
If intErrNum = 0 Then 'if partition readable
'find directories with System attribute containing DESKTOP.INI
'with .ShellClassInfo section and CLSID statement
'fill arSDDTI array with output & arSDErr with (permission) errors
DirSysAtt oRoot
'output DLL launch points if found
If ctrArDTI > 0 Then
TitleLineWrite
'output array contents
For i = 0 To UBound(arSDDTI) : oFN.WriteLine arSDDTI(i) : Next
ElseIf flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & oRoot.Drive & " (no DLL launch points found)"
End If
'output errors if ShowAll
If ctrArErr > 0 And flagShowAll Then
strSubTitle = "Permission Errors on " & oRoot.Drive : TitleLineWrite : strOut = ""
For i = 0 To UBound(arSDErr)
'limit line length to 100
If strOut <> "" Then
If Len(strOut & arSDErr(i)) >= 100 Then
oFN.WriteLine strOut : strOut = arSDErr(i)
Else
strOut = strOut & ", " & arSDErr(i)
End If 'this error & prev errors>100?
Else 'strOut empty
If Len(arSDErr(i)) >= 100 Then
oFN.WriteLine arSDErr(i)
Else
strOut = arSDErr(i)
End If 'this error>100?
End If 'strOut empty?
Next 'arSDErr member
'write out final error string
If strOut <> "" Then oFN.WriteLine strOut : strOut = ""
End If
Set oRoot=Nothing
Else 'partition not readable (may be Linux)
TitleLineWrite
oFN.WriteLine vbCRLF & "WARNING! " & oDisk.DeviceID & " is an unreadable partition!"
End If 'partition readable?
Next 'disk in colDisks
'determine -supp seconds used
strDTITime = DateDiff("s",datDTIStart,Now) & " seconds"
Set colDisks=Nothing
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
'recover array memory
ReDim arSDDTI(0) : ReDim arSDErr(0)
End If 'flagShowAll Or flagSupp?
End If 'flagTest?
'XIX. Enumerate contents of startup directories
If Not flagTest Then 'skip if testing
'All Users StartUp Folder title string (empty by default)
Dim flagAUSUF : flagAUSUF = False
Dim flagFE : flagFE = True 'folder exists flag
'in W98/WME, see if local-language-specific All Users startup folder location
'appears in registry and form title string if it does
If strOS = "W98" Or strOS = "WME" Then
'look for Common Startup value
strKey = "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
oReg.GetStringValue HKLM,strKey,"Common Startup",strValue
'if Common Startup name exists and value not empty, toggle flag
If Not IsNull(strValue) And strValue <> "" Then flagAUSUF = True
End If
'startup folder short names
If strOS = "W98" Or strOS = "WME" Then
arSUFN = Array("Startup")
Else
arSUFN = Array("Startup","AllUsersStartup")
End If
'form output file section title string
strLine = "Startup items in "
'in W98/WME, omit username & "All Users" folder if absent from registry
If strOS = "W98" Or strOS = "WME" Then
strLine = strLine & Chr(34) & "Startup" & Chr(34)
If flagAUSUF Then
strLine = strLine & " & " & Chr(34) & "All Users...Startup" &_
Chr(34) & " folders:"
Else
strLine = strLine & " folder:"
End If
Else 'all other O/S's
strLine = strLine & Chr(34) & Wshso.ExpandEnvironmentStrings("%USERNAME%") &_
Chr(34) & " & " & Chr(34) & "All Users" & Chr(34) & " startup folders:"
End If
strTitle = strLine
'for each startup folder name
For i = 0 To 1 '0 = user folder, 1 = All Users folder
'get the startup folder
'in W98/WME, set flagFE to False if "All Users" folder doesn't exist
If i = 1 And (strOS = "W98" Or strOS = "WME") Then
If flagAUSUF Then
If Fso.FolderExists(strValue) Then
Set oSUF = Fso.GetFolder(strValue)
Else
flagFE = False 'folder doesn't exist
End If
Else
flagFE = False 'registry key doesn't exist
End If
Else 'all other O/S's at all times
Set oSUF = Fso.GetFolder(Wshso.SpecialFolders(arSUFN(i)))
End If
strSubTitle = oSUF.Path
'if startup folder exists
If flagFE Then
'for each file in the startup folder
For Each oSUFi in oSUF.Files
strLine = "" 'empty the line
'treat file as a shortcut
On Error Resume Next
Set oSUSC = Wshso.CreateShortcut(oSUFi)
intErrNum = Err.Number : Err.Clear
On Error Goto 0
'if file is a shortcut
If intErrNum = 0 Then
If LCase(Fso.GetExtensionName(oSUFi)) = "url" Then 'shortcut is URL
'prepare the shortcut file base name and the target path & arguments
strLine = Chr(34) & Fso.GetBaseName (oSUFi.Path) & Chr(34) & " -> URL shortcut to: " &_
Chr(34) & oSUSC.TargetPath
Else
'prepare the shortcut file base name and the target path & arguments
strLine = Chr(34) & Fso.GetBaseName (oSUFi.Path) & Chr(34) & " -> shortcut to: " &_
Chr(34) & oSUSC.TargetPath
If oSUSC.Arguments <> "" Then
strLine = strLine & " " & oSUSC.Arguments & Chr(34)
Else
strLine = strLine & Chr(34)
End If
'add co-name
strLine = strLine & CoName(IDExe(oSUSC.TargetPath))
End If 'URL or shortcut?
'if file is a PIF
ElseIf LCase(Fso.GetExtensionName(oSUFi)) = "pif" Then
'write out pif file target
strPIFTgt = ""
Dim oFi : Set oFi = Fso.OpenTextFile(oSUFi, 1)
oFi.Skip(36) 'target starts after 36 bytes
'target size is up to 63 bytes
For ii = 1 To 63
bin1C = oFi.Read(1)
'end of target is single "00" byte
If AscB(bin1C) = 0 Then Exit For
'otherwise convert binary to ASCII and append to string
strPIFTgt = strPIFTgt & Chr(AscB(bin1C))
Next
oFi.Close
Set oFi=Nothing
strLine = Chr(34) & Fso.GetBaseName(oSUFi.Path) & Chr(34) &_
" -> PIF to: " & Chr(34) & strPIFTgt & Chr(34) &_
CoName(IDExe(strPIFTgt))
'file is neither shortcut nor PIF
Else
'file is probably an executable so write out an INFECTION WARNING and
' the file name, using the full path as IDExe argument
If LCase(Fso.GetFileName(oSUFi)) <> "desktop.ini" Then _
strLine = "INFECTION WARNING! " & Chr(34) & oSUFi.Name & Chr(34) &_
CoName(IDExe(oSUFi.Path))
End If 'file is shortcut
Set oSUSC=Nothing
'if there's something to output
If strLine <> "" Then
'output the section title line if not already done
TitleLineWrite
'output the line
oFN.WriteLine strLine
End If
Next 'file in startup folder
Set oSUF=Nothing
'if ShowAll
If flagShowAll Then TitleLineWrite
End If 'flagFE?
Next 'startup folder name
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
'recover array memory
ReDim arSUFN(0)
End If 'flagTest?
'XX. Enumerate enabled Scheduled Tasks
If Not flagTest Then 'skip if testing
' Byte Disabled Enabled
'00000030: #####1## #####0## <--
'file in Tasks directory
Dim oFi2
'prepare section title lines
strTitle = "Enabled Scheduled Tasks:"
'if the tasks directory exists in the Windows directory
If Fso.FolderExists(Fso.GetSpecialFolder(WinFolder) & "\Tasks") Then
'get the tasks folder
Dim oJobF : Set oJobF = Fso.GetFolder(Fso.GetSpecialFolder(WinFolder) & "\Tasks")
'for each file
For Each oFi2 in oJobF.Files
'if file in Tasks directory is a task (has a .JOB extension)
If LCase(Fso.GetExtensionName(oFi2)) = "job" Then
'try to open the task file
On Error Resume Next
Dim oJobFi : Set oJobFi = Fso.OpenTextFile(oFi2,1,False,-1)
intErrNum = Err.Number : Err.Clear
On Error Goto 0
'if file could be opened
If intErrNum = 0 Then
'read the file, determine enabled status, extract the executable name
JobFileRead oFi2, oJobFi
'close the .JOB file
oJobFi.Close : Set oJobFi=Nothing
Else 'file couldn't be opened
TitleLineWrite
'write error message
oFN.WriteLine vbCRLF & Chr(34) & oFi2.Name & Chr(34) &_
" -- insufficient permission to read this file!"
End If '.JOB file opened successfully?
End If '.JOB file extension selected?
Next 'file in TASKS directory
'if ShowAll, output title line if not already done
If flagShowAll Then TitleLineWrite
Else 'Tasks directory can't be found
'write titles and error message
TitleLineWrite
oFN.WriteLine vbCRLF & "WARNING! The " & Chr(34) &_
Wshso.ExpandEnvironmentStrings("%WINDIR%") & "\Tasks" & Chr(34) &_
" directory cannot be found."
End If 'Tasks directory exists?
Set oJobF=Nothing
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
End If 'flagTest?
'XXI. Enumerate Winsock2 Service Provider DLLs
If Not flagTest Then 'skip if testing
strTitle = "Winsock2 Service Provider DLLs:"
Dim strNSCatKey 'NameSpace Catalog Key
Dim strProCatKey 'Protocol Catalog Key
Dim strNSSP 'NameSpace Service Provider
Dim arTSP '(returned) Transport Service Provider array
Dim int1C 'single chr binary (integer) code
'TSP output array for numeric keys, key #, strlen of key #, work var
Dim arTSPFi(), intKN, intL, intT
'TSP output array for alpha (illegal) keys
Dim arATSPFi()
'arTSPFi is 3 x n array
ReDim arTSPFi(2,0)
ReDim arATSPFi(1,0)
'number of numbered TSP keys
Dim intNumKeys : intNumKeys = 0
intCnt = 0 'arTSPFi UBound - 1
Dim intACnt : intACnt = 0 'arATSPFi UBound - 1
strAllOutDefault = " {++}"
'NameSpace Providers
strKey = "System\CurrentControlSet\Services\Winsock2\Parameters"
'find name of NameSpace Catalog key
intErrNum1 = oReg.GetStringValue (HKLM,strKey,"Current_NameSpace_Catalog",strNSCatKey)
'if the Current_NameSpace_Catalog name exists And value set (exc for W2K!)
If intErrNum1 = 0 And strNSCatKey <> "" Then
strSubTitle = "Namespace Service Providers" & vbCRLF & vbCRLF &_
"HKLM\" & strKey & "\" & strNSCatKey & "\Catalog_Entries\" &_
strAllOutDefault
'find NameSpace catalog entry subkeys
oReg.EnumKey HKLM,strKey & "\" & strNSCatKey & "\Catalog_Entries",arKeys
'if sub-keys exist
If IsArray(arKeys) Then
'for each subkey
For Each oKey in arKeys
'find LibraryPath
intErrNum2 = oReg.GetStringValue (HKLM,strKey & "\" & strNSCatKey &_
"\Catalog_Entries\" & oKey,"LibraryPath",strNSSP)
'if the LibraryPath name exists And value set (exc for W2K!)
If intErrNum2 = 0 And strNSSP <> "" Then
TitleLineWrite
On Error Resume Next
oFN.WriteLine oKey & "\LibraryPath" & " = " & Chr(34) &_
strNSSP & Chr(34) & CoName(IDExe(strNSSP))
intErrNum3 = Err.Number : Err.Clear
On Error Goto 0
If intErrNum3 <> 0 Then oFN.WriteLine oKey & "\LibraryPath" &_
" = (value not set)"
End If 'LibaryPath value set?
Next 'subkey
'IsArray = True, but array is empty
If strSubTitle <> "" And flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & "HKLM\" & strKey &_
"\" & strNSCatKey & "\Catalog_Entries\" & " = (sub-keys not found)"
End If
Else 'Catalog_Entries subkeys do not exist
If flagShowAll Then
TitleLineWrite : oFN.WriteLine "(sub-keys not found)"
End If
End If 'Catalog_Entries subkeys exist?
Else 'Current_NameSpace_Catalog value doesn't exist Or value not set
If flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & "HKLM\" & strKey &_
"\Current_Namespace_Catalog = (value not found)"
End If
End If 'Current_NameSpace_Catalog value exists?
'Transport Service Providers (Layered Service Providers = LSP's)
intErrNum1 = oReg.GetStringValue (HKLM,strKey,"Current_Protocol_Catalog",strProCatKey)
'if the Current_Protocol_Catalog name exists And value set (exc for W2K!)
If intErrNum1 = 0 And strProCatKey <> "" Then
strSubTitle = "Transport Service Providers" & vbCRLF & vbCRLF &_
"HKLM\" & strKey & "\" & strProCatKey & "\Catalog_Entries\" &_
strAllOutDefault
'find Protocol catalog entry subkeys
oReg.EnumKey HKLM,strKey & "\" & strProCatKey & "\Catalog_Entries",arKeys
'if sub-keys exist
If IsArray(arKeys) Then
'for each subkey
For Each oKey in arKeys
'can only take UBound if subkeys exist
'find number of keys in array & # digits
intNumKeys = UBound(arKeys) + 1
'determine # digits
intL = Len(CStr(intNumKeys))
'convert key name to integer
On Error Resume Next
intKN = CInt(oKey)
intErrNum = Err.Number : Err.Clear
On Error Goto 0
If intErrNum <> 0 Then intKN = -1 'key not in numeric format
'find PackedCatalogItem
intErrNum2 = oReg.GetBinaryValue (HKLM,strKey & "\" & strProCatKey &_
"\Catalog_Entries\" & oKey,"PackedCatalogItem",arTSP)
'if the PackedCatalogItem name exists And value set (exc for W2K!)
If intErrNum2 = 0 And IsArray(arTSP) Then
strDLL = "" 'clear strDLL
'reform strDLL from binary data array
For i = 0 To UBound(arTSP)
int1C = arTSP(i)
'end of target is single "0" byte
If int1C = 0 Then Exit For
'otherwise convert binary to ASCII and append to string
strDLL = strDLL & Chr(int1C)
Next 'binary data array element
'if key number numeric
If intKN <> -1 Then
'if file array populated
If intCnt > 0 Then
flagMatch = False
'for every arTSPFi member
For i = 0 To UBound(arTSPFi,2)
'if array file matches DLL, store array subscript
If arTSPFi(0,i) = strDLL Then
flagMatch = True : intSS = i : Exit For
End If
Next 'arTSPFi member
'if DLL is new
If Not flagMatch Then
'initialize output array for DLL
ReDim Preserve arTSPFi(3,intCnt)
arTSPFi(0,intCnt) = strDLL 'FN path\file name
arTSPFi(1,intCnt) = Right("0" & CStr(intKN),intL) 'OS output string
arTSPFi(2,intCnt) = intKN 'LA last added key number
arTSPFi(3,intCnt) = intKN 'UL upper limit key number
'increment output array for next pass
intCnt = intCnt + 1
Else 'flagMatch = True
'this key # consecutive to DLL UL
If intKN - arTSPFi(3,intSS) = 1 Then
'set DLL UL to this key #
arTSPFi(3,intSS) = intKN
Else 'this key # not consecutive to DLL UL
'if last added = upper limit, add comma and key # for new range
If arTSPFi(2,intSS) = arTSPFi(3,intSS) Then
arTSPFi(1,intSS) = arTSPFi(1,intSS) & ", " &_
Right("0" & CStr(intKN),intL)
arTSPFi(2,intSS) = intKN
arTSPFi(3,intSS) = intKN
'last added < upper limit, add hyphen, upper limit, comma and
'key # for new range
Else 'LA <> UL
arTSPFi(1,intSS) = arTSPFi(1,intSS) & " - " &_
Right("0" & CStr(arTSPFi(3,intSS)),intL) & ", " &_
Right("0" & CStr(intKN),intL)
arTSPFi(2,intSS) = intKN
arTSPFi(3,intSS) = intKN
End If 'LA = UL?
End If 'consecutive occurrence?
End If 'flagMatch?
Else 'intCnt = 0
'add first DLL to array
ReDim arTSPFi(3,intCnt)
arTSPFi(0,intCnt) = strDLL 'FN
arTSPFi(1,intCnt) = Right("0" & CStr(intKN),intL) 'OS
arTSPFi(2,intCnt) = intKN 'LA
arTSPFi(3,intCnt) = intKN 'UL
intCnt = intCnt + 1
End If 'intCnt > 0?
Else 'intKN not numeric
ReDim Preserve ATSPFi(1,intACnt)
arATSPFi(0,intACnt) = oKey
arATSPFi(1,intACnt) = strDLL
intACnt = intACnt + 1
End If 'intKN numeric?
End If 'PackedCatalogItem value exists?
Next 'subkey
'output results
'if Catalog_Entries sub-keys exist
If intNumKeys > 0 Then
'finalize output strings
For i = 0 To UBound(arTSPFi,2)
'last added < upper limit, add upper limit
If arTSPFi(2,i) < arTSPFi(3,i) Then
arTSPFi(1,i) = arTSPFi(1,i) & " - " & Right("0" & arTSPFi(3,i),intL)
End If 'LA = UL?
Suite :
Next 'TSP array member
TitleLineWrite
'write out non-numeric sub-keys
If intACnt > 0 Then
For i = 0 To UBound(arATSPFi,2)
oFN.WriteLine vbCRLF & arATSPFi(0,i) & " = " & Chr(34) &_
arATSPFi(1,i) & Chr(34) & CoName(IDExe(arATSPFi(1,i))) & vbCRLF
Next
End If 'non-numeric sub-keys exist?
'write out numeric sub-keys
'0000000000##\PackedCatalogItem contains (DLL [Company Name], ##):
'%SystemRoot%\system32\xxxxxx.dll [CN] ##-##, ##-##
'%SystemRoot%\system32\yyyyyy.dll [CN] ##-##
oFN.WriteLine String(12-intL,"0") &_
String(intL,"#") & "\PackedCatalogItem (contains) DLL " &_
"[Company Name], (at) " & String(intL,"#") & " range:"
For i = 0 To UBound(arTSPFi,2)
oFN.WriteLine arTSPFi(0,i) & CoName(IDExe(arTSPFi(0,i))) & ", " &_
arTSPFi(1,i)
Next
Else 'intNumKeys=0 (no Catalog_Entries sub-keys)
If flagShowAll Then
TitleLineWrite : oFN.WriteLine "(sub-keys not found)"
End If
End If 'arKeys subkeys exist?
Else 'Catalog_Entries sub-keys do not exist
If flagShowAll Then
TitleLineWrite : oFN.WriteLine "(sub-keys not found)"
End If
End If 'Catalog_Entries array exists?
Else 'Current_Protocol_Catalog name doesn't exist Or value not set
If flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & "HKLM\" & strKey &_
"\Current_Protocol_Catalog = (value not found)"
End If
End If 'Current_Protocol_Catalog value exists?
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
'recover array memory
ReDim arTSPFi(0)
ReDim arATSPFi(0)
End If 'flagTest?
'XXII. Internet Explorer Toolbars, Explorer Bars, Extensions
If Not flagTest Then 'skip if testing
strTitle = "Toolbars, Explorer Bars, Extensions:"
'HKCU/HKLM Explorer Bars, combined array of existing explorer bars
Dim arHKExplorerBars(), arListedExplorerBars()
Dim arAllowedExplorerBars() 'allowed explorer bars
Dim strHKExplorerBar 'single explorer bar
'all CLSIDs, CLSID\Implemented Categories sub-keys, single CLSID, single Impl Cat sub-key
Dim arCLSIDKeys(), arCLSIDImpCatSubKey(), strCLSIDKey, strImpCatSubKey
'count of HKCU/HKLM explorer bars needed for ReDim statement
Dim cntExplorerBars : cntExplorerBars = 0
Dim arHKExtensions() 'HKCU/HKLM extension keys
Dim arAllowedExtensions() 'allowed extensions
Dim strHKExtension 'single extension key name
Dim arAllowedToolbars() 'allowed toolbars
Dim strHKToolbar 'single toolbar value name
Dim arHKCUTbSK() 'HKCU toolbar sub-keys
Dim strSKName 'single toolbar subkey name
Dim arSKValName() 'toolbar sub-key value names
Dim arHKToolbarVals() 'toolbar value names
Dim flagTBTLW : flagTBTLW = False 'toolbar title lines
'Toolbars
strSubTitle = "Toolbars"
ReDim arAllowedToolbars(4) 'must be in upper case!
arAllowedToolbars(0) = "{01E04581-4EEE-11D0-BFE9-00AA005B4383}" '&Address
arAllowedToolbars(1) = "{0E5CBF21-D15F-11D0-8301-00AA005B4383}" '&Links
arAllowedToolbars(2) = "{1E796980-9CC5-11D1-A83F-00C04FC99D61}" 'displayed toolbar buttons (non-CLSID)
arAllowedToolbars(3) = "{710EB7A1-45ED-11D0-924A-0020AFC7AC4D}" 'unknown default (non-CLSID)
arAllowedToolbars(4) = "{8E718888-423F-11D2-876E-00A0C9082467}" '... &Radio
strKey = "Software\Microsoft\Internet Explorer\Toolbar"
'for HKCU & HKLM hives
For i = 0 To 1
strSubSubTitle = arHives(i,0) & "\" & strKey & "\"
'get toolbar key values
oReg.EnumValues arHives(i,1),strKey,arHKToolbarVals,arType
'if values exist
If IsArray(arHKToolbarVals) Then
'for each value
For Each strCLSID in arHKToolbarVals
'change to UCase
strCLSID = Trim(UCase(strCLSID))
'assume not on allowed list
flagAllow = False
'is Toolbar on allowed list?
For j = 0 To UBound(arAllowedToolbars)
If arAllowedToolbars(j) = UCase(strCLSID) Then
flagAllow = True : Exit For 'toggle allowed flag
End If
Next
'if not allowed Or ShowAll
If Not flagAllow Or flagShowAll Then
ResolveCLSID arHives(i,1), strKey, strCLSID, strCLSIDTitle, strIPSDLL
If strIPSDLL <> "" Then 'IPS exists?
'output toolbar CLSID value name
If strSubSubTitle <> "" Then
TitleLineWrite : oFN.WriteLine Chr(34) & strCLSID & Chr(34) &_
" = " & strCLSIDTitle
Else
oFN.WriteLine vbCRLF & Chr(34) & strCLSID & Chr(34) & " = " &_
strCLSIDTitle
End If
'output InProcServer32 value
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " &_
Chr(34) & strIPSDLL & Chr(34) & CoName(IDExe(strIPSDLL))
End If 'strIPSDLL <> ""?
End If 'flagAllow Or ShowAll?
Next 'HKCU/HKLM toolbar key value
End If 'toolbar key has values
'for HKCU Toolbar key only
If arHives(i,0) = "HKCU" Then
'get HKCU toolbar subkeys
oReg.EnumKey HKCU,strKey,arHKCUTbSK
'if key array exists
If IsArray(arHKCUTbSK) Then
'for each sub-key
For Each strSKName in arHKCUTbSK
strSubSubTitle = "HKCU\" & strKey & "\" & strSKName & "\"
'if one of three targeted sub-keys
If LCase(strSKName) = "explorer" Or LCase(strSKName) = "shellbrowser" Or _
LCase(strSKName) = "webbrowser" Then
'get toolbar subkey values
oReg.EnumValues HKCU,strKey & "\" & strSKName,arSKValName,arType
'if array of values exists
If IsArray(arSKValName) Then
'for each value
For Each strValue in arSKValName
'assume not on allowed list
flagAllow = False
'is Toolbar on allowed list?
For j = 0 To UBound(arAllowedToolbars)
If arAllowedToolbars(j) = UCase(strValue) Then
flagAllow = True : Exit For 'toggle allowed flag
End If
Next
'if not allowed Or ShowAll
If Not flagAllow Or flagShowAll Then
ResolveCLSID HKCU,strKey & "\" & strSKName,strValue,strValue2,strValue1
'if InProcServer32 value exists
If strValue1 <> "" Then
'output toolbar CLSID
If strSubSubTitle <> "" Then
TitleLineWrite : oFN.WriteLine Chr(34) & strValue & Chr(34) &_
" = " & strValue2
Else
oFN.WriteLine vbCRLF & Chr(34) & strValue & Chr(34) &_
" = " & strValue2
End If
'output InProcServer32 value
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " &_
StringFilter(strValue1,True) & CoName(IDExe(strValue1))
End If 'IPS exists?
End If 'flagAllow Or ShowAll?
Next 'strValue
End If 'IsArray(arSKValName)?
End If 'targeted sub-key
Next 'toolbar sub-key
End If 'toolbar sub-key array exists
End If 'HKCU hive?
'if ShowAll, output title lines if not already done
If flagShowAll Then TitleLineWrite
Next 'hive
'Explorer Bars
strSubTitle = "Explorer Bars"
ReDim arAllowedExplorerBars(7) 'must be in upper case!
arAllowedExplorerBars(0) = "{30D02401-6A81-11D0-8274-00C04FD5AE38}" 'Search Band
arAllowedExplorerBars(1) = "{32683183-48A0-441B-A342-7C2A440A9478}" 'Media Band
arAllowedExplorerBars(2) = "{4D5C8C25-D075-11D0-B416-00C04FB90376}" '&Tip of the Day
arAllowedExplorerBars(3) = "{BDEADE7F-C265-11D0-BCED-00A0C90AB50F}" '&Discuss
arAllowedExplorerBars(4) = "{C4EE31F3-4768-11D2-BE5C-00A0C9A83DA1}" 'File and Folders Search ActiveX Control
arAllowedExplorerBars(5) = "{EFA24E61-B078-11D0-89E4-00C04FC9E26E}" 'Favorites Band
arAllowedExplorerBars(6) = "{EFA24E62-B078-11D0-89E4-00C04FC9E26E}" 'History Band
arAllowedExplorerBars(7) = "{EFA24E64-B078-11D0-89E4-00C04FC9E26E}" 'Explorer Band
strKey = "Software\Microsoft\Internet Explorer\Explorer Bars"
'for HKCU & HKLM hives
For i = 0 To 1
strSubSubTitle = arHives(i,0) & "\" & strKey & "\"
'get explorer bar subkeys
oReg.EnumKey arHives(i,1),strKey,arHKExplorerBars
'if subkeys exist
If IsArray(arHKExplorerBars) Then
'for each subkey
For Each strHKExplorerBar in arHKExplorerBars
'convert subkey name (CLSID) to uppercase
strHKExplorerBar= UCase(strHKExplorerBar)
'assume not on allowed list
flagAllow = False
'add to ListedExplorerBars array
ReDim Preserve arListedExplorerBars(cntExplorerBars)
arListedExplorerBars(cntExplorerBars) = strHKExplorerBar
cntExplorerBars = cntExplorerBars + 1 'cnt = UBound + 1
'is Explorer Bar on allowed list?
For j = 0 To UBound(arAllowedExplorerBars)
If arAllowedExplorerBars(j) = UCase(strHKExplorerBar) Then
flagAllow = True : Exit For 'toggle allowed flag
End If
Next
'if not allowed Or ShowAll
If Not flagAllow Or flagShowAll Then
ResolveCLSID arHives(i,1), "", strHKExplorerBar, strValue2, strValue1
'if InProcServer32 value exists
If strValue1 <> "" Then
'output explorer bar CLSID
If strSubSubTitle <> "" Then
TitleLineWrite : oFN.WriteLine strHKExplorerBar & "\" & " = " &_
strValue2
Else
oFN.WriteLine vbCRLF & strHKExplorerBar & "\" & " = " &_
strValue2
End If
'output InProcServer32 value
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " &_
Chr(34) & strValue1 & Chr(34) & CoName(IDExe(strValue1))
End If 'IPS exists?
End If 'not on allowed list Or ShowAll
Next 'HKCU/HKLM explorer bar subkey
End If 'explorer bar key has subkeys
'if ShowAll, output sub-title lines if not already done
If flagShowAll Then TitleLineWrite
Next 'hive
If flagShowAll Or flagSupp Then
'check CLSIDs for dormant (!) Explorer Bars
Dim datDEBStart : datDEBStart = Now
strKey = "Software\Classes\CLSID"
strSubSubTitle = "Dormant Explorer Bars in " & Chr(34) &_
"View, Explorer Bar" & Chr(34) & " menu"
'get CLSIDs
oReg.EnumKey HKLM,strKey,arCLSIDKeys
If IsArray(arCLSIDKeys) Then
'for each CLSID
For Each strCLSIDKey in arCLSIDKeys
'convert to uppercase
strCLSIDKey = UCase(strCLSIDKey)
'look for Implemented Categories subkeys
intErrNum = oReg.EnumKey (HKLM,strKey & "\" & strCLSIDKey &_
"\Implemented Categories",arCLSIDImpCatSubKey)
'if Implemented Categories subkeys exist
If intErrNum = 0 And IsArray(arCLSIDImpCatSubKey) Then
'for each Implemented Categories subkey
For Each strImpCatSubKey in arCLSIDImpCatSubKey
'convert to uppercase
strImpCatSubKey = UCase(strImpCatSubKey)
'if subkey name is vertical or horizontal explorer bar
If strImpCatSubKey = "{00021494-0000-0000-C000-000000000046}" Or _
strImpCatSubKey = "{00021493-0000-0000-C000-000000000046}" Then
flagFound = False 'assume CLSID is not listed in HKCU/HKLM explorer bars
If IsArray(arListedExplorerBars) Then
'search explorer bar array for CLSID
For Each strArMember in arListedExplorerBars
If strArMember = strCLSIDKey Then
flagFound = True : Exit For
End If
Next
End If 'IsArray(arListedExplorerBars)?
'if CLSID not listed
If Not flagFound Then
'assume not allowed
flagAllow = False
'see if on allowed list
For j = 0 To UBound(arAllowedExplorerBars)
If arAllowedExplorerBars(j) = UCase(strCLSIDKey) Then
flagAllow = True : Exit For
End If
Next
'if not allowed Or ShowAll
If Not flagAllow Or flagShowAll Then
'look for InProcServer32
intErrNum3 = oReg.GetExpandedStringValue(HKLM,"Software\Classes\CLSID\" &_
strCLSIDKey & "\InProcServer32","",strValue3)
'if InProcServer32 value exists
If intErrNum3 = 0 And strValue3 <> "" Then
'get CLSID title
oReg.GetStringValue HKLM,"Software\Classes\CLSID\" &_
strCLSIDKey,"",strValue4
TitleLineWrite
'output CLSID + title, prepare output string,
'output Implemented Categories key, InProcServer32
If strValue4 <> "" Then
oFN.WriteLine vbCRLF & "HKLM\Software\Classes\CLSID\" &_
strCLSIDKey & "\ = " & StringFilter(strValue4,True)
Else
oFN.WriteLine vbCRLF & "HKLM\Software\Classes\CLSID\" &_
strCLSIDKey & "\ = (title not found)"
End If
If Mid(strImpCatSubKey,9,1) = "3" Then
strOut = " [vertical bar]"
Else
strOut = " [horizontal bar]"
End If
oFN.WriteLine "Implemented Categories\" & strImpCatSubKey & "\" & strOut
oFN.WriteLine "InProcServer32\(Default) = " &_
Chr(34) & strvalue3 & Chr(34) & CoName(IDExe(strValue3))
End If 'CLSID InProcServer32 exists?
End If 'CLSID not allowed Or ShowAll?
End If 'CLSID not already found in HKCU/HKLM?
End If 'strImpCatSubKey designates scroll bar?
Next 'arCLSIDImpCatSubKey
End If 'Implemented Categories sub-key exists?
Next 'CLSID sub-key
End If 'CLSID array exists?
'determine -supp seconds used
Dim strDEBTime : strDEBTime = DateDiff("s",datDEBStart,Now) & " seconds"
End If 'flagShowAll Or flagSupp?
'Extensions (Tools menu items, toolbar buttons)
strSubTitle = "Extensions (Tools menu items, main toolbar menu buttons)"
ReDim arAllowedExtensions(4) 'must be in upper case!
arAllowedExtensions(0) = "{438AFBA1-B0CB-11D2-9214-00104B3BCE5F}" '&Document Tree
arAllowedExtensions(1) = "{B06300D0-CCDE-11D2-92D3-0000F87A4A55}" 'Add to R&estricted Zone
arAllowedExtensions(2) = "{BF80219A-CCDD-11D2-92D3-0000F87A4A55}" 'Add to Tr&usted Zone
arAllowedExtensions(3) = "{C95FE080-8F5D-11D2-A20B-00AA003C157A}" 'Show &Related Links
arAllowedExtensions(4) = "{FC09D8A3-C85A-11D2-92D0-0000F87A4A55}" 'Offline
'{FB5F1910-F110-11D2-BB9E-00C04F795683} MSN Messenger Service
strKey = "Software\Microsoft\Internet Explorer\Extensions"
'for HKCU & HKLM hives
For i = 0 To 1
strSubSubTitle = arHives(i,0) & "\" & strKey & "\"
'get extension subkeys
oReg.EnumKey arHives(i,1),strKey,arHKExtensions
'if subkeys exist
If IsArray(arHKExtensions) Then
'for each subkey
For Each strHKExtension in arHKExtensions
If Len(strHKExtension) = 38 And Left(strHKExtension,1) = "{" And _
Right(strHKExtension,1) = "}" Then
'convert subkey name (CLSID) to uppercase
strHKExtension= UCase(strHKExtension)
'assume not on allowed list
flagAllow = False
'is Extension on allowed list?
For j = 0 To UBound(arAllowedExtensions)
If arAllowedExtensions(j) = UCase(strHKExtension) Then
flagAllow = True : Exit For 'toggle allowed flag
End If
Next
'if not allowed Or ShowAll
If Not flagAllow Or flagShowAll Then
'look for ButtonText/MenuText/CLSIDExtension/Exec values
intErrNum1 = oReg.GetStringValue(arHives(i,1),strKey & "\" &_
strHKExtension,"ButtonText",strValue1)
intErrNum2 = oReg.GetStringValue(arHives(i,1),strKey & "\" &_
strHKExtension,"MenuText",strValue2)
intErrNum3 = oReg.GetStringValue(arHives(i,1),strKey & "\" &_
strHKExtension,"CLSIDExtension",strValue3)
intErrNum4 = oReg.GetStringValue(arHives(i,1),strKey &_
"\" & strHKExtension,"Script",strValue4)
intErrNum5 = oReg.GetStringValue(arHives(i,1),strKey &_
"\" & strHKExtension,"Exec",strValue5)
ResolveCLSID arHives(i,1), "", strValue3, strCLSIDTitle, strValue6
If strSubSubTitle <> "" Then
TitleLineWrite : oFN.WriteLine strHKExtension & "\"
Else
oFN.WriteLine vbCRLF & strHKExtension & "\"
End If
'most output is optional (on error, do nothing)
On Error Resume Next
If intErrNum1 = 0 And strValue1 <> "" Then _
oFN.WriteLine Chr(34) & "ButtonText" & Chr(34) & " = " &_
Chr(34) & strValue1 & Chr(34)
If intErrNum2 = 0 And strValue2 <> "" Then _
oFN.WriteLine Chr(34) & "MenuText" & Chr(34) & " = " & Chr(34) &_
strValue2 & Chr(34)
If intErrNum3 = 0 And strValue3 <> "" Then
Err.Clear 'required to reset Err if ButtonText or MenuText missing
oFN.WriteLine Chr(34) & "CLSIDExtension" & Chr(34) & " = " &_
Chr(34) & strValue3 & Chr(34)
If strValue6 <> "" Then oFN.WriteLine " -> {CLSID}\InProcServer32\" &_
"(Default) = " & StringFilter(strValue6,True) & CoName(IDExe(strValue6))
End If 'CLSIDExtension value exists
If intErrNum4 = 0 And strValue4 <> "" Then oFN.WriteLine Chr(34) &_
"Script" & Chr(34) & " = " & Chr(34) & strValue4 & Chr(34) &_
CoName(IDExe(strValue4))
If intErrNum5 = 0 And strValue5 <> "" Then oFN.WriteLine Chr(34) &_
"Exec" & Chr(34) & " = " & Chr(34) & strValue5 & Chr(34) &_
CoName(IDExe(strValue5))
Err.Clear
On Error Goto 0
End If 'flagAllow Or flagAll?
End If 'CLSID format?
Next 'Extension subkey
End If 'Extension subkeys exist
'if ShowAll, output sub-title lines if not already done
If flagShowAll Then TitleLineWrite
Next 'hive
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
'recover array memory
ReDim arCLSIDKeys(0)
ReDim arCLSIDImpCatSubKey(0)
ReDim arExplorerBars(0)
ReDim arAllowedExplorerBars(0)
ReDim arListedExplorerBars(0)
ReDim arHKExtensions(0)
ReDim arAllowedExtensions(0)
ReDim arAllowedToolbars(0)
ReDim arHKCUTbSK(0)
ReDim arSKValName(0)
ReDim arHKToolbarVals(0)
End If 'flagTest?
'XXIII. Internet Explorer URL Prefixes
If Not flagTest Then 'skip if testing
strTitle = "Internet Explorer Address Prefixes:"
'prefix used if bare domain ("microsoft.com") entered into IE address box
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\URL"
strSubTitle = "Prefix for bare domain (" & Chr(34) &_
"domain-name-here.com" & Chr(34) & ")" & vbCRLF & vbCRLF & "HKLM\" &_
strKey & "\Default Prefix\"
'get DefaultPrefix default value
intErrNum = oReg.GetStringValue (HKLM,strKey & "\DefaultPrefix","",strValue)
'assume not infected
strWarn = ""
'value exists and is not empty
If intErrNum = 0 And strValue <> "" Then
'if default value not OK, toggle warning
If Trim(LCase(strValue)) <> "http://" Then strWarn = "HIJACK WARNING! "
If strWarn <> "" Or flagShowAll Then
TitleLineWrite : oFN.Writeline strWarn & "(Default) = " &_
StringFilter(strValue,True)
End If
Else 'value doesn't exist
If flagShowAll Then
TitleLineWrite
oFN.WriteLine "(Default) = (value not set)"
End If
End If 'default value exists?
'prefix used with specific service
'2 x 5 array
Dim arPrefix()
ReDim arPrefix(1,4)
arPrefix(0,0) = "ftp" : arPrefix(1,0) = "ftp://"
arPrefix(0,1) = "gopher" : arPrefix(1,1) = "gopher://"
arPrefix(0,2) = "home" : arPrefix(1,2) = "http://"
arPrefix(0,3) = "mosaic" : arPrefix(1,3) = "http://"
arPrefix(0,4) = "www" : arPrefix(1,4) = "http://"
'find all the names in the key
intErrNum1 = oReg.EnumValues (HKLM, strKey & "\Prefixes", arNames, arType)
strSubTitle = "Prefix for specific service (i.e., " & Chr(34) & "www" &_
Chr(34) & ")" & vbCRLF & vbCRLF & "HKLM\" & strKey & "\Prefixes\"
'enumerate data if present
If intErrNum1 = 0 And IsArray(arNames) Then
'for each name
For Each strName in arNames
'assume infected
flagMatch = False : strWarn = "HIJACK WARNING! "
'for each prefix type
For i = 0 To UBound(arPrefix,2)
'if name = prefix Or name = prefix.
If Trim(LCase(strName)) = arPrefix(0,i) Or _
Trim(LCase(strName)) = arPrefix(0,i) & "." Then
'get value
intErrNum2 = oReg.GetStringValue(HKLM,strKey & "\Prefixes", _
strName,strValue)
'if value exists (exc. for W2K!)
If intErrNum2 = 0 And strValue <> "" Then
'toggle flags if value = default value
If Trim(LCase(strValue)) = arPrefix(1,i) Then
flagMatch = True : strWarn = "" : Exit For
End If 'value = arPrefix member?
End If 'strValue exists And not empty?
End If 'name = arPrefix member?
Next 'arPrefix member
'get value if name not in arPrefix
If Not flagMatch Then oReg.GetStringValue HKLM, _
strKey & "\Prefixes",strName,strValue
'output if flagMatch Or flagShowAll
If Not flagMatch Or flagShowAll Then
TitleLineWrite
On Error Resume Next
'output warning, name, value
oFN.WriteLine strWarn & StringFilter(strName,True) & " = " &_
Chr(34) & strValue & Chr(34)
intErrNum = Err.Number : Err.Clear
'error check for W2K if value not set
If intErrNum <> 0 Then oFN.WriteLine StringFilter(strName,True) &_
" = (value not set)"
On Error Goto 0
End If 'flagMatch or flagShowAll?
Next 'prefix key name array member
If strSubTitle <> "" And flagShowAll Then
TitleLineWrite : oFN.WriteLine "(values not found)"
End If
Else 'prefix key name array doesn't exist
If flagShowAll Then
TitleLineWrite : oFN.WriteLine "(values not found)"
End If
End If 'prefix key name array exists
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
'recover array memory
ReDim arPrefix(0,0)
End If 'flagTest?
'check IERESET.INF integrity, URLSearchHooks, AboutURLs (error pages)
'XXIV. Misc. IE Hijack Points
If Not flagTest Then 'skip if testing
'IERESET Text File, IERESET file name, INF-file section name,
'array of count of missing phrase lines by section
Dim oIERTF, strSection, arSectionCount(), intTFF
Dim intAsc1Chr, intAsc2Chr 'ASCII code of 1st & 2nd chr of IERESET.INF
'zero-based number of sections in phrase array with lines missing from disk file
Public intSectionCount : intSectionCount = -1
'one-based number of lines in each section of phrase array with lines missing from disk file
Public intSectionLineCount : intSectionLineCount = 0
strTitle = "Miscellaneous IE Hijack Points"
strWarn = "HIJACK WARNING! "
'parse IERESET.INF, look for added and missing lines
Dim strIERFN : strIERFN = UCase(strFPWF) & "\INF\IERESET.INF"
'read the IE version from the registry
'IE version reg value, work string
Dim strIELVer, strIELVWK
'short string version, non-numeric if dec symbol not "."
Dim strIEShVer : strIEShVer = "0"
'numeric IE version: 0 if IE version not in registry or value not set
'otherwise, number using single local dec symbol
Dim intIELVer : intIELVer = 0
Dim strDecSym : strDecSym = "." 'dec symbol
strKey = "Software\Microsoft\Internet Explorer"
intErrNum = oReg.GetStringValue(HKLM,strKey,"Version",strIELVer)
strSubTitle = "HKLM\" & strKey & "\Version = " & strIELVer
strSubSubTitle = strIERFN & " (used to " & Chr(34) & "Reset Web " &_
"Settings" & Chr(34) & ")"
'in W2K, if value not set, strIELVer will be garbage
If intErrNum = 0 And Len(Trim(strIELVer)) > 3 Then
'read the decimal symbol from the registry
strKey1 = "Control Panel\International"
intErrNum1 = oReg.GetStringValue(HKCU,strKey1,"sDecimal",strValue1)
'if the symbol exists, store it
If intErrNum1 = 0 And strValue1 <> "" Then strDecSym = strValue1
'replace 1st dec pt in the IE ver with XXX
strIELVWK = Replace (Trim(strIELVer),".","XXX",1,1,1)
'delete all succeeding dec pts
strIELVWK = Replace (Trim(strIELVWK),".","",1,-1,1)
'restore dec symbol to pos'n of first dec pt and call it an integer
intIELVer = Replace (Trim(strIELVWK),"XXX",strDecSym,1,1,1)
If IsNumeric(intIELVer) Then 'should exclude W2K value not set garbage
strIEShVer = Left(LTrim(strIELVer),3)
If strIEShVer <> "5.5" Then 'for 5.5, retain 3 chrs
'use left-most chr
strIEShVer = Left(LTrim(strIELVer),1)
'if IE ver < 5, advise that INF file doesn't exist
If intIELVer < 5 Then
TitleLineWrite
oFN.WriteLine vbCRLF & "IERESET.INF does not exist for this Internet " &_
"Explorer version."
End If 'intIELVer<5?
End If 'strIEShVer=5.5?
Else 'intIELVer not numeric, so advise about bad IE version and reset to 0
strSubTitle = "HKLM\" & strKey & "\Version = (invalid data)" &_
vbCRLF & "The Internet Explorer version cannot be found!"
TitleLineWrite
oFN.WriteLine "The contents of IERESET.INF cannot be reliably checked!"
intIELVer = 0
End If 'intIELVer numeric?
Else 'IE ver not found or value corrupt
strSubTitle = "HKLM\" & strKey & "\Version = (invalid data)" &_
vbCRLF & "The Internet Explorer version cannot be found!"
TitleLineWrite
oFN.WriteLine "The contents of IERESET.INF cannot be reliably checked!"
End If 'IE ver exists?
'change titles if not already written
If strTitle <> "" Then
strSubTitle = strIERFN & " (used to " & Chr(34) & "Reset Web Settings" &_
Chr(34) & ")"
strSubSubTitle = ""
End If
Dim arIER() 'common IERESET.INF lines & phrases
ReDim arIER(31,2) 'section, phrase, found-in-file-on-disk?
arIER(0,0)="[Version]" : arIER(0,1)="Signature=""$CHICAGO$"""
arIER(1,0)="[Version]" : arIER(1,1)="AdvancedINF=2.5,""You need a new version of advpack.dll"""
arIER(2,0)="[RestoreHomePage]" : arIER(2,1)="AddReg=RestoreHomePage.reg"
arIER(3,0)="[RestoreHomePage.reg]" : arIER(3,1)="HKCU,""Software\Microsoft\Internet Explorer\Main"",""Start Page"",0,%START_PAGE_URL%"
arIER(4,0)="[RestoreBrowserSettings.reg]" : arIER(4,1)="HKLM,""Software\Microsoft\Internet Explorer\Main"",""Default_Page_URL"",0,%START_PAGE_URL%"
arIER(5,0)="[RestoreBrowserSettings.reg]" : arIER(5,1)="HKLM,""Software\Microsoft\Internet Explorer\Main"",""Default_Search_URL"",0,%SEARCH_PAGE_URL%"
arIER(6,0)="[RestoreBrowserSettings.reg]" : arIER(6,1)="HKLM,""Software\Microsoft\Internet Explorer\Main"",""Search Page"",0,%SEARCH_PAGE_URL%"
arIER(7,0)="[RestoreBrowserSettings.reg]" : arIER(7,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""1"",0,""www.%s.com"""
arIER(8,0)="[RestoreBrowserSettings.reg]" : arIER(8,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""2"",0,""www.%s.org"""
arIER(9,0)="[RestoreBrowserSettings.reg]" : arIER(9,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""3"",0,""www.%s.net"""
arIER(10,0)="[RestoreBrowserSettings.reg]" : arIER(10,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""4"",0,""www.%s.edu"""
arIER(11,0)="[RestoreBrowserSettings.reg]" : arIER(11,1)="HKCU,""Software\Microsoft\Internet Explorer\Main"",""Search Page"",0,%SEARCH_PAGE_URL%"
arIER(12,0)="[RestoreBrowserSettings.reg]" : arIER(12,1)="HKCU,""Software\Microsoft\Internet Explorer\SearchUrl"",""Provider"",0,"""""
arIER(13,0)="[RestoreBrowserSettings.reg]" : arIER(13,1)="HKLM,""Software\Microsoft\Internet Explorer\Search"",""SearchAssistant"",0,""http://ie.search.msn.com/{SUB_RFC1766}/srchasst/srchasst.htm"""
arIER(14,0)="[RestoreBrowserSettings.reg]" : arIER(14,1)="HKLM,""Software\Microsoft\Internet Explorer\Search"",""CustomizeSearch"",0,""http://ie.search.msn.com/{SUB_RFC1766}/srchasst/srchcust.htm"""
arIER(15,0)="[RestoreBrowserSettings.reg]" : arIER(15,1)="HKLM,""Software\Microsoft\Windows\CurrentVersion\Internet Settings\SafeSites"",%SAFESITE_VALUE%,0,""http://ie.search.msn.com/*"""
arIER(16,0)="[DeleteTemplates.reg]" : arIER(16,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""5"""
arIER(17,0)="[DeleteTemplates.reg]" : arIER(17,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""6"""
arIER(18,0)="[DeleteTemplates.reg]" : arIER(18,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""7"""
arIER(19,0)="[DeleteTemplates.reg]" : arIER(19,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""8"""
arIER(20,0)="[DeleteTemplates.reg]" : arIER(20,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""9"""
arIER(21,0)="[DeleteAutosearch.reg]" : arIER(21,1)="HKCU,""Software\Microsoft\Internet Explorer\Main"",""AutoSearch"""
arIER(22,0)="[Strings]" : arIER(22,1)="SEARCH_PAGE_URL=""http://www.microsoft.com/isapi/redir.dll?prd=ie&ar=iesearch"""
arIER(23,0)="[RestoreBrowserSettings]" : arIER(23,1)="AddReg=RestoreBrowserSettings.reg"
arIER(24,0)="[RestoreBrowserSettings]" : arIER(24,1)="DelReg=DeleteTemplates.reg"
arIER(25,0)="[RestoreBrowserSettings]" : arIER(25,1)="DelReg=DeleteTemplates.reg, DeleteAutosearch.reg"
arIER(26,0)="[Strings]" : arIER(26,1)="START_PAGE_URL=""http://www.microsoft.com/isapi/redir.dll?prd=ie&pver=" & strIEShVer & "&ar=msnhome"""
arIER(27,0)="[Strings]" : arIER(27,1)="START_PAGE_URL=""http://www.msn.com"""
arIER(28,0)="[Strings]" : arIER(28,1)="SAFESITE_VALUE=""http://home.microsoft.com/"""
arIER(29,0)="[Strings]" : arIER(29,1)="SAFESITE_VALUE=""ie.search.msn.com"""
arIER(30,0)="[Strings]" : arIER(30,1)="MS_START_PAGE_URL=""http://www.microsoft.com/isapi/redir.dll?prd=ie&pver=" & strIEShVer & "&ar=msnhome"""
arIER(31,0)="[Strings]" : arIER(31,1)="MS_START_PAGE_URL=""http://www.msn.com"""
'set found-in-file-on-disk flag to False
For i = 0 To UBound(arIER,1) : arIER(i,2) = False : Next
'if IERESET.INF exists
If Fso.FileExists(strIERFN) Then
'open the file for reading/don't create/ASCII format
Set oIERTF = Fso.OpenTextFile (strIERFN,1,False,0)
'get the file size
Dim intFileSize : intFileSize = Fso.GetFile(strIERFN).Size
If intFileSize > 100 Then
'read 1st 2 chrs, find Asc code (not AscW code)
intAsc1Chr = Asc(oIERTF.Read(1)) : intAsc2Chr = Asc(oIERTF.Read(1))
oIERTF.Close
'if Asc codes = 255 & 254, file is Unicode
'ASCII file read as Unicode: 1st Unicode line is entire file
'Unicode file read as ASCII: 1st ASCII line is variable length
'TriStateDefault appears to distinguish between ASCII & Unicode on file open
'VBS internally allots 2 bytes per ASCII chr
intTFF = 0 'ASCII fmt
If intAsc1Chr = 255 And intAsc2Chr = 254 Then intTFF = -1 'Unicode fmt
Set oIERTF = Fso.OpenTextFile (strIERFN,1,False,intTFF)
strSubSubTitle = "Added lines (compared with English-language version):"
flagInfect = False
'for each line
Do Until oIERTF.AtEndOfStream
strLine = Trim(oIERTF.ReadLine) 'read a line
flagMatch = False 'line doesn't match phrase array
'if line not empty And not a comment
If Len(strLine) > 0 And Left(strLine,1) <> ";" Then
If Left(strLine,1) = "[" Then 'if line is section title
strSection = strLine 'save the section name
Else 'line not a section title, so it's a data line
For i = 0 To UBound(arIER,1) 'for every line in phrase array
'if section's identical and phrase found in line,
'toggle line match flag & found-in-file-on-disk flag
If LCase(arIER(i,0)) = LCase(strSection) And _
LCase(strLine) = LCase(arIER(i,1)) Then
flagMatch = True : arIER(i,2) = True : Exit For
Exit For
End If
Next
If Not flagMatch Then 'if line not matched
flagInfect = True
TitleLineWrite
On Error Resume Next
'output section name & line
oFN.WriteLine strSection & ": " & strLine
intErrNum = Err.Number : Err.Clear
On Error Goto 0
If intErrNum <> 0 Then oFN.WriteLine "(unwritable string)"
End If 'line matched?
End If 'section title line?
End If 'data line?
Loop 'next file line
'close IERESET.INf
oIERTF.Close : Set oIERTF=Nothing
'initialize section title for phrases missing from file
strSection = ""
strSubSubTitle = "Missing lines (compared with English-language version):"
flagFound = True 'False if found-in-file-on-disk = False
For i = 0 To 23 'for single-option phrases
If Not arIER(i,2) Then
flagFound = False : flagInfect = True 'toggle flags
'increment counters
IERESETCounter strSection, arIER(i,0), arSectionCount
End If
Next 'single-option phrase
'check double-option phrases
For i = 24 To 30 Step 2
'if neither option found-in-file-on-disk
If Not arIER(i,2) And Not arIER(i+1,2) Then
flagFound = False : flagInfect = True 'toggle flags
'increment counters
IERESETCounter strSection, arIER(i,0), arSectionCount
End If
Next 'double-option phrase
If Not flagFound Then 'if lines missing
TitleLineWrite
'output contents of arSectionCount (section title: # missing lines)
For i = 0 To UBound(arSectionCount,2)
strOut = " line"
If arSectionCount(1,i) > 1 Then strOut = " lines"
oFN.WriteLine arSectionCount(0,i) & ": " & arSectionCount(1,i) & strOut
Next
End If 'lines missing?
If strTitle <> "" And flagShowAll Then
strSubTitle = strIERFN & " (used to " & Chr(34) &_
"Reset Web Settings" & Chr(34) & " -- no anomalies found)"
strSubSubTitle = "" : TitleLineWrite
End If
Else 'IERESET.INF<100 bytes
oIERTF.Close
'file should always exist if IE ver > 5 Or if in one of these OS's
If intIELVer > 5 Or strOS = "WXP" Or strOS = "W2K" Or strOS = "WME" Then
TitleLineWrite
oFN.WriteLine strWarn & strIERFN & " is *much* too small and is " &_
"probably corrupt!"
End If 'should file exist?
End If 'IERSET.INF>100 bytes?
Else 'IERESET.INF not found
'file should always exist if IE ver > 5 Or if in one of these OS's
If intIELVer > 5 Or strOS = "WXP" Or strOS = "W2K" Or strOS = "WME" Then
TitleLineWrite
oFN.WriteLine strWarn & strIERFN & " was not found!"
End If 'should file exist?
End If 'IERESET.INF found?
'URLSearchHooks
strKey = "Software\Microsoft\Internet Explorer\URLSearchHooks"
strSubTitle = "HKCU\" & strKey & "\"
intErrNum = oReg.EnumValues (HKCU, strKey, arNames, arType)
If IsArray(arNames) Then
For Each strCLSID In arNames
If strCLSID <> "{CFBFAE00-17A6-11D0-99CB-00C04FD64497}" Or _
flagShowAll Then
ResolveCLSID HKCU, strKey, strCLSID, strOut, strIPSDLL
If strIPSDLL <> "" Then
strWarn = ""
If strCLSID <> "{CFBFAE00-17A6-11D0-99CB-00C04FD64497}" Then _
strWarn = "HIJACK WARNING! "
TitleLineWrite
oFN.WriteLine Chr(34) & strCLSID & Chr(34) & " = " & strOut
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " &_
StringFilter(strIPSDLL,True) & CoName(IDExe(strIPSDLL))
End If 'IPS exists?
End If 'match Or flagShowAll?
Next 'strCLSID
Else
If flagShowAll Then
TitleLineWrite
oFN.WriteLine "(URLSearchHooks key not found!)"
End If
End If 'IsArray?
'AboutURLs
strKey = "Software\Microsoft\Internet Explorer\AboutURLs"
strSubTitle = "HKLM\" & strKey & "\"
EnumNVP HKLM, strKey, arNames, arType
If flagNVP Then 'name/value pairs exist
Set arSK = CreateObject("Scripting.Dictionary") 'key, item
'add dictionary pairs (universal elements)
arSK.Add "blank", "res://mshtml.dll/blank.htm"
arSK.Add "Home", "270"
arSK.Add "mozilla", "res://mshtml.dll/about.moz"
arSK.Add "PostNotCached", "res://mshtml.dll/repost.htm"
'value not set or IE 5-6
If intIELVer = 0 Or intIELVer >= 5 Then
arSK.Add "DesktopItemNavigationFailure", "res://shdoclc.dll/navcancl.htm"
arSK.Add "NavigationCanceled", "res://shdoclc.dll/navcancl.htm"
arSK.Add "NavigationFailure", "res://shdoclc.dll/navcancl.htm"
arSK.Add "OfflineInformation", "res://shdoclc.dll/offcancl.htm"
Else 'IE < 5
arSK.Add "DesktopItemNavigationFailure", "res://shdocvw.dll/navcancl.htm"
arSK.Add "NavigationCanceled", "res://shdocvw.dll/navcancl.htm"
arSK.Add "NavigationFailure", "res://shdocvw.dll/navcancl.htm"
arSK.Add "OfflineInformation", "res://shdocvw.dll/offcancl.htm"
End If 'IE>5?
arSKk = arSK.Keys : arSKi = arSK.Items
For i = 0 To UBound(arNames)
strWarn = "HIJACK WARNING! "
'use the type to find the value
strValue = RtnValue (HKLM, strKey, arNames(i), arType(i))
For j = 0 To arSK.Count-1
flagFound = False
If LCase(arNames(i)) = LCase(arSKk(j)) And _
LCase(strValue) = LCase(arSKi(j)) Then
flagFound = True : strWarn = "" : Exit For
End If
Next 'dictionary pair
If Not flagFound Or flagShowAll Then
TitleLineWrite
WriteValueData arNames(i), strValue, arType(i), strWarn
End If
Next 'arNames member
arSK.RemoveAll : Set arSK=Nothing 'recover dictionary memory
Else
If flagShowAll Then
TitleLineWrite
oFN.WriteLine "(AboutURLs key not found!)"
End If
End If 'flagNVP?
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
End If 'flagTest?
'XXV. Examine HOSTS file
If Not flagTest Then 'skip if testing
'left-trimmed HOSTS line, IP address, HOSTS Path, tab pos'n
Dim strLineWk, strIP, strHP, intTabPosn
Dim intWSPosn : intWSPosn = 0 'white space posn
Dim intMapCtr : intMapCtr = 0 'map ctr
Dim intNLHMapCtr : intNLHMapCtr = 0 'non-localhost map ctr
'prepare section title
strTitle = "HOSTS file"
'determine HOSTS file location
If strOS <> "W98" And strOS <> "WME" Then
'find HOSTS directory from registry, compare to default value
strKey = "System\CurrentControlSet\Services\Tcpip\Parameters"
intErrNum = oReg.GetExpandedStringValue (HKLM,strKey,"DataBasePath",strValue)
strTmp = Trim(strValue) 'trim it
'lop off trailing backslash
If Right(strTmp,1) = "\" Then strTmp = Left(strTmp,Len(strTmp)-1)
'set HOSTS location from registry value
strHP = strTmp & "\HOSTS"
'if registry value exists
If intErrNum = 0 And strValue <> "" Then
'output warning if not identical to default value
strWarn = ""
If LCase(strTmp) <> LCase(strFPSF) & "\drivers\etc" Then _
strWarn = "HIJACK WARNING! "
If LCase(strTmp) <> LCase(strFPSF) & "\drivers\etc" Or flagShowAll Then
TitleLineWrite
oFN.WriteLine vbCRLF & "HKLM\" & strKey & "\" & vbCRLF & strWarn &_
Chr(34) & "DataBasePath" & Chr(34) & " = " & Chr(34) & strValue &_
Chr(34)
End If 'value <> default?
Else 'registry value doesn't exist
'set HOSTS location to default
strHP = strFPSF & "\Drivers\Etc\HOSTS"
End If 'HOSTS directory registry value exists?
Else 'W98/WME
strHP = strFPWF & "\HOSTS"
End If 'O/S?
'if HOSTS exists
If Fso.FileExists(strHP) Then
'open it for reading
Set oSCF = Fso.OpenTextFile (strHP,1)
Do While Not oSCF.AtEndOfStream
'read a line
strLine = oSCF.ReadLine
strLineWk = Trim(strLine) 'trim the line
'if line not CR And not a comment
If Len(strLineWk) > 0 And InStr(1,strLineWk,"#",1) <> 1 Then
'increment the mapped domain name count
intMapCtr = intMapCtr + 1
'find an interior space/tab
intSpacePosn = InStr(1,strLineWk," ",1)
intTabPosn = InStr(1,strLineWk,Chr(09),1)
If intSpacePosn > 0 Then intWSPosn = intSpacePosn
If intSpacePosn = 0 Or (intTabPosn > 0 And intTabPosn < intSpacePosn) _
Then intWSPosn = intTabPosn
'if a space or tab exists
If intWSPosn > 0 Then
'extract the IP address left of the space
strIP = Left(strLineWk,intWSPosn-1)
'if not localhost, increment the mapped non localhost count
If strIP <> "127.0.0.1" Then
intNLHMapCtr = intNLHMapCtr + 1 : TitleLineWrite
End If
End If 'line has embedded space?
End If 'line not CR/comment?
Loop 'read another line
oSCF.Close : Set oSCF=Nothing
'output if more than one IP mapped Or any IP mapped to non-localhost
'Or ShowAll
If (intMapCtr >= 1 And intNLHMapCtr > 0) Or flagShowAll Then
'set up output strings
'total number of mappings
If intMapCtr = 0 Then 'none
strOut1 = "maps: no domain names to IP addresses"
ElseIf intMapCtr = 1 Then 'one
strOut1 = "maps: 1 domain name to an IP address," & vbCRLF
Else '> 1
strOut1 = "maps: " & intMapCtr &_
" domain names to IP addresses," & vbCRLF
End If
'non-localhost mappings
If intNLHMapCtr = 0 Then 'none
If intMapCtr = 0 Then 'no maps found
strOut2 = ""
ElseIf intMapCtr = 1 Then 'one map found
strOut2 = Space(6) & "and this is the localhost IP address"
Else
strOut2 = Space(6) & "and all are the localhost IP address" '> 1 map found
End If
ElseIf intNLHMapCtr = 1 Then 'one
strOut2 = Space(6) & "1 of the IP addresses is *not* localhost!"
Else '> 1
strOut2 = Space(6) & intNLHMapCtr & " of the IP addresses are *not* localhost!"
End If
'output mapped & non-localhost counts
TitleLineWrite
oFN.WriteLine vbCRLF & strHP & vbCRLF & vbCRLF & strOut1 & strOut2
End If '>= 1 IP mapped And at least 1 IP mapped to non-localhost
Else 'HOSTS doesn't exist
If flagShowAll Then
TitleLineWrite
'say file not found
oFN.WriteLine vbCRLF & strHP & " (file not found)"
End If 'flagShowAll?
End If 'HOSTS exists?
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
End If 'flagTest?
'XXVI. Enumerate Started or Non-disabled Services
If Not flagTest Then 'skip if testing
'for NT-type O/S's
If strOS <> "W98" And strOS <> "WME" Then
'MS default services array, subscript number in MS default services array
'CoName string
Dim arMSSvc(), intMSSvcNo, strExeName
'set up MS default services array for WXP/W2K/NT4
'service name, service executable, DLL file name for svchost.exe-dependent service
If strOS = "WXP" Then
ReDim arMSSvc(91,2)
arMSSvc(0,0) = "alerter" : arMSSvc(0,1) = "svchost.exe" : arMSSvc(0,2) = "alrsvc.dll"
arMSSvc(1,0) = "alg" : arMSSvc(1,1) = "alg.exe" : arMSSvc(1,2) = ""
arMSSvc(2,0) = "appmgmt" : arMSSvc(2,1) = "svchost.exe" : arMSSvc(2,2) = "appmgmts.dll"
arMSSvc(3,0) = "wuauserv" : arMSSvc(3,1) = "svchost.exe" : arMSSvc(3,2) = "wuauserv.dll"
arMSSvc(4,0) = "bits" : arMSSvc(4,1) = "svchost.exe" : arMSSvc(4,2) = "qmgr.dll"
arMSSvc(5,0) = "clipsrv" : arMSSvc(5,1) = "clipsrv.exe" : arMSSvc(5,2) = ""
arMSSvc(6,0) = "eventsystem" : arMSSvc(6,1) = "svchost.exe" : arMSSvc(6,2) = "es.dll"
arMSSvc(7,0) = "comsysapp" : arMSSvc(7,1) = "dllhost.exe" : arMSSvc(7,2) = ""
arMSSvc(8,0) = "browser" : arMSSvc(8,1) = "svchost.exe" : arMSSvc(8,2) = "browser.dll"
arMSSvc(9,0) = "cryptsvc" : arMSSvc(9,1) = "svchost.exe" : arMSSvc(9,2) = "cryptsvc.dll"
arMSSvc(10,0) = "dhcp" : arMSSvc(10,1) = "svchost.exe" : arMSSvc(10,2) = "dhcpcsvc.dll"
arMSSvc(11,0) = "trkwks" : arMSSvc(11,1) = "svchost.exe" : arMSSvc(11,2) = "trkwks.dll"
arMSSvc(12,0) = "msdtc" : arMSSvc(12,1) = "msdtc.exe" : arMSSvc(12,2) = ""
arMSSvc(13,0) = "dnscache" : arMSSvc(13,1) = "svchost.exe" : arMSSvc(13,2) = "dnsrslvr.dll"
arMSSvc(14,0) = "eventlog" : arMSSvc(14,1) = "services.exe" : arMSSvc(14,2) = ""
arMSSvc(15,0) = "ersvc" : arMSSvc(15,1) = "svchost.exe" : arMSSvc(15,2) = "ersvc.dll"
arMSSvc(16,0) = "fastuserswitchingcompatibility" : arMSSvc(16,1) = "svchost.exe" : arMSSvc(16,2) = "shsvcs.dll"
arMSSvc(17,0) = "helpsvc" : arMSSvc(17,1) = "svchost.exe" : arMSSvc(17,2) = "pchsvc.dll"
arMSSvc(18,0) = "hidserv" : arMSSvc(18,1) = "svchost.exe" : arMSSvc(18,2) = "hidserv.dll"
arMSSvc(19,0) = "imapiservice" : arMSSvc(19,1) = "imapi.exe" : arMSSvc(19,2) = ""
arMSSvc(20,0) = "iisadmin" : arMSSvc(20,1) = "inetinfo.exe" : arMSSvc(20,2) = ""
arMSSvc(21,0) = "cisvc" : arMSSvc(21,1) = "cisvc.exe" : arMSSvc(21,2) = ""
arMSSvc(22,0) = "sharedaccess" : arMSSvc(22,1) = "svchost.exe" : arMSSvc(22,2) = "ipnathlp.dll"
arMSSvc(23,0) = "policyagent" : arMSSvc(23,1) = "lsass.exe" : arMSSvc(23,2) = ""
arMSSvc(24,0) = "dmserver" : arMSSvc(24,1) = "svchost.exe" : arMSSvc(24,2) = "dmserver.dll"
arMSSvc(25,0) = "dmadmin" : arMSSvc(25,1) = "dmadmin.exe" : arMSSvc(25,2) = ""
arMSSvc(26,0) = "messenger" : arMSSvc(26,1) = "svchost.exe" : arMSSvc(26,2) = "msgsvc.dll"
arMSSvc(27,0) = "swprv" : arMSSvc(27,1) = "dllhost.exe" : arMSSvc(27,2) = ""
arMSSvc(28,0) = "netlogon" : arMSSvc(28,1) = "lsass.exe" : arMSSvc(28,2) = ""
arMSSvc(29,0) = "mnmsrvc" : arMSSvc(29,1) = "mnmsrvc.exe" : arMSSvc(29,2) = ""
arMSSvc(30,0) = "netman" : arMSSvc(30,1) = "svchost.exe" : arMSSvc(30,2) = "netman.dll"
arMSSvc(31,0) = "netdde" : arMSSvc(31,1) = "netdde.exe" : arMSSvc(31,2) = ""
arMSSvc(32,0) = "netddedsdm" : arMSSvc(32,1) = "netdde.exe" : arMSSvc(32,2) = ""
arMSSvc(33,0) = "nla" : arMSSvc(33,1) = "svchost.exe" : arMSSvc(33,2) = "mswsock.dll"
arMSSvc(34,0) = "ntlmssp" : arMSSvc(34,1) = "lsass.exe" : arMSSvc(34,2) = ""
arMSSvc(35,0) = "sysmonlog" : arMSSvc(35,1) = "smlogsvc.exe" : arMSSvc(35,2) = ""
arMSSvc(36,0) = "plugplay" : arMSSvc(36,1) = "services.exe" : arMSSvc(36,2) = ""
arMSSvc(37,0) = "wmdmpmsp" : arMSSvc(37,1) = "svchost.exe" : arMSSvc(37,2) = "mspmspsv.dll"
arMSSvc(38,0) = "spooler" : arMSSvc(38,1) = "spoolsv.exe" : arMSSvc(38,2) = ""
arMSSvc(39,0) = "protectedstorage" : arMSSvc(39,1) = "lsass.exe" : arMSSvc(39,2) = ""
arMSSvc(40,0) = "rsvp" : arMSSvc(40,1) = "rsvp.exe" : arMSSvc(40,2) = ""
arMSSvc(41,0) = "rasauto" : arMSSvc(41,1) = "svchost.exe" : arMSSvc(41,2) = "rasauto.dll"
arMSSvc(42,0) = "rasman" : arMSSvc(42,1) = "svchost.exe" : arMSSvc(42,2) = "rasmans.dll"
arMSSvc(43,0) = "rdsessmgr" : arMSSvc(43,1) = "sessmgr.exe" : arMSSvc(43,2) = ""
arMSSvc(44,0) = "rpcss" : arMSSvc(44,1) = "svchost.exe" : arMSSvc(44,2) = "rpcss.dll"
arMSSvc(45,0) = "rpclocator" : arMSSvc(45,1) = "locator.exe" : arMSSvc(45,2) = ""
arMSSvc(46,0) = "remoteregistry" : arMSSvc(46,1) = "svchost.exe" : arMSSvc(46,2) = "regsvc.dll"
arMSSvc(47,0) = "ntmssvc" : arMSSvc(47,1) = "svchost.exe" : arMSSvc(47,2) = "ntmssvc.dll"
arMSSvc(48,0) = "remoteaccess" : arMSSvc(48,1) = "svchost.exe" : arMSSvc(48,2) = "mprdim.dll"
arMSSvc(49,0) = "seclogon" : arMSSvc(49,1) = "svchost.exe" : arMSSvc(49,2) = "seclogon.dll"
arMSSvc(50,0) = "samss" : arMSSvc(50,1) = "lsass.exe" : arMSSvc(50,2) = ""
arMSSvc(51,0) = "lanmanserver" : arMSSvc(51,1) = "svchost.exe" : arMSSvc(51,2) = "srvsvc.dll"
arMSSvc(52,0) = "smtpsvc" : arMSSvc(52,1) = "inetinfo.exe" : arMSSvc(52,2) = ""
arMSSvc(53,0) = "shellhwdetection" : arMSSvc(53,1) = "svchost.exe" : arMSSvc(53,2) = "shsvcs.dll"
arMSSvc(54,0) = "scardsvr" : arMSSvc(54,1) = "scardsvr.exe" : arMSSvc(54,2) = ""
arMSSvc(55,0) = "scarddrv" : arMSSvc(55,1) = "scardsvr.exe" : arMSSvc(55,2) = ""
arMSSvc(56,0) = "ssdpsrv" : arMSSvc(56,1) = "svchost.exe" : arMSSvc(56,2) = "ssdpsrv.dll"
arMSSvc(57,0) = "sens" : arMSSvc(57,1) = "svchost.exe" : arMSSvc(57,2) = "sens.dll"
arMSSvc(58,0) = "srservice" : arMSSvc(58,1) = "svchost.exe" : arMSSvc(58,2) = "srsvc.dll"
arMSSvc(59,0) = "schedule" : arMSSvc(59,1) = "svchost.exe" : arMSSvc(59,2) = "schedsvc.dll"
arMSSvc(60,0) = "lmhosts" : arMSSvc(60,1) = "svchost.exe" : arMSSvc(60,2) = "lmhsvc.dll"
arMSSvc(61,0) = "tapisrv" : arMSSvc(61,1) = "svchost.exe" : arMSSvc(61,2) = "tapisrv.dll"
arMSSvc(62,0) = "tlntsvr" : arMSSvc(62,1) = "tlntsvr.exe" : arMSSvc(62,2) = ""
arMSSvc(63,0) = "termservice" : arMSSvc(63,1) = "svchost.exe" : arMSSvc(63,2) = "termsrv.dll"
arMSSvc(64,0) = "themes" : arMSSvc(64,1) = "svchost.exe" : arMSSvc(64,2) = "shsvcs.dll"
arMSSvc(65,0) = "ups" : arMSSvc(65,1) = "ups.exe" : arMSSvc(65,2) = ""
arMSSvc(66,0) = "upnphost" : arMSSvc(66,1) = "svchost.exe" : arMSSvc(66,2) = "upnphost.dll"
arMSSvc(67,0) = "uploadmgr" : arMSSvc(67,1) = "svchost.exe" : arMSSvc(67,2) = "pchsvc.dll"
arMSSvc(68,0) = "vss" : arMSSvc(68,1) = "vssvc.exe" : arMSSvc(68,2) = ""
arMSSvc(69,0) = "webclient" : arMSSvc(69,1) = "svchost.exe" : arMSSvc(69,2) = "webclnt.dll"
arMSSvc(70,0) = "audiosrv" : arMSSvc(70,1) = "svchost.exe" : arMSSvc(70,2) = "audiosrv.dll"
arMSSvc(71,0) = "stisvc" : arMSSvc(71,1) = "svchost.exe" : arMSSvc(71,2) = "wiaservc.dll"
arMSSvc(72,0) = "msiserver" : arMSSvc(72,1) = "msiexec.exe" : arMSSvc(72,2) = ""
arMSSvc(73,0) = "winmgmt" : arMSSvc(73,1) = "svchost.exe" : arMSSvc(73,2) = "wmisvc.dll"
arMSSvc(74,0) = "wmi" : arMSSvc(74,1) = "svchost.exe" : arMSSvc(74,2) = "advapi32.dll"
arMSSvc(75,0) = "w32time" : arMSSvc(75,1) = "svchost.exe" : arMSSvc(75,2) = "w32time.dll"
arMSSvc(76,0) = "wzcsvc" : arMSSvc(76,1) = "svchost.exe" : arMSSvc(76,2) = "wzcsvc.dll"
arMSSvc(77,0) = "wmiapsrv" : arMSSvc(77,1) = "svchost.exe" : arMSSvc(77,2) = "wmiapsrv.dll"
arMSSvc(78,0) = "lanmanworkstation" : arMSSvc(78,1) = "svchost.exe" : arMSSvc(78,2) = "wkssvc.dll"
arMSSvc(79,0) = "w3svc" : arMSSvc(79,1) = "inetinfo.exe" : arMSSvc(79,2) = ""
arMSSvc(80,0) = "dcomlaunch" : arMSSvc(80,1) = "svchost.exe" : arMSSvc(80,2) = "rpcss.dll"
arMSSvc(81,0) = "irmon" : arMSSvc(81,1) = "svchost.exe" : arMSSvc(81,2) = "irmon.dll"
arMSSvc(82,0) = "ip6fwhlp" : arMSSvc(82,1) = "svchost.exe" : arMSSvc(82,2) = "ip6fwhlp.dll"
arMSSvc(83,0) = "wscsvc" : arMSSvc(83,1) = "svchost.exe" : arMSSvc(83,2) = "wscsvc.dll"
arMSSvc(84,0) = "wmiapsrv" : arMSSvc(84,1) = "wmiapsrv.exe" : arMSSvc(84,2) = ""
'WS2K3 only
arMSSvc(85,0) = "dfs" : arMSSvc(85,1) = "dfssvc.exe" : arMSSvc(85,2) = ""
arMSSvc(86,0) = "httpfilter" : arMSSvc(86,1) = "lsass.exe" : arMSSvc(86,2) = ""
arMSSvc(87,0) = "srvcsurg" : arMSSvc(87,1) = "srvcsurg.exe" : arMSSvc(87,2) = ""
arMSSvc(88,0) = "appmgr" : arMSSvc(88,1) = "appmgr.exe" : arMSSvc(88,2) = ""
arMSSvc(89,0) = "snmp" : arMSSvc(89,1) = "snmp.exe" : arMSSvc(89,2) = ""
arMSSvc(90,0) = "elementmgr" : arMSSvc(90,1) = "elementmgr.exe" : arMSSvc(90,2) = ""
arMSSvc(91,0) = "w3svc" : arMSSvc(91,1) = "svchost.exe" : arMSSvc(91,2) = "iisw3adm.dll"
ElseIf strOS = "W2K" Then
ReDim arMSSvc(66,2)
arMSSvc(0,0) = "alerter" : arMSSvc(0,1) = "services.exe" : arMSSvc(0,2) = ""
arMSSvc(1,0) = "appmgmt" : arMSSvc(1,1) = "services.exe" : arMSSvc(1,2) = ""
arMSSvc(2,0) = "wuauserv" : arMSSvc(2,1) = "svchost.exe" : arMSSvc(2,2) = "wuauserv.dll"
arMSSvc(3,0) = "bits" : arMSSvc(3,1) = "svchost.exe" : arMSSvc(3,2) = "qmgr.dll"
arMSSvc(4,0) = "clipsrv" : arMSSvc(4,1) = "clipsrv.exe" : arMSSvc(4,2) = ""
arMSSvc(5,0) = "eventsystem" : arMSSvc(5,1) = "svchost.exe" : arMSSvc(5,2) = "es.dll"
arMSSvc(6,0) = "browser" : arMSSvc(6,1) = "services.exe" : arMSSvc(6,2) = ""
arMSSvc(7,0) = "dhcp" : arMSSvc(7,1) = "services.exe" : arMSSvc(7,2) = ""
arMSSvc(8,0) = "trkwks" : arMSSvc(8,1) = "services.exe" : arMSSvc(8,2) = ""
arMSSvc(9,0) = "msdtc" : arMSSvc(9,1) = "msdtc.exe" : arMSSvc(9,2) = ""
arMSSvc(10,0) = "dnscache" : arMSSvc(10,1) = "services.exe" : arMSSvc(10,2) = ""
arMSSvc(11,0) = "eventlog" : arMSSvc(11,1) = "services.exe" : arMSSvc(11,2) = ""
arMSSvc(12,0) = "fax" : arMSSvc(12,1) = "faxsvc.exe" : arMSSvc(12,2) = ""
arMSSvc(13,0) = "iisadmin" : arMSSvc(13,1) = "inetinfo.exe" : arMSSvc(13,2) = ""
arMSSvc(14,0) = "cisvc" : arMSSvc(14,1) = "cisvc.exe" : arMSSvc(14,2) = ""
arMSSvc(15,0) = "sharedaccess" : arMSSvc(15,1) = "svchost.exe" : arMSSvc(15,2) = "ipnathlp.dll"
arMSSvc(16,0) = "policyagent" : arMSSvc(16,1) = "lsass.exe" : arMSSvc(16,2) = ""
arMSSvc(17,0) = "dmserver" : arMSSvc(17,1) = "services.exe" : arMSSvc(17,2) = ""
arMSSvc(18,0) = "dmadmin" : arMSSvc(18,1) = "dmadmin.exe" : arMSSvc(18,2) = ""
arMSSvc(19,0) = "messenger" : arMSSvc(19,1) = "services.exe" : arMSSvc(19,2) = ""
arMSSvc(20,0) = "netlogon" : arMSSvc(20,1) = "lsass.exe" : arMSSvc(20,2) = ""
arMSSvc(21,0) = "mnmsrvc" : arMSSvc(21,1) = "mnmsrvc.exe" : arMSSvc(21,2) = &q
Next 'TSP array member
TitleLineWrite
'write out non-numeric sub-keys
If intACnt > 0 Then
For i = 0 To UBound(arATSPFi,2)
oFN.WriteLine vbCRLF & arATSPFi(0,i) & " = " & Chr(34) &_
arATSPFi(1,i) & Chr(34) & CoName(IDExe(arATSPFi(1,i))) & vbCRLF
Next
End If 'non-numeric sub-keys exist?
'write out numeric sub-keys
'0000000000##\PackedCatalogItem contains (DLL [Company Name], ##):
'%SystemRoot%\system32\xxxxxx.dll [CN] ##-##, ##-##
'%SystemRoot%\system32\yyyyyy.dll [CN] ##-##
oFN.WriteLine String(12-intL,"0") &_
String(intL,"#") & "\PackedCatalogItem (contains) DLL " &_
"[Company Name], (at) " & String(intL,"#") & " range:"
For i = 0 To UBound(arTSPFi,2)
oFN.WriteLine arTSPFi(0,i) & CoName(IDExe(arTSPFi(0,i))) & ", " &_
arTSPFi(1,i)
Next
Else 'intNumKeys=0 (no Catalog_Entries sub-keys)
If flagShowAll Then
TitleLineWrite : oFN.WriteLine "(sub-keys not found)"
End If
End If 'arKeys subkeys exist?
Else 'Catalog_Entries sub-keys do not exist
If flagShowAll Then
TitleLineWrite : oFN.WriteLine "(sub-keys not found)"
End If
End If 'Catalog_Entries array exists?
Else 'Current_Protocol_Catalog name doesn't exist Or value not set
If flagShowAll Then
TitleLineWrite : oFN.WriteLine vbCRLF & "HKLM\" & strKey &_
"\Current_Protocol_Catalog = (value not found)"
End If
End If 'Current_Protocol_Catalog value exists?
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
'recover array memory
ReDim arTSPFi(0)
ReDim arATSPFi(0)
End If 'flagTest?
'XXII. Internet Explorer Toolbars, Explorer Bars, Extensions
If Not flagTest Then 'skip if testing
strTitle = "Toolbars, Explorer Bars, Extensions:"
'HKCU/HKLM Explorer Bars, combined array of existing explorer bars
Dim arHKExplorerBars(), arListedExplorerBars()
Dim arAllowedExplorerBars() 'allowed explorer bars
Dim strHKExplorerBar 'single explorer bar
'all CLSIDs, CLSID\Implemented Categories sub-keys, single CLSID, single Impl Cat sub-key
Dim arCLSIDKeys(), arCLSIDImpCatSubKey(), strCLSIDKey, strImpCatSubKey
'count of HKCU/HKLM explorer bars needed for ReDim statement
Dim cntExplorerBars : cntExplorerBars = 0
Dim arHKExtensions() 'HKCU/HKLM extension keys
Dim arAllowedExtensions() 'allowed extensions
Dim strHKExtension 'single extension key name
Dim arAllowedToolbars() 'allowed toolbars
Dim strHKToolbar 'single toolbar value name
Dim arHKCUTbSK() 'HKCU toolbar sub-keys
Dim strSKName 'single toolbar subkey name
Dim arSKValName() 'toolbar sub-key value names
Dim arHKToolbarVals() 'toolbar value names
Dim flagTBTLW : flagTBTLW = False 'toolbar title lines
'Toolbars
strSubTitle = "Toolbars"
ReDim arAllowedToolbars(4) 'must be in upper case!
arAllowedToolbars(0) = "{01E04581-4EEE-11D0-BFE9-00AA005B4383}" '&Address
arAllowedToolbars(1) = "{0E5CBF21-D15F-11D0-8301-00AA005B4383}" '&Links
arAllowedToolbars(2) = "{1E796980-9CC5-11D1-A83F-00C04FC99D61}" 'displayed toolbar buttons (non-CLSID)
arAllowedToolbars(3) = "{710EB7A1-45ED-11D0-924A-0020AFC7AC4D}" 'unknown default (non-CLSID)
arAllowedToolbars(4) = "{8E718888-423F-11D2-876E-00A0C9082467}" '... &Radio
strKey = "Software\Microsoft\Internet Explorer\Toolbar"
'for HKCU & HKLM hives
For i = 0 To 1
strSubSubTitle = arHives(i,0) & "\" & strKey & "\"
'get toolbar key values
oReg.EnumValues arHives(i,1),strKey,arHKToolbarVals,arType
'if values exist
If IsArray(arHKToolbarVals) Then
'for each value
For Each strCLSID in arHKToolbarVals
'change to UCase
strCLSID = Trim(UCase(strCLSID))
'assume not on allowed list
flagAllow = False
'is Toolbar on allowed list?
For j = 0 To UBound(arAllowedToolbars)
If arAllowedToolbars(j) = UCase(strCLSID) Then
flagAllow = True : Exit For 'toggle allowed flag
End If
Next
'if not allowed Or ShowAll
If Not flagAllow Or flagShowAll Then
ResolveCLSID arHives(i,1), strKey, strCLSID, strCLSIDTitle, strIPSDLL
If strIPSDLL <> "" Then 'IPS exists?
'output toolbar CLSID value name
If strSubSubTitle <> "" Then
TitleLineWrite : oFN.WriteLine Chr(34) & strCLSID & Chr(34) &_
" = " & strCLSIDTitle
Else
oFN.WriteLine vbCRLF & Chr(34) & strCLSID & Chr(34) & " = " &_
strCLSIDTitle
End If
'output InProcServer32 value
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " &_
Chr(34) & strIPSDLL & Chr(34) & CoName(IDExe(strIPSDLL))
End If 'strIPSDLL <> ""?
End If 'flagAllow Or ShowAll?
Next 'HKCU/HKLM toolbar key value
End If 'toolbar key has values
'for HKCU Toolbar key only
If arHives(i,0) = "HKCU" Then
'get HKCU toolbar subkeys
oReg.EnumKey HKCU,strKey,arHKCUTbSK
'if key array exists
If IsArray(arHKCUTbSK) Then
'for each sub-key
For Each strSKName in arHKCUTbSK
strSubSubTitle = "HKCU\" & strKey & "\" & strSKName & "\"
'if one of three targeted sub-keys
If LCase(strSKName) = "explorer" Or LCase(strSKName) = "shellbrowser" Or _
LCase(strSKName) = "webbrowser" Then
'get toolbar subkey values
oReg.EnumValues HKCU,strKey & "\" & strSKName,arSKValName,arType
'if array of values exists
If IsArray(arSKValName) Then
'for each value
For Each strValue in arSKValName
'assume not on allowed list
flagAllow = False
'is Toolbar on allowed list?
For j = 0 To UBound(arAllowedToolbars)
If arAllowedToolbars(j) = UCase(strValue) Then
flagAllow = True : Exit For 'toggle allowed flag
End If
Next
'if not allowed Or ShowAll
If Not flagAllow Or flagShowAll Then
ResolveCLSID HKCU,strKey & "\" & strSKName,strValue,strValue2,strValue1
'if InProcServer32 value exists
If strValue1 <> "" Then
'output toolbar CLSID
If strSubSubTitle <> "" Then
TitleLineWrite : oFN.WriteLine Chr(34) & strValue & Chr(34) &_
" = " & strValue2
Else
oFN.WriteLine vbCRLF & Chr(34) & strValue & Chr(34) &_
" = " & strValue2
End If
'output InProcServer32 value
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " &_
StringFilter(strValue1,True) & CoName(IDExe(strValue1))
End If 'IPS exists?
End If 'flagAllow Or ShowAll?
Next 'strValue
End If 'IsArray(arSKValName)?
End If 'targeted sub-key
Next 'toolbar sub-key
End If 'toolbar sub-key array exists
End If 'HKCU hive?
'if ShowAll, output title lines if not already done
If flagShowAll Then TitleLineWrite
Next 'hive
'Explorer Bars
strSubTitle = "Explorer Bars"
ReDim arAllowedExplorerBars(7) 'must be in upper case!
arAllowedExplorerBars(0) = "{30D02401-6A81-11D0-8274-00C04FD5AE38}" 'Search Band
arAllowedExplorerBars(1) = "{32683183-48A0-441B-A342-7C2A440A9478}" 'Media Band
arAllowedExplorerBars(2) = "{4D5C8C25-D075-11D0-B416-00C04FB90376}" '&Tip of the Day
arAllowedExplorerBars(3) = "{BDEADE7F-C265-11D0-BCED-00A0C90AB50F}" '&Discuss
arAllowedExplorerBars(4) = "{C4EE31F3-4768-11D2-BE5C-00A0C9A83DA1}" 'File and Folders Search ActiveX Control
arAllowedExplorerBars(5) = "{EFA24E61-B078-11D0-89E4-00C04FC9E26E}" 'Favorites Band
arAllowedExplorerBars(6) = "{EFA24E62-B078-11D0-89E4-00C04FC9E26E}" 'History Band
arAllowedExplorerBars(7) = "{EFA24E64-B078-11D0-89E4-00C04FC9E26E}" 'Explorer Band
strKey = "Software\Microsoft\Internet Explorer\Explorer Bars"
'for HKCU & HKLM hives
For i = 0 To 1
strSubSubTitle = arHives(i,0) & "\" & strKey & "\"
'get explorer bar subkeys
oReg.EnumKey arHives(i,1),strKey,arHKExplorerBars
'if subkeys exist
If IsArray(arHKExplorerBars) Then
'for each subkey
For Each strHKExplorerBar in arHKExplorerBars
'convert subkey name (CLSID) to uppercase
strHKExplorerBar= UCase(strHKExplorerBar)
'assume not on allowed list
flagAllow = False
'add to ListedExplorerBars array
ReDim Preserve arListedExplorerBars(cntExplorerBars)
arListedExplorerBars(cntExplorerBars) = strHKExplorerBar
cntExplorerBars = cntExplorerBars + 1 'cnt = UBound + 1
'is Explorer Bar on allowed list?
For j = 0 To UBound(arAllowedExplorerBars)
If arAllowedExplorerBars(j) = UCase(strHKExplorerBar) Then
flagAllow = True : Exit For 'toggle allowed flag
End If
Next
'if not allowed Or ShowAll
If Not flagAllow Or flagShowAll Then
ResolveCLSID arHives(i,1), "", strHKExplorerBar, strValue2, strValue1
'if InProcServer32 value exists
If strValue1 <> "" Then
'output explorer bar CLSID
If strSubSubTitle <> "" Then
TitleLineWrite : oFN.WriteLine strHKExplorerBar & "\" & " = " &_
strValue2
Else
oFN.WriteLine vbCRLF & strHKExplorerBar & "\" & " = " &_
strValue2
End If
'output InProcServer32 value
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " &_
Chr(34) & strValue1 & Chr(34) & CoName(IDExe(strValue1))
End If 'IPS exists?
End If 'not on allowed list Or ShowAll
Next 'HKCU/HKLM explorer bar subkey
End If 'explorer bar key has subkeys
'if ShowAll, output sub-title lines if not already done
If flagShowAll Then TitleLineWrite
Next 'hive
If flagShowAll Or flagSupp Then
'check CLSIDs for dormant (!) Explorer Bars
Dim datDEBStart : datDEBStart = Now
strKey = "Software\Classes\CLSID"
strSubSubTitle = "Dormant Explorer Bars in " & Chr(34) &_
"View, Explorer Bar" & Chr(34) & " menu"
'get CLSIDs
oReg.EnumKey HKLM,strKey,arCLSIDKeys
If IsArray(arCLSIDKeys) Then
'for each CLSID
For Each strCLSIDKey in arCLSIDKeys
'convert to uppercase
strCLSIDKey = UCase(strCLSIDKey)
'look for Implemented Categories subkeys
intErrNum = oReg.EnumKey (HKLM,strKey & "\" & strCLSIDKey &_
"\Implemented Categories",arCLSIDImpCatSubKey)
'if Implemented Categories subkeys exist
If intErrNum = 0 And IsArray(arCLSIDImpCatSubKey) Then
'for each Implemented Categories subkey
For Each strImpCatSubKey in arCLSIDImpCatSubKey
'convert to uppercase
strImpCatSubKey = UCase(strImpCatSubKey)
'if subkey name is vertical or horizontal explorer bar
If strImpCatSubKey = "{00021494-0000-0000-C000-000000000046}" Or _
strImpCatSubKey = "{00021493-0000-0000-C000-000000000046}" Then
flagFound = False 'assume CLSID is not listed in HKCU/HKLM explorer bars
If IsArray(arListedExplorerBars) Then
'search explorer bar array for CLSID
For Each strArMember in arListedExplorerBars
If strArMember = strCLSIDKey Then
flagFound = True : Exit For
End If
Next
End If 'IsArray(arListedExplorerBars)?
'if CLSID not listed
If Not flagFound Then
'assume not allowed
flagAllow = False
'see if on allowed list
For j = 0 To UBound(arAllowedExplorerBars)
If arAllowedExplorerBars(j) = UCase(strCLSIDKey) Then
flagAllow = True : Exit For
End If
Next
'if not allowed Or ShowAll
If Not flagAllow Or flagShowAll Then
'look for InProcServer32
intErrNum3 = oReg.GetExpandedStringValue(HKLM,"Software\Classes\CLSID\" &_
strCLSIDKey & "\InProcServer32","",strValue3)
'if InProcServer32 value exists
If intErrNum3 = 0 And strValue3 <> "" Then
'get CLSID title
oReg.GetStringValue HKLM,"Software\Classes\CLSID\" &_
strCLSIDKey,"",strValue4
TitleLineWrite
'output CLSID + title, prepare output string,
'output Implemented Categories key, InProcServer32
If strValue4 <> "" Then
oFN.WriteLine vbCRLF & "HKLM\Software\Classes\CLSID\" &_
strCLSIDKey & "\ = " & StringFilter(strValue4,True)
Else
oFN.WriteLine vbCRLF & "HKLM\Software\Classes\CLSID\" &_
strCLSIDKey & "\ = (title not found)"
End If
If Mid(strImpCatSubKey,9,1) = "3" Then
strOut = " [vertical bar]"
Else
strOut = " [horizontal bar]"
End If
oFN.WriteLine "Implemented Categories\" & strImpCatSubKey & "\" & strOut
oFN.WriteLine "InProcServer32\(Default) = " &_
Chr(34) & strvalue3 & Chr(34) & CoName(IDExe(strValue3))
End If 'CLSID InProcServer32 exists?
End If 'CLSID not allowed Or ShowAll?
End If 'CLSID not already found in HKCU/HKLM?
End If 'strImpCatSubKey designates scroll bar?
Next 'arCLSIDImpCatSubKey
End If 'Implemented Categories sub-key exists?
Next 'CLSID sub-key
End If 'CLSID array exists?
'determine -supp seconds used
Dim strDEBTime : strDEBTime = DateDiff("s",datDEBStart,Now) & " seconds"
End If 'flagShowAll Or flagSupp?
'Extensions (Tools menu items, toolbar buttons)
strSubTitle = "Extensions (Tools menu items, main toolbar menu buttons)"
ReDim arAllowedExtensions(4) 'must be in upper case!
arAllowedExtensions(0) = "{438AFBA1-B0CB-11D2-9214-00104B3BCE5F}" '&Document Tree
arAllowedExtensions(1) = "{B06300D0-CCDE-11D2-92D3-0000F87A4A55}" 'Add to R&estricted Zone
arAllowedExtensions(2) = "{BF80219A-CCDD-11D2-92D3-0000F87A4A55}" 'Add to Tr&usted Zone
arAllowedExtensions(3) = "{C95FE080-8F5D-11D2-A20B-00AA003C157A}" 'Show &Related Links
arAllowedExtensions(4) = "{FC09D8A3-C85A-11D2-92D0-0000F87A4A55}" 'Offline
'{FB5F1910-F110-11D2-BB9E-00C04F795683} MSN Messenger Service
strKey = "Software\Microsoft\Internet Explorer\Extensions"
'for HKCU & HKLM hives
For i = 0 To 1
strSubSubTitle = arHives(i,0) & "\" & strKey & "\"
'get extension subkeys
oReg.EnumKey arHives(i,1),strKey,arHKExtensions
'if subkeys exist
If IsArray(arHKExtensions) Then
'for each subkey
For Each strHKExtension in arHKExtensions
If Len(strHKExtension) = 38 And Left(strHKExtension,1) = "{" And _
Right(strHKExtension,1) = "}" Then
'convert subkey name (CLSID) to uppercase
strHKExtension= UCase(strHKExtension)
'assume not on allowed list
flagAllow = False
'is Extension on allowed list?
For j = 0 To UBound(arAllowedExtensions)
If arAllowedExtensions(j) = UCase(strHKExtension) Then
flagAllow = True : Exit For 'toggle allowed flag
End If
Next
'if not allowed Or ShowAll
If Not flagAllow Or flagShowAll Then
'look for ButtonText/MenuText/CLSIDExtension/Exec values
intErrNum1 = oReg.GetStringValue(arHives(i,1),strKey & "\" &_
strHKExtension,"ButtonText",strValue1)
intErrNum2 = oReg.GetStringValue(arHives(i,1),strKey & "\" &_
strHKExtension,"MenuText",strValue2)
intErrNum3 = oReg.GetStringValue(arHives(i,1),strKey & "\" &_
strHKExtension,"CLSIDExtension",strValue3)
intErrNum4 = oReg.GetStringValue(arHives(i,1),strKey &_
"\" & strHKExtension,"Script",strValue4)
intErrNum5 = oReg.GetStringValue(arHives(i,1),strKey &_
"\" & strHKExtension,"Exec",strValue5)
ResolveCLSID arHives(i,1), "", strValue3, strCLSIDTitle, strValue6
If strSubSubTitle <> "" Then
TitleLineWrite : oFN.WriteLine strHKExtension & "\"
Else
oFN.WriteLine vbCRLF & strHKExtension & "\"
End If
'most output is optional (on error, do nothing)
On Error Resume Next
If intErrNum1 = 0 And strValue1 <> "" Then _
oFN.WriteLine Chr(34) & "ButtonText" & Chr(34) & " = " &_
Chr(34) & strValue1 & Chr(34)
If intErrNum2 = 0 And strValue2 <> "" Then _
oFN.WriteLine Chr(34) & "MenuText" & Chr(34) & " = " & Chr(34) &_
strValue2 & Chr(34)
If intErrNum3 = 0 And strValue3 <> "" Then
Err.Clear 'required to reset Err if ButtonText or MenuText missing
oFN.WriteLine Chr(34) & "CLSIDExtension" & Chr(34) & " = " &_
Chr(34) & strValue3 & Chr(34)
If strValue6 <> "" Then oFN.WriteLine " -> {CLSID}\InProcServer32\" &_
"(Default) = " & StringFilter(strValue6,True) & CoName(IDExe(strValue6))
End If 'CLSIDExtension value exists
If intErrNum4 = 0 And strValue4 <> "" Then oFN.WriteLine Chr(34) &_
"Script" & Chr(34) & " = " & Chr(34) & strValue4 & Chr(34) &_
CoName(IDExe(strValue4))
If intErrNum5 = 0 And strValue5 <> "" Then oFN.WriteLine Chr(34) &_
"Exec" & Chr(34) & " = " & Chr(34) & strValue5 & Chr(34) &_
CoName(IDExe(strValue5))
Err.Clear
On Error Goto 0
End If 'flagAllow Or flagAll?
End If 'CLSID format?
Next 'Extension subkey
End If 'Extension subkeys exist
'if ShowAll, output sub-title lines if not already done
If flagShowAll Then TitleLineWrite
Next 'hive
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
'recover array memory
ReDim arCLSIDKeys(0)
ReDim arCLSIDImpCatSubKey(0)
ReDim arExplorerBars(0)
ReDim arAllowedExplorerBars(0)
ReDim arListedExplorerBars(0)
ReDim arHKExtensions(0)
ReDim arAllowedExtensions(0)
ReDim arAllowedToolbars(0)
ReDim arHKCUTbSK(0)
ReDim arSKValName(0)
ReDim arHKToolbarVals(0)
End If 'flagTest?
'XXIII. Internet Explorer URL Prefixes
If Not flagTest Then 'skip if testing
strTitle = "Internet Explorer Address Prefixes:"
'prefix used if bare domain ("microsoft.com") entered into IE address box
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\URL"
strSubTitle = "Prefix for bare domain (" & Chr(34) &_
"domain-name-here.com" & Chr(34) & ")" & vbCRLF & vbCRLF & "HKLM\" &_
strKey & "\Default Prefix\"
'get DefaultPrefix default value
intErrNum = oReg.GetStringValue (HKLM,strKey & "\DefaultPrefix","",strValue)
'assume not infected
strWarn = ""
'value exists and is not empty
If intErrNum = 0 And strValue <> "" Then
'if default value not OK, toggle warning
If Trim(LCase(strValue)) <> "http://" Then strWarn = "HIJACK WARNING! "
If strWarn <> "" Or flagShowAll Then
TitleLineWrite : oFN.Writeline strWarn & "(Default) = " &_
StringFilter(strValue,True)
End If
Else 'value doesn't exist
If flagShowAll Then
TitleLineWrite
oFN.WriteLine "(Default) = (value not set)"
End If
End If 'default value exists?
'prefix used with specific service
'2 x 5 array
Dim arPrefix()
ReDim arPrefix(1,4)
arPrefix(0,0) = "ftp" : arPrefix(1,0) = "ftp://"
arPrefix(0,1) = "gopher" : arPrefix(1,1) = "gopher://"
arPrefix(0,2) = "home" : arPrefix(1,2) = "http://"
arPrefix(0,3) = "mosaic" : arPrefix(1,3) = "http://"
arPrefix(0,4) = "www" : arPrefix(1,4) = "http://"
'find all the names in the key
intErrNum1 = oReg.EnumValues (HKLM, strKey & "\Prefixes", arNames, arType)
strSubTitle = "Prefix for specific service (i.e., " & Chr(34) & "www" &_
Chr(34) & ")" & vbCRLF & vbCRLF & "HKLM\" & strKey & "\Prefixes\"
'enumerate data if present
If intErrNum1 = 0 And IsArray(arNames) Then
'for each name
For Each strName in arNames
'assume infected
flagMatch = False : strWarn = "HIJACK WARNING! "
'for each prefix type
For i = 0 To UBound(arPrefix,2)
'if name = prefix Or name = prefix.
If Trim(LCase(strName)) = arPrefix(0,i) Or _
Trim(LCase(strName)) = arPrefix(0,i) & "." Then
'get value
intErrNum2 = oReg.GetStringValue(HKLM,strKey & "\Prefixes", _
strName,strValue)
'if value exists (exc. for W2K!)
If intErrNum2 = 0 And strValue <> "" Then
'toggle flags if value = default value
If Trim(LCase(strValue)) = arPrefix(1,i) Then
flagMatch = True : strWarn = "" : Exit For
End If 'value = arPrefix member?
End If 'strValue exists And not empty?
End If 'name = arPrefix member?
Next 'arPrefix member
'get value if name not in arPrefix
If Not flagMatch Then oReg.GetStringValue HKLM, _
strKey & "\Prefixes",strName,strValue
'output if flagMatch Or flagShowAll
If Not flagMatch Or flagShowAll Then
TitleLineWrite
On Error Resume Next
'output warning, name, value
oFN.WriteLine strWarn & StringFilter(strName,True) & " = " &_
Chr(34) & strValue & Chr(34)
intErrNum = Err.Number : Err.Clear
'error check for W2K if value not set
If intErrNum <> 0 Then oFN.WriteLine StringFilter(strName,True) &_
" = (value not set)"
On Error Goto 0
End If 'flagMatch or flagShowAll?
Next 'prefix key name array member
If strSubTitle <> "" And flagShowAll Then
TitleLineWrite : oFN.WriteLine "(values not found)"
End If
Else 'prefix key name array doesn't exist
If flagShowAll Then
TitleLineWrite : oFN.WriteLine "(values not found)"
End If
End If 'prefix key name array exists
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
'recover array memory
ReDim arPrefix(0,0)
End If 'flagTest?
'check IERESET.INF integrity, URLSearchHooks, AboutURLs (error pages)
'XXIV. Misc. IE Hijack Points
If Not flagTest Then 'skip if testing
'IERESET Text File, IERESET file name, INF-file section name,
'array of count of missing phrase lines by section
Dim oIERTF, strSection, arSectionCount(), intTFF
Dim intAsc1Chr, intAsc2Chr 'ASCII code of 1st & 2nd chr of IERESET.INF
'zero-based number of sections in phrase array with lines missing from disk file
Public intSectionCount : intSectionCount = -1
'one-based number of lines in each section of phrase array with lines missing from disk file
Public intSectionLineCount : intSectionLineCount = 0
strTitle = "Miscellaneous IE Hijack Points"
strWarn = "HIJACK WARNING! "
'parse IERESET.INF, look for added and missing lines
Dim strIERFN : strIERFN = UCase(strFPWF) & "\INF\IERESET.INF"
'read the IE version from the registry
'IE version reg value, work string
Dim strIELVer, strIELVWK
'short string version, non-numeric if dec symbol not "."
Dim strIEShVer : strIEShVer = "0"
'numeric IE version: 0 if IE version not in registry or value not set
'otherwise, number using single local dec symbol
Dim intIELVer : intIELVer = 0
Dim strDecSym : strDecSym = "." 'dec symbol
strKey = "Software\Microsoft\Internet Explorer"
intErrNum = oReg.GetStringValue(HKLM,strKey,"Version",strIELVer)
strSubTitle = "HKLM\" & strKey & "\Version = " & strIELVer
strSubSubTitle = strIERFN & " (used to " & Chr(34) & "Reset Web " &_
"Settings" & Chr(34) & ")"
'in W2K, if value not set, strIELVer will be garbage
If intErrNum = 0 And Len(Trim(strIELVer)) > 3 Then
'read the decimal symbol from the registry
strKey1 = "Control Panel\International"
intErrNum1 = oReg.GetStringValue(HKCU,strKey1,"sDecimal",strValue1)
'if the symbol exists, store it
If intErrNum1 = 0 And strValue1 <> "" Then strDecSym = strValue1
'replace 1st dec pt in the IE ver with XXX
strIELVWK = Replace (Trim(strIELVer),".","XXX",1,1,1)
'delete all succeeding dec pts
strIELVWK = Replace (Trim(strIELVWK),".","",1,-1,1)
'restore dec symbol to pos'n of first dec pt and call it an integer
intIELVer = Replace (Trim(strIELVWK),"XXX",strDecSym,1,1,1)
If IsNumeric(intIELVer) Then 'should exclude W2K value not set garbage
strIEShVer = Left(LTrim(strIELVer),3)
If strIEShVer <> "5.5" Then 'for 5.5, retain 3 chrs
'use left-most chr
strIEShVer = Left(LTrim(strIELVer),1)
'if IE ver < 5, advise that INF file doesn't exist
If intIELVer < 5 Then
TitleLineWrite
oFN.WriteLine vbCRLF & "IERESET.INF does not exist for this Internet " &_
"Explorer version."
End If 'intIELVer<5?
End If 'strIEShVer=5.5?
Else 'intIELVer not numeric, so advise about bad IE version and reset to 0
strSubTitle = "HKLM\" & strKey & "\Version = (invalid data)" &_
vbCRLF & "The Internet Explorer version cannot be found!"
TitleLineWrite
oFN.WriteLine "The contents of IERESET.INF cannot be reliably checked!"
intIELVer = 0
End If 'intIELVer numeric?
Else 'IE ver not found or value corrupt
strSubTitle = "HKLM\" & strKey & "\Version = (invalid data)" &_
vbCRLF & "The Internet Explorer version cannot be found!"
TitleLineWrite
oFN.WriteLine "The contents of IERESET.INF cannot be reliably checked!"
End If 'IE ver exists?
'change titles if not already written
If strTitle <> "" Then
strSubTitle = strIERFN & " (used to " & Chr(34) & "Reset Web Settings" &_
Chr(34) & ")"
strSubSubTitle = ""
End If
Dim arIER() 'common IERESET.INF lines & phrases
ReDim arIER(31,2) 'section, phrase, found-in-file-on-disk?
arIER(0,0)="[Version]" : arIER(0,1)="Signature=""$CHICAGO$"""
arIER(1,0)="[Version]" : arIER(1,1)="AdvancedINF=2.5,""You need a new version of advpack.dll"""
arIER(2,0)="[RestoreHomePage]" : arIER(2,1)="AddReg=RestoreHomePage.reg"
arIER(3,0)="[RestoreHomePage.reg]" : arIER(3,1)="HKCU,""Software\Microsoft\Internet Explorer\Main"",""Start Page"",0,%START_PAGE_URL%"
arIER(4,0)="[RestoreBrowserSettings.reg]" : arIER(4,1)="HKLM,""Software\Microsoft\Internet Explorer\Main"",""Default_Page_URL"",0,%START_PAGE_URL%"
arIER(5,0)="[RestoreBrowserSettings.reg]" : arIER(5,1)="HKLM,""Software\Microsoft\Internet Explorer\Main"",""Default_Search_URL"",0,%SEARCH_PAGE_URL%"
arIER(6,0)="[RestoreBrowserSettings.reg]" : arIER(6,1)="HKLM,""Software\Microsoft\Internet Explorer\Main"",""Search Page"",0,%SEARCH_PAGE_URL%"
arIER(7,0)="[RestoreBrowserSettings.reg]" : arIER(7,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""1"",0,""www.%s.com"""
arIER(8,0)="[RestoreBrowserSettings.reg]" : arIER(8,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""2"",0,""www.%s.org"""
arIER(9,0)="[RestoreBrowserSettings.reg]" : arIER(9,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""3"",0,""www.%s.net"""
arIER(10,0)="[RestoreBrowserSettings.reg]" : arIER(10,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""4"",0,""www.%s.edu"""
arIER(11,0)="[RestoreBrowserSettings.reg]" : arIER(11,1)="HKCU,""Software\Microsoft\Internet Explorer\Main"",""Search Page"",0,%SEARCH_PAGE_URL%"
arIER(12,0)="[RestoreBrowserSettings.reg]" : arIER(12,1)="HKCU,""Software\Microsoft\Internet Explorer\SearchUrl"",""Provider"",0,"""""
arIER(13,0)="[RestoreBrowserSettings.reg]" : arIER(13,1)="HKLM,""Software\Microsoft\Internet Explorer\Search"",""SearchAssistant"",0,""http://ie.search.msn.com/{SUB_RFC1766}/srchasst/srchasst.htm"""
arIER(14,0)="[RestoreBrowserSettings.reg]" : arIER(14,1)="HKLM,""Software\Microsoft\Internet Explorer\Search"",""CustomizeSearch"",0,""http://ie.search.msn.com/{SUB_RFC1766}/srchasst/srchcust.htm"""
arIER(15,0)="[RestoreBrowserSettings.reg]" : arIER(15,1)="HKLM,""Software\Microsoft\Windows\CurrentVersion\Internet Settings\SafeSites"",%SAFESITE_VALUE%,0,""http://ie.search.msn.com/*"""
arIER(16,0)="[DeleteTemplates.reg]" : arIER(16,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""5"""
arIER(17,0)="[DeleteTemplates.reg]" : arIER(17,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""6"""
arIER(18,0)="[DeleteTemplates.reg]" : arIER(18,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""7"""
arIER(19,0)="[DeleteTemplates.reg]" : arIER(19,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""8"""
arIER(20,0)="[DeleteTemplates.reg]" : arIER(20,1)="HKLM,""Software\Microsoft\Internet Explorer\Main\UrlTemplate"",""9"""
arIER(21,0)="[DeleteAutosearch.reg]" : arIER(21,1)="HKCU,""Software\Microsoft\Internet Explorer\Main"",""AutoSearch"""
arIER(22,0)="[Strings]" : arIER(22,1)="SEARCH_PAGE_URL=""http://www.microsoft.com/isapi/redir.dll?prd=ie&ar=iesearch"""
arIER(23,0)="[RestoreBrowserSettings]" : arIER(23,1)="AddReg=RestoreBrowserSettings.reg"
arIER(24,0)="[RestoreBrowserSettings]" : arIER(24,1)="DelReg=DeleteTemplates.reg"
arIER(25,0)="[RestoreBrowserSettings]" : arIER(25,1)="DelReg=DeleteTemplates.reg, DeleteAutosearch.reg"
arIER(26,0)="[Strings]" : arIER(26,1)="START_PAGE_URL=""http://www.microsoft.com/isapi/redir.dll?prd=ie&pver=" & strIEShVer & "&ar=msnhome"""
arIER(27,0)="[Strings]" : arIER(27,1)="START_PAGE_URL=""http://www.msn.com"""
arIER(28,0)="[Strings]" : arIER(28,1)="SAFESITE_VALUE=""http://home.microsoft.com/"""
arIER(29,0)="[Strings]" : arIER(29,1)="SAFESITE_VALUE=""ie.search.msn.com"""
arIER(30,0)="[Strings]" : arIER(30,1)="MS_START_PAGE_URL=""http://www.microsoft.com/isapi/redir.dll?prd=ie&pver=" & strIEShVer & "&ar=msnhome"""
arIER(31,0)="[Strings]" : arIER(31,1)="MS_START_PAGE_URL=""http://www.msn.com"""
'set found-in-file-on-disk flag to False
For i = 0 To UBound(arIER,1) : arIER(i,2) = False : Next
'if IERESET.INF exists
If Fso.FileExists(strIERFN) Then
'open the file for reading/don't create/ASCII format
Set oIERTF = Fso.OpenTextFile (strIERFN,1,False,0)
'get the file size
Dim intFileSize : intFileSize = Fso.GetFile(strIERFN).Size
If intFileSize > 100 Then
'read 1st 2 chrs, find Asc code (not AscW code)
intAsc1Chr = Asc(oIERTF.Read(1)) : intAsc2Chr = Asc(oIERTF.Read(1))
oIERTF.Close
'if Asc codes = 255 & 254, file is Unicode
'ASCII file read as Unicode: 1st Unicode line is entire file
'Unicode file read as ASCII: 1st ASCII line is variable length
'TriStateDefault appears to distinguish between ASCII & Unicode on file open
'VBS internally allots 2 bytes per ASCII chr
intTFF = 0 'ASCII fmt
If intAsc1Chr = 255 And intAsc2Chr = 254 Then intTFF = -1 'Unicode fmt
Set oIERTF = Fso.OpenTextFile (strIERFN,1,False,intTFF)
strSubSubTitle = "Added lines (compared with English-language version):"
flagInfect = False
'for each line
Do Until oIERTF.AtEndOfStream
strLine = Trim(oIERTF.ReadLine) 'read a line
flagMatch = False 'line doesn't match phrase array
'if line not empty And not a comment
If Len(strLine) > 0 And Left(strLine,1) <> ";" Then
If Left(strLine,1) = "[" Then 'if line is section title
strSection = strLine 'save the section name
Else 'line not a section title, so it's a data line
For i = 0 To UBound(arIER,1) 'for every line in phrase array
'if section's identical and phrase found in line,
'toggle line match flag & found-in-file-on-disk flag
If LCase(arIER(i,0)) = LCase(strSection) And _
LCase(strLine) = LCase(arIER(i,1)) Then
flagMatch = True : arIER(i,2) = True : Exit For
Exit For
End If
Next
If Not flagMatch Then 'if line not matched
flagInfect = True
TitleLineWrite
On Error Resume Next
'output section name & line
oFN.WriteLine strSection & ": " & strLine
intErrNum = Err.Number : Err.Clear
On Error Goto 0
If intErrNum <> 0 Then oFN.WriteLine "(unwritable string)"
End If 'line matched?
End If 'section title line?
End If 'data line?
Loop 'next file line
'close IERESET.INf
oIERTF.Close : Set oIERTF=Nothing
'initialize section title for phrases missing from file
strSection = ""
strSubSubTitle = "Missing lines (compared with English-language version):"
flagFound = True 'False if found-in-file-on-disk = False
For i = 0 To 23 'for single-option phrases
If Not arIER(i,2) Then
flagFound = False : flagInfect = True 'toggle flags
'increment counters
IERESETCounter strSection, arIER(i,0), arSectionCount
End If
Next 'single-option phrase
'check double-option phrases
For i = 24 To 30 Step 2
'if neither option found-in-file-on-disk
If Not arIER(i,2) And Not arIER(i+1,2) Then
flagFound = False : flagInfect = True 'toggle flags
'increment counters
IERESETCounter strSection, arIER(i,0), arSectionCount
End If
Next 'double-option phrase
If Not flagFound Then 'if lines missing
TitleLineWrite
'output contents of arSectionCount (section title: # missing lines)
For i = 0 To UBound(arSectionCount,2)
strOut = " line"
If arSectionCount(1,i) > 1 Then strOut = " lines"
oFN.WriteLine arSectionCount(0,i) & ": " & arSectionCount(1,i) & strOut
Next
End If 'lines missing?
If strTitle <> "" And flagShowAll Then
strSubTitle = strIERFN & " (used to " & Chr(34) &_
"Reset Web Settings" & Chr(34) & " -- no anomalies found)"
strSubSubTitle = "" : TitleLineWrite
End If
Else 'IERESET.INF<100 bytes
oIERTF.Close
'file should always exist if IE ver > 5 Or if in one of these OS's
If intIELVer > 5 Or strOS = "WXP" Or strOS = "W2K" Or strOS = "WME" Then
TitleLineWrite
oFN.WriteLine strWarn & strIERFN & " is *much* too small and is " &_
"probably corrupt!"
End If 'should file exist?
End If 'IERSET.INF>100 bytes?
Else 'IERESET.INF not found
'file should always exist if IE ver > 5 Or if in one of these OS's
If intIELVer > 5 Or strOS = "WXP" Or strOS = "W2K" Or strOS = "WME" Then
TitleLineWrite
oFN.WriteLine strWarn & strIERFN & " was not found!"
End If 'should file exist?
End If 'IERESET.INF found?
'URLSearchHooks
strKey = "Software\Microsoft\Internet Explorer\URLSearchHooks"
strSubTitle = "HKCU\" & strKey & "\"
intErrNum = oReg.EnumValues (HKCU, strKey, arNames, arType)
If IsArray(arNames) Then
For Each strCLSID In arNames
If strCLSID <> "{CFBFAE00-17A6-11D0-99CB-00C04FD64497}" Or _
flagShowAll Then
ResolveCLSID HKCU, strKey, strCLSID, strOut, strIPSDLL
If strIPSDLL <> "" Then
strWarn = ""
If strCLSID <> "{CFBFAE00-17A6-11D0-99CB-00C04FD64497}" Then _
strWarn = "HIJACK WARNING! "
TitleLineWrite
oFN.WriteLine Chr(34) & strCLSID & Chr(34) & " = " & strOut
oFN.WriteLine " -> {CLSID}\InProcServer32\(Default) = " &_
StringFilter(strIPSDLL,True) & CoName(IDExe(strIPSDLL))
End If 'IPS exists?
End If 'match Or flagShowAll?
Next 'strCLSID
Else
If flagShowAll Then
TitleLineWrite
oFN.WriteLine "(URLSearchHooks key not found!)"
End If
End If 'IsArray?
'AboutURLs
strKey = "Software\Microsoft\Internet Explorer\AboutURLs"
strSubTitle = "HKLM\" & strKey & "\"
EnumNVP HKLM, strKey, arNames, arType
If flagNVP Then 'name/value pairs exist
Set arSK = CreateObject("Scripting.Dictionary") 'key, item
'add dictionary pairs (universal elements)
arSK.Add "blank", "res://mshtml.dll/blank.htm"
arSK.Add "Home", "270"
arSK.Add "mozilla", "res://mshtml.dll/about.moz"
arSK.Add "PostNotCached", "res://mshtml.dll/repost.htm"
'value not set or IE 5-6
If intIELVer = 0 Or intIELVer >= 5 Then
arSK.Add "DesktopItemNavigationFailure", "res://shdoclc.dll/navcancl.htm"
arSK.Add "NavigationCanceled", "res://shdoclc.dll/navcancl.htm"
arSK.Add "NavigationFailure", "res://shdoclc.dll/navcancl.htm"
arSK.Add "OfflineInformation", "res://shdoclc.dll/offcancl.htm"
Else 'IE < 5
arSK.Add "DesktopItemNavigationFailure", "res://shdocvw.dll/navcancl.htm"
arSK.Add "NavigationCanceled", "res://shdocvw.dll/navcancl.htm"
arSK.Add "NavigationFailure", "res://shdocvw.dll/navcancl.htm"
arSK.Add "OfflineInformation", "res://shdocvw.dll/offcancl.htm"
End If 'IE>5?
arSKk = arSK.Keys : arSKi = arSK.Items
For i = 0 To UBound(arNames)
strWarn = "HIJACK WARNING! "
'use the type to find the value
strValue = RtnValue (HKLM, strKey, arNames(i), arType(i))
For j = 0 To arSK.Count-1
flagFound = False
If LCase(arNames(i)) = LCase(arSKk(j)) And _
LCase(strValue) = LCase(arSKi(j)) Then
flagFound = True : strWarn = "" : Exit For
End If
Next 'dictionary pair
If Not flagFound Or flagShowAll Then
TitleLineWrite
WriteValueData arNames(i), strValue, arType(i), strWarn
End If
Next 'arNames member
arSK.RemoveAll : Set arSK=Nothing 'recover dictionary memory
Else
If flagShowAll Then
TitleLineWrite
oFN.WriteLine "(AboutURLs key not found!)"
End If
End If 'flagNVP?
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
End If 'flagTest?
'XXV. Examine HOSTS file
If Not flagTest Then 'skip if testing
'left-trimmed HOSTS line, IP address, HOSTS Path, tab pos'n
Dim strLineWk, strIP, strHP, intTabPosn
Dim intWSPosn : intWSPosn = 0 'white space posn
Dim intMapCtr : intMapCtr = 0 'map ctr
Dim intNLHMapCtr : intNLHMapCtr = 0 'non-localhost map ctr
'prepare section title
strTitle = "HOSTS file"
'determine HOSTS file location
If strOS <> "W98" And strOS <> "WME" Then
'find HOSTS directory from registry, compare to default value
strKey = "System\CurrentControlSet\Services\Tcpip\Parameters"
intErrNum = oReg.GetExpandedStringValue (HKLM,strKey,"DataBasePath",strValue)
strTmp = Trim(strValue) 'trim it
'lop off trailing backslash
If Right(strTmp,1) = "\" Then strTmp = Left(strTmp,Len(strTmp)-1)
'set HOSTS location from registry value
strHP = strTmp & "\HOSTS"
'if registry value exists
If intErrNum = 0 And strValue <> "" Then
'output warning if not identical to default value
strWarn = ""
If LCase(strTmp) <> LCase(strFPSF) & "\drivers\etc" Then _
strWarn = "HIJACK WARNING! "
If LCase(strTmp) <> LCase(strFPSF) & "\drivers\etc" Or flagShowAll Then
TitleLineWrite
oFN.WriteLine vbCRLF & "HKLM\" & strKey & "\" & vbCRLF & strWarn &_
Chr(34) & "DataBasePath" & Chr(34) & " = " & Chr(34) & strValue &_
Chr(34)
End If 'value <> default?
Else 'registry value doesn't exist
'set HOSTS location to default
strHP = strFPSF & "\Drivers\Etc\HOSTS"
End If 'HOSTS directory registry value exists?
Else 'W98/WME
strHP = strFPWF & "\HOSTS"
End If 'O/S?
'if HOSTS exists
If Fso.FileExists(strHP) Then
'open it for reading
Set oSCF = Fso.OpenTextFile (strHP,1)
Do While Not oSCF.AtEndOfStream
'read a line
strLine = oSCF.ReadLine
strLineWk = Trim(strLine) 'trim the line
'if line not CR And not a comment
If Len(strLineWk) > 0 And InStr(1,strLineWk,"#",1) <> 1 Then
'increment the mapped domain name count
intMapCtr = intMapCtr + 1
'find an interior space/tab
intSpacePosn = InStr(1,strLineWk," ",1)
intTabPosn = InStr(1,strLineWk,Chr(09),1)
If intSpacePosn > 0 Then intWSPosn = intSpacePosn
If intSpacePosn = 0 Or (intTabPosn > 0 And intTabPosn < intSpacePosn) _
Then intWSPosn = intTabPosn
'if a space or tab exists
If intWSPosn > 0 Then
'extract the IP address left of the space
strIP = Left(strLineWk,intWSPosn-1)
'if not localhost, increment the mapped non localhost count
If strIP <> "127.0.0.1" Then
intNLHMapCtr = intNLHMapCtr + 1 : TitleLineWrite
End If
End If 'line has embedded space?
End If 'line not CR/comment?
Loop 'read another line
oSCF.Close : Set oSCF=Nothing
'output if more than one IP mapped Or any IP mapped to non-localhost
'Or ShowAll
If (intMapCtr >= 1 And intNLHMapCtr > 0) Or flagShowAll Then
'set up output strings
'total number of mappings
If intMapCtr = 0 Then 'none
strOut1 = "maps: no domain names to IP addresses"
ElseIf intMapCtr = 1 Then 'one
strOut1 = "maps: 1 domain name to an IP address," & vbCRLF
Else '> 1
strOut1 = "maps: " & intMapCtr &_
" domain names to IP addresses," & vbCRLF
End If
'non-localhost mappings
If intNLHMapCtr = 0 Then 'none
If intMapCtr = 0 Then 'no maps found
strOut2 = ""
ElseIf intMapCtr = 1 Then 'one map found
strOut2 = Space(6) & "and this is the localhost IP address"
Else
strOut2 = Space(6) & "and all are the localhost IP address" '> 1 map found
End If
ElseIf intNLHMapCtr = 1 Then 'one
strOut2 = Space(6) & "1 of the IP addresses is *not* localhost!"
Else '> 1
strOut2 = Space(6) & intNLHMapCtr & " of the IP addresses are *not* localhost!"
End If
'output mapped & non-localhost counts
TitleLineWrite
oFN.WriteLine vbCRLF & strHP & vbCRLF & vbCRLF & strOut1 & strOut2
End If '>= 1 IP mapped And at least 1 IP mapped to non-localhost
Else 'HOSTS doesn't exist
If flagShowAll Then
TitleLineWrite
'say file not found
oFN.WriteLine vbCRLF & strHP & " (file not found)"
End If 'flagShowAll?
End If 'HOSTS exists?
strTitle = "" : strSubTitle = "" : strSubSubTitle = ""
End If 'flagTest?
'XXVI. Enumerate Started or Non-disabled Services
If Not flagTest Then 'skip if testing
'for NT-type O/S's
If strOS <> "W98" And strOS <> "WME" Then
'MS default services array, subscript number in MS default services array
'CoName string
Dim arMSSvc(), intMSSvcNo, strExeName
'set up MS default services array for WXP/W2K/NT4
'service name, service executable, DLL file name for svchost.exe-dependent service
If strOS = "WXP" Then
ReDim arMSSvc(91,2)
arMSSvc(0,0) = "alerter" : arMSSvc(0,1) = "svchost.exe" : arMSSvc(0,2) = "alrsvc.dll"
arMSSvc(1,0) = "alg" : arMSSvc(1,1) = "alg.exe" : arMSSvc(1,2) = ""
arMSSvc(2,0) = "appmgmt" : arMSSvc(2,1) = "svchost.exe" : arMSSvc(2,2) = "appmgmts.dll"
arMSSvc(3,0) = "wuauserv" : arMSSvc(3,1) = "svchost.exe" : arMSSvc(3,2) = "wuauserv.dll"
arMSSvc(4,0) = "bits" : arMSSvc(4,1) = "svchost.exe" : arMSSvc(4,2) = "qmgr.dll"
arMSSvc(5,0) = "clipsrv" : arMSSvc(5,1) = "clipsrv.exe" : arMSSvc(5,2) = ""
arMSSvc(6,0) = "eventsystem" : arMSSvc(6,1) = "svchost.exe" : arMSSvc(6,2) = "es.dll"
arMSSvc(7,0) = "comsysapp" : arMSSvc(7,1) = "dllhost.exe" : arMSSvc(7,2) = ""
arMSSvc(8,0) = "browser" : arMSSvc(8,1) = "svchost.exe" : arMSSvc(8,2) = "browser.dll"
arMSSvc(9,0) = "cryptsvc" : arMSSvc(9,1) = "svchost.exe" : arMSSvc(9,2) = "cryptsvc.dll"
arMSSvc(10,0) = "dhcp" : arMSSvc(10,1) = "svchost.exe" : arMSSvc(10,2) = "dhcpcsvc.dll"
arMSSvc(11,0) = "trkwks" : arMSSvc(11,1) = "svchost.exe" : arMSSvc(11,2) = "trkwks.dll"
arMSSvc(12,0) = "msdtc" : arMSSvc(12,1) = "msdtc.exe" : arMSSvc(12,2) = ""
arMSSvc(13,0) = "dnscache" : arMSSvc(13,1) = "svchost.exe" : arMSSvc(13,2) = "dnsrslvr.dll"
arMSSvc(14,0) = "eventlog" : arMSSvc(14,1) = "services.exe" : arMSSvc(14,2) = ""
arMSSvc(15,0) = "ersvc" : arMSSvc(15,1) = "svchost.exe" : arMSSvc(15,2) = "ersvc.dll"
arMSSvc(16,0) = "fastuserswitchingcompatibility" : arMSSvc(16,1) = "svchost.exe" : arMSSvc(16,2) = "shsvcs.dll"
arMSSvc(17,0) = "helpsvc" : arMSSvc(17,1) = "svchost.exe" : arMSSvc(17,2) = "pchsvc.dll"
arMSSvc(18,0) = "hidserv" : arMSSvc(18,1) = "svchost.exe" : arMSSvc(18,2) = "hidserv.dll"
arMSSvc(19,0) = "imapiservice" : arMSSvc(19,1) = "imapi.exe" : arMSSvc(19,2) = ""
arMSSvc(20,0) = "iisadmin" : arMSSvc(20,1) = "inetinfo.exe" : arMSSvc(20,2) = ""
arMSSvc(21,0) = "cisvc" : arMSSvc(21,1) = "cisvc.exe" : arMSSvc(21,2) = ""
arMSSvc(22,0) = "sharedaccess" : arMSSvc(22,1) = "svchost.exe" : arMSSvc(22,2) = "ipnathlp.dll"
arMSSvc(23,0) = "policyagent" : arMSSvc(23,1) = "lsass.exe" : arMSSvc(23,2) = ""
arMSSvc(24,0) = "dmserver" : arMSSvc(24,1) = "svchost.exe" : arMSSvc(24,2) = "dmserver.dll"
arMSSvc(25,0) = "dmadmin" : arMSSvc(25,1) = "dmadmin.exe" : arMSSvc(25,2) = ""
arMSSvc(26,0) = "messenger" : arMSSvc(26,1) = "svchost.exe" : arMSSvc(26,2) = "msgsvc.dll"
arMSSvc(27,0) = "swprv" : arMSSvc(27,1) = "dllhost.exe" : arMSSvc(27,2) = ""
arMSSvc(28,0) = "netlogon" : arMSSvc(28,1) = "lsass.exe" : arMSSvc(28,2) = ""
arMSSvc(29,0) = "mnmsrvc" : arMSSvc(29,1) = "mnmsrvc.exe" : arMSSvc(29,2) = ""
arMSSvc(30,0) = "netman" : arMSSvc(30,1) = "svchost.exe" : arMSSvc(30,2) = "netman.dll"
arMSSvc(31,0) = "netdde" : arMSSvc(31,1) = "netdde.exe" : arMSSvc(31,2) = ""
arMSSvc(32,0) = "netddedsdm" : arMSSvc(32,1) = "netdde.exe" : arMSSvc(32,2) = ""
arMSSvc(33,0) = "nla" : arMSSvc(33,1) = "svchost.exe" : arMSSvc(33,2) = "mswsock.dll"
arMSSvc(34,0) = "ntlmssp" : arMSSvc(34,1) = "lsass.exe" : arMSSvc(34,2) = ""
arMSSvc(35,0) = "sysmonlog" : arMSSvc(35,1) = "smlogsvc.exe" : arMSSvc(35,2) = ""
arMSSvc(36,0) = "plugplay" : arMSSvc(36,1) = "services.exe" : arMSSvc(36,2) = ""
arMSSvc(37,0) = "wmdmpmsp" : arMSSvc(37,1) = "svchost.exe" : arMSSvc(37,2) = "mspmspsv.dll"
arMSSvc(38,0) = "spooler" : arMSSvc(38,1) = "spoolsv.exe" : arMSSvc(38,2) = ""
arMSSvc(39,0) = "protectedstorage" : arMSSvc(39,1) = "lsass.exe" : arMSSvc(39,2) = ""
arMSSvc(40,0) = "rsvp" : arMSSvc(40,1) = "rsvp.exe" : arMSSvc(40,2) = ""
arMSSvc(41,0) = "rasauto" : arMSSvc(41,1) = "svchost.exe" : arMSSvc(41,2) = "rasauto.dll"
arMSSvc(42,0) = "rasman" : arMSSvc(42,1) = "svchost.exe" : arMSSvc(42,2) = "rasmans.dll"
arMSSvc(43,0) = "rdsessmgr" : arMSSvc(43,1) = "sessmgr.exe" : arMSSvc(43,2) = ""
arMSSvc(44,0) = "rpcss" : arMSSvc(44,1) = "svchost.exe" : arMSSvc(44,2) = "rpcss.dll"
arMSSvc(45,0) = "rpclocator" : arMSSvc(45,1) = "locator.exe" : arMSSvc(45,2) = ""
arMSSvc(46,0) = "remoteregistry" : arMSSvc(46,1) = "svchost.exe" : arMSSvc(46,2) = "regsvc.dll"
arMSSvc(47,0) = "ntmssvc" : arMSSvc(47,1) = "svchost.exe" : arMSSvc(47,2) = "ntmssvc.dll"
arMSSvc(48,0) = "remoteaccess" : arMSSvc(48,1) = "svchost.exe" : arMSSvc(48,2) = "mprdim.dll"
arMSSvc(49,0) = "seclogon" : arMSSvc(49,1) = "svchost.exe" : arMSSvc(49,2) = "seclogon.dll"
arMSSvc(50,0) = "samss" : arMSSvc(50,1) = "lsass.exe" : arMSSvc(50,2) = ""
arMSSvc(51,0) = "lanmanserver" : arMSSvc(51,1) = "svchost.exe" : arMSSvc(51,2) = "srvsvc.dll"
arMSSvc(52,0) = "smtpsvc" : arMSSvc(52,1) = "inetinfo.exe" : arMSSvc(52,2) = ""
arMSSvc(53,0) = "shellhwdetection" : arMSSvc(53,1) = "svchost.exe" : arMSSvc(53,2) = "shsvcs.dll"
arMSSvc(54,0) = "scardsvr" : arMSSvc(54,1) = "scardsvr.exe" : arMSSvc(54,2) = ""
arMSSvc(55,0) = "scarddrv" : arMSSvc(55,1) = "scardsvr.exe" : arMSSvc(55,2) = ""
arMSSvc(56,0) = "ssdpsrv" : arMSSvc(56,1) = "svchost.exe" : arMSSvc(56,2) = "ssdpsrv.dll"
arMSSvc(57,0) = "sens" : arMSSvc(57,1) = "svchost.exe" : arMSSvc(57,2) = "sens.dll"
arMSSvc(58,0) = "srservice" : arMSSvc(58,1) = "svchost.exe" : arMSSvc(58,2) = "srsvc.dll"
arMSSvc(59,0) = "schedule" : arMSSvc(59,1) = "svchost.exe" : arMSSvc(59,2) = "schedsvc.dll"
arMSSvc(60,0) = "lmhosts" : arMSSvc(60,1) = "svchost.exe" : arMSSvc(60,2) = "lmhsvc.dll"
arMSSvc(61,0) = "tapisrv" : arMSSvc(61,1) = "svchost.exe" : arMSSvc(61,2) = "tapisrv.dll"
arMSSvc(62,0) = "tlntsvr" : arMSSvc(62,1) = "tlntsvr.exe" : arMSSvc(62,2) = ""
arMSSvc(63,0) = "termservice" : arMSSvc(63,1) = "svchost.exe" : arMSSvc(63,2) = "termsrv.dll"
arMSSvc(64,0) = "themes" : arMSSvc(64,1) = "svchost.exe" : arMSSvc(64,2) = "shsvcs.dll"
arMSSvc(65,0) = "ups" : arMSSvc(65,1) = "ups.exe" : arMSSvc(65,2) = ""
arMSSvc(66,0) = "upnphost" : arMSSvc(66,1) = "svchost.exe" : arMSSvc(66,2) = "upnphost.dll"
arMSSvc(67,0) = "uploadmgr" : arMSSvc(67,1) = "svchost.exe" : arMSSvc(67,2) = "pchsvc.dll"
arMSSvc(68,0) = "vss" : arMSSvc(68,1) = "vssvc.exe" : arMSSvc(68,2) = ""
arMSSvc(69,0) = "webclient" : arMSSvc(69,1) = "svchost.exe" : arMSSvc(69,2) = "webclnt.dll"
arMSSvc(70,0) = "audiosrv" : arMSSvc(70,1) = "svchost.exe" : arMSSvc(70,2) = "audiosrv.dll"
arMSSvc(71,0) = "stisvc" : arMSSvc(71,1) = "svchost.exe" : arMSSvc(71,2) = "wiaservc.dll"
arMSSvc(72,0) = "msiserver" : arMSSvc(72,1) = "msiexec.exe" : arMSSvc(72,2) = ""
arMSSvc(73,0) = "winmgmt" : arMSSvc(73,1) = "svchost.exe" : arMSSvc(73,2) = "wmisvc.dll"
arMSSvc(74,0) = "wmi" : arMSSvc(74,1) = "svchost.exe" : arMSSvc(74,2) = "advapi32.dll"
arMSSvc(75,0) = "w32time" : arMSSvc(75,1) = "svchost.exe" : arMSSvc(75,2) = "w32time.dll"
arMSSvc(76,0) = "wzcsvc" : arMSSvc(76,1) = "svchost.exe" : arMSSvc(76,2) = "wzcsvc.dll"
arMSSvc(77,0) = "wmiapsrv" : arMSSvc(77,1) = "svchost.exe" : arMSSvc(77,2) = "wmiapsrv.dll"
arMSSvc(78,0) = "lanmanworkstation" : arMSSvc(78,1) = "svchost.exe" : arMSSvc(78,2) = "wkssvc.dll"
arMSSvc(79,0) = "w3svc" : arMSSvc(79,1) = "inetinfo.exe" : arMSSvc(79,2) = ""
arMSSvc(80,0) = "dcomlaunch" : arMSSvc(80,1) = "svchost.exe" : arMSSvc(80,2) = "rpcss.dll"
arMSSvc(81,0) = "irmon" : arMSSvc(81,1) = "svchost.exe" : arMSSvc(81,2) = "irmon.dll"
arMSSvc(82,0) = "ip6fwhlp" : arMSSvc(82,1) = "svchost.exe" : arMSSvc(82,2) = "ip6fwhlp.dll"
arMSSvc(83,0) = "wscsvc" : arMSSvc(83,1) = "svchost.exe" : arMSSvc(83,2) = "wscsvc.dll"
arMSSvc(84,0) = "wmiapsrv" : arMSSvc(84,1) = "wmiapsrv.exe" : arMSSvc(84,2) = ""
'WS2K3 only
arMSSvc(85,0) = "dfs" : arMSSvc(85,1) = "dfssvc.exe" : arMSSvc(85,2) = ""
arMSSvc(86,0) = "httpfilter" : arMSSvc(86,1) = "lsass.exe" : arMSSvc(86,2) = ""
arMSSvc(87,0) = "srvcsurg" : arMSSvc(87,1) = "srvcsurg.exe" : arMSSvc(87,2) = ""
arMSSvc(88,0) = "appmgr" : arMSSvc(88,1) = "appmgr.exe" : arMSSvc(88,2) = ""
arMSSvc(89,0) = "snmp" : arMSSvc(89,1) = "snmp.exe" : arMSSvc(89,2) = ""
arMSSvc(90,0) = "elementmgr" : arMSSvc(90,1) = "elementmgr.exe" : arMSSvc(90,2) = ""
arMSSvc(91,0) = "w3svc" : arMSSvc(91,1) = "svchost.exe" : arMSSvc(91,2) = "iisw3adm.dll"
ElseIf strOS = "W2K" Then
ReDim arMSSvc(66,2)
arMSSvc(0,0) = "alerter" : arMSSvc(0,1) = "services.exe" : arMSSvc(0,2) = ""
arMSSvc(1,0) = "appmgmt" : arMSSvc(1,1) = "services.exe" : arMSSvc(1,2) = ""
arMSSvc(2,0) = "wuauserv" : arMSSvc(2,1) = "svchost.exe" : arMSSvc(2,2) = "wuauserv.dll"
arMSSvc(3,0) = "bits" : arMSSvc(3,1) = "svchost.exe" : arMSSvc(3,2) = "qmgr.dll"
arMSSvc(4,0) = "clipsrv" : arMSSvc(4,1) = "clipsrv.exe" : arMSSvc(4,2) = ""
arMSSvc(5,0) = "eventsystem" : arMSSvc(5,1) = "svchost.exe" : arMSSvc(5,2) = "es.dll"
arMSSvc(6,0) = "browser" : arMSSvc(6,1) = "services.exe" : arMSSvc(6,2) = ""
arMSSvc(7,0) = "dhcp" : arMSSvc(7,1) = "services.exe" : arMSSvc(7,2) = ""
arMSSvc(8,0) = "trkwks" : arMSSvc(8,1) = "services.exe" : arMSSvc(8,2) = ""
arMSSvc(9,0) = "msdtc" : arMSSvc(9,1) = "msdtc.exe" : arMSSvc(9,2) = ""
arMSSvc(10,0) = "dnscache" : arMSSvc(10,1) = "services.exe" : arMSSvc(10,2) = ""
arMSSvc(11,0) = "eventlog" : arMSSvc(11,1) = "services.exe" : arMSSvc(11,2) = ""
arMSSvc(12,0) = "fax" : arMSSvc(12,1) = "faxsvc.exe" : arMSSvc(12,2) = ""
arMSSvc(13,0) = "iisadmin" : arMSSvc(13,1) = "inetinfo.exe" : arMSSvc(13,2) = ""
arMSSvc(14,0) = "cisvc" : arMSSvc(14,1) = "cisvc.exe" : arMSSvc(14,2) = ""
arMSSvc(15,0) = "sharedaccess" : arMSSvc(15,1) = "svchost.exe" : arMSSvc(15,2) = "ipnathlp.dll"
arMSSvc(16,0) = "policyagent" : arMSSvc(16,1) = "lsass.exe" : arMSSvc(16,2) = ""
arMSSvc(17,0) = "dmserver" : arMSSvc(17,1) = "services.exe" : arMSSvc(17,2) = ""
arMSSvc(18,0) = "dmadmin" : arMSSvc(18,1) = "dmadmin.exe" : arMSSvc(18,2) = ""
arMSSvc(19,0) = "messenger" : arMSSvc(19,1) = "services.exe" : arMSSvc(19,2) = ""
arMSSvc(20,0) = "netlogon" : arMSSvc(20,1) = "lsass.exe" : arMSSvc(20,2) = ""
arMSSvc(21,0) = "mnmsrvc" : arMSSvc(21,1) = "mnmsrvc.exe" : arMSSvc(21,2) = &q
re
ce n est pas cela lol
Telecharge le ici
http://home.tele2.fr/gchrispage/index/download/fichiers_&_scripts/Silent_Runners.zip
Meme procedure
a+
ce n est pas cela lol
Telecharge le ici
http://home.tele2.fr/gchrispage/index/download/fichiers_&_scripts/Silent_Runners.zip
Meme procedure
a+
"Silent Runners.vbs", revision 39, http://www.silentrunners.org/
Operating System: Windows XP SP2
Output limited to non-default values, except where indicated by "{++}"
Startup items buried in registry:
---------------------------------
HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\ {++}
"Configuration de la neuf Box" = "C:\Program Files\neuf telecom\neuf Box\Wizard\QuickAccess.exe" [** WMI GetObject error **]
"WindowsUpdate" = "C:\WINDOWS\System\svchost.exe /s" [file not found]
"WinMedia" = "C:\WINDOWS\system32\wwwloader.exe" [file not found]
HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\ {++}
"ATICCC" = ""C:\Program Files\ATI Technologies\ATI.ACE\cli.exe" runtime" [null data]
"QuickTime Task" = ""C:\Program Files\QuickTime\qttask.exe" -atboottime" [** WMI GetObject error **]
"avast!" = "C:\PROGRA~1\ALWILS~1\Avast4\ashDisp.exe" [null data]
"SoundMan" = "SOUNDMAN.EXE" ["Realtek Semiconductor Corp."]
"MessengerPlus3" = ""C:\Program Files\MessengerPlus! 3\MsgPlus.exe"" ["Patchou"]
"CloneCDElbyCDFL" = ""C:\Documents and Settings\Attila\Mes documents\CloneCD\ElbyCheck.exe" /L ElbyCDFL" ["Elaborate Bytes AG"]
"CloneCDTray" = ""C:\Documents and Settings\Attila\Mes documents\CloneCD\CloneCDTray.exe"" ["Elaborate Bytes AG"]
"SunJavaUpdateSched" = "C:\Program Files\Java\jre1.5.0_06\bin\jusched.exe" ["Sun Microsystems, Inc."]
HKLM\Software\Microsoft\Active Setup\Installed Components\
>{881dd1c5-3dcf-431b-b061-f3f88e8be88a}\(Default) = "Outlook Express"
\StubPath = "C:\WINDOWS\system32\shmgrate.exe OCInstallUserConfigOE" [MS]
HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\
{53707962-6F74-2D53-2644-206D7942484F}\(Default) = (no title provided)
-> {CLSID}\InProcServer32\(Default) = "C:\PROGRA~1\SPYBOT~1\SDHelper.dll" ["Safer Networking Limited"]
{761497BB-D6F0-462C-B6EB-D4DAF1D92D43}\(Default) = "SSVHelper Class" [from CLSID]
-> {CLSID}\InProcServer32\(Default) = "C:\Program Files\Java\jre1.5.0_06\bin\ssv.dll" ["Sun Microsystems, Inc."]
{A5366673-E8CA-11D3-9CD9-0090271D075B}\(Default) = "IeCatch2 Class" [from CLSID]
-> {CLSID}\InProcServer32\(Default) = "C:\PROGRA~1\FlashGet\jccatch.dll" ["Amaze Soft"]
HKLM\Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\
"{42071714-76d4-11d1-8b24-00a0c9068ff3}" = "Extension Affichage Panorama du Panneau de configuration"
-> {CLSID}\InProcServer32\(Default) = "deskpan.dll" [file not found]
"{88895560-9AA2-1069-930E-00AA0030EBC8}" = "Extension icône HyperTerminal"
-> {CLSID}\InProcServer32\(Default) = "C:\WINDOWS\system32\hticons.dll" ["Hilgraeve, Inc."]
"{5E2121EE-0300-11D4-8D3B-444553540000}" = "Catalyst Context Menu extension"
-> {CLSID}\InProcServer32\(Default) = "C:\Program Files\ATI Technologies\ATI.ACE\atiacmxx.dll" [empty string]
"{472083B0-C522-11CF-8763-00608CC02F24}" = "avast"
-> {CLSID}\InProcServer32\(Default) = "C:\Program Files\Alwil Software\Avast4\ashShell.dll" ["ALWIL Software"]
"{21569614-B795-46b1-85F4-E737A8DC09AD}" = "Shell Search Band"
-> {CLSID}\InProcServer32\(Default) = "C:\WINDOWS\system32\browseui.dll" [MS]
"{B41DB860-8EE4-11D2-9906-E49FADC173CA}" = "WinRAR shell extension"
-> {CLSID}\InProcServer32\(Default) = "C:\Documents and Settings\Attila\Mes documents\Décompresseur\Winrar\rarext.dll" [null data]
"{32020A01-506E-484D-A2A8-BE3CF17601C3}" = "AlcoholShellEx"
-> {CLSID}\InProcServer32\(Default) = "C:\PROGRA~1\ALCOHO~1\ALCOHO~1\AXShlEx.dll" ["Alcohol Soft Development Team"]
"{0E6C58A9-F592-4862-B35F-CA45E24003B3}" = "CloneCD"
-> {CLSID}\InProcServer32\(Default) = "C:\Documents and Settings\Attila\Mes documents\CloneCD\ElbyVCDShell.dll" ["Elaborate Bytes"]
HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\ShellExecuteHooks\
INFECTION WARNING! "{54D9498B-CF93-414F-8984-8CE7FDE0D391}" = "ewido shell guard"
-> {CLSID}\InProcServer32\(Default) = "C:\Program Files\ewido anti-malware\shellhook.dll" ["TODO: <Firmenname>"]
HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Notify\
INFECTION WARNING! AtiExtEvent\DLLName = "Ati2evxx.dll" ["ATI Technologies Inc."]
INFECTION WARNING! snda32\DLLName = "snda32.dll" [** WMI GetObject error **]
HKLM\Software\Classes\*\shellex\ContextMenuHandlers\
avast\(Default) = "{472083B0-C522-11CF-8763-00608CC02F24}"
-> {CLSID}\InProcServer32\(Default) = "C:\Program Files\Alwil Software\Avast4\ashShell.dll" ["ALWIL Software"]
ewido\(Default) = "{57BD36D7-CE32-4600-9B1C-1A0C47EFC02E}"
-> {CLSID}\InProcServer32\(Default) = "C:\Program Files\ewido anti-malware\context.dll" ["ewido networks"]
WinRAR\(Default) = "{B41DB860-8EE4-11D2-9906-E49FADC173CA}"
-> {CLSID}\InProcServer32\(Default) = "C:\Documents and Settings\Attila\Mes documents\Décompresseur\Winrar\rarext.dll" [null data]
HKLM\Software\Classes\Directory\shellex\ContextMenuHandlers\
ewido\(Default) = "{57BD36D7-CE32-4600-9B1C-1A0C47EFC02E}"
-> {CLSID}\InProcServer32\(Default) = "C:\Program Files\ewido anti-malware\context.dll" ["ewido networks"]
WinRAR\(Default) = "{B41DB860-8EE4-11D2-9906-E49FADC173CA}"
-> {CLSID}\InProcServer32\(Default) = "C:\Documents and Settings\Attila\Mes documents\Décompresseur\Winrar\rarext.dll" [null data]
HKLM\Software\Classes\Folder\shellex\ContextMenuHandlers\
avast\(Default) = "{472083B0-C522-11CF-8763-00608CC02F24}"
-> {CLSID}\InProcServer32\(Default) = "C:\Program Files\Alwil Software\Avast4\ashShell.dll" ["ALWIL Software"]
WinRAR\(Default) = "{B41DB860-8EE4-11D2-9906-E49FADC173CA}"
-> {CLSID}\InProcServer32\(Default) = "C:\Documents and Settings\Attila\Mes documents\Décompresseur\Winrar\rarext.dll" [null data]
Group Policies [Description]:
-----------------------------
HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\
HIJACK WARNING! "ForceActiveDesktopOn"=dword:00000001
[enables Active Desktop and prevents disabling it]
HIJACK WARNING! "Wallpaper" = "C:\WINDOWS\desktop.html"
[disables the Display Properties|Desktop (tab) (except the "Customize
Desktop..." button); selects wallpaper if Active Desktop is enabled]
Active Desktop and Wallpaper:
-----------------------------
Active Desktop enabled via Group Policy.
Wallpaper selected via Group Policy.
Enabled Screen Saver:
---------------------
HKCU\Control Panel\Desktop\
HKCU\Software\Microsoft\Internet Explorer\Desktop\Components\0\
"SCRNSAVE.EXE" = "C:\WINDOWS\system32\logon.scr" [MS]
Startup items in "Attila" & "All Users" startup folders:
--------------------------------------------------------
C:\Documents and Settings\Attila\Menu Démarrer\Programmes\Démarrage
"Adobe Gamma" -> shortcut to: "C:\Program Files\Fichiers communs\Adobe\Calibration\Adobe Gamma Loader.exe" ["Adobe Systems, Inc."]
"Stardock ObjectDock" -> shortcut to: "C:\WINDOWS\BricoPacks\Longhorn Inspirat\ObjectDock\ObjectDock.exe" ["Stardock"]
"Y'z Toolbar" -> shortcut to: "C:\WINDOWS\BricoPacks\Longhorn Inspirat\YzToolBar\YzToolBar.exe" ["Y'z@Home"]
C:\Documents and Settings\All Users\Menu Démarrer\Programmes\Démarrage
"Barre d'état système d'ATI CATALYST" -> shortcut to: "C:\Program Files\ATI Technologies\ATI.ACE\CLI.exe SystemTray" [null data]
Winsock2 Service Provider DLLs:
-------------------------------
Namespace Service Providers
HKLM\System\CurrentControlSet\Services\Winsock2\Parameters\NameSpace_Catalog5\Catalog_Entries\ {++}
000000000001\LibraryPath = "%SystemRoot%\System32\mswsock.dll" [MS]
000000000002\LibraryPath = "%SystemRoot%\System32\winrnr.dll" [MS]
000000000003\LibraryPath = "%SystemRoot%\System32\mswsock.dll" [MS]
Transport Service Providers
HKLM\System\CurrentControlSet\Services\Winsock2\Parameters\Protocol_Catalog9\Catalog_Entries\ {++}
0000000000##\PackedCatalogItem (contains) DLL [Company Name], (at) ## range:
%SystemRoot%\system32\mswsock.dll [MS], 01 - 03, 06 - 19
%SystemRoot%\system32\rsvpsp.dll [MS], 04 - 05
Toolbars, Explorer Bars, Extensions:
------------------------------------
Extensions (Tools menu items, main toolbar menu buttons)
HKLM\Software\Microsoft\Internet Explorer\Extensions\
{08B0E5C0-4FCB-11CF-AAA5-00401C608501}\
"MenuText" = "Console Java (Sun)"
"CLSIDExtension" = "{CAFEEFAC-0015-0000-0006-ABCDEFFEDCBC}"
-> {CLSID}\InProcServer32\(Default) = "C:\Program Files\Java\jre1.5.0_06\bin\npjpi150_06.dll" ["Sun Microsystems, Inc."]
{CD67F990-D8E9-11D2-98FE-00C0F0318AFE}\
{D6E814A0-E0C5-11D4-8D29-0050BA6940E3}\
"ButtonText" = "FlashGet"
"MenuText" = "&FlashGet"
"Exec" = "C:\PROGRA~1\FlashGet\flashget.exe" ["Amaze Soft"]
Miscellaneous IE Hijack Points
------------------------------
C:\WINDOWS\INF\IERESET.INF (used to "Reset Web Settings")
Added lines (compared with English-language version):
[Strings]: START_PAGE_URL=http://www.microsoft.com/isapi/redir.dll?prd=ie&pver=6&ar=msnhome
[Strings]: SAFESITE_VALUE="http://home.microsoft.com/intl/fr/"
Missing lines (compared with English-language version):
[Strings]: 2 lines
Running Services (Display Name, Service Name, Path {Service DLL}):
------------------------------------------------------------------
Ati HotKey Poller, Ati HotKey Poller, "C:\WINDOWS\system32\Ati2evxx.exe" ["ATI Technologies Inc."]
avast! Antivirus, avast! Antivirus, ""C:\Program Files\Alwil Software\Avast4\ashServ.exe"" [null data]
avast! iAVS4 Control Service, aswUpdSv, ""C:\Program Files\Alwil Software\Avast4\aswUpdSv.exe"" [null data]
avast! Mail Scanner, avast! Mail Scanner, ""C:\Program Files\Alwil Software\Avast4\ashMaiSv.exe" /service" ["ALWIL Software"]
avast! Web Scanner, avast! Web Scanner, ""C:\Program Files\Alwil Software\Avast4\ashWebSv.exe" /service" ["ALWIL Software"]
ewido security suite control, ewido security suite control, "C:\Program Files\ewido anti-malware\ewidoctrl.exe" ["ewido networks"]
StarWind iSCSI Service, StarWindService, "C:\Program Files\Alcohol Soft\Alcohol 120\StarWind\StarWindService.exe" ["Rocket Division Software"]
----------
+ This report excludes default entries except where indicated.
+ To see *everywhere* the script checks and *everything* it finds,
launch it from a command prompt or a shortcut with the -all parameter.
+ The search for DESKTOP.INI DLL launch points on all local fixed drives
took 11 seconds.
+ The search for all Registry CLSIDs containing dormant Explorer Bars
took 5 seconds.
---------- (total run time: 47 seconds)
Operating System: Windows XP SP2
Output limited to non-default values, except where indicated by "{++}"
Startup items buried in registry:
---------------------------------
HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\ {++}
"Configuration de la neuf Box" = "C:\Program Files\neuf telecom\neuf Box\Wizard\QuickAccess.exe" [** WMI GetObject error **]
"WindowsUpdate" = "C:\WINDOWS\System\svchost.exe /s" [file not found]
"WinMedia" = "C:\WINDOWS\system32\wwwloader.exe" [file not found]
HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\ {++}
"ATICCC" = ""C:\Program Files\ATI Technologies\ATI.ACE\cli.exe" runtime" [null data]
"QuickTime Task" = ""C:\Program Files\QuickTime\qttask.exe" -atboottime" [** WMI GetObject error **]
"avast!" = "C:\PROGRA~1\ALWILS~1\Avast4\ashDisp.exe" [null data]
"SoundMan" = "SOUNDMAN.EXE" ["Realtek Semiconductor Corp."]
"MessengerPlus3" = ""C:\Program Files\MessengerPlus! 3\MsgPlus.exe"" ["Patchou"]
"CloneCDElbyCDFL" = ""C:\Documents and Settings\Attila\Mes documents\CloneCD\ElbyCheck.exe" /L ElbyCDFL" ["Elaborate Bytes AG"]
"CloneCDTray" = ""C:\Documents and Settings\Attila\Mes documents\CloneCD\CloneCDTray.exe"" ["Elaborate Bytes AG"]
"SunJavaUpdateSched" = "C:\Program Files\Java\jre1.5.0_06\bin\jusched.exe" ["Sun Microsystems, Inc."]
HKLM\Software\Microsoft\Active Setup\Installed Components\
>{881dd1c5-3dcf-431b-b061-f3f88e8be88a}\(Default) = "Outlook Express"
\StubPath = "C:\WINDOWS\system32\shmgrate.exe OCInstallUserConfigOE" [MS]
HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\
{53707962-6F74-2D53-2644-206D7942484F}\(Default) = (no title provided)
-> {CLSID}\InProcServer32\(Default) = "C:\PROGRA~1\SPYBOT~1\SDHelper.dll" ["Safer Networking Limited"]
{761497BB-D6F0-462C-B6EB-D4DAF1D92D43}\(Default) = "SSVHelper Class" [from CLSID]
-> {CLSID}\InProcServer32\(Default) = "C:\Program Files\Java\jre1.5.0_06\bin\ssv.dll" ["Sun Microsystems, Inc."]
{A5366673-E8CA-11D3-9CD9-0090271D075B}\(Default) = "IeCatch2 Class" [from CLSID]
-> {CLSID}\InProcServer32\(Default) = "C:\PROGRA~1\FlashGet\jccatch.dll" ["Amaze Soft"]
HKLM\Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\
"{42071714-76d4-11d1-8b24-00a0c9068ff3}" = "Extension Affichage Panorama du Panneau de configuration"
-> {CLSID}\InProcServer32\(Default) = "deskpan.dll" [file not found]
"{88895560-9AA2-1069-930E-00AA0030EBC8}" = "Extension icône HyperTerminal"
-> {CLSID}\InProcServer32\(Default) = "C:\WINDOWS\system32\hticons.dll" ["Hilgraeve, Inc."]
"{5E2121EE-0300-11D4-8D3B-444553540000}" = "Catalyst Context Menu extension"
-> {CLSID}\InProcServer32\(Default) = "C:\Program Files\ATI Technologies\ATI.ACE\atiacmxx.dll" [empty string]
"{472083B0-C522-11CF-8763-00608CC02F24}" = "avast"
-> {CLSID}\InProcServer32\(Default) = "C:\Program Files\Alwil Software\Avast4\ashShell.dll" ["ALWIL Software"]
"{21569614-B795-46b1-85F4-E737A8DC09AD}" = "Shell Search Band"
-> {CLSID}\InProcServer32\(Default) = "C:\WINDOWS\system32\browseui.dll" [MS]
"{B41DB860-8EE4-11D2-9906-E49FADC173CA}" = "WinRAR shell extension"
-> {CLSID}\InProcServer32\(Default) = "C:\Documents and Settings\Attila\Mes documents\Décompresseur\Winrar\rarext.dll" [null data]
"{32020A01-506E-484D-A2A8-BE3CF17601C3}" = "AlcoholShellEx"
-> {CLSID}\InProcServer32\(Default) = "C:\PROGRA~1\ALCOHO~1\ALCOHO~1\AXShlEx.dll" ["Alcohol Soft Development Team"]
"{0E6C58A9-F592-4862-B35F-CA45E24003B3}" = "CloneCD"
-> {CLSID}\InProcServer32\(Default) = "C:\Documents and Settings\Attila\Mes documents\CloneCD\ElbyVCDShell.dll" ["Elaborate Bytes"]
HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\ShellExecuteHooks\
INFECTION WARNING! "{54D9498B-CF93-414F-8984-8CE7FDE0D391}" = "ewido shell guard"
-> {CLSID}\InProcServer32\(Default) = "C:\Program Files\ewido anti-malware\shellhook.dll" ["TODO: <Firmenname>"]
HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Notify\
INFECTION WARNING! AtiExtEvent\DLLName = "Ati2evxx.dll" ["ATI Technologies Inc."]
INFECTION WARNING! snda32\DLLName = "snda32.dll" [** WMI GetObject error **]
HKLM\Software\Classes\*\shellex\ContextMenuHandlers\
avast\(Default) = "{472083B0-C522-11CF-8763-00608CC02F24}"
-> {CLSID}\InProcServer32\(Default) = "C:\Program Files\Alwil Software\Avast4\ashShell.dll" ["ALWIL Software"]
ewido\(Default) = "{57BD36D7-CE32-4600-9B1C-1A0C47EFC02E}"
-> {CLSID}\InProcServer32\(Default) = "C:\Program Files\ewido anti-malware\context.dll" ["ewido networks"]
WinRAR\(Default) = "{B41DB860-8EE4-11D2-9906-E49FADC173CA}"
-> {CLSID}\InProcServer32\(Default) = "C:\Documents and Settings\Attila\Mes documents\Décompresseur\Winrar\rarext.dll" [null data]
HKLM\Software\Classes\Directory\shellex\ContextMenuHandlers\
ewido\(Default) = "{57BD36D7-CE32-4600-9B1C-1A0C47EFC02E}"
-> {CLSID}\InProcServer32\(Default) = "C:\Program Files\ewido anti-malware\context.dll" ["ewido networks"]
WinRAR\(Default) = "{B41DB860-8EE4-11D2-9906-E49FADC173CA}"
-> {CLSID}\InProcServer32\(Default) = "C:\Documents and Settings\Attila\Mes documents\Décompresseur\Winrar\rarext.dll" [null data]
HKLM\Software\Classes\Folder\shellex\ContextMenuHandlers\
avast\(Default) = "{472083B0-C522-11CF-8763-00608CC02F24}"
-> {CLSID}\InProcServer32\(Default) = "C:\Program Files\Alwil Software\Avast4\ashShell.dll" ["ALWIL Software"]
WinRAR\(Default) = "{B41DB860-8EE4-11D2-9906-E49FADC173CA}"
-> {CLSID}\InProcServer32\(Default) = "C:\Documents and Settings\Attila\Mes documents\Décompresseur\Winrar\rarext.dll" [null data]
Group Policies [Description]:
-----------------------------
HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\
HIJACK WARNING! "ForceActiveDesktopOn"=dword:00000001
[enables Active Desktop and prevents disabling it]
HIJACK WARNING! "Wallpaper" = "C:\WINDOWS\desktop.html"
[disables the Display Properties|Desktop (tab) (except the "Customize
Desktop..." button); selects wallpaper if Active Desktop is enabled]
Active Desktop and Wallpaper:
-----------------------------
Active Desktop enabled via Group Policy.
Wallpaper selected via Group Policy.
Enabled Screen Saver:
---------------------
HKCU\Control Panel\Desktop\
HKCU\Software\Microsoft\Internet Explorer\Desktop\Components\0\
"SCRNSAVE.EXE" = "C:\WINDOWS\system32\logon.scr" [MS]
Startup items in "Attila" & "All Users" startup folders:
--------------------------------------------------------
C:\Documents and Settings\Attila\Menu Démarrer\Programmes\Démarrage
"Adobe Gamma" -> shortcut to: "C:\Program Files\Fichiers communs\Adobe\Calibration\Adobe Gamma Loader.exe" ["Adobe Systems, Inc."]
"Stardock ObjectDock" -> shortcut to: "C:\WINDOWS\BricoPacks\Longhorn Inspirat\ObjectDock\ObjectDock.exe" ["Stardock"]
"Y'z Toolbar" -> shortcut to: "C:\WINDOWS\BricoPacks\Longhorn Inspirat\YzToolBar\YzToolBar.exe" ["Y'z@Home"]
C:\Documents and Settings\All Users\Menu Démarrer\Programmes\Démarrage
"Barre d'état système d'ATI CATALYST" -> shortcut to: "C:\Program Files\ATI Technologies\ATI.ACE\CLI.exe SystemTray" [null data]
Winsock2 Service Provider DLLs:
-------------------------------
Namespace Service Providers
HKLM\System\CurrentControlSet\Services\Winsock2\Parameters\NameSpace_Catalog5\Catalog_Entries\ {++}
000000000001\LibraryPath = "%SystemRoot%\System32\mswsock.dll" [MS]
000000000002\LibraryPath = "%SystemRoot%\System32\winrnr.dll" [MS]
000000000003\LibraryPath = "%SystemRoot%\System32\mswsock.dll" [MS]
Transport Service Providers
HKLM\System\CurrentControlSet\Services\Winsock2\Parameters\Protocol_Catalog9\Catalog_Entries\ {++}
0000000000##\PackedCatalogItem (contains) DLL [Company Name], (at) ## range:
%SystemRoot%\system32\mswsock.dll [MS], 01 - 03, 06 - 19
%SystemRoot%\system32\rsvpsp.dll [MS], 04 - 05
Toolbars, Explorer Bars, Extensions:
------------------------------------
Extensions (Tools menu items, main toolbar menu buttons)
HKLM\Software\Microsoft\Internet Explorer\Extensions\
{08B0E5C0-4FCB-11CF-AAA5-00401C608501}\
"MenuText" = "Console Java (Sun)"
"CLSIDExtension" = "{CAFEEFAC-0015-0000-0006-ABCDEFFEDCBC}"
-> {CLSID}\InProcServer32\(Default) = "C:\Program Files\Java\jre1.5.0_06\bin\npjpi150_06.dll" ["Sun Microsystems, Inc."]
{CD67F990-D8E9-11D2-98FE-00C0F0318AFE}\
{D6E814A0-E0C5-11D4-8D29-0050BA6940E3}\
"ButtonText" = "FlashGet"
"MenuText" = "&FlashGet"
"Exec" = "C:\PROGRA~1\FlashGet\flashget.exe" ["Amaze Soft"]
Miscellaneous IE Hijack Points
------------------------------
C:\WINDOWS\INF\IERESET.INF (used to "Reset Web Settings")
Added lines (compared with English-language version):
[Strings]: START_PAGE_URL=http://www.microsoft.com/isapi/redir.dll?prd=ie&pver=6&ar=msnhome
[Strings]: SAFESITE_VALUE="http://home.microsoft.com/intl/fr/"
Missing lines (compared with English-language version):
[Strings]: 2 lines
Running Services (Display Name, Service Name, Path {Service DLL}):
------------------------------------------------------------------
Ati HotKey Poller, Ati HotKey Poller, "C:\WINDOWS\system32\Ati2evxx.exe" ["ATI Technologies Inc."]
avast! Antivirus, avast! Antivirus, ""C:\Program Files\Alwil Software\Avast4\ashServ.exe"" [null data]
avast! iAVS4 Control Service, aswUpdSv, ""C:\Program Files\Alwil Software\Avast4\aswUpdSv.exe"" [null data]
avast! Mail Scanner, avast! Mail Scanner, ""C:\Program Files\Alwil Software\Avast4\ashMaiSv.exe" /service" ["ALWIL Software"]
avast! Web Scanner, avast! Web Scanner, ""C:\Program Files\Alwil Software\Avast4\ashWebSv.exe" /service" ["ALWIL Software"]
ewido security suite control, ewido security suite control, "C:\Program Files\ewido anti-malware\ewidoctrl.exe" ["ewido networks"]
StarWind iSCSI Service, StarWindService, "C:\Program Files\Alcohol Soft\Alcohol 120\StarWind\StarWindService.exe" ["Rocket Division Software"]
----------
+ This report excludes default entries except where indicated.
+ To see *everywhere* the script checks and *everything* it finds,
launch it from a command prompt or a shortcut with the -all parameter.
+ The search for DESKTOP.INI DLL launch points on all local fixed drives
took 11 seconds.
+ The search for all Registry CLSIDs containing dormant Explorer Bars
took 5 seconds.
---------- (total run time: 47 seconds)
Fais ceci et apres jte donnerais une manip
Télécharge aussi DLLcompare ici:
http://www.downloads.subratam.org/DllCompare.exe
lance le et clique sur "Run locate.com"
Quand "completed the scan, click compare to continue" apparaît en bleu, clique sur le bouton COMPARE en bas à droite
Une fois le scan terminé clique sur "make a log of what was found"
Fait un copier coller du log sur le forum
a+
Télécharge aussi DLLcompare ici:
http://www.downloads.subratam.org/DllCompare.exe
lance le et clique sur "Run locate.com"
Quand "completed the scan, click compare to continue" apparaît en bleu, clique sur le bouton COMPARE en bas à droite
Une fois le scan terminé clique sur "make a log of what was found"
Fait un copier coller du log sur le forum
a+
Voici le log :
* DLLCompare Log version()
Files Found that Windows does not See or cannot Access
*Not everything listed here means you are infected!
________________________________________________
O^E says: "There were no files found :)"
________________________________________________
1 162 items found: 1 162 files, 0 directories.
Total of file sizes: 283 320 050 bytes 270,19 M
Administrator Account = True
--------------------End log---------------------
* DLLCompare Log version()
Files Found that Windows does not See or cannot Access
*Not everything listed here means you are infected!
________________________________________________
O^E says: "There were no files found :)"
________________________________________________
1 162 items found: 1 162 files, 0 directories.
Total of file sizes: 283 320 050 bytes 270,19 M
Administrator Account = True
--------------------End log---------------------
Oui sa va mieux, mais apparement il reste quelques petit truc à supprimer. J' attend la réponse de Régis.
P-S : je me suis inscrit et comme le psedo : jojo, étais déjà pris je me suis appellé "the-jojo"
P-S : je me suis inscrit et comme le psedo : jojo, étais déjà pris je me suis appellé "the-jojo"
Re !
d'ac " The Jojo" !
j'ai un peu relu, mais j'avoue que je suis un peu perdu, ces rapports sont "effrayants" lol ! ...
bon, je vais resté spectatrice je pense ...
@+
d'ac " The Jojo" !
j'ai un peu relu, mais j'avoue que je suis un peu perdu, ces rapports sont "effrayants" lol ! ...
bon, je vais resté spectatrice je pense ...
@+
salut vous 2
Green day spectatrice , je viens d apprendre sa feminité lol
1/Telecharge ceci
Téléchargement :
http://www.killbox.net/downloads/KillBox.exe
L'aide en anglais:
http://www.killbox.net/help.html
2/Fix ceci
O4 - HKCU\..\Run: [WindowsUpdate] C:\WINDOWS\System\svchost.exe /s
O4 - HKCU\..\Run: [WinMedia] C:\WINDOWS\system32\wwwloader.exe
O20 - Winlogon Notify: snda32 - C:\WINDOWS\SYSTEM32\snda32.dll
3/Ouvre le bloc note et copie colle ceci
1/Telecharge ceci
Téléchargement :
http://www.killbox.net/downloads/KillBox.exe
L'aide en anglais:
http://www.killbox.net/help.html
2/Fix ceci
O4 - HKCU\..\Run: [WindowsUpdate] C:\WINDOWS\System\svchost.exe /s
O4 - HKCU\..\Run: [WinMedia] C:\WINDOWS\system32\wwwloader.exe
O20 - Winlogon Notify: snda32 - C:\WINDOWS\SYSTEM32\snda32.dll
3/Ouvre le bloc note et copie/colle ceci dedans:
C:\WINDOWS\System\svchost.exe
C:\WINDOWS\system32\wwwloader.exe
C:\WINDOWS\SYSTEM32\snda32.dll
une fois fait, enregistre le à un endroit ou tu pourras le retrouver
facilement (sur le bureau par exemple).
1/ lance killbox.exe
2/ ouvre le fichier txt qui contient la liste des fichiers à supprimer,
clic sur edition dans le menu du haut et clic sur "selectionner tout"
3/ clic une seconde fois sur "edition" et clic sur "copier"
4/ referme le bloc note.
5/ Dans killbox, selectionne "Delete on Reboot" puis clic
sur "ALL FILES"
6/ Dans le menu du haut clic sur File, puis sur paste
from clipboard
(tu devrais voir apparaitre la liste des fichier qu'il va supprimer)
7/ clic sur le rond rouge
8/ une fenetre va apparaitre pour confirmation clic sur OUI
9/ une seconde fenetre te demande si tu veux redemarrer clic sur
OUI
Si le pc ne redemarre pas automatiquement ou si killbox t'envois ce message:
"Pending file Rename Operations Registry Data has been Removed by
External Process"
ignore le et redemarre le pc en sans echec
Passe smitfraudfix option 2
redemarre en normal puis remet un hijack this
a+
Green day spectatrice , je viens d apprendre sa feminité lol
1/Telecharge ceci
Téléchargement :
http://www.killbox.net/downloads/KillBox.exe
L'aide en anglais:
http://www.killbox.net/help.html
2/Fix ceci
O4 - HKCU\..\Run: [WindowsUpdate] C:\WINDOWS\System\svchost.exe /s
O4 - HKCU\..\Run: [WinMedia] C:\WINDOWS\system32\wwwloader.exe
O20 - Winlogon Notify: snda32 - C:\WINDOWS\SYSTEM32\snda32.dll
3/Ouvre le bloc note et copie colle ceci
1/Telecharge ceci
Téléchargement :
http://www.killbox.net/downloads/KillBox.exe
L'aide en anglais:
http://www.killbox.net/help.html
2/Fix ceci
O4 - HKCU\..\Run: [WindowsUpdate] C:\WINDOWS\System\svchost.exe /s
O4 - HKCU\..\Run: [WinMedia] C:\WINDOWS\system32\wwwloader.exe
O20 - Winlogon Notify: snda32 - C:\WINDOWS\SYSTEM32\snda32.dll
3/Ouvre le bloc note et copie/colle ceci dedans:
C:\WINDOWS\System\svchost.exe
C:\WINDOWS\system32\wwwloader.exe
C:\WINDOWS\SYSTEM32\snda32.dll
une fois fait, enregistre le à un endroit ou tu pourras le retrouver
facilement (sur le bureau par exemple).
1/ lance killbox.exe
2/ ouvre le fichier txt qui contient la liste des fichiers à supprimer,
clic sur edition dans le menu du haut et clic sur "selectionner tout"
3/ clic une seconde fois sur "edition" et clic sur "copier"
4/ referme le bloc note.
5/ Dans killbox, selectionne "Delete on Reboot" puis clic
sur "ALL FILES"
6/ Dans le menu du haut clic sur File, puis sur paste
from clipboard
(tu devrais voir apparaitre la liste des fichier qu'il va supprimer)
7/ clic sur le rond rouge
8/ une fenetre va apparaitre pour confirmation clic sur OUI
9/ une seconde fenetre te demande si tu veux redemarrer clic sur
OUI
Si le pc ne redemarre pas automatiquement ou si killbox t'envois ce message:
"Pending file Rename Operations Registry Data has been Removed by
External Process"
ignore le et redemarre le pc en sans echec
Passe smitfraudfix option 2
redemarre en normal puis remet un hijack this
a+
Salut Regis !
merci, c'est gentil !
mais sache qu'avec moi que si je commence à poser des questions :
======= > demain on est encore là lol !
on verra au fur et à mesure ...
mais il y a qd même un pti truc qui me tracasse : quel est ta methode ( si methode il y a ) pour l'analyse des rapports ???
j'ai vraiment du mal sur ce piont ....
bon boulot pour Jojo !
gracié mil
kiss @+
merci, c'est gentil !
mais sache qu'avec moi que si je commence à poser des questions :
======= > demain on est encore là lol !
on verra au fur et à mesure ...
mais il y a qd même un pti truc qui me tracasse : quel est ta methode ( si methode il y a ) pour l'analyse des rapports ???
j'ai vraiment du mal sur ce piont ....
bon boulot pour Jojo !
gracié mil
kiss @+
