QQ2008自动聊天精灵delphi源码

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls,Registry, ExtDlgs, bsSkinShellCtrls,
   BusinessSkinForm, bsSkinBoxCtrls, bsSkinCtrls;

type
TTform1 = class(TForm)
     GroupBox1: TGroupBox;
     Bevel1: TBevel;
     Label2: TLabel;
     Bevel2: TBevel;
     Bevel3: TBevel;
     Bevel4: TBevel;
     FindBtn: TSpeedButton;
     Image1: TImage;
     SendBtn: TSpeedButton;
     LoadBtn: TSpeedButton;
     loaddialog1: TOpenDialog;
     ListBox1: TListBox;
     bsBusinessSkinForm1: TbsBusinessSkinForm;
     bsSkinOpenDialog1: TbsSkinOpenDialog;
     AoutBtn: TSpeedButton;
     procedure FormCreate(Sender: TObject);
     procedure FindBtnClick(Sender: TObject);
     procedure LoadBtnClick(Sender: TObject);
     procedure SendBtnClick(Sender: TObject);
     procedure AoutBtnClick(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Tform1: TTform1;

implementation
{$R *.dfm}
//定义一组全程变量
const
    WinCaption07:string='聊天中';
    WinCaption08:string='交谈中';
var
   x:integer;
   TextBoxNum:shortint; //QQ输入框是第几个对话框
   SendButtonNum:shortint; //发送按钮是第几个按钮
   QQInputBoxHandle,SendButtonHandle:HWND;//发送按钮和输入框句柄
   StopSend:boolean;
//=====================延时时程序===================
procedure Delay(msecs:integer);
var
FirstTickCount:longint;
begin
FirstTickCount:=GetTickCount;
repeat
     if STopSend then   exit ;
     Application.ProcessMessages;
until ((GetTickCount-FirstTickCount) >= Longint(msecs));
end;
//=====================得到窗口内容===================
function GetWindowStr(Wnd: HWND): String;
var
Len: Integer;
begin
Len := SendMessage(Wnd, WM_GETTEXTLENGTH, 0, 0);
SetLength(Result, Len + 1);
SendMessage(Wnd, WM_GETTEXT, Length(Result), Longint(@Result[1]));
end;
//=====================得到所属类===================
function GetWindowClass(Wnd: HWND): String;
begin
SetLength(Result, 65);
GetClassName(Wnd, @Result[1], 65);
end;

//=====================查找子控件===================
function EnumChildProc(Wnd: HWND; lParam: LPARAM): Boolean; stdcall;
var
S, C: String;
begin
   S := GetWindowStr(Wnd);
   C := GetWindowClass(Wnd);
      X:=X+1;

     if   Pos('RichEdit', C) =1   then
       begin
         TextBoxNum:=TextBoxNum+1;
         if   TextBoxNum =3 then QQInputBoxHandle :=Wnd;
       end;
     if (pos('发送',S) =1) and (Pos('Button', C) =1) then
       begin
         if   SendButtonNum=2 then   SendButtonHandle:=wnd;
         SendButtonNum:= SendButtonNum+1;
       end;
Result := True;
end;
//=====================定义一个回调函数===================

function EnumWindowsProc(Wnd: HWND; lParam: LPARAM): Boolean; stdcall;
var
S, C: String;
begin
S := GetWindowStr(Wnd);
C := GetWindowClass(Wnd);
//看是07和08版QQ的标题吗?
if (Pos(WinCaption07, S) >0) or (Pos(WinCaption08, S) >0) then
   begin   //如果找到QQ窗体则找出所有控件
     if not EnumChildWindows(Wnd, @EnumChildProc, lParam) then ;
     Result := False;
   end;
Result := True;
end;
//=====================主表单初始化===================
procedure TTform1.FormCreate(Sender: TObject);
begin
   //初始化表单和列表框颜色
   Tform1.color:=tcolor(rgb(236,233,216));
   ListBox1.color:=Tcolor(rgb(96,96,97));
end;

//=====================查找QQ主窗体===================
procedure TTform1.FindBtnClick(Sender: TObject);
begin
   X:=0;
   TextBoxNum:=1;
   SendButtonNum:=1;

   try
   if not EnumWindows(@EnumWindowsProc, Integer(Pointer(ListBox1))) then ;
   finally
     if X = 0 then messagebox( Tform1.Handle,'不能找到QQ发送窗口!','错误',MB_OK+MB_DEFBUTTON1 +MB_ICONHAND);   end;
   listbox1.ItemIndex:=0;
   if (QQInputBoxHandle<>0) and (SendButtonHandle <>0) then SendBtn.Enabled :=True;
end;

//=====================装入聊天记录===================
procedure TTform1.LoadBtnClick(Sender: TObject);
begin
if bsSkinOpenDialog1.execute then
    begin
      ListBox1.Clear;
      ListBox1.Items.LoadFromFile(bsSkinOpenDialog1.filename);
    end;
end;

//=====================可中断的连续发送================
procedure TTform1.SendBtnClick(Sender: TObject);
var
   SendTxt:string;
begin

   StopSend := False; //把是否安暂停设为不停
   if SendBtn.Caption='发 送' then
     begin
       SendBtn.Caption :='暂 停';
     end
   else
     begin //如果是暂停按钮按下
       SendBtn.Caption:='发 送';
       StopSend:=True;
     end;

   while (listbox1.ItemIndex<ListBox1.Items.Count-1) and (not StopSend)   do
     begin
        listbox1.ItemIndex:=listbox1.ItemIndex+1;

        //如果导入的文本文件里有空行,则跳过空行
        while ListBox1.Items.strings[listbox1.ItemIndex]='' do listbox1.ItemIndex:=listbox1.ItemIndex+1;

        if STopSend then    exit; //如果暂停键按下
        SendTxt :=ListBox1.Items.strings[listbox1.ItemIndex];
        SendMessage(QQInputBoxHandle,EM_REPLACESEL,180,Integer(Pchar(SendTxt)));
        delay(300);
        SendMessage(SendButtonHandle,BM_CLICK,0,0);
     end;
end;

procedure TTform1.AoutBtnClick(Sender: TObject);
begin
   messagebox( Tform1.Handle,'QQ2008!','关于',MB_OK+MB_DEFBUTTON1 +MB_ICONQUESTION );
end;


Delphi编写的即时通信程序,类似QQ聊天源码内包括了控件补盯配置方法说明和各个模块的代码等。   一个自我感觉很好的通信程序,它的特点:   1.数据包格式全部自己定义。    所有的定义和通信核心类全部在COMM文件夹中。   2.能处理大量客户端同时通信的情况,客户和服务端共用相同的通信对象,并且可以实现互传。   3.通信细节全部封装在几个通用的类中,隐藏了交互通信的所有处理细节,如断包处理,超时重发等功能。   4.数据通信和数据具体应用完全分离,扩展性良好,本例中只做一个上传文件的例子,你可以在不用改动通信核心的情况下,可以实现远程控制所需的任何功能,并且不需要考虑通信细节。具体方法可以参考:CommSrvApps 单元的TSrvApp_File类,只需写一个新类即可:    TSrvApp_File = class(TServerAppObject)    public    function ProcessData(ABuf: PChar; ASize: integer): integer; override;    end;    通过以上类配合通信核心类,实现了远程实时传送一个文件就像copy那么简单。   其它:   此程序是我自己开发的连锁超市方案中数据交换的应用实例,所以客户端和服务端的代码有点多,但多是与通信本身无关,所实现功能是将本地Local文件夹与远程Remote文件夹的.rs文件互相进行传送。   程序配置方法:   1.本程序在Delphi6下编译通过,其它版本没有测试。   2.请先安装"控件补丁"中的控件包。   3.编译Client或Server时,请先设置Search Path指向comm 文件夹。
Delphi实现QQ自动聊天功能,用法介绍: 打开QQ聊天室, 可以一号开多个聊天室,也可以多号进一个聊天室.然后点自动检测,然后用打开文本选择你要发送的信息当然也可以直接写信息在文本窗口内,最后点开始发送,默认时间   为30秒发送一次.可以根据需要自己调整。详细用发介绍:   工具条按钮介绍:    进程窗口按钮    点击后显示进程窗口。    文本窗口按钮    点击后显示要发送的文本。    打开按钮    点击后显示进程窗口。    打开文本按钮    点击后选择要打开的文本文件。    开始/停止发送按钮    开始或暂停发送消息。    内容重复按钮    一次总循环中发送内容相同。总循环一次文本换一行。    内容递增按钮    进程跳转一次文本内容换一行。    删除进程按钮    删除列表中选中的进程。    自动检测按钮    自动检测当前QQ聊天室里的输入框进程。   时间行号控制板说明    总循环时间    默认为30秒用户可以在1-1000秒内定义。    间隔发送时间    用户不可以定义,随总循环时间和进程多少而计算。    间隔发送时间=总循环时间÷列表中进程数量。    行号显示与指定行号按钮    行号显示“第?行”为当前进程正在发送的文本行。    指定行号按钮与行号显示紧挨在一起,点击后将使当前发送位置跳转到文本窗口里光标所在行,这个    功能使用户自己选择从哪一行开始发送。    定义进程请用F12说明    手动进程定义,将鼠标移动到你要自动发送消息的聊天室输入框(输入框不需要得到焦点)然后按F12,转回QQ聊神的进程窗口可以就可以看到你定义的进程了.用这种方法可以给线上好友自动发消息,但是需要把   聊天模式改为按回车发送信息.
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值