一個QQ隱蔽聊天的軟體，用於你在辦公室QQ聊天又不想讓其他人知道

　　這個程式是我以前還不是很忙的時候隨便搞的一個。主要參考了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