黑客资源之网站程序安全分析器VB源码
来源:中国安全信息网 更新时间:2012-04-13
             

本程序通杀:

ASP、ASPX、PHP、CGI、JSP、VBS等脚本WebShell,并能查出99%加密过的脚本WebShell。后来发现,精度越高误杀越高,基本做到宁误扫三千不放过一马!

其实是利用串判断,原理很简单。有很多人向偶要代码,想到人家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, "