一个QQ隐蔽聊天的软件，用于你在办公室QQ聊天又不想让其他人知道

关注

原创最新推荐文章于 2026-10-22 14:12:14 发布 7k 阅读 AI 写同款· GEO 优化 ›

[原创]FavChat爱聊全能隐蔽穿透型聊天平台完整源码源程序包(Hedda) 特点：- 开源诚交志友、任您扩展- 文本语音让您“爱上”聊- 隐蔽型设计、老板键支持- 无视防火墙局域网关障碍- 线程运用及周全的缓冲架构- XML/XSL呈现技术浏览地址：http://www.favnet.cn/Exhibition.aspx?OriginalKeyword=&OriginalPageIndex=0&OriginalPageSize=7&OriginalId=20080423075449842429■ “FavChat 爱聊”平台分为客户端(Windows Application)和服务端(Web Service)两部分，两者采用当前时尚的HTTP/SOAP协议进行通讯，服务器端采用特殊数据结构作为数据的交换媒介，由客户端收集客户操作请求主动连接服务器发送和接受数据来完成事务流程。由于自身技术和协议的优势，基本上可以无视防火墙和局域网关障碍，唯一前提是您具备一个支持服务器端Web Service运行的空间。■ 考虑FavChat实际工作中的计算机因素和网络延迟，平台充分地利用线程并发运作和多阶段队列缓冲机制，保证事务处理的顺畅和聊天过程中最重要的全双工能力的完美实现。（参考附件流程图）■ 语音部分则使用当前比较流行的DirectX技术实现。由于该领域网上的资料不多，所以我也是在不断的试验和摸索中找到门路，已封装好的Recorder(录音机)和Player(播放器)类，理应有比较大的参考学习和应用价值。■ 本平台的设计初衷其实是为方便我和妻子日常交流，大型企业里一般都限制即时通讯软件的使用，于是我运用所学开发了具备一定隐蔽性和系统热键功能的私人聊天工具，加上通用型的HTTP协议和XML节点内的密码验证，即使有上网记录也难查出是在干啥米 ^_^ 与爱人聊，会让您越来越“爱聊”哦，客户端通过修改本地配置参数还可以轻易实现个性化的多方畅聊……■ XML也是不得不说的一块，Web Service通讯和本地消息框的呈现，都使用了相关的处理方法。可以说XML是当代程序里不可或缺的一项重要通用技术。FavChat作为开源项目，作者仅在FavNet.cn（附件）和优快云网站原创发布，其它网站皆为转载，您可以下载源程序参考或进行自由扩展，但请尊重分享，尊重开源，保留作者的版权信息或注明来源。项目使用Visual Studio 2008基于.NET Framework 2.0兼容模式开发，您若使用Visual Studio 2005打开，在编译时会出现错误（少量无法识别的C#3.0语法），您可能有必要修改少量非核心代码即可解决。另外，您还需要安装微软 DirectX End-User Runtimes(March 2008)以获得对Microsoft.DirectX和Microsoft.DirectX.DirectSound命名空间的支持。如果您是志同道合的朋友，可以给我来信(HeddaZ@live.com)交流，亦很乐意提供底层的Source互相学习探讨。本程序不尽完善，还请各位同僚前辈指教……谢谢！程序采用WinRAR压缩打包-----------FavNet.cn 专勤致精想您所思专业IT技术服务http://www.FavNet.cn展示技术实力，寻求合作伙伴、合作项目中…… --------------------------------------------- Powered by FavNet.cn 专业IT技术服务 [Plusii 您的企业附加值]旗下品牌立即下载

　　这个程序是我以前还不是很忙的时候随便搞的一个。主要参考了Enumeration源代码，用于查找句柄。由于QQ里的RichEdit并不是一般的RichEdit，不可以直接发送消息给它，所以废了一些周折。不过后来找到了解决问题的折中方法：利用模拟键盘将要发送的消息进行复制粘贴，然后再发送出去。
　 form1上的控件包含一个commonDialog:cdlbg用于打开文件的通用对话框,一个timer控件:timer1用于检查是否有新消息;两个Text控件text2用于接收和text1发送消息的文本框;两个picturebox：picture1用于载入背景。pictemp用于临时存储剪贴板上的图象。里面有一点小BUG，由于没有时间也就没有去管它。如果谁有兴趣研究句柄，或发送和接受消息机理，值得看一看。
　忘了说用途了，这个软件可以用于你在办公室QQ聊天又不想让其他人知道。载入你平时工作的屏幕，没准老板一直认为你在专心工作呢。
　使用这个小软件的前提是要打开和一个人聊天的对话框（没办法，找不到不需要打开聊天框的方法，如果你有，麻烦你告诉我，我一定会感激你的。：），目前只能支持同时和一个人聊天。呵呵，虽然功能不是很全，但还是有一点点的小实用，不信你试试看。

　　'*************************************************************************
'**模块名：Module1
'**文件名：Module1.bas
'**创建人：蒹葭
'**日    期：2005-03-18
'**描    述：QQ辅助聊天工具
'**说    明：运行此程序需打开一个QQ聊天对话框。
'**版    本：V1.0.0
'*************************************************************************

Option Explicit
'APIs : WHERE THE REAL POWER IS
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 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 EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Any) 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 EnumChildWindows Lib "user32" (ByVal hwndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Any) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function BringWindowToTop Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const WM_COMMAND = &H111
Public Const MIIM_TYPE = &H10
Public Const MFT_STRING = &H0&

'Public Const WM_SETFOCUS = &H7 Messages for:

Public Const WM_SETTEXT = &HC                   'Setting text of child window
Public Const WM_GETTEXT = &HD                   'Getting text of child window
Public Const WM_GETTEXTLENGTH = &HE
Public Const BM_CLICK = &HF5                    'Clicking a button
Public Const SW_MAXIMIZE = 3
Public Const SW_MINIMIZE = 6
Public Const SW_HIDE = 0
Public Const SW_RESTORE = 9
Public Const WM_MDICASCADE = &H227              'Cascading windows
Public Const MDITILE_HORIZONTAL = &H1
Public Const MDITILE_SKIPDISABLED = &H2
Public Const WM_MDITILE = &H226
Public g_hnum As Long
Public VCount As Integer, ICount As Integer
Public SpyHwnd As Long
Public g_ReceiveHwnd As Long
Public g_DilogHwnd As Long, g_editHwnd As Long, g_sendButtonHwnd As Long
Dim b_editflag As Boolean
Public Function WndEnumProc(ByVal hWnd As Long, ByVal lParam As TextBox) As Long
    Dim WText As String * 512
    Dim bRet As Long, WLen As Long
    Dim WClass As String * 50

    WLen = GetWindowTextLength(hWnd)
    bRet = GetWindowText(hWnd, WText, WLen + 1)
    GetClassName hWnd, WClass, 50

    If (WLen <> 0 And Left(WClass, 6) = Trim("#32770") And (Left(WText, 2) = "与 " Or Left(WText, 1) = "群")) Then
        g_DilogHwnd = hWnd
        'Debug.Print hwnd, Left(WText, 15); ";", WClass
        Form1.Frame1.Caption = Left(WText, 12)
    End If


    WndEnumProc = 1
End Function

Public Function WndEnumChildProc(ByVal hWnd As Long, ByVal lParam As TextBox) As Long
    Dim bRet As Long
    Dim myStr As String * 50
    bRet = GetClassName(hWnd, myStr, 50)
    If (Left(myStr, 11) = "RichEdit20A") Then
       ' Debug.Print hwnd; myStr; GetText(hwnd)
       g_ReceiveHwnd = hWnd
       b_editflag = True
    End If
    If b_editflag = True And (Left(myStr, 8) = "RICHEDIT") And (Left(myStr, 11) <> "RichEdit20A") Then
        g_editHwnd = hWnd
       ' Debug.Print g_editHwnd
        b_editflag = False
    End If
    If Left(Trim(GetText(hWnd)), 6) = "发送(&S)" Then
       ' Debug.Print GetText(Hwnd); ":"; Len(GetText(Hwnd))
       g_sendButtonHwnd = hWnd
    End If
    ICount = ICount + 1

    WndEnumChildProc = 1

End Function

Function GetText(iHwnd As Long) As String
Dim Textlen As Long
Dim Text As String

    Textlen = SendMessage(iHwnd, WM_GETTEXTLENGTH, 0, 0)
    If Textlen = 0 Then
        GetText = "暂无消息，或者你没有打开聊天对话框！：）"
        Exit Function
    End If
    Textlen = Textlen + 1
    Text = Space(Textlen)
    Textlen = SendMessage(iHwnd, WM_GETTEXT, Textlen, ByVal Text)
    'The 'ByVal' keyword is necessary or you'll get an invalid page fault
    'and the app crashes, and takes VB with it.
    GetText = Left(Text, Textlen)

End Function

＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆＆

'*************************************************************************
'**模块名：form1
'**文件名：form1.frm
'**创建人：蒹葭
'**日    期：2005-03-18
'**描    述：QQ辅助聊天工具
'**版    本：V1.0.0
'*************************************************************************

Option Explicit

Private Declare Function ShellExecute Lib "shell32.dll" Alias _
    "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As _
    String, ByVal lpFile As String, ByVal lpParameters As String, _
    ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function PutFocus Lib "user32" Alias "SetFocus" (ByVal hWnd As Long) As Long '由于vb自带一个SetFocus函数，所以改个函数名
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Const SW_RESTORE = 9

Private Sub CmdSend_Click()
'*********************************
'将剪贴板里的东西暂时保存到变量中去
Dim stempClip As String
Dim btype As Integer '识别剪贴板里的内容类型 1----文本;2----图形
If Clipboard.GetFormat(vbCFText) Then
        stempClip = Clipboard.GetText()
        btype = 1
ElseIf Clipboard.GetFormat(vbCFBitmap) Then
        Pictemp.Picture = Clipboard.GetData(vbCFBitmap)
        btype = 2
End If

'*********************************
'向剪贴板写内容
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Clipboard.Clear
Clipboard.SetText Text1.SelText
'*******************************
'发送消息，采用模拟键盘Ctrl+V
Call Sendmes(g_editHwnd)
'*******************************
'延时，防止发送点击按钮动作失败
Do
      DoEvents
Loop Until Clipboard.GetText() <> ""
'*******************************
'发送消息给“发送按钮”
PressSendButton
'*******************************
'将原来剪贴板上的内容再送回去
If btype = 1 Then
      Clipboard.Clear
      Clipboard.SetText stempClip
ElseIf btype = 2 Then
      Clipboard.Clear
      Clipboard.SetData Pictemp.Picture
End If
btype = 0
Text1.Text = ""
Text1.SetFocus
SendKeys "{Home}+{End}"
End Sub

Private Sub Command1_Click()
    Dim myLong As Long
    myLong = EnumWindows(AddressOf WndEnumProc, Text1)
    Dim myLong2 As Long
    myLong2 = EnumChildWindows(g_DilogHwnd, AddressOf WndEnumChildProc, Text2)
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Command4_Click()
On Error Resume Next
Dim bgFileName As String
cdlbg.CancelError = True
'属性DialogTitle是要弹出的对话框的标题
cdlbg.DialogTitle = "打开文件"
'缺省的文件名为空
cdlbg.FileName = ""
'属性Filter是文件滤器，返回或设置在对话框的类型列表框中所显示的过滤器。
'语法object.Filter [= 文件类型描述1 |filter1 |文件类型描述2 |filter2...]
cdlbg.Filter = "JPG文件(.jpg)|*.jpg|BMP文件|*.bmp|所有文件|*.*"
'Flags属性的用法依据不同的对话框而变，详细使用需要查找联机帮助手册
cdlbg.Flags = cdlOFNCreatePrompt + cdlOFNHideReadOnly
cdlbg.ShowOpen
If Err = cdlCancel Then Exit Sub
Set Picture1.Picture = LoadPicture(cdlbg.FileName)
End Sub

Private Sub Form_Load()
    Dim myLong As Long
    myLong = EnumWindows(AddressOf WndEnumProc, Text1)
    Dim myLong2 As Long
    myLong2 = EnumChildWindows(g_DilogHwnd, AddressOf WndEnumChildProc, Text2)
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        CmdSend_Click
        Text1.Text = ""
    End If
End Sub
'Private Sub Text2_Change()
' Text1.SelStart = Len(Text1.Text)
'End Sub

Private Sub Timer1_Timer()
Form1.Text2.Text = ""
Form1.Text2.SelText = Right(GetText(g_ReceiveHwnd), 100)
End Sub

Private Sub PressSendButton()
    SendMessage g_sendButtonHwnd, BM_CLICK, 0, 0
    ShowWindow Val(g_DilogHwnd), SW_MINIMIZE
End Sub
Private Sub Sendmes(ByVal hWnd As Long)
    SetForegroundWindow hWnd
    ShowWindow hWnd, SW_RESTORE
    SendKeys "^v" 'SHIFT+a－－>"+a",Ctl+a--> "^a",alt+a-> "%a"
' SendKeys "{ENTER}"
' SendKeys "^{ENTER}"
End Sub