qqsms.pas

QQ消息自动发送组件及程序

//QQ消息发送组件，作者：朱颂东
//编写此组件是为了学生的目的
//欢迎大家一起交流学习，开发出更多更好的组件，让大家使用
//[e-mail]  QQ:278789991
unit QQSMS;

interface

uses
 Windows, SysUtils,strUtils,Classes,messages,ExtCtrls;
type
  TQQSMS = class(TComponent)
  private
    { Private declarations }

   FTimer:TTimer;
   FInterval: integer;
   FSendStrs: TstringList;
   Fint:integer;
   FstrLength:integer;
   Forder:boolean;
//   FSendByName:Boolean;
//   FsendName:string;
   procedure SetInterval(const Value: integer);
   procedure TimerProc(sender:Tobject);
   procedure SetSendStrs(const Value: TstringList);
   procedure SetOrder(const Value: boolean);
//    procedure SetSendByName(const Value: Boolean);
//    procedure SetsendName(const Value: string);

  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(Owner:Tcomponent);Override;
    destructor Destroy;override;
    function Execute:boolean;
    procedure Stop;
  published
    { Published declarations }
    property Interval:integer read FInterval write SetInterval;
    property SendStrs:TstringList read FSendStrs write SetSendStrs;
    property Order:boolean read FOrder write SetOrder;
//    property SendByName:Boolean read FSendByName write SetSendByName;
//    property sendName:string read FsendName write SetsendName;
  end;

procedure Register;
var
  FHForm:THandle;
  FHButton:Thandle;
  FHEdit:THandle;
//  byname:Boolean;
//  Name:string;
implementation

procedure Register;
begin
  RegisterComponents('QQSMS', [TQQSMS]);
end;

constructor TQQSMS.Create(Owner: Tcomponent);
begin
  inherited;
  FTimer:=TTimer.Create(self);
  Ftimer.Enabled := false;
  Ftimer.OnTimer:=TimerProc;
  FInterval:= 1000;
  FSendStrs:=TstringList.Create;
  FSendstrs.Add('你好吗？我是你的朋友');
  Fint:=0;
  FstrLength:=1;
  Forder := true;
//  Fsendbyname:=false;
//  Fsendname:=emptystr;
end;

destructor TQQSMS.Destroy;
begin
  if FTimer.Enabled then
  Ftimer.Enabled:=false;
  FTimer.Free;
  FSendStrs.Free;
  inherited;
end;



function EnumWindowsProc(hwnd: HWND; lParam: LPARAM): boolean;stdcall;
var
  cName: array[0..32] of Char;
  wName: array[0..180] of Char;
begin
  GetClassName(hwnd, cName, 32);
  GetWindowText(hwnd, wName, 180);
{  if  then
    begin
       if Pos('与' + Name, StrPas(wName)) > 0then
        begin
          FHFORM := hwnd;
          result := false;
        end
     else
        result := true;
    end
  else
    begin   }
      if Pos('聊天中', StrPas(wName)) > 0then
        begin
          FHFORM := hwnd;
          result := false;
        end
     else
        result := true;
     end;
//end;

function GetButtonHandle(hwnd: HWND; lParam: LPARAM):Boolean;stdcall;
var
  cName: array[0..180] of Char;
  wName: array[0..12] of Char;
begin
  result := true;
  GetClassName(hwnd, cName, 180);
  if StrPas(cName) = 'Button' then
  begin
    GetWindowText(hwnd, wName, 12);
    if StrPas(wName) = '发送(&S)' then
    begin
      PInteger(lParam)^ := hwnd;
      result := false;
    end;
  end;
end;

function GetEditHandle(hwnd: HWND; lParam: LPARAM):Boolean; stdcall;
var
  cName: array[0..180] of Char;
begin
  result := true;
  GetClassName(hwnd, cName, 180);
  if StrPas(cName) = 'RICHEDIT' then
    PInteger(lParam)^ := hwnd;
end;

function TQQSMS.Execute: boolean;
begin
  EnumWindows(@EnumWindowsProc,0);
  if FHFORM <> 0 then
  begin
    EnumChildWindows(FHForm,@GetButtonHandle,Integer(@FHBUTTON));
    EnumChildWindows(FHForm, @GetEditHandle, Integer(@FHEDIT));
    FstrLength := Fsendstrs.Count;
    FTimer.Enabled := true;
    FTimer.Interval := Interval;
    result := true;
 end
 else
   result := false;
end;



procedure TQQSMS.SetInterval(const Value: integer);
begin
  if value <= 0 then exit;
  if FInterval <> value then
    FInterval := Value;
end;

procedure TQQSMS.SetOrder(const Value: boolean);
begin
  if Forder <> Value then
    FOrder := Value;
end;

{procedure TQQSMS.SetSendByName(const Value: Boolean);
begin
  if FSendbyName <> Value then
    begin
    FSendByName := Value;
   byname:=value;
    end;
end;

procedure TQQSMS.SetsendName(const Value: string);
begin
  if Fsendname <> value then
  begin
    FsendName := Value;
    name:=value;
  end;
end;  }

procedure TQQSMS.SetSendStrs(const Value: TstringList);
begin
  if  FSendStrs <> Value then
    FSendStrs.Assign(Value)
end;

procedure TQQSMS.Stop;
begin
  if FTimer.Enabled then
    FTimer.Enabled := false;
end;

procedure TQQSMS.TimerProc(sender: Tobject);
var
  sMsg: string;
begin
  if FOrder then
  begin
    if Fint = FstrLength then fint := 0;
      sMsg := FSendStrs.Strings[fint] ;
    fint := fint + 1;
  end
  else
  begin
    Randomize;
    sMsg :=FSendStrs.Strings[Random(self.FstrLength-1)];
  end;
  SendMessage(FHedit,WM_SETTEXT,180,Integer(PChar(sMsg)));
  SendMessage(FHbutton,WM_LBUTTONDOWN, 0, 0);
  SendMessage(Fhbutton,WM_LBUTTONUP, 0, 0);
end;

end.