Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As LongPrivate Const WS_EX_LAYERED = &H80000Private Const GWL_EXSTYLE = (-20)Private Const LWA_ALPHA = &H2Private Const LWA_COLORKEY = &H1Private Declare Function ReleaseCapture Lib "user32" () As LongPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Const HTCAPTION = 2Private Const WM_NCLBUTTONDOWN = &HA1Private Declare Function timeGetTime Lib "winmm.dll" () As LongPrivate Declare Sub InitCommonControls Lib "comctl32.dll" ()Dim SuJu1 As LongDim Faxian As StringDim FaJs As StringPrivate Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As LongPrivate Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As LongPrivate Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As LongPrivate Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As LongConst MAX_PATH = 260Const MAXDWORD = &HFFFFConst INVALID_HANDLE_VALUE = -1Const FILE_ATTRIBUTE_ARCHIVE = &H20Const FILE_ATTRIBUTE_DIRECTORY = &H10Const FILE_ATTRIBUTE_HIDDEN = &H2Const FILE_ATTRIBUTE_NORMAL = &H80Const FILE_ATTRIBUTE_READONLY = &H1Const FILE_ATTRIBUTE_SYSTEM = &H4Const FILE_ATTRIBUTE_TEMPORARY = &H100Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As LongPrivate Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pIdl As Long, ByVal pszPath As String) As LongPrivate Type BrowseInfohwndOwner As LongpiDLroot As LongpszdisplayName As Stringlpsztitle As StringulFlags As Longlpfncallback As LonglParam As LongiImage As LongEnd TypePrivate Type FILETIME    dwLowDateTime   As Long    dwHighDateTime   As LongEnd TypePrivate 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 * 14End TypePrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)ReleaseCaptureSendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&End SubPrivate 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_COLORKEYEnd SubSub YS()  Dim Savetime As Double  Savetime = timeGetTime  While timeGetTime < Savetime + 200  DoEvents  WendEnd SubPrivate Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Me.Image1.Visible = FalseMe.Image2.Visible = TrueYSWindowState = 1Me.Image1.Visible = TrueMe.Image2.Visible = FalseEnd SubPrivate Sub Image4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Me.Image4.Visible = FalseMe.Image3.Visible = TrueYSEndEnd SubPrivate Sub Command1_Click()Dim bi As BrowseInfoDim folderid As LongDim pb As StringWith bi.hwndOwner = Me.hwnd.lpsztitle = "选择查杀的文件夹:".ulFlags = 3End Withfolderid = SHBrowseForFolder(bi)If folderid = 0 Then Exit Subpb = String$(260, 0)SHGetPathFromIDList folderid, pbpb = Left$(pb, InStr(pb, vbNullChar) - 1)Text1.Text = pbEnd SubFunction StripNulls(OriginalStr As String) As String    If (InStr(OriginalStr, Chr(0)) > 0) Then          OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)    End If    StripNulls = OriginalStrEnd FunctionFunction 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 FunctionPrivate Sub Command3_Click()Dim SearchPath   As String, FindStr     As StringDim FileSize   As LongIf Text1.Text = "" ThenMsgBox "请输入正确扫描路径"Exit SubEnd IfMe.Command3.Enabled = FalseMe.Command7.Enabled = TrueList1.ClearFaJs = 0SuJu1 = 0Me.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 IfEnd SubSub 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", vbMaximizedFocusEnd SubPrivate Sub Command7_Click()Me.Command3.Enabled = TrueMe.Command7.Enabled = FalseScreen.MousePointer = vbDefaultEnd SubPrivate Sub Text5_Change()Text5.SelStart = Len(Text5.Text)End Sub