Dim scriptPath,lenRootPath,listFilePath
Dim sCheck
scriptPath=WScript.ScriptFullName
lenRootPath=Left(scriptPath,InStrRev(scriptPath,"\"))
listFilePath=lenRootPath & "list.txt" '设置进程黑名单文件名称
sCheck=10 '设定间隔多少秒钟扫描一次进程
Do
Call CheckList(listFilePath)
WScript.Sleep sCheck*1000
Loop
Sub CheckList(listFilePath)
On Error Resume Next
Dim Fso,listFile
Dim KeyWord,processKey,pathKey,TipStr
Set Fso=CreateObject("Scripting.FileSystemObject")
If Fso.FileExists(listFilePath) Then
Set listFile=Fso.OpenTextFile(listFilePath,1,0)
Do While Not listFile.AtEndOfStream
KeyWord=listFile.ReadLine
If KeyWord<>"" And Left(KeyWord,1)<>"'" Then
KeyWord=Split(KeyWord,"|")
If UBound(KeyWord)>1 Then
processKey=Trim(KeyWord(0))
pathKey=Trim(KeyWord(1))
Tipstr=Trim(KeyWord(2))
Call ProcessKiller(processKey,TipStr)
If pathKey<>"" Then Call ProcessKiller(pathKey,TipStr)
End If
End If
If Err Then Err.Clear
Loop
Set listFile=Nothing
Else
WScript.Quit
End If
Set Fso=Nothing
End Sub
Sub ProcessKiller(callstr,Tstr)
On Error Resume Next
Dim WMI,objProcess,Process
Dim MsgStr
Dim isKilled
isKilled=False
Set WMI=GetObject("WinMgmts:")
Set Process=WMI.InstancesOf("Win32_Process")
For Each objProcess In Process
If InStr(callstr,".")>0 Then
If objProcess.name=callstr Then
objProcess.Terminate
isKilled=True
End If
Else
If InStr(objProcess.ExecutablePath,callstr)>0 Then
objProcess.Terminate
isKilled=True
End If
End If
If Err Then Err.Clear
Next
Set Process=Nothing
Set WMI=Nothing
MsgStr="对不起,为了营造一个良好的网络环境,本网吧禁止运行以下程序:" & vbCrLf & vbCrLf
MsgStr=MsgStr & " - " & Tstr & vbCrLf & vbCrLf & "敬请广大顾客朋友理解并配合,谢谢!"
If isKilled=True Then MsgBox MsgStr
End Sub