网站程序安全分析器VB源码

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, "www.ChinNetHack.Com - 网站程序安全分析器 零号服务器专用"
  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