导航:
论坛 -> DELPHI技术
斑竹:liumazi,sephil
作者:
2003/5/6 11:32:19
标题:
各位前辈: 我想要象 QQ 发送消息的代码,帮帮我急用
浏览:3291
加入我的收藏
楼主:
我的hly308@sina.com 不感激不尽
----------------------------------------------
-
作者:
Giver (Giver)
★☆☆☆☆
-
盒子活跃会员
2003/5/6 14:26:10
1楼:
本站以前有过,不知道你是不是要这个,先发到这里再说,呵呵,被转载到我的网站了: 这是一段实现类似oicq千夫指代码 搜集整理:giver 来源:Delphi盒子 作者:狭路相逢 收录时间:2003-2-9 阅读次数:本日/总计: 4/141 ///这是一段实现类似oicq千夫指代码 //没有附带DFM //简单的看看功能实现。注释很详细。 //live_on@sohu.com 狭路相逢 unit main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls; type TForm1 = class(TForm) Memo1: TMemo; Button1: TButton; CmdStart: TButton; Timer1: TTimer; CmdEnd: TButton; ScrollBar1: TScrollBar; Label1: TLabel; Label2: TLabel; Label3: TLabel; Edit1: TEdit; pb: TProgressBar; Button2: TButton; Label4: TLabel; talk: TScrollBar; Label5: TLabel; procedure Button1Click(Sender: TObject); procedure CmdStartClick(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure ScrollBar1Change(Sender: TObject); procedure Button4Click(Sender: TObject); procedure CmdEndClick(Sender: TObject); procedure Button2Click(Sender: TObject); procedure talkChange(Sender: TObject); private { Private declarations } public TimeS: Integer; { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var hParent,hButton,hMemo: HWND; begin Memo1.SelectAll;//Memo内容全选 Memo1.CopyToClipboard;//把Memo中选中的语句拷贝到剪贴板中 try // 找发送消息的QQ 窗口 hParent := FindWindow(nil, '发送消息'); // 然后找回话时用的编辑窗口,Point 函数用于返回一个TPoint 类型变量 hMemo := ChildWindowFromPointEx(hParent, Point(50, 100),CWP_ALL); // 找到“送讯息”按钮的句柄 hButton := FindWindowEx(hParent,0,nil,'送讯息(&S)'); if (hParent = 0) or (hMemo = 0) or (hButton = 0) then MessageBox(Handle,' 没有找到发送窗口,请重试! ',' 错误', MB_ICONWARNING) else begin // 向发送消息中的回话编辑框发送粘贴消息 SendMessage(hMemo,WM_PASTE,0,0); // 向“送讯息”按钮送单击消息以模仿按键发送回话 SendMessage(hButton,BM_CLICK,0,0); end; except // 如果发生意外错误给出提示 MessageBox(Handle,' 发送消息出错,请重试! ' , ' 错误' , MB_ICONWARNING); end; end; procedure TForm1.CmdStartClick(Sender: TObject); var hParent,hButton,hMemo: HWND; begin Memo1.SelectAll; Memo1.CopyToClipboard;//把Memo中选中的语句拷贝到剪贴板中 try // 找对话模式中窗口 //ShowMessage('test'); hParent := FindWindow(nil, '对话模式'); // 找到对话模式中的回话编辑框 hMemo := ChildWindowFromPointEx(hParent, Point(50, 300), CWP_ALL); hButton := FindWindowEx(hParent,0,nil,'送讯息(&S)'); // 如果有任何一个句柄没有找到都不能完成发送,并给出提示 //if hMemo=0 then // ShowMessage('1'); if (hParent = 0) or (hMemo = 0) or (hButton = 0) then begin MessageBox(Handle,' 没有找到发送窗口,请切换到双人对话模式! ',' 错误', MB_ICONWARNING); //ShowMessage('go'); end else begin // 向对话模式中的回话编辑框发送粘贴消息 TimeS:=ScrollBar1.Position; Timer1.Interval:=1000 div StrToInt(Edit1.Text); pb.Position:=0; pb.Min:=0; pb.Max:=ScrollBar1.Position; Timer1.Enabled:=true; CmdEnd.Enabled:=true; CmdStart.Enabled:=false; //SendMessage(hMemo,WM_PASTE,0,0); // 向“送讯息”按钮送单击消息以模仿按键发送回话 //SendMessage(hButton,BM_CLICK,0,0); end; except // 如果发生意外错误给出提示 MessageBox(Handle,' 发送消息出错,请重试! ' , ' 错误' , MB_ICONWARNING); end; end; procedure TForm1.Timer1Timer(Sender: TObject); var hParent,hButton,hMemo: HWND; begin hParent := FindWindow(nil, '对话模式'); hMemo := ChildWindowFromPointEx(hParent, Point(50, 300), CWP_ALL); hButton := FindWindowEx(hParent,0,nil,'送讯息(&S)'); SendMessage(hMemo,WM_PASTE,0,0); // 向“送讯息”按钮送单击消息以模仿按键发送回话 pb.Position:=pb.Position+1; TimeS:=TimeS-1; if TimeS=0 then begin Timer1.Enabled:=false; CmdStart.Enabled:=true; CmdEnd.Enabled:=false; ShowMessage('完成!'); end; SendMessage(hButton,BM_CLICK,0,0); end; procedure TForm1.ScrollBar1Change(Sender: TObject); begin //ScrollBar1.Position Label2.Caption:=IntToStr( ScrollBar1.Position); end; procedure TForm1.Button4Click(Sender: TObject); begin ShowMessage(IntToStr(1000 div StrToInt(Edit1.Text))); end; procedure TForm1.CmdEndClick(Sender: TObject); begin Timer1.Enabled:=false; CmdStart.Enabled:=true; CmdEnd.Enabled:=false; pb.Position:=0; end; procedure TForm1.Button2Click(Sender: TObject); begin Application.Terminate; end; procedure TForm1.talkChange(Sender: TObject); begin Label5.Caption:=IntToStr(talk.Position); case talk.Position of 0:Memo1.Text :='你是那样地美,美得象一首抒情诗。你全身充溢着少女的纯情和青春的风采。留给我印象最深的是你那双湖水般清澈的眸子,以及长长的、一闪一闪的睫毛。像是探询,像是关切,像是问候。'; 1:Memo1.Text :='其实,我最先认识你是在照片上。照片上的你托腮凝眸,若有所思。那份温柔、那份美感、那份妩媚,使我久久难以忘怀。'; 2:Memo1.Text :='远远地,我目送你的背影,你那用一束大红色绸带扎在脑后的黑发,宛如幽静的月夜里从山涧中倾泻下来的一壁瀑布。'; 3:Memo1.Text :='你蹦蹦跳跳地走进来,一件红尼大衣,紧束着腰带,显得那么轻盈,那么矫健,简直就像天边飘来一朵红云。'; 4:Memo1.Text :='你笑起来的样子最为动人,两片薄薄的嘴唇在笑,长长的眼睛在笑,腮上两个陷得很举动的酒窝也在笑.'; 5:Memo1.Text :='春花秋月,是诗人们歌颂的情景,可是我对于它,却感到十分平凡。只有你嵌着梨涡的笑容,才是我眼中最美的偶象。'; 6:Memo1.Text :='你其有点像天上的月亮,也像那闪烁的星星,可惜我不是诗人,否则,当写一万首诗来形容你的美丽。'; 7:Memo1.Text :='你是一尊象牙雕刻的女神,大方、端庄、温柔、姻静,无一不使男人深深崇拜。'; 8:Memo1.Text :='在风吹干你的散发时,我简直着魔了:在闪闪发光的披肩柔发中,在淡淡入鬓的蛾眉问,在碧水漓漓的眼睛里……你竟是如此美丽可人!'; 9:Memo1.Text :='你是花丛中的蝴蝶,是百合花中的蓓蕾。无论什么衣服穿到你的身上,总是那么端庄、好看。'; 10:Memo1.Text :='你那瓜子形的形,那么白净,弯弯的一双眉毛,那么修长;水汪汪的一对眼睛,那么明亮!'; end; end; end.
----------------------------------------------
http://www.gaiwei.com
作者:
delphicn (http://www.delphicn.com)
★☆☆☆☆
-
普通会员
2003/5/6 17:07:20
2楼:
《字符画大师》的源程序里有比较完整的 可到这里下载http://www.delphicn.com
----------------------------------------------
中国Delphi联盟 http://www.delphicn.com 欢迎访问
作者:
fan (孤独求爱)
★☆☆☆☆
-
盒子活跃会员
2003/5/6 22:11:40
3楼:
Giver: 请教了,我用这个代码时候有这个问题,就是好象以下代码没有运行似的: // 向发送消息中的回话编辑框发送粘贴消息 SendMessage(hMemo,WM_PASTE,0,0); 所以每次都提示出现“不能发空信息”的提示!请问怎么解决,麻烦你了!
----------------------------------------------
我不懂就发帖子!大家帮我哦!
作者:
Giver (Giver)
★☆☆☆☆
-
盒子活跃会员
2003/5/7 3:21:10
4楼:
是不是handle,没有得到啊?
----------------------------------------------
http://www.gaiwei.com