一个Visual Basic编写的禁止教室电脑玩游戏的程序【暴力枚举法】

这是上学期写的一个小程序,可以禁止电脑玩CS等主流游戏。

没什么技术含量,原理主要是在后台每过一段时间扫描一次进程,并且终止指定程序。

在XP上正常,Win7不知。

现在公布全套lowB代码吧。Time1和2是禁止游戏的,Time3是定时换桌面的,没启用(当年开启后电脑很卡PPT都一闪一闪亮晶晶…)。

在页面下方有下载,带桌面图片的。

源代码:


Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

'Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long

Const SPI_SETDESKWALLPAPER = 20
Const SPIF_SENDWININICHANGE = &H2
Const SPIF_UPDATEINIFILE = &H1
Const REG_SZ As Long = 1
Const HKEY_CURRENT_USER = &H80000001

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long

Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long

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
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
(ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, _
ByVal fuWinIni As Long) As Long
Dim pid As Long
Dim pname As String
Dim T As Integer
Dim i As Integer

'-------------结束进程通用函数 注意进程名要区分大小写
Private Sub taskkill(ByVal taskname As String)
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$(taskname) Then
pid = my.th32ProcessID
pname = mName
'Dim mProcID As Long
'mProcID = OpenProcess(1&, -1&, pid)
'TerminateProcess mProcID, 0&
x = Shell("ntsd -c q -p " & pid)
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

Private Sub Form_Load()
App.TaskVisible = False
T = 0
i = 0
End Sub

Private Sub Timer1_Timer()
Call taskkill("cstrike.exe")
Call taskkill("NFSHP2.exe")
Call taskkill("Warcraft III.exe")
Call taskkill("Frozen Throne.exe")
Call taskkill("crossfire.exe")
Call taskkill("war3.exe")
Call taskkill("gta-vc.exe")
End Sub

Private Sub Timer2_Timer()
Call taskkill("nfs6.exe")
Call taskkill("cs1.6.exe")
Call taskkill("mshearts.exe")
Call taskkill("freecell.exe")
Call taskkill("winmine.exe")
Call taskkill("spider.exe")
Call taskkill("sol.exe")
Call taskkill("pinball.exe")
End Sub

Private Sub Timer3_Timer()
'T = T + 1
'If T > 1 And T Mod 2 = 0 Then
'Static i As Integer
'i = i Mod 2 + 1
'i = i + 1
'If i = 18 Then
'i = 1
'End If
'Dim Path As String, strSave As String
'strSave = String(50, Chr$(0))
'Path = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave)))
'Image1.Picture = LoadPicture(App.Path & "\wallpicture\" & i & ".JPG")
'SavePicture Image1, Path & "\wallpicture\" & i & ".bmp"
'Dim aa As String
'aa = Path & "\wallpicture\" & i & ".bmp"
'aa = App.Path & "\wallpicture\" & i & ".bmp"
'aaa = SystemParametersInfo(ByVal 20, vbnostring, ByVal App.Path & "\wallpicture\" & i & ".bmp", &H1) '设置墙纸
'T = 0
'End If
End Sub

 

下载VB代码

 

留下你的评论呗...

电子邮件地址不会被公开。 必填项已用*标注