给QQ窗口发消息 ,为什么发不了呀 ? ( 积分: 50 )

  • 主题发起人 主题发起人 fisheryj
  • 开始时间 开始时间
F

fisheryj

Unregistered / Unconfirmed
GUEST, unregistred user!
http://community.csdn.net/Expert/topic/4023/4023403.xml?temp=.3622705
 
http://community.csdn.net/Expert/topic/4023/4023403.xml?temp=.3622705
 
unit FrmUnit;<br><br>interface<br><br>uses<br> &nbsp;Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,<br> &nbsp;Dialogs, StdCtrls, CheckLst, ExtCtrls, ComCtrls;<br><br>type<br> &nbsp;TSendFrm = class(TForm)<br> &nbsp; &nbsp;SendBtn: TButton;<br> &nbsp; &nbsp;Label1: TLabel;<br> &nbsp; &nbsp;Memo1: TMemo;<br> &nbsp; &nbsp;Label2: TLabel;<br> &nbsp; &nbsp;Memo2: TMemo;<br> &nbsp; &nbsp;Label3: TLabel;<br> &nbsp; &nbsp;Edit1: TEdit;<br> &nbsp; &nbsp;Label4: TLabel;<br> &nbsp; &nbsp;Edit2: TEdit;<br> &nbsp; &nbsp;procedure SendBtnClick(Sender: TObject);<br> &nbsp; &nbsp;procedure FormClose(Sender: TObject; var Action: TCloseAction);<br> &nbsp; &nbsp;procedure FormCreate(Sender: TObject);<br> &nbsp;end;<br><br>var<br> &nbsp;SendFrm: TSendFrm;<br> &nbsp;NeedLoop: Bool = FALSE;<br><br>implementation<br><br>{$R *.dfm}<br><br>procedure LoopStop(TimeOut: DWORD);<br>var<br> &nbsp;StartTick: DWORD;<br>begin<br> &nbsp;StartTick := GetTickCount();<br> &nbsp;repeat<br> &nbsp; &nbsp;Application.ProcessMessages;<br> &nbsp; &nbsp;Sleep(1);<br> &nbsp;until (GetTickCount() - StartTick &gt; TimeOut) or (not NeedLoop);<br>end;<br><br>procedure SendText(hWnd: HWND; Text: string);<br>var<br> &nbsp;hDialog, hButton, hAfxWnd42, hRICHEDIT: DWORD;<br> &nbsp;J: Integer;<br>begin<br> &nbsp;hDialog := FindWindowEx(hWnd, 0, '#32770', nil);<br> &nbsp;if (hDialog = 0) then Exit;<br><br> &nbsp;hButton := FindWindowEx(hDialog, 0, 'Button', '发送(&amp;S)');<br> &nbsp;if (hButton = 0) then Exit;<br><br> &nbsp;hAfxWnd42 := 0;<br> &nbsp;repeat<br> &nbsp; &nbsp;hAfxWnd42 := FindWindowEx(hDialog, hAfxWnd42, 'AfxWnd42', nil);<br> &nbsp; &nbsp;if (hAfxWnd42 = 0) then Exit;<br><br> &nbsp; &nbsp;hRICHEDIT := FindWindowEx(hAfxWnd42, 0, 'RICHEDIT', nil);<br> &nbsp;until (hRICHEDIT &lt;&gt; 0);<br><br> &nbsp;J := 1;<br> &nbsp;while (J &lt;= StrToInt(SendFrm.Edit1.Text)) and (NeedLoop) do<br> &nbsp;begin<br> &nbsp; &nbsp;SendMessage(hRICHEDIT, EM_REPLACESEL, 0, Integer(@Text[1]));<br> &nbsp; &nbsp;SendMessage(hButton, BM_CLICK, 0 , 0);<br> &nbsp; &nbsp;J := J + 1;<br> &nbsp; &nbsp;LoopStop(StrToInt(SendFrm.Edit2.Text) * 1000);<br> &nbsp;end;<br>end;<br><br>function EnumFunc(hWnd: HWND; lParam: LPARAM): BOOL; stdcall;<br>var<br> &nbsp;Buffer: array[0..50] of Char;<br> &nbsp;J: Integer;<br>begin<br> &nbsp;Result := NeedLoop;<br><br> &nbsp;Buffer[GetWindowText(hWnd, Buffer, 50)] := #0;<br><br> &nbsp;if (SendFrm.Memo2.Lines.Count = 0) then<br> &nbsp;begin<br> &nbsp; &nbsp;if (Pos('聊天中', Buffer) &gt; 0) then SendText(hWnd, SendFrm.Memo1.Text);<br> &nbsp;end else<br> &nbsp;begin<br> &nbsp; &nbsp;for J := 0 to SendFrm.Memo2.Lines.Count do<br> &nbsp; &nbsp; &nbsp;if (Buffer = '与 ' + Trim(SendFrm.Memo2.Lines.Strings[J]) + ' 聊天中') then<br> &nbsp; &nbsp; &nbsp; &nbsp;SendText(hWnd, SendFrm.Memo1.Text);<br> &nbsp;end; &nbsp;<br>end;<br><br>procedure TSendFrm.SendBtnClick(Sender: TObject);<br>begin<br> &nbsp;if (SendBtn.Caption = '发送') then<br> &nbsp;begin<br> &nbsp; &nbsp;SendBtn.Caption := '停止';<br> &nbsp; &nbsp;NeedLoop := TRUE;<br> &nbsp; &nbsp;EnumWindows(@EnumFunc, 0);<br> &nbsp; &nbsp;SendBtn.Caption := '发送';<br> &nbsp;end else<br> &nbsp;begin<br> &nbsp; &nbsp;NeedLoop := FALSE;<br> &nbsp;end;<br>end;<br><br>procedure TSendFrm.FormClose(Sender: TObject; var Action: TCloseAction);<br>begin<br> &nbsp;NeedLoop := FALSE;<br>end;<br><br>procedure TSendFrm.FormCreate(Sender: TObject);<br>begin<br> &nbsp;SetWindowLong(Edit1.Handle, GWL_STYLE, GetWindowLong(Edit1.Handle, GWL_STYLE) or ES_NUMBER);<br> &nbsp;SetWindowLong(Edit2.Handle, GWL_STYLE, GetWindowLong(Edit2.Handle, GWL_STYLE) or ES_NUMBER);<br>end;<br><br>end.
 
http://fisheryj.ys168.com/<br>里面的QQ灌水 <br>就是整个工程文件<br>和调试过程的截图
 
代码都给你了还搞不定? 已把完整代码上传到您的空间, 查收
 
谢谢 刘大哥
 
不客气,如果问题解决了就结帐吧.~~~~~ &nbsp;[:D][:D]
 
好的接分
 

Similar threads

D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部