我的QQ只有我能登陆

作者：JiaJia [YuLv]
起因

最近本人的爱机放在宿舍老有人用来聊QQ，一聊就没完没，占着偶的机子让我没法学习。弄得我实在没办法了，正好我最近在整QQ的文件，找到一个方法能让自己爱机上的QQ只有自己的能登陆，这样一来就可以忽悠一下室友了。为了方便。我用VB6写了一个简单的工具，下面就来跟大家分享一下吧！

解决

在QQ的安装目录下有一个文件“WizardCtrl.dll”动态链接库文件，将该文件删除、改名或者移动到其他的目录中。此后，你会发现在QQ登录对话框中输入未出现在列表中的QQ号码时，点击“登录”按键后，QQ程序就会自动消失，看看进程管理中也是没有QQ.exe，说明它已经自己结束了！但是之前已登陆过的QQ，在号码下拉栏中有的QQ号，这些就可以顺利的登陆了。这说明，我们只要事先把我们的QQ号登陆过，其他的号码删除就可以了。
知道了这个方法之后就好办了。为了步骤简易化，我们尝试用编程实现。这里我选择的是将“WizardCtrl.dll”动态链接库文件改名的方法，接下来我们打开VB6，一起来把这个小工具写出来吧！不废话了，开始进入主题，界面如图1。

图1（略|就一个command按钮控件）

代码以及解释如下：
'打开一个系统注册表中现有的项
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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
'获取系统注册表中一个项的值
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

'定义读取注册表时要用到的变量
Dim lBuffer As Long
Dim sBuffer As String
Dim hKey As Long
Dim lType As Long

'通过注册表读取QQ安装目录
Public Function GetQQPathValue(sValue As String) As Long
'定义变量 rtn 存放键位
Dim rtn As Long

rtn = RegOpenKeyEx(&H80000002, "Software\TENCENT\QQ", 0, &H20000 Or &H1& Or &H8& Or &H10&, hKey)

'判断该项是否存在。
If rtn <> 0& Then
'不存在
GetQQPathValue = rtn
'不存在则给 sValue 变量赋值，方便后面做判断。
sValue = "Not Path"
'退出过程
Exit Function
End If

GetQQPathValue = RegQueryValueEx(hKey, "Install", 0, lType, ByVal 0, lBuffer)
lBuffer = 255
sBuffer = Space(lBuffer)
GetQQPathValue = RegQueryValueEx(hKey, "Install", 0, lType, ByVal sBuffer, lBuffer)

'取得QQ安装目录
sValue = Left(sBuffer, InStr(sBuffer, Chr(0)) - 1)

'关闭 hKey 键
RegCloseKey hKey
End Function

Private Sub Command1_Click()
'定义变量 strQQPath ，用来存放QQ安装目录。
Dim strQQPath As String

'读取QQ安装目录，并且赋予变量 strQQPath 。
GetQQPathValue strQQPath
Debug.Print strQQPath

'当未安装QQ时提示用户。
If strQQPath = "Not Path" Then
MsgBox "本机未安装QQ，或未找到QQ安装目录。", vbExclamation, "提示"
End If

'判断 WizardCtrl.dll 文件是否存在。
If Dir(strQQPath & "WizardCtrl.dll", vbNormal) <> "" Then
'改名实现锁定QQ只有自己能登陆
Name strQQPath & "WizardCtrl.dll" As strQQPath & "WizardCtrl.dll.bak"
Command1.Caption = "解锁QQ任何人都可以登陆"
ElseIf Dir(strQQPath & "WizardCtrl.dll.bak", vbNormal) <> "" Then
'还原
Name strQQPath & "WizardCtrl.dll.bak" As strQQPath & "WizardCtrl.dll"
Command1.Caption = "锁定QQ只有自己能登陆"
End If
End Sub

好了，这样我们的这个小工具就完成了。代码中主要应用到了系统的API实现读取注册表项取得QQ安装路径的方法，还用到了Name…As…改文件名或文件夹名的基本语句来实现。大家也可以尝试的用别的方法去实现，这里我就不多写了。

写在最后

这个禁止别人在自己的爱机上登录他们QQ的方法比较简单，以前也有介绍过，我只是做了一个扩展，写成小工具。

去学习了