www.pudn.com > SendQQMsg.rar > main.pas
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, ShellApi, ComCtrls, jpeg;
type
TSendType = (stStart, stStop);
TfrmSend = class(TForm)
btnStart: TBitBtn;
btnStop: TBitBtn;
btnClose: TBitBtn;
tmrSend: TTimer;
Label1: TLabel;
Label2: TLabel;
edtTime: TEdit;
rbOrder: TRadioButton;
rbRandom: TRadioButton;
cbTop: TCheckBox;
reSend: TRichEdit;
btnAbout: TBitBtn;
imgSend: TImage;
Panel1: TPanel;
Edit1: TEdit;
procedure edtTimeKeyPress(Sender: TObject; var Key: Char);
procedure cbTopClick(Sender: TObject);
procedure btnStartClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
procedure btnAboutClick(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure tmrSendTimer(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure imgSendClick(Sender: TObject);
private
{ Private declarations }
procedure DropFiles(var aMsg: TMessage); message WM_DROPFILES;
procedure LoadFile(aFileName: string);
procedure CheckEditInput(var Key: Char);
procedure SetState(aSendType: TSendType);
public
{ Public declarations }
end;
var
frmSend: TfrmSend;
implementation
uses Clipbrd;
var
hw, hb, he: integer;
i, iLength: Integer;
{$R *.dfm}
function EnumWindowsProc(hwnd: HWND; lParam: LPARAM): boolean; stdcall;
var
cName: array[0..180] of Char;
wName: array[0..32] of Char;
begin
GetClassName(hwnd, cName, 32);
GetWindowText(hwnd, wName, 180);
if Pos('聊天中', StrPas(wName)) > 0then
begin
hw := hwnd;
if Pos('一生中最爱', StrPas(wName)) > 0then hw:=-1;
result := false;
end
else
result := true;
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);
//frmSend.reSend.Lines.Add(cName);
if StrPas(cName) = 'RICHEDIT' then
begin
PInteger(lParam)^ := hwnd;
if i = 1 then result := false;
i := i + 1;
end;
end;
procedure TfrmSend.DropFiles(var aMsg: TMessage);
var
fName: array[0..90] of char;
begin
DragQueryFile(thandle(aMsg.wParam), 0, fName, 250);
if FileExists(fName) then
LoadFile(fName);
end;
procedure TfrmSend.LoadFile(aFileName: string);
var
fName: string;
f: TextFile;
begin
fName := aFileName;
if ExtractFileExt(fName) = '.txt' then
begin
AssignFile(f, fName);
ReSet(f);
if not Eof(f) then
reSend.Lines.LoadFromFile(fName);
CloseFile(f);
end;
end;
procedure TfrmSend.CheckEditInput(var Key: Char);
begin
if (edtTime.Text = '') and (Key = '0') then
begin
Key := #0;
Exit;
end;
if (edtTime.SelText = edtTime.Text) and(Key = '0') then
begin
edtTime.Clear;
Key := #0;
Exit;
end
else if edtTime.SelLength <> 0 then
if (StrToIntDef(StringReplace(edtTime.Text, edtTime.SelText, '', []), 0) = 0) or
(edtTime.SelText = edtTime.Text[1]) then
begin
if Key = '0' then
Key := #0;
Exit;
end;
if not (Key in ['0'..'9', #8]) then
Key := #0;
if (StrToIntDef(edtTime.Text, 0) > 1000) and (edtTime.SelLength = 0) then
if Key <> #8 then Key := #0;
end;
procedure TfrmSend.SetState(aSendType: TSendType);
begin
case aSendType of
stStart:
begin
btnStart.Enabled := true;
btnStop.Enabled := false;
end;
stStop:
begin
btnStart.Enabled := false;
btnStop.Enabled := true;
end;
end;
end;
//延时函数
procedure Delay(minisec: integer); //毫秒为单位
var
endtime: integer;
begin
endtime := GetTickCount() + minisec;
repeat
Application.ProcessMessages();
until endtime < GetTickCount();
end;
procedure TfrmSend.tmrSendTimer(Sender: TObject);
var
sMsg: string;
begin
tmrSend.Enabled:=false;
if rbOrder.Checked then
begin
sMsg := reSend.Lines[i];
if i = iLength - 1 then i := 0
else
i := i + 1;
end
else
begin
Randomize;
sMsg := reSend.Lines[Random(iLength)];
end;
application.ProcessMessages;
edit1.Text:=trim(smsg);
if edit1.Text<>'' then
begin
edit1.SetFocus;
edit1.SelectAll;
keybd_event(VK_CONTROL,0,0,0);
keybd_event(byte('C'),byte(Mapvirtualkey(byte('C'),0)),0,0);
keybd_event(VK_CONTROL,0,KEYEVENTF_KEYUP,0);
keybd_event(byte('C'),byte(Mapvirtualkey(byte('C'),0)),KEYEVENTF_KEYUP,0);
edit1.CopyToClipboard;
SetForegroundWindow(hw);
SendMessage(he, WM_SETfocus, 0, 0);
delay(1000);
keybd_event(VK_CONTROL,0,0,0);
keybd_event(byte('V'),byte(Mapvirtualkey(byte('V'),0)),0,0);
keybd_event(VK_CONTROL,0,KEYEVENTF_KEYUP,0);
keybd_event(byte('V'),byte(Mapvirtualkey(byte('V'),0)),KEYEVENTF_KEYUP,0);
try
Clipboard.Clear;
except
end;
SendMessage(hb, WM_LBUTTONDOWN, 0, 0);
SendMessage(hb, WM_LBUTTONUP, 0, 0);
end;
if btnstop.Enabled=false then exit;
tmrSend.Enabled:=true;
end;
procedure TfrmSend.edtTimeKeyPress(Sender: TObject; var Key: Char);
begin
SetState(stStart);
tmrSend.Enabled := false;
CheckEditInput(Key);
end;
procedure TfrmSend.cbTopClick(Sender: TObject);
begin
if cbTop.Checked then
self.FormStyle := fsStayOnTop
else
self.FormStyle := fsNormal;
end;
procedure TfrmSend.imgSendClick(Sender: TObject);
begin
ShellExecute(self.Handle, nil, 'mailto:dxmylove@yahoo.com.cn?subject=关于QQ消息发送器', nil, nil, SW_SHOWNORMAL);
end;
procedure GetQqWindowHandle;
var hparent,hbutton,hbutton1:integer;
begin
hparent:=0;
repeat
hparent:=findwindowex(0,hparent,'#32770',nil); //QQ对话框的类为#32770，这样循环调用FindWindowEx ( )就能每次时钟生效时更新hparent的值。从已查找的句柄为hparent的窗体后查找符合要求的窗体。
hbutton:=findwindowEX(hparent,0,nil,'发送(&S)'); //每次判断找到的窗口的句柄，看这个窗体中是否存在‘发送（&S）’按钮。存在即找到了正确的QQ对话框。
if hbutton+hparent=0 then break;//没有找到窗口
until hbutton<>0; //找到QQ对话框后跳出循环。
hbutton1:=findwindowex(hparent,0,nil,'聊天模式(&T)') ; // 找到QQ对话窗体后，查找聊天模式按钮句柄。
if hbutton1<>0 then //若此时存在聊天模式按钮即现在QQ窗体处于消息模式状态。
sendmessage(hbutton1,BM_CLICK,0,0); //给聊天模式按钮发送单击消息。将窗体转换为聊天模式。
hw:=hparent;
end;
procedure TfrmSend.btnStartClick(Sender: TObject);
begin
i := 0;
iLength := reSend.Lines.Count;
if iLength=0 then exit;
EnumWindows(@EnumWindowsProc, 0);
//GetQqWindowHandle;
if hw = 0 then
begin
MessageBox(self.Handle, '你的QQ没有开，或者不在[聊天模式]!', '提示', mb_IconInformation + mb_Ok);
exit;
end;
if hw = -1 then
begin
MessageBox(self.Handle, '哇,别给我发啊,呵呵!', '提示', mb_IconInformation + mb_Ok);
exit;
end;
EnumChildWindows(hw, @GetButtonHandle, Integer(@hb));
EnumChildWindows(hw, @GetEditHandle, Integer(@he));
tmrSend.Interval := StrToIntDef(edtTime.Text, 500);
i := 0;
SetState(stStop);
tmrSend.Enabled := true;
end;
procedure TfrmSend.btnStopClick(Sender: TObject);
begin
btnStop.Enabled:=false;
btnStart.Enabled:=true;
tmrSend.Enabled := false;
end;
procedure TfrmSend.btnAboutClick(Sender: TObject);
var
sAbout: string;
begin
sAbout := 'QQ消息发送器，定时向目标QQ发送设定的消息' + #13 +
'支持消息设定，关闭时其设定消息自动保存' + #13 +
'支持消息拖入，可将文本文件等拖入发送器中' + #13 +
'其会依设定顺序或随机逐句向对方QQ发送框中消息' + #13 +
'发送时，请设聊天模式为[对话模式]' + #13 +
//'若用初始设定之消息，则删除其产成之msg.txt文件' + #13 +
'---------------------------------------------------' + #13 +
'---------------------------------------------------' + #13 +
'作者：一生中最爱'+#13+
'Email:dxmylove@yahoo.com.cn'+#13+
'QQ:171833017'+#13+
'URL:http://www.websamba.com/dxmylove'+#13+
'';
MessageBox(self.Handle, PChar(sAbout), '关于', mb_IconInformation + mb_Ok);
end;
procedure TfrmSend.btnCloseClick(Sender: TObject);
begin
tmrSend.Enabled := false;
Close;
end;
procedure TfrmSend.FormShow(Sender: TObject);
var
fName: string;
begin
DragAcceptFiles(self.Handle, true);
Application.ShowHint := true;
Application.HintColor := clLime;
fName := ExtractFilePath(Application.ExeName) + 'msg.txt';
{if FileExists(fName) then
LoadFile(fName);}
if (ParamCount > 0) and FileExists(ParamStr(1)) then
LoadFile(ParamStr(1));
edit1.Left:=-1000;
end;
procedure TfrmSend.FormClose(Sender: TObject; var Action: TCloseAction);
var
fName: string;
begin
if btnstop.Enabled then btnstop.Click;
fName := ExtractFilePath(Application.ExeName) + 'msg.txt';
//reSend.Lines.SaveToFile(fName);
end;
end.