delphi QQ尾巴源码

来源:互联网 发布:java stream filter 编辑:程序博客网 时间:2024/03/29 18:07

  之前网上看了QQ尾巴的源码,就自己试运行了一下,但是无反应,后上网一查,QQ在2005版后就禁止,SendMessage给发送框,后来在一BBS看到一回帖,说只要把SendMessage中的MSG参数换成EM_ReplaceSel就能正常发送(测试QQ版本QQ2008Beta1_BlessingKB1)

 

{ QQ尾巴  开启:SetHook 关闭:UnHook}
function SetHook:Boolean;stdcall;far; external 'TestDll.dll';
SetHook;

 


{ 生成TestDll.dLL文件 }
library TestDll;

uses
  SysUtils,Windows,Messages,
  Classes;
var
  dwThreadID:DWord;
  EventLog:Integer;
  hHook:Integer;
  recOK:Integer;
  hQQ : hwnd;
  note:hwnd;
 
procedure SetWndText(hWnd: HWND; Text: String);
Var
    //Ret:LongInt;
    mText:PChar;
    Buf:Integer;
begin
    GetMem(mText,Length(Text));
    StrCopy(mText,PChar(Text));
    try
        Buf:=LongInt(mText);
        SendMessage(hWnd,EM_ReplaceSel,0,Buf);
    finally
        FreeMem(mText,Length(Text));
    end;
end;
function GetWndText(hWnd: HWND): String;
Var
    Ret:LongInt;
    mText:PChar;
    Buf:Integer;
begin
    Ret:=SendMessage(hWnd,WM_GETTEXTLENGTH,0,0)+1;
    GetMem(mText,Ret);
    try
        Buf:=LongInt(mText);
        SendMessage(hWnd,WM_GETTEXT,Ret,Buf);
        Result:=StrPas(mText);
    finally
       FreeMem(mText,Ret);
    end;
end;

Function FindQQ:hwnd;
var
   hQQ    : hwnd;
   QQTitle: String;
begin
    Result :=0;
    //查找QQ
    hQQ :=  FindWindowEx(0,        //Parent
                         0,        //Child
                         '#32770', //窗口类名通过Spy++或者MiniSpy都可以查到
                         nil       //窗口Caption
                         );

  //循环查找
  While   (hQQ <> 0)  do                   //and (hSend = 0)
  begin
    QQTitle := GetWndText(hQQ);
    if  (Pos('聊天中',QQTitle)>0) or
        (Pos('发送消息',QQTitle)>0) or
        (Pos('群',QQTitle)>0) then
    begin
      //  showMessage(QQTitle);
        result := hQQ;
        exit;
    end;
    //查找QQ
    hQQ :=  FindWindowEx(0,        //Parent
                         hQQ,        //Child
                         '#32770', //窗口类名通过Spy++或者MiniSpy都可以查到
                         nil       //窗口Caption
                         );
   end;
end;

function HookProc(iCode:Integer;wParam:wParam;lParam:lParam):LRESULT;stdcall;
var
 hChild:hwnd;
 hRichText:hwnd;
begin
  recOK:=1;
  Result:=0;
  if iCode < 0 then
    Result := CallNextHookEx(hHook,iCode,wParam,lParam)
  else if iCode = HC_SYSMODALON then
    recOK:=0
  else if iCode = HC_SYSMODALOFF then
    recOK:=1
  else if ((recOK>0) and (iCode = HC_ACTION)) then
  begin
    if ((wParam = VK_RETURN) and (GetAsyncKeyState(VK_CONTROL) < 0)) then
    begin
      hQQ := FindQQ;
      hChild := GetDlgItem(hQQ,0);     //发送窗口所在的子窗口
      hRichText  := GetDlgItem(GetDlgItem(hChild,0), 894);
      SetWndText(hRichText,' -- 哈哈,你中了QQ尾巴!');
    end;
    result:=CallNextHookEx(hHook,iCode,wParam,lParam);
  end;
end;

Function SetHook:Boolean;stdcall; export;
var
     dwThreadID:DWord;
     hQQ : hwnd;
begin
  EventLog:=0;
      hQQ := FindQQ;
      if hQQ=0 then exit;
     dwThreadID := GetWindowThreadProcessId(hQQ, dwThreadID);
  //建立键盘鼠标操作消息纪录链
  hHook:=SetwindowsHookEx(WH_KEYBOARD,HookProc,HInstance,dwThreadID);
end;

Function UnHook:Boolean;stdcall; export;
begin
    result:=UnhookWindowsHookEx(hHook);
end;
exports //DLL的输出函数
SetHook,UnHook;

begin
end.

原创粉丝点击