没什么技术含量、无聊弄的、
D2010 + Windows7下没有问题
实际上就一个函数而已、在执行的时候可能会程序程序假死以及网络被大量占用的情况、
此时不要结束程序、等待运行完毕后即正常
（如果很在意程序的假死、可以先不要显示listview、全部获取完毕后再次显示listview、就不会假死了）
procedure TForm1.FormCreate(Sender: TObject); var nLoop,i:Cardinal; Html,gMail:string; Reg,RegSp,RegMail:TPerlRegEx; aLinker:string; begin Self.Show; Reg:=TPerlRegEx.Create(Self); RegSp:=TPerlRegEx.Create(Self); RegMail:=TPerlRegEx.Create(Self); nLoop:=StrToInt(InputBox('','找前几页？','')); idhtp1.Request.UserAgent:='Mozilla/5.0 (Windows; U; Windows NT 6.1; zh-CN; rv:1.9.2.8) Gecko/20100722 Firefox/3.6.8'; idhtp1.HandleRedirects:=True; //Self.Enabled:=False; for i := 0 to nLoop - 1 do begin try Html:=idhtp1.Get({idhtp1.URL.URLEncode}( 'http://tieba.baidu.com/f?ct=352452608&lm=65536&rs1=0&rs2=1&rs5=0&rs6=0&rn=10&word=%D3%CA%CF%E4&sn=&un=&tn=baiduPostSearch&pn=' + IntToStr(i * 10) )); except Html:=''; end; Reg.Subject:=Html; Reg.RegEx:='<span\x20class="tit">.*</span>'; while Reg.MatchAgain do begin RegSp.Subject:=Reg.MatchedExpression; RegSp.RegEx:='"/f\?.*?"'; if RegSp.Match then begin aLinker:=RegSp.MatchedExpression; aLinker:=StringReplace(aLinker,'"','',[rfReplaceAll]); try gMail:=idhtp1.Get(StringReplace( idhtp1.URL.URLEncode( 'http://tieba.baidu.com' + aLinker), 'amp;','',[rfReplaceAll]) ); except gMail:=''; end; RegMail.Subject:=gMail; RegMail.RegEx:='[a-zA-Z0-9-_]{1,}@.*?\.[a-zA-Z0-9-_]{1,}'; while RegMail.MatchAgain do begin with lv1.Items.Add do begin Caption:=IntToStr(lv1.Items.Count + 1); SubItems.Add(RegMail.MatchedExpression); Application.ProcessMessages; end; end; end; Application.ProcessMessages; end; end; //Self.Enabled:=True; ShowMessage('检索完成'); end;
