mgetclass.bas

我自己写的查QQ在线用户的程序.本来是用来群发的.后来QQ的程序改了就不能用了.

Attribute VB_Name = "mGetClass"
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetClassName& Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long)
Public Declare Function ShowWindow& Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long)
Public Declare Function EnumWindows& Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long)
Public Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Const WM_SETTEXT = &HC

Public Const WM_CLOSE = &H10
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Public Const TCM_FIRST = &H1300
Public Const TCM_SETCURFOCUS = (TCM_FIRST + 48)
Public Const VK_SPACE = &H20
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Test1 As Boolean
Public Test2 As Boolean
Public 上页ID As Byte
Public 下页ID As Byte
Public LVCID As Byte


Public 查找窗体ID As Long

Public 上页(4) As Long
Public 下页(4) As Long
Public TabC As Long
Public 查找 As Long
Public LVC(4) As Long

Public 发送按钮ID As Long
Public 文本框ID As Long

'SendMessage 文本框ID, WM_SETTEXT, 0, ByVal "Asdf"
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) 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 mClassName() As String
Public m_Done As Boolean



Function EnumWindowsProc(ByVal hwnd As Long, ByVal parma As Long) As Long
   Dim Astr As String * 256
   GetWindowText hwnd, Astr, Len(Astr)
   If InStr(1, ThisWindowClassName(hwnd), "#32770") > 0 Then
   ReDim Preserve mClassName(UBound(mClassName) + 1) As String
   mClassName(UBound(mClassName)) = hwnd & "||" & Astr
   End If
   EnumWindowsProc = True
End Function

Function EnumClientProc(ByVal hwnd As Long, ByVal parma As Long) As Long
Dim Astr As String * 256
GetWindowText hwnd, Astr, Len(Astr)
If Left(ThisWindowClassName(hwnd), 15) = "SysTabControl32" Then
TabC = hwnd
End If


If Left(Astr, 2) = "关闭" Then Test1 = True
If Test1 = True Then
If Left(Astr, 2) = "查找" And Test1 = True Then 查找 = hwnd
End If

If Left(Astr, 2) = "上页" Then
上页(上页ID) = hwnd
上页ID = 上页ID + 1
End If


If Left(Astr, 2) = "下页" Then
下页(下页ID) = hwnd
下页ID = 下页ID + 1
End If


If Left(ThisWindowClassName(hwnd), 13) = "SysListView32" Then
LVC(LVCID) = hwnd
LVCID = LVCID + 1
End If

EnumClientProc = True
End Function
Function EnumSendMsg(ByVal hwnd As Long, ByVal parma As Long) As Long
Dim Astr As String * 256
GetWindowText hwnd, Astr, Len(Astr)
If Left(Astr, 1) = "与" And InStr(1, Astr, "会话中") > 0 Then
EnumChildWindows hwnd, AddressOf EnumCloseMsg, 0

SendMessage 文本框ID, WM_SETTEXT, 0, ByVal "我的QQ3132237我想和你做朋友"

PostMessage 发送按钮ID, WM_KEYDOWN, VK_SPACE, 0
PostMessage 发送按钮ID, WM_KEYUP, VK_SPACE, 0

PostMessage hwnd, WM_CLOSE, 0, 0

Exit Function
End If

'PostMessage hwnd, WM_CLOSE, 0, 0
EnumSendMsg = True
End Function
Function EnumCloseMsg(ByVal hwnd As Long, ByVal parma As Long) As Long
Dim Astr As String * 256
GetWindowText hwnd, Astr, Len(Astr)
If Left(Astr, 2) = "发送" Then 发送按钮ID = hwnd
If Left(ThisWindowClassName(hwnd), 8) = "RICHEDIT" Then 文本框ID = hwnd
EnumCloseMsg = True
End Function



Public Function ThisWindowClassName(ByVal m_hWnd As Long) As String
Dim RetVal As Long, lpClassName As String
    lpClassName = Space(255)
    RetVal = GetClassName(m_hWnd, lpClassName, 255)
    ThisWindowClassName = Left$(lpClassName, RetVal)
    'GetWindowText m_hWnd, ThisWindowClassName, 255
End Function