杀毒

开发平台：
Visual Basic

Form1.frm：源码内容
							VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   BackColor       =   &H80000018&
   Caption         =   "Form1"
   ClientHeight    =   3135
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7320
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   Picture         =   "Form1.frx":0442
   ScaleHeight     =   3135
   ScaleWidth      =   7320
   Begin VB.Frame Frame6 
      BackColor       =   &H80000018&
      Caption         =   "设定 选择操作"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1185
      Left            =   4200
      TabIndex        =   35
      Top             =   720
      Width           =   3130
      Begin VB.PictureBox BN 
         AutoRedraw      =   -1  'True
         BackColor       =   &H80000018&
         BorderStyle     =   0  'None
         ForeColor       =   &H00C00000&
         Height          =   855
         Index           =   3
         Left            =   2280
         Picture         =   "Form1.frx":0884
         ScaleHeight     =   855
         ScaleWidth      =   735
         TabIndex        =   39
         Top             =   240
         Width           =   735
      End
      Begin VB.PictureBox BN 
         AutoRedraw      =   -1  'True
         BackColor       =   &H80000018&
         BorderStyle     =   0  'None
         ForeColor       =   &H00C00000&
         Height          =   855
         Index           =   5
         Left            =   80
         Picture         =   "Form1.frx":0CC6
         ScaleHeight     =   855
         ScaleWidth      =   735
         TabIndex        =   37
         Top             =   240
         Width           =   735
      End
      Begin VB.PictureBox BN 
         AutoRedraw      =   -1  'True
         BackColor       =   &H80000018&
         BorderStyle     =   0  'None
         ForeColor       =   &H00C00000&
         Height          =   855
         Index           =   6
         Left            =   1080
         Picture         =   "Form1.frx":1108
         ScaleHeight     =   855
         ScaleWidth      =   975
         TabIndex        =   36
         Top             =   240
         Width           =   975
      End
   End
   Begin VB.PictureBox PIC 
      Height          =   615
      Index           =   12
      Left            =   3360
      Picture         =   "Form1.frx":154A
      ScaleHeight     =   555
      ScaleWidth      =   675
      TabIndex        =   34
      Top             =   6120
      Width           =   735
   End
   Begin VB.PictureBox PIC 
      Height          =   615
      Index           =   11
      Left            =   2640
      Picture         =   "Form1.frx":198C
      ScaleHeight     =   555
      ScaleWidth      =   675
      TabIndex        =   33
      Top             =   6120
      Width           =   735
   End
   Begin VB.PictureBox PIC 
      Height          =   615
      Index           =   10
      Left            =   1920
      Picture         =   "Form1.frx":1DCE
      ScaleHeight     =   555
      ScaleWidth      =   675
      TabIndex        =   32
      Top             =   6120
      Width           =   735
   End
   Begin VB.PictureBox PIC 
      Height          =   615
      Index           =   9
      Left            =   8400
      Picture         =   "Form1.frx":2210
      ScaleHeight     =   555
      ScaleWidth      =   675
      TabIndex        =   31
      Top             =   5520
      Width           =   735
   End
   Begin VB.PictureBox PIC 
      Height          =   615
      Index           =   8
      Left            =   7680
      Picture         =   "Form1.frx":2ADA
      ScaleHeight     =   555
      ScaleWidth      =   675
      TabIndex        =   30
      Top             =   5520
      Width           =   735
   End
   Begin VB.PictureBox PIC 
      Height          =   615
      Index           =   7
      Left            =   6960
      Picture         =   "Form1.frx":2F1C
      ScaleHeight     =   555
      ScaleWidth      =   675
      TabIndex        =   27
      Top             =   5520
      Width           =   735
   End
   Begin VB.PictureBox PIC 
      Height          =   615
      Index           =   6
      Left            =   6240
      Picture         =   "Form1.frx":3226
      ScaleHeight     =   555
      ScaleWidth      =   675
      TabIndex        =   26
      Top             =   5520
      Width           =   735
   End
   Begin VB.PictureBox PIC 
      Height          =   615
      Index           =   5
      Left            =   5520
      Picture         =   "Form1.frx":3668
      ScaleHeight     =   555
      ScaleWidth      =   675
      TabIndex        =   25
      Top             =   5520
      Width           =   735
   End
   Begin VB.CommandButton Command1 
      BackColor       =   &H80000010&
      Caption         =   "退出程序"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Index           =   5
      Left            =   7440
      TabIndex        =   23
      Top             =   1320
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      BackColor       =   &H80000014&
      Caption         =   "安全打开"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Index           =   0
      Left            =   7440
      TabIndex        =   22
      Top             =   1920
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "查看记录"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Index           =   2
      Left            =   7440
      TabIndex        =   21
      Top             =   120
      Width           =   960
   End
   Begin VB.CommandButton Command1 
      Caption         =   "删除记录"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Index           =   3
      Left            =   7440
      TabIndex        =   20
      Top             =   720
      Width           =   975
   End
   Begin VB.Frame Frame5 
      BackColor       =   &H80000018&
      Height          =   400
      Left            =   5430
      TabIndex        =   18
      Top             =   1890
      Width           =   1900
      Begin VB.Label Label3 
         BackColor       =   &H80000018&
         Caption         =   "正在启动. . ."
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   9
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   225
         Left            =   80
         TabIndex        =   19
         Top             =   120
         Width           =   1720
      End
   End
   Begin VB.Timer Timer2 
      Left            =   9600
      Top             =   120
   End
   Begin VB.PictureBox PIC 
      Height          =   615
      Index           =   4
      Left            =   4800
      Picture         =   "Form1.frx":3AAA
      ScaleHeight     =   555
      ScaleWidth      =   675
      TabIndex        =   13
      Top             =   5520
      Width           =   735
   End
   Begin VB.Frame Frame4 
      BackColor       =   &H80000018&
      Height          =   400
      Left            =   20
      TabIndex        =   11
      Top             =   1890
      Width           =   5415
      Begin MSComctlLib.ProgressBar PASS2 
         Height          =   255
         Left            =   45
         TabIndex        =   14
         Top             =   120
         Width           =   4815
         _ExtentX        =   8493
         _ExtentY        =   450
         _Version        =   393216
         Appearance      =   1
      End
      Begin VB.Label Label2 
         BackColor       =   &H80000018&
         Caption         =   "%"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   225
         Left            =   4930
         TabIndex        =   12
         Top             =   120
         Width           =   420
      End
   End
   Begin VB.Frame Frame3 
      BackColor       =   &H80000018&
      Caption         =   "设定: 选择操作"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   860
      Left            =   20
      TabIndex        =   7
      Top             =   2280
      Width           =   7320
      Begin VB.CheckBox Check7 
         BackColor       =   &H80000018&
         Caption         =   "限制窗口移出屏幕"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   240
         Left            =   4920
         TabIndex        =   40
         Top             =   280
         Width           =   2250
      End
      Begin VB.CheckBox Check6 
         BackColor       =   &H80000018&
         Caption         =   "前端显示"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   1800
         TabIndex        =   17
         Top             =   280
         Width           =   1290
      End
      Begin VB.CheckBox Check5 
         BackColor       =   &H80000018&
         Caption         =   "检查当前窗口的文件状态"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   100
         TabIndex        =   16
         Top             =   550
         Width           =   2955
      End
      Begin VB.CheckBox Check4 
         BackColor       =   &H80000018&
         Caption         =   "显示运行时间"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   240
         Left            =   3120
         TabIndex        =   15
         Top             =   550
         Width           =   1770
      End
      Begin VB.CheckBox Check1 
         BackColor       =   &H80000018&
         Caption         =   "打开U盘目录"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   240
         Left            =   100
         TabIndex        =   10
         Top             =   280
         Width           =   1755
      End
      Begin VB.CheckBox Check2 
         BackColor       =   &H80000018&
         Caption         =   "自动消息提示"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   240
         Left            =   3120
         TabIndex        =   9
         Top             =   280
         Width           =   1755
      End
      Begin VB.CheckBox Check3 
         BackColor       =   &H80000018&
         Caption         =   "30秒自动隐藏窗口"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   240
         Left            =   4920
         TabIndex        =   8
         Top             =   550
         Width           =   2250
      End
   End
   Begin VB.PictureBox PIC 
      Height          =   615
      Index           =   3
      Left            =   4080
      Picture         =   "Form1.frx":97FC
      ScaleHeight     =   555
      ScaleWidth      =   675
      TabIndex        =   6
      Top             =   5520
      Width           =   735
   End
   Begin VB.PictureBox PIC 
      Height          =   615
      Index           =   2
      Left            =   3360
      Picture         =   "Form1.frx":9C3E
      ScaleHeight     =   555
      ScaleWidth      =   675
      TabIndex        =   5
      Top             =   5520
      Width           =   735
   End
   Begin VB.PictureBox PIC 
      Height          =   615
      Index           =   1
      Left            =   2640
      Picture         =   "Form1.frx":A080
      ScaleHeight     =   555
      ScaleWidth      =   675
      TabIndex        =   4
      Top             =   5520
      Width           =   735
   End
   Begin VB.PictureBox PIC 
      Height          =   615
      Index           =   0
      Left            =   1920
      Picture         =   "Form1.frx":A4C2
      ScaleHeight     =   555
      ScaleWidth      =   675
      TabIndex        =   3
      Top             =   5520
      Width           =   735
   End
   Begin VB.Frame Frame2 
      BackColor       =   &H80000018&
      Caption         =   "操作"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1185
      Left            =   20
      TabIndex        =   2
      Top             =   720
      Width           =   4110
      Begin VB.PictureBox BN 
         AutoRedraw      =   -1  'True
         BackColor       =   &H80000018&
         BorderStyle     =   0  'None
         ForeColor       =   &H00C00000&
         Height          =   855
         Index           =   4
         Left            =   3240
         Picture         =   "Form1.frx":A904
         ScaleHeight     =   855
         ScaleWidth      =   975
         TabIndex        =   38
         Top             =   240
         Width           =   975
      End
      Begin VB.PictureBox BN 
         AutoRedraw      =   -1  'True
         BackColor       =   &H80000018&
         BorderStyle     =   0  'None
         ForeColor       =   &H00C00000&
         Height          =   855
         Index           =   2
         Left            =   2280
         Picture         =   "Form1.frx":B1CE
         ScaleHeight     =   855
         ScaleWidth      =   1095
         TabIndex        =   29
         Top             =   250
         Width           =   1095
      End
      Begin VB.PictureBox BN 
         AutoRedraw      =   -1  'True
         BackColor       =   &H80000018&
         BorderStyle     =   0  'None
         ForeColor       =   &H00C00000&
         Height          =   855
         Index           =   1
         Left            =   1160
         Picture         =   "Form1.frx":B4D8
         ScaleHeight     =   855
         ScaleWidth      =   1095
         TabIndex        =   28
         Top             =   250
         Width           =   1095
      End
      Begin VB.PictureBox BN 
         BackColor       =   &H80000018&
         BorderStyle     =   0  'None
         ForeColor       =   &H00C00000&
         Height          =   840
         Index           =   0
         Left            =   80
         Picture         =   "Form1.frx":B91A
         ScaleHeight     =   840
         ScaleWidth      =   960
         TabIndex        =   24
         Top             =   240
         Width           =   960
      End
   End
   Begin VB.Timer Timer1 
      Left            =   10320
      Top             =   240
   End
   Begin VB.Frame Frame1 
      BackColor       =   &H80000018&
      Caption         =   "提示"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   730
      Left            =   20
      TabIndex        =   0
      Top             =   0
      Width           =   7320
      Begin VB.Label Label1 
         BackColor       =   &H80000018&
         Caption         =   "Label1"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   11.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   120
         TabIndex        =   1
         Top             =   300
         Width           =   7125
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Dis As Integer, DT As String, NT As String, WH As Integer, Start As Date, ML As String, Si As Integer, Factory As String
Function TellDanger(DangerDrive As String) '=====autorun.inf警告拦截===
Dim fso, f, FF, f1, d, A As Integer, EX As String, FTemp(1 To 10) As String, e, Fu As Integer
Dim FK As String, FS(1 To 10) As String, Nu As Integer, Vol As String, Volume As String * 255
Dim LAB As String
If DangerDrive = "" Or DangerDrive = " " Then Exit Function
If InStr(DangerDrive, ":") = 0 Then Exit Function
Set fso = CreateObject("scripting.filesystemobject")
If fso.driveexists(DangerDrive) = False Then Exit Function
Set wshshell = CreateObject("wscript.shell")
Set f = fso.getfolder(DangerDrive & "")
Set f1 = f.Files
For Each d In f1
On Error Resume Next
If InStr(GetAutoRun(CStr(d)), "H") <> 0 Then
EX = fso.getextensionname(d)
If LCase(EX) = "exe" Or LCase(EX) = "inf" Or LCase(EX) = "pif" Then
Fu = Fu + 1
Label1.Caption = Factory & " " & DangerDrive & "   发现文件：" & d.Name & "，" & TellFileType(GetAutoRun(CStr(d)))
Form1.Label1.ForeColor = vbBlue
Command1(2).Enabled = True: Command1(3).Enabled = True
FTemp(Fu) = d.Name: FK = DangerDrive & ""
If fso.folderexists(FK & "隔离文件") = False Then fso.createfolder FK & "隔离文件"
FS(Fu) = TellFileType(GetAutoRun(FK & FTemp(Fu)))
Set e = fso.GetFile(d)
e.Attributes = e.Attributes - 2 '================去掉隐藏属性＝＝＝＝
If InStr(GetAutoRun(CStr(d)), "R") <> 0 Then '====去掉只读属性＝＝＝
e.Attributes = e.Attributes - 1
End If
If InStr(GetAutoRun(CStr(d)), "S") <> 0 Then '====去掉系统属性＝＝＝
e.Attributes = e.Attributes - 4
End If
CopyFile FK & FTemp(Fu), FK & "隔离文件" & FTemp(Fu), False
DeleteFile FK & FTemp(Fu)
WriteLog Now & " 发现文件：" & FTemp(Fu) & "，" & FS(Fu) & "，该文件已被清除。"
Form1.Frame2.Caption = "操作 已检测到：" & RecordNumber & " 条信息。"
DoEvents
End If
End If
Next
TrayI.hIcon = PIC(2).Picture '====外围改变图标以免档机＝＝＝＝
TrayI.szTip = "插入了可移动磁盘，正在拦截自动播放 ..." & Chr$(0)
Shell_NotifyIcon NIM_MODIFY, TrayI
If Fu > 0 Then '====如果发现了病毒，等先清除了所有病毒后再显示对话框＝＝＝＝＝
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
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
End Function
Private Sub BN_Click(Index As Integer)
Dim wshshell, fso, f, FF
Set fso = CreateObject("scripting.filesystemobject")
Set wshshell = CreateObject("wscript.shell")
Select Case Index
Case 3 '退出程序
SaveSetting "key", "U", "X", CStr(Me.Left)
SaveSetting "key", "U", "Y", CStr(Me.Top)
Shell_NotifyIcon NIM_DELETE, TrayI
If GetSetting("key", "K", 0, "") = "pass" Then
SaveSetting "key", "K", 0, "finish"
End If
Dim ret As Long
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWindProc)
Call UnregisterHotKey(Me.hwnd, uVirtkey)
End
Case 6 '===更多功能＝＝＝＝
If GetSetting("key", "U", 11, "") = "ok" Then
Frame6.Caption = "设定 缩进以精简窗口"
SaveSetting "key", "U", 11, "no"
Frame3.Top = Frame2.Top + Frame2.Height + 30
Frame5.Top = Frame3.Top + Frame3.Height - 20
Frame4.Top = Frame3.Top + Frame3.Height - 20
Me.Height = 3688
Else
Frame6.Caption = "设定 显示更多操作"
SaveSetting "key", "U", 11, "ok"
Frame5.Top = Frame2.Top + Frame2.Height
Frame4.Top = Frame2.Top + Frame2.Height
Frame3.Top = Frame4.Top + Frame4.Height + 5
Me.Height = 2805
End If
Case 0 '====打开目录＝＝＝＝
If NT = "" Then BN(0).Enabled = False: BN_Paint (0): Exit Sub
Me.Visible = False
Call Shell("explorer.exe " & NT, vbMaximizedFocus)
SafeOpen
Case 1 '=====查看记录＝＝＝＝＝
If fso.fileexists("d:usb.txt") = False Then Exit Sub
Shell "notepad.exe d:usb.txt", vbMaximizedFocus
Case 2 '======系统扫描＝＝＝＝＝＝
ScanFactory
Case 4 '======删除后台记录==========
Dim A As Integer
If fso.fileexists("d:usb.txt") = False Then Exit Sub
Me.Visible = False
A = MsgBox("后台记录可以查看有关U盘操作的信息，确定要删除？", vbOKCancel + vbQuestion, "系统扫描")
If A = vbOK Then
DeleteFile "d:usb.txt"
Frame2.Caption = "操作 已检测到：" & 0 & " 条信息。"
Me.Visible = True
BN_Paint (1)
ElseIf A = vbCancel Then
Me.Visible = True
End If
Case 5 '=======热键设定＝＝＝＝＝＝＝＝＝＝＝＝＝
'xx = GetSetting("key", "FAST", 0, "")
'yy = GetSetting("key", "FAST", 1, "")
Dim X As Long, Y As Integer, SP As String, AX, Wp(0 To 2) As String
Wp(0) = "Ctrl": Wp(1) = "Alt": Wp(2) = "Shift"
X = GetSetting("key", "FAST", 0, "")
Y = GetSetting("key", "FAST", 1, "")
SP = ShowKey(X, Y)
AX = Split(SP, "+", -1, 1)
If UBound(AX) = 0 Then
MsgBox "无效的快捷键！", 0 + 48, "退出"
Exit Sub
End If
For i = 0 To 2 '====先清空文本＝＝＝＝
Form5.Check1(i).Value = 0
Next i
Form5.Text1(3).Text = ""
For i = UBound(AX) - 1 To 0 Step -1 '====分开写入＝＝＝＝
For j = 0 To 2
If AX(i) = Wp(j) Then Form5.Check1(j).Value = 1 '===找好位置写入＝＝＝＝
Next j
Next i
Form5.Text1(3).Text = UCase(AX(UBound(AX)))
'Frame6.Caption = "设定 热键:" & ShowKey(x, y)
Form5.Visible = True
SetWindowPos Form5.hwnd, -1, 0, 0, 0, 0, 3
Form5.Text1(3).SetFocus
End Select
End Sub
Private Sub BN_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim TitleMe(0 To 6) As String
TitleMe(0) = "安全打开": TitleMe(1) = "查看记录": TitleMe(2) = "系统扫描": TitleMe(3) = "退出程序"
TitleMe(4) = "删除记录": TitleMe(5) = "热键设定": TitleMe(6) = "参数设置"
DrawButton BN(Index), 3, TitleMe(Index), PIC(Index + 5)
End Sub
Private Sub BN_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim TitleMe(0 To 6) As String, i As Integer, xx As Long, yy As Integer
TitleMe(0) = "安全打开": TitleMe(1) = "查看记录": TitleMe(2) = "系统扫描": TitleMe(3) = "退出程序"
TitleMe(4) = "删除记录": TitleMe(5) = "热键设定": TitleMe(6) = "参数设置"
If ML <> CStr(Index) Then
ML = CStr(Index)
xx = GetSetting("key", "FAST", 0, "")
yy = GetSetting("key", "FAST", 1, "")
If Index = 5 Then
Frame6.Caption = "设定 热键:" & ShowKey(xx, yy)
ElseIf Index = 6 Then
If GetSetting("key", "U", 11, "") = "ok" Then
Frame6.Caption = "设定 显示更多操作"
Else
Frame6.Caption = "设定 缩进以精简窗口"
End If
ElseIf Index = 3 Then
Frame6.Caption = "设定 安全地退出程序"
ElseIf Index = 0 Then
Frame6.Caption = "操作 安全地打开U盘"
ElseIf Index = 2 Then
Frame6.Caption = "操作 检查磁盘中的文件"
ElseIf Index = 1 Then
Frame6.Caption = "操作 查看后台消息记录"
ElseIf Index = 4 Then
Frame6.Caption = "操作 删除后台消息记录"
End If
For i = 0 To 6
If i = Index Then
If Index = 0 And BN(0).Enabled = False Then
DrawButton BN(0), 1, "安全打开", PIC(12)
DoEvents
Else
DrawButton BN(Index), 2, TitleMe(Index), PIC(Index + 5)
DoEvents
End If
DoEvents
Else
If i = 0 And BN(0).Enabled = False Then
DrawButton BN(i), 1, "安全打开", PIC(12):  DoEvents
Else
DrawButton BN(i), 1, TitleMe(i), PIC(i + 5): DoEvents
End If
End If
DoEvents
Next
End If
End Sub
Private Sub BN_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim TitleMe(0 To 6) As String
TitleMe(0) = "安全打开": TitleMe(1) = "查看记录": TitleMe(2) = "系统扫描": TitleMe(3) = "退出程序"
TitleMe(4) = "删除记录": TitleMe(5) = "热键设定": TitleMe(6) = "参数设置"
DrawButton BN(Index), 2, TitleMe(Index), PIC(Index + 5)
End Sub
Private Sub BN_Paint(Index As Integer)
DrawButton BN(1), 1, "查看记录", PIC(6)
DrawButton BN(2), 1, "系统扫描", PIC(7)
DrawButton BN(3), 1, "退出程序", PIC(8)
DrawButton BN(4), 1, "删除记录", PIC(9)
DrawButton BN(5), 1, "热键设定", PIC(10)
DrawButton BN(6), 1, "参数设置", PIC(11)
If BN(0).Enabled = False Then
DrawButton BN(0), 1, "安全打开", PIC(12)
Else
DrawButton BN(0), 1, "安全打开", PIC(5)
End If
End Sub
Private Sub Check1_Click()
If Check1.Value = 1 Then
SaveSetting "key", "U", 0, "ok"
Else
SaveSetting "key", "U", 0, "false"
End If
End Sub
Private Sub Check1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
WH = 0: Si = 0
ML = "设定: 插入U盘时,自动打开目录且在窗口标题栏上有提示"
If Frame3.Caption <> ML Then Frame3.Caption = ML
End Sub
Private Sub Check2_Click()
If Check2.Value = 1 Then
SaveSetting "key", "U", 1, "ok"
Else
SaveSetting "key", "U", 1, "no"
End If
End Sub
Private Sub Check2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
WH = 0: Si = 0
ML = "设定: 插入、移出可移动硬盘时显示进度条状态提示"
If Frame3.Caption <> ML Then Frame3.Caption = ML
End Sub
Private Sub Check3_Click()
If Check3.Value = 1 Then
SaveSetting "key", "U", 2, "ok"
Else
SaveSetting "key", "U", 2, "no"
End If
End Sub
Private Sub Check3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
ML = "设定: 30秒内窗口没有检测到鼠标动作时自动隐藏"
If Frame3.Caption <> ML Then Frame3.Caption = ML
End Sub
Private Sub Check4_Click()
If Check4.Value = 0 Then
SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 3
SaveSetting "key", "U", 8, "no"
Frame5.Visible = False
Check4.Value = 0
Frame5.Visible = False
Frame4.Width = Form4.Frame1.Width
PASS2.Width = Form4.PASS.Width
Label2.Left = Form4.Label1.Left
Else
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
SaveSetting "key", "U", 8, "ok"
Frame5.Visible = True
Frame4.Width = Form4.Frame4.Width
PASS2.Width = Form4.PASS2.Width
Label2.Left = Form4.Label2.Left
End If
End Sub
Private Sub Check4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
WH = 0: Si = 0
ML = "设定: 显示程序从启动到现在的时间，或仅显示进度条"
If Frame3.Caption <> ML Then Frame3.Caption = ML
End Sub
Private Sub Check5_Click()
If Check5.Value = 0 Then
SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 3
SaveSetting "key", "U", 6, "no"
Else
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
SaveSetting "key", "U", 6, "ok"
End If
End Sub
Private Sub Check5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
WH = 0: Si = 0
ML = "设定: 动态跟随当前的活动窗口，发现病毒文件立即删除。"
If Frame3.Caption <> ML Then Frame3.Caption = ML
End Sub
Private Sub Check6_Click()
If Check6.Value = 0 Then
SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 3
SaveSetting "key", "U", 5, "no"
Else
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
SaveSetting "key", "U", 5, "ok"
End If
End Sub
Private Sub Check6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
ML = "设定: 窗口在所有窗口最前端显示而不会被其它窗口覆盖"
If Frame3.Caption <> ML Then Frame3.Caption = ML
End Sub
Private Sub Check7_Click()
If Check7.Value = 0 Then
MuLimit = False
SaveSetting "key", "U", 10, "no"
Else
MuLimit = True
SaveSetting "key", "U", 10, "ok"
End If
End Sub
Private Sub ClearAll_Click()
Dim wshshell, fso, f, FF, d1, A
Set fso = CreateObject("scripting.filesystemobject")
Set f = fso.drives
For Each d1 In f
If d1.drivetype = 2 Or d1.drivetype = 1 Then '===不检测CDROM及软盘或网络驱动器
If LCase(d1.driveletter) <> "a" Then
If d1.isready Then '===磁盘就绪＝＝＝
If fso.folderexists(d1.driveletter & ":隔离文件") = True Then
If MsgBox("发现隔离文件夹：" & d1.driveletter & ":隔离文件，是否删除？按‘确定’删除，‘取消’退出循环检查。", vbQuestion + vbOKCancel, "清除隔离文件") = vbOK Then
fso.deletefolder d1.driveletter & ":隔离文件", True
Else
Exit Sub
End If
End If
End If
End If
End If
DoEvents
Next
End Sub
Function GetVolumeName() As String '====卷标名称＝＝＝＝
Dim Volume As String * 255
If NT = "" Then Exit Function
Call GetVolumeInformation(NT, Volume, 255, 0&, 0&, 0&, 0&, 255)
GetVolumeName = Left(Volume, InStr(Volume, vbNullChar) - 1)
End Function
Function SafeOpen()  '=====安全打开窗口模式＝＝＝＝
Sleep 300
Dim X As Long, TE As String * 255, FO As String, FK As String, TF As String
Dim i As Integer, j As Integer, Wa As Boolean
If GetVolumeName = "" Then
FO = "可移动磁盘"
Else
FO = GetVolumeName
End If
FK = FO & " (" & NT & ")"
Wa = False
Do
X = FindWindow("CabinetWClass", FK)
If X <> 0 Then SetForegroundWindow X: Exit Do
j = j + 1
Sleep 50
DoEvents
If j > 80 Then: Wa = True: Exit Do
Loop
DoEvents
If Wa = False Then
Call GetWindowText(X, TE, 255)
TF = Left(TE, InStr(TE, vbNullChar) - 1)
If Wa = False Then
SetWindowText X, TF & "   安全打开 . . . "
End If
End If
If Check2.Value = 1 Then
If Wa = False Then
Form2.Label1.Caption = Now & " 检测到可移动磁盘 " & NT & ": ，正在更新信息 ..."
ElseIf Wa = True Then
Form2.Label1.Caption = Now & " 检测到可移动磁盘 " & NT & ": ，等待超时退出 ..."
keybd_event vbKeyShift, 0, KEYEVENTF_KEYUP, 0
keybd_event vbKeyShift, 0, KEYEVENTF_KEYUP, 0
Exit Function
End If
DoEvents
For i = 80 To 100 Step 2
SetWindowPos Form2.hwnd, -1, 0, 0, 0, 0, 3
Form2.PASS.Value = i
Sleep 5
DoEvents
Next i
Form2.Visible = False
DoEvents
If Check6.Value = 1 Then SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
End If
SetForegroundWindow X
ShowWindow X, 3
keybd_event vbKeyShift, 0, KEYEVENTF_KEYUP, 0
keybd_event vbKeyShift, 0, KEYEVENTF_KEYUP, 0
End Function
Private Sub Check7_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
WH = 0: Si = 0
ML = "设定: 窗口不能移动超过屏幕的左，右，上，下四边范围。"
If Frame3.Caption <> ML Then Frame3.Caption = ML
End Sub
Private Sub Command1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
WH = 0: Si = 0
End Sub
Function ShowKey(X As Long, Y As Integer) As String   '===快捷键显示===
If X = 0 Or Y = 0 Then Exit Function
Select Case X
Case MOD_CONTROL
ShowKey = "Ctrl"
Case MOD_ALT
ShowKey = "Alt"
Case MOD_SHIFT
ShowKey = "Shift"
Case MOD_CONTROL + MOD_ALT
ShowKey = "Ctrl+Alt"
Case MOD_CONTROL + MOD_SHIFT
ShowKey = "Ctrl+Shift"
Case MOD_ALT + MOD_SHIFT
ShowKey = "Alt+Shift"
Case MOD_CONTROL + MOD_ALT + MOD_SHIFT
ShowKey = "Ctrl+Alt+Shift"
Case Else
MsgBox "未知的按键!!!", 0 + 48, "False"
Exit Function
End Select
ShowKey = ShowKey & "+" & Chr(Y)
End Function
Private Sub Form_Load()
ShowWindow GetWindow(Me.hwnd, 4), 0
On Error Resume Next
For i = 0 To 6
BN(i).Width = 990 '1026
BN(i).Top = 220
DoEvents
Next i
BN(2).Left = BN(0).Left + BN(0).Width
BN(1).Left = BN(2).Left + BN(2).Width
BN(4).Left = BN(1).Left + BN(1).Width
'BN(5).Left = BN(4).Left + BN(4).Width
BN(6).Left = BN(5).Left + BN(5).Width
BN(3).Left = BN(6).Left + BN(6).Width
DoEvents
Start = Now '====开始计时====
'=======初始化右下角图标＝＝＝＝＝
 TrayI.cbSize = Len(TrayI)
    TrayI.hwnd = PIC(0).hwnd
    TrayI.uId = 1&
    TrayI.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
TrayI.ucallbackMessage = WM_MOUSEMOVE '====这一行很重要，使用MOUSEMOVE消息与下面的PIC的MOUSEMOVE事件相对应＝＝
TrayI.hIcon = PIC(0).Picture
TrayI.szTip = Label1.Caption & Chr$(0)
Shell_NotifyIcon NIM_ADD, TrayI
DoEvents
'====================================
Load Form2
If RecordNumber <> 0 Then
Frame2.Caption = "操作 已检测到：" & RecordNumber & " 条信息。"
DoEvents
End If
WH = 0: Si = 0
Me.Caption = "U盘自动播放拦截程序 V1.19   <全面拦截AUTORUN病毒>"
If GetSetting("key", "U", 0, "") = "" Then SaveSetting "key", "U", 0, "ok"
If GetSetting("key", "U", 1, "") = "" Then SaveSetting "key", "U", 1, "ok"
If GetSetting("key", "U", 2, "") = "" Then SaveSetting "key", "U", 2, "no"
If GetSetting("key", "U", 5, "") = "" Then SaveSetting "key", "U", 5, "ok"
If GetSetting("key", "U", 6, "") = "" Then SaveSetting "key", "U", 6, "ok"
If GetSetting("key", "U", 8, "") = "" Then SaveSetting "key", "U", 8, "ok"
If GetSetting("key", "U", 10, "") = "" Then SaveSetting "key", "U", 10, "ok"
If GetSetting("key", "U", 11, "") = "" Then SaveSetting "key", "U", 11, "ok"
If GetSetting("key", "U", 11, "") = "ok" Then
Frame5.Top = Frame2.Top + Frame2.Height
Frame4.Top = Frame2.Top + Frame2.Height
Frame3.Top = Frame4.Top + Frame4.Height + 5
Me.Height = 2805
Else
Frame3.Top = Frame2.Top + Frame2.Height + 30
Frame5.Top = Frame3.Top + Frame3.Height - 20
Frame4.Top = Frame3.Top + Frame3.Height - 20
Me.Height = 3688
End If
If GetSetting("key", "U", 10, "") = "ok" Then
Check7.Value = 1
Else
Check7.Value = 0
End If
If GetSetting("key", "U", 0, "") = "ok" Then '====打开U盘＝＝＝
Check1.Value = 1
Else
Check1.Value = 0
End If
If GetSetting("key", "U", 1, "") = "ok" Then
Check2.Value = 1
Else
Check2.Value = 0
End If
If GetSetting("key", "U", 2, "") = "ok" Then
Check3.Value = 1
Else
Check3.Value = 0
PASS2.Max = 400
PASS2.Value = 400
Label2.Caption = "Time"
End If
If GetSetting("key", "U", "X", "") = "" Then
SaveSetting "key", "U", "X", Me.Width / 3
End If
If GetSetting("key", "U", "Y", "") = "" Then
SaveSetting "key", "U", "Y", Me.Height / 2
End If
Me.Left = CInt(GetSetting("key", "U", "X", ""))
Me.Top = CInt(GetSetting("key", "U", "Y", ""))
Dim fso, f, w, FF, wshshell, d, d1, H, h1
Dim KI As Boolean
Set fso = CreateObject("scripting.filesystemobject")
Set wshshell = CreateObject("wscript.shell")
Label1.Caption = Now & " 未检测到可移动磁盘 . . . ."
Form1.Label1.ForeColor = vbBlack
TrayI.hIcon = PIC(3).Picture
TrayI.szTip = Label1.Caption & Chr$(0)
Shell_NotifyIcon NIM_MODIFY, TrayI
DoEvents
Set H = fso.drives
For Each h1 In H '====提前检测磁盘数以免以错＝＝＝＝＝重要！！！＝＝＝＝＝＝＝＝＝＝＝
If h1.drivetype = 2 Or h1.drivetype = 1 Then '===不检测CDROM及软盘或网络驱动器
If LCase(h1.driveletter) <> "a" Then
If h1.isready Then '===磁盘就绪＝＝＝
Dis = Dis + 1
DT = DT & h1.driveletter
End If
End If
End If
DoEvents
Next
DoEvents
Set d = fso.drives
For Each d1 In d
On Error Resume Next
If d1.drivetype = 2 Or d1.drivetype = 1 Then '===不检测CDROM及软盘或网络驱动器
If d1.drivetype = 1 And LCase(d1.driveletter) <> "a" Then '可移动磁盘
If d1.isready Then '===磁盘就绪＝＝＝
Factory = d1.volumename
Label1.Caption = Now & " 检测到可移动磁盘 " & Factory & " " & d1 & ", 状态良好。"
Form1.Label1.ForeColor = vbBlue
KI = True '===注意，不能在循环中改变图标，这样会导致程序出错提前退出FOR　NEXT＝＝＝重要！！！！＝＝＝＝
Dim X As Integer
Set f = fso.getfolder(CStr(d1))
Set f1 = f.Files
For Each DX In f1
X = X + 1
Next
DoEvents
Frame1.Caption = "提示 检测到: " & X & " 个文件。"
WriteLog Label1.Caption '===记录＝＝＝
Frame2.Caption = "操作 已检测到：" & RecordNumber & " 条信息。"
NT = d1
On Error Resume Next
Call TellDanger(CStr(d1.driveletter) & ":")
End If
End If
End If
DoEvents
Next
If KI = True Then
TrayI.szTip = Label1.Caption & Chr$(0)
TrayI.hIcon = PIC(0).Picture
Shell_NotifyIcon NIM_MODIFY, TrayI
DoEvents
End If
TitleBar '====放在最前面无效，别窗口的标题不能在Timer控件中更改，否则无效。＝＝＝＝
If NT = "" Then BN(0).Enabled = False: BN_Paint (0)
If GetSetting("key", "U", 5, "") = "ok" Then
Check6.Value = 1
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
Else
Check6.Value = 0
SetWindowPos Me.hwnd, 1, 0, 0, 0, 0, 3
End If
If GetSetting("key", "U", 6, "") = "ok" Then
Check5.Value = 1
Else
Check5.Value = 0
End If
If GetSetting("key", "U", 8, "") = "ok" Then
Check4.Value = 1
Frame5.Visible = True
Frame5.Visible = True
Frame4.Width = Form4.Frame4.Width
PASS2.Width = Form4.PASS2.Width
Label2.Left = Form4.Label2.Left
Else
Check4.Value = 0
Frame5.Visible = False
Frame4.Width = Form4.Frame1.Width
PASS2.Width = Form4.PASS.Width
Label2.Left = Form4.Label1.Left
End If
SaveSetting "key", "K", 0, "pass"
Timer1.Enabled = True '===注册＝＝＝
If GetSetting("key", "FAST", 0, "") = "" Then
SaveSetting "key", "FAST", 0, MOD_CONTROL + MOD_ALT
End If
If GetSetting("key", "FAST", 1, "") = "" Then
SaveSetting "key", "FAST", 1, vbKeyZ
End If
Dim ret As Long '====设置全局快捷键===================  =
preWindProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WndProc)
idHotkey = 1
Modifiers = GetSetting("key", "FAST", 0, "")
uVirtkey = GetSetting("key", "FAST", 1, "")
ret = RegisterHotKey(Me.hwnd, idHotkey, Modifiers, uVirtkey)
'====================移动边界限制========
'=====要设置两个prewindproc,prewindproc2目的为了避免干扰======
MuLimit = True '===开关打开=======
PreWindProc2 = GetWindowLong(Me.hwnd, GWL_WNDPROC)
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WndProc2)
Timer1.Interval = 100
Timer2.Interval = 1000
Form2.PASS.Max = 100
Form2.PASS.Min = 0
Form2.Left = Screen.Width / 4
Form2.Top = Screen.Height / 2
SetWindowPos Form2.hwnd, -1, 0, 0, 0, 0, 3
For i = 0 To 6
BN(i).Picture = LoadPicture()
Next
BN_Paint (0)
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
WH = 0: Si = 0
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = 2 Then
SaveSetting "key", "K", 0, "finish"
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Me.Visible = False
Cancel = -1
End Sub
Function GetRemoveName(Str1 As String, Str2 As String) As String
Dim A As Integer, B As Integer, i As Integer, j As Integer, T1 As String, K1 As String, K2 As String
'===K1 K2 变量储存原有值，以防止原有值被修改＝＝＝
A = Len(Str1): B = Len(Str2): K1 = Str1: K2 = Str2
If A = B Then Exit Function
If A > B Then
For i = 1 To B
K1 = Replace(K1, Mid(K2, i, 1), "")
DoEvents
Next i
GetRemoveName = K1
ElseIf A < B Then
For i = 1 To A
K2 = Replace(K2, Mid(K1, i, 1), "")
DoEvents
Next i
GetRemoveName = K2
End If
End Function
Private Sub Frame1_DblClick()
SaveSetting "key", "U", 4, "no"
End Sub
Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
WH = 0: Si = 0
Dim TitleMe(0 To 6) As String, i As Integer
TitleMe(0) = "安全打开": TitleMe(1) = "查看记录": TitleMe(2) = "系统扫描": TitleMe(3) = "退出程序"
TitleMe(4) = "删除记录": TitleMe(5) = "热键设定": TitleMe(6) = "参数设置"
If ML <> "frame1" Then
ML = "frame1"
For i = 0 To 6
If i = 0 And BN(0).Enabled = False Then
DrawButton BN(0), 1, "安全打开", PIC(12)
Else
DrawButton BN(i), 1, TitleMe(i), PIC(i + 5)
End If
DoEvents
Next i
End If
End Sub
Private Sub Frame2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
WH = 0: Si = 0
End Sub
Private Sub Frame3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
WH = 0: Si = 0
Dim TitleMe(0 To 6) As String, i As Integer
TitleMe(0) = "安全打开": TitleMe(1) = "查看记录": TitleMe(2) = "系统扫描": TitleMe(3) = "退出程序"
TitleMe(4) = "删除记录": TitleMe(5) = "热键设定": TitleMe(6) = "参数设置"
If ML <> "frame3" Then
ML = "frame3"
For i = 0 To 6
If i = 0 And BN(0).Enabled = False Then
DrawButton BN(0), 1, "安全打开", PIC(12)
Else
DrawButton BN(i), 1, TitleMe(i), PIC(i + 5)
End If
DoEvents
Next i
End If
End Sub
Private Sub Frame4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim TitleMe(0 To 6) As String, i As Integer
TitleMe(0) = "安全打开": TitleMe(1) = "查看记录": TitleMe(2) = "系统扫描": TitleMe(3) = "退出程序"
TitleMe(4) = "删除记录": TitleMe(5) = "热键设定": TitleMe(6) = "参数设置"
If ML <> "frame4" Then
ML = "frame4"
For i = 0 To 6
If i = 0 And BN(0).Enabled = False Then
DrawButton BN(0), 1, TitleMe(0), PIC(12)
Else
DrawButton BN(i), 1, TitleMe(i), PIC(i + 5)
End If
DoEvents
Next i
End If
End Sub
Private Sub Frame5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim TitleMe(0 To 6) As String, i As Integer
TitleMe(0) = "安全打开": TitleMe(1) = "查看记录": TitleMe(2) = "系统扫描": TitleMe(3) = "退出程序"
TitleMe(4) = "删除记录": TitleMe(5) = "热键设定": TitleMe(6) = "参数设置"
If ML <> "frame4" Then
ML = "frame4"
For i = 0 To 6
If i = 0 And BN(0).Enabled = False Then
DrawButton BN(0), 1, TitleMe(0), PIC(12)
Else
DrawButton BN(i), 1, TitleMe(i), PIC(i + 5)
End If
DoEvents
Next i
End If
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
WH = 0: Si = 0
End Sub
Private Sub PASS2_Mousemove(Button As Integer, Shift As Integer, X As Single, Y As Single)
WH = 0: Si = 0
Dim TitleMe(0 To 3) As String, i As Integer
TitleMe(0) = "安全打开": TitleMe(1) = "查看记录": TitleMe(2) = "系统扫描": TitleMe(3) = "退出程序"
If ML <> CStr(Index) Then
ML = CStr(Index)
For i = 0 To 3
If i = 0 And BN(0).Enabled = False Then
DrawButton BN(0), 1, TitleMe(0), PIC(12)
Else
DrawButton BN(i), 1, TitleMe(i), PIC(i + 5)
End If
DoEvents
Next i
End If
End Sub
Private Sub PIC_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Msg = X / Screen.TwipsPerPixelX
If Msg = WM_LBUTTONDOWN Then
Me.Visible = True
ElseIf Msg = WM_RBUTTONDOWN Then
Me.Visible = True
End If
End Sub
Function CheckTime(xx As Long) As String
Dim TS As Integer, TF As String, TS2 As Integer, TF2 As String
If xx < 1 Then
CheckTime = "正在启动 ..."
ElseIf xx < 60 Then
CheckTime = xx & " 秒 . . ."
ElseIf xx < 3600 And xx > 59 Then
TS = (xx - 60 * (xx  60))
If TS < 10 Then
TF = "0" & TS
Else
TF = TS
End If
CheckTime = xx  60 & " 分 " & TF & " 秒"
ElseIf xx > 3599 Then '====显示整零时刷新＝＝＝＝
TS2 = (xx - 3600 * (xx  3600))  60
If TS2 < 10 Then
TF2 = "0" & TS2
Else
TF2 = TS2
End If
CheckTime = xx  3600 & " 小时 " & TF2 & " 分"
End If
End Function
Private Sub Timer1_Timer() '====计时器＝＝＝＝
PASS2.Max = 400
On Error Resume Next
'Unknown 0 不能确定驱动器类型。
'Removable 1 驱动器具有可删除介质。包括所有软盘驱动器和许多其它种类的存储设备。
'Fixed 2 驱动器具有固定介质（不可删除的）。包括可删除硬盘在内的所有硬盘驱动器。
'Remote 3 网络驱动器。包括在网络上任何地方都可以共享的驱动器。
'CDROM 4 驱动器是一个CD-ROM。包括只读的CD-ROM和可读写的CD-ROM。
'RAMDisk 5 驱动器是本地计算机上的一块随机存取内存（RAM），它工作起来就象是磁盘驱动器一样。
Dim fso, f, w, FF, wshshell, d, d1
Dim k As Integer, K2 As String, i As Integer
Static SS As Integer
If Me.Visible = False Then WH = 0: Si = 0
If Check3.Value = 0 Then WH = 0: Si = 0
If Check3.Value = 1 Then
Si = Si + 1
If Si > 15 Then WH = WH + 1
If (400 - WH) Mod 4 = 0 Then PASS2.Value = 400 - WH
If (100 - WH  4) = 100 Then
Label2.Caption = "Time"
Else
Label2.Caption = 100 - WH  4 & "%"
End If
If (100 - WH  4) < 20 Then
Label2.ForeColor = vbRed
Else
Label2.ForeColor = vbBlack
End If
DoEvents
End If
If WH > 399 Then
WH = 0: Si = 0
If Check2.Value = 1 Then '====消息提示开关＝＝＝＝
SetWindowPos Form2.hwnd, -1, 0, 0, 0, 0, 3
Form2.Label1.Caption = "检测到30秒内没有鼠标动作，正在自动隐藏 . . . ."
Form2.Visible = True
For i = 1 To 100 Step 2
Form2.PASS.Value = i
Sleep 5
DoEvents
Next i
Form2.Visible = False
DoEvents
End If
Me.Visible = False
End If
Set fso = CreateObject("scripting.filesystemobject")
Set wshshell = CreateObject("wscript.shell")
k = 0: K2 = ""
Set d = fso.drives
For Each d1 In d
If d1.drivetype = 2 Or d1.drivetype = 1 Then  '===不检测CDROM及软盘或网络驱动器
If LCase(d1.driveletter) <> "a" Then '====不检测软盘＝＝＝＝
If d1.isready Then '===磁盘就绪＝＝＝
k = k + 1
K2 = K2 & d1.driveletter
End If
End If
End If
DoEvents
Next
If NT = "" Then BN(0).Enabled = False ': BN_Paint (0) '=====如果没有检测到U盘，则按钮不可用＝＝＝＝
If k > Dis Then '插入了可移动磁盘
SS = 0 '=====这个期间不进行额外的文件检查以防止出现档机＝＝＝＝
TrayI.szTip = "插入了可移动磁盘，正在拦截自动播放 ..." & Chr$(0)
TrayI.hIcon = PIC(2).Picture
Shell_NotifyIcon NIM_MODIFY, TrayI
keybd_event vbKeyShift, 0, 0, 0 '====开始按下SHIFT＝＝＝＝
BN(0).Enabled = True '============================================
'DrawButton BN(0), 1, "安全打开", PIC(5)
BN_Paint (0)
DoEvents
TellDanger CStr(GetRemoveName(DT, K2)) & ":"
Factory = GetFactory(GetRemoveName(DT, K2) & ":")
Label1.Caption = Now & " 检测到可移动磁盘 " & Factory & " " & GetRemoveName(DT, K2) & ": , 状态良好."
Form1.Label1.ForeColor = vbBlue
DoEvents
WriteLog Label1.Caption '===记录＝＝＝
Frame2.Caption = "操作 已检测到：" & RecordNumber & " 条信息。"
NT = GetRemoveName(DT, K2) & ":"
Dim X As Integer
X = 0
Set f = fso.getfolder(NT)
Set f1 = f.Files
For Each d In f1
X = X + 1
DoEvents
Next
DoEvents
Frame1.Caption = "提示 检测到: " & X & " 个文件。"
DoEvents
Dim StopTime As Integer
If GetDriveType(NT) = 2 Then '===检测到U盘＝＝＝＝
StopTime = 15
ElseIf GetDriveType(NT) = 3 Then '====检测到移动硬盘＝＝＝＝
StopTime = 25
End If
If Check2.Value = 1 Then '====自动消息提示＝＝＝＝
SetWindowPos Form2.hwnd, -1, 0, 0, 0, 0, 3
Form2.Visible = True
Form2.Label1.Caption = Now & " " & Factory & " " & GetRemoveName(DT, K2) & ": ，正在拦截自动播放 ..."
For i = 1 To 80 Step 2 '====先进度到80格，然后打开中。。。
SetWindowPos Form2.hwnd, -1, 0, 0, 0, 0, 3
Form2.PASS.Value = i
If i > 79 And Check1.Value = 1 Then '===自动打开U盘＝＝＝
Form2.Label1.Caption = Now & " " & Factory & " " & GetRemoveName(DT, K2) & ": ，正在自动打开 . . . ."
End If
Sleep StopTime
DoEvents
Next i
'Form2.Visible = False
DoEvents
Else
Sleep 1000 '===等待相同的时间＝＝＝
keybd_event vbKeyShift, 0, KEYEVENTF_KEYUP, 0
keybd_event vbKeyShift, 0, KEYEVENTF_KEYUP, 0
End If
TrayI.hIcon = PIC(0).Picture
TrayI.szTip = Label1.Caption & Chr$(0)
Shell_NotifyIcon NIM_MODIFY, TrayI
If GetSetting("key", "U", 0, "") = "ok" Then
Dim FW As Long
FW = GetForegroundWindow
If FW <> 0 And FW <> Form2.hwnd Then
SetWindowPos FW, -2, 0, 0, 0, 0, 3: Sleep 50
End If
'A = wshshell.run("explorer.exe " & GetRemoveName(DT, K2) & ":", 3, False)
Shell "explorer.exe " & GetRemoveName(DT, K2) & ":", vbMaximizedFocus: Sleep 300
DoEvents
'SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 3
SafeOpen
Else
For i = 80 To 100
Form2.PASS.Value = i
Sleep 5
DoEvents
Next i
Form2.Visible = False
DoEvents
End If
Dis = k
DT = K2
keybd_event vbKeyShift, 0, KEYEVENTF_KEYUP, 0
ElseIf k < Dis Then '==========================拨出了可移动磁盘＝＝＝＝＝
Dim MD As String, MoveDrive As String
Frame1.Caption = "提示 检测到: " & 0 & " 个文件。"
DoEvents
MoveDrive = GetRemoveName(DT, K2)
If Len(MoveDrive) = 1 Then '====移动硬盘会出现2个以上的盘符＝＝＝＝＝
MD = Factory & " " & MoveDrive & ":"
Else
For i = 1 To Len(MoveDrive)
MD = MD & Mid(MoveDrive, i, 1) & ":  "
Next i
End If
Label1.Caption = Now & " 可移动磁盘 " & MD & " 从系统中移除 ...."
Form1.Label1.ForeColor = vbBlack
WriteLog Label1.Caption: Command1(2).Enabled = True: Command1(3).Enabled = True  '===记录＝＝＝
Frame2.Caption = "操作 已检测到：" & RecordNumber & " 条信息。"
BN(0).Enabled = False
'DrawButton BN(0), 1, "安全打开", PIC(12)
BN_Paint (0)
If Check2.Value = 1 Then '=====消息提示开关＝＝＝＝＝
DoEvents
TrayI.hIcon = PIC(1).Picture
TrayI.szTip = "可移动磁盘从系统中移除..." & Chr$(0)
Shell_NotifyIcon NIM_MODIFY, TrayI
Form2.Label1.Caption = Now & " " & MD & " 从系统中移除 ...."
SetWindowPos Form2.hwnd, -1, 0, 0, 0, 0, 3
Form2.Visible = True
For i = 1 To 100 Step 2
Form2.PASS.Value = i
Sleep 5
DoEvents
Next i
DoEvents
Form2.Visible = False
Else
TrayI.hIcon = PIC(1).Picture
TrayI.szTip = "可移动磁盘从系统中移除..." & Chr$(0)
Shell_NotifyIcon NIM_MODIFY, TrayI
Sleep 800
End If
TrayI.hIcon = PIC(3).Picture
TrayI.szTip = Label1.Caption & Chr$(0)
Shell_NotifyIcon NIM_MODIFY, TrayI
Dis = k
DT = K2
End If
SS = SS + 1
If SS > 50 Then
SS = 51
If Check5.Value = 1 Then CheckFile '===全面保护文件系统＝＝＝
'ElseIf SS < 50 Then
'If Check6.Value = 1 Then SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
End If
End Sub
Private Sub Timer2_Timer()
Label3.Caption = "已运行: " & CheckTime(CLng(DateDiff("s", Start, Now)))
DoEvents
End Sub
Sub DrawButton(PB As PictureBox, ByVal ButtonType As Integer, Tit As String, Mini As PictureBox)
'返回或设置对象内部的水平 (ScaleWidth) 或垂直 (ScaleHeight) 度量单位。
'能够使用这些属性来为绘图或打印创建一个自定义的坐标比例尺。例如，语句 ScaleHeight = 100 将改变窗体实际内部高度的度量单位。取代当前高度为 n 个单位（缇、像素、...），高度将变为 100 个自定义单位。因而，50 个单位的距离就是对象的高度/宽度的一半，101 个单位的距离将超出对象 1 个单位。
'为了定义基于标准度量单位的比例尺，例如缇、磅、像素、字符、英寸、毫米、或厘米应使用 ScaleMode 属性。
'这些属性设置为正值将使坐标从上向下及从左向右增加?它们设置为负值将使坐标从下向上及从右向左增加?
'这些属性和相关的 ScaleLeft 与 ScaleTop 属性的使用，可以建立起一个完全的带有正、负坐标的坐标系统。所有这四个 Scale 属性与 ScaleMode 属性按下面的方式进行交互作用：
'把其它任何 Scale 属性设置为任何值都将使 ScaleMode 自动地设置为 0。ScaleMode 等于 0 是用户定义。
'把 ScaleMode 设置为一个大于 0 的数，将使 ScaleHeight 和 ScaleWidth 的度量单位发生改变，并将 ScaleLeft 和 ScaleTop 设置为 0。另外，CurrentX 和 CurrentY 的设置值将发生改变以反映当前点的新坐标。
'也可以在语句中使用 Scale 方法设置 ScaleHeight、ScaleWidth、ScaleLeft 和 ScaleTop 属性。
'注意 ScaleHeight 和 ScaleWidth 属性与 Height 和 Width 属性是不一样的。
'对于 MDIForm 对象，ScaleHeight 和 ScaleWidth 仅涉及窗体中未被 PictureBox 控件覆盖的区域。在 MDIForm 的 Resize 事件中应避免使用这些属性调整 PictureBox 的大小。
'返回水平 (TwipsPerPixelX) 或垂直 (TwipsPerPixelY) 度量的对象的每一像素中的缇数。
'Windows API 例程一般需要以像素为度量单位。使用这些属性能够快速转换度量单位而不用改变对象的 ScaleMode 属性设置值
    Dim picCaption As String
    picCaption = Tit
    Dim PICx As Picture
    Dim X As Long, Y As Long, w As Integer, H As Integer
    Set PICx = Mini.Picture
    PB.ScaleMode = vbPixels '====要求以像素为单位方便API函数调用====
    w = PICx.Width / 1000 * 567 / Screen.TwipsPerPixelX
    H = PICx.Height / 1000 * 567 / Screen.TwipsPerPixelY
    X = (PB.ScaleWidth - w) / 2
    Y = (PB.ScaleHeight - H) / 2
    Y = Y * 2 / 3
    If ButtonType = 3 Then
        X = X + 1
        Y = Y + 1
    End If
    PB.Cls
    PB.PaintPicture PICx, X, Y
    w = PB.TextWidth(picCaption) '====在图片上的字符串的宽度====
    H = PB.TextHeight(picCaption)
    PB.CurrentX = (PB.ScaleWidth - w) / 2
    PB.CurrentY = (PB.ScaleHeight - H) - 5
    If ButtonType = 3 Then
        PB.CurrentX = PB.CurrentX + 1
        PB.CurrentY = PB.CurrentY + 1
    End If
    PB.Print picCaption
    Dim r As RECT
    r.Left = 0: r.Top = 0
    r.Right = PB.ScaleWidth: r.Bottom = PB.ScaleHeight
    If ButtonType = 2 Then
        DrawEdge PB.hDC, r, BDR_RAISEDINNER, BF_RECT
    ElseIf ButtonType = 3 Then
        DrawEdge PB.hDC, r, BDR_SUNKENOUTER, BF_RECT
    End If
End Sub
Function AutoPic()
Call BN_Paint(0)
End Function

						