vbs脚本――检测U盘插入拨出并通过邮件报警

自己复制粘贴和修改的，很多做网管的朋友应该会用得上，里面锁定操作的小程序是自己用VB写的，很不完善，就不拿出来献丑了~~~
报警邮件内容包括电脑的IP、计算机名、域用户名

'###############################################################
'              检测U盘接入和拨出行为并触发邮件报警                        
'   同时可以锁定计算机操作，产生卡机现像，拨出U盘或15分钟后解除
'###############################################################
OnErrorResumeNext
'获取当前IP、计算机名、登录用户
strIPPattern = "((192\.168|172\.([1][6-9]|[2]\d|3[01]))(\.([2][0-4]\d|[2][5][0-5]|[01]?\d?\d)){2}|10(\.([2][0-4]\d|[2][5][0-5]|[01]?\d?\d)){3})"
Set objNet = createobject("Wscript.Network")
Set objRegExp = New RegExp
objRegExp.Pattern = strIPPattern
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set IPConfigSet = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")
For Each IPConfig in IPConfigSet
If Not IsNull(IPConfig.IPAddress) Then
For i=LBound(IPConfig.IPAddress) to UBound(IPConfig.IPAddress)
If InStr(IPConfig.Caption(i),"VMware Network") = 0 And InStr(IPConfig.Caption(i),"Microsoft") = 0 Then
If InStr(IPConfig.Caption(i),"VirtualBox") = 0 And InStr(IPConfig.Caption(i),"TAP") = 0 Then
If InStr(IPConfig.Caption(i),"169.254") = 0 And InStr(IPConfig.Caption(i),"0.0.0.0") = 0 Then
If objRegExp.Test(IPConfig.IPAddress(i)) = True Then       
IP = IPConfig.IPAddress(i)
End If
End If
End If
End If
Next
End If
Next
Hostname = objNet.ComputerName
Set oADSystemInfo = CreateObject("ADSystemInfo")
strUserDN = Replace(oADSystemInfo.UserName,"/","\/")
Set objUser = GetObject("LDAP://" & strUserDN)
User = Mid(objUser.Name,4)
 
Constf="***@163.com" '发件人邮箱
Constsmtp="smtp.163.com" 'SMTP地址
Constu="***@163.com" '发件人发件账号
Constp="***" '发件人发件密码
Constt="***@abc.com;***@abc.com" '收件人邮箱，分号隔开
Constm_in="检测到U盘接入" '邮件主题
Constm_out="检测到U盘拨出" '邮件主题
'Constj="附件地址"'需要发送附件则反注释掉此行
DimobjShell,objWMIService,msg
msg="IP地址:"&IP&vbCrLf&"计算机名:"&Hostname&vbCrLf&"用户名:"&User '邮件内容
NameSpace="http://schemas.microsoft.com/cdo/configuration/"
SetobjShell=CreateObject("Wscript.Shell")
Setfs=wscript.createobject("scripting.filesystemobject")
setwfolder=fs.getspecialfolder(0)
 
'将锁定操作.exe从共享复制到d盘根目录下，默认关闭了
'fs.copyfile"\\192.168.0.8\工具软件\锁定操作.exe","d:\",true
 
'每10秒循环检测U盘接入
strComputer="."
SetobjWMIService=GetObject("winmgmts:\\"&strComputer&"\root\cimv2")
SetcolEvents=objWMIService.ExecNotificationQuery_
("Select*From__InstanceOperationEventWithin10Where"_
&"TargetInstanceisa'Win32_LogicalDisk'")
 
'接入与拨出都会发送邮件
DoWhileTrue
SetobjEvent=colEvents.NextEvent
IfobjEvent.TargetInstance.DriveType=2Then
SelectCaseobjEvent.Path_.Class
Case"__InstanceCreationEvent"
SetEmail=createObject("CDO.Message")
Email.From=f
Email.To=t
Email.Subject=m_in
Email.Textbody=msg
'Email.AddAttachmentj'需要发送附件则反注释掉此行
WithEmail.Configuration.Fields
.Item(NameSpace&"sendusing")=2
.Item(NameSpace&"smtpserver")=smtp
.Item(NameSpace&"smtpserverport")=25
.Item(NameSpace&"smtpauthenticate")=1
.Item(NameSpace&"sendusername")=u
.Item(NameSpace&"sendpassword")=p
.update
EndWith
Email.Send
 
'运行d:\锁定操作.exe，默认关闭
'objShell.Run"d:\锁定操作.exe"
 
Case"__InstanceDeletionEvent"
SetEmail=createObject("CDO.Message")
Email.From=f
Email.To=t
Email.Subject=m_out
Email.Textbody=msg
'Email.AddAttachmentj'需要发送附件则反注释掉此行
WithEmail.Configuration.Fields
.Item(NameSpace&"sendusing")=2
.Item(NameSpace&"smtpserver")=smtp
.Item(NameSpace&"smtpserverport")=25
.Item(NameSpace&"smtpauthenticate")=1
.Item(NameSpace&"sendusername")=u
.Item(NameSpace&"sendpassword")=p
.update
EndWith
Email.Send
 
'拨出U盘后杀死锁定操作.exe进程，恢复电脑操作
SetobjWMIService=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
SetarrProcesses=objWMIService.ExecQuery("select*fromwin32_processwhereName='锁定操作.exe'")
ForEachproccessInarrProcesses
proccess.Terminate0
Next
 
EndSelect
EndIf
Loop