Question

限制程序运行 vb代码

让一个指定程序无法运行的VB代码

Answer 1

下面的代码一发现QQ就立马把它关闭！
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 1024
End Type
Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Dim pid As Long
Dim pname As String
Const sEndProess As String = "qq.exe" 'qq.exe是要关闭的进程名字

Private Sub Timer1_Timer()
Dim my As PROCESSENTRY32
Dim l As Long
Dim l1 As Long
Dim flag As Boolean
Dim mName As String
Dim i As Integer
l = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If l Then
my.dwSize = 1060
If (Process32First(l, my)) Then '遍历第一个进程
Do
i = InStr(1, my.szExeFile, Chr(0)) '获得映像名称
mName = LCase(Left(my.szExeFile, i - 1)) '并转换成小写
If mName = LCase(sEndProess) Then '是不是指定的程序
pid = my.th32ProcessID '获得进程ID
pname = mName
Dim mProcID As Long
mProcID = OpenProcess(1&, -1&, pid)
TerminateProcess mProcID, 0&
flag = True
Exit Sub
Else
flag = False
End If
Loop Until (Process32Next(l, my) < 1) '遍历所有进程知道返回值为False
End If
l1 = CloseHandle(l)
End If
End Sub

Answer 2

以计算器为例:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_CLOSE = &H10

Private Sub Form_Load()
Timer1.Interval = 50
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
Dim hwnd As Long
hwnd = FindWindow("SciCalc", "计算器")
If hwnd <> 0 Then SendMessage hwnd, WM_CLOSE, 0, 0
End Sub

Answer 3

参考一下病毒是怎么做的。

Answer 4

给你个思路吧：检测该程序是否运行，一旦运行就调用任务管理器强制关闭该程序也就实现了让该程序无法运行。