杀毒

开发平台：
Visual Basic

Button.bas：源码内容
							Attribute VB_Name = "Button"
Option Explicit
Public Const BF_BOTTOM = &H8
Public Const BF_LEFT = &H1
Public Const BF_RIGHT = &H4
Public Const BF_TOP = &H2
Public Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
Public Const BF_BOTTOMLEFT = (BF_BOTTOM Or BF_LEFT)
Public Const BF_BOTTOMRIGHT = (BF_BOTTOM Or BF_RIGHT)
Public Const BF_TOPRIGHT = (BF_TOP Or BF_RIGHT)
Public Const BF_TOPLEFT = (BF_TOP Or BF_LEFT)
Public Const BF_DIAGONAL = &H10
Public Const BF_DIAGONAL_ENDBOTTOMLEFT = (BF_DIAGONAL Or BF_BOTTOM Or BF_LEFT)
Public Const BF_DIAGONAL_ENDBOTTOMRIGHT = (BF_DIAGONAL Or BF_BOTTOM Or BF_RIGHT)
Public Const BF_DIAGONAL_ENDTOPLEFT = (BF_DIAGONAL Or BF_TOP Or BF_LEFT)
Public Const BF_DIAGONAL_ENDTOPRIGHT = (BF_DIAGONAL Or BF_TOP Or BF_RIGHT)
Public Const BDR_RAISEDINNER = &H4
Public Const BDR_RAISEDOUTER = &H1
Public Const BDR_SUNKENINNER = &H8
Public Const BDR_SUNKENOUTER = &H2
Public Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
Public Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
Public Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
Public Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
Public Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
Public Const EM_SETREADONLY = &HCF
Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Declare Function DrawEdge Lib "user32" (ByVal hDC As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
Function ScanFactory() '====全盘扫描＝＝＝＝
Dim TE As String * 255, FO As String, FK As String, i As Integer, FB As Integer, AllFile As String
Dim Volume As String * 255, Vol As String, LAB As String, FD As String, Nu As Integer
Dim fso, d, f, f1, d1, m, A As Integer, FTemp(1 To 10) As String, e, FS(1 To 10) As String
Dim m2, d2, PassMax As Integer, PassValue As Integer, BT As Integer
'====定义Ftemp10个元素表示最多可以储存10个病毒＝＝＝＝＝＝＝
Form1.PASS2.Value = 0
Set fso = CreateObject("scripting.filesystemobject")
Set m2 = fso.drives
For Each d2 In m2 '=====先统计磁盘总数，计算进度条的最大值＝＝＝
On Error Resume Next
If d2.drivetype = 2 Or d2.drivetype = 1 Then '===不检测CDROM及软盘或网络驱动器
If LCase(d2.driveletter) <> "a" Then '可移动磁盘
If d2.isready Then '===磁盘就绪＝＝＝
PassMax = PassMax + 1
End If
End If
End If
Next
If PassMax = 0 Then
MsgBox "没有发现磁盘分区，请检查系统配置及软件运行状况，与作者联系。", 0 + 64, "出错"
Exit Function
End If
Form1.PASS2.Max = PassMax
Form1.Timer1.Enabled = False
Form1.BN(2).Enabled = False
Form1.AutoPic '====刷新按钮＝＝＝＝＝＝
Form1.Label1.ForeColor = vbBlue
Form1.Label2.Caption = "Find"
Form1.Label1.Caption = Now & " 计时器暂停工作，正在执行系统扫描 ..."
DoEvents
Sleep 600
Set m = fso.drives
For Each d1 In m
On Error Resume Next
If d1.drivetype = 2 Or d1.drivetype = 1 Then '===不检测CDROM及软盘或网络驱动器
If LCase(d1.driveletter) <> "a" Then '可移动磁盘
If d1.isready Then '===磁盘就绪＝＝＝
PassValue = PassValue + 1 '====进度条状况＝＝＝
FK = d1.driveletter & ":" '====磁盘名＝＝＝＝
Call GetVolumeInformation(FK, Volume, 255, 0&, 0&, 0&, 0&, 255)
Vol = Left(Volume, InStr(Volume, vbNullChar) - 1)
If Vol = "" Then
If GetDriveType(FK) = 2 Then
LAB = "可移动磁盘"
ElseIf GetDriveType(FK) = 3 Then
LAB = "本地磁盘"
End If
Else
LAB = Vol
End If
Form1.Label1.Caption = Now & " 正在检测磁盘分区 " & PassValue & " ,  " & LAB & " " & FK & " ..."
DoEvents
Sleep 200
FB = 0 '====初始化清空计数＝＝＝
Set d = fso.getfolder(FK)
Set f = d.Files
For Each f1 In f
On Error Resume Next '===防止突然删除了文件导致刷新不过来＝＝＝＝
If InStr(GetAutoRun(CStr(f1)), "H") <> 0 Then
FD = fso.getextensionname(f1)
If LCase(FD) = "inf" Or LCase(FD) = "exe" Or LCase(FD) = "pif" Then
FB = FB + 1 '======发现病毒的个数＝＝＝＝＝
BT = BT + 1 '=====总病毒个数＝＝＝＝＝＝
FTemp(FB) = f1.Name '====================存储文件名＝＝＝＝＝＝
If fso.folderexists(FK & "隔离文件") = False Then fso.createfolder (FK & "隔离文件")
FS(FB) = TellFileType(GetAutoRun(FK & FTemp(FB)))
Set e = fso.GetFile(f1)
e.Attributes = e.Attributes - 2 '================去掉隐藏属性＝＝＝＝
If InStr(GetAutoRun(CStr(f1)), "R") <> 0 Then '====去掉只读属性＝＝＝＝
e.Attributes = e.Attributes - 1
End If
If InStr(GetAutoRun(CStr(f1)), "S") <> 0 Then '====去掉系统属性＝＝＝＝
e.Attributes = e.Attributes - 4
End If
CopyFile FK & FTemp(FB), FK & "隔离文件" & FTemp(FB), False
DeleteFile FK & FTemp(FB)
WriteLog Now & " 发现文件：" & FTemp(FB) & "，" & FS(FB) & "，该文件已被清除。"
Form1.Frame2.Caption = "操作 已检测到：" & RecordNumber & " 条信息。"
End If
End If
Next
If FB > 0 Then '====如果发现了病毒，等先清除了所有病毒后再显示对话框＝＝＝＝＝
For i = 1 To 10
If FTemp(i) <> "" Then
Nu = Nu + 1
AllFile = AllFile & Nu & "." & FTemp(i) & " " & FS(i) & "  "
Else
Exit For
End If
Next i
Dim WT As Long
WT = GetForegroundWindow
SetWindowPos WT, 1, 0, 0, 0, 0, 3 '==这一步很重要，在前台显示消息＝＝＝
A = MsgBox("发现文件：" & AllFile & _
"文件已被清除。" & _
"副本已备份到:" & FK & "隔离文件 中。" & vbCrLf & vbCrLf & _
"选择‘确定’继续，‘取消’恢复被删除的文件。", vbOKCancel + 48, _
"发现隐藏文件  " & LAB & " " & FK)
For i = 1 To 10
FTemp(i) = ""
Next i
Nu = 0: AllFile = ""
AllFile = AllFile & Nu & "." & FTemp(i) & " " & FS(i) & "  "
SetWindowPos WT, -2, 0, 0, 0, 0, 3 '==恢复正常＝＝＝
If A = vbCancel Then '===恢复文件并去掉隐藏属性＝＝＝＝＝
If fso.folderexists(FK & "隔离文件") = False Then
WriteLog Now & " 备份文件被删除，无法恢复所需文件！"
Form1.Frame2.Caption = "操作 已检测到：" & RecordNumber & " 条信息。"
MsgBox "备份文件夹被删除，无法恢复所需文件！", 0 + 48, "失败"
Exit Function
End If
For i = 1 To 10
If FTemp(i) = "" Then Exit For
If fso.fileexists(FK & "隔离文件" & FTemp(i)) = False Then
WriteLog Now & " 文件：" & FK & "隔离文件" & FTemp(i) & " 被删除，无法恢复所需文件！"
Form1.Frame2.Caption = "操作 已检测到：" & RecordNumber & " 条信息。"
MsgBox "文件：" & FK & "隔离文件" & FTemp(i) & " 被删除，无法恢复所需文件！", 0 + 48, "失败"
End If
Next i
For i = 1 To 10
If FTemp(i) = "" Then Exit For
CopyFile FK & "隔离文件" & FTemp(i), FK & FTemp(i), False
WriteLog Now & " 备份文件被还原，为防止误删文件，请去掉文件的隐藏属性。"
Form1.Frame2.Caption = "操作 已检测到：" & RecordNumber & " 条信息。"
Next i
Exit Function
End If
End If
Form1.PASS2.Value = PassValue
End If
End If
DoEvents
End If
Next
Form1.Label1.ForeColor = vbBlue
Form1.AutoPic
Form1.BN(2).Enabled = True
If BT > 0 Then
Form1.Label1.Caption = Now & " 共检查:" & PassValue & " 块分区。共发现：" & BT & " 个病毒文件。"
Else
Form1.Label1.Caption = Now & " 共检查:" & PassValue & " 块分区。磁盘系统状态良好。"
End If
Sleep 500
'Form1.PASS2.Max = 400
Form1.Timer1.Enabled = True
End Function

						