VB做QQ游戏刷屏器问题

'用我这个代码一定可以，不明白的百度HI我
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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 GetWindow Lib "user32" (ByVal Hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal Hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal Hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_SETTEXT = &HC

Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5

Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101

Dim A() As Long '定义数组

Private Sub Command1_Click()
Temp = True
Dim Ai As Integer
Dim Ak As Integer

Dim Hwnd As Long, l As Long
Dim s As String, T As String
List1.Clear
Hwnd = GetDesktopWindow()

Hwnd = GetWindow(Hwnd, GW_CHILD Or GW_HWNDFIRST)

While Hwnd <> 0
Hwnd = GetWindow(Hwnd, GW_HWNDNEXT)
s = String(256, Chr(0))
GetClassName Hwnd, s, 255
s = Replace(s, Chr(0), "")

T = String(256, Chr(0))
GetWindowText Hwnd, T, 255
T = Replace(T, Chr(0), "")
DoEvents
If Right(s, 11) = "8:10011:0:0" And Left(s, 4) = "Afx:" And T = "QQ游戏" Then '要匹配的窗口类名
EnumAllHandles Hwnd '枚举所有子控件/窗口
End If
Wend

If List1.ListCount > 0 Then
ReDim A(0 To List1.ListCount - 1) As Long
Dim i As Integer
For i = 0 To UBound(A)
A(i) = Val(Mid(List1.List(i), 4))
T = Mid(List1.List(i), InStr(List1.List(i), "父句柄类型") + 6)
T = Left(T, 8)
If T <> "ComboBox" Then
A(i) = 0
End If
Next i
Else
Temp = False
MsgBox "未找到游戏窗口", vbCritical, "错误"
Exit Sub
End If

If List1.ListCount > 0 Then
For i = 0 To UBound(A)
If A(i) <> 0 Then
l = SendMessage(A(i), WM_SETTEXT, 0, "aaaaaa" & Chr(0))
Sleep 10
DoEvents
l = PostMessage(A(i), WM_KEYDOWN, vbKeyReturn, 0)
Sleep 10
DoEvents
l = PostMessage(A(i), WM_KEYUP, vbKeyReturn, 0)
Sleep 10
DoEvents
End If
Next i
End If

End Sub

Private Sub EnumAllHandles(ByVal Hwnd As Long)
Dim hn As Long
Dim firsthd As Long
Dim s As String, T As String
firsthd = GetWindow(Hwnd, GW_CHILD)
firsthd = GetWindow(firsthd, GW_HWNDFIRST)

hn = firsthd
Do While hn <> 0
s = String(256, Chr(0))
GetClassName hn, s, 255
s = Replace(s, Chr(0), "")
T = String(256, Chr(0))
GetClassName Hwnd, T, 255
T = Replace(T, Chr(0), "")
DoEvents
If s = "Edit" Then '符合条件就加入到list里
List1.AddItem "句柄:" & hn & " 父句柄:" & Hwnd & " 类名:" & s & "父句柄类型:" & T & vbCrLf
End If
EnumAllHandles hn '递归查找，不放过子控件

hn = GetWindow(hn, GW_HWNDNEXT)
If hn = firsthd Then Exit Do
Loop
End Sub

Private Sub Command2_Click()

End Sub

这个没戏的，游戏都屏蔽了这类API，这种模拟键盘方式是不行的，建议尝试写驱动，可以到网上查相关资料