帮忙写一段不准使用某一执行文件的代码

Question

儿子游戏上瘾，不想让他玩某些游戏，所以想:1: 能上网，但不能上QQ或不能玩QQ堂游戏 
      老爷子要上网，但不上QQ，儿子只玩QQ堂游戏。
2: 开机自动运行，驻留内存或托盘显示，不能随便退出。   

Answer 1

不需要编什么程，设置"D:\Program Files\Tencent\CoralQQ.exe"访问权限即可啦。

Answer 2

呵呵, 治本治根, 楼上几位,如果他儿子玩的不是QQ的游戏, 那不就没辙了 ?'程序一进入即隐藏自动监控列表的exe, 热键Ctrl + Alt + F10 结束监控并退出
'编译的exe文件名称请注意改正为你的exe名称 Call AutoStart(appdisk & "CBMMON.exe")
'否则你无法开机自动启动
'要监控的exe列表在这里自己修整 Monlist = UCase("qq.exe,calc.exe,Notepad.exe")'********************** Form1 的代码
Option Explicit
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_SZ = 1
Private WithEvents Timer1 As Timer
Dim objWMIService, objProcess, colProcess, Tmpstr$, Monlist$
Private Sub Form_Load()
   If App.PrevInstance Then Call MsgBox("对不起本程序已在运行中, 不得重复加载!!", vbCritical, "CBM666的EXE监控"): End
   appdisk = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\")
   Monlist = UCase("qq.exe,calc.exe,Notepad.exe") '要监视的exe列表
   Set Timer1 = Controls.Add("vb.timer", "Timer1")
   Timer1.Interval = 1000 '别太短
   '****************注册热键
   RegisterHotKey Me.hWnd, &HB000, MOD_CONTROL + MOD_ALT, vbKeyF10 '定义 Ctrl + Alt + F10 为热键
   Rtnval = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf wnd)
   '****************开机自动启动
   Call AutoStart(appdisk & "CBMMON.exe")
   Me.Hide '隐藏窗口
End SubPrivate Sub Form_Unload(Cancel As Integer)
   Call UnregisterHotKey(Me.hWnd, &HB000&) '撤销热键的注册Ctrl + Alt + F10
   SetWindowLong Me.hWnd, GWL_WNDPROC, Rtnval
End SubPrivate Sub Timer1_Timer()
   Tmpstr = "."
   Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & Tmpstr & "\root\cimv2")
   Set colProcess = objWMIService.ExecQuery("SELECT * FROM Win32_Process")
   For Each objProcess In colProcess
      If InStr(Monlist, UCase(objProcess.Name)) > 0 Then objProcess.Terminate
   Next
   If Sexit Then Unload Me
End SubPublic Sub AutoStart(Exenm$)
   '不想开机自动启动就别Call这段,而且这段代码最好在另个Setup代码中加入.
   Dim Ret2&
   RegCreateKey HKEY_LOCAL_MACHINE, "software\microsoft\windows\currentVersion\run", Ret2
   RegSetValue Ret2, vbNullString, REG_SZ, Exenm, 4
   RegCloseKey Ret2
End Sub
'************************** Module1.bas 的代码
Option Explicit
Public Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4
Public Const WM_HOTKEY = &H312
Public Const GWL_WNDPROC = (-4)
Public Rtnval&, i&, jj&, fname$, appdisk$, winsys$, aa$
Global Sexit As Boolean
Public Function wnd(ByVal hWnd&, ByVal Msg&, ByVal wp&, ByVal lp&) As Long
   If Msg = WM_HOTKEY And wp = &HB000 Then Sexit = True
   wnd = CallWindowProc(Rtnval, hWnd, Msg, wp, lp)
End Function

Answer 3

要监控的exe列表在这里自己修整 Monlist = UCase("qq.exe,calc.exe,Notepad.exe") 发出去的帖无法再改, 要运行上面程序,请注意列表里面的 exe 你要改为特定的exe免得你一打开记事本就被关掉.Public Sub AutoStart(Exenm$) '不想开机自动启动就别Call这段, 测试代码时最好先标记起来别运行 AutoStart 

Answer 4

cbm666老师的方法好啊，又学到一招

Answer 5

经测试: cbm666老师的方法完全合适啊，结贴给分。