unitsearch.pas

《Delphi实例开发教程》源代码包说明

  //调用搜索过程进行第一次搜索
  Search(YahooID);

  //设定标识符记录结构体
  YahooID.URL:='http://cn.websearch.yahoo.com/search/web_cn?';
  YahooID.TotalPrev:='共找到'+#$A+'<b class="yge">';
  YahooID.TotalRear:=' </b>个';
  YahooID.KeywordID:='p';
  YahooID.PageID:='b';
  YahooID.ItemAmountPerPage:=10;
  YahooID.PageIndex:=10;
  YahooID.PageBegin:=1;
  YahooID.HasNO:=False;
  YahooID.ItemPrev:='<li>';
  YahooID.ItemRear:='</a>';
  YahooID.LinkPrev:='/?';
  YahooID.LinkRear:=''' target=''_blank''>';
  YahooID.HeadPrev:='target=''_blank''>';
  YahooID.HeadRear:='</a>';
  YahooID.ContentPrev:='<small>';
  YahooID.ContentRear:='</small>';
  YahooID.Source:='雅虎';

  //调用搜索过程进行第二次搜索
  Search(YahooID);
end;

//当连接成功时，马上断开连接，并记录连接成功
procedure TMyIdHTTP.Connected(Sender: TObject);
begin
  with (Sender as TMyIdHTTP) do
  begin
    Disconnect;
    GotWebPage:=True;
  end;
end;

//对搜索引擎进行搜索
procedure Search(Identifier: TIdentifier);
var
  AURL,Code,Link,Head,Content,ItemHead:string;
  i,j,Index,Total,Page:Integer;
  Match:Boolean;
  idhttpHTTP:TIdHTTP;
  idhttpTest:TMyIdHTTP;
 // qrySearch,qryCheck:TQuery;
  qrySearch,qryCheck:TADOQuery;
begin
  //初始化每个用到的控件

  idhttpHTTP:=TIdHTTP.Create(nil);

  idhttpTest:=TMyIdHTTP.Create(nil);
  //定义用户的超时
  idhttpTest.ReadTimeout:=TimeLimit*1000;
  //定义连接成功事件
  idhttpTest.OnConnected:=idhttpTest.Connected;

 // qrySearch:=TQuery.Create(nil);
  //qrySearch.DatabaseName:=extractfilepath(application.ExeName)+'database';
  //qrySearch.RequestLive:=True;
  qrySearch:=TADOQuery.Create(nil);
  qrySearch.Connection:=frmMain.AdocnDate;
  frmMain.MyExecSQL(qrySearch,'select * from temp where ID='+quotedstr(ID));

  qrySearch.Edit;

  //qryCheck:=TQuery.Create(nil);
 // qryCheck.DatabaseName:=extractfilepath(application.ExeName)+'database';
  qryCheck:=TADOQuery.Create(nil);
  qryCheck.Connection:=frmMain.AdocnDate;
  frmMain.MyExecSQL(qryCheck,'select * from temp where ID='+quotedstr(ID));
  qryCheck.Active:=True;

  //开始搜索                  
  with qrySearch do
  begin

    try
      //向搜索引擎发送关键字信息
      AURL:=Identifier.URL+Identifier.KeywordID+'='+CustomSearchFrm.Keyword;
      Code:=idhttpHTTP.Get(AURL);
      //获取总搜索条数
      Total:=strtoint(DelSubStr(',',GetStrBetween(Code,Identifier.TotalPrev,Identifier.TotalRear)));
      //计算页数
      Page:=Total div Identifier.ItemAmountPerPage;
      if (Total mod Identifier.ItemAmountPerPage)<>0 then
        Page:=Page+1;

      //处理所有结果
      for i:=0 to Page-1 do
      begin
        //向搜索引擎发送关键字和翻页信息
        AURL:=Identifier.URL+Identifier.KeywordID+'='+CustomSearchFrm.Keyword;
        AURL:=AURL+'&'+Identifier.PageID+'='+IntToStr(i*Identifier.PageIndex+Identifier.PageBegin);
        //取回页面，保持链接
        Code:=idhttpHTTP.Get(AURL);

        //每返回一页，对当页所有记录处理
        for j:=1 to Identifier.ItemAmountPerPage do
        begin

//          idhttpHTTP.Get(AURL);

          //记录ID
          FieldByName('ID').AsString:=CustomSearchFrm.ID;

          //还原Match值为False，用于检测网站类型
          Match:=False;
          //Index表示当前是第几条记录
          Index:=i*Identifier.ItemAmountPerPage+j;

          //如果截取完所有信息，退出
          if Index>Total then
            Exit;

          //截取序号后面的代码
          ItemHead:='';
          if Identifier.HasNO then
            ItemHead:=IntToStr(Index);
          ItemHead:=ItemHead+Identifier.ItemPrev;
          Code:=Copy(Code,Pos(ItemHead,Code),Length(Code));

          //截取链接
          Link:=GetStrBetween(Code,Identifier.LinkPrev,Identifier.LinkRear);

          //检测重复
          with qryCheck do
          begin
            SQL.Clear;
            SQL.Add('select * from temp where link='''+Link+''' and ID='''+ID+'''');
            Open;
            //有重复地址
            if RecordCount>0 then
            begin
              //截取结束标记后面的代码，即取下一个记录
              Code:=Copy(Code,Pos(Identifier.ItemRear,Code),Length(Code));
              Continue;
            end;
          end;

          //检测类型
          //商业网
          with frmCustomSearch.fraInput do
          begin

            if clbWebtype.Checked[0] then
              if Pos('.com',Link)>0 then
              begin
                FieldByName('Type').AsString:='商业网';
                Match:=True;
              end;

            //公众网
            if clbWebtype.Checked[1] then
              if Pos('.net',Link)>0 then
              begin
                FieldByName('Type').AsString:='公众网';
                Match:=True;
              end;
            //教育网
            if clbWebtype.Checked[2] then
              if Pos('.edu',Link)>0 then
              begin
                FieldByName('Type').AsString:='教育网';
                Match:=True;
              end;
            //其他网
            if clbWebtype.Checked[3] then
              if not(Pos('.com',Link)>0) and not(Pos('.net',Link)>0) and not(Pos('.edu',Link)>0)  then
              begin
                FieldByName('Type').AsString:='其他';
                Match:=True;
              end;
            //网站类型匹配
            if Match then
              FieldByName('Link').AsString:=Link
            else
            begin
              //截取结束标记后面的代码
              Code:=Copy(Code,Pos(Identifier.ItemRear,Code),Length(Code));
              Continue;
            end;
          end;

          with idhttpTest do
          begin
            //重置为没有获取页面
            GotWebPage:=False;

            //检测链接
            //检测页面存在
            try
              Get(Link);
            except
              //没有获取到页面
              if not(GotWebPage) then
              begin
                //截取结束标记后面的代码
                Code:=Copy(Code,Pos(Identifier.ItemRear,Code),Length(Code));
                Continue;
              end;
            end;
          end;

          with idhttpHTTP do
          begin
            //获取头信息
            try
              Head(Link);
              FieldByName('Datetime').AsDateTime:=Response.Date;
            except
              FieldByName('Datetime').AsString:='';
            end;
          end;

          //截取标题
          Head:=GetStrBetween(Code,Identifier.HeadPrev,Identifier.HeadRear);
          //删除无用的html标识符
          Head:=DelSubStr('<B>',Head);
          Head:=DelSubStr('</B>',Head);
          Head:=DelSubStr('<b>',Head);
          Head:=DelSubStr('</b>',Head);
          Head:=DelSubStr('<font color=#e10900>',Head);
          Head:=DelSubStr('</font>',Head);
          Head:=DelSubStr('<font color=RED>',Head);
          Head:=DelSubStr('<font color="red">',Head);
          Head:=DelSubStr('&lt;',Head);
          Head:=DelSubStr('gt;',Head);
          Head:=DelSubStr('quot',Head);
          //放入数据库
          FieldByName('Head').AsString:=Head;

          //截取内容
          Content:=GetStrBetween(Code,Identifier.ContentPrev,Identifier.ContentRear);
          //删除无用的html标识符
          Content:=DelSubStr('<B>',Content);
          Content:=DelSubStr('</B>',Content);
          Content:=DelSubStr('<b>',Content);
          Content:=DelSubStr('</b>',Content);
          Content:=DelSubStr('<font color=#e10900>',Content);
          Content:=DelSubStr('</font>',Content);
          Content:=DelSubStr('<br>',Content);
          Content:=DelSubStr('<font color=RED>',Content);
          Content:=DelSubStr('<font color="red">',Content);
          Content:=DelSubStr('&lt;',Content);
          Content:=DelSubStr('&gt;',Content);
          Content:=DelSubStr('&amp',Content);
          Content:=DelSubStr('&quot',Content);
          Content:=DelSubStr('gt;',Content);
          Content:=DelSubStr(#$D,Content);
          Content:=DelSubStr(#$A,Content);
          Content:=DelSubStr(#9,Content);
          //无内容
          if (Pos(#13,Content)>0) or (Content='') then
            Content:='无可显示内容';
          //放入数据库
          FieldByName('Content').AsString:=Content;

          //记录来源
          FieldByName('Source').AsString:=Identifier.Source;

          Insert;

          //截取结束标记后面的代码
          Code:=Copy(Code,Pos(Identifier.ItemRear,Code),Length(Code));
        end;
      end;

    except
    end;
    
  end;
end;

//定义每个线程结束的动作
procedure TBaiduSearch.ThreadDone(Sender: TObject);
begin
  BaiduStarted:=False;
  Decrease;
  ShowDone('百度');
end;

procedure TGoogleSearch.ThreadDone(Sender: TObject);
begin
  GoogleStarted:=False;
  Decrease;
  ShowDone('Google');
end;

procedure T_21cnSearch.ThreadDone(Sender: TObject);
begin
  _21cnStarted:=False;
  Decrease;
  ShowDone('21cn');
end;

procedure TSinaSearch.ThreadDone(Sender: TObject);
begin
  SinaStarted:=False;
  Decrease;
  ShowDone('新浪');
end;

procedure TSohuSearch.ThreadDone(Sender: TObject);
begin
  SohuStarted:=False;
  Decrease;
  ShowDone('搜狐');
end;

procedure TYahooSearch.ThreadDone(Sender: TObject);
begin
  YahooStarted:=False;
  Decrease;
  ShowDone('雅虎');
end;

procedure Decrease;
begin
  //每当一个搜索引擎完成搜索，搜索引擎数减一
  Dec(EngineSelected);
  //所有引擎搜索完毕
  if EngineSelected=0 then
    with frmCustomSearch do
    begin       
      //显示搜索键
      sbSearch.Show;
      //隐藏停止键
      sbStop.Hide;
      //禁用暂停键
      sbPause.Enabled:=False;
      //禁用继续键
      sbResume.Enabled:=False;
      //启用输入
      EnableCustom;
      //标志完成
      Finished:=True;
      //状态栏提示
      stbStatusBar.Panels[0].Text:='完成';  
      //停止刷新
      tmRefresh.Enabled:=False;
      //停止计时
      tmTimeCost.Enabled:=False;
    end;
end;

//提示完成
procedure ShowDone(Engine: string);
begin
//  ShowMessage(Engine+'搜索完成！');
  frmCustomSearch.stbStatusBar.Panels[1].Text:=frmCustomSearch.stbStatusBar.Panels[1].Text+'  '+Engine;
end;

end.