纯抓窗体喊话..用QQ堂的那个示范 "有源码"!
本帖最后由 ccb777 于 2010-3-19 01:27 编辑使用的是VB语言 需要: timer控件一个textbox文本框二个 checkbox一个(可有无 如果设置 style 设置为 1 比较好) - 控件是可以随心所变的不是一定的. 模块1个
不知道这中东西能不能算原创- - 还是谢谢大家 渣技术 无技术含量....
不发源程序..就源码还是自己动下手比较好 附上现成的！ 修正下注释！
'-------------------------
'吾爱破解 By:ccb777
'www.52pojie.cn "timer 部分"
'向QQ堂喊话..指定
'转载请不要删除该讯息
'-------------------------
Private Sub Timer1_Timer()
If Text1.Text = "" Then Exit Sub
Dim x() As String
x = Split(Text1.Text, vbCrLf)
SendMsgToQQT x(uMsgCounst)
uMsgCounst = uMsgCounst + 1
If uMsgCounst > UBound(x) Then uMsgCounst = 0
End Sub
'-------------------------
'吾爱破解 By:ccb777
'www.52pojie.cn "checkbox 部分"
'向QQ堂喊话..指定
'转载请不要删除该讯息
'-------------------------
Private Sub Check1_Click()
Timer1.Interval = Val(Text2.Text) * 1000 '喊话间隔
If Check1.Value = 1 Then
Timer1.Enabled = True
Text1.Enabled = False
uMsgCounst = 0
Else
Timer1.Enabled = False
Text1.Enabled = True
End If
End Sub
'-------------------------
'吾爱破解 By:ccb777
'www.52pojie.cn "模块部分"
'向QQ堂喊话..指定
'转载请不要删除该讯息
'-------------------------
Option Explicit
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public 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
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_HOTKEY = &H312
Public Const WM_CHAR = &H102
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101'通用部分是调用按键..
Public Sub SendMsgToQQT(ByVal uMsg As String)
Dim QQThwnd As Long, i As Long, KeyCode As Long, uData() As Byte
QQThwnd = FindWindow("QQTangWinClass", "QQ堂 3.4 Beta1 Build1 ") '找到这个窗体 抓它的窗体名称..
If QQThwnd <> 0 Then '发送喊话
SendMessage QQThwnd, WM_KEYDOWN, vbKeyReturn, ByVal 0
SendMessage QQThwnd, WM_KEYUP, vbKeyReturn, ByVal 0
Sleep 50
For i = 1 To Len(uMsg)
KeyCode = Asc(Mid(uMsg, i, 1))
If KeyCode < 0 Then
uData = StrConv(Mid(uMsg, i, 1), vbFromUnicode)
PostMessage QQThwnd, WM_CHAR, uData(0), ByVal 0
PostMessage QQThwnd, WM_CHAR, uData(1), ByVal 0
Else
PostMessage QQThwnd, WM_CHAR, KeyCode, ByVal 0
End If
Next
Sleep 50
SendMessage QQThwnd, WM_KEYDOWN, vbKeyReturn, ByVal 0
SendMessage QQThwnd, WM_KEYUP, vbKeyReturn, ByVal 0
End If
End Sub 学习一下，谢谢 谢谢 顶个:victory: 学习一下，谢谢 顶一个，学习学习 不错。，拿来学习一下 学习一下！！！ 学习下 ~~~~~~~~~~~~~~···· 支持 辛苦了 支持一下..