A QQ concealed chat software that is used for chatting in the office and does not want others to know.

Source: Internet
Author: User

This is a simple program that I used to do when I was not very busy. Refer to the enumeration source code to find the handle. Since the RichEdit in QQ is not a general RichEdit, it cannot directly send messages to it, so it has been ruined. However, I found a compromise to solve the problem: copy and paste the message to be sent using the analog keyboard, and then send it out.
The control on form1 contains a commondialog: cdlbg universal dialog box for opening files. A timer control: timer1 is used to check whether there are new messages; two text control text2. two pictureboxes: picture1 are used to load the background. Pictemp is used to temporarily store the image on the clipboard. There is a small bug in it, because there is no time to ignore it. It is worth looking at if anyone is interested in studying the handle, or sending and receiving the message mechanism.
I forgot to mention the purpose. This software can be used for QQ chat in the office and you don't want others to know about it. Loading the screen of your usual work, maybe the boss has always thought that you are focusing on your work.
The premise of using this small software is to open the dialog box for chatting with a person (no way, you cannot find the method that does not need to open the chat box. If you have any, please tell me, I will be grateful to you. :). Currently, you can only chat with one person at the same time. Haha, although the function is not very comprehensive, there is still a little bit of small practical, do not believe you try it.

'*************************************** **********************************
'** Module name: module1
*** File name: module1.bas
'** Creator: zookeeper
'** Date:
'** Description: QQ chat tool
'** Note: to run this program, you need to open a QQ chat dialog box.
'** Version: 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:

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) = "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 = 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) = "Send (& 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 = "no message, or you have not opened 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
'** Creator: zookeeper
'** Date:
'** Description: QQ chat tool
'** Version: v1.0.0
'*************************************** **********************************

Option explicit

Private declare function ShellExecute lib "shell32.dll" alias _
"Shellexecutea" (byval hwnd as long, byval lpoperation _
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 'Because VB comes with a setfocus function, change the function name
Private declare function setforegroundwindow lib "USER32" (byval hwnd as long) as long
Private const sw_restore = 9

Private sub cmdsend_click ()
'*********************************
'Save the items in the clipboard to the variable temporarily.
Dim stempclip as string
Dim btype as integer 'identifies the content type in the clipboard 1 ---- text; 2 ---- graphics
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 content to the clipboard
Text1.setfocus
Text1.selstart = 0
Text1.sellength = Len (text1.text)
Clipboard. Clear
Clipboard. settext text1.seltext
'*******************************
'Send the message, using the analog keyboard Ctrl + V
Call sendmes (g_edithwnd)
'*******************************
'Delay to prevent sending and Clicking buttons from failing
Do
Doevents
Loop until clipboard. gettext () <> ""
'*******************************
'Send a message to the send' button"
Presssendbutton
'*******************************
'Send the content on the original clipboard back.
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 commandementclick ()
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
'Attribute dialogtitle is the title of the dialog box to pop up
Cdlbg. dialogtitle = "Open File"
'The default file name is null.
Cdlbg. filename = ""
'Attribute filters are file filters, and the filters displayed in the type list box in the dialog box are returned or set.
'Syntax object. Filter [= file type description 1 | filter1 | file type description 2 | filter2. ..]
Cdlbg. Filter = "JPG file (.jpg) | *. jpg | BMP file | *. BMP | all files | *.*"
The usage of the 'flags attribute varies depending on the dialog box. For details, refer to the online help manual.
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 text=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-> "%"
'Sendkeys "{enter }"
'Sendkeys "^ {enter }"
End sub

Related Article

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.