纯抓窗体喊话..用QQ堂的那个示范 "有源码"!

ccb777

使用的是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

zest

学习一下，谢谢

oo789458

谢谢 顶个

hack0215

学习一下，谢谢

744289077

顶一个，学习学习

swing

不错。，拿来学习一下

秋风夜雪

学习一下！！！

chok2009

学习下 ~~~~~~~~~~~~~~····

anjelxia

支持 辛苦了

7515组

支持一下..