盒子论坛 v2.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

信息

登陆以后才能回复