[Arquivado] explorer fechando e abrindo @ Analisem meu log

MAcgYvER everyONE · Setembro 21, 2008

'#26. HOSTS file

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)

If Not flagTest Or (flagTest And SecTest) Then

'left-trimmed HOSTS line, IP address, HOSTS Path, tab pos'n, space pos'n

Dim strLineWk, strIP, strHP, intTabPosn, intSpacePosn

Dim intWSPosn : intWSPosn = 0 'white space posn

Dim intMapCtr : intMapCtr = 0 'map ctr

Dim intNLHMapCtr : intNLHMapCtr = 0 'non-localhost map ctr

'prepare section title

strTitle = "HOSTS file"

'determine HOSTS file location

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

'find HOSTS directory from registry, compare to default value

strKey = "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters"

intErrNum = oReg.GetExpandedStringValue (HKLM,strKey,"DataBasePath",strValue)

'if registry value exists

If intErrNum = 0 And strValue <> "" Then

'trim it & expand path string

strTmp = Wshso.ExpandEnvironmentStrings(Trim(strValue))

'lop off trailing backslash

If Right(strTmp,1) = "\" Then strTmp = Left(strTmp,Len(strTmp)-1)

'set HOSTS path from registry value

strHP = strTmp & "\HOSTS"

'output warning if not identical to default value

strWarn = ""

If LCase(strTmp) <> LCase(strFPSF) & "\drivers\etc" Then

strWarn = HWarn : flagHWarn = True

End If

If LCase(strTmp) <> LCase(strFPSF) & "\drivers\etc" Or flagShowAll Then

TitleLineWrite

oFN.WriteLine vbCRLF & "HKLM\" & strKey & "\" & vbCRLF & strWarn &_

DQ & "DataBasePath" & DQ & " = " & DQ & strValue &_

DQ

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" And strIP <> "::1" Then

intNLHMapCtr = intNLHMapCtr + 1 : TitleLineWrite

End If

End If 'line has embedded space?

End If 'line not CR/comment?

Loop 'read another line

oSCF.Close : Set oSCF=Nothing

'output if more than one IP mapped Or any IP mapped to non-localhost

'Or ShowAll

If (intMapCtr >= 1 And intNLHMapCtr > 0) Or flagShowAll Then

'set up output strings

'total number of mappings

If intMapCtr = 0 Then 'none

strOut1 = "maps: no domain names to IP addresses"

ElseIf intMapCtr = 1 Then 'one

strOut1 = "maps: 1 domain name to an IP address," & vbCRLF

Else '> 1

strOut1 = "maps: " & intMapCtr &_

" domain names to IP addresses," & vbCRLF

End If

'non-localhost mappings

If intNLHMapCtr = 0 Then 'none

If intMapCtr = 0 Then 'no maps found

strOut2 = ""

ElseIf intMapCtr = 1 Then 'one map found

strOut2 = Space(6) & "and this is the localhost IP address"

Else

strOut2 = Space(6) & "and all are the localhost IP address" '> 1 map found

End If

ElseIf intNLHMapCtr = 1 Then 'one

strOut2 = Space(6) & "1 of the IP addresses is *not* localhost!"

Else '> 1

strOut2 = Space(6) & intNLHMapCtr & " of the IP addresses are *not* localhost!"

End If

'output mapped & non-localhost counts

TitleLineWrite

oFN.WriteLine vbCRLF & strHP & vbCRLF & vbCRLF & strOut1 & strOut2

End If '>= 1 IP mapped And at least 1 IP mapped to non-localhost

Else 'HOSTS doesn't exist

If flagShowAll Then

TitleLineWrite

'say file not found

oFN.WriteLine vbCRLF & strHP & " (file not found)"

End If 'flagShowAll?

End If 'HOSTS exists?

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

End If 'SecTest?

'#27. Started Services

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)

If Not flagTest Or (flagTest And SecTest) Then

'for NT-type O/S's

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

'MS default services array, subscript number in MS default services array

'CoName string, optionally quote-delimited path name

Dim arMSSvc(), intMSSvcNo, strExeName, strPathNameOut

'set up MS default services array for WVa/WXP/W2K/NT4

'service name, service executable, DLL file name for svchost.exe-dependent service

If strOS = "WXP" Then

ReDim arMSSvc(93,2)

arMSSvc(0,0) = "alerter" : arMSSvc(0,1) = "svchost.exe" : arMSSvc(0,2) = "alrsvc.dll"

arMSSvc(1,0) = "alg" : arMSSvc(1,1) = "alg.exe" : arMSSvc(1,2) = ""

arMSSvc(2,0) = "appmgmt" : arMSSvc(2,1) = "svchost.exe" : arMSSvc(2,2) = "appmgmts.dll"

arMSSvc(3,0) = "wuauserv" : arMSSvc(3,1) = "svchost.exe" : arMSSvc(3,2) = "wuauserv.dll"

arMSSvc(4,0) = "bits" : arMSSvc(4,1) = "svchost.exe" : arMSSvc(4,2) = "qmgr.dll"

arMSSvc(5,0) = "clipsrv" : arMSSvc(5,1) = "clipsrv.exe" : arMSSvc(5,2) = ""

arMSSvc(6,0) = "eventsystem" : arMSSvc(6,1) = "svchost.exe" : arMSSvc(6,2) = "es.dll"

arMSSvc(7,0) = "comsysapp" : arMSSvc(7,1) = "dllhost.exe" : arMSSvc(7,2) = ""

arMSSvc(8,0) = "browser" : arMSSvc(8,1) = "svchost.exe" : arMSSvc(8,2) = "browser.dll"

arMSSvc(9,0) = "cryptsvc" : arMSSvc(9,1) = "svchost.exe" : arMSSvc(9,2) = "cryptsvc.dll"

arMSSvc(10,0) = "dhcp" : arMSSvc(10,1) = "svchost.exe" : arMSSvc(10,2) = "dhcpcsvc.dll"

arMSSvc(11,0) = "trkwks" : arMSSvc(11,1) = "svchost.exe" : arMSSvc(11,2) = "trkwks.dll"

arMSSvc(12,0) = "msdtc" : arMSSvc(12,1) = "msdtc.exe" : arMSSvc(12,2) = ""

arMSSvc(13,0) = "dnscache" : arMSSvc(13,1) = "svchost.exe" : arMSSvc(13,2) = "dnsrslvr.dll"

arMSSvc(14,0) = "eventlog" : arMSSvc(14,1) = "services.exe" : arMSSvc(14,2) = ""

arMSSvc(15,0) = "ersvc" : arMSSvc(15,1) = "svchost.exe" : arMSSvc(15,2) = "ersvc.dll"

arMSSvc(16,0) = "fastuserswitchingcompatibility" : arMSSvc(16,1) = "svchost.exe" : arMSSvc(16,2) = "shsvcs.dll"

arMSSvc(17,0) = "helpsvc" : arMSSvc(17,1) = "svchost.exe" : arMSSvc(17,2) = "pchsvc.dll"

arMSSvc(18,0) = "hidserv" : arMSSvc(18,1) = "svchost.exe" : arMSSvc(18,2) = "hidserv.dll"

arMSSvc(19,0) = "imapiservice" : arMSSvc(19,1) = "imapi.exe" : arMSSvc(19,2) = ""

arMSSvc(20,0) = "iisadmin" : arMSSvc(20,1) = "inetinfo.exe" : arMSSvc(20,2) = ""

arMSSvc(21,0) = "cisvc" : arMSSvc(21,1) = "cisvc.exe" : arMSSvc(21,2) = ""

arMSSvc(22,0) = "sharedaccess" : arMSSvc(22,1) = "svchost.exe" : arMSSvc(22,2) = "ipnathlp.dll"

arMSSvc(23,0) = "policyagent" : arMSSvc(23,1) = "lsass.exe" : arMSSvc(23,2) = ""

arMSSvc(24,0) = "dmserver" : arMSSvc(24,1) = "svchost.exe" : arMSSvc(24,2) = "dmserver.dll"

arMSSvc(25,0) = "dmadmin" : arMSSvc(25,1) = "dmadmin.exe" : arMSSvc(25,2) = ""

arMSSvc(26,0) = "messenger" : arMSSvc(26,1) = "svchost.exe" : arMSSvc(26,2) = "msgsvc.dll"

arMSSvc(27,0) = "swprv" : arMSSvc(27,1) = "dllhost.exe" : arMSSvc(27,2) = ""

arMSSvc(28,0) = "netlogon" : arMSSvc(28,1) = "lsass.exe" : arMSSvc(28,2) = ""

arMSSvc(29,0) = "mnmsrvc" : arMSSvc(29,1) = "mnmsrvc.exe" : arMSSvc(29,2) = ""

arMSSvc(30,0) = "netman" : arMSSvc(30,1) = "svchost.exe" : arMSSvc(30,2) = "netman.dll"

arMSSvc(31,0) = "netdde" : arMSSvc(31,1) = "netdde.exe" : arMSSvc(31,2) = ""

arMSSvc(32,0) = "netddedsdm" : arMSSvc(32,1) = "netdde.exe" : arMSSvc(32,2) = ""

arMSSvc(33,0) = "nla" : arMSSvc(33,1) = "svchost.exe" : arMSSvc(33,2) = "mswsock.dll"

arMSSvc(34,0) = "ntlmssp" : arMSSvc(34,1) = "lsass.exe" : arMSSvc(34,2) = ""

arMSSvc(35,0) = "sysmonlog" : arMSSvc(35,1) = "smlogsvc.exe" : arMSSvc(35,2) = ""

arMSSvc(36,0) = "plugplay" : arMSSvc(36,1) = "services.exe" : arMSSvc(36,2) = ""

arMSSvc(37,0) = "wmdmpmsp" : arMSSvc(37,1) = "svchost.exe" : arMSSvc(37,2) = "mspmspsv.dll"

arMSSvc(38,0) = "spooler" : arMSSvc(38,1) = "spoolsv.exe" : arMSSvc(38,2) = ""

arMSSvc(39,0) = "protectedstorage" : arMSSvc(39,1) = "lsass.exe" : arMSSvc(39,2) = ""

arMSSvc(40,0) = "rsvp" : arMSSvc(40,1) = "rsvp.exe" : arMSSvc(40,2) = ""

arMSSvc(41,0) = "rasauto" : arMSSvc(41,1) = "svchost.exe" : arMSSvc(41,2) = "rasauto.dll"

arMSSvc(42,0) = "rasman" : arMSSvc(42,1) = "svchost.exe" : arMSSvc(42,2) = "rasmans.dll"

arMSSvc(43,0) = "rdsessmgr" : arMSSvc(43,1) = "sessmgr.exe" : arMSSvc(43,2) = ""

arMSSvc(44,0) = "rpcss" : arMSSvc(44,1) = "svchost.exe" : arMSSvc(44,2) = "rpcss.dll"

arMSSvc(45,0) = "rpclocator" : arMSSvc(45,1) = "locator.exe" : arMSSvc(45,2) = ""

arMSSvc(46,0) = "remoteregistry" : arMSSvc(46,1) = "svchost.exe" : arMSSvc(46,2) = "regsvc.dll"

arMSSvc(47,0) = "ntmssvc" : arMSSvc(47,1) = "svchost.exe" : arMSSvc(47,2) = "ntmssvc.dll"

arMSSvc(48,0) = "remoteaccess" : arMSSvc(48,1) = "svchost.exe" : arMSSvc(48,2) = "mprdim.dll"

arMSSvc(49,0) = "seclogon" : arMSSvc(49,1) = "svchost.exe" : arMSSvc(49,2) = "seclogon.dll"

arMSSvc(50,0) = "samss" : arMSSvc(50,1) = "lsass.exe" : arMSSvc(50,2) = ""

arMSSvc(51,0) = "lanmanserver" : arMSSvc(51,1) = "svchost.exe" : arMSSvc(51,2) = "srvsvc.dll"

arMSSvc(52,0) = "smtpsvc" : arMSSvc(52,1) = "inetinfo.exe" : arMSSvc(52,2) = ""

arMSSvc(53,0) = "shellhwdetection" : arMSSvc(53,1) = "svchost.exe" : arMSSvc(53,2) = "shsvcs.dll"

arMSSvc(54,0) = "scardsvr" : arMSSvc(54,1) = "scardsvr.exe" : arMSSvc(54,2) = ""

arMSSvc(55,0) = "scarddrv" : arMSSvc(55,1) = "scardsvr.exe" : arMSSvc(55,2) = ""

arMSSvc(56,0) = "ssdpsrv" : arMSSvc(56,1) = "svchost.exe" : arMSSvc(56,2) = "ssdpsrv.dll"

arMSSvc(57,0) = "sens" : arMSSvc(57,1) = "svchost.exe" : arMSSvc(57,2) = "sens.dll"

arMSSvc(58,0) = "srservice" : arMSSvc(58,1) = "svchost.exe" : arMSSvc(58,2) = "srsvc.dll"

arMSSvc(59,0) = "schedule" : arMSSvc(59,1) = "svchost.exe" : arMSSvc(59,2) = "schedsvc.dll"

arMSSvc(60,0) = "lmhosts" : arMSSvc(60,1) = "svchost.exe" : arMSSvc(60,2) = "lmhsvc.dll"

arMSSvc(61,0) = "tapisrv" : arMSSvc(61,1) = "svchost.exe" : arMSSvc(61,2) = "tapisrv.dll"

arMSSvc(62,0) = "tlntsvr" : arMSSvc(62,1) = "tlntsvr.exe" : arMSSvc(62,2) = ""

arMSSvc(63,0) = "termservice" : arMSSvc(63,1) = "svchost.exe" : arMSSvc(63,2) = "termsrv.dll"

arMSSvc(64,0) = "themes" : arMSSvc(64,1) = "svchost.exe" : arMSSvc(64,2) = "shsvcs.dll"

arMSSvc(65,0) = "ups" : arMSSvc(65,1) = "ups.exe" : arMSSvc(65,2) = ""

arMSSvc(66,0) = "upnphost" : arMSSvc(66,1) = "svchost.exe" : arMSSvc(66,2) = "upnphost.dll"

arMSSvc(67,0) = "uploadmgr" : arMSSvc(67,1) = "svchost.exe" : arMSSvc(67,2) = "pchsvc.dll"

arMSSvc(68,0) = "vss" : arMSSvc(68,1) = "vssvc.exe" : arMSSvc(68,2) = ""

arMSSvc(69,0) = "webclient" : arMSSvc(69,1) = "svchost.exe" : arMSSvc(69,2) = "webclnt.dll"

arMSSvc(70,0) = "audiosrv" : arMSSvc(70,1) = "svchost.exe" : arMSSvc(70,2) = "audiosrv.dll"

arMSSvc(71,0) = "stisvc" : arMSSvc(71,1) = "svchost.exe" : arMSSvc(71,2) = "wiaservc.dll"

arMSSvc(72,0) = "msiserver" : arMSSvc(72,1) = "msiexec.exe" : arMSSvc(72,2) = ""

arMSSvc(73,0) = "winmgmt" : arMSSvc(73,1) = "svchost.exe" : arMSSvc(73,2) = "wmisvc.dll"

arMSSvc(74,0) = "wmi" : arMSSvc(74,1) = "svchost.exe" : arMSSvc(74,2) = "advapi32.dll"

arMSSvc(75,0) = "w32time" : arMSSvc(75,1) = "svchost.exe" : arMSSvc(75,2) = "w32time.dll"

arMSSvc(76,0) = "wzcsvc" : arMSSvc(76,1) = "svchost.exe" : arMSSvc(76,2) = "wzcsvc.dll"

arMSSvc(77,0) = "wmiapsrv" : arMSSvc(77,1) = "svchost.exe" : arMSSvc(77,2) = "wmiapsrv.dll"

arMSSvc(78,0) = "lanmanworkstation" : arMSSvc(78,1) = "svchost.exe" : arMSSvc(78,2) = "wkssvc.dll"

arMSSvc(79,0) = "w3svc" : arMSSvc(79,1) = "inetinfo.exe" : arMSSvc(79,2) = ""

arMSSvc(80,0) = "dcomlaunch" : arMSSvc(80,1) = "svchost.exe" : arMSSvc(80,2) = "rpcss.dll"

arMSSvc(81,0) = "irmon" : arMSSvc(81,1) = "svchost.exe" : arMSSvc(81,2) = "irmon.dll"

arMSSvc(82,0) = "ip6fwhlp" : arMSSvc(82,1) = "svchost.exe" : arMSSvc(82,2) = "ip6fwhlp.dll"

arMSSvc(83,0) = "wscsvc" : arMSSvc(83,1) = "svchost.exe" : arMSSvc(83,2) = "wscsvc.dll"

arMSSvc(84,0) = "wmiapsrv" : arMSSvc(84,1) = "wmiapsrv.exe" : arMSSvc(84,2) = ""

arMSSvc(85,0) = "httpfilter" : arMSSvc(85,1) = "svchost.exe" : arMSSvc(85,2) = "w3ssl.dll"

arMSSvc(86,0) = "xmlprov" : arMSSvc(86,1) = "svchost.exe" : arMSSvc(86,2) = "xmlprov.dll"

'WS2K3 only

arMSSvc(87,0) = "dfs" : arMSSvc(87,1) = "dfssvc.exe" : arMSSvc(87,2) = ""

arMSSvc(88,0) = "httpfilter" : arMSSvc(88,1) = "lsass.exe" : arMSSvc(88,2) = ""

arMSSvc(89,0) = "srvcsurg" : arMSSvc(89,1) = "srvcsurg.exe" : arMSSvc(89,2) = ""

arMSSvc(90,0) = "appmgr" : arMSSvc(90,1) = "appmgr.exe" : arMSSvc(90,2) = ""

arMSSvc(91,0) = "snmp" : arMSSvc(91,1) = "snmp.exe" : arMSSvc(91,2) = ""

arMSSvc(92,0) = "elementmgr" : arMSSvc(92,1) = "elementmgr.exe" : arMSSvc(92,2) = ""

arMSSvc(93,0) = "w3svc" : arMSSvc(93,1) = "svchost.exe" : arMSSvc(93,2) = "iisw3adm.dll"

ElseIf strOS = "W2K" Then

ReDim arMSSvc(65,2)

arMSSvc(0,0) = "alerter" : arMSSvc(0,1) = "services.exe" : arMSSvc(0,2) = ""

arMSSvc(1,0) = "appmgmt" : arMSSvc(1,1) = "services.exe" : arMSSvc(1,2) = ""

arMSSvc(2,0) = "wuauserv" : arMSSvc(2,1) = "svchost.exe" : arMSSvc(2,2) = "wuauserv.dll"

arMSSvc(3,0) = "bits" : arMSSvc(3,1) = "svchost.exe" : arMSSvc(3,2) = "qmgr.dll"

arMSSvc(4,0) = "clipsrv" : arMSSvc(4,1) = "clipsrv.exe" : arMSSvc(4,2) = ""

arMSSvc(5,0) = "eventsystem" : arMSSvc(5,1) = "svchost.exe" : arMSSvc(5,2) = "es.dll"

arMSSvc(6,0) = "browser" : arMSSvc(6,1) = "services.exe" : arMSSvc(6,2) = ""

arMSSvc(7,0) = "dhcp" : arMSSvc(7,1) = "services.exe" : arMSSvc(7,2) = ""

arMSSvc(8,0) = "trkwks" : arMSSvc(8,1) = "services.exe" : arMSSvc(8,2) = ""

arMSSvc(9,0) = "msdtc" : arMSSvc(9,1) = "msdtc.exe" : arMSSvc(9,2) = ""

arMSSvc(10,0) = "dnscache" : arMSSvc(10,1) = "services.exe" : arMSSvc(10,2) = ""

arMSSvc(11,0) = "eventlog" : arMSSvc(11,1) = "services.exe" : arMSSvc(11,2) = ""

arMSSvc(12,0) = "fax" : arMSSvc(12,1) = "faxsvc.exe" : arMSSvc(12,2) = ""

arMSSvc(13,0) = "iisadmin" : arMSSvc(13,1) = "inetinfo.exe" : arMSSvc(13,2) = ""

arMSSvc(14,0) = "cisvc" : arMSSvc(14,1) = "cisvc.exe" : arMSSvc(14,2) = ""

arMSSvc(15,0) = "sharedaccess" : arMSSvc(15,1) = "svchost.exe" : arMSSvc(15,2) = "ipnathlp.dll"

arMSSvc(16,0) = "policyagent" : arMSSvc(16,1) = "lsass.exe" : arMSSvc(16,2) = ""

arMSSvc(17,0) = "dmserver" : arMSSvc(17,1) = "services.exe" : arMSSvc(17,2) = ""

arMSSvc(18,0) = "dmadmin" : arMSSvc(18,1) = "dmadmin.exe" : arMSSvc(18,2) = ""

arMSSvc(19,0) = "messenger" : arMSSvc(19,1) = "services.exe" : arMSSvc(19,2) = ""

arMSSvc(20,0) = "netlogon" : arMSSvc(20,1) = "lsass.exe" : arMSSvc(20,2) = ""

arMSSvc(21,0) = "mnmsrvc" : arMSSvc(21,1) = "mnmsrvc.exe" : arMSSvc(21,2) = ""

arMSSvc(22,0) = "netman" : arMSSvc(22,1) = "svchost.exe" : arMSSvc(22,2) = "netman.dll"

arMSSvc(23,0) = "netdde" : arMSSvc(23,1) = "netdde.exe" : arMSSvc(23,2) = ""

arMSSvc(24,0) = "ntlmssp" : arMSSvc(24,1) = "lsass.exe" : arMSSvc(24,2) = ""

arMSSvc(25,0) = "sysmonlog" : arMSSvc(25,1) = "smlogsvc.exe" : arMSSvc(25,2) = ""

arMSSvc(26,0) = "plugplay" : arMSSvc(26,1) = "services.exe" : arMSSvc(26,2) = ""

arMSSvc(27,0) = "wmdmpmsn" : arMSSvc(27,1) = "svchost.exe" : arMSSvc(27,2) = "mspmsnsv.dll"

arMSSvc(28,0) = "spooler" : arMSSvc(28,1) = "spoolsv.exe" : arMSSvc(28,2) = ""

arMSSvc(29,0) = "protectedstorage" : arMSSvc(29,1) = "services.exe" : arMSSvc(29,2) = ""

arMSSvc(30,0) = "rsvp" : arMSSvc(30,1) = "rsvp.exe" : arMSSvc(30,2) = ""

arMSSvc(31,0) = "rasauto" : arMSSvc(31,1) = "svchost.exe" : arMSSvc(31,2) = "rasauto.dll"

arMSSvc(32,0) = "rasman" : arMSSvc(32,1) = "svchost.exe" : arMSSvc(32,2) = "rasmans.dll"

arMSSvc(33,0) = "rpcss" : arMSSvc(33,1) = "svchost.exe" : arMSSvc(33,2) = "rpcss.dll"

arMSSvc(34,0) = "rpclocator" : arMSSvc(34,1) = "locator.exe" : arMSSvc(34,2) = ""

arMSSvc(35,0) = "remoteregistry" : arMSSvc(35,1) = "regsvc.exe" : arMSSvc(35,2) = ""

arMSSvc(36,0) = "ntmssvc" : arMSSvc(36,1) = "svchost.exe" : arMSSvc(36,2) = "ntmssvc.dll"

arMSSvc(37,0) = "remoteaccess" : arMSSvc(37,1) = "svchost.exe" : arMSSvc(37,2) = "mprdim.dll"

arMSSvc(38,0) = "seclogon" : arMSSvc(38,1) = "services.exe" : arMSSvc(38,2) = ""

arMSSvc(39,0) = "samss" : arMSSvc(39,1) = "lsass.exe" : arMSSvc(39,2) = ""

arMSSvc(40,0) = "lanmanserver" : arMSSvc(40,1) = "services.exe" : arMSSvc(40,2) = ""

arMSSvc(41,0) = "smtpsvc" : arMSSvc(41,1) = "inetinfo.exe" : arMSSvc(41,2) = ""

arMSSvc(42,0) = "scardsvr" : arMSSvc(42,1) = "scardsvr.exe" : arMSSvc(42,2) = ""

arMSSvc(43,0) = "scarddrv" : arMSSvc(43,1) = "scardsvr.exe" : arMSSvc(43,2) = ""

arMSSvc(44,0) = "stisvc" : arMSSvc(44,1) = "stisvc.exe" : arMSSvc(44,2) = ""

arMSSvc(45,0) = "sens" : arMSSvc(45,1) = "svchost.exe" : arMSSvc(45,2) = "sens.dll"

arMSSvc(46,0) = "schedule" : arMSSvc(46,1) = "mstask.exe" : arMSSvc(46,2) = ""

arMSSvc(47,0) = "lmhosts" : arMSSvc(47,1) = "services.exe" : arMSSvc(47,2) = ""

arMSSvc(48,0) = "tapisrv" : arMSSvc(48,1) = "svchost.exe" : arMSSvc(48,2) = "tapisrv.dll"

arMSSvc(49,0) = "tlntsvr" : arMSSvc(49,1) = "tlntsvr.exe" : arMSSvc(49,2) = ""

arMSSvc(50,0) = "ups" : arMSSvc(50,1) = "ups.exe" : arMSSvc(50,2) = ""

arMSSvc(51,0) = "msiserver" : arMSSvc(51,1) = "msiexec.exe" : arMSSvc(51,2) = ""

arMSSvc(52,0) = "winmgmt" : arMSSvc(52,1) = "winmgmt.exe" : arMSSvc(52,2) = ""

arMSSvc(53,0) = "wmi" : arMSSvc(53,1) = "services.exe" : arMSSvc(53,2) = ""

arMSSvc(54,0) = "w32time" : arMSSvc(54,1) = "services.exe" : arMSSvc(54,2) = ""

arMSSvc(55,0) = "wzcsvc" : arMSSvc(55,1) = "svchost.exe" : arMSSvc(55,2) = "wzcsvc.dll"

arMSSvc(56,0) = "lanmanworkstation" : arMSSvc(56,1) = "services.exe" : arMSSvc(56,2) = ""

arMSSvc(57,0) = "w3svc" : arMSSvc(57,1) = "inetinfo.exe" : arMSSvc(57,2) = ""

arMSSvc(58,0) = "wmdm pmsp service" : arMSSvc(58,1) = "mspmspsv.exe" : arMSSvc(58,2) = ""

arMSSvc(59,0) = "msftpsvc" : arMSSvc(59,1) = "inetinfo.exe" : arMSSvc(59,2) = ""

arMSSvc(60,0) = "irmon" : arMSSvc(60,1) = "svchost.exe" : arMSSvc(60,2) = "irmon.dll"

'W2KS

arMSSvc(61,0) = "dhcpServer" : arMSSvc(61,1) = "tcpsvcs.exe" : arMSSvc(61,2) = ""

arMSSvc(62,0) = "dfs" : arMSSvc(62,1) = "dfssvc.exe" : arMSSvc(62,2) = ""

arMSSvc(63,0) = "dns" : arMSSvc(63,1) = "dns.exe" : arMSSvc(63,2) = ""

arMSSvc(64,0) = "ias" : arMSSvc(64,1) = "svchost.exe" : arMSSvc(64,2) = "ias.dll"

arMSSvc(65,0) = "licenseservice" : arMSSvc(65,1) = "llssrv.exe" : arMSSvc(65,2) = ""

ElseIf strOs = "NT4" Then

ReDim arMSSvc(27,2)

arMSSvc(0,0) = "alerter" : arMSSvc(0,1) = "services.exe" : arMSSvc(0,2) = ""

arMSSvc(1,0) = "clipsrv" : arMSSvc(1,1) = "clipsrv.exe" : arMSSvc(1,2) = ""

arMSSvc(2,0) = "eventsystem" : arMSSvc(2,1) = "esserver.exe" : arMSSvc(2,2) = ""

arMSSvc(3,0) = "browser" : arMSSvc(3,1) = "services.exe" : arMSSvc(3,2) = ""

arMSSvc(4,0) = "dhcp" : arMSSvc(4,1) = "services.exe" : arMSSvc(4,2) = ""

arMSSvc(5,0) = "replicator" : arMSSvc(5,1) = "lmrepl.exe" : arMSSvc(5,2) = ""

arMSSvc(6,0) = "eventlog" : arMSSvc(6,1) = "services.exe" : arMSSvc(6,2) = ""

arMSSvc(7,0) = "messenger" : arMSSvc(7,1) = "services.exe" : arMSSvc(7,2) = ""

arMSSvc(8,0) = "netlogon" : arMSSvc(8,1) = "lsass.exe" : arMSSvc(8,2) = ""

arMSSvc(9,0) = "netdde" : arMSSvc(9,1) = "netdde.exe" : arMSSvc(9,2) = ""

arMSSvc(10,0) = "netddedsdm" : arMSSvc(10,1) = "netdde.exe" : arMSSvc(10,2) = ""

arMSSvc(11,0) = "ntlmssp" : arMSSvc(11,1) = "services.exe" : arMSSvc(11,2) = ""

arMSSvc(12,0) = "plugplay" : arMSSvc(12,1) = "services.exe" : arMSSvc(12,2) = ""

arMSSvc(13,0) = "protectedstorage" : arMSSvc(13,1) = "pstores.exe" : arMSSvc(13,2) = ""

arMSSvc(14,0) = "rasauto" : arMSSvc(14,1) = "rasman.exe" : arMSSvc(14,2) = ""

arMSSvc(15,0) = "rasman" : arMSSvc(15,1) = "rasman.exe" : arMSSvc(15,2) = ""

arMSSvc(16,0) = "rpclocator" : arMSSvc(16,1) = "locator.exe" : arMSSvc(16,2) = ""

arMSSvc(17,0) = "rpcss" : arMSSvc(17,1) = "rpcss.exe" : arMSSvc(17,2) = ""

arMSSvc(18,0) = "lanmanserver" : arMSSvc(18,1) = "services.exe" : arMSSvc(18,2) = ""

arMSSvc(19,0) = "spooler" : arMSSvc(19,1) = "spoolss.exe" : arMSSvc(19,2) = ""

arMSSvc(20,0) = "sens" : arMSSvc(20,1) = "sens.exe" : arMSSvc(20,2) = ""

arMSSvc(21,0) = "schedule" : arMSSvc(21,1) = "mstask.exe" : arMSSvc(21,2) = ""

arMSSvc(22,0) = "lmhosts" : arMSSvc(22,1) = "services.exe" : arMSSvc(22,2) = ""

arMSSvc(23,0) = "tapisrv" : arMSSvc(23,1) = "tapisrv.exe" : arMSSvc(23,2) = ""

arMSSvc(24,0) = "ups" : arMSSvc(24,1) = "ups.exe" : arMSSvc(24,2) = ""

arMSSvc(25,0) = "msiserver" : arMSSvc(25,1) = "msiexec.exe" : arMSSvc(25,2) = ""

arMSSvc(26,0) = "winmgmt" : arMSSvc(26,1) = "winmgmt.exe" : arMSSvc(26,2) = ""

arMSSvc(27,0) = "lanmanworkstation" : arMSSvc(27,1) = "services.exe" : arMSSvc(27,2) = ""

ElseIf strOS = "WVA" Then

ReDim arMSSvc(76,2)

arMSSvc(0,0) = "aelookupsvc" : arMSSvc(0,1) = "svchost.exe" : arMSSvc(0,2) = "aelupsvc.dll"

arMSSvc(1,0) = "appinfo" : arMSSvc(1,1) = "svchost.exe" : arMSSvc(1,2) = "appinfo.dll"

arMSSvc(2,0) = "AudioEndpointBuilder" : arMSSvc(2,1) = "svchost.exe" : arMSSvc(2,2) = "Audiosrv.dll"

arMSSvc(3,0) = "Audiosrv" : arMSSvc(3,1) = "svchost.exe" : arMSSvc(3,2) = "Audiosrv.dll"

arMSSvc(4,0) = "BITS" : arMSSvc(4,1) = "svchost.exe" : arMSSvc(4,2) = "qmgr.dll"

arMSSvc(5,0) = "bfe" : arMSSvc(5,1) = "svchost.exe" : arMSSvc(5,2) = "bfe.dll"

arMSSvc(6,0) = "CryptSvc" : arMSSvc(6,1) = "svchost.exe" : arMSSvc(6,2) = "cryptsvc.dll"

arMSSvc(7,0) = "CscService" : arMSSvc(7,1) = "svchost.exe" : arMSSvc(7,2) = "cscsvc.dll"

arMSSvc(8,0) = "DcomLaunch" : arMSSvc(8,1) = "svchost.exe" : arMSSvc(8,2) = "rpcss.dll"

arMSSvc(9,0) = "Dhcp" : arMSSvc(9,1) = "svchost.exe" : arMSSvc(9,2) = "dhcpcsvc.dll"

arMSSvc(10,0) = "Dnscache" : arMSSvc(10,1) = "svchost.exe" : arMSSvc(10,2) = "dnsrslvr.dll"

arMSSvc(11,0) = "dps" : arMSSvc(11,1) = "svchost.exe" : arMSSvc(11,2) = "dps.dll"

arMSSvc(12,0) = "EMDMgmt" : arMSSvc(12,1) = "svchost.exe" : arMSSvc(12,2) = "emdmgmt.dll"

arMSSvc(13,0) = "Eventlog" : arMSSvc(13,1) = "svchost.exe" : arMSSvc(13,2) = "wevtsvc.dll" 'ServiceDll value in main key

arMSSvc(14,0) = "EventSystem" : arMSSvc(14,1) = "svchost.exe" : arMSSvc(14,2) = "es.dll"

arMSSvc(15,0) = "fdphost" : arMSSvc(15,1) = "svchost.exe" : arMSSvc(15,2) = "fdphost.dll"

arMSSvc(16,0) = "gpsvc" : arMSSvc(16,1) = "svchost.exe" : arMSSvc(16,2) = "gpsvc.dll"

arMSSvc(17,0) = "ikeext" : arMSSvc(17,1) = "svchost.exe" : arMSSvc(17,2) = "ikeext.dll"

arMSSvc(18,0) = "iphlpsvc" : arMSSvc(18,1) = "svchost.exe" : arMSSvc(18,2) = "iphlpsvc.dll" 'missing data!

arMSSvc(19,0) = "KtmRm" : arMSSvc(19,1) = "svchost.exe" : arMSSvc(19,2) = "msdtckrm.dll"

arMSSvc(20,0) = "LanmanServer" : arMSSvc(20,1) = "svchost.exe" : arMSSvc(20,2) = "srvsvc.dll"

arMSSvc(21,0) = "LanmanWorkstation" : arMSSvc(21,1) = "svchost.exe" : arMSSvc(21,2) = "wkssvc.dll"

arMSSvc(22,0) = "lmhosts" : arMSSvc(22,1) = "svchost.exe" : arMSSvc(22,2) = "lmhsvc.dll" 'missing data!

arMSSvc(23,0) = "MMCSS" : arMSSvc(23,1) = "svchost.exe" : arMSSvc(23,2) = "mmcss.dll"

arMSSvc(24,0) = "MpsSvc" : arMSSvc(24,1) = "svchost.exe" : arMSSvc(24,2) = "mpssvc.dll"

arMSSvc(25,0) = "Netman" : arMSSvc(25,1) = "svchost.exe" : arMSSvc(25,2) = "netman.dll"

arMSSvc(26,0) = "netprofm" : arMSSvc(26,1) = "svchost.exe" : arMSSvc(26,2) = "netprofm.dll"

arMSSvc(27,0) = "NlaSvc" : arMSSvc(27,1) = "svchost.exe" : arMSSvc(27,2) = "nlasvc.dll"

arMSSvc(28,0) = "nsi" : arMSSvc(28,1) = "svchost.exe" : arMSSvc(28,2) = "nsisvc.dll" 'missing data!

arMSSvc(29,0) = "PcaSvc" : arMSSvc(29,1) = "svchost.exe" : arMSSvc(29,2) = "pcasvc.dll"

arMSSvc(30,0) = "PlugPlay" : arMSSvc(30,1) = "svchost.exe" : arMSSvc(30,2) = "umpnpmgr.dll"

arMSSvc(31,0) = "PolicyAgent" : arMSSvc(31,1) = "svchost.exe" : arMSSvc(31,2) = "ipsecsvc.dll"

arMSSvc(32,0) = "ProfSvc" : arMSSvc(32,1) = "svchost.exe" : arMSSvc(32,2) = "profsvc.dll"

arMSSvc(33,0) = "RasMan" : arMSSvc(33,1) = "svchost.exe" : arMSSvc(33,2) = "rasmans.dll"

arMSSvc(34,0) = "RpcSs" : arMSSvc(34,1) = "svchost.exe" : arMSSvc(34,2) = "rpcss.dll"

arMSSvc(35,0) = "SamSs" : arMSSvc(35,1) = "lsass.exe" : arMSSvc(35,2) = ""

arMSSvc(36,0) = "Schedule" : arMSSvc(36,1) = "svchost.exe" : arMSSvc(36,2) = "schedsvc.dll"

arMSSvc(37,0) = "seclogon" : arMSSvc(37,1) = "svchost.exe" : arMSSvc(37,2) = "seclogon.dll"

arMSSvc(38,0) = "SENS" : arMSSvc(38,1) = "svchost.exe" : arMSSvc(38,2) = "sens.dll"

arMSSvc(39,0) = "ShellHWDetection" : arMSSvc(39,1) = "svchost.exe" : arMSSvc(39,2) = "shsvcs.dll"

arMSSvc(40,0) = "slsvc" : arMSSvc(40,1) = "SLsvc.exe" : arMSSvc(40,2) = ""

arMSSvc(41,0) = "Spooler" : arMSSvc(41,1) = "spoolsv.exe" : arMSSvc(41,2) = ""

arMSSvc(42,0) = "SSDPSRV" : arMSSvc(42,1) = "svchost.exe" : arMSSvc(42,2) = "ssdpsrv.dll"

arMSSvc(43,0) = "SysMain" : arMSSvc(43,1) = "svchost.exe" : arMSSvc(43,2) = "sysmain.dll"

arMSSvc(44,0) = "TabletInputService" : arMSSvc(44,1) = "svchost.exe" : arMSSvc(44,2) = "TabSvc.dll"

arMSSvc(45,0) = "TapiSrv" : arMSSvc(45,1) = "svchost.exe" : arMSSvc(45,2) = "tapisrv.dll"

arMSSvc(46,0) = "TermService" : arMSSvc(46,1) = "svchost.exe" : arMSSvc(46,2) = "termsrv.dll"

arMSSvc(47,0) = "Themes" : arMSSvc(47,1) = "svchost.exe" : arMSSvc(47,2) = "shsvcs.dll"

arMSSvc(48,0) = "THREADORDER" : arMSSvc(48,1) = "svchost.exe" : arMSSvc(48,2) = "mmcss.dll"

arMSSvc(49,0) = "TrkWks" : arMSSvc(49,1) = "svchost.exe" : arMSSvc(49,2) = "trkwks.dll"

arMSSvc(50,0) = "TrustedInstaller" : arMSSvc(50,1) = "TrustedInstaller.exe" : arMSSvc(50,2) = ""

arMSSvc(51,0) = "uxsms" : arMSSvc(51,1) = "svchost.exe" : arMSSvc(51,2) = "uxsms.dll"

arMSSvc(52,0) = "W32Time" : arMSSvc(52,1) = "svchost.exe" : arMSSvc(52,2) = "w32time.dll"

arMSSvc(53,0) = "wdisystemhost" : arMSSvc(53,1) = "svchost.exe" : arMSSvc(53,2) = "wdi.dll"

arMSSvc(54,0) = "WebClient" : arMSSvc(54,1) = "svchost.exe" : arMSSvc(54,2) = "webclnt.dll"

arMSSvc(55,0) = "WerSvc" : arMSSvc(55,1) = "svchost.exe" : arMSSvc(55,2) = "WerSvc.dll"

arMSSvc(56,0) = "WinDefend" : arMSSvc(56,1) = "svchost.exe" : arMSSvc(56,2) = "mpsvc.dll"

arMSSvc(57,0) = "WinHttpAutoProxySvc" : arMSSvc(57,1) = "svchost.exe" : arMSSvc(57,2) = "winhttp.dll"

arMSSvc(58,0) = "Winmgmt" : arMSSvc(58,1) = "svchost.exe" : arMSSvc(58,2) = "WMIsvc.dll"

arMSSvc(59,0) = "WPDBusEnum" : arMSSvc(59,1) = "svchost.exe" : arMSSvc(59,2) = "wpdbusenum.dll"

arMSSvc(60,0) = "wscsvc" : arMSSvc(60,1) = "svchost.exe" : arMSSvc(60,2) = "wscsvc.dll"

arMSSvc(61,0) = "WSearch" : arMSSvc(61,1) = "SearchIndexer.exe" : arMSSvc(61,2) = ""

arMSSvc(62,0) = "wuauserv" : arMSSvc(62,1) = "svchost.exe" : arMSSvc(62,2) = "wuaueng.dll"

arMSSvc(63,0) = "ProtectedStorage" : arMSSvc(63,1) = "lsass.exe" : arMSSvc(63,2) = ""

arMSSvc(64,0) = "NfsClnt" : arMSSvc(64,1) = "nfsclnt.exe" : arMSSvc(64,2) = ""

arMSSvc(65,0) = "IISADMIN" : arMSSvc(65,1) = "inetinfo.exe" : arMSSvc(65,2) = ""

arMSSvc(66,0) = "MSMQ" : arMSSvc(66,1) = "mqsvc.exe" : arMSSvc(66,2) = ""

arMSSvc(67,0) = "MSMQTriggers" : arMSSvc(67,1) = "mqtgsvc.exe" : arMSSvc(67,2) = ""

arMSSvc(68,0) = "iprip" : arMSSvc(68,1) = "svchost.exe" : arMSSvc(68,2) = "iprip.dll"

arMSSvc(69,0) = "SNMP" : arMSSvc(69,1) = "snmp.exe" : arMSSvc(69,2) = ""

arMSSvc(70,0) = "LPDSVC" : arMSSvc(70,1) = "tcpsvcs.exe" : arMSSvc(70,2) = ""

arMSSvc(71,0) = "WAS" : arMSSvc(71,1) = "svchost.exe" : arMSSvc(71,2) = "iisw3adm.dll"

arMSSvc(72,0) = "W3SVC" : arMSSvc(72,1) = "svchost.exe" : arMSSvc(72,2) = "iisw3adm.dll"

arMSSvc(73,0) = "swprv" : arMSSvc(73,1) = "svchost.exe" : arMSSvc(73,2) = "swprv.dll"

arMSSvc(74,0) = "VSS" : arMSSvc(74,1) = "vssvc.exe" : arMSSvc(74,2) = ""

arMSSvc(75,0) = "upnphost" : arMSSvc(75,1) = "svchost.exe" : arMSSvc(75,2) = "upnphost.dll"

arMSSvc(76,0) = "FDResPub" : arMSSvc(76,1) = "svchost.exe" : arMSSvc(76,2) = "fdrespub.dll"

' arMSSvc(77,0) = "" : arMSSvc(77,1) = "svchost.exe" : arMSSvc(77,2) = ""

End If 'filling MS default services array

'Services collection, Service object,

Dim colSvce, oSvce

'lowest-sort name holder, temp variables x 3

Dim intLSS, str1stName, strT0, strT1, strT2

Dim flagSM : flagSM = False 'Safe Mode flag

'for W2K/WXP/WVa, determine if running in Safe Mode

If strOS <> "NT4" Then

strKey = "SYSTEM\CurrentControlSet\Control"

intErrNum = oReg.GetStringValue (HKLM,strKey,"SystemStartOptions",strValue)

'if name exists

If intErrNum = 0 Then

'check if in Safe Mode

If InStr(LCase(strValue),"safeboot") <> 0 Then flagSM = True

End If

End If 'W2K/WXP/WVa?

'set up title line for normal, ShowAll, Safe Mode operation

strTitle = "Running Services (Display Name, Service Name, Path {Service DLL}):"

If flagShowAll Then strTitle = "All Running Services (Display Name, Service Name, Path {Service DLL}):"

If flagSM Then strTitle = "All Non-Disabled Services (Display Name, " &_

"Service Name, Path {Service DLL}):"

'if in Safe Mode

If flagSM Then

'get collection of services with Auto or Manual "Startup type"

Set colSvce = GetObject("winmgmts:\root\cimv2").ExecQuery("SELECT DisplayName, " &_

"Name, PathName FROM Win32_Service WHERE StartMode = ""Manual"" " &_

"Or StartMode = ""Auto""")

'not in Safe Mode

Else

'get collection of started services

Set colSvce = GetObject("winmgmts:\root\cimv2").ExecQuery("SELECT DisplayName, " &_

"Name, PathName FROM Win32_Service WHERE Started = True")

End If 'safe mode?

'sort services by display name

'get the count

On Error Resume Next

intCnt = colSvce.Count

intErrNum = Err.Number : Err.Clear

On Error Goto 0

'output warning and exit if count impeded

If intErrNum <> 0 Then

flagIWarn = True

TitleLineWrite

oFN.WriteLine vbCRLF & IWarn &_

"The running services cannot be counted." & vbCRLF &_

"Presence of a spyware service is suspected." & vbCRLF &_

"The script has been forced to exit."

SRClose

WScript.Quit

End If

'set up two arrays: work array & sorted array

Dim arSvces()

ReDim arSvces(intCnt-1, 2) 'services array

i = 0

'transfer data from collection to array

For Each oSvce in colSvce

arSvces(i,0) = oSvce.DisplayName : arSvces(i,1) = oSvce.Name

'check for null values or empty strings returned by WMI

If IsNull(oSvce.PathName) Then

arSvces(i,2) = "(null value)"

ElseIf oSvce.PathName = "" Then

arSvces(i,2) = "(empty string)"

Else

arSvces(i,2) = oSvce.PathName

End If

i = i + 1

Next 'service in collection

Set colSvce=Nothing

'for every service in array up to the next to last one

For i = 0 To UBound(arSvces,1) - 1

'store array row in temp variables

strT0 = arSvces(i,0)

strT1 = arSvces(i,1)

strT2 = arSvces(i,2)

'initialize the sorted name & lowest-sort subscript

str1stName = arSvces(i,0)

intLSS = i

'for every subsequent service in array up to the last one

For j = i + 1 To UBound(arSvces,1)

'if current array name < saved lowest-sort name,

'reset sorted array data and

'set lowest-sort subscript = current array subscript

If LCase(arSvces(j,0)) < LCase(str1stName) Then

str1stName = arSvces(j,0)

intLSS = j

End If

Next 'j array element

'set current array position = lowest-sort subscript element

arSvces(i,0) = arSvces(intLSS,0)

arSvces(i,1) = arSvces(intLSS,1)

arSvces(i,2) = arSvces(intLSS,2)

'save data formerly in current array position to array position just vacated

arSvces(intLSS,0) = strT0

arSvces(intLSS,1) = strT1

arSvces(intLSS,2) = strT2

Next 'i sorted name array element

'for every service sorted by display name

For i = 0 To UBound(arSvces,1)

'format path name for output

If arSvces(i,2) = "(null value)" Then

strPathNameOut = "(null value)"

ElseIf arSvces(i,2) = "(empty string)" Then

strPathNameOut = "(empty string)"

Else

strPathNameOut = StringFilter(arSvces(i,2),True)

End If

intMSSvcNo = -1 'assume not an MS Service

'find company name

strCN = CoName(IDExe(arSvces(i,2)))

'if service name found in MS default services array, save array subscript

For j = 0 To UBound(arMSSvc,1)

If LCase(arSvces(i,1)) = LCase(arMSSvc(j,0)) Then

intMSSvcNo = j : Exit For

End If

Next 'arMSSvc (MS Service)

'for services with unique file names

If InStr(LCase(arSvces(i,2)),"services.exe") = 0 And _

InStr(LCase(arSvces(i,2)),"svchost") = 0 Then

'find last backslash in service executable path

intLBSP = InStrRev(arSvces(i,2),"\")

'set position to 0 if no backslash present

If IsNull(intLBSP) Then intLBSP = 0

'extract service executable

strExeName = Mid(IDExe(arSvces(i,2)),intLBSP+1)

'if not MS default service Or ShowAll

If intMSSvcNo < 0 Or flagShowAll Then

If strTitle <> "" Then

TitleLineWrite : oFN.WriteBlankLines (1)

End If

'output display name, service name, path

oFN.WriteLine StringFilter(arSvces(i,0),False) & ", " &_

StringFilter(arSvces(i,1),False) & ", " &_

strPathNameOut & strCN

'if MS default service And (executable name or CoName doesn't match expected value)

ElseIf intMSSvcNo >= 0 And _

(LCase(strExeName) <> LCase(arMSSvc(intMSSvcNo,1)) Or _

strCN <> MS) Then

If strTitle <> "" Then

TitleLineWrite : oFN.WriteBlankLines (1)

End If

'output display name, service name, path

oFN.WriteLine StringFilter(arSvces(i,0),False) & ", " &_

StringFilter(arSvces(i,1),False) & ", " &_

strPathNameOut & strCN

End If 'MS default service with unexpected executable/CoName?

'shared process -- look for ServiceDLL value in Parameter subkey

ElseIf InStr(LCase(arSvces(i,2)),"svchost") > 0 And _

InStr(LCase(arSvces(i,2))," -k") > 0 Then

strKey = "System\CurrentControlSet\Services\"

intErrNum = oReg.GetExpandedStringValue (HKLM,strKey & arSvces(i,1) &_

"\Parameters","ServiceDll",strValue)

'prepare output for missing Parameters key or ServiceDLL value

strLine = " {(missing data)}"

strCN = CoName(IDExe(strValue))

If intErrNum = 0 And strValue <> "" Then

strLine = " {" & DQ & strValue & DQ & strCN & "}"

'extract ServiceDLL filename.ext

strDLL = Fso.GetFileName(strValue)

flagMatch = True

'if ShowAll Or DLL name/CoName have unexpected values

If flagShowAll Or LCase(strCN) <> " [ms]" Or intMSSvcNo = -1 Then

flagMatch = False

ElseIf LCase(strDLL) <> LCase(arMSSvc(intMSSvcNo,2)) Then

flagMatch = False

End If

If Not flagMatch Then

If strTitle <> "" Then

TitleLineWrite : oFN.WriteBlankLines (1)

End If

'output display name, service name, path

oFN.WriteLine StringFilter(arSvces(i,0),False) & ", " &_

StringFilter(arSvces(i,1),False) & ", " &_

strPathNameOut & strLine

End If 'flagMatch?

Else 'Parameters\ServiceDll not found so check service key

intErrNum1 = oReg.GetExpandedStringValue (HKLM,strKey & arSvces(i,1), _

"ServiceDll",strValue1)

'prepare output for missing Parameters key or ServiceDLL value

strLine = " {(missing data)}"

strCN = CoName(IDExe(strValue1))

If intErrNum1 = 0 And strValue1 <> "" Then

strLine = " {" & DQ & strValue1 & DQ & strCN & "}"

'extract ServiceDLL filename.ext

strDLL = Fso.GetFileName(strValue1)

flagMatch = True

'if ShowAll Or DLL name/CoName have unexpected values

If flagShowAll Or LCase(strCN) <> " [ms]" Or intMSSvcNo = -1 Then

flagMatch = False

ElseIf LCase(strDLL) <> LCase(arMSSvc(intMSSvcNo,2)) Then

flagMatch = False

End If

If Not flagMatch Then

If strTitle <> "" Then

TitleLineWrite : oFN.WriteBlankLines (1)

End If

'output display name, service name, path

oFN.WriteLine StringFilter(arSvces(i,0),False) & ", " &_

StringFilter(arSvces(i,1),False) & ", " &_

strPathNameOut & strLine

End If 'flagMatch?

End If 'ServiceDll exists at service key?

End If 'Parameters\ServiceDll exists?

'services.exe

Else

'extract service executable filename.ext

strExeName = Fso.GetFileName(arSvces(i,2))

flagMatch = True

'if ShowAll Or service name <> Services.exe or CoName <> MS

If flagShowAll Or LCase(strCN) <> " [ms]" Or intMSSvcNo = -1 Then

flagMatch = False

ElseIf LCase(strExeName) <> LCase(arMSSvc(intMSSvcNo,1)) Then

flagMatch = False

End If

If Not flagMatch Then

If strTitle <> "" Then

TitleLineWrite : oFN.WriteBlankLines (1)

End If

'output display name, service name, path

oFN.WriteLine StringFilter(arSvces(i,0),False) & ", " &_

StringFilter(arSvces(i,1),False) & ", " &_

strPathNameOut & strCN

End If

End If 'independent file, svchost, or services?

Next 'service file

'recover array memory

ReDim arSvces(0,0)

ReDim arMSSvc(0,0)

End If 'NT4-type O/S?

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

End If 'SecTest?

'#28. Accessibility Tools

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)

If Not flagTest Or (flagTest And SecTest) Then

'prepare title line

strTitle = "Accessibility Tools:"

'in W2K, recurse Utility Manager subkeys

If strOS = "W2K" Then

strKey = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Accessibility\Utility Manager"

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

ReDim arAllowedNames(2) : arAllowedNames(0) = "magnifier.exe"

arAllowedNames(1) = "narrator.exe" : arAllowedNames(2) = "osk.exe"

'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

'get the configured startup values (dword returned as string)

strValue1 = RtnValue (HKLM, strKey & "\" & strSubKey, "Start with Utility Manager", REG_DWORD)

strValue2 = RtnValue (HKLM, strKey & "\" & strSubKey, "Start with Windows", REG_DWORD)

'if startup enabled (dword = 1)

If LCase(strValue1) = "dword:0x00000001" Or LCase(strValue2) = "dword:0x00000001" Then

'use new subtitle

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

strWarn = IWarn 'assume app path is not an allowed executable

'retrieve Application Path value & find CN

strValue3 = RtnValue (HKLM, strKey & "\" & strSubKey, "Application Path", REG_SZ)

strCN = CoName(IDExe(strValue3))

'empty strWarn if app path/CoName OK or app path empty

For i = 0 To UBound(arAllowedNames)

If (LCase(strValue3) = arAllowedNames(i) And strCN = MS) Or _

LCase(strValue3) = "(empty string)" Then

strWarn = "" : Exit For

End If

If strWarn <> "" Then flagIWarn = True

'output the title line if not already done

TitleLineWrite

'retrieve Display Name value

strValue4 = RtnValue (HKLM, strKey & "\" & strSubKey, "Display Name", REG_SZ)

'output data

oFN.WriteLine strWarn & DQ & "Application Path" & DQ & " = " &_

StringFilter(strValue3,True) & strCN & vbCRLF &_

DQ & "Display Name" & DQ & " = " & StringFilter(strValue4,True)

If LCase(strValue1) = "dword:0x00000001" Then _

oFN.WriteLine DQ & "Start with Utility Manager" & DQ & " = " & strValue1

If LCase(strValue2) = "dword:0x00000001" Then _

oFN.WriteLine DQ & "Start with Windows" & DQ & " = " & strValue2

End If 'sub-key name exists & dword = 1

Next 'sub-key

End If 'sub-key array exists?

'if ShowAll, output the key name if not already done

If flagShowAll Then TitleLineWrite

'clean up

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

ReDim arAllowedNames(0)

End If 'W2K?

'examine 4 WVa keys for accessibility tool names

If strOS = "WVA" Then

Public intUB : intUB = -1 'Upper Bound of unique accessibility tool array

ReDim arAllowedNames(2) : arAllowedNames(0) = "magnify.exe"

arAllowedNames(1) = "narrator.exe" : arAllowedNames(2) = "osk.exe"

'2 principal keys: HKCU/HKLM...Accessibility

strKey = "Software\Microsoft\Windows NT\CurrentVersion\Accessibility"

'for each hive

For ctrCH = intCLL To 1

strSubTitle = SOCA(arHives(ctrCH,0) & "\" & strKey & "\")

intErrNum = oReg.GetStringValue (arHives(ctrCH,1),strKey,"Configuration",strValue)

'if strValue exists & not empty or ShowAll

If (intErrNum = 0 And strValue <> "") Or flagShowAll Then

If intErrNum = 0 And strValue <> "" Then

TitleLineWrite

'output Configuration value

oFN.WriteLine DQ & "Configuration" & DQ & " = " & DQ & strValue & DQ

'parse comma-delimited strValue into Public arAcc array

StrParse2Unique strValue

Else 'ShowAll

TitleLineWrite

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

End If 'strValue exists?

End If 'strValue exists or ShowAll?

'output if ShowAll

If flagShowAll Then TitleLineWrite

Next 'hive

'HKCU...AccessibilityTemp

strKey = "Software\Microsoft\Windows NT\CurrentVersion\AccessibilityTemp"

strSubTitle = "HKCU\" & strKey & "\"

'find the names array

intErrNum = oReg.EnumValues (HKCU, strKey, arNames, arType)

'if names array found

If intErrNum = 0 And IsArray(arNames) Then

TitleLineWrite

For Each strName In arNames

'output the DWORD values as strings

strValue = RtnValue (HKCU, strKey, strName, REG_DWORD)

oFN.WriteLine DQ & strName & DQ & " = " & strValue

'add unique names to array

AppUnique2DynArr strName,1,Len(strName)

'HKLM...Accessibility/Session#

strKey = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Accessibility"

strSubTitle = "HKLM\" & strKey & "\Session#\"

flagFound = False 'true if Session# key found

'find the subkeys

oReg.EnumKey HKLM, strKey, arSubKeys

'enumerate data if present

If IsArray(arSubKeys) Then

For Each strSubKey in arSubKeys

'save the subkey name if first seven letters are "session"

If LCase(Left(Trim(strSubKey),7)) = "session" Then

flagFound = True : strName = strSubKey : Exit For

End If

If flagFound Then

'look for Configuration value

intErrNum = oReg.GetStringValue (HKLM,strKey & "\" & strName,"Configuration",strValue)

'if Configuration value found

If intErrNum = 0 And strValue <> "" Then

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

TitleLineWrite

'output Configuration value

oFN.WriteLine DQ & "Configuration" & DQ & " = " & StringFilter(strValue,True)

'parse comma-delimited strValue into arAcc array

StrParse2Unique strValue

End If 'Configuration value exists?

End If 'Session# sub-key found?

End If 'HKLM...Accessibility sub-keys exist?

'output arAcc members - unique accessibility tools

If IsArray(arAcc) Then

strKey = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Accessibility\ATs"

'get the ATs sub-keys

oReg.EnumKey HKLM, strKey, arSubKeys

'if array populated

If IsArray(arSubKeys) Then

'for each unique app tool

For Each strName In arAcc

'for each ATs sub-key name

For Each strSubKey In arSubKeys

'if app tool = sub-key name

If LCase(Trim(strName)) = LCase(Trim(strSubKey)) Then

'find Description & StartExe values

strValue1 = RtnValue (HKLM, strKey & "\" & strSubKey, "Description", REG_SZ)

strValue2 = RtnValue (HKLM, strKey & "\" & strSubKey, "StartExe", REG_EXPAND_SZ)

strFN = LCase(Fso.GetFileName(strValue2)) 'find file name

strCN = CoName(IDExe(strValue2)) 'find CoName

'no output if StartExe simple integer

If IsNumeric(strValue2) Then Exit For

'output title line

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

TitleLineWrite

strWarn = IWarn 'assume StartExe is not an allowed executable

'empty strWarn if StartExe/CoName OK or StartExe empty

For i = 0 To UBound(arAllowedNames)

If (strFN = arAllowedNames(i) And strCN = MS) Or _

strFN = "(empty string)" Then

strWarn = "" : Exit For

End If

'output data

oFN.WriteLine DQ & "Description" & DQ & " = " &_

StringFilter(strValue1,True) & vbCRLF &_

strWarn & DQ & "StartExe" & DQ &_

" = " & StringFilter(strValue2,True) & CoName(IDExe(strValue2))

Exit For 'arSubKey members

End If 'arAcc member=ATs sub-key name?

Next 'arSubKey member

Next 'arAcc member

End If 'is arSubKeys an array?

End If 'is arAcc an array?

'clean up

strTitle = "" : strSubTitle = "" : intUB = 0 : ReDim arAcc(0)

ReDim arAllowedNames(0)

End If 'WVa?

End If 'SecTest?

'#29. Keyboard Driver Filters

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)

If Not flagTest Or (flagTest And SecTest) Then

'prepare title line

strTitle = "Keyboard Driver Filters:"

Dim arValue() 'multi-string value

strOut = "" 'empty output string

flagInfect = False

'for W2K/WXP/WVa

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

strKey = "SYSTEM\CurrentControlSet\Control\Class\{4D36E96B-E325-11CE-BFC1-08002BE10318}"

intErrNum = oReg.GetMultiStringValue (HKLM,strKey,"UpperFilters",arValue)

'if value exists

If intErrNum = 0 And IsArray(arValue) Then

'if array is not empty

If UBound(arValue) >= 0 Then

'for every UpperFilter

For i = 0 To UBound(arValue)

'if not default value

If LCase(Trim(arValue(i))) <> "kbdclass" Then

'toggle infection flag

flagInfect = True : flagIWarn = True

'if no extension, look in Drivers

If Fso.GetExtensionName(arValue(i)) = "" Then

strCN = CoName(strFPSF & "\Drivers\" & arValue(i) & ".sys")

Else 'use IDExe for CoName

strCN = CoName(IDExe(arValue(i)))

End If 'extension?

'if output string not empty, use leading comma

If strOut <> "" Then

strOut = strOut & ", " & IWarn & DQ & arValue(i) & DQ & strCN

Else 'skip leading comma if output string empty

strOut = IWarn & DQ & arValue(i) & DQ & strCN

End If

'set up output for ShowAll

ElseIf flagShowAll Then

'if no extension, look in Drivers

If Fso.GetExtensionName(arValue(i)) = "" Then

strCN = CoName(strFPSF & "\Drivers\" & arValue(i) & ".sys")

Else 'use IDExe for CoName

strCN = CoName(IDExe(arValue(i)))

End If 'extension?

'if output string not empty, use leading comma

If strOut <> "" Then

strOut = strOut & ", " & DQ & arValue(i) & DQ & strCN

Else 'skip leading comma if output string empty

strOut = DQ & arValue(i) & DQ & strCN

End If

End If 'kbdclass Or flagShowAll?

Next 'multi-string value element

'output if necessary

If flagInfect Or flagShowAll Then

TitleLineWrite

oFN.WriteLine vbCRLF & "HKLM\" & strKey & "\" & vbCRLF & DQ &_

"UpperFilters" & DQ & " = " & strOut

End If 'output necessary?

End If 'arValue empty?

Else 'arValue not returned

If flagShowAll Then

TitleLineWrite : oFN.WriteLine vbCRLF & "HKLM\" & strKey & "\" & vbCRLF & DQ &_

"UpperFilters" & DQ & " = (value not found)"

End If

End If 'arValue returned?

'recover array memory

ReDim arValue(0)

End If 'W2K/WXP/WVa?

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

End If 'SecTest?

'#30. Print Monitors

intSection = intSection + 1

'execute section if not in testing mode or (in testing mode And this section selected for testing)

If Not flagTest Or (flagTest And SecTest) Then

Dim arPMon(), intMSPMonNo

'assume monitor drivers don't exist

Dim flagMonDrvExist : flagMonDrvExist = False

If strOS = "NT4" Then

ReDim arPMon(1,1)

arPMon(0,0) = "Local Port" : arPMon(0,1) = "localmon.dll"

arPMon(1,0) = "PJL Language Monitor" : arPMon(1,1) = "pjlmon.dll"

ElseIf strOS = "W2K" Or strOS = "WXP" Then

ReDim arPMon(5,1)

arPMon(0,0) = "BJ Language Monitor" : arPMon(0,1) = "cnbjmon.dll"

arPMon(1,0) = "Local Port" : arPMon(1,1) = "localspl.dll"

arPMon(2,0) = "PJL Language Monitor" : arPMon(2,1) = "pjlmon.dll"

arPMon(3,0) = "Standard TCP/IP Port" : arPMon(3,1) = "tcpmon.dll"

arPMon(4,0) = "USB Monitor" : arPMon(4,1) = "usbmon.dll"

arPMon(5,0) = "Windows NT Fax Monitor" : arPMon(5,1) = "msfaxmon.dll"

ElseIf strOS = "WVA" Then

ReDim arPMon(5,1)

arPMon(0,0) = "Local Port" : arPMon(0,1) = "localspl.dll"

arPMon(1,0) = "Microsoft Shared Fax Monitor" : arPMon(1,1) = "FXSMON.DLL"

arPMon(2,0) = "Standard TCP/IP Port" : arPMon(2,1) = "tcpmon.dll"

arPMon(3,0) = "USB Monitor" : arPMon(3,1) = "usbmon.dll"

arPMon(4,0) = "WSD Port" : arPMon(4,1) = "WSDMon.dll"

arPMon(5,0) = "LPR Port" : arPMon(5,1) = "lprmon.dll"

ElseIf strOS = "WME" Then

ReDim arPMon(0,1)

arPMon(0,0) = "usbmon" : arPMon(0,1) = "usbmon.dll"

End If

strTitle = "Print Monitors:"

strKey = "System\CurrentControlSet\Control\Print\Monitors"

strSubTitle = SYCA("HKLM" & "\" & strKey & "\")

'find all the subkeys

oReg.EnumKey HKLM, strKey, arSubKeys

'enumerate data if present

If IsArray(arSubKeys) Then

'for each key

For Each strSubKey In arSubKeys

'set default values

intMSPMonNo = -1 : strCN = "" : flagAllow = False

'get the driver value

intErrNum = oReg.GetStringValue (HKLM,strKey & "\" & strSubKey,"Driver",strValue)

'if the driver value exists (exc for W2K!)

If intErrNum = 0 And strValue <> "" Then

flagMonDrvExist = True 'monitor drivers exist

'check for allowed values

If strOS <> "W98" Then

'set intMSPMonNo if subkey name & drive name are on approved list

For j = 0 To UBound(arPMon,1)

If LCase(strSubKey) = LCase(arPMon(j,0)) And _

LCase(strValue) = LCase(arPMon(j,1)) Then

intMSPMonNo = j : Exit For

End If

Next 'arPMon

End If 'strOS?

'find CoName

strCN = CoName(IDExe(strValue))

'toggle flag if subkey name/driver name/CoName OK

If intMSPMonNo >= 0 And strCN = MS Then flagAllow = True

'output if driver unapproved or showall

If Not flagAllow Or flagShowAll Then

TitleLineWrite

'output the quote-delimited names and values

On Error Resume Next

oFN.WriteLine StringFilter(strSubKey,False) & "\Driver = " &_

DQ & strValue & DQ & strCN

intErrNum = Err.Number : Err.Clear

On Error Goto 0

If intErrNum <> 0 Then oFN.WriteLine StringFilter(strSubKey,False) &_

"\Driver = (value not set)"

End If 'output?

End If 'driver value exists?

Next 'Monitors subkey

End If 'no Monitors subkeys found

If Not flagMonDrvExist And flagShowAll Then

strSubTitle = strSubTitle & vbCRLF & "(no drivers found)"

TitleLineWrite

End If

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

'recover array memory

ReDim arSubKeys(0)

ReDim arPMon(0,0)

End If 'SecTest?

'run closing sub

SRClose

'clean up

Set oReg=Nothing

Set Fso=Nothing

Set Wshso=Nothing

Sub SRClose

'find the number of seconds spent replying to popups

Dim datPUBsec : datPUBsec = datPUB1 + datPUB2

'find the words for the message box duration

Dim strPUBSec

Dim strOut

If flagShowAll Or flagSupp Or flagOut = "C" Then

strPUBsec = ""

ElseIf datPUBsec < 2 Then

strPUBsec = ", including " & datPUBsec & " second for message boxes"

Else

strPUBsec = ", including " & datPUBsec & " seconds for message boxes"

End if

'form the run time phrase

Dim strRunTime : strRunTime = " (total run time: " &_

DateDiff("s",datLaunch,Now) & " seconds" & strPUBsec & ")"

Dim intClosePUBSec 'script close announcement popup display seconds

Dim strBody : strBody = ""

Dim strSpacer : strSpacer = vbCRLF

Dim strHeader : strHeader = vbCRLF & vbCRLF & String(10,"-") &_

" (launch time: " & FmtDate(datLaunch) & " " & FmtHMSFtr(datLaunch) & ")"

Dim strFooter : strFooter = vbCRLF & String(10,"-") &_

strRunTime

'explain <<!>> & <<H>> symbols if present

'precede HWarn symbol by new line if IWarn also present

If flagIWarn And flagHWarn Then strSpacer = ""

If flagIWarn Then strBody = strBody & vbCRLF & "<<!>>: " &_

"Suspicious data at a malware launch point." & vbCRLF

If flagHWarn Then strBody = strBody & strSpacer & "<<H>>: " &_

"Suspicious data at a browser hijack point." & vbCRLF

If Not flagShowAll Then

strBody = strBody &_

vbCRLF & "+ This report excludes default entries except where indicated." &_

vbCRLF & "+ To see *everywhere* the script checks and *everything* it finds," &_

vbCRLF & " launch it from a command prompt or a shortcut with the -all parameter."

If Not flagSupp Then

strBody = strBody &_

vbCRLF & "+ To search all directories of local fixed drives for DESKTOP.INI" &_

vbCRLF & " DLL launch points, use the -supp parameter or answer " & DQ & "No" & DQ &_

" at the" & vbCRLF & " first message box and " & DQ & "Yes" & DQ &_

" at the second message box."

Else 'flagSupp=True

strBody = strBody &_

vbCRLF & "+ The search for DESKTOP.INI DLL launch points on all local fixed drives" &_

vbCRLF & " took " & strDTITime & "."

End If

Else 'flagShowAll=True

strHeader = vbCRLF & vbCRLF & "--" & strRunTime : strFooter = ""

End If

oFN.WriteLine strHeader & strBody & strFooter

oFN.Close : Set oFN=Nothing

'inform user that script is complete

If flagOut = "W" Then

intClosePUBSec = 20 : If flagTest Then intClosePUBSec = 1

'include path if report file directory specified via cmd-line parameter

If flagDirArg Then

strOut = "All Done! The results are in the file:" & vbCRLF & vbCRLF &_

strFN

Else 'directory not specified via cmd-line parameter

strOut = "All Done! The results are in the file:" & vbCRLF & vbCRLF &_

strFNNP & vbCRLF & vbCRLF & "This file is in the same directory as the script."

End if 'report file path?

Wshso.PopUp strOut,intClosePUBSec,"Silent Runners R" & strRevNo & " Complete", _

vbOKOnly + vbInformation + vbSystemModal

Else 'console output

'include path if report file directory specified via cmd-line parameter

If flagDirArg Then

strOut = "Silent Runners R" & strRevNo & " is done! The results " &_

"are in the file:" & vbCRLF & vbCRLF & strFN

Else 'directory not specified via cmd-line parameter

strOut = "Silent Runners R" & strRevNo & " is done! The results " &_

"are in the file:" & vbCRLF & vbCRLF & strFNNP & vbCRLF & vbCRLF &_

"This file is in the same directory as the script."

End If 'report file path?

WScript.Echo strOut

End If 'flagout?

End Sub

'YYYY-MM-DD

Function FmtDate (datIn)

FmtDate = Year(datIn) & "-" & Right("0" & Month(datIn),2) & "-" &_

Right("0" & Day(datIn),2)

End Function

'hh.mm.ss for report title

Function FmtHMS (datIn)

FmtHMS = Right("0" & Hour(datIn),2) & "." & Right("0" & Minute(datIn),2) &_

"." & Right("0" & Second(datIn),2)

End Function

'hh:mm:ss for report footer

Function FmtHMSFtr (datIn)

FmtHMSFtr = Right("0" & Hour(datIn),2) & ":" & Right("0" & Minute(datIn),2) &_

":" & Right("0" & Second(datIn),2)

End Function

'enumerate Name/Value Pairs

Sub EnumNVP (hexHive,strRunKey,arNames,arType)

Dim intUB, intErrNum, intErrNum1, i

flagNVP = False

'find all the names in the key

intErrNum = oReg.EnumValues (hexHive, strRunKey, arNames, arType)

'excludes W2K/WXP/WVa with no name/value pairs

If intErrNum = 0 And IsArray(arNames) Then

'try to get array UBound

On Error Resume Next

intUB = UBound(arNames)

intErrNum1 = Err.Number : Err.Clear

On Error Goto 0

'excludes WS2K3 with no name/value pairs

If intErrNum1 = 0 Then

'excludes W98/WMe/NT4 with no name/value pairs

If intUB >= 0 Then flagNVP = True

End If 'UBound exists?

End If 'names array exists?

End Sub

'return Name given value Type, toggle flag if value found

Function RtnValue (hexHive, strKey, strName, intType)

flagValueFound = False

'value as string/integer/array, counter, string variable, error number

Dim strFValue, intFValue, arFValue, i, strFMsg, intFErrNum

Select Case intType

'string value

Case REG_SZ

'return the string-type value

intErrNum = oReg.GetStringValue (hexHive,strKey,strName,strFValue)

If intErrNum = 0 Then

If strFValue = "" Then

strFValue = "(empty string)"

Else

flagValueFound = True

End If 'value empty?

RtnValue = strFValue

Else

RtnValue = "(value not set)"

End If 'value set?

'expandable-string value

Case REG_EXPAND_SZ

'return the expanded string-type value

intErrNum = oReg.GetExpandedStringValue (hexHive,strKey,strName,strFValue)

If intErrNum = 0 Then

If strFValue = "" Then

strFValue = "(empty string)"

Else

flagValueFound = True

End If 'value empty?

RtnValue = strFValue

Else

RtnValue = "(value not set)"

End If 'value set?

'binary value

Case REG_BINARY

'return the binary-type value as array

intFErrNum = oReg.GetBinaryValue (hexHive,strKey,strName,arFValue)

If intFErrNum = 0 And IsArray(arFValue) Then

If UBound(arFValue) >= 0 Then

'delimit every two-bytes by space

strFMsg = ""

For i = 0 To UBound(arFValue)

strFMsg = strFMsg & Right("00" & CStr(Hex(arFValue(i))),2) & " "

Else 'UBound(arFValue) = -1

strFMsg = "(value not set)"

End If 'UBound >= 0?

RtnValue = strFMsg

Else

RtnValue = "(value not set)"

End If 'value array exists?

'4-byte (32-bit) value

Case REG_DWORD

'return the DWORD-type value

intErrNum = oReg.GetDWORDValue (hexHive,strKey,strName,intFValue)

If intErrNum = 0 Then

flagValueFound = True

RtnValue = "dword:0x" & Right("00000000" & CStr(Hex(intFValue)),8)

Else

RtnValue = "(value not set)"

End If

'multiple-string value

Case REG_MULTI_SZ

'return the multiple-string-type value

intFErrNum = oReg.GetMultiStringValue (hexHive,strKey,strName,arFValue)

If intFErrNum = 0 And IsArray(arFValue) Then

If UBound(arFValue) >= 0 Then

flagValueFound = True

'delimit every quote-enclosed string by "|"

strFMsg = ""

For i = 0 To UBound(arFValue)

strFMsg = strFMsg & DQ & arFValue(i) & DQ & "|"

strFMsg = "(value not set)|" 'append "|" for later deletion

End If 'UBound >= 0?

strFMsg = Left(strFMsg,Len(strFMsg)-1) 'lop off trailing "|"

RtnValue = strFMsg

Else

RtnValue = "(value not set)"

End If 'value array exists?

'8-byte (64-bit) value

Case REG_QWORD

'return the QWORD-type value

intErrNum = oReg.GetQWORDValue (hexHive,strKey,strName,intFValue)

If intErrNum = 0 Then

flagValueFound = True

RtnValue = "hex:0x" & Right("0000000000000000" & CStr(Hex(intFValue)),16)

Else

RtnValue = "(value not set)"

End If

Case Else

'admit we don't know what it is

RtnValue = "(unknown data type)"

End Select 'data type

End Function

'return Type as string given Type as integer

Function RtnType (intType)

Select Case intType

'string value

Case REG_SZ

RtnType = "REG_SZ"

'expandable-string value

Case REG_EXPAND_SZ

RtnType = "REG_EXPAND_SZ"

'binary value

Case REG_BINARY

RtnType = "REG_BINARY"

'4-byte value

Case REG_DWORD

RtnType = "REG_DWORD"

'multiple-string-type value

Case REG_MULTI_SZ

RtnType = "REG_MULTI_SZ"

Case REG_QWORD

RtnType = "REG_QWORD"

'any other type

Case Else

RtnType = "(unknown data type)"

End Select

End Function

'write name/value pair to file

Function WriteValueData (strName, strValue, intType, strWarn)

Dim strOQEC 'Optionally Quote-Enclosed Comment

Dim strFiltVal : strFiltVal = StringFilter(strValue,False) 'filtered value

Dim strFiltNam : strFiltNam = StringFilter(strName,False) 'filtered name

'enclose REG_SZ strings in quotes and append CoName

If intType = REG_SZ Then

strOQEC = DQ & strFiltVal & DQ & CoName(IDExe(strValue))

ElseIf intType = REG_EXPAND_SZ Or intType = REG_SZ_NO_CN Then

strOQEC = DQ & strFiltVal & DQ

Else

strOQEC = strFiltVal

End If

'output the quote-delimited name and value

If strName = "" Then

oFN.WriteLine strWarn & DQ & "(Default)" & DQ & " = " & strOQEC

Else 'name is non-empty string

oFN.WriteLine strWarn & DQ & strFiltNam & DQ & " = " & strOQEC

End If

End Function

'compare registry value to accepted value and output

'hexHive, registry key, value name, accepted value, Special Handling label, CoName output flag

'any value accepted if accepted value = "all", CoName not output if flag = False

Sub RegDataChk_v2 (cHive, strKey, strName, strAccVal, strSH, flagCoName)

strSH = LCase(strSH)

Dim intType, strWarn, strValue

intType = 0 : strWarn = "" : strValue = "" : flagValueFound = False

'find value names & types

EnumNVP cHive,strKey,arNames,arType

'if names exist, check for strName

If flagNVP Then

For i = 0 To UBound(arNames)

'if target name found

If LCase(arNames(i)) = LCase(strName) Then

intType = arType(i) 'find type

strValue = RtnValue (cHive, strKey, arNames(i), intType) 'find value

'warn if value not allowed: all values not allowed, value <> allowed,

'value was found by RtnValue function

If strSH = "" Then

If LCase(strAccVal) <> "all" And LCase(strValue) <> LCase(strAccVal) _

And flagValueFound Then

flagIWarn = True : strWarn = IWarn

End If 'exception found?

'for ui, use string + comma-appended string as reference

ElseIf LCase(strSH) = "ui" Then

If LCase(strValue) <> LCase(strAccVal) And _

LCase(strValue) <> LCase(strAccVal) & "," Then

flagIWarn = True : strWarn = IWarn

End If 'exception found?

End If 'special handling?

Exit For

End If 'strName in arNames?

Next 'arNames member

'if type not set, name wasn't found

If intType = 0 Then strValue = "(name not found)"

'if output needed

If strWarn <> "" Or flagShowAll Then

TitleLineWrite

'quote-enclose value unless REG_MULTI_SZ Or no value found

'use LRParse for certain special handling fields

If intType = 7 Or Not flagValueFound Then

oFN.WriteLine strWarn & DQ & strName & DQ & " = " &_

StringFilter(strValue,False)

Else

If flagCoName Then

If strSH = "lrp" Or strSH = "ui" Then

oFN.WriteLine strWarn & DQ & strName & DQ & " = " &_

StringFilter(strValue,True) & LRParse(strValue)

Else

oFN.WriteLine strWarn & DQ & strName & DQ & " = " &_

StringFilter(strValue,True) & CoName(IDExe(strValue))

End If

Else 'flagCoName=False

oFN.WriteLine strWarn & DQ & strName & DQ & " = " &_

StringFilter(strValue,True)

End If 'flagCoName=True?

End If

End If 'output needed?

ElseIf flagShowAll Then 'flagNVP=False

TitleLineWrite

oFN.WriteLine DQ & strName & DQ & " = (name not found)"

End If 'values exist?

End Sub

'find a key's default value and compare to allowed string

Sub ChkDefaultValue (strKey,strAllowedValue)

'error number, value

Dim intErrNum, strValue

'initialize warning string

Dim strWarn : strWarn = ""

'find default value

intErrNum = oReg.GetStringValue (HKLM,strKey,"",strValue)

'if default value found

If intErrNum = 0 And strValue <> "" Then

'toggle warnings if default value not allowed

If LCase(Trim(strValue)) <> LCase(strAllowedValue) Then

strWarn = IWarn : flagIWarn = True

End If

'if output needed

If strWarn <> "" Or flagShowAll Then

'output

TitleLineWrite

oFN.WriteLine strWarn & "(Default) = " & DQ & strValue & DQ

End If

End Sub

MAcgYvER everyONE · Setembro 21, 2008

'enumerate a key's names and, for names matching those in a dictionary,

'find the values and compare to allowed strings stored as dictionary items

'if the values don't match the allowed strings and a flag is set,

'display the value at the unallowed location

Sub ChkNameValues (strKey, dictNV, flagResolveValue)

'error numbers

Dim intErrNum, intErrNum1, intErrNum2

'name/value type arrays, Dictionary associative array, single key

Dim arNames, arType, arDictKeys, strDictKey

'key, name, value x 2, output warning, output string

Dim strKey1, strName, strValue, strValue1, strWarn, strOut

'loc'n of SYS:/USR:

Dim intSYS, intUSR

'enumerate key names

intErrNum = oReg.EnumValues (HKLM, strKey, arNames, arType)

'if name array found

If intErrNum = 0 And IsArray(arNames) Then

'put dictionary keys in array

arDictKeys = dictNV.Keys

'for each name under strKey

For Each strName In arNames

'intialize variables

strWarn = "" : strOut = ""

'find value

intErrNum1 = oReg.GetStringValue (HKLM,strKey,strName,strValue)

'if value exists

If intErrNum1 = 0 And strValue <> "" Then

'for every dictionary key

For Each strDictKey In arDictKeys

'if dictionary key = name

If LCase(Trim(strDictKey)) = LCase(Trim(strName)) Then

'if dictionary key's item <> name's value

If LCase(dictNV.Item(strDictKey)) <> LCase(Trim(strValue)) Then

'toggle warnings

strWarn = IWarn : flagIWarn = True

'if need to resolve name's value

If flagResolveValue Then

'look for "SYS:" and "USR:"

intSYS = InStr(LCase(Trim(strValue)),"sys:")

intUSR = InStr(LCase(Trim(strValue)),"usr:")

'extract string beyond "SYS:" or "USR:"

strKey1 = Mid(Trim(strValue),5)

If intSYS = 1 Then 'if "SYS:" found in value

'resolve value in HKLM\SOFTWARE

intErrNum2 = oReg.GetStringValue (HKLM,"SOFTWARE\" & strKey1,strName,strValue1)

'form strOut if resolved value found

If intErrNum2 = 0 And strValue1 <> "" Then _

strOut = vbCRLF & strWarn & "HKLM\SOFTWARE\" & strKey1 & "\" & strName &_

" = " & DQ & strValue1 & DQ

ElseIf intUSR = 1 Then 'if "USR:" found in value

'resolve value in HKCU\Software

intErrNum2 = oReg.GetStringValue (HKCU,"Software\" & strKey1,strName,strValue1)

'form strOut if resolved value found

If intErrNum2 = 0 And strValue1 <> "" Then _

strOut = vbCRLF & strWarn & "HKCU\Software\" & strKey1 & "\" & strName &_

" = " & DQ & strValue1 & DQ

End If 'SYS: or USR: in value?

End If 'resolver flag set?

End If 'dictionary key's item <> name's value?

'if output necessary

If LCase(dictNV.Item(strDictKey)) <> LCase(Trim(strValue)) Or flagShowAll Then

'output & exit For

TitleLineWrite

oFN.WriteLine strWarn & DQ & strName & DQ & " = " & DQ & strValue & DQ & strOut

Exit For

End If 'output necessary?

End If 'dictionary key = name?

Next 'dictionary key

End If 'strValue exists?

Next 'strKey name

End If 'name array found?

End Sub

'set NoDriveTypeAutoRun flag

Function NDTAR (cHive, flagValueExists, flagFDEnabled)

'DWORD or BINARY value, binary value array, error number, hive name as string

Dim hVal, arBVal, intErrNum, strHive

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

'if cHive NoDriveTypeAutoRun DWORD value exists

If oReg.GetDWORDValue(cHive,strKey,"NoDriveTypeAutoRun",hVal) = 0 Then

flagValueExists = True

'if autorun for fixed drives is disabled, set flag

If (hVal And 8) = 8 Then flagFDEnabled = False

'if cHive NoDriveTypeAutoRun BINARY value exists

ElseIf oReg.GetBinaryValue(cHive,strKey,"NoDriveTypeAutoRun",arBVal) = 0 Then

'UBound = -1 if value not set (zero-length binary value)

If UBound(arBVal) = -1 Then

'if O/S = W2K/WXP SP0/1, "value not set" interpreted by O/S as

'0 for NDTAR instead of null!

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

flagValueExists = True

End If 'W2K/WXP?

Else 'UBound <> -1, so value set

flagValueExists = True : hVal = 0

'binary value retrieved as array in increments of 16^2

For i = 0 To UBound(arBVal)

hVal = hVal + arBVal(i) * 256^i

On Error Resume Next

If (hVal And 8) = 8 Then flagFDEnabled = False

intErrNum = Err.Number : Err.Clear

On Error Goto 0

If intErrNum <> 0 Then

TitleLineWrite

strHive = "HKCU\"

If cHive = HKLM Then strHive = "HKLM\"

oFN.WriteLine vbCRLF & SOCA(strHive & strKey & "\" & vbCRLF &_

DQ & "NoDriveTypeAutoRun" & DQ & " = ** WARNING -- corrupt BINARY value! **")

End If

End If 'UBound = -1?

End If 'NoDriveTypeAutoRun value exists?

End Function

'detect if autorun disabled for individual drives

Function NDAR (cHive, flagValueExists)

'DWORD or BINARY value, binary value array, error number, hive name as string

Dim hVal, arBVal, intErrNum, strHive

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

'if cHive NoDriveAutoRun DWORD value exists

If oReg.GetDWORDValue(cHive,strKey,"NoDriveAutoRun",hVal) = 0 Then

flagValueExists = True

'for every fixed disk

For i = 0 To UBound(arFixedDisks,2)

'if autorun for fixed drive is disabled, set flag

If (hVal And arFixedDisks(1,i)) = arFixedDisks(1,i) Then

arFixedDisks(2,i) = False

End If 'autorun disabled for this drive?

Next 'fixed disk

'if cHive NoDriveAutoRun BINARY value exists

ElseIf oReg.GetBinaryValue(cHive,strKey,"NoDriveAutoRun",arBVal) = 0 Then

'UBound = -1 if value not set (zero-length binary value)

If UBound(arBVal) = -1 Then

'if O/S = W2K/WXP SP0/1, "value not set" interpreted by O/S as

'0 instead of null!

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

flagValueExists = True

'set all NDAR flags to True

For i = 0 To UBound(arFixedDisks,2)

arFixedDisks(2,i) = True

Else 'UBound <> -1, so value set

flagValueExists = True

hVal = 0

'binary value retrieved as array in increments of 16^2

For i = 0 To UBound(arBVal)

hVal = hVal + arBVal(i) * 256^i

For i = 0 To UBound(arFixedDisks,2)

On Error Resume Next

'if autorun for the fixed disk is disabled, set flag

If (hVal And arFixedDisks(1,i)) = arFixedDisks(1,i) Then

arFixedDisks(2,i) = False

intErrNum = Err.Number : Err.Clear

End If

On Error Goto 0

If intErrNum <> 0 Then

strHive = "HKCU\"

If cHive = HKLM Then strHive = "HKLM\"

TitleLineWrite

oFN.WriteLine vbCRLF & SOCA(strHive & strKey & "\" & vbCRLF &_

DQ & "NoDriveAutoRun" & DQ & " = ** WARNING -- corrupt BINARY value! **")

Exit For

End If

Next 'fixed disk

End If 'hive NoDriveAutoRun value set?

End If 'hive NoDriveAutoRun value exists?

End Function

'INI/INF-file parser

Function IniInfParse (strInput, strVerb, strEquiv, strDisk)

Dim strOutput 'report line

Dim strWarn : strWarn = "" 'warning string

Dim strExe : strExe = "" 'executable after "="

Dim strLFN : strLFN = "" 'screen saver LFN

Dim intEqu

'if verb is first non-space chars (if line is populated)

If Left(LCase(LTrim(strInput)),Len(strVerb)) = strVerb Then

'find pos'n of equals sign

intEqu = InStr(strInput,"=")

'find executable statement after equals sign

strExe = Trim(Mid(strInput,intEqu+1))

'if chrs to right of equals sign different from argument or ShowAll

If (LCase(strExe) <> strEquiv) Or flagShowAll Then

'fill warning string if chrs to right of equals sign different from argument

If LCase(strExe) <> strEquiv And strEquiv <> "anything" Then

strWarn = IWarn : flagIWarn = True

End If

'concatenate line for load or run

If LCase(strVerb) = "load" Or LCase(strVerb) = "run" Then

strOutput = strWarn & DQ & strInput & DQ & LRParse(strExe)

'concatenate line for open or shellexecute

ElseIf LCase(strVerb) = "open" Or LCase(strVerb) = "shellexecute" Then

strOutput = strWarn & strDisk & "\AUTORUN.INF -> " &_

DQ & strInput & DQ & CoName(IDExe(strDisk & "\" & strExe))

'if screensaver = None then no line exists in INI-file

'if flagShowAll, nothing will be written since no line exists

ElseIf LCase(strVerb) = "scrnsave.exe" Then

'get screen saver LFN if file exists

If Fso.FileExists(strExe) Then

'create (but don't save) shortcut

Dim oSC : Set oSC = Wshso.CreateShortcut("getLFN.lnk")

'set & retrieve target path

oSC.TargetPath = strExe

strLFN = Fso.GetFile(oSC.TargetPath).Name

Set oSC=Nothing

'set up LFN string if SFN <> LFN

If LCase(strLFN) = LCase(Fso.GetFileName(strExe)) Then

strLFN = ""

Else

strLFN = " (" & strLFN & ")"

End If

End If 'screen saver file exists?

strOutput = strWarn & DQ & strInput & DQ & strLFN &_

CoName(IDExe(strExe))

'concatenate line for all other verbs

Else

strOutput = strWarn & DQ & strInput & DQ & LRParse(strExe)

End If 'load/run, open/shellexecute, scrnsave.exe, other?

TitleLineWrite : oFN.WriteLine strOutput

End If 'verb populated?

End If 'line populated

End Function

'trim the parameters from a string to isolate the executable and

'then locate the executable on the hard disk

Function IDExe (strPath)

'check for empty string

If IsNull(strPath) Or strPath = "" Then

IDExe = "file not found" : Exit Function

End If

'work path: trimmed, lower case, expanded env strings

Dim strPWk : strPWk = Trim(LCase(Wshso.ExpandEnvironmentStrings(strPath)))

Dim intFS 'forward slash pos'n

'check for "res://"

If Left(strPWk,6) = "res://" Then

'look for forword slash after "res://"

intFS = InStr(7,strPWk,"/",1)

'if no trailing fs, annex one's position at end of string

If intFS = 0 Then intFS = Len(strPWk) + 1

'extract string between "res://" and trailing fs

strPWk = Mid(strPWk,7,intFS-7)

End If 'string starts with "res://"?

If Fso.FileExists(strPWk) Then

IDExe = Fso.GetFile(strPWk).Path : Exit Function

End If 'as-is?

'dissect input string

'work path & TmpExe strings, loc'n of decimal pt, second quote, backslash, counter

Dim strTEx, intDP, int2Q, intBS, i

Dim flagFileFound : flagFileFound = False 'TRUE if file found in called function

Dim flagSpaceExists : flagSpaceExists = True 'FALSE if no space in work path

'Executable Extension array

Dim arExeExt : arExeExt = Array (".exe", ".com", ".cmd", ".bat", ".pif", ".dll")

'look for leading double quote, embedded " /", " """ (parameter prefixes)

If Left(strPWk,1) = DQ Then

'if find it, then look for second quote

int2Q = InStr(2, strPWk, """")

'if find it, reset the path string to what was between the quotes

If int2Q > 0 Then strPWk = Trim(Mid(strPWk, 2, int2Q - 2))

'look for embedded " /"

ElseIf InStr(strPWk," /") > 0 Then

'if find it, reset the path string

strPWk = Trim(Mid(strPWk,1,InStr(strPWk," /")-1))

'look for embedded space + double quote

ElseIf InStr(strPWk," """) > 0 Then

'if find it, reset the path string

strPWk = Trim(Mid(strPWk,1,InStr(strPWk," """)-1))

End If

Do While flagSpaceExists

'look for trailing dot & backslash

intDP = InStrRev(strPWk,".")

intBS = InStrRev(strPWk,"\")

'if dot found And dot after backslash And string contains extension

If (intDP > 0) And (intDP > intBS) And (intDP < Len(strPWk)) Then

'look for entire string on hard disk

strTEx = WSL(strPWk, flagFileFound)

'if found, return it

If flagFileFound Then

IDExe = strTEx : Exit Function

End if

Else 'either dot not found Or dot in string Or string has no extension

'try adding executable extension

For i = 0 To UBound(arExeExt)

'look for string on hard disk

strTEx = WSL(strPWk & arExeExt(i), flagFileFound)

'if found, return it with executable extension appended

If flagFileFound Then

IDExe = strTEx : Exit Function

End if

Next 'executable extension

End If 'dot found And dot after BS And string has extension?

'trim chrs after space

If InStrRev(strPWk," ") = 0 Then

flagSpaceExists = False

Else

strPWk = Trim(Left(strPWk,InStrRev(strPWk," ") - 1))

End If

Loop 'flagSpaceExists

'last chance: look for AppPath of space-less executable

strPWk = Trim(AppPath(strPWk))

strTEx = WSL(strPWk,flagFileFound)

If flagFileFound Then

IDExe = strTEx

Else

IDExe = "file not found"

End if

End Function

'WinSysLocate

Function WSL (strIn, logFound)

'set default results

WSL = strIn : logFound = False

'if strIn exists, exit

If Fso.FileExists(strIn) Then

WSL = Fso.GetFile(strIn).Path

logFound = True

'if strIn doesn't contain drive or UNC network path

ElseIf InStr(strIn,":") = 0 And InStr(strIn,"\\") <> 1 Then

'check for file in Windows directory

If Fso.FileExists(strFPWF & "\" & strIn) Then

WSL = strFPWF & "\" & strIn : logFound = True

'check for file in System directory

ElseIf Fso.FileExists(strFPSF & "\" & strIn) Then

WSL = strFPSF & "\" & strIn : logFound = True

End If 'prefixed strIn exists?

End If 'strIn contains path?

End Function

'find company name in existing file

Function CoName (strFN)

If strFN = "file not found" Or IsNull(strFN) Or strFN = "" _

Or Not Fso.FileExists(strFN) Then

CoName = " [file not found]"

Exit Function

End If

'WMI file object, co-name, error number, working file name

Dim oFile, strMftr, intErrNum, strFNWk

'R44 -- removed StringFilter added in R40 -- findable Unicode file

' name added "unwritable string", which automatically threw a

' WMI GetObject Error

strFNWk = strFN

'if there are already escaped backslashes, unescape them

If InStr(strFNWk,"\\") <> 0 Then strFNWk = Replace(strFNWk,"\\","\")

'now reescape all of them

strFNWk = Replace(strFNWk,"\","\\")

'get the file object with filename delimited by double quotes

'(couldn't get single quotes to work with single quote embedded in path)

On Error Resume Next

Set oFile = GetObject("winmgmts:\root\cimv2").Get _

("CIM_DataFile.Name=""" & strFNWk & """")

intErrNum = Err.Number : Err.Clear

On Error Goto 0

If intErrNum <> 0 Then

CoName = " [** WMI GetObject error **]"

Exit Function

End If

'find the co-name

strMftr = oFile.Manufacturer

Set oFile=Nothing

'if null, say so

If IsNull(strMftr) Then

CoName = " [null data]"

'if empty, say so

ElseIf strMftr = "" Then

CoName = " [empty string]"

'if some company, say it

Else

'if MS, say it with 2 letters

If strMftr = "Microsoft Corporation" Or strMftr = "Microsoft Corp." Then

CoName = MS

'if some other company, provide all the data, which may take up several lines

Else

CoName = " [" & StringFilter(Replace(strMftr,Chr(13) & Chr(10),Space(1)), _

True) & "]"

End If 'MS or not?

End If 'null, mt, MS or not?

End Function

'SCRipts.Ini-File Parser

'file name to open, action for which scripts must be parsed

Function ScrIFP (strValue, strAction)

'form scripts.ini path\FileName

Dim strScrFN : strScrFN = strValue & "\scripts.ini"

'default path

Dim strDefPath : strDefPath = ""

'error number, line read from file, pos'n of CmdLine & equals sign,

'parameter string, line intro ("arrow") string

Dim intErrNum, strLine, intCS, intEq, strParam, strArrow

Dim strSC : strSC = "" 'script command

Dim intSN : intSN = 0 'script number

Dim strCmd : strCmd = "" 'command string

Dim flagSection : flagSection = False 'True if in strAction section

Dim flagActionWritten : flagActionWritten = False 'True if Action written once

Dim intActL : intActL = Len(strAction) 'action length (used for spacing of output)

'open the SCRIPTS.INI file For Reading

On Error Resume Next

Dim oSI : Set oSI = Fso.OpenTextFile(strScrFN, 1, False,-1)

intErrNum = Err.Number : Err.Clear

On Error Goto 0

'if couldn't open file, output a warning & quit

If intErrNum <> 0 Then

TitleLineWrite

oFN.WriteLine "WARNING! Insufficient permission to read " &_

DQ & strScrFN & DQ

Exit Function

End If

'for every line of file

Do Until oSI.AtEndOfStream

strLine = oSI.ReadLine

'if know already in right section

If flagSection Then

'exit if find beginning of next section

If InStr(strLine, "[") Then Exit Do

'[Logon]

'0CmdLine=path\filename.ext

'0Parameters=

'find pos'n of equals sign

intEq = InStr(strLine,"=")

'if equals sign found in the line

If intEq > 0 Then

'output saved info if the script number has changed

If intSN <> FLN(strLine) Then

TitleLineWrite

strArrow = DQ & strAction & DQ & " -> launches: "

If flagActionWritten = True Then strArrow = Space(intActL+2) & " -> launches: "

'output script command, reset script command & saved script number

oFN.WriteLine strArrow & DQ & strSC & DQ & CoName(IDExe(strCmd))

strSC = "" : strCmd = "" : flagActionWritten = True

intSN = FLN(strLine)

End If 'new script number?

'current line is cmdline

If InStr(LCase(strLine), "cmdline") > 0 Then

'if cmdline doesn't contain backslash, form script path from

'function parameters

If InStr(strLine,"\") = 0 Then strDefPath = strValue & "\" & strAction & "\"

'add script command to command string

strSC = strDefPath & Mid(strLine, intEQ + 1) & strSC

strCmd = strDefPath & Mid(strLine, intEQ + 1) 'store cmdline field for co-name id

'if parameters line

ElseIf InStr(LCase(strLine), "parameters") > 0 Then

'extract parameters string

strParam = Mid(strLine, intEq + 1)

'add non-empty parameters command to command string

If Trim(strParam) <> "" Then strSC = strSC & " " & strParam

End If 'line is cmdline or parameter

End If '"=" in this line

End If 'inside action section

'if action found in current line, set flag to True

If InStr(LCase(strLine), LCase(strAction)) > 0 Then flagSection = True

Loop 'next line in SCRIPTS.INI

oSI.Close : Set oSI=Nothing

'if a script was located, output last script command found

If strSC <> "" Then

strArrow = DQ & strAction & DQ & " -> launches: "

If flagActionWritten = True Then strArrow = Space(intActL+2) & " -> launches: "

TitleLineWrite

oFN.WriteLine strArrow & DQ & strSC & DQ & CoName(IDExe(strCmd))

End If 'script located?

End Function

'Find Leading Number

Function FLN (strLine)

'save the input in a trimmed work variable

Dim strWork : strWork = LTrim(strLine)

'initialize the output number

Dim intNumber : intNumber = 0

'counter, single character

Dim i, str1C

'find length of work variable

Dim intLen : intLen = Len(strWork)

'for the length of the work variable

For i = 1 To intLen

'take the left-most chr

str1C = Left(strWork,1)

'if it's numeric

If IsNumeric(str1C) Then

'concatenate the digit

intNumber = intNumber + CInt(str1C)

'remove 1st chr from the work variable

strWork = Right(strWork,Len(strWork)-1)

Else 'left-most chr isn't numeric

FLN = intNumber 'output the leading number & exit

Exit For

End IF

Next 'work variable chr

End Function

'look for the App Path default value for an executable

Function AppPath (strFN)

Dim strKey, strValue, intErrNum

strKey = "Software\Microsoft\Windows\CurrentVersion\App Paths"

intErrNum = oReg.GetStringValue (HKLM,strKey & "\" & strFN,"",strValue)

'return the value or an empty string (or garbage if value not set under W2K!)

If intErrNum = 0 And strValue <> "" Then

AppPath = strValue

Else

AppPath = ""

End If

End Function

'parse HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows\load

'HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows\run for executables

'and return co-name for each executable

'executables are delimited by spaces and/or commas

Function LRParse (strLine)

Dim i, strLRSeg 'counter, line segment

Dim strIn : strIn = Trim(strLine) 'input string

Dim intSLLI : intSLLI = Len(strIn) 'Input String Line Length

Dim strOut : strOut = "" 'output string

Dim arOut() 'dynamic executable output array

Dim cntAr : cntAr = -1 'output array UBound

Dim cntChr : cntChr = 0 'number of chrs in executable string

Dim intStartChr : intStartChr = 1 'start of executable string in input string

'for every chr in input string

For i = 1 To intSLLI

'if the chr is a delimiter

If Mid(strIn,i,1) = " " Or Mid(strIn,i,1) = "," Then

'if at least one non-delimiter chr has been encountered

If cntChr > 0 Then

'extract the executable from the input string

strLRSeg = Mid(strIn,intStartChr,cntChr)

'if executable has no extension, add ".exe"

If Fso.GetExtensionName(strLRSeg) = "" Then _

strLRSeg = strLRSeg & ".exe"

cntChr = 0 'reset the executable counter

cntAr = cntAr + 1 'increment the output array UBound

ReDim Preserve arOut(cntAr) 'redim the output array

arOut(cntAr) = strLRseg 'add the executable to the output array

End If 'non-delimiter chr encountered?

intStartChr = i + 1 'reset the executable string start to next chr

Else 'chr not a delimiter

cntChr = cntChr + 1 'increment the exec string counter

End If 'chr a delimiter?

Next 'line chr

'check the end-string

If cntChr > 0 Then

'extract the executable

strLRSeg = Mid(strIn,intStartChr,cntChr)

cntAr = cntAr + 1 'increment the output array UBound

ReDim Preserve arOut(cntAr) 'redim the output array

arOut(cntAr) = strLRSeg 'add the executable to the output array

End If 'exec string found at end of line?

'if exec strings found

If cntAr >= 0 Then

'for every string

For i = 0 To UBound(arOut)

If strOut = "" Then

strOut = CoName(IDExe(arOut(i)))

Else

'concatenate a comma & co-name (with leading space)

strOut = strOut & "," & CoName(IDExe(arOut(i)))

End If

'return delimited string

LRParse = strOut

End Function

'read JOB file & output error if file corrupt

Function JobFileRead (oFile, oJobFi)

'number of Unicode chrs in Run field executable statements,

'decimal value of enabled byte, command string, error number

Dim intUChrCtr, int1C, strCmd, intErrNum

Dim strJobExe : strJobExe = "" 'concatenated executable string

Dim flagEnStatus : flagEnStatus = False 'task enabled status

'check for minimum length

If oFile.Size <= 80 Then

JobFileReadError oFile, " (too small)" : Exit Function

End If

On Error Resume Next

'determine enabled/disabled status by reading one Unicode chr

oJobFi.Skip(24)

int1C = AscB(oJobFi.Read(1))

'for a DISabled task: byte 48 (30h), 0-based-bit 2 (4-bit) = 1

If (int1C And 4) = 0 Then flagEnStatus = True

'if an enabled task

If flagEnStatus Then

'write titles & skip one line if not already done

If strTitle <> "" Then

TitleLineWrite

oFN.WriteBlankLines (1)

End If

'skip to the counter for the number of chrs in the first executable statement

oJobFi.Skip(10) 'no of bytes at unicode chr 35 (byte 70)

'no of chrs includes final zero chr so subtract one chr

intUChrCtr = AscW(oJobFi.Read(1))-1

'check for 0 or negative executable length

If intUChrCtr <= 0 Then

JobFileReadError oFile, " (no executable)"

Exit Function

End If

'read the chrs and convert to ASCII

strJobExe = MidB(oJobFi.Read(intUChrCtr),1)

intErrNum = Err.Number : Err.Clear

'check for truncated executable

If intErrNum <> 0 Then

JobFileReadError oFile, " (truncated executable)"

Exit Function

End If

strCmd = strJobExe 'store executable for co-name ID

'add ".exe" extension to bare executables

If Fso.GetExtensionName(strCmd) = "" Then strCmd = strCmd & ".exe"

'skip to parameters counter

oJobFi.Skip(1)

intErrNum = Err.Number : Err.Clear

'check for truncated file

If intErrNum <> 0 Then

JobFileReadError oFile, " (too small)"

Exit Function

End If

'read the parameters counter

intUChrCtr = AscW(oJobFi.Read(1))

intErrNum = Err.Number : Err.Clear

'check for absence of parameters counter

If intErrNum <> 0 Then

JobFileReadError oFile, " (parameter string size missing)"

Exit Function

End If

'if parameters exist, concatenate the executable

If intUChrCtr <> 0 Then _

strJobExe = strJobExe & Space(1) & MidB(oJobFi.Read(intUChrCtr-1),1)

intErrNum = Err.Number : Err.Clear

'check for truncated parameter string

If intErrNum <> 0 Then

JobFileReadError oFile, " (truncated parameter string)"

Exit Function

End If

'write out the .JOB file name & executable string

oFN.WriteLine DQ & Fso.GetBaseName(oFile.Path) & DQ &_

" -> launches: " & StringFilter(strJobExe,True) &_

CoName(IDExe(strCmd))

End If 'enabled task?

On Error Goto 0

End Function

'output reason for JOB file corruption

Function JobFileReadError (oFile, strReason)

'write titles if not already done

TitleLineWrite

'write out the .JOB file name & error

oFN.WriteLine DQ & Fso.GetBaseName(oFile.Path) & DQ &_

" -> " & "WARNING -- The file " & DQ & oFile.Name & DQ &_

" is corrupt!" & strReason

End Function

'filter unwritable chrs from output strings

'flagEmbedQ : if True, embed output string in quotes

Function StringFilter (strIn, flagEmbedQ)

'exit if string is null or empty

If IsNull(strIn) Then

StringFilter = "(null value)" : Exit Function

ElseIf strIn = Asc(0) Then

StringFilter = "(null value)" : Exit Function

ElseIf strIn = "" Then

StringFilter = "" : Exit Function

ElseIf LCase(strIn) = "(empty string)" Then

StringFilter = strIn : Exit Function

End If

Dim flagCorrupt : flagCorrupt = False 'unwritable chr encountered

Dim i, strChr 'counter, single chr

Dim intLen : intLen = Len(strIn) 'string length

Dim strOut : strOut = "" 'output string

'for every chr in argument

For i = 1 To intLen

'take ith chr

strChr = Mid(strIn,i,1)

'undocumented Asc behavior: certain chrs will return 63 ("?")

'if the chr really is a "?", then AscW will return the same thing

'otherwise, the chr is not a "?" and is unwritable

'if Asc = 160 Or Asc < 32 Or (Asc returns "?" but AscW doesn't)

If Asc(strChr) = 160 Or Asc(strChr) < 32 Or _

(Asc(strChr) = 63 And AscW(strChr) <> 63) Then

flagCorrupt = True : strOut = strOut & "*"

Else 'chr is legitimate ASCII

strOut = strOut & strChr

End If

If flagCorrupt Then

If flagEmbedQ Then

StringFilter = DQ & strOut & DQ & " (unwritable string)"

Else

StringFilter = strOut & " (unwritable string)"

End If 'flagEmbedQ?

Else 'input string is writable

If flagEmbedQ Then

StringFilter = DQ & strOut & DQ

Else

StringFilter = strOut

End If 'flagEmbedQ?

End If 'flagCorrupt?

End Function

'increment counters when IERESET.INF found-in-file-on-disk flag is False

Sub IERESETCounter (strSection, arIERSectionName, arSectionCount)

'if current INF section <> section for last not-found line

If strSection <> arIERSectionName Then 'if new section title

'increment # sections, reset # lines in section

'intSectionCount is an array index and initializes at -1

'intSectionLineCount initializes at 0 for new section

intSectionCount = intSectionCount + 1 : intSectionLineCount = 0

'1st row = section name; 2nd row = # not-found lines in section

'add column for new section to array, add title to array column

ReDim Preserve arSectionCount(1,intSectionCount)

arSectionCount(0,intSectionCount) = arIERSectionName

'set current section = section for last-found line

strSection = arIERSectionName

End If

'increment # lines not found in this section

intSectionLineCount = intSectionLineCount + 1

'increment # not-found lines in section

arSectionCount(1,intSectionCount) = intSectionLineCount

End Sub

'write title, sub-title, and sub-sub-title lines

Sub TitleLineWrite

If strTitle <> "" Then 'output title line if necessary

oFN.WriteLine vbCRLF & vbCRLF & strTitle & vbCRLF &_

String(Len(strTitle),"-")

strTitle = ""

End If

If strSubTitle <> "" Then 'output sub-title line if necessary

oFN.WriteLine vbCRLF & strSubTitle

strSubTitle = ""

End If

If strSubSubTitle <> "" Then 'output sub-title line if necessary

oFN.WriteLine vbCRLF & strSubSubTitle

strSubSubTitle = ""

End If

End Sub

Sub CLSIDLocTitle (hLocHive, strKeyLoc, strCLSID, strLocTitle)

'assign default values

flagIsCLSID = False : strLocTitle = ""

'toggle flag if strCLSID in correct format

If IsCLSID(strCLSID) Then flagIsCLSID = True

'get title from value

'title retrieved successfully even if value of type REG_EXPAND_SZ

intErrNum = oReg.GetStringValue (hLocHive,strKeyLoc,strCLSID,strValue)

If intErrNum = 0 And strValue <> "" Then

strLocTitle = StringFilter(strValue, True)

Else

strLocTitle = "(no title provided)"

End If 'strValue returned?

End Sub

'for CLSID name, recover CLSID title, CLSID\InProcServer32 DLL name

Sub ResolveCLSID (strCLSID, hCLSIDHive, strCLSIDTitle, strIPSDLL)

Dim strValue_1, strValue_2, strKey_1, strKey_2

Dim intErrNum_1, intErrNum_2, intErrNum_3

Dim arN(), arT()

'assign default values

strCLSIDTitle = "" : strIPSDLL = ""

strKey_1 = "Software\Classes\CLSID\" & strCLSID

strKey_2 = "Software\Classes\CLSID\" & strCLSID & "\InProcServer32"

'look for key

intErrNum_1 = oReg.EnumValues (hCLSIDHive,strKey_1,arN,arT)

'if key exists

If intErrNum_1 = 0 Then

'look for title

intErrNum_2 = oReg.GetStringValue (hCLSIDHive,strKey_1,"",strValue_1)

'set CLSID key title

strCLSIDTitle = "(no title provided)"

If intErrNum_2 = 0 And strValue_1 <> "" Then _

strCLSIDTitle = StringFilter(strValue_1, True)

'look for IPSDLL

intErrNum_3 = oReg.GetExpandedStringValue (hCLSIDHive,strKey_2,"",strValue_2)

If intErrNum_3 = 0 And strValue_2 <> "" Then strIPSDLL = strValue_2

End If 'CLSID key exists?

End Sub

'search for CLSID verb at InProcServer32, LocalServer32, ProgID, VersionIndependentProgID subkeys

'

'two inputs: CLSID, upper limit of arCLSIDVerb to search

'five outputs: flag (TRUE if CLSID found to be a default value),

' string value of hive in which CLSID found,

' CLSID verb, default value of verb, CLSID title

Sub CLSIDPop (strCLSID, intLimit, flagAllowedVerb, strHive, strCLSIDVerb, strCLSIDVerbValue, strCLSIDTitle)

'initialize variables

strCLSIDVerbValue = "" : strCLSIDTitle = ""

'counters x 3, CLSID key, CLSID key + verb, error numbers x 2

Dim i, j, k, strCLSIDKey, strCLSIDSubKey, intErrNum, intErrNum1

'TRUE if CLSID resolved, used to back out of For loops

Dim flagFoundHere : flagFoundHere = False

Dim strCLSIDDefaultValue 'CLSID default value (used for title)

Dim arCLSIDVerbs : arCLSIDVerbs = Array("InProcServer32","LocalServer32", _

"ProgID","VersionIndependentProgID")

'look for CLSID verbs up to limit

For i = 0 To intLimit

'exit if subverb action already found

If flagFoundHere Then Exit For

'look in each hive

For j = 0 To 1

'exit if subverb action already found

If flagFoundHere Then Exit For

'form CLSID key & CLSID verb key

strCLSIDKey = "SOFTWARE\Classes\CLSID\" & strCLSID

strCLSIDSubKey = strCLSIDKey & "\" & arCLSIDVerbs(i)

'retrieve CLSID verb key default value

intErrNum = oReg.GetStringValue (arHives(j,1),strCLSIDSubKey,"",strCLSIDVerbValue)

'if CLSID verb default value found

If intErrNum = 0 And strCLSIDVerbValue <> "" Then

flagFoundHere = True

strHive = arHives(j,0) : strCLSIDVerb = arCLSIDVerbs(i)

'look for CLSID title

intErrNum1 = oReg.GetStringValue (arHives(j,1),strCLSIDKey,"",strCLSIDDefaultValue)

'set CLSID key title

strCLSIDTitle = "(no title provided)"

If intErrNum1 = 0 And strCLSIDDefaultValue <> "" Then _

strCLSIDTitle = StringFilter(strCLSIDDefaultValue, True)

'check if CLSID verb is default

For k = 0 To UBound(arAllowedHandlerGrammar)

If LCase(Trim(strCLSIDVerbValue)) = LCase(arAllowedHandlerGrammar(k)) Then

flagAllowedVerb = True : Exit For 'if default, toggle flag and exit

End If

Next 'arAllowedHandlerGrammar member

End If 'CLSID verb default value found?

Next 'j hive

Next 'i arCLSIDVerbs

End Sub

'find directories with System attribute and DESKTOP.INI file

'with .ShellClassInfo section and CLSID statement

Sub DirSysAtt (oDir)

'sub-dir collection & count, single sub-dir, error number

Dim colSF, cntSF, oSF, intErrNum

'DeskTop.Ini path string & Parse return string,

Dim strDTI, strDTIP

'avoid "RECYCLER" And "System Volume Information" directories

If InStr(LCase(oDir),"recycler") > 0 Or _

InStr(LCase(oDir),"recycled") > 0 Or _

InStr(LCase(oDir),"system volume information") > 0 Then Exit Sub

'increment folder count

ctrFo = ctrFo + 1

'form DESKTOP.INI path string

strDTI = oDir.Path & "\DESKTOP.INI"

'if root directory, backslash is present by default

If oDir.IsRootFolder Then strDTI = oDir.Path & "DESKTOP.INI"

'if System attribute present And DESKTOP.INI CLSID exists,

'add path to array & increment count

If (oDir.Attributes And 4) And Fso.FileExists(strDTI) Then

strDTIP = DTIParse(strDTI)

If strDTIP <> "" Then

ReDim Preserve arSDDTI(ctrArDTI) : arSDDTI(ctrArDTI) = strDTIP

ctrArDTI = ctrArDTI + 1

End If 'return string not empty?

End If 'S And DTI exists?

'count the sub-folders, trap any error (prob. due to permissions)

On Error Resume Next

Set colSF = oDir.SubFolders : cntSF = colSF.Count

intErrNum = Err.Number : Err.Clear

On Error Goto 0

'if no error, recurse the sub-folders

If intErrNum = 0 Then

For Each oSF In colSF : DirSysAtt oSF : Next

Set colSF=Nothing

Else 'add (permissions) error to array & increment count

ReDim Preserve arSDErr(ctrArErr) : arSDErr(ctrArErr) = oDir.Path

ctrArErr = ctrArErr + 1

End If

End Sub

'return output string for DESKTOP.INI with CLSID statement

'consisting of CLSID and InProcServer32 DLL

Function DTIParse (strDTIFN)

'DESKTOP.INI file, error number, CoName

Dim oDTIFi, intErrNum, strIPSDLL, strCN

Dim strOut : strOut = "" 'output string

'file line, Lower-Case Left-Trimmed line, pos'n of equals sign

'CLSID, key string, counter

Dim strLine, strLCLT, intEq, strCLSID, strKey, i

Dim flagSection : flagSection = False 'in [.ShellClassInfo]?

Dim flagAllow 'IPS DLL on allowed list?

Dim flagTitle 'hive title line written?

DTIParse = "" 'by default, return empty string

'try to open DESKTOP.INI

On Error Resume Next

Set oDTIFi = Fso.OpenTextFile(strDTIFN,1,False,0)

intErrNum = Err.Number : Err.Clear

On Error Goto 0

'return error if file can't be opened

If intErrNum <> 0 Then

DTIParse = strDTIFN & " -- cannot be opened!" : Exit Function

End If

'[.shellclassinfo]

'CLSID=

'UICLSID=

'for every line

Do While Not oDTIFi.AtEndOfStream

strLine = oDTIFi.ReadLine

strLCLT = LCase(LTrim(strLine))

'detect [.ShellClassInfo]

If Left(strLCLT,1) = "[" And InStr(strLCLT,".shellclassinfo") > 0 Then

flagSection = True

'toggle flag if encountered another section before CLSID statement

ElseIf Left(strLCLT,1) = "[" And InStr(strLCLT,".shellclassinfo") = 0 Then

flagSection = False

'detect "CLSID=" or "UICLSID="

ElseIf flagSection And (Left(strLCLT,5) = "clsid" Or _

Left(strLCLT,7) = "uiclsid") Then

'find "="

intEq = InStr(1,strLCLT,"=",1)

'if "=" past "CLSID"

If intEq > 5 Then

strCLSID = RTrim(Mid(strLCLT,intEq + 1)) 'save the string past the equals

strKey = "Software\Classes\CLSID\" & strCLSID & "\InProcServer32"

flagTitle = False

For ctrCH = intCLL To 1

'get the CLSID IPS from the registry

intErrNum = oReg.GetExpandedStringValue (arHives(ctrCH,1),strKey,"", strIPSDLL)

'if the IPS DLL exists, check if it's allowed, CoName = MS & CLSID hive = HKLM

If intErrNum = 0 And strIPSDLL <> "" Then

flagAllow = False : strCN = CoName(IDExe(strIPSDLL))

For i = 0 To UBound(arOKDLLs)

If LCase(Fso.GetFileName(strIPSDLL)) = LCase(arOKDLLs(i)) And _

strCN = MS And ctrCH = 1 Then

flagAllow = True : Exit For

End If 'allowed?

Next 'allowed IPS DLL

'form string if DLL not allowed Or ShowAll

If Not flagAllow Or flagShowAll Then

If strOut = "" Then 'if no output yet, write full headers

strOut = vbCRLF & strDTIFN & vbCRLF & "[.ShellClassInfo]" &_

vbCRLF & strLine & vbCRLF & " -> {" & arHives(ctrCH,0) & "...CLSID}\" &_

"InProcServer32\(Default) = " & DQ & strIPSDLL & DQ & strCN

flagTitle = True

Else 'concatenate add'l text

If Not flagTitle Then 'no output for this line, so write line

strOut = strOut & vbCRLF & strLine & vbCRLF &_

" -> {" & arHives(ctrCH,0) & "...CLSID}\InProcServer32\(Default) = " &_

DQ & strIPSDLL & DQ & strCN

flagTitle = True

Else 'flagTitle True - current file line has generated output,

'so just append CLSID info

strOut = strOut & vbCRLF &_

" -> {" & arHives(ctrCH,0) & "...CLSID}\InProcServer32\(Default) = " &_

DQ & strIPSDLL & DQ & strCN

End If 'flagTitle?

End If 'strOut empty?

End If 'DLL not allowed?

End If 'IPS DLL exists?

Next 'CLSID hive

End If 'equals sign past "CLSID" or "UICLSID"?

End If 'in [.ShellClassInfo] section?

Loop 'DESKTOP.INI line

oDTIFi.Close : Set oDTIFi=Nothing

'set function value & exit

DTIParse = strOut

End Function

'file type, hive number, SOC default value

'check existence of file type key if SOC key not found? (True = Yes)

Sub SOCValue (strFT, intHive, strDefVal, flagFTKey)

'key string, error, returned value, array of key values/value types,

'company name, ddeexec key name

Dim strKey, intErrNum, strValue, arNames(), arType(), strCN, strKeyDDEX

Dim strWarn : strWarn = ""

'initialize company name

strCN = ""

'form file type S

strKey = "Software\Classes\" & strFT & "\shell"

'look for shell default value

intErrNum = oReg.GetStringValue (arHives(intHive,1),strKey,"",strValue)

'if file type shell value exists And not empty And <> "open"

If intErrNum = 0 And strValue <> "" And LCase(strValue <> "open") Then

flagIWarn = True 'toggle flag for report file footer

'output shell default value with IWarn

strOut = StrOutSep (strOut,IWarn & SOCA(arHives(intHive,0) & "\" &_

StringFilter(strKey,False)) & "\(Default) = " &_

StringFilter(strValue,True),vbCRLF)

'form ddeexec key

strKeyDDEX = strKey & "\" & strValue & "\ddeexec"

'form command key

strKey = strKey & "\" & strValue & "\command"

'look for command value

intErrNum = oReg.GetStringValue (arHives(intHive,1),strKey,"",strValue1)

'if command value exists

If intErrNum = 0 And strValue1 <> "" Then

'find CoName

strCN = CoName(IDExe(strValue1))

'output command value with warning

strOut = StrOutSep(strOut,IWarn & SOCA(arHives(intHive,0) & "\" &_

StringFilter(strKey,False)) & "\(Default) = " &_

StringFilter(strValue1,True) & strCN,vbCRLF)

End If 'command value exists?

'look for ddeexec value

DDEX intHive, strKeyDDEX

Else 'shell value empty Or = "open"

'form ddeexec key

strKeyDDEX = strKey & "\open\ddeexec"

'form SOC key

strKey = strKey & "\open\command"

'look for file type SOC

intErrNum = oReg.GetStringValue (arHives(intHive,1),strKey,"",strValue)

'if file type SOC value exists

If intErrNum = 0 And strValue <> "" Then

'if SOC value not expected, look for company name

If LCase(strValue) <> LCase(strDefVal) Then

strCN = CoName(IDExe(strValue))

strWarn = IWarn : flagIWarn = True

End If

'output if default value not expected or show all

If (LCase(strValue) <> LCase(strDefVal)) Or flagShowAll Then

strOut = StrOutSep(strOut,strWarn & SOCA(arHives(intHive,0) & "\" &_

StringFilter(strKey,False)) & "\(Default) = " &_

StringFilter(strValue,True) & strCN,vbCRLF)

End If

'file type SOC default value doesn't exist, does SOC key exist?

Else

'look for SOC key

intErrNum = oReg.EnumValues (arHives(intHive,1),strKey,arNames,arType)

'output SOC key status

If intErrNum = 0 Then

strOut = StrOutSep(strOut,SOCA(arHives(intHive,0) & "\" &_

StringFilter(strKey,False)) & "\(Default) = (value not set)",vbCRLF)

'SOC key doesn't exist, check for file type key if requested

ElseIf flagFTKey Then

'output missing HKLM key

If intHive = 1 Then strOut = StrOutSep (strOut,SOCA(arHives(intHive,0) &_

"\" & StringFilter(strKey,False)) & "\ = (key not found)",vbCRLF)

'form file type key

strKey = "Software\Classes\" & strFT

'look for file type key

intErrNum = oReg.EnumValues (arHives(intHive,1),strKey,arNames,arType)

'output file type key status

If intErrNum = 0 Then

strOut = StrOutSep (strOut,SOCA(arHives(intHive,0) & "\" &_

StringFilter(strKey,False)) & "\",vbCRLF)

ElseIf intHive = 1 Then

strOut = StrOutSep (strOut,SOCA(arHives(intHive,0) & "\" &_

StringFilter(strKey,False)) & "\ = (key not found)",vbCRLF)

End If

End If 'check file type key?

End If 'file type SOC exists?

'look for ddeexec value

DDEX intHive, strKeyDDEX

End If 'file type shell exists?

End Sub

'look for shell\open\ddeexec default values

Sub DDEX (intHive2, strKey)

'error x 2, returned value, arrays of key values/value types

Dim intErrNum, intErrNum1, strValue, arNames(), arType()

Dim strWarn : strWarn = IWarn

'look for ddeexec key

intErrNum = oReg.EnumValues (arHives(intHive2,1),strKey,"",arNames,arType)

'if ddeexec key exists

If intErrNum = 0 Then

flagIWarn = True

'get default value

oReg.GetStringValue arHives(intHive2,1),strKey,"",strValue

'form output string

strOut = StrOutSep (strOut, strWarn & SOCA(arHives(intHive2,0) & "\" &_

StringFilter(strKey,False)) & "\(Default) = " &_

StringFilter(strValue,True),vbCRLF)

'look for Application key

intErrNum1 = oReg.EnumValues (arHives(intHive2,1),strKey & "\Application","",arNames,arType)

'if Application key exists, get default value

If intErrNum1 = 0 Then

oReg.GetStringValue arHives(intHive2,1),strKey & "\Application","",strValue1

strOut = StrOutSep (strOut, strWarn & SOCA(arHives(intHive2,0) & "\" &_

StringFilter(strKey,False)) & "\Application\(Default) = " &_

StringFilter(strValue1,True),vbCRLF)

End If 'Application key exists?

End If 'ddeexec key exists?

End Sub

'initial output string, string to add, Separator string

Function StrOutSep (strOut, strAdd, strSep)

'if output string not empty, separate added string with strSep

If strOut <> "" Then

StrOutSep = strOut & strSep & strAdd

Else 'initial output string empty, set output to added string

StrOutSep = strAdd

End If

End Function

'recurse sub-directories for WVa Scheduled Tasks, run ESTParse sub on contents

Sub DirEST (oDir)

Dim strOutFo : strOutFo = "" 'output string for the folder

'File/Sub-Folder collections & count, single file/sub-dir

Dim colFi, colSF, oFi, oSF

'avoid "RECYCLER" And "System Volume Information" directories

If InStr(LCase(oDir.Name),"recycler") > 0 Or _

InStr(LCase(oDir.Name),"recycled") > 0 Or _

InStr(LCase(oDir.Name),"system volume information") > 0 Then Exit Sub

Set colFi = oDir.Files 'get the file collection

'trap any file access errors in the directory

'parse each file for EST info and append info to output string

On Error Resume Next

For Each oFi In colFi

strTmp = ESTParse(oFi.Path)

If strTmp <> "" Then 'if EST found

If strOutFo <> "" Then 'if output string not MT

strOutFo = strOutFo & vbCRLF & strTmp 'add EST to next line

Else 'output string still MT

strOutFo = strTmp 'don't precede EST string with CR

End If 'output string MT?

End If 'EST found?

Next 'next file in directory

intErrNum = Err.Number : Err.Clear

On Error Goto 0

'in case of access error, save the directory path in the error array

' increment the error count & exit

If intErrNum <> 0 Then

ReDim Preserve arErr(ctrErr) : arErr(ctrErr) = oDir.Path

ctrErr = ctrErr + 1 : Exit Sub

End If

'if EST's found, prefix the output string with the directory path

If strOutFo <> "" Then

If strOut = "" Then 'if first directory with output

'skip line and place EST's below directory path

strOut = vbCRLF & oDir.Path & vbCRLF & strOutFo

Else 'not first directory with output

'put blank line between old and new strings, then follow with

'directory path and new EST's

strOut = strOut & vbCRLF & vbCRLF & oDir.Path & vbCRLF & strOutFo

End If 'first directory with output?

End If 'EST's found in directory?

'get the sub-folder collection, trap any error (prob. due to permissions)

On Error Resume Next

Set colSF = oDir.SubFolders

intErrNum = Err.Number : Err.Clear

On Error Goto 0

'if no error, recurse the sub-folders

If intErrNum = 0 Then

For Each oSF In colSF : DirEST oSF : Next

Set colSF=Nothing

Else 'add (permissions) error to array & increment count

ReDim Preserve arErr(ctrErr) : arErr(ctrErr) = oDir.Path

ctrErr = ctrErr + 1

End If

End Sub

'WVa Enabled Scheduled Task (XML file) Parser

Function ESTParse (strESTFN)

Dim strCLSID, strCLSIDTitle, strIPSDLL, strNodeText

Dim strArg, flagIPSFnd

Dim flagDisabled : flagDisabled = False 'disabled flag

Dim strHidden : strHidden = ""

ESTParse = "" 'by default, return empty string

'create XML document

Dim oXMLFi: Set oXMLFi = CreateObject("MSXML2.DOMDocument")

'try to open argument (task file)

On Error Resume Next

oXMLFi.Load strESTFN

intErrNum = Err.Number : Err.Clear

On Error Goto 0

'exit if file can't be opened

If intErrNum <> 0 Then Exit Function

'exit if not a valid XML file or if file cannot be opened due to

'insufficient permissions

'also available: oXMLFi.ParseError.ErrorCode, oXMLFi.ParseError.Reason

If oXMLFi.ParseError.ErrorCode <> 0 Then Exit Function

On Error Resume Next

strNodeText = LCase(oXMLFi.SelectSingleNode("//Settings/Enabled").text)

intErrNum = Err.Number : Err.Clear

On Error Goto 0

If intErrNum = 0 Then

If strNodeText = "false" Then flagDisabled = True

End If

'if task is not disabled

If Not flagDisabled Then

'check if hidden

'*MUST* enclose within On Error, set .text property, save error number,

'test error number subsequently and *then* set dependent variable value

On Error Resume Next

strNodeText = LCase(oXMLFi.SelectSingleNode("//Settings/Hidden").text)

intErrNum = Err.Number : Err.Clear

On Error Goto 0

If intErrNum = 0 Then

If strNodeText = "true" Then strHidden = "(HIDDEN!)"

End If

'look for Custom Handler

'removal of "On Error Resume Next" generated error if CLSID not

' present and caused Function to return, but script did not abort

On Error Resume Next

strCLSID = oXMLFi.SelectSingleNode("//ComHandler/ClassId").text

intErrNum = Err.Number : Err.Clear

On Error Goto 0

If intErrNum = 0 Then 'Custom Handler present

'add CLSID to output string

ESTParse = DQ & Fso.GetFileName(strESTFN) & DQ &_

" -> " & strHidden & " launches: " & DQ & strCLSID & DQ

flagIPSFnd = False 'assume IPS DLL doesn't exist

'look for InProcServer32 in HKCU/HKLM

For ctrCH = 0 To 1

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

'if IPS found

If strIPSDLL <> "" Then

flagIPSFnd = True 'toggle flag

'append IPS string to output string

ESTParse = ESTParse & vbCRLF &_

" -> {" & arHives(ctrCH,0) & "...CLSID} = " &_

strCLSIDTitle & vbCRLF & Space(19) & "\InProcServer32\(Default) = " &_

StringFilter(strIPSDLL,True) & CoName(IDExe(strIPSDLL))

End If 'strIPSDLL exists?

Next 'CLSID hive

'if IPS not found, say it and return

If Not flagIPSFnd Then ESTParse = ESTParse & DQ &_

" [inProcServer32 entry not found]"

End If 'Custom Handler present?

'look for executable command

'removal of "On Error Resume Next" generated error if CLSID not

' present and caused Function to return, but script did not abort

On Error Resume Next

strCmd = oXMLFi.SelectSingleNode("//Command").text

intErrNum = Err.Number : Err.Clear

On Error Goto 0

'if command exists, save to output

If intErrNum = 0 Then

ESTParse = DQ & Fso.GetFileName(strESTFN) & DQ &_

" -> " & strHidden & " launches: " & DQ & strCmd

strCN = CoName(IDExe(strCmd)) 'find CoName

'look for executable arguments

'removal of "On Error Resume Next" generated error if CLSID not

' present and caused Function to return, but script did not abort

On Error Resume Next

strArg = oXMLFi.SelectSingleNode("//Arguments").text

intErrNum1 = Err.Number : Err.Clear

On Error Goto 0

'if arguments exist, add to output and return

If intErrNum1 = 0 Then

ESTParse = ESTParse & Space(1) & strArg & DQ & strCN

ElseIf ESTParse <> "" Then 'otherwise terminate output string

ESTParse = ESTParse & DQ & strCN

End If

End If 'command exists?

End If 'task not disabled?

End Function

'hex hive, registry key

Sub GPRecognizer (hHive, strKey)

'error number, counters x 2, Known Setting Index,

'Group Policy setting location string, value type

Dim intErrNum, i, j, intKSI, intISI, strGPLoc, strType

Dim flagIgnore

Dim arNames(), arType() 'returned array of value names/types

Const UCFG = "{User Configuration|"

Const CCFG = "{Computer Configuration|"

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

If hHive = HKLM Then strSubSubTitle = SOCA("HKLM\" & strKey & "\")

'set up GPO type

Dim strGPOT : strGPOT = UCFG 'GPO Type

If hHive = HKLM Then strGPOT = CCFG

'obtain arrays of value names & types

intErrNum = oReg.EnumValues (hHive, strKey, arNames, arType)

'if array returned (exc for WS2K3)

If intErrNum = 0 And IsArray(arNames) Then

On Error Resume Next 'WS2K3 will throw error if no values exist

'for every member of the names array

For i = 0 To UBound(arNames)

'if not default value

If arNames(i) <> "" Then

flagIgnore = False 'assume name not approved

'retrieve the value as a string

strValue = RtnValue (hHive, strKey, arNames(i), arType(i))

'save the value type as a string

strType = RtnType (arType(i))

'compare name/value pair to approved names/values

For j = 0 To UBound(arAllowedNames,1)

'for approved names and equivalent or any values,

'toggle flag and exit

If LCase(Trim(arNames(i))) = LCase(arAllowedNames(j,0)) Then

If ((LCase(strValue) = LCase(arAllowedNames(j,3))) Or _

arAllowedNames(j,3) = "***") And Not flagShowAll Then

flagIgnore = True : intISI = j : Exit For

Else 'approved name, but unapproved value or ShowAll

'form output string and write to file, avoid add'l output

strGPLoc = strGPOT & arAllowedNames(j,1) & vbCRLF

'if GP not used here or GP editor doesn't contain this value,

'set location string to LBr

If Not flagGP Or arAllowedNames(j,1) = "" Then strGPLoc = LBr

TitleLineWrite

oFN.WriteLine vbCRLF & DQ & arNames(i) & DQ & " = (" & strType & ") " &_

strValue & vbCRLF & strGPLoc & arAllowedNames(j,2)

flagIgnore = True

End If 'approved value?

End If 'approved name?

Next 'arAllowedNames member

'if name/value not approved

If Not flagIgnore Then

flagFound = False 'assume name not recognized

'for every recognized name

For j = 0 To UBound(arRecNames,1)

'if name on recognized list, toggle flag and save array index

If LCase(Trim(arNames(i))) = LCase(arRecNames(j,0)) Then

flagFound = True : intKSI = j : Exit For

End If

Next 'recognized name array member

If flagFound Then 'if name recognized

'form output string and write to file

strGPLoc = strGPOT & arRecNames(intKSI,1) & vbCRLF

'if GP not used here or GP editor doesn't contain this value,

'set location string to LBr

If Not flagGP Or arRecNames(intKSI,1) = "" Then strGPLoc = LBr

TitleLineWrite

oFN.WriteLine vbCRLF & DQ & arNames(i) & DQ & " = (" & strType & ") " &_

strValue & vbCRLF & strGPLoc & arRecNames(intKSI,2)

Else 'name not recognized

TitleLineWrite

oFN.WriteLine vbCRLF & DQ & arNames(i) & DQ & " = (" & strType & ") " &_

strValue & vbCRLF & "{unrecognized setting}"

End If 'name recognized?

End If 'not approved name/value?

End If 'default name?

Next 'next arNames member

On Error Goto 0

'output reg-key title if absent or empty and ShowAll

ElseIf flagShowAll Then

TitleLineWrite

End If 'reg key has values?

End Sub

Sub ReDimGPOArrays

ReDim arRecNames(0,0) : arRecNames(0,0) = ""

ReDim arAllowedNames(0,0) : arAllowedNames(0,0) = ""

End Sub

Function SecTest

Dim i

SecTest = False

'check section status if in testing mode

If flagTest Then

For i = 0 To UBound(arSecTest)

'if section number in arSecTest, toggle function

If arSecTest(i) = intSection Then

SecTest = True : Exit For

End If 'this section in arSecTest?

End Function

Sub StrParse2Unique (strIn)

Dim i 'counter

Dim intStrLen : intStrLen = Len(strIn) 'input string Length

Dim cntChr : cntChr = 0 'number of chrs in executable string

Dim intStartChr : intStartChr = 1 'start of component name in string

'for every chr in input string

For i = 1 To intStrLen

'if the chr is a delimiter

If Mid(strIn,i,1) = " " Or Mid(strIn,i,1) = "," Then

'if at least one non-delimiter chr has been encountered

If cntChr > 0 Then

AppUnique2DynArr strIn,intStartChr,cntChr

intStartChr = i + 1 'reset the executable string start to next chr

End If

Else 'chr not a delimiter

cntChr = cntChr + 1 'increment the exec string counter

End If 'chr a delimiter?

Next 'line chr

'check the end-string

If cntChr > 0 Then

AppUnique2DynArr strIn,intStartChr,cntChr

End If 'exec string found at end of line?

End Sub

'APPendUNIQUE2DYNamicARRay

Sub AppUnique2DynArr (strIn,intStart,intLen)

Dim i 'counter

Dim strCName : strCName = Mid(strIn,intStart,intLen) 'extract the component from the input string

intLen = 0 'reset the executable counter

Dim flagNew : flagNew = True 'true if extracted component not already in array

If intUB >= 0 Then

For i = 0 To intUB

If LCase(arAcc(i)) = LCase(strCName) Then

flagNew = False : Exit For

End If

If flagNew Then

intUB = intUB + 1 : ReDim Preserve arAcc(intUB)

arAcc(intUB) = strCName 'add the component to the output array

End If

End Sub

'SOftWare CAse

Function SOCA (strIn)

SOCA = strIn

If InStr(strIn,"HKCU\SOFTWARE") > 0 Then _

SOCA = Replace(strIn,"HKCU\SOFTWARE","HKCU\Software")

If InStr(strIn,"HKLM\Software") > 0 And strOSLong <> "Windows 98" Then

SOCA = Replace(strIn,"HKLM\Software","HKLM\SOFTWARE")

ElseIf InStr(strIn,"HKLM\SOFTWARE") > 0 And strOSLong = "Windows 98" Then

SOCA = Replace(strIn,"HKLM\SOFTWARE","HKLM\Software")

End If

End Function

'SYstem CAse

Function SYCA (strIn)

SYCA = strIn

If InStr(strIn,"HKLM\System") And strOS <> "W98" And strOS <> "WME" Then _

SYCA = Replace(strIn,"HKLM\System","HKLM\SYSTEM")

If InStr(strIn,"HKLM\SYSTEM") And (strOS = "W98" Or strOS = "WME") Then _

SYCA = Replace(strIn,"HKLM\SYSTEM","HKLM\System")

End Function

Function IsCLSID (strIn)

'{########-####-####-####-############}

'set default value

IsCLSID = False

Dim strWork, i

Dim arHexAlpha : arHexAlpha = Array("a","b","c","d","e","f")

'check length, first & last chrs

If Len(strIn) = 38 And Left(strIn,1) = "{" And Right(strIn,1) = "}" Then

strWork = strIn

'change all digits to 0

For i = 1 To 9

strWork = Replace (strWork,i,"0")

For i = 0 To UBound(arHexAlpha)

strWork = Replace (LCase(strWork),arHexAlpha(i),"0")

If strWork = "{00000000-0000-0000-0000-000000000000}" Then

IsCLSID = True : Exit Function

End If

End If 'len, 1st/last chrs OK?

'exit with default value if land here

End Function

'R00

'initial rev. 2004-04-20

'R01

'avoided trailing backslash for ScrPath if path is drive root; added

'detection of W98 and HKLM... RunOnceEx, RunServices, RunServicesOnce;

'enumeration of RunOnceEx keys; error if WMI not installed with launch

'of browser to download site & message in text file

'R02

'minor report enhancements

'R03

'added computer name to report file name

'R04

'added:

'HKCU-HKLM\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run

'HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows\load & run

'HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell & Userinit

'HKLM\Software\Classes\[exe-type]file\shell\open\command

'WIN.INI [windows] load= & run=

'SYSTEM.INI [boot] shell=

'R05

'added:

'HKLM\Software\Microsoft\Windows\CurrentVersion\RunOnceEx

'HKLM\Software\Microsoft\Windows\CurrentVersion\ShellServiceObjectDelayLoad

' value of name is CLSID whose InProcServer32 default name's value = executable

'omitted output if keys empty

'R06

'omitted all output if anomalies absent; added W98Titles & DefExeTitles

'functions

'R07

'added RegDataChk sub

'added:

'HKLM\Software\Microsoft\Active Setup\Installed Components\

'HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\SharedTaskScheduler\

'HKCU & HKLM\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains\

'HKCU & HKLM\Software\Microsoft\Command Processor\AutoRun

'HKLM\Software\Microsoft\Windows NT\CurrentVersion\Windows\AppInit_DLLs

'HKLM\System\CurrentControlSet\Control\Session Manager\BootExecute

'R08

'removed:

'HKCU & HKLM\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains\

'manages restricted/trusted sites, but not an executable launch point

'added MsgBox at script completion

'R09

'added identification of PIF target, converted script completion

'MsgBox to PopUp

'R10

'added VIII. shortcut parameters

'R11

'added length check for CLSID data, error handling for bad values

' & missing BHO InprocServer32 key

'added:

'WINSTART.BAT contents listing

'HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\

'R12

'added 10-line "unalterable" comments header

'added detected O/S to output file (incl. WMe & WS2K3)

'changed terminology from "value/data" to "name/value"

'added to section I:

' arRegFlag array (for each O/S: hive,key,execution applicability & warning flags)

' W98,WMe,NT4,W2K,WXP arRegFlag data

' EnumKeyData function for parsing of all value data types & display

' in output file

' subkey recursion (for handling of W2K bug & HKCU/HKLM... RunOnce\Setup)

'removed from Section I:

' HKCU...RunServices & RunServicesOnce for W98

' HKCU... / HKLM... Explorer\Run for NT4

'R13

'added MsgBox to quit if WS2K3 detected

'added HKLM... Winlogon\Notify

'encoded MsgBox e-mail address in hex

'R14

'added INFECTION WARNING! for non-default Winlogon\Notify entry

'R15

'added default value as program's title to HKLM...Active

'Setup\Installed Components section

'R16

'corrected R07 comments concerning HKLM...BootExecute

'R17

'added detection of URL shortcuts in Start Menu folders

'R18

'changed attribution header to accommodate SE results

'added Echo output for CScript host

'added revision number to output file

'modified section II:

' list HKLM\Software\Microsoft\Active Setup\Installed Components\ if

' StubPath value exists and HKCU... Active Setup\Installed Components

' key does not exist, or if HKLM comma-delimited version number > HKCU

' version number

'added to section VI:

' HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\Shell

' HKCU\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell

'modified section X: suppressed startup folder title in output file if folder empty

'added section XI - enabled Scheduled Tasks

'redimmed arrays to 0 to recover memory at end of every section

'R19

'added to section X:

' %WINDIR%\All Users... Startup for W98

'in section XI:

' fixed executable statement parsing bug due to use of Asc instead of AscW

' changed enabled criterion to single byte (44)

'added revision number to MsgBox/Echo at EOJ

'R20

'added output file directory via argument

'added two sections & renumbered existing sections

'added tests for WMe in sections VI, VII, X, XI

'in section III:

' obtained BHO names from CLSID key if unavailable from BHO key

'added section VIII for W2K/WXP:

' HKCU/HKLM\Software\Policies\Microsoft\Windows\System\Scripts

'in section XI:

' excluded DESKTOP.INI files when present in startup directories,

' revised startup folder name title output to only occur if shortcut,

' PIF or executable found in folder

'in section XII:

' changed enabled criteria to single byte: 30h (48),

' bit 2 (0-based) = 0

'added section XIII: started service name, display name, path,

' CompanyName != Microsoft

'added functions: IDExe - extract service executable from path

' FLN - find leading script executable number

' ScrIP - SCRIPTS.INI parser

' CoName - find CompanyName in file

'R21

'added trap for VBScript version for W98/NT4

'added detection of W95 (interpreted as W98)

'added Err.Clear statement after every invocation of On Error Resume Next

'added script name to report header

'added namespace to WMI connection statement

'revised CoName function to concatenate several path strings and call

' 2nd function that uses WMI to retrieve co-name

'added functions: LRParse - parse load/run lines for executables

' CNCall - locate file in initial string, windows,

' system, app paths; retrieve co-name via WMI

'added co-name ID to all pgm sections

'removed output of value type from section I

'fixed bug in section VI - HKLM\...Winlogon\Userinit, infection alert

' was being issued when no comma in string

'changed BootExecute output in VI from output line for every

' multistring entry to single line

'R22

'fixed CNCall malformed path (leading backslash) bug, improved CNCall

'error handling; protected CoName from null or empty ImagePath strings

'due to deleted service left running

'R23

'changed strAUSUF to flagAUSUF in section XI

'added error handling for corrupt JOB file in section XII

'added function: JobFileRead

'changed "empty data" to "empty string" in CNCall

'added ".exe" to extension-less executable in JobFileRead

'R24

'revised R23 changes

'added back strTitleLine assignment in section XII

'R25

'added test for arHKCUKeys array in HKCU... Active Setup\Installed

' Components (section II)

'DIMed local variables in AppPath to avoid conflict with strValue used

' in Section VI; fixed same bug in IniLRS

'suppressed section title if both startup folders empty in section XI

'R26

'changed endpoint in services sort in section XIII so that sort

' included last service in initial array

'R27

'declared strFPSF & strFPWF Public (used in CoName sub)

'script host bug workaround: in some script versions,

' CreateTextFile/OpenTextFile with Create parameter=True overwrites

' file contents line by line instead of overwriting file, so now delete

' output file if it exists before writing to it

'added trap for CreateTextFile error

'added colons to all section titles

'added comments to better explain array in section I

'added to section V: HKCU...ShellServiceObjectDelayLoad

'added to section VI: GinaDLL

'added to section VII: Notify values for W2K (termsrv) & WS2K3 (=WXP)

'new section XI: AUTORUN.INF in root of fixed disks, renumbered XII-XIV

'added functions: NDTAR, NDAR, FmtTime

'changed function titles: W98Titles -> IniInfTitles; IniLRS -> IniInfParse

'modified function RegDataChk to handle no value or empty+expected value

'added script launch time to output file header

'R28

'new section IV: HKLM...Shell Extensions\Approved, renumbered V-XV

'restricted output in sections II, V, XIV

'added flagShowAll and "-all" command line parameter

'added header and footer comments, {++} indicator in non-default mode

' for HKCU/HKLM...Run keys

'subkey enumeration (EnumKey) via IsArray followed by For Each

'enabled WS2K3 operation, extended final popup to 5 seconds

'R29

'redirected browser to RED version in case of CreateTextFile error

'appended wscsvc to arMSSvc for WXP

'checked for null string returned by oReg.GetStringValue

'fixed bug under XP for script not stored in default script directory --

' CoName was always "file not found"

'in Section II (HKLM... Active Setup\Installed Components), avoid code

' section if HKLM Version name doesn't exist or value not set (exc for (W2K!)

'in Section III (HKLM... Explorer\Browser Helper Objects\), avoid

' output if InProcServer32 default value not set

'in Section V (HKLM... Explorer\SharedTaskScheduler), avoid code if

' IPS doesn't exist

'rewrote IDExe & revised CoName functions, eliminated CNCall

'R30

'added FmtHMS function, removed FmtTime function

'added hh.mm.ss to report file name

'use unique time for report title, removed launch time from report header

'default flagOut = "C" if neither WSCRIPT nor CSCRIPT detected

'in Section XIII, for executable in SU directory, send Path to IDExe

' instead of Name

'in IDExe & WSL functions, return Path property of GetFile object so path

' included if file located in VBS CurrentDirectory

'standardized CLSID InProcServer32 output line in Sections III, IV, V, VI to:

' " -> {CLSID}\InProcServer32\(Default) = "

'R31

'added instructions for WXP if Fso connection fails

'added instructions for W2K/WXP if WMI connection fails

'added StringFilter function to filter unwritable default values

'added to section VII: Policies\System\Shell for W2K

'added to section X: cmd, scr; added arExpVal (expected value array);

' get filetype from extension default value and check filetype

' shell\open\command

'removed DefExeTitles function

'added section XI: scrnsave.exe for NT4/W2K/WXP

'added to section XII: scrnsave.exe in SYSTEM.INI

'added section XVII: Winsock2 Service Provider DLLs

'modified IDExe to use common environment variables

'added section XVIII: IE URL prefixes

'R31.1

'added home page URL to report header

'R32

'removed quotes surrounding key\value name output in following sections:

' HKLM... Active Setup\Installed Components

' HKLM...Winlogon\Notify\

'added section X: HKCR\Protocols\Filter

'modified output format in Screen Saver section

'R33

'section II: HKLM-to-HKCU Active Setup/Installed Components key names

' made non-case-specific

'added to section VII: Winlogon\Taskman

'added to section XII: Wallpaper

'allowed URL\Prefixes names to contain trailing periods

'moved Services to next-to-last section (XX)

'trapped error & quit if running services can't be counted

'added section XIX: HOSTS

'added section XXI: Keyboard Driver Filters

'added sub: SRClose

'R34

'added section XVIII: Toolbars, Explorer Bars (active & dormant), Extensions

'section XX: detect tabs [Chr(09)] in addition to spaces as HOSTS file delimiter

'section XXI: moved DIM of two variables to main (errors not thrown

' by Option Explicit!)

'added flagPad to StringFilter function

'retrieved all InProcServer32 default values via GetExpandedStringValue

' instead of GetStringValue

'R35

'revised R34 notes

'introduced MS constant

'section V: added HKLM...Explorer\ShellExecuteHooks, modified allowed

' logic

'section VIII: added "&Discuss" to allowed Explorer Bars

'section XV: added INFECTION WARNING if executable located in startup directory

'changed flagPad to flagEmbedQ in StringFilter function

'R36

'added flagTest

'added section IX: HKLM...Windows NT\CurrentVersion\Image File Execution Options

'section XXI: checked HOSTS file location at HKLM...Tcpip\Parameters\DataBasePath

'R37

'added W95 & WMe compatibility

'sections III & XX: if ShowAll, write section titles if hive keys absent

'added section XIII: System/Group Policies

'moved wallpaper ahead of screen saver in section XIV

'in RegDataChk, sent "shell" line to LRParse for ID of malware CoName

'R38

'added script startup popup

'replaced EnumKeyData with EnumNVP and RtnValue functions, renamed

' ScrIP to ScrIFP

'added IERESETCounter, ResolveCLSID, TitleLineWrite functions

'section XIII: added Control Panel applet removal + 2 toolbar entries

' to Explorer values; added Policies\Microsoft\Internet Explorer

' subsection

'section XX (IE Toolbars, Explorer Bars, Extensions): moved CLSID

' titles (default values) to the CLSID line

'added section XXII: misc IE hijack points (IERESET.INF,

' URLSearchHooks, AboutURLS)

'section XXIII: detect tabs preceding spaces as HOST file delimiters

'added "--" tail to ShowAll report

'removed Messenger from allowed IE extensions (Messenger has

' vulnerable versions)

'R38.1

'section XXII: determined IERESET.INF format by reading 1st 2 chrs

'before opening to compare with local copy

'R39

'performed housekeeping on all opened objects

'section XIII: added Explorer\NoFolderOptions, NoWindowsUpdate,

' and DisableWindowsUpdateAccess; HKLM... Windows NT\SystemRestore

'added section XII: context menu shell extensions

'added section XVIII: DESKTOP.INI in local fixed drive directory

'added -supp command line parameter to skip DESKTOP.INI and dormant

' Explorer Bar sections

'SRClose: added -supp advisory and reformatted

'section XXIV: added IERESET.INF minimum size requirement

'section XXVI: added 5 services for W2KS & 1 for WXP

'report footer: added total run time, DESKTOP.INI folder search time,

' dormant Explorer Bar search time

'added popup to select -supp parameter

'fixed intMB Dim placement bug

'R40

'moved WMI installation detection after VBScript version & OS version

' detection

'switched supp search msgbox buttons so that "Yes" is default instead of "No"

'suppressed menu display time when using CSCRIPT.EXE

'section XIV: for WXP SP2, added NoExtensionManagement

'section XVIII: trapped error if letter assigned to RAW data

' (ex: Linux) partition

'section XXIV: added On Error trap for IERESET.INF lines

'function IDExe: simplified use of ExpandEnvironmentStrings

'function CoName: added StringFilter for Unicode names

'R40.1

'edited SRClose footer to cite pressing "No" instead of "Yes" at first

'msgbox for -supp option

'R41

'section VII: check for existence of BootExecute value before

' validating

'added section XXVIII: Print Monitors

'R42

'added WINVER.EXE file version for W95 SR2 (OEM)

'lengthened final Popup time from 5 to 20 seconds

'R43

'section XII: added HKLM... Control\SafeBoot\Option\UseAlternateShell

'R44

'sections III-IV-V-VI-XI-XII-XVIII-XXII-XXIV: modified CLSID\InProcServer32

' search to use HKCU, then HKLM

'section XI: modified Classes\PROTOCOLS\Filter search to use HKCU, then HKLM

'section XII: added ColumnHandlers

'section XIII: rewrote to output non-default values in HKCU/HKLM

'section XXV: improved function logic, added ExpandEnvironmentStrings

' to DataBasePath value

'added SOCValue sub and StrOutCR function

'WriteValueData function: protected strName with StringFilter

'CoName function: removed StringFilter for findable file with Unicode name

'R45

'added colOS WMI error trap

'section VII: added WOW\cmdline and WOW\wowcmdline values

'modified function RegDataChk to handle empty string or missing

' name/value pair

'changed "(no data)" to "(value not found)"

'R46

'section VII: removed output of BootExecute strLine on WriteLine error

'section XIII, SOCValue sub: added check for shell default value

'added DDEX sub to look for open\ddeexec value in SOCValue sub

'R47

'section VIII: added wgalogon to Winlogon\Notify allowed entries

'section XIII: output default executable string via StringFilter

'section XXI: arTSPFi (TSP output array) initial REDIM statement

' changed from (2,0) to (3,0)

'section XXVI: tested service pathname returned by WMI for null or

' empty string before storing in array

'for compatibility with IE 7 RC1, modified sections:

' IV (Shell Extensions)

' V (SharedTaskScheduler)

' XXIV (bypass of IERESET.INF check, AboutURLs)

'R48

'section VII: added HKLM\System\CurrentControlSet\Control\SecurityProviders\SecurityProviders

'R49

'added message box to confirm choice of supplementary search

'added IWarn/HWarn strings with explanatory footer note if present

'abandoned roman numerals for section numbers

'added SecTest for section testing

'changed OS version error e-mail address

'section 1: added W95-specific matrix; HKCU...RunOnceEx for all OS's

' Policies/Explorer/Run for WMe, Run/RunOnce subkey launch for WMe,

' removed Policies/Explorer/Run & RunOnce/Setup warnings for NT4

'section 12: added AllFilesystemObjects

'section 14: removed Policy hierarchization, added registry

' keys, added GPRCaller and GPReconizer subs

'section 15: due to Policy hierarchization changes, lost detection of

' Active Desktop status

'section 20: added XML parsing for WVa

'section 22: restored "dormant" IE explorer bars to default

' operation, removed "dormant" label

'RtnValue function fixed for REG_BINARY & REG_MULTI_SZ, added REG_QWORD

'StrOutCR function renamed to StrOutSep, 3rd arg is sep character

'all sections: ensured compatibility with Vista RC1

'R50

'section 10: added FileSysPath to script directory even if script file

' not found (due to disconnection from domain)

'section 13: added StringFilter to every occurrence of strOut in

' SOCValue & DDEX subs

'section 26: added WXP httpfilter service

'R51

'renamed "Vista RC1" to "Vista"

'section 19: checked for error on retrieval of startup folders

'added script launch time to report footer

'R52

'protected NDAR/NDTAR from corrupt binary values

'R53

'modified section titles to match top comments section

'updated Configuration Detection Section line numbers

'section 13: added HKCU FileExt loop for WMe/W2K/WXP, modified main loop logic

'section 26: removed UtilMan from W2K default list, added 3 services

' to WVa default list

'added section 27: Accessibility Tools

'modified RtnValue function (DWORD value displays "dword:" instead of "hex:"),

' StringFilter function, SOCValue Sub

'R54

'section 7: added HKLM... Windows NT... Aedebug

'section 27: toggled flagIWarn for report footer

'capitalized HKLM\Software if HKCU\Software unaffected

'R55

'section 4: added 30 shell extensions from Vista Home Premium

'section 7: revised Winlogon name/value logic, added Winlogon\VmApplet

'section 26: removed 1 duplicate Vista service, improved Vista ServiceDll identification

'added functions SOCA/SYCA to manage display of "Software" & "System"

'replaced Chr(34) by DQ

'R56

'section 7: added HKLM\SYSTEM\CurrentControlSet\Control\BootVerificationProgram\ImagePath

' HKLM\SYSTEM\CurrentControlSet\Control\Lsa\Authentication Packages

' HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Execute

' HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\SetupExecute

'section 25: treated "::1" as localhost

'modified RtnValue function (returns "value not set" if registry read

' throws error)

'replaced RegDataChk sub with RegDataChk_v2

'R57

'made testing alert sensitive to flagOut

'changed strOS to Public variable

'section 5: added Explorer\DeviceNotificationCallbacks\ for WVa

'added section 18: HKLM... Explorer\AutoplayHandlers\Handlers\

'section 27: added Network Provisioning Service (xmlprov.dll) to default XP services

'added IsCLSID & CLSIDPop functions

'rewrote SOCA/SYCA functions

'R58

'section 16: added IniFileMapping

'StringFilter function: trap Asc = 160 as corrupt character

'added ChkDefaultValue & ChkNameValues subs

'** Update Revision Number on line #15 **

jgarcia · Setembro 21, 2008

Opa MAcgYvER everyONE,

O log que você postou é o conteúdo do documento Startup Programs (NOME DO USUÁRIO) XX/XX/2008, criado após a execução do Silent Runners? Creio que não. O log do Silent Runners é parecido com o que segue abaixo:

"Silent Runners.vbs", revision 49, 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\Policies\Explorer\Run\

"{904AB22A-0680-1046-1007-031115030037}" = ""C:\Arquivos de programas\Arquivos comuns\{904AB22A-0680-1046-1007-031115030037}\Update.exe" te-110-12-0000073" [file not found]

HKCU\Software\Microsoft\Windows\CurrentVersion\Run\ {++}

"MsnMsgr" = ""C:\Arquivos de programas\MSN Messenger\MsnMsgr.Exe" /background" [MS]

"Free Download Manager" = "C:\Arquivos de programas\Free Download Manager\fdm.exe -autorun" [null data]

"POP Peeper" = ""C:\Arquivos de programas\POP Peeper\POPPeeper.exe" -min" ["Mortal Universe"]

"MSMSGS" = ""C:\Arquivos de programas\Messenger\msmsgs.exe" /background" [MS]

"BitComet" = ""C:\Arquivos de programas\BitComet\BitComet.exe"" ["www.BitComet.com"]

"DVDXGhost" = "(empty string)" [file not found]

"swg" = "C:\Arquivos de programas\Google\GoogleToolbarNotifier\1.0.720.3640\GoogleToolbarNotifier.exe" [file not found]

"Steam" = "C:\Arquivos de programas\Valve\Steam\\Steam.exe -silent" ["Valve Corporation"]

"ctfmon.exe" = "C:\WINDOWS\system32\ctfmon.exe" [MS]

HKLM\Software\Microsoft\Windows\CurrentVersion\Run\ {++}

"NvCplDaemon" = "RUNDLL32.EXE C:\WINDOWS\system32\NvCpl.dll,NvStartup" [MS]

"nwiz" = "nwiz.exe /install" ["NVIDIA Corporation"]

"NvMediaCenter" = "RUNDLL32.EXE C:\WINDOWS\system32\NvMcTray.dll,NvTaskbarInit" [MS]

"avast!" = "C:\ARQUIV~1\ALWILS~1\Avast4\ashDisp.exe" [null data]

"SunJavaUpdateSched" = "C:\Arquivos de programas\Java\jre1.5.0_06\bin\jusched.exe" ["Sun Microsystems, Inc."]

"NeroFilterCheck" = "C:\WINDOWS\system32\NeroCheck.exe" ["Ahead Software Gmbh"]

"PWRISOVM.EXE" = "C:\Arquivos de programas\PowerISO\PWRISOVM.EXE" ["PowerISO Computing, Inc."]

"DAEMON Tools" = ""C:\Arquivos de programas\DAEMON Tools\daemon.exe" -lang 1033" ["DT Soft Ltd."]

"ISUSPM Startup" = ""C:\Arquivos de programas\Arquivos comuns\InstallShield\UpdateService\isuspm.exe" -startup" ["Macrovision Corporation"]

"ISUSScheduler" = ""C:\Arquivos de programas\Arquivos comuns\InstallShield\UpdateService\issch.exe" -start" ["Macrovision Corporation"]

"Atualizador - Puxa Rápido" = "C:\Arquivos de programas\Puxa Rápido\Atualiza.exe" [null data]

"Google Desktop Search" = ""C:\Arquivos de programas\Google\Google Desktop Search\GoogleDesktop.exe" /startup" [null data]

HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\

{06849E9F-C8D7-4D59-B87D-784B7D6BE0B3}\(Default) = (no title provided)

-> {HKLM...CLSID} = "Adobe PDF Reader Link Helper"

\InProcServer32\(Default) = "C:\Arquivos de programas\Adobe\Acrobat 7.0\ActiveX\AcroIEHelper.dll" ["Adobe Systems Incorporated"]

{22BF413B-C6D2-4d91-82A9-A0F997BA588C}\(Default) = "Skype Plugin (mastermind)"

-> {HKLM...CLSID} = "Skype Plugin (mastermind)"

\InProcServer32\(Default) = "C:\ARQUIV~1\Skype\Phone\IEPlugin\SKYPEI~1.DLL" ["Skype Technologies S.A."]

{2F85D76C-0569-466F-A488-493E6BD0E955}\(Default) = (no title provided)

-> {HKLM...CLSID} = "dsWebAllowBHO Class"

\InProcServer32\(Default) = "C:\Arquivos de programas\Windows Desktop Search\dsWebAllow.dll" [MS]

{39F7E362-828A-4B5A-BCAF-5B79BFDFEA60}\(Default) = "BitComet ClickCapture"

-> {HKLM...CLSID} = "BitComet Helper"

\InProcServer32\(Default) = "C:\Arquivos de programas\BitComet\tools\BitCometBHO.dll" ["BitComet"]

{6EF05952-B48D-4944-AA91-57A6A1A48EF8}\(Default) = (no title provided)

-> {HKLM...CLSID} = (no title provided)

\InProcServer32\(Default) = "C:\Arquivos de programas\Puxa Rápido\IEBHO.DLL" [null data]

{761497BB-D6F0-462C-B6EB-D4DAF1D92D43}\(Default) = (no title provided)

-> {HKLM...CLSID} = "SSVHelper Class"

\InProcServer32\(Default) = "C:\Arquivos de programas\Java\jre1.5.0_06\bin\ssv.dll" ["Sun Microsystems, Inc."]

{9030D464-4C02-4ABF-8ECC-5164760863C6}\(Default) = (no title provided)

-> {HKLM...CLSID} = "Windows Live Sign-in Helper"

\InProcServer32\(Default) = "C:\Arquivos de programas\Arquivos comuns\Microsoft Shared\Windows Live\WindowsLiveLogin.dll" [MS]

{BDBD1DAD-C946-4A17-ADC1-64B5B4FF55D0}\(Default) = (no title provided)

-> {HKLM...CLSID} = "Windows Live Toolbar Helper"

\InProcServer32\(Default) = "C:\Arquivos de programas\Windows Live Toolbar\msntb.dll" [MS]

{C41A1C0E-EA6C-11D4-B1B8-444553540000}\(Default) = "G-Buster Browser Defense"

-> {HKLM...CLSID} = "GbIehObj Class"

\InProcServer32\(Default) = "C:\WINDOWS\Downloaded Program Files\gbieh.dll" ["Banco do Brasil"]

HKLM\Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\

"{42071714-76d4-11d1-8b24-00a0c9068ff3}" = "Extensão do 'Painel de controle' para panorâmica de vídeo"

-> {HKLM...CLSID} = "Extensão do 'Painel de controle' para panorâmica de vídeo"

\InProcServer32\(Default) = "deskpan.dll" [file not found]

"{88895560-9AA2-1069-930E-00AA0030EBC8}" = "Extensão de ícone do HyperTerminal"

-> {HKLM...CLSID} = "HyperTerminal Icon Ext"

\InProcServer32\(Default) = "C:\WINDOWS\system32\hticons.dll" ["Hilgraeve, Inc."]

"{A70C977A-BF00-412C-90B7-034C51DA2439}" = "NvCpl DesktopContext Class"

-> {HKLM...CLSID} = "DesktopContext Class"

\InProcServer32\(Default) = "C:\WINDOWS\system32\nvcpl.dll" ["NVIDIA Corporation"]

"{FFB699E0-306A-11d3-8BD1-00104B6F7516}" = "Play on my TV helper"

-> {HKLM...CLSID} = "NVIDIA CPL Extension"

\InProcServer32\(Default) = "C:\WINDOWS\system32\nvcpl.dll" ["NVIDIA Corporation"]

"{1CDB2949-8F65-4355-8456-263E7C208A5D}" = "Desktop Explorer"

-> {HKLM...CLSID} = "Desktop Explorer"

\InProcServer32\(Default) = "C:\WINDOWS\system32\nvshell.dll" ["NVIDIA Corporation"]

"{1E9B04FB-F9E5-4718-997B-B8DA88302A47}" = "Desktop Explorer Menu"

-> {HKLM...CLSID} = (no title provided)

\InProcServer32\(Default) = "C:\WINDOWS\system32\nvshell.dll" ["NVIDIA Corporation"]

"{1E9B04FB-F9E5-4718-997B-B8DA88302A48}" = "nView Desktop Context Menu"

-> {HKLM...CLSID} = "nView Desktop Context Menu"

\InProcServer32\(Default) = "C:\WINDOWS\system32\nvshell.dll" ["NVIDIA Corporation"]

"{B41DB860-8EE4-11D2-9906-E49FADC173CA}" = "WinRAR shell extension"

-> {HKLM...CLSID} = "WinRAR"

\InProcServer32\(Default) = "C:\Arquivos de programas\WinRAR\rarext.dll" [null data]

"{FC9FB64A-1EB2-4CCF-AF5E-1A497A9B5C2D}" = "Messenger Sharing Folders"

-> {HKLM...CLSID} = "Minhas Pastas de Compartilhamento"

\InProcServer32\(Default) = "C:\Arquivos de programas\MSN Messenger\fsshext.8.0.0812.00.dll" [MS]

"{472083B0-C522-11CF-8763-00608CC02F24}" = "avast"

-> {HKLM...CLSID} = "avast"

\InProcServer32\(Default) = "C:\Arquivos de programas\Alwil Software\Avast4\ashShell.dll" ["ALWIL Software"]

"{E37CB5F0-51F5-4395-A808-5FA49E399F83}" = "GbPlugin ShlObj"

-> {HKLM...CLSID} = "GbPluginObj Class"

\InProcServer32\(Default) = "C:\WINDOWS\Downloaded Program Files\gbieh.dll" ["Banco do Brasil"]

"{00020D75-0000-0000-C000-000000000046}" = "Microsoft Office Outlook Desktop Icon Handler"

-> {HKLM...CLSID} = "Microsoft Office Outlook"

\InProcServer32\(Default) = "C:\ARQUIV~1\MICROS~2\OFFICE11\MLSHEXT.DLL" [MS]

"{0006F045-0000-0000-C000-000000000046}" = "Microsoft Office Outlook Custom Icon Handler"

-> {HKLM...CLSID} = "Extensão de ícone de arquivo do Outlook"

\InProcServer32\(Default) = "C:\ARQUIV~1\MICROS~2\OFFICE11\OLKFSTUB.DLL" [MS]

"{42042206-2D85-11D3-8CFF-005004838597}" = "Microsoft Office HTML Icon Handler"

-> {HKLM...CLSID} = (no title provided)

\InProcServer32\(Default) = "C:\Arquivos de programas\Microsoft Office\OFFICE11\msohev.dll" [MS]

"{967B2D40-8B7D-4127-9049-61EA0C2C6DCE}" = "PowerISO"

-> {HKLM...CLSID} = "PowerISO"

\InProcServer32\(Default) = "C:\Arquivos de programas\PowerISO\PWRISOSH.DLL" ["PowerISO Computing, Inc."]

"{cc86590a-b60a-48e6-996b-41d25ed39a1e}" = "Portable Media Devices Menu"

-> {HKLM...CLSID} = "Portable Media Devices Menu"

\InProcServer32\(Default) = "C:\WINDOWS\system32\Audiodev.dll" [MS]

"{569DAC0F-2791-46ab-8EFC-A54B77C04C20}" = "Execute Hooker"

-> {HKLM...CLSID} = "ExecuteHooker Class"

\InProcServer32\(Default) = "C:\Arquivos de programas\DVD X Studios\DVD X Utilities 2.1\DVDGhost\ExecuteHooker.dll" ["WWW.Region-Free-DVD.COM"]

"{97090E2F-3062-4459-855B-014F0D3CDBB1}" = "Windows Deskbar"

-> {HKCU...CLSID} = "Deskbar do Windows"

\InProcServer32\(Default) = "C:\Arquivos de programas\Windows Desktop Search\deskbar.dll" [MS]

"{13E7F612-F261-4391-BEA2-39DF4F3FA311}" = "Windows Desktop Search"

-> {HKLM...CLSID} = "Windows Desktop Search"

\InProcServer32\(Default) = "C:\Arquivos de programas\Windows Desktop Search\msnlExt.dll" [MS]

"{D426CFD0-87FC-4906-98D9-A23F5D515D61}" = "Windows Desktop Search Outlook Express ISearchFolder Class"

-> {HKLM...CLSID} = "Windows Desktop Search Outlook Express SearchProtocol Class"

\InProcServer32\(Default) = "C:\Arquivos de programas\Windows Desktop Search\OEPH.dll" [MS]

"{EFA24E62-B078-11d0-89E4-00C04FC9E26E}" = "History Band"

-> {HKLM...CLSID} = "History Band"

\InProcServer32\(Default) = "C:\WINDOWS\system32\shdocvw.dll" [MS]

HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\ShellExecuteHooks\

<<!>> "{57B86673-276A-48B2-BAE7-C6DBB3020EB8}" = "ewido anti-spyware 4.0"

-> {HKLM...CLSID} = "CShellExecuteHookImpl Object"

\InProcServer32\(Default) = "C:\Arquivos de programas\ewido anti-spyware 4.0\shellexecutehook.dll" ["Anti-Malware Development a.s."]

<<!>> "{E37CB5F0-51F5-4395-A808-5FA49E399F83}" = "GbPlugin ShlObj"

-> {HKLM...CLSID} = "GbPluginObj Class"

\InProcServer32\(Default) = "C:\WINDOWS\Downloaded Program Files\gbieh.dll" ["Banco do Brasil"]

<<!>> "{569DAC0F-2791-46ab-8EFC-A54B77C04C20}" = "Execute Hooker"

-> {HKLM...CLSID} = "ExecuteHooker Class"

\InProcServer32\(Default) = "C:\Arquivos de programas\DVD X Studios\DVD X Utilities 2.1\DVDGhost\ExecuteHooker.dll" ["WWW.Region-Free-DVD.COM"]

<<!>> "{56F9679E-7826-4C84-81F3-532071A8BCC5}" = (no title provided)

-> {HKLM...CLSID} = "Windows Desktop Search Namespace Manager"

\InProcServer32\(Default) = "C:\Arquivos de programas\Windows Desktop Search\MSNLNamespaceMgr.dll" [MS]

HKLM\Software\Microsoft\Windows NT\CurrentVersion\Windows\

<<!>> "AppInit_DLLs" = "C:\ARQUIV~1\Google\GOOGLE~2\GOEC62~1.DLL" [null data]

HKLM\Software\Classes\PROTOCOLS\Filter\

<<!>> text/xml\CLSID = "{807553E5-5146-11D5-A672-00B0D022E945}"

-> {HKLM...CLSID} = (no title provided)

\InProcServer32\(Default) = "C:\Arquivos de programas\Arquivos comuns\Microsoft Shared\OFFICE11\MSOXMLMF.DLL" [MS]

HKLM\Software\Classes\Folder\shellex\ColumnHandlers\

{F9DB5320-233E-11D1-9F84-707F02C10627}\(Default) = "PDF Column Info"

-> {HKLM...CLSID} = "PDF Shell Extension"

\InProcServer32\(Default) = "C:\Arquivos de programas\Adobe\Acrobat 7.0\ActiveX\PDFShell.dll" ["Adobe Systems, Inc."]

HKLM\Software\Classes\*\shellex\ContextMenuHandlers\

avast\(Default) = "{472083B0-C522-11CF-8763-00608CC02F24}"

-> {HKLM...CLSID} = "avast"

\InProcServer32\(Default) = "C:\Arquivos de programas\Alwil Software\Avast4\ashShell.dll" ["ALWIL Software"]

ewido anti-spyware\(Default) = "{8934FCEF-F5B8-468f-951F-78A921CD3920}"

-> {HKLM...CLSID} = "CContextScan Object"

\InProcServer32\(Default) = "C:\Arquivos de programas\ewido anti-spyware 4.0\context.dll" ["Anti-Malware Development a.s."]

HVCVTMFile\(Default) = "{362BA661-F1A0-11d6-A9D6-009027992B41}"

-> {HKLM...CLSID} = "Hero Video Convert Shell Extension"

\InProcServer32\(Default) = "C:\Herosoft\Hero Video Convert\VCvtShell.dll" [null data]

PowerISO\(Default) = "{967B2D40-8B7D-4127-9049-61EA0C2C6DCE}"

-> {HKLM...CLSID} = "PowerISO"

\InProcServer32\(Default) = "C:\Arquivos de programas\PowerISO\PWRISOSH.DLL" ["PowerISO Computing, Inc."]

WinRAR\(Default) = "{B41DB860-8EE4-11D2-9906-E49FADC173CA}"

-> {HKLM...CLSID} = "WinRAR"

\InProcServer32\(Default) = "C:\Arquivos de programas\WinRAR\rarext.dll" [null data]

HKLM\Software\Classes\Directory\shellex\ContextMenuHandlers\

ewido anti-spyware\(Default) = "{8934FCEF-F5B8-468f-951F-78A921CD3920}"

-> {HKLM...CLSID} = "CContextScan Object"

\InProcServer32\(Default) = "C:\Arquivos de programas\ewido anti-spyware 4.0\context.dll" ["Anti-Malware Development a.s."]

PowerISO\(Default) = "{967B2D40-8B7D-4127-9049-61EA0C2C6DCE}"

-> {HKLM...CLSID} = "PowerISO"

\InProcServer32\(Default) = "C:\Arquivos de programas\PowerISO\PWRISOSH.DLL" ["PowerISO Computing, Inc."]

WinRAR\(Default) = "{B41DB860-8EE4-11D2-9906-E49FADC173CA}"

-> {HKLM...CLSID} = "WinRAR"

\InProcServer32\(Default) = "C:\Arquivos de programas\WinRAR\rarext.dll" [null data]

HKLM\Software\Classes\Folder\shellex\ContextMenuHandlers\

avast\(Default) = "{472083B0-C522-11CF-8763-00608CC02F24}"

-> {HKLM...CLSID} = "avast"

\InProcServer32\(Default) = "C:\Arquivos de programas\Alwil Software\Avast4\ashShell.dll" ["ALWIL Software"]

FineReader8\(Default) = "{F7091C74-EBB1-49D7-94C7-FE4886CCC18D}"

-> {HKLM...CLSID} = "FineReader8ExplorerContextMenuHandler"

\InProcServer32\(Default) = "C:\Arquivos de programas\ABBYY FineReader 8.0 Professional Edition\FECMenu.dll" ["ABBYY Software"]

PowerISO\(Default) = "{967B2D40-8B7D-4127-9049-61EA0C2C6DCE}"

-> {HKLM...CLSID} = "PowerISO"

\InProcServer32\(Default) = "C:\Arquivos de programas\PowerISO\PWRISOSH.DLL" ["PowerISO Computing, Inc."]

WinRAR\(Default) = "{B41DB860-8EE4-11D2-9906-E49FADC173CA}"

-> {HKLM...CLSID} = "WinRAR"

\InProcServer32\(Default) = "C:\Arquivos de programas\WinRAR\rarext.dll" [null data]

Default executables:

--------------------

HKCU\Software\Classes\.bat\(Default) = (value not set)

HKCU\Software\Classes\.cmd\(Default) = (value not set)

HKCU\Software\Classes\.com\(Default) = (value not set)

HKCU\Software\Classes\.exe\(Default) = (value not set)

HKCU\Software\Classes\.hta\(Default) = "htafile"

Group Policies {GPedit.msc branch and setting}:

-----------------------------------------------

Note: detected settings may not have any effect.

HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\

"DisableRegistryTools" = (REG_DWORD) hex:0x00000000

{User Configuration|Administrative Templates|System|

Prevent access to registry editing tools}

HKLM\Software\Microsoft\Windows\CurrentVersion\Policies\System\

"shutdownwithoutlogon" = (REG_DWORD) hex:0x00000001

{Computer Configuration|Windows Settings|Security Settings|Local Policies|Security Options|

Shutdown: Allow system to be shut down without having to log on}

"undockwithoutlogon" = (REG_DWORD) hex:0x00000001

{Computer Configuration|Windows Settings|Security Settings|Local Policies|Security Options|

Devices: Allow undock without having to log on}

Active Desktop and Wallpaper:

-----------------------------

Active Desktop may be disabled at this entry:

HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\ShellState

Displayed if Active Desktop enabled and wallpaper not set by Group Policy:

HKCU\Software\Microsoft\Internet Explorer\Desktop\General\

"Wallpaper" = "C:\WINDOWS\system32\config\systemprofile\Configurações locais\Dados de aplicativos\Microsoft\Wallpaper1.bmp"

Displayed if Active Desktop disabled and wallpaper not set by Group Policy:

HKCU\Control Panel\Desktop\

"Wallpaper" = "C:\Documents and Settings\RICARDO\Configurações locais\Dados de aplicativos\Microsoft\Wallpaper1.bmp"

Enabled Screen Saver:

---------------------

HKCU\Control Panel\Desktop\

"SCRNSAVE.EXE" = "C:\WINDOWS\system32\logon.scr" [MS]

Startup items in "RICARDO" & "All Users" startup folders:

---------------------------------------------------------

C:\Documents and Settings\RICARDO\Menu Iniciar\Programas\Inicializar

"Adobe Gamma" -> shortcut to: "C:\Arquivos de programas\Arquivos comuns\Adobe\Calibration\Adobe Gamma Loader.exe" ["Adobe Systems, Inc."]

"HotSync Manager" -> shortcut to: "C:\Arquivos de programas\Palm\HOTSYNC.EXE" ["Palm, Inc."]

C:\Documents and Settings\All Users\Menu Iniciar\Programas\Inicializar

"Adobe Reader Speed Launch" -> shortcut to: "C:\Arquivos de programas\Adobe\Acrobat 7.0\Reader\reader_sl.exe" ["Adobe Systems Incorporated"]

"DataViz Inc Messenger" -> shortcut to: "C:\Arquivos de programas\Arquivos comuns\DataViz\DvzIncMsgr.exe" ["DataViz, Inc."]

"InterVideo WinCinema Manager" -> shortcut to: "C:\Arquivos de programas\InterVideo\Common\Bin\WinCinemaMgr.exe" ["InterVideo Inc."]

"Microsoft Office" -> shortcut to: "C:\Arquivos de programas\Microsoft Office\Office10\OSA.EXE -b -l" [MS]

"Windows Desktop Search" -> shortcut to: "C:\Arquivos de programas\Windows Desktop Search\WindowsSearch.exe /startup" [MS]

"WinKey" -> shortcut to: "C:\Arquivos de programas\WinKey\WinKey.exe" [null data]

Enabled Scheduled Tasks:

------------------------

"Check Updates for Windows Live Toolbar" -> launches: "C:\Arquivos de programas\Windows Live Toolbar\MSNTBUP.EXE" [MS]

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 - 11

%SystemRoot%\system32\rsvpsp.dll [MS], 04 - 05

Toolbars, Explorer Bars, Extensions:

------------------------------------

Toolbars

HKCU\Software\Microsoft\Internet Explorer\Toolbar\ShellBrowser\

"{BDAD1DAD-C946-4A17-ADC1-64B5B4FF55D0}"

-> {HKLM...CLSID} = "Windows Live Toolbar"

\InProcServer32\(Default) = "C:\Arquivos de programas\Windows Live Toolbar\msntb.dll" [MS]

HKCU\Software\Microsoft\Internet Explorer\Toolbar\WebBrowser\

"{BDAD1DAD-C946-4A17-ADC1-64B5B4FF55D0}"

-> {HKLM...CLSID} = "Windows Live Toolbar"

\InProcServer32\(Default) = "C:\Arquivos de programas\Windows Live Toolbar\msntb.dll" [MS]

"{4064EA35-578D-4073-A834-C96D82CBCF40}"

-> {HKLM...CLSID} = "&Save Flash"

\InProcServer32\(Default) = "C:\Arquivos de programas\Save Flash\SaveFlash.dll" ["TODO: <Company name>"]

HKLM\Software\Microsoft\Internet Explorer\Toolbar\

"{BDAD1DAD-C946-4A17-ADC1-64B5B4FF55D0}" = (no title provided)

-> {HKLM...CLSID} = "Windows Live Toolbar"

\InProcServer32\(Default) = "C:\Arquivos de programas\Windows Live Toolbar\msntb.dll" [MS]

"{4064EA35-578D-4073-A834-C96D82CBCF40}" = (no title provided)

-> {HKLM...CLSID} = "&Save Flash"

\InProcServer32\(Default) = "C:\Arquivos de programas\Save Flash\SaveFlash.dll" ["TODO: <Company name>"]

Explorer Bars

HKLM\Software\Microsoft\Internet Explorer\Explorer Bars\

HKLM\Software\Classes\CLSID\{FF059E31-CC5A-4E2E-BF3B-96E929D65503}\(Default) = "&Pesquisar"

Implemented Categories\{00021493-0000-0000-C000-000000000046}\ [vertical bar]

InProcServer32\(Default) = "C:\ARQUIV~1\MICROS~2\OFFICE11\REFIEBAR.DLL" [MS]

Extensions (Tools menu items, main toolbar menu buttons)

HKLM\Software\Microsoft\Internet Explorer\Extensions\

{08B0E5C0-4FCB-11CF-AAA5-00401C608501}\

"MenuText" = "Sun Java Console"

"CLSIDExtension" = "{CAFEEFAC-0015-0000-0006-ABCDEFFEDCBC}"

-> {HKCU...CLSID} = "Java Plug-in"

\InProcServer32\(Default) = "C:\Arquivos de programas\Java\jre1.5.0_06\bin\ssv.dll" ["Sun Microsystems, Inc."]

-> {HKLM...CLSID} = "Java Plug-in 1.5.0_06"

\InProcServer32\(Default) = "C:\Arquivos de programas\Java\jre1.5.0_06\bin\npjpi150_06.dll" ["Sun Microsystems, Inc."]

{09EA1F80-F40A-11D1-B792-444553540001}\

"ButtonText" = "Flash Saver"

"MenuText" = "Flash Saver"

"Script" = "C:\ARQUIV~1\FLASHS~1.0\save.htm" [null data]

{77BF5300-1474-4EC7-9980-D32B190E9B07}\

"ButtonText" = "Skype Plugin"

"CLSIDExtension" = "{77BF5300-1474-4EC7-9980-D32B190E9B07}"

-> {HKLM...CLSID} = "Skype Plugin (button)"

\InProcServer32\(Default) = "C:\ARQUIV~1\Skype\Phone\IEPlugin\SKYPEI~1.DLL" ["Skype Technologies S.A."]

{86301D40-94C1-4A5E-843B-7F43965E364A}\

"ButtonText" = "FlashKeeper"

"Script" = "C:\Arquivos de programas\FlashKeeper\GetFlash.htm" [null data]

{92780B25-18CC-41C8-B9BE-3C9C571A8263}\

"ButtonText" = "Pesquisar"

{E2E2DD38-D088-4134-82B7-F2BA38496583}\

"MenuText" = "@xpsp3res.dll,-20001"

"Exec" = "%windir%\Network Diagnostic\xpnetdiag.exe" [MS]

{FB5F1910-F110-11D2-BB9E-00C04F795683}\

"ButtonText" = "Messenger"

"MenuText" = "Windows Messenger"

"Exec" = "C:\Arquivos de programas\Messenger\msmsgs.exe" [MS]

Running Services (Display Name, Service Name, Path {Service DLL}):

------------------------------------------------------------------

Apache2Triad Apache2 Service, Apache2, ""D:\apache2triad2\bin\httpd.exe" -n Apache2 -k runservice" ["Apache Software Foundation"]

Apache2Triad MySql Service, MySql, "D:\apache2triad2\mysql\bin\mysqld.exe" [null data]

Apache2Triad Xmail Service, XMail, "D:\apache2triad2\mail\bin\XMail.exe" [null data]

avast! Antivirus, avast! Antivirus, ""C:\Arquivos de programas\Alwil Software\Avast4\ashServ.exe"" [null data]

avast! iAVS4 Control Service, aswUpdSv, ""C:\Arquivos de programas\Alwil Software\Avast4\aswUpdSv.exe"" [null data]

avast! Mail Scanner, avast! Mail Scanner, ""C:\Arquivos de programas\Alwil Software\Avast4\ashMaiSv.exe" /service" ["ALWIL Software"]

avast! Web Scanner, avast! Web Scanner, ""C:\Arquivos de programas\Alwil Software\Avast4\ashWebSv.exe" /service" ["ALWIL Software"]

ewido anti-spyware 4.0 guard, ewido anti-spyware 4.0 guard, "C:\Arquivos de programas\ewido anti-spyware 4.0\guard.exe" ["Anti-Malware Development a.s."]

Machine Debug Manager, MDM, ""C:\Arquivos de programas\Arquivos comuns\Microsoft Shared\VS7DEBUG\MDM.EXE"" [MS]

NVIDIA Display Driver Service, NVSvc, "C:\WINDOWS\system32\nvsvc32.exe" ["NVIDIA Corporation"]

Serviço Messenger Sharing USN Journal Reader, usnsvc, "C:\WINDOWS\system32\svchost.exe -k usnsvc" {"C:\Arquivos de programas\MSN Messenger\usnsvc.dll" [MS]}

Ulead Burning Helper, UleadBurningHelper, "C:\Arquivos de programas\Arquivos comuns\Ulead Systems\DVD\ULCDRSvr.exe" ["Ulead Systems, Inc."]

Windows User Mode Driver Framework, UMWdf, "C:\WINDOWS\system32\wdfmgr.exe" [MS]

Print Monitors:

---------------

HKLM\System\CurrentControlSet\Control\Print\Monitors\

hpzsnt10\Driver = "hpzsnt10.dll" ["HP"]

Microsoft Document Imaging Writer Monitor\Driver = "mdimon.dll" [MS]

VeryPDF\Driver = "_pdfxp.dll" [null data]

----------

<<!>>: Suspicious data at a malware launch point.

+ 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.

+ To search all directories of local fixed drives for DESKTOP.INI

DLL launch points, use the -supp parameter or answer "No" at the

first message box and "Yes" at the second message box.

---------- (total run time: 64 seconds, including 9 seconds for message boxes)

Preciso que você poste um log análogo a este.

Abraços.

MAcgYvER everyONE · Setembro 23, 2008

Eu abro o silent runners e aparece o log q eu enviei pra você mais n sei como conseguir o log esse q você quer

jgarcia · Outubro 3, 2008

Eu abro o silent runners e aparece o log q eu enviei pra você mais n sei como conseguir o log esse q você quer

Não sei mais o que fazer, pois testei o link e consegui executar o Silent com sucesso. Como você o está executando?

Mário Monteiro · Novembro 3, 2008

Tópico Arquivado

Como o autor não respondeu por mais de 30 dias, o tópico foi arquivado.

Caso você seja o autor do tópico e quer reabrir, envie uma mensagem privada para um moderador da área juntamente com o link para este tópico e explique o motivo da reabertura.

Entrar

Arquivado

[Arquivado] explorer fechando e abrindo @ Analisem meu log

Recommended Posts

MAcgYvER everyONE 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

MAcgYvER everyONE 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

jgarcia 1

Compartilhar este post

Link para o post

Compartilhar em outros sites

MAcgYvER everyONE 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

jgarcia 1

Compartilhar este post

Link para o post

Compartilhar em outros sites

Mário Monteiro 179

Compartilhar este post

Link para o post

Compartilhar em outros sites

Fazer busca no Banco de dados usando vários critério

agregar dados em VBA excel

Sistema não funciona corretamente

Este projeto é apoiado pelas empresas

Fóruns

Tempo Real

Informação importante