通过http发送手机短信[转] [复制链接]

procedure Tsmsfrm.SpeedButton1Click(Sender: TObject);
begin
close;
end;

procedure Tsmsfrm.FormActivate(Sender: TObject);
begin
myphonebook.Enabled := checkbox1.Checked;
tv.OnMouseMove(sender,[ssleft],0,0);
pagecontrol1.ActivePageIndex :=0;
tv.Items[1].Selected :=true;
tv.OnClick(sender);
mycode.Text :=curuser.phone;
end;

procedure Tsmsfrm.CheckBox1Click(Sender: TObject);
begin
myphonebook.Enabled :=checkbox1.Checked;
end;

procedure Tsmsfrm.PageControl1Change(Sender: TObject);
begin
edit1.Visible :=( pagecontrol1.ActivePageIndex=2);
end;

procedure Tsmsfrm.WebDocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
i,j,ok:integer;
doc:olevariant;
begin
ok:=0;
doc:=(sender as twebbrowser).document;
j:=doc.all.length;
for i:=0 to j-1 do
begin
if (doc.all.item(i).tagname='INPUT')or
(doc.all.item(i).tagname='TEXTAREA') then
begin
if (doc.all.item(i).tagname='INPUT')and
(doc.all.item(i).type='text')and
(doc.all.item(i).name='phone') then //对方手机号
begin
inc(ok); //=1
doc.all.item(i).value:=frendcode.Text;
end;
if(doc.all.item(i).tagname='TEXTAREA')and
(doc.all.item(i).name='content') then//内容
begin
inc(ok); //=2
doc.all.item(i).value:=memomsg.Text;
end;
if (doc.all.item(i).tagname='INPUT')and
(doc.all.item(i).type='text')and
(doc.all.item(i).name='mycode') then //我的手机号
begin
inc(ok);//=3
doc.all.item(i).value:=mycode.Text;
end;
if (doc.all.item(i).tagname='INPUT')and
(doc.all.item(i).type='password') and
(doc.all.item(i).name='mypw') then //密码
begin
inc(ok); //=4
doc.all.item(i).value:=mypwd.Text;
end;
if (doc.all.item(i).tagname='INPUT')and
(doc.all.item(i).type='submit')and
(doc.all.item(i).value=' 发送 ') then //发送按钮
begin
inc(ok);//=5
if ok=7 then
doc.all.item(i).click;
end;
end;
end;
end;

procedure Tsmsfrm.FormCreate(Sender: TObject);
begin
loginfrm.showmodal;
r:=0;
url:='www.smschina.com';
sg.Cells[0,0]:='编号';
sg.Cells[1,0]:='内容';
sg.Cells[2,0]:='人气';
sg2.Cells[0,0]:='编号';
sg2.Cells[1,0]:='姓名';
sg2.Cells[2,0]:='性别';
sg2.Cells[3,0]:='手机号';
sg2.Cells[4,0]:='备注';
ini:=tinifile.create(extractfilepath(application.exename)+curuser.phone +'.ini');
readini;
updatephone;
// showmessage(inttostr(length(label10.Caption)));
end;

procedure Tsmsfrm.btnsendClick(Sender: TObject);
var
i1,i2,i3,i4:olevariant;
begin
if length(trim(mycode.Text))<>11 then
begin
messagebox(handle,'请输入您的手机号码。','警告',mb_ok or mb_iconwarning);
mycode.SetFocus;
mycode.SelectAll;
exit;
end;
if trim(mypwd.Text)='' then
begin
messagebox(handle,'请输入您的手机密码。','警告',mb_ok or mb_iconwarning);
mypwd.SetFocus;
mypwd.SelectAll;
exit;
end;
if length(trim(frendcode.Text))<>11 then
begin
messagebox(handle,'请输入对方的手机号码。','警告',mb_ok or mb_iconwarning);
frendcode.SetFocus;
frendcode.SelectAll;
exit;
end;
if trim( memomsg.Text)='' then
begin
messagebox(handle,'不能发送空消息。','警告',mb_ok or mb_iconwarning);
memomsg.SetFocus;
memomsg.SelectAll;
exit;
end;
i1:=0;
i2:=0;
i3:=0;
i4:=0;
web.Navigate(url,i1,i2,i3,i4);
pagecontrol1.ActivePageIndex :=2;
pagecontrol1.OnChange(sender);
end;

procedure Tsmsfrm.WebBeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
begin
edit1.Text :=url;
end;

procedure Tsmsfrm.mycodeClick(Sender: TObject);
begin
mycode.SelectAll ;
end;

procedure Tsmsfrm.mypwdClick(Sender: TObject);
begin
mypwd.SelectAll;
end;

procedure Tsmsfrm.frendcodeClick(Sender: TObject);
begin
frendcode.SelectAll;
end;

procedure Tsmsfrm.memomsgChange(Sender: TObject);
var
i:integer;
j:integer;
begin
j:=0;
for i:=1 to length(trim(memomsg.Text)) do
begin
if bytetype(trim(memomsg.Text),i-1)<>mbleadbyte then
inc(j);
end;
label8.Caption :=inttostr(j);
end;

procedure Tsmsfrm.spMoved(Sender: TObject);
begin
tv.Width :=sp.Left;
sg.Left:=sp.Left +sp.Width;
sg.Width :=panel3.Width -sp.Width -tv.Width-1;
end;

procedure Tsmsfrm.tvClick(Sender: TObject);
var
st:ttreenode;
begin
st:=nil;
if tv.Selected =nil then exit;
if tv.Selected <>nil then
st:=tv.Selected;
if (st=tv.Items[0])or(st=tv.Items[2]) then
exit;
sg.RowCount :=2;
sg.Cells[0,1]:='';
sg.Cells[1,1]:='';
sg.Cells[2,1]:='';
if (st=tv.Items[1])and(fileexists('sms1.txt')) then
updatesg('sms1.txt');
if (st=tv.Items[3])and(fileexists('sms3.txt')) then
updatesg('sms3.txt');
if (st=tv.Items[4]) and(fileexists('sms4.txt'))then
updatesg('sms4.txt');
if (st=tv.Items[5])and(fileexists('sms5.txt')) then
updatesg('sms5.txt');
if (st=tv.Items[6])and(fileexists('sms6.txt')) then
updatesg('sms6.txt');

end;

procedure Tsmsfrm.sgMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
k:integer;
begin
sg.MouseToCell(x,y,c,r);
if r>0 then
begin
label10.Caption :=' '+sg.Cells[1,r];
k:=length(label10.Caption);
k:=((k-1) div 48)+1;
k:=k*18;
label10.Height :=k;
memosms.Height :=k+12;
if trim(label10.Caption) <>'' then
memosms.Visible :=true;
memosms.Top :=y+54;
end
else
memosms.Visible :=false;
end;

procedure Tsmsfrm.tvMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
i:integer;
begin
memosms.Visible :=false;
shape3.Pen.Color :=bkcolor;
shape4.Pen.Color :=bkcolor;
shape5.Pen.Color :=bkcolor;
shape6.Pen.Color :=bkcolor;
shape7.Pen.Color:=bkcolor;
shape8.Pen.Color :=bkcolor;
for i:=9 to 14 do
tshape(smsfrm.FindComponent('shape'+inttostr(i))).Visible :=true;
end;

procedure Tsmsfrm.sgDblClick(Sender: TObject);
begin
if r>1 then
memomsg.Text :=sg.Cells[1,r];
end;

procedure Tsmsfrm.SpeedButton2Click(Sender: TObject);
var
b:boolean;
begin
if trim(edtname.Text)='' then
begin
messagebox(handle,'请输入姓名。','警告',mb_ok or mb_iconwarning);
edtname.SetFocus;
exit;
end;
if (trim(edtphone.Text)='')or(length(trim(edtphone.Text))<>11) then
begin
messagebox(handle,'请输入朋友的手机号码(11位)。','警告',mb_ok or mb_iconwarning);
edtphone.SetFocus;
exit;
end;
b:=rb1.Checked;
writeini(trim(edtname.Text),b,trim(edtphone.text),trim(memo1.Text));
readini;
updatephone;
edtname.Clear;
edtphone.Clear;
memo1.Clear;
edtname.SetFocus;
end;

procedure Tsmsfrm.sg2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
sg2.MouseToCell(x,y,c,cr);
end;

procedure Tsmsfrm.SpeedButton4Click(Sender: TObject);
begin
if cr1<1 then exit;
if messagebox(handle,pchar('您真的要删除"'+trim(sg2.Cells[1,cr1])+'"的联系信息吗？'),'警告',mb_yesno or mb_iconwarning)=id_yes then
begin
deleteini(trim(sg2.Cells[1,cr1]),trim(sg2.Cells[3,cr1]));
readini;
updatephone;
cr1:=0;
end;
end;

procedure Tsmsfrm.sg2Click(Sender: TObject);
begin
cr1:=cr;
end;

procedure Tsmsfrm.myphonebookChange(Sender: TObject);
var
i:integer;
begin
if myphonebook.ItemIndex >-1 then
begin
frendcode.Items.Clear;
for i:=1 to myphonebook.Items.Count do
if trim(myphonebook.Text)=userlist[i-1].name then
begin
frendcode.Items.Add(userlist[i-1].phone);
end;
if frendcode.Items.Count >0 then
frendcode.ItemIndex :=0;
end;
end;

procedure Tsmsfrm.edtnameKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
begin
edtphone.SetFocus;
edtphone.SelectAll;
exit;
end;
end;

procedure Tsmsfrm.edtphoneKeyPress(Sender: TObject; var Key: Char);
begin
if (key<'0')or(key>'9') then
if key<>#8 then key:=#0;

end;

procedure Tsmsfrm.SpeedButton3Click(Sender: TObject);
begin
if cr1<1 then exit;
modifrm.showmodal;
end;

procedure Tsmsfrm.sg2DblClick(Sender: TObject);
begin
cr1:=cr;
if cr1>0 then
modifrm.ShowModal;
end;

procedure Tsmsfrm.Shape10MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
sp:tshape;
k:string;
begin
sp:=(sender as tshape);
sp.Visible :=false;
k:=sp.Name;
k:=copy(k,6,length(k)-5);
tshape(smsfrm.FindComponent('shape'+inttostr(strtoint(k)-6))).pen.color:=clblue;
end;

procedure Tsmsfrm.btntimesendClick(Sender: TObject);
begin
ismodi:=true;
regfrm.showmodal;
end;

procedure Tsmsfrm.Label13Click(Sender: TObject);
begin
shellexecute(0,nil,'http://www.smschina.com',nil,nil,9);
end;

procedure Tsmsfrm.memomsgKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then key:=#0;
end;

（出处：www.delphibbs.com）