[原创]网站程序安全分析器 VB源码
软件作者：暗夜盛装(零号)信息来源：邪恶八进制信息安全团队（[url]www.eviloctal.com[/url]）
本程序通杀:
ASP ASPX PHP CGI JSP VBS 等脚本WebShell
并能查出99%加密过的脚本WebShell
后来发现..精度越高误杀越高...基本做到宁误扫三千不放过1马~
其实是利用串判断.原理很简单.有很多人向偶要代码.想到人家ScanWebshell都贡献出来了~偶要是不贡献出来就不厚道咯.以下是全部代码.
------------------------------------------------------------------------------------------
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Dim SuJu1 As Long
Dim Faxian As String
Dim FaJs As String
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pIdl As Long, ByVal pszPath As String) As Long
Private Type BrowseInfo
hwndOwner As Long
piDLroot As Long
pszdisplayName As String
lpsztitle As String
ulFlags As Long
lpfncallback As Long
lParam As Long
iImage As Long
End Type
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub
Private Sub Form_Initialize()
InitCommonControls
Dim rtn As Long
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, &HFF00FF, 0, LWA_COLORKEY
End Sub
Sub YS()
Dim Savetime As Double
Savetime = timeGetTime
While timeGetTime < Savetime + 200
DoEvents
Wend
End Sub
Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.Image1.Visible = False
Me.Image2.Visible = True
YS
WindowState = 1
Me.Image1.Visible = True
Me.Image2.Visible = False
End Sub
Private Sub Image4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.Image4.Visible = False
Me.Image3.Visible = True
YS
End
End Sub
Private Sub Command1_Click()
Dim bi As BrowseInfo
Dim folderid As Long
Dim pb As String
With bi
.hwndOwner = Me.hwnd
.lpsztitle = "选择查杀的文件夹:"
.ulFlags = 3
End With
folderid = SHBrowseForFolder(bi)
If folderid = 0 Then Exit Sub
pb = String$(260, 0)
SHGetPathFromIDList folderid, pb
pb = Left$(pb, InStr(pb, vbNullChar) - 1)
Text1.Text = pb
End Sub
Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function
Function FindFilesAPI(path As String, SearchStr As String)
Dim FileName As String
Dim DirName As String
Dim dirNames() As String
Dim nDir As Integer
Dim i As Integer
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
If Right(path, 1) <> "\" Then path = path & "\"
nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(path & "*.*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
DirName = StripNulls(WFD.cFileName)
If (DirName <> ".") And (DirName <> "..") Then
If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
dirNames(nDir) = DirName
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
End If
End If
Cont = FindNextFile(hSearch, WFD)
DoEvents
Loop
Cont = FindClose(hSearch)
End If
hSearch = FindFirstFile(path & SearchStr, WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
While Cont
FileName = StripNulls(WFD.cFileName)
If (FileName <> ".") And (FileName <> "..") Then
SuJu1 = SuJu1 + 1
Dim strFileContent As String
Dim strTemp As String
If Dir(path & FileName) <> "" Then
Open path & FileName For Input As #1
While Not EOF(1)
Line Input #1, strTemp
If InStr(1, strTemp, "WScr" & DoMyBest & "ipt.Shell", vbTextCompare) Or InStr(1, strTemp, "clsid:72C24DD5-D70A" & DoMyBest & "-438B-8A42-98424B88AFB8", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 包含危险组件! " & " 安全评估: 危险度极高!"
List1.AddItem "描述:一般被ASP木马利用来获取CMD SHELL 序列:1"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "She" & DoMyBest & "ll.Application", vbTextCompare) Or InStr(1, strTemp, "clsid:13709620-C27" & DoMyBest & "9-11CE-A49E-444553540000", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 包含危险组件! " & " 安全评估: 危险度极高!"
List1.AddItem "描述:一般被ASP木马利用来获取系统信息 序列:2"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "<%@ LANGUAGE = VBScript.Encode %>", vbTextCompare) Or InStr(1, strTemp, "#@", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 文件被加密! " & " 安全评估: 危险度极高!"
List1.AddItem "描述:此文件被加过密!一般安全的程序是不可能加密的!极有可能是木马.图片格式文件可能会误杀请详细检查 序列:3"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "clsid:F935DC22-1CF0-11D0-ADB9-00C04FD58A0B", vbTextCompare) Or InStr(1, strTemp, "clsid:0D43FE01-F093-11CF-8940-00A0C9054228", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 包含危险组件! " & " 安全评估: 危险度高!"
List1.AddItem "描述:此文件包含文件读写指令.如非上传组件.请删除! 序列:4"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "上传组件", vbTextCompare) Or InStr(1, strTemp, "Upload", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 包含危险特征! " & " 安全评估: 危险度中!(未知)"
List1.AddItem "描述:此文件包含上传组件或上传文件的专用串.请检查是否合法. 序列:5"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "FSO", vbTextCompare) Or InStr(1, strTemp, "<SCRIPT RUNAT=SERVER LANGUAGE=JAVASCRIPT>", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 包含危险特征! " & " 安全评估: 危险度高!(未知)"
List1.AddItem "描述:此文件包含木马执行特征.请检查是否合法. 序列:6"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "execute request", vbTextCompare) Or InStr(1, strTemp, "FQAAAA", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 包含危险特征! " & " 安全评估: 危险度极高!"
List1.AddItem "描述:此文件包含一句话木马.请手工分析删除! 序列:7"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "java.io", vbTextCompare) Or InStr(1, strTemp, "java.util", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 包含危险组件! " & " 安全评估: 危险度极高!"
List1.AddItem "描述:此文件包含JSP木马.请删除! 序列:8"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "System.IO", vbTextCompare) Or InStr(1, strTemp, "System.Diagnostics", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 包含危险组件! " & " 安全评估: 危险度极高!"
List1.AddItem "描述:此文件包含ASP.NET木马.请删除! 序列:9"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "TBNnGMfflrqBF", vbTextCompare) Or InStr(1, strTemp, "POST[cmd]", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 包含危险组件! " & " 安全评估: 危险度高!"
List1.AddItem "描述:此文件包含PHP木马.请删除! 序列:10"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "务服", vbTextCompare) Or InStr(1, strTemp, "琳", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 文件被加密! " & " 安全评估: 危险度极高!"
List1.AddItem "描述:此文件有可能被加过密!一般安全的程序是不可能加密的!极有可能是木马 序列:11"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "System.Net.Sockets", vbTextCompare) Or InStr(1, strTemp, "UnEncode=temp", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 包含危险特征! " & " 安全评估: 危险度极高!"
List1.AddItem "描述:此文件包含木马执行特征.请检查是否合法 序列:12"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "execute request(", vbTextCompare) Or InStr(1, strTemp, "vbs&", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 文件被加密! " & " 安全评估: 危险度极高!"
List1.AddItem "描述:此文件有可能被加过密!一般安全的程序是不可能加密的!极有可能是木马 序列:13"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "MSXML2.XMLHTTP", vbTextCompare) Or InStr(1, strTemp, "127.0.0.1", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 包含危险组件! " & " 安全评估: 危险度高!"
List1.AddItem "描述:此文件包含木马执行特征.请检查是否合法 序列:14"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "Encoding.ASCII", vbTextCompare) Or InStr(1, strTemp, "cmd", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 包含危险特征! " & " 安全评估: 危险度高!"
List1.AddItem "描述:此文件包含木马转码特征或CMD关键字.请检查是否合法 序列:15"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "GetSpecialFolder", vbTextCompare) Or InStr(1, strTemp, "Socket", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 包含危险特征! " & " 安全评估: 危险度高!"
List1.AddItem "描述:此文件包含木马执行特征.请检查是否合法 序列:16"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "gif""" & "--", vbTextCompare) Or InStr(1, strTemp, "jpg""" & "--", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 包含危险特征! " & " 安全评估: 危险度极高!"
List1.AddItem "描述:此文件引用了图片极有可能是图片木马 序列:17"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "bmp""" & "--", vbTextCompare) Or InStr(1, strTemp, "png""" & "--", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 包含危险特征! " & " 安全评估: 危险度极高!"
List1.AddItem "描述:此文件引用了图片极有可能是图片木马 序列:18"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "<?require(", vbTextCompare) Or InStr(1, strTemp, "require($", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 包含危险特征! " & " 安全评估: 危险度高!(未知)"
List1.AddItem "描述:此文件包涵了PHP的特殊引用如发现类似<?require($AAA);?>引用请检查是否合法 序列:19"
Faxian = "发现危险"
End If
If InStr(1, strTemp, "4e454c33322", vbTextCompare) Or InStr(1, strTemp, """\x", vbTextCompare) Then
List1.AddItem "发现 " & FileName & " 包含危险特征! " & " 安全评估: 危险度高!(未知)"
List1.AddItem "描述:此文件极有可能是提权PHP木马或加过密的文件 序列:20"
Faxian = "发现危险"
End If
Wend
If SuJu1 > 100 Then
Text5.Text = ""
End If
If Faxian = "发现危险" Then
List1.AddItem "发现存在危险的文件是: "
List1.AddItem ""
List1.AddItem path & FileName
List1.AddItem "-----------------------------------------------------------------------------------------------"
Faxian = ""
FaJs = FaJs + 1
Me.Label2.Caption = "发现有隐患的文件有:" & FaJs & "个"
Else
Faxian = ""
End If
Close #1
End If
GC1 = Text5.Text & "正在检测文件..." & Chr(13) & Chr(10) & path & FileName & Chr(13) & Chr(10)
Text5.Text = GC1
End If
If Me.Command3.Enabled = True Then
Exit Function
End If
Cont = FindNextFile(hSearch, WFD)
DoEvents
Me.Label3.Caption = "扫描进程: " & "已经扫描文件:" & SuJu1 & "个"
Wend
Cont = FindClose(hSearch)
End If
If nDir > 0 Then
For i = 0 To nDir - 1
FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", SearchStr)
Next i
End If
End Function
Private Sub Command3_Click()
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
If Text1.Text = "" Then
MsgBox "请输入正确扫描路径"
Exit Sub
End If
Me.Command3.Enabled = False
Me.Command7.Enabled = True
List1.Clear
FaJs = 0
SuJu1 = 0
Me.Text5 = ""
Screen.MousePointer = vbHourglass
List1.Clear
LUjin = Text1.Text & "\"
SearchPath = LUjin
FindStr = "*.*"
FindFilesAPI SearchPath, FindStr
Screen.MousePointer = vbDefault
If Screen.MousePointer = vbDefault Then
MsgBox "扫描完成!自动导出扫描结果."
CxLog
FaJs = "0"
Me.Command3.Enabled = True
Me.Command7.Enabled = False
End If
End Sub
Sub CxLog()
On Error Resume Next
Open App.path & "\LOG\" & Date & "查杀结果.log" For Output As #1
Print #1, "[url]Www.ChinNetHack.Com[/url] - 网站程序安全分析器 零号服务器专用"
Print #1, "发现对服务器具有安全隐患的文件有" & FaJs & "个. 具体结果如下:" & Chr(13) & Chr(10)
For i = 0 To List1.ListCount
Print #1, List1.List(i)
Next
Close #1
Shell "NOTEPAD.EXE " & App.path & "\LOG\" & Date & "查杀结果.log", vbMaximizedFocus
End Sub
Private Sub Command7_Click()
Me.Command3.Enabled = True
Me.Command7.Enabled = False
Screen.MousePointer = vbDefault
End Sub
Private Sub Text5_Change()
Text5.SelStart = Len(Text5.Text)
End Sub 1.建议自动解码asp加密
2.增强可扩充性
3.如能附上界面代码更佳。
谢谢 1.代码加密其实也能找到固定的串值的.
2.代码都给出来了5555....扩充性够强了吧?
3.其实界面代码都包涵在里面了....所以才用调用那么多API...连按钮延时都提供出来了...和原来的程序一样一字不漏. 恩 我把SSK加上“自动解码asp加密” 呵呵 原来楼主就是零号,呵呵.在火狐看到你发的帖子了,呵呵.没想到你把源码公开了.
我有点小的建议,楼主和大家看看合不合适:
将那些查杀的关键字还有判断结果一类的数据整理后放入数据库.也好做以后的升级和自定义.
那个...看起来这个好象不是2.0? 我看了你的代码，还行看来我VB没白学，基本上都看懂了。不过我要说的是这段代码是抄老外的吧。嘿
Function FindFilesAPI(path As String, SearchStr As String)
Dim FileName As String
Dim DirName As String
Dim dirNames() As String
Dim nDir As Integer
Dim i As Integer
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
If Right(path, 1) <> "\" Then path = path & "\"
nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(path & "*.*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
DirName = StripNulls(WFD.cFileName)
If (DirName <> ".") And (DirName <> "..") Then
If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
dirNames(nDir) = DirName
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
End If
End If
Cont = FindNextFile(hSearch, WFD)
DoEvents
Loop [quote][b]引用第5楼[i]75240[/i]于[i]2006-12-10 12:30[/i]发表的[/b]:
我看了你的代码，还行看来我VB没白学，基本上都看懂了。不过我要说的是这段代码是抄老外的吧。嘿
Function FindFilesAPI(path As String, SearchStr As String)
Dim FileName As String
Dim DirName As String
Dim dirNames() As String
.......[/quote]
当函数变的通用时,就无所谓抄不抄了.为什么非得每一句都自己写呢?
成大事者不拘小节~ 既然是抄的那又怎能算原创呢。顺便问一下定义的这个含数是什么作用啊
Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function
百思不得其解 看看WIN32_FIND_DATA的结构定义就知道了，这个结构重的cFileName成员是“A null-terminated string that is the name of the file. ”，也就是说以0结尾的字符串，C/C++、delphi都可以直接处理，或许VB需要去掉这个0才可以吧（不懂VB，不敢肯定），这个函数就是干这个的，把0（ Chr(0)，好像vbNullChar也是一样的吧）前面的（也就是左面的Left(...)）的字符取出来。
其实呢，如果只是字符串的查找的话，DOS命令一句话就可以，抛砖引玉，如下：
for /r x:\htmlfiles %a in (*.*) do @findstr /i /m /G:"x:\Htmlid.txt" "%a"
x:\htmlfiles为要扫描的路径
x:\Htmlid.txt为扫描特征字典（从暗夜的代码里抽取出来就可以了）
当然，如果做成批处理，完全可以达到类似这个VB程序的效果。另外，VBS,JS更是没问题。 No.1 [原创]scan.vbs
一个扫描ASP木马的脚本，本地命令行下使用，速度比ASP的快：）
#用法: CScript scan.vbs [扫描路径] [结果HTM文件路径]
#例子: CScript scan.vbs d:\Web f:\my\report.html
欢迎提意见
附件: ASPSecurityvbs.rar [需 0 社区元下载]
-----------------------------------------------------------------------
[code]
'-----------------------
'Scan ASP WebShell in vbs
'Author: lake2 ([url]http://lake2.0x54.org[/url])
'Date: 2006-11-30
'Version: 1.0 Beta
'-----------------------
DimFileExt = "asp,cer,asa,cdx"
Dim Report, Report2, Sun, SumFiles, SumFolders
Call ShowInfo()
If WScript.Arguments.Count = 2 Then
Call CheckArg()
Sun = 0
SumFiles = 0
SumFolders = 1
If Right(WScript.Arguments.Item(0),1) = "\" Then
thePath = Mid(WScript.Arguments.Item(0),1,Len(WScript.Arguments.Item(0))-1)
Else
thePath = WScript.Arguments.Item(0)
End If
WScript.Echo "开始扫描，请稍候……"
WScript.Sleep(1000)
StartTime = now()
Call ShowAllFile(thePath)
EndTime = now()
WScript.Echo vbcrlf & "扫描完成！" & vbcrlf
report2 = report2 & "<html><head><title>雷客图 ASP 站长安全助手vbs版扫描报告</title>"
report2 = report2 & "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312""></head>"
report2 = report2 & "<body><b><font size=4>雷客图 ASP 站长安全助手vbs版扫描报告</font></b><br><br>"
report2 = report2 & "<body><font size=2>开始时间："&StartTime&"</font><br>"
report2 = report2 & "<body><font size=2>结束时间："&EndTime&"</font><br>"
report2 = report2 & "<font size=2>扫描完毕！一共检查文件夹<font color=""#FF0000"">"&SumFolders&"</font>个，文件<font color=""#FF0000"">"&SumFiles&"</font>个，发现可疑点<font color=""#FF0000"">"&Sun&"</font>个（<font color=""#FF0000"">红字</font>显示的为严重可疑）</font><br/>"
report2 = report2 & "<table width=""100%"" border=""0"" style=""padding:5px;line-height:170%;clear:both;font-size:12px;word-break:break-all"">"
report2 = report2 & "<tr>"
report2 = report2 & "<td width=""20%"">文件路径</td>"
report2 = report2 & "<td width=""20%"">特征码</td>"
report2 = report2 & "<td width=""40%"">描述</td>"
report2 = report2 & "<td width=""20%"">创建/修改时间</td>"
report2 = report2 & "</tr>"
report2 = report2 & "<p>"
report2 = report2 & report
report2 = report2 & "</p>"
report2 = report2 & "</table><hr><script src=http://www.0x54.org/announce.js></script>"
report2 = report2 & "<div align=center>powered by <a href=""[url]http://www.0x54.org[/url]"" target=_blank>0x54.org</a></div>"
report2 = report2 & "</body></html>"
Call WriteToFile()
Else
Call ShowHelp()
End If
Sub ShowInfo()
HelpStr = HelpStr & "=====＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝=====" & vbcrlf
HelpStr = HelpStr & "===== 欢迎使用雷客图 ASP 站长安全助手vbs版 =====" & vbcrlf
HelpStr = HelpStr & "===== Author: lake2 =====" & vbcrlf
HelpStr = HelpStr & "===== Email:lake2@mail.csdn.net =====" & vbcrlf
HelpStr = HelpStr & "===== 欢迎访问 [url]www.0x54.org[/url] 得到更多信息 =====" & vbcrlf
HelpStr = HelpStr & "=====＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝=====" & vbcrlf
HelpStr = HelpStr & vbcrlf
WScript.Echo HelpStr
End Sub
Sub ShowHelp()
HelpStr = HelpStr & "#用法: CScript scan.vbs [扫描路径] [结果HTM文件路径]" & vbcrlf
HelpStr = HelpStr & "#例子: CScript scan.vbs d:\Web f:\my\report.html" & vbcrlf
HelpStr = HelpStr & vbcrlf
WScript.Echo HelpStr
End Sub
Sub CheckArg()
tmpPath = Left(WScript.Arguments.Item(1), InStrRev(WScript.Arguments.Item(1),"\")-1)
Set objFSO = WScript.CreateObject ("Scripting.FileSystemObject")
If Not objFSO.FolderExists(WScript.Arguments.Item(0)) Then
WScript.Echo "Error：错误的路径“" & WScript.Arguments.Item(0) & "”！"
WScript.Quit
ElseIf Not objFSO.FolderExists(tmpPath) Then
WScript.Echo "Error：错误的文件路径“" & tmpPath & "”！"
WScript.Quit
End If
Set objFSO = Nothing
End Sub
'遍历处理path及其子目录所有文件
Sub ShowAllFile(Path)
WScript.Echo "正在检查目录" & path
Set FSO = CreateObject("Scripting.FileSystemObject")
Set f = FSO.GetFolder(Path)
Set fc2 = f.files
For Each myfile in fc2
If CheckExt(FSO.GetExtensionName(path&"\"&myfile.name)) Then
'WScript.Echo "正在检查文件" & path&"\"&myfile.name
Call ScanFile(Path&Temp&"\"&myfile.name, "")
SumFiles = SumFiles + 1
End If
Next
Set fc = f.SubFolders
For Each f1 in fc
ShowAllFile path&"\"&f1.name
SumFolders = SumFolders + 1
Next
Set FSO = Nothing
End Sub
'检查文件后缀，如果与预定的匹配即返回TRUE
Function CheckExt(FileExt)
If DimFileExt = "*" Then CheckExt = True
Ext = Split(DimFileExt,",")
For i = 0 To Ubound(Ext)
If Lcase(FileExt) = Ext(i) Then
CheckExt = True
Exit Function
End If
Next
End Function
'检测文件
Sub ScanFile(FilePath, InFile)
If InFile <> "" Then
Infiles = "<font color=red>该文件被"& InFile & "文件包含执行</font>"
End If
temp = FilePath
On Error Resume Next
Set tStream = WScript.CreateObject("ADODB.Stream")
tStream.type = 1
tStream.mode = 3
tStream.open
tStream.Position=0
tStream.LoadFromFile FilePath
If err Then Exit Sub end if
tStream.type = 2
tStream.charset = "GB2312"
Do Until tStream.EOS
filetxt = filetxt & LCase(replace(tStream.ReadText(102400), Chr(0), ""))
Loop
tStream.close()
Set tStream = Nothing
Set FSOs = WScript.CreateObject("Scripting.FileSystemObject")
if len(filetxt) >0 then
'特征码检查
filetxt = vbcrlf & filetxt
'Check "WScr"&DoMyBest&"ipt.Shell"
If Instr( filetxt, Lcase("WScr"&DoMyBest&"ipt.Shell") ) or Instr( filetxt, Lcase("clsid:72C24DD5-D70A"&DoMyBest&"-438B-8A42-98424B88AFB8") ) then
Report = Report&"<tr><td>"&temp&"</td><td>WScr"&DoMyBest&"ipt.Shell 或者 clsid:72C24DD5-D70A"&DoMyBest&"-438B-8A42-98424B88AFB8</td><td><font color=red>危险组件，一般被ASP木马利用</font>"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
Sun = Sun + 1
End if
'Check "She"&DoMyBest&"ll.Application"
If Instr( filetxt, Lcase("She"&DoMyBest&"ll.Application") ) or Instr( filetxt, Lcase("clsid:13709620-C27"&DoMyBest&"9-11CE-A49E-444553540000") ) then
Report = Report&"<tr><td>"&temp&"</td><td>She"&DoMyBest&"ll.Application 或者 clsid:13709620-C27"&DoMyBest&"9-11CE-A49E-444553540000</td><td><font color=red>危险组件，一般被ASP木马利用</font>"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
Sun = Sun + 1
End If
'Check Unicode
If instr( filetxt, chr(-22048)) then
Report = Report&"<tr><td>"&temp&"</td><td>无</td><td><font color=red>使用 Unicode 编码 ASP 代码</font>"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
Sun = Sun + 1
End If
'Check .Encode
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Global = True
regEx.Pattern = "\bLANGUAGE\s*=\s*[""]?\s*(vbscript|jscript|javascript).encode\b"
If regEx.Test(filetxt) Then
Report = Report&"<tr><td>"&temp&"</td><td>(vbscript|jscript|javascript).Encode</td><td><font color=red>似乎脚本被加密了，一般ASP文件是不会加密的</font>"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
Sun = Sun + 1
End If
'Check my ASP backdoor :(
regEx.Pattern = "\bEv"&"al\b"
If regEx.Test(filetxt) Then
Report = Report&"<tr><td>"&temp&"</td><td>Ev"&"al</td><td>e"&"val()函数可以执行任意ASP代码，被一些后门利用。其形式一般是：ev"&"al(X)<br>但是javascript代码中也可以使用，有可能是误报。"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
Sun = Sun + 1
End If
'Check exe&cute backdoor
regEx.Pattern = "[^.]\bExe"&"cute\b"
If regEx.Test(filetxt) Then
Report = Report&"<tr><td>"&temp&"</td><td>Exec"&"ute</td><td><font color=red>e"&"xecute()函数可以执行任意ASP代码，被一些后门利用。其形式一般是：ex"&"ecute(X)</font><br>"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
Sun = Sun + 1
End If
'Check .(Open|Create)TextFile
regEx.Pattern = "\.(Open|Create)TextFile\b"
If regEx.Test(filetxt) Then
Report = Report&"<tr><td>"&temp&"</td><td>.Crea"&"teTextFile|.O"&"penTextFile</td><td>使用了FSO的CreateTextFile|OpenTextFile函数读写文件"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
Sun = Sun + 1
End If
'Check .SaveT&oFile
regEx.Pattern = "\.SaveT"&"oFile\b"
If regEx.Test(filetxt) Then
Report = Report&"<tr><td>"&temp&"</td><td>.Sa"&"veToFile</td><td>使用了Stream或者JMail的SaveToFile函数写文件"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
Sun = Sun + 1
End If
'Check .&Save
regEx.Pattern = "\.Sa"&"ve\b"
If regEx.Test(filetxt) Then
Report = Report&"<tr><td>"&temp&"</td><td>.Sa"&"ve</td><td>使用了XMLHTTP的Save函数写文件"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
Sun = Sun + 1
End If
'Check set Server
regEx.Pattern = "set\s*.*\s*=\s*server\s"
If regEx.Test(filetxt) Then
Report = Report&"<tr><td>"&temp&"</td><td>Set xxx=Se"&"rver</td><td><font color=red>发现Set xxx=Ser" & jj & "ver，请管理员仔细检查是否调用.execute</font><br>"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
Sun = Sun + 1
End If
'Check Server.(Transfer|Ex&ecute)
regEx.Pattern = "Server.(Ex"&"ecute|Transfer)([ \t]*|\()[^""]\)"
If regEx.Test(filetxt) Then
Report = Report&"<tr><td>"&temp&"</td><td>Server.Ex"&"ecute</td><td><font color=red>不能跟踪检查Server.e"&"xecute()函数执行的文件。请管理员自行检查</font><br>"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
Sun = Sun + 1
End If
'Check .Ru&n
regEx.Pattern = "\.R"&"un\b"
If regEx.Test(filetxt) Then
Report = Report&"<tr><td>"&temp&"</td><td>.Ru"&"n</td><td><font color=red>发现 WScript 的 Run 函数</font><br>"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
Sun = Sun + 1
End If
'Check .Exe&c
regEx.Pattern = "\.Ex"&"ec\b"
If regEx.Test(filetxt) Then
Report = Report&"<tr><td>"&temp&"</td><td>.Ex"&"ec</td><td><font color=red>发现 WScript 的 Exec 函数</font><br>"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
Sun = Sun + 1
End If
'Check .Shel&lExecute
regEx.Pattern = "\.Shel"&"lExecute\b"
If regEx.Test(filetxt) Then
Report = Report&"<tr><td>"&temp&"</td><td>.ShellE"&"xecute</td><td><font color=red>发现 Application 的 ShellExecute 函数</font><br>"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
Sun = Sun + 1
End If
Set regEx = Nothing
'Check include file not with "&'
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Global = True
regEx.Pattern = "<!--\s*#include\s+(file|virtual)\s*=\s*.*-->"
Set Matches = regEx.Execute(filetxt)
For Each Match in Matches
tFile = Replace(Trim(Mid(Match.Value, Instr(Match.Value, "=") + 1, Len(Match.Value) - Instr(Match.Value, "=") - 1)),"/","\")
If Left(tFile, 1)="'" Then
tFile = Mid(tFile, 2, InStr(2, tFile, "'", 1) - 2)
ElseIf Left(tFile, 1)="""" Then
tFile = Mid(tFile, 2, InStr(2, tFile, """", 1) - 2)
Else
tFile = Replace(tFile, Chr(9), " ")
If InStr(tFile, " ") <> 0 Then
tFile = Left(tFile, InStr( tFile, " ") - 1)
Else
tFile = Left(tFile, InStr( tFile, "-") - 1)
End If
End If
If Not CheckExt(FSOs.GetExtensionName(tFile)) Then
Call ScanFile( Mid(FilePath,1,InStrRev(FilePath,"\"))&tFile, FilePath)
SumFiles = SumFiles + 1
End If
Next
Set Matches = Nothing
Set regEx = Nothing
'Check Server&.Execute|Transfer
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Global = True
regEx.Pattern = "Server.(Exec"&"ute|Transfer)([ \t]*|\()"".*?"""
Set Matches = regEx.Execute(filetxt)
For Each Match in Matches
tFile = Replace(Mid(Match.Value, Instr(Match.Value, """") + 1, Len(Match.Value) - Instr(Match.Value, """") - 1),"/","\")
If Not CheckExt(FSOs.GetExtensionName(tFile)) Then
Call ScanFile( Mid(FilePath,1,InStrRev(FilePath,"\"))&tFile, FilePath)
SumFiles = SumFiles + 1
End If
Next
Set Matches = Nothing
Set regEx = Nothing
'Check RunatScript
Set XregEx = New RegExp
XregEx.IgnoreCase = True
XregEx.Global = True
XregEx.Pattern = "<scr"&"ipt\s*(.|\n)*?runat\s*=\s*""?server""?(.|\n)*?>"
Set XMatches = XregEx.Execute(filetxt)
For Each Match in XMatches
tmpLake2 = Mid(Match.Value, 1, InStr(Match.Value, ">"))
srcSeek = InStr(1, tmpLake2, "src", 1)
If srcSeek > 0 Then
srcSeek2 = instr(srcSeek, tmpLake2, "=")
For i = 1 To 50
tmp = Mid(tmpLake2, srcSeek2 + i, 1)
If tmp <> " " and tmp <> chr(9) and tmp <> vbCrLf Then
Exit For
End If
Next
If tmp = """" Then
tmpName = Mid(tmpLake2, srcSeek2 + i + 1, Instr(srcSeek2 + i + 1, tmpLake2, """") - srcSeek2 - i - 1)
Else
If InStr(srcSeek2 + i + 1, tmpLake2, " ") > 0 Then tmpName = Mid(tmpLake2, srcSeek2 + i, Instr(srcSeek2 + i + 1, tmpLake2, " ") - srcSeek2 - i) Else tmpName = tmpLake2
If InStr(tmpName, chr(9)) > 0 Then tmpName = Mid(tmpName, 1, Instr(1, tmpName, chr(9)) - 1)
If InStr(tmpName, vbCrLf) > 0 Then tmpName = Mid(tmpName, 1, Instr(1, tmpName, vbcrlf) - 1)
If InStr(tmpName, ">") > 0 Then tmpName = Mid(tmpName, 1, Instr(1, tmpName, ">") - 1)
End If
Call ScanFile( Mid(FilePath,1,InStrRev(FilePath,"\"))&tmpName , FilePath)
SumFiles = SumFiles + 1
End If
Next
Set Matches = Nothing
Set regEx = Nothing
end if
set fsos = nothing
End Sub
Function GetDateModify(filepath)
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(filepath)
s = f.DateLastModified
set f = nothing
set fso = nothing
GetDateModify = s
End Function
Function GetDateCreate(filepath)
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(filepath)
s = f.DateCreated
set f = nothing
set fso = nothing
GetDateCreate = s
End Function
Sub WriteToFile()
Set FSO = CreateObject("Scripting.FileSystemObject")
Set theFile = FSO.OpenTextFile(WScript.Arguments.Item(1), 2, True)
theFile.Write(Report2)
theFile.Close
Set FSO = Nothing
WScript.Echo "扫描结果已经写入文件“"&WScript.Arguments.Item(1)&"”，请查看之！"
End Sub
[/code]
页:
[1]