module1.bas

几个月前用VB做的小软件,今天把他翻出来又重新修改了一下,使其支持QQ2006,QQ2007 Beta1, 网上的流传的QQ性别修改器倒是不少,但是没看到几个公布了源代码的,其实这个软件非常简单,主

Attribute VB_Name = "Module1"
Option Explicit

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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
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 GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long


Public Const CB_GETCOUNT = &H146
Public Const CB_INSERTSTRING = &H14A

Public QQhandle As Long
Public IsActivate As Boolean

Public Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
  Dim ret As Long
  Dim stext As String
  Dim title As String
  
  stext = Space(255)
  ret = GetClassName(hwnd, stext, 255)
  title = String(GetWindowTextLength(hwnd) + 1, Chr$(0))
  GetWindowText hwnd, title, Len(title)
  If InStr(1, stext, "Static") <> 0 And InStr(1, title, "性    别:") <> 0 Then
    QQhandle = FindWindowEx(GetParent(hwnd), hwnd, "ComboBox", vbNullString)
    EnumChildProc = 0
  Else
    EnumChildProc = 1
  End If

End Function