杀毒

开发平台：
Visual Basic

Check.bas：源码内容
							Attribute VB_Name = "Check"
Dim SF As String
Function CheckFile() '====动态检测＝＝＝＝
Dim X As Long, TE As String * 255, FO As String, FK As String, AX, Res As String, BX, cx
Dim i As Integer, Volume As String * 255, Vol As String, LAB As String, Find As Integer, FD As String
Dim fso, FF, d, f, f1, A As Integer, FTemp(1 To 10) As String, e, FS(1 To 10) As String, FB As Integer, AllFile As String
Dim Nu As Integer
'====定义Ftemp10个元素表示最多可以储存10个病毒＝＝＝＝＝＝＝
X = GetForegroundWindow()
If X = Form1.hwnd Then Exit Function '===本身不作检测＝＝＝
If X = 0 Then Exit Function  '====如果找不到活动窗口则退出＝＝＝
Set fso = CreateObject("scripting.filesystemobject")
Call GetWindowText(X, TE, X + 1)
FO = Left(TE, InStr(TE, vbNullChar) - 1) '=====活动窗口标题＝＝＝＝
If FO = "" Then Exit Function '===找不到标题退出＝＝＝
If FO <> SF Then '====对相同焦点的窗口只执行一次＝＝＝
SF = FO
If InStr(FO, " ") = 0 Then
'Form1.Label1.Caption = Now & " " & FK & " 活动窗口:" & FO
Exit Function '====找不到空格退出＝＝＝
End If
If InStr(FO, "(") = 0 Or InStr(FO, ")") = 0 Then
'Form1.Label1.Caption = Now & " " & FK & " 活动窗口:" & FO
Exit Function '====找不到括号则退出＝＝＝＝
End If
AX = Split(FO, " ", -1, 1)
If UBound(AX) < 1 Then '===只限制一个要求＝＝＝
'Form1.Label1.Caption = Now & " " & FK & " 活动窗口:" & FO
Exit Function '====小于两个空格退出＝＝＝＝
End If
BX = Split(AX(1), "(", -1, 1)
If UBound(BX) = 0 Then Exit Function
cx = Split(BX(1), ")", -1, 1)
FK = cx(0) & "" '====磁盘名＝＝＝＝
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
Res = "": Find = 0: FF = 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
Find = Find + 1 '====发现文件的个数＝＝＝＝＝
Res = Res & f1.Name & ". "
FD = fso.getextensionname(f1)
If LCase(FD) = "inf" Or LCase(FD) = "exe" Or LCase(FD) = "pif" Then
FB = FB + 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)
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
Find = 0
Exit Function
End If
End If
If Find <> 0 Then
Form1.Frame1.Caption = "提示 检测到: " & Find & " 个文件。"
If Find = 1 Then
Form1.Label1.Caption = Now & " " & LAB & " " & FK & " 发现隐藏文件:" & Res
Form1.Label1.ForeColor = vbBlue
ElseIf Find > 1 Then
Form1.Label1.Caption = LAB & " " & FK & " 发现隐藏文件:" & Res
Form1.Label1.ForeColor = vbBlue
End If
Else
Form1.Frame1.Caption = "提示 检测到: " & 0 & " 个文件。"
Form1.Label1.Caption = Now & " " & LAB & "  " & FK & " ，没有发现隐藏文件。"
Form1.Label1.ForeColor = vbBlack
End If
End If
End Function

						