This app is one of my past is not very busy. The enumeration source code is mainly referenced to find the handle. Since Richedit in QQ is not a general Richedit, you cannot send a message directly to it, so some twists and turns. However, later found a solution method of solving the problem: use the analog keyboard to copy the message to be sent, and then send it out. The control on the Form1 contains a Commondialog: CDLBG Used to open the common dialog box, a Timer Control: Timer1 is used to check if there is a new message; two Text control Text2 is used to receive text boxes for sending messages in TEXT1; two Picturebox : Picture1 is used to load the background. PICTEMP is used to temporarily store images on the clipboard. There is a little bug inside, because there is no time, there is no need to take it. If you are interested in studying your handle, or sending and accepting the message mechanism, it is worth seeing. Forgot to use it, this software can be used for you to chat in the office QQ chat and don't want others to know. Enter the screen you usually work, the boss has always thought that you are working. The premise of using this small software is to open and chat with a person's chat (no way, find the way you don't need to open the chat box, if you have, please tell me, I will be grateful. :), Currently, it can only be supported with one person. Oh, although the function is not very full, there is still a little small practical, don't believe you try it.
'********************************************************** ************************ ** module name: module1 '** file name: module1.bas' ** Create: 蒹葭' ** Japanese issue: 2005-03-18 '** Description: QQ Assistant Chat Tool' ** Speech: Run this program to open a QQ chat dialog. '** version: v1.0.0' ********************************************** ***************************************
Option Explicit'APIs: WHERE THE REAL POWER ISPublic Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPublic Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As LongPublic Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As LongPublic Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Any) As LongPublic Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As LongPublic Declare Function EnumChildWindows Lib "user32" (ByVal hwndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Any) As LongPublic Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As LongPublic Declare Function BringWindowToTop Lib "User32" (ByVal hWnd As Long) As LongPublic Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPublic Const WM_COMMAND = & H111Public Const MIIM_TYPE = & H10Public const mft_string = & h0 & 'public const wm_setfocus = & h7 message for:
Public Const WM_SETTEXT = & HC 'Setting text of child windowPublic Const WM_GETTEXT = & HD' Getting text of child windowPublic Const WM_GETTEXTLENGTH = & HEPublic Const BM_CLICK = & HF5 'Clicking a buttonPublic Const SW_MAXIMIZE = 3Public Const SW_MINIMIZE = 6Public Const SW_HIDE = 0Public Const SW_RESTORE = 9Public Const WM_MDICASCADE = & H227 'Cascading windowsPublic Const MDITILE_HORIZONTAL = & H1Public Const MDITILE_SKIPDISABLED = & H2Public Const WM_MDITILE = & H226Public g_hnum As LongPublic VCount As Integer, iCount As IntegerPublic SpyHwnd As LongPublic g_ReceiveHwnd As LongPublic g_DilogHwnd As Long, g_editHwnd As Long, g_sendButtonHwnd As LongDim b_editflag As BooleanPublic 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 * 50WLen = 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) = "and" or left (wtext, 1) = "group")) THEN G_DILOGHWND = HWnd 'Debug.print hwnd, Left (wtext, 15); ";", wclass form1.frame1.caption = left (wtext, 12) end if wndenumproc = 1END 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 (ilt (mystr, 8) = "richedit") and (left (mystr, 11) <> "richedit20a" ) THEN G_EDITHWND = HWND 'Debug.print g_edithWnd B_EDitflag = false end if ifness (TRIM (GetText (HWND)), 6) = "Send (& S)" Then' debug.print getText (hwnd); ":"; len (GetText (hwnd) g_sendbuttonhwnd = hwnd end if iCount = iCount 1 WndenumChildProc = 1END 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 = "No message, or you didn't open the chat dialog box! :)" 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
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& '**************************** ************************* ** module name: Form1 '** file name: form1.frm' ** Create: 蒹葭 '* * Japan: 2005-03-18 '** Description: QQ Auxiliary Chat Tool' ** version: v1.0.0 '******************** *********************************************************** **
Option expedition
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 LongPrivate Declare function PutFocus Lib "user32" Alias "SetFocus" (ByVal hWnd As Long) As Long 'because a vb comes SetFocus function, so a change of the function name Private Declare function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As LongPrivate Const SW_RESTORE = 9
Private Sub Cmdsend_click () '*********************** The thing in the clipboard is temporarily saved to the variable To DIM STEMPCLIP AS STRING DIM BTYPE AS INTEGER 'Identify the content type 1 in the clipboard ---- Text; 2 ---- Graphic if Clipboard.getFormat (vbcftext) Then StempClip = Clipboard.getText () btype = 1 elseif CLIPBOARD.GETFORMAT (VBCFBITMAP) THEN PICTEMP.PICTURE = clipboard.getdata (vbcfbitmap) btype = 2 end if '*********************************************** ****** 'Write the contents to the clipboard text1.Setfocus text1.selstart = 0 text1.selLength = len (text1.text) Clipboard.clear clipboard.settext text1.seltext' ******************* ************************************************************************************************************************************** ***************** The delay, preventing the click button action failure Do DoEvents loop unsil clipboard.getText () <> "" ******** ********************** The send message to "send button" presssendButton '************************* ************* 'Take the contents of the original clipboard back if Btype = 1 Then Clipboard.clear Clipboard.Settext Stempclip Elseif Btype = 2 Then Clipboard.clear Clipboard.SetData PICTEMP.PICTUR e End If btype = 0 Text1.Text = "" Text1.SetFocus SendKeys "{Home} {End}" End SubPrivate 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 () Endend Sub
Private Sub Command4_Click () on error resume next dim BGFileName As StringCdlbg.cancename = true 'attribute Dialogtitle is the title of the dialog to pop up CDLBG.DIALOGTILE = "Open File"' Default file name is empty CDLBG.FileName = "" 'Attribute Filter is a filter, returns or set the filter shown in the Type Box of the dialog. 'Syntax Object.Filter [= File Type Description 1 | Filter1 | File Type Description 2 | Filter2 ...] CDLBG.Filter = "JPG File (.jpg) | * .jpg | BMP file | * .bmp | All files | *. * " 'Flags usage attributes vary according to different dialog boxes, detailed online help find the need to use manual cdlbg.Flags = cdlOFNCreatePrompt cdlOFNHideReadOnlycdlbg.ShowOpenIf Err = cdlCancel Then Exit subSet Picture1.Picture = LoadPicture (cdlbg.FileName) End SubPrivate 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 IfEnd 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_MINIMIZEEnd SubPrivate 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
