form1.frm

是个杀本角木马的简单软件

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "脚本木马查杀-----Binsword系统安全工具"
   ClientHeight    =   5040
   ClientLeft      =   5025
   ClientTop       =   4365
   ClientWidth     =   8295
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5040
   ScaleWidth      =   8295
   Begin MSComctlLib.ProgressBar ProgressBar1 
      Height          =   255
      Left            =   2160
      TabIndex        =   10
      Top             =   2400
      Width           =   5895
      _ExtentX        =   10398
      _ExtentY        =   450
      _Version        =   393216
      Appearance      =   1
   End
   Begin VB.Frame Frame1 
      Caption         =   "请选择网站根目录进行查杀"
      BeginProperty Font 
         Name            =   "黑体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2175
      Left            =   240
      TabIndex        =   5
      Top             =   120
      Width           =   7695
      Begin VB.CommandButton Command1 
         BackColor       =   &H00FFFFFF&
         Caption         =   "查杀脚本木马"
         Height          =   615
         Left            =   5520
         TabIndex        =   8
         Top             =   240
         Width           =   1815
      End
      Begin VB.DriveListBox Drive1 
         Height          =   300
         Left            =   360
         TabIndex        =   7
         Top             =   360
         Width           =   4575
      End
      Begin VB.DirListBox Dir1 
         BackColor       =   &H00FFFFFF&
         Height          =   1140
         Left            =   360
         TabIndex        =   6
         Top             =   840
         Width           =   4575
      End
      Begin VB.Label Label5 
         Caption         =   "0"
         Height          =   255
         Left            =   6120
         TabIndex        =   13
         Top             =   1080
         Width           =   1335
      End
      Begin VB.Label Label4 
         Caption         =   "个脚本对象需要检测"
         Height          =   375
         Left            =   5400
         TabIndex        =   12
         Top             =   1440
         Width           =   1695
      End
      Begin VB.Label Label3 
         Caption         =   "总共有"
         Height          =   375
         Left            =   5400
         TabIndex        =   11
         Top             =   1080
         Width           =   1935
      End
   End
   Begin VB.ListBox List2 
      ForeColor       =   &H000000FF&
      Height          =   780
      Left            =   240
      TabIndex        =   4
      Top             =   3960
      Width           =   7815
   End
   Begin VB.TextBox Text1 
      Height          =   855
      Left            =   1080
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   5760
      Visible         =   0   'False
      Width           =   3855
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      Left            =   360
      TabIndex        =   1
      Text            =   "脚本木马特征字符串"
      Top             =   5040
      Width           =   7815
   End
   Begin VB.ListBox List1 
      Height          =   780
      ItemData        =   "Form1.frx":164A
      Left            =   240
      List            =   "Form1.frx":164C
      TabIndex        =   0
      Top             =   2760
      Width           =   7815
   End
   Begin VB.Label Label2 
      Caption         =   "正在为您检测的对象："
      Height          =   495
      Left            =   240
      TabIndex        =   9
      Top             =   2400
      Width           =   3495
   End
   Begin VB.Label Label1 
      Caption         =   "查找到的危险对象:(点击选择相应的操作,文件删除操作不可恢复)"
      Height          =   375
      Left            =   240
      TabIndex        =   3
      Top             =   3720
      Width           =   6375
   End
   Begin VB.Menu deal 
      Caption         =   "处理木马"
      Visible         =   0   'False
      Begin VB.Menu deletethisfile 
         Caption         =   "删除此文件"
      End
      Begin VB.Menu deleteall 
         Caption         =   "删除所有文件"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit  '强制变量声明
Dim i As Integer  '声明变量a,用于列目录的时候存储
Dim j As Integer   '声明变量b,用于统计需要检测的脚本文件总数
Private Sub Command1_Click()
i = 0  '初始化
j = 0  '初始化
List1.Clear '将list1中的内容清除
List2.Clear  '将list2中的内容清除
ProgressBar1.Value = 0  '进度条置0

If Dir1.Path = "C:\" Or Dir1.Path = "c:\" Or Dir1.Path = "c:" Or Dir1.Path = "d:\" Or Dir1.Path = "d:" Or Dir1.Path = "D:\" Then '如果dir1的path为C盘，则提示错误，防止全盘检查过度消耗内存
MsgBox "对不起，本工具不支持C盘和D盘全盘查杀,请选择网站根目录", vbInformation, "错误--脚本木马查杀--Binsword"    '错误提示
Else
Call Tfile1(Dir1.Path)  '通过Tfile1过程来计算需要检测的文件总数
Label5.Caption = i    '将label5的caption设置成文件总数
Call Tfile(Dir1.Path)  '通过Tfile过程来列出正在检测的文件
If List2.ListCount = 0 Then   '如果list2中没有数据，表明没有检测到任何危险对象
MsgBox "没有发现任何危险对象!!", vbInformation, "脚本木马查杀--Binsword"
End If
End If
End Sub

Private Sub deleteall_Click()
If List2.ListCount <> 0 Then
Dim fso
Set fso = CreateObject("scripting.filesystemobject")
For i = 1 To List2.ListCount
fso.deletefile (List2.List(0))
List2.RemoveItem 0
List2.Refresh
Next i
End If
End Sub

Private Sub deletethisfile_Click()
If List2.ListCount <> 0 Then
Dim fso
Set fso = CreateObject("scripting.filesystemobject")
fso.deletefile (List2.List(List2.ListIndex))
List2.RemoveItem List2.ListIndex
List2.Refresh
End If
End Sub

Private Sub Drive1_Change()
Dir1.Path = Drive1  '将dir1的path设置成驱动器列表drive1
End Sub

Private Sub Form_Load()
On Error GoTo errorhandle  '对错误进行调试和处理
errorhandle:  '处理错误
'MsgBox "程序出现未知错误" & Chr(13) & Chr(10) & "  错误号：  " & Err.Number, vbCritical, "脚本木马查杀"
Dim fso
Set fso = CreateObject("scripting.filesystemobject")
If Not fso.fileexists(App.Path & "\Trojan.data") Then
MsgBox "找不到特征库文件，程序即将退出", vbCritical, "严重错误--脚本木马查杀"
End
End If
'On Error Resume Next   '容错语句
Dir1.Path = "e:\"   '默认地将驱动列表放置到D盘
Dim trojandata, trojandatalist    '声明fso对象,trojandata 为脚本木马的特征码数据,trojandatalist为单行读出的一条特征码数据
Set fso = CreateObject("scripting.filesystemobject")   '创建fso对象
Set trojandata = fso.opentextfile(App.Path & "\em001_32.data")
Set trojandata = fso.opentextfile(App.Path & "\em002_32.Data")
Set trojandata = fso.opentextfile(App.Path & "\em003_32.Data")
Set trojandata = fso.opentextfile(App.Path & "\em004_32.Data")
Set trojandata = fso.opentextfile(App.Path & "\em005_32.Data")
Set trojandata = fso.opentextfile(App.Path & "\em006_32.Data")
Set trojandata = fso.opentextfile(App.Path & "\em007_32.Data")
Set trojandata = fso.opentextfile(App.Path & "\em008_32.Data")
Set trojandata = fso.opentextfile(App.Path & "\em000_32.Data")
'利用opentextfile方法打开特征码文件
Do While trojandata.AtEndOfStream <> True    '利用循环将trojandata中的所有特征码分行加入combo1下拉框中
trojandatalist = trojandata.readline   'trojandatalist 是其中一条记录
If Not IsNull(trojandatalist) Then  '忽略掉空格，不使空格成为特征码
Combo1.AddItem trojandatalist    '将记录trojandatalist加入下拉框combo1中
End If
Loop

End Sub
Sub Tfile(ByVal Folder As String)   'Tfile过程用于列出目录
On Error Resume Next   '容错语句
Dim fso '声明fso对象
Set fso = CreateObject("scripting.filesystemobject")   '创建fso对象
Dim objFile, objFolder   '声明objFile和objFolder 变量
Set objFolder = fso.GetFolder(Folder)  '取得当前文件夹
For Each objFile In objFolder.Files
Call TFolder(objFile.Path)
Next
For Each objFolder In objFolder.SubFolders
Call Tfile(objFolder)
Next
End Sub
Sub Tfile1(ByVal Folder As String)
On Error Resume Next
Dim fso
Set fso = CreateObject("scripting.filesystemobject")
Dim objFile, objFolder
Set objFolder = fso.GetFolder(Folder)
For Each objFile In objFolder.Files
Call TFolder1(objFile.Path)
Next
For Each objFolder In objFolder.SubFolders
Call Tfile1(objFolder)
Next
End Sub

Sub TFolder(ByVal FileName As String)
Dim fso, allcode
Set fso = CreateObject("scripting.filesystemobject")
Dim houzhui
j = j + 1
houzhui = fso.getextensionName(FileName)
If LCase(houzhui) = "asp" Or LCase(houzhui) = "asa" Or LCase(houzhui) = "jsp" Or LCase(houzhui) = "cer" Or LCase(houzhui) = "aspx" Or LCase(houzhui) = "htr" Or LCase(houzhui) = "php" Or LCase(houzhui) = "cfm" Then
Me.List1.AddItem FileName
Set fso = CreateObject("scripting.filesystemobject")
Set allcode = fso.opentextfile(FileName)
Text1.Text = allcode.readall
'检查特征码
For i = 1 To Combo1.ListCount
If InStr(LCase(Text1.Text), LCase(Combo1.List(i - 1))) Then
List2.AddItem FileName
MsgBox "发现脚本木马。。。" & Chr(13) & Chr(10) & "其路径是" & FileName, vbInformation, "发现危险对象--脚本木马查杀"
Exit For
End If
Next i
allcode.Close
End If
ProgressBar1.Value = (j / Label5.Caption) * 100
End Sub

Sub TFolder1(ByVal FileName As String)
Dim fso, allcode
Set fso = CreateObject("scripting.filesystemobject")
Dim houzhui
houzhui = fso.getextensionName(FileName)
If LCase(houzhui) = "asp" Or LCase(houzhui) = "asa" Or LCase(houzhui) = "jsp" Or LCase(houzhui) = "cer" Or LCase(houzhui) = "aspx" Or LCase(houzhui) = "htr" Or LCase(houzhui) = "php" Or LCase(houzhui) = "cfm" Then
i = i + 1
End If
End Sub

Private Sub List2_Click()
PopupMenu deal
End Sub

Private Sub List2_KeyDown(KeyCode As Integer, Shift As Integer)
PopupMenu deal
End Sub

Private Sub List2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
PopupMenu deal
End Sub