发信人: wuchunlei()
整理人: (2000-07-16 11:30:25), 站内信件
|
使用vb6制作限制计算机系统的程序(转载请著名作者)
作者:wuchunlei
您是不是曾遇到过这样头疼的事,在你早上起床打开计算机准备工作时,却发
现显示器上出现了一个有"致命的错误出现在xxx,请重新安装系统或与软件供应商
联系!"这样一行字样的对话框, 当你你莫名其妙的按下确定按钮以后,有趣的事请
发生了.只见你的显示器伴出现了一排又一派乱七八糟的字符,紧接着是PC喇叭和
硬盘肆无忌惮的狂叫,在往下就是蓝屏,死机,瘫痪,爆炸,地球毁灭..........过后
,剩下的只有不知所措的你和一堆卖破烂的都不会要废铁. 为什麽会这样呢?你破
坏了几十万个脑细胞后终于想到了,原来是昨天你的那位同学干的好事, 你的那位
同学昨天坐在你的电脑前,东点点这个,西按按那个.把你的隐私看了个够不说,还
把你的系统搞的一榻糊涂. 你一定不希望上面的事情发生在你身上吧,于是你就去
卖那些动不动就X百元的软件(盗版的另说),弄得"倾家荡产". 那你为什麽不试试
自己动手编一个限制WIN9X系统的程序呢!如果你想试试,那麽就继续往下看吧,你
不一定要学过VB,甚至不一定要学过编程,只要你按着下面讲的一步一步作,你就可
以学会.
在编写程序之前,我们需要知道一点.在WIN9X系统中有三个重要的文件,他们分别
是:USER.DAT、SYSTEM.DAT和REGEDIT.EXE。这三个文件组成了WIN9X的心脏---注
册表，WIN98中的大多数设置保存在SYSTEM.DAT中，可这是个二进制文件，编辑它
是几乎是不可能的，不过WIN9X的设计人员为了方便用户对注册表进行修改，为用
户编写了一个注册表编辑程序，这个程序就是REGEDIT.EXE。有了这个程序我们就
可以方便的对注册表进行修改了。我们要做的就是要通过VB编写程序来修改注册
表以达到限制系统的目的。也许有人会问："既然可以直接修改注册表，我们为什
麽还要舍近求远去用VB编程实现？"因为,限制注册表的主要原理就是修改注册表
，如果注册表不被禁止使用，我们还要限制它何用？如果禁止了注册表的使用，
那连管理员自己也无法使用注册表，系统启不是无法恢复了（其实也可以恢复，
但不是一般用户做得到的）。
好了，知道了上面的那些内容。我们就开始着手编程序了。
第一步：创建新的工程。
打开VB6，新建一个"标准EXE"，将名称改为"FRMREG"（原来是FORM1），在将CAP
TION属性设为："禁止系统程序"。
第二步：调用API函数，再这一步中你不必明白什麽是API，也不必明白下面代码
的作用，只需按说明一步一步去做即可，我尽量说明。
2．1 在菜单栏的"工程"菜单中点击"创建模块"命令
2．2 将"模块"命名为MDLREGISTRY
2．3 将下面的代码原封不动的粘贴到MDLREGISTRY模块中。
Type FILETIME
lLowDateTime As Long
lHighDateTime As Long
End Type
Global Const HKEY_CURRENT_USER = &H80000001
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA"
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Lon
g, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) A
s Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA"
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As
Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA"
(ByVal hKey As Long, ByVal lpSubKey As String) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryVal
ueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReser
ved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long)
As Long
Declare Function RegQueryValueExA Lib "advapi32.dll" (ByVal hKey As Lo
ng, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As L
ong, ByRef lpData As Long, lpcbData As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueEx
A" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As
Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As L
ong) As Long
Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long
, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As
Long, ByRef lpData As Long, ByVal cbData As Long) As Long
Declare Function RegSetValueExB Lib "advapi32.dll" Alias "RegSetValueE
xA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved A
s Long, ByVal dwType As Long, ByRef lpData As Byte, ByVal cbData As Lo
ng) As Long
Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "Reg
DeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)
Const ERROR_SUCCESS = 0&
Const ERROR_BADDB = 1009&
Const ERROR_BADKEY = 1010&
Const ERROR_CANTOPEN = 1011&
Const ERROR_CANTREAD = 1012&
Const ERROR_CANTWRITE = 1013&
Const ERROR_OUTOFMEMORY = 14&
Const ERROR_INVALID_PARAMETER = 87&
Const ERROR_ACCESS_DENIED = 5&
Const ERROR_NO_MORE_ITEMS = 259&
Const ERROR_MORE_DATA = 234&
Const REG_NONE = 0&
Const REG_SZ = 1&
Const REG_EXPAND_SZ = 2&
Const REG_BINARY = 3&
Const REG_DWORD = 4&
Const REG_DWORD_LITTLE_ENDIAN = 4&
Const REG_DWORD_BIG_ENDIAN = 5&
Const REG_LINK = 6&
Const REG_MULTI_SZ = 7&
Const REG_RESOURCE_LIST = 8&
Const REG_FULL_RESOURCE_DESCRIPTOR = 9&
Const REG_RESOURCE_REQUIREMENTS_LIST = 10&
Const KEY_QUERY_VALUE = &H1&
Const KEY_SET_VALUE = &H2&
Const KEY_CREATE_SUB_KEY = &H4&
Const KEY_ENUMERATE_SUB_KEYS = &H8&
Const KEY_NOTIFY = &H10&
Const KEY_CREATE_LINK = &H20&
Const READ_CONTROL = &H20000
Const WRITE_DAC = &H40000
Const WRITE_OWNER = &H80000
Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const STANDARD_RIGHTS_READ = READ_CONTROL
Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL
Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMER
ATE_SUB_KEYS Or KEY_NOTIFY
Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE
_SUB_KEY
Const KEY_EXECUTE = KEY_READ
Dim hKey As Long, MainKeyHandle As Long
Dim rtn As Long, lBuffer As Long, sBuffer As String
Dim lBufferSize As Long
Dim lDataSize As Long
Dim ByteArray() As Byte
'This constant determins wether or not to display error messages to th
e
'user. I have set the default value to False as an error message can a
nd
'does become irritating after a while. Turn this value to true if you
want
'to debug your programming code when reading and writing to your syste
m
'registry, as any errors will be displayed in a message box.
Const DisplayErrorMsg = False
Function SetDWORDValue(SubKey As String, Entry As String, Value As Lon
g)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_WRITE, hKey) 'open
the key
If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
rtn = RegSetValueExA(hKey, Entry, 0, REG_DWORD, Value, 4) 'write
the value
If Not rtn = ERROR_SUCCESS Then 'if there was an error writtin
g the value
If DisplayErrorMsg = True Then 'if the user want errors displ
ayed
MsgBox ErrorMsg(rtn) 'display the error
End If
End If
rtn = RegCloseKey(hKey) 'close the key
Else 'if there was an error opening the key
If DisplayErrorMsg = True Then 'if the user want errors displaye
d
MsgBox ErrorMsg(rtn) 'display the error
End If
End If
End If
End Function
Function GetDWORDValue(SubKey As String, Entry As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_READ, hKey) 'open
the key
If rtn = ERROR_SUCCESS Then 'if the key could be opened then
rtn = RegQueryValueExA(hKey, Entry, 0, REG_DWORD, lBuffer, 4) 'g
et the value from the registry
If rtn = ERROR_SUCCESS Then 'if the value could be retreived the
n
rtn = RegCloseKey(hKey) 'close the key
GetDWORDValue = lBuffer 'return the value
Else 'otherwise, if the value couldnt be
retreived
GetDWORDValue = "Error" 'return Error to the user
If DisplayErrorMsg = True Then 'if the user wants errors disp
layed
MsgBox ErrorMsg(rtn) 'tell the user what was wrong
End If
End If
Else 'otherwise, if the key couldnt be opened
GetDWORDValue = "Error" 'return Error to the user
If DisplayErrorMsg = True Then 'if the user wants errors display
ed
MsgBox ErrorMsg(rtn) 'tell the user what was wrong
End If
End If
End If
End Function
Function SetBinaryValue(SubKey As String, Entry As String, Value As St
ring)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_WRITE, hKey) 'open
the key
If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
lDataSize = Len(Value)
ReDim ByteArray(lDataSize)
For i = 1 To lDataSize
ByteArray(i) = Asc(Mid$(Value, i, 1))
Next
rtn = RegSetValueExB(hKey, Entry, 0, REG_BINARY, ByteArray(1), l
DataSize) 'write the value
If Not rtn = ERROR_SUCCESS Then 'if the was an error writting
the value
If DisplayErrorMsg = True Then 'if the user want errors displ
ayed
MsgBox ErrorMsg(rtn) 'display the error
End If
End If
rtn = RegCloseKey(hKey) 'close the key
Else 'if there was an error opening the key
If DisplayErrorMsg = True Then 'if the user wants errors display
ed
MsgBox ErrorMsg(rtn) 'display the error
End If
End If
End If
End Function
Function GetBinaryValue(SubKey As String, Entry As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_READ, hKey) 'open
the key
If rtn = ERROR_SUCCESS Then 'if the key could be opened
lBufferSize = 1
rtn = RegQueryValueEx(hKey, Entry, 0, REG_BINARY, 0, lBufferSize
) 'get the value from the registry
sBuffer = Space(lBufferSize)
rtn = RegQueryValueEx(hKey, Entry, 0, REG_BINARY, sBuffer, lBuff
erSize) 'get the value from the registry
If rtn = ERROR_SUCCESS Then 'if the value could be retreived the
n
rtn = RegCloseKey(hKey) 'close the key
GetBinaryValue = sBuffer 'return the value to the user
Else 'otherwise, if the value couldnt be
retreived
GetBinaryValue = "Error" 'return Error to the user
If DisplayErrorMsg = True Then 'if the user wants to errors d
isplayed
MsgBox ErrorMsg(rtn) 'display the error to the user
End If
End If
Else 'otherwise, if the key couldnt be opened
GetBinaryValue = "Error" 'return Error to the user
If DisplayErrorMsg = True Then 'if the user wants to errors disp
layed
MsgBox ErrorMsg(rtn) 'display the error to the user
End If
End If
End If
End Function
Function DeleteKey(Keyname As String)
Call ParseKey(Keyname, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, Keyname, 0, KEY_WRITE, hKey) 'ope
n the key
If rtn = ERROR_SUCCESS Then 'if the key could be opened then
rtn = RegDeleteKey(hKey, Keyname) 'delete the key
rtn = RegCloseKey(hKey) 'close the key
End If
End If
End Function
Function GetMainKeyHandle(MainKeyName As String) As Long
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_DYN_DATA = &H80000006
Select Case MainKeyName
Case "HKEY_CLASSES_ROOT"
GetMainKeyHandle = HKEY_CLASSES_ROOT
Case "HKEY_CURRENT_USER"
GetMainKeyHandle = HKEY_CURRENT_USER
Case "HKEY_LOCAL_MACHINE"
GetMainKeyHandle = HKEY_LOCAL_MACHINE
Case "HKEY_USERS"
GetMainKeyHandle = HKEY_USERS
Case "HKEY_PERFORMANCE_DATA"
GetMainKeyHandle = HKEY_PERFORMANCE_DATA
Case "HKEY_CURRENT_CONFIG"
GetMainKeyHandle = HKEY_CURRENT_CONFIG
Case "HKEY_DYN_DATA"
GetMainKeyHandle = HKEY_DYN_DATA
End Select
End Function
Function ErrorMsg(lErrorCode As Long) As String
'If an error does accurr, and the user wants error messages displayed,
then
'display one of the following error messages
Select Case lErrorCode
Case 1009, 1015
GetErrorMsg = "The Registry Database is corrupt!"
Case 2, 1010
GetErrorMsg = "Bad Key Name"
Case 1011
GetErrorMsg = "Can't Open Key"
Case 4, 1012
GetErrorMsg = "Can't Read Key"
Case 5
GetErrorMsg = "Access to this key is denied"
Case 1013
GetErrorMsg = "Can't Write Key"
Case 8, 14
GetErrorMsg = "Out of memory"
Case 87
GetErrorMsg = "Invalid Parameter"
Case 234
GetErrorMsg = "There is more data than the buffer has been
allocated to hold."
Case Else
GetErrorMsg = "Undefined Error Code: " & Str$(lErrorCode)
End Select
End Function
Function GetStringValue(SubKey As String, Entry As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_READ, hKey) 'open
the key
If rtn = ERROR_SUCCESS Then 'if the key could be opened then
sBuffer = Space(255) 'make a buffer
lBufferSize = Len(sBuffer)
rtn = RegQueryValueEx(hKey, Entry, 0, REG_SZ, sBuffer, lBufferSi
ze) 'get the value from the registry
If rtn = ERROR_SUCCESS Then 'if the value could be retreived the
n
rtn = RegCloseKey(hKey) 'close the key
sBuffer = Trim(sBuffer)
GetStringValue = Left(sBuffer, Len(sBuffer) - 1) 'return the
value to the user
Else 'otherwise, if the value couldnt be
retreived
GetStringValue = "Error" 'return Error to the user
If DisplayErrorMsg = True Then 'if the user wants errors disp
layed then
MsgBox ErrorMsg(rtn) 'tell the user what was wrong
End If
End If
Else 'otherwise, if the key couldnt be opened
GetStringValue = "Error" 'return Error to the user
If DisplayErrorMsg = True Then 'if the user wants errors display
ed then
MsgBox ErrorMsg(rtn) 'tell the user what was wrong
End If
End If
End If
End Function
Private Sub ParseKey(Keyname As String, Keyhandle As Long)
rtn = InStr(Keyname, "\") 'return if "\" is contained in the Keyname
If Left(Keyname, 5) <> "HKEY_" Or Right(Keyname, 1) = "\" Then 'if the
is a "\" at the end of the Keyname then
MsgBox "Incorrect Format:" + Chr(10) + Chr(10) + Keyname 'display e
rror to the user
Exit Sub 'exit the procedure
ElseIf rtn = 0 Then 'if the Keyname contains no "\"
Keyhandle = GetMainKeyHandle(Keyname)
Keyname = "" 'leave Keyname blank
Else 'otherwise, Keyname contains "\"
Keyhandle = GetMainKeyHandle(Left(Keyname, rtn - 1)) 'seperate the
Keyname
Keyname = Right(Keyname, Len(Keyname) - rtn)
End If
End Sub
Function CreateKey(SubKey As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegCreateKey(MainKeyHandle, SubKey, hKey) 'create the key
If rtn = ERROR_SUCCESS Then 'if the key was created then
rtn = RegCloseKey(hKey) 'close the key
End If
End If
End Function
Function SetStringValue(SubKey As String, Entry As String, Value As St
ring)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_WRITE, hKey) 'open
the key
If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
rtn = RegSetValueEx(hKey, Entry, 0, REG_SZ, ByVal Value, Len(Val
ue)) 'write the value
If Not rtn = ERROR_SUCCESS Then 'if there was an error writtin
g the value
If DisplayErrorMsg = True Then 'if the user wants errors disp
layed
MsgBox ErrorMsg(rtn) 'display the error
End If
End If
rtn = RegCloseKey(hKey) 'close the key
Else 'if there was an error opening the key
If DisplayErrorMsg = True Then 'if the user wants errors display
ed
MsgBox ErrorMsg(rtn) 'display the error
End If
End If
End If
End Function
Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String
, sValueName As String)
Dim lRetVal As Long
Dim hKey As Long
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACC
ESS, hKey)
lRetVal = RegDeleteValue(hKey, sValueName)
RegCloseKey (hKey)
End Function
OK，到现在为止模块部分就编写完毕了，怎麽样比喝咖啡还简单吧！下面我们开
始编写界面和代码部分。
第三步.添加控件编写程序代码
3.1 还记得我们在第一步时设置好的窗体吗,请在这个窗体上添加两个"commandb
utton"控件,并分别将其名称改为:CMDREG和CMDRES
3.2 双击CMDREG按钮出现代码编辑窗口,在代码编辑窗口中输入以下代码:
Private Sub CMDREG_Click()
SETDWORDVALUE "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVer
sion\Po licies\Explorer", "RestrictRun",1 '禁止使用所有文件
CREATEKEY "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion
\Policies\Explorer\RestrictRun"
SETSTRINGVALUE "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVe
rsion\Po licies\Explorer\RestrictRun " HKEY_CURRENT_USER\Software\Micr
osoft\Windows\CurrentVersion\Po licies\Explorer\RestrictRun","1","JZ..
EXE" '将JZ.EXE列为第一个可执行项,不必写路径.(这一行代码一定
要写)
SETSTRINGVALUE "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVe
rsion\Po licies\Explorer\RestrictRun " HKEY_CURRENT_USER\Software\Micr
osoft\Windows\CurrentVersion\Po licies\Explorer\RestrictRun","2","REGE
DIT.EXE" '把注册表编辑器列为第二个可执行项, 其中"REGEDIT.EXE"
可以换成任何可执行文件
SETSTRINGVALUE "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentV
ersion\Po licies\Explorer\RestrictRun " HKEY_CURRENT_USER\Software\Mic
rosoft\Windows\CurrentVersion\Po licies\Explorer\RestrictRun","3"," EX
PLORER.EXE" '将资源管理其列为第三个可执行项,下面以此类推.
End Sub
好了,起劲之作用的按钮CMDREG就编写完毕了.先别忙运行,下面我们来编写解除注
册表设置的按钮CMDRES.
3.3 首先还是先双击CMDRES按钮进入到代码编辑窗口, 在代码编辑窗口中输入以
下代码
Private Sub CMDRES_Click()
DELETEVALUE HKEY_CURRENT_USER," Software\Microsoft\Windows\CurrentVer
sion\Po licies\Explorer\RestrictRun " HKEY_CURRENT_USER\Software\Micro
soft\Windows\CurrentVersion\Po licies\Explorer", "RestrictRuN"
'删除键值RESTRICTRUN
DELETEKEY "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion
\Po licies\Explorer\RestrictRun " HKEY_CURRENT_USER\Software\Microsoft
\Windows\CurrentVersion\Po licies\Explorer\RestrictRun"
'删除主键RESTRICTRUN
End Sub
3.4 恢复按钮也编写完毕了,下面我们将把他编译成为可执行文件,请选择菜单栏
中的"文件"---"生成工程1.EXE",在弹出的对话框的"保存在"那栏中选中"C:"再在
下面的列表框中选择" My Documents",最后在"文件名"那栏中添入"JZ.EXE"(如果
这了改了文件名,那麽一定要在CMDREG中的代码也改为同样的文件名,否则将无法
运行.).
好了,运行一下试试吧!是不是很爽.什麽?你说系统无法恢复禁止状态,拜
托您要先重启计算机才会恢复!
这样还是没什麽意义,因为JZ.EXE这个文件谁都可以运行,所也我们需要
为它设置一个密码!
第四步.设置密码
打开我们刚刚编写的源程序,双击FRMREG窗口到代码编辑窗口,将下列代
码输入到编辑窗口中即可实现简单的密码设置.
Private Sub FORM_Load()
DIM SPASSWORD AS STRING
SPASSWORD=INPUTBOX("请输入密码:","密码确认")
IF SPASSWORD〈〉"XXXXXX" THEN EXIT SUB '其中把XXXXXX替换成你想
要的密码!
End Sub
在重复3.4步生成JZ.EXE文件即可.到此为止,这个程序就编制完成了,快向朋友们
吹嘘一番吧!
(注:模块MDLREGISTRY中的函数,可以进行注册表主键的添加、删除，字符串、BI
NARY、DWORD的建立、获取、删除操作。有兴趣的朋友不妨试一试。)
--
※ 来源:．月光软件站 http://www.moon-soft.com．[FROM: 210.74.173.30]
|
|