'-----------------------
'Scan ASP WebShell in vbs
'Author: lake2 (http://lake2.0x54.org)
'Date: 2007-7-29
'Version: 1.1
'-----------------------

DimFileExt = "asp,cer,asa,cdx"
Dim Report, Report2, Sun, SumFiles, SumFolders

Call ShowInfo()
If WScript.Arguments.Count = 2 Then
    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
    Call CheckArg(thePath)
    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 "font size=2>開始時間："StartTime"/font>br>"
    report2 = report2 "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=""1"" bordercolor=""blue"" 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=""http://www.0x54.org"" 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 "===== 之 檢查ASP木馬 =====" vbcrlf
    HelpStr = HelpStr "===== Author: lake2 =====" vbcrlf
    HelpStr = HelpStr "===== Email:lake2@mail.csdn.net =====" vbcrlf
    HelpStr = HelpStr "===== 歡迎訪問 www.0x54.org 得到更多信息 =====" 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(arg)
    tmpPath = arg
    tmpPath2 = Left(WScript.Arguments.Item(1), InStrRev(WScript.Arguments.Item(1),"\")-1)
    Set objFSO = WScript.CreateObject ("Scripting.FileSystemObject")
    If Not objFSO.FolderExists(tmpPath2) Then
        WScript.Echo "Error：錯誤的路徑“" tmpPath2 "”！"
        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(PathTemp"\"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 .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 execute backdoor
            regEx.Pattern = "[^.]\bExe""cute(Global)?\b"
            If regEx.Test(filetxt) Then
                Report = Report"tr>td>"temp"/td>td>Exec""ute()或者Exe""cuteGlobal()/td>td>font color=red>該函數可以執行任意ASP代碼，被一些后門利用。其形式一般是：ex""ecute(X)/font>br>"infiles"/td>td>"GetDateCreate(filepath)"br>"GetDateModify(filepath)"/td>/tr>"
                Sun = Sun + 1
            End If
            'Check Script.Control
            regEx.Pattern = "\.Execu""teStatement\b"
            If regEx.Test(filetxt) Then
                Report = Report"tr>td>"temp"/td>td>.Exec""uteStatement/td>td>font color=red>發現MSScriptControl.ScriptControl的.Execut""eStatement函數/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 .SaveToFile
            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|.SaveAs
            regEx.Pattern = "\.Sa""ve(As)?\b"
            If regEx.Test(filetxt) Then
                Report = Report"tr>td>"temp"/td>td>.Sa""ve或者.Sa""veAs/td>td>使用了Save或SaveAs函數寫文件"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|Execute)
            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 .Run
            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 .Exec
            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 .ShellExecute
            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
            'Check .create
            regEx.Pattern = "\.Cre""ate\b"
            If regEx.Test(filetxt) Then
                Report = Report"tr>td>"temp"/td>td>.Crea""te/td>td>發現 Create 函數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