form1.frm

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

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "QQ性别修改器"
   ClientHeight    =   1755
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4395
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   1755
   ScaleWidth      =   4395
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer Timer1 
      Interval        =   1000
      Left            =   3840
      Top             =   600
   End
   Begin VB.CommandButton Command2 
      Caption         =   "帮助"
      Height          =   375
      Left            =   3480
      TabIndex        =   3
      Top             =   120
      Width           =   735
   End
   Begin VB.CommandButton Command1 
      Caption         =   "插入"
      Height          =   375
      Left            =   2520
      TabIndex        =   2
      Top             =   120
      Width           =   735
   End
   Begin VB.TextBox Text1 
      BeginProperty Font 
         Name            =   "华文行楷"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1680
      TabIndex        =   1
      Text            =   "神"
      Top             =   120
      Width           =   375
   End
   Begin VB.Label Label4 
      BackStyle       =   0  'Transparent
      Caption         =   "By 圣战☆天使           QQ：393293840     E-mail:[e-mail]      "
      Height          =   615
      Left            =   2400
      TabIndex        =   6
      Top             =   1080
      Width           =   1935
   End
   Begin VB.Label Label3 
      BackStyle       =   0  'Transparent
      Caption         =   "提示：只能插入一个中文字符(支持QQ2006和QQ2007)"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   600
      Width           =   4335
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Height          =   495
      Left            =   120
      TabIndex        =   4
      Top             =   840
      Width           =   3735
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "自定义性别:"
      BeginProperty Font 
         Name            =   "华文行楷"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   180
      Width           =   1575
   End
   Begin VB.Image Image1 
      Height          =   3000
      Left            =   0
      Picture         =   "Form1.frx":4D5A
      Top             =   -360
      Width           =   4395
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Private Sub Command1_Click()
  
  If IsActivate = False Then
    MsgBox "还没有检测到QQ设置窗口,请先打开QQ个人设置,然后继续", vbOKOnly, "还没有检测到QQ设置窗口"
    Exit Sub
  End If
  If Len(Trim(Text1.Text)) > 1 Then
    MsgBox "提示：只能插入一个中文字符,如果强行插入多个字符QQ是不认的^_^", vbOKOnly, "提示"
    Text1.Text = ""
    Exit Sub
  End If
  Dim ItemCount As Long
  Dim MySex As String
  On Error Resume Next
  MySex = Text1.Text
  SendMessage QQhandle, CB_INSERTSTRING, 0, ByVal MySex '这里一定要按值传送,如果不按值传送就会出现乱码,我在这里卡了好久,才相通的
  ItemCount = SendMessage(QQhandle, CB_GETCOUNT, 0, 0)
  If ItemCount > 2 Then
    MsgBox "插入QQ自定义性别成功~!请在QQ性别选项中选择您所设置的自定义性别并点击『应用』", vbOKOnly, "成功了~!"
  End If
  
    
    
  
  
  
  
  
End Sub

Private Sub Command2_Click()
  Dim MyMsg As String
  MyMsg = "使用帮助：" + vbCrLf + "1.首先打开QQ的『菜单』——『设置』——『个人设置』(程序会自动检测QQ的窗口)" + vbCrLf + "2.在本软件文本框中填入您要插入的自定义性别(默认为''神'')" + vbCrLf + "3.点击『插入』按钮，如果提示插入成功，您就可以QQ的性别选项框中找到您所插入的性别，接下来选中该选项并点击『应用』即可" + vbCrLf + "                 Good Luck～！   By   圣战☆天使" + vbCrLf + "                              2007－3－17   23：40"
  MsgBox MyMsg, vbOKOnly, "使用帮助  ^_^"

End Sub

Private Sub Form_Load()
  IsActivate = False
  QQhandle = 0
  Label2.Caption = "检测状态:还没有检测到QQ设置窗口,请先打开QQ个人设置,然后继续"
End Sub

Private Sub Timer1_Timer()
  Dim QQ2006 As Long  '用于保存QQ2006的句柄
  Dim QQ2007 As Long  '用于保存QQ2007 Beta1或Beta2的句柄
  Dim QQ2007B3 As Long '用于保存QQ2007 Beta3的句柄,应为QQ2007 Beta3的窗口标题不一样
  Dim StaticHandle As Long
  
  IsActivate = False
  QQhandle = 0
  
  QQ2006 = FindWindow("#32770", "QQ2006设置")
  If QQ2006 <> 0 Then EnumChildWindows QQ2006, AddressOf EnumChildProc, ByVal 0&
  
  If QQhandle <> 0 Then
    Label2.Caption = "检测状态:已经找到QQ2006设置窗口,请继续"
    IsActivate = True
    Exit Sub
  End If
  
  
  QQ2007 = FindWindow("#32770", "QQ2007设置")
  If QQ2007 <> 0 Then EnumChildWindows QQ2007, AddressOf EnumChildProc, ByVal 0&
  If QQhandle <> 0 Then
    Label2.Caption = "检测状态:已经找到QQ2007 设置窗口,请继续"
    IsActivate = True
  End If
  
  QQ2007B3 = FindWindow("#32770", "QQ2007 7.0 设置")
  If QQ2007B3 <> 0 Then EnumChildWindows QQ2007B3, AddressOf EnumChildProc, ByVal 0&
  If QQhandle <> 0 Then
    Label2.Caption = "检测状态:已经找到QQ2007  7.0 Beta3 设置窗口,请继续"
    IsActivate = True
  End If
  
  If IsActivate = False Then Label2.Caption = "检测状态:还没有检测到QQ设置窗口,请先打开QQ个人设置,然后继续"
   
End Sub