unitsitesearch.pas

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

unit UnitSiteSearch;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, DBTables, IdHTTP, ADODB;

type

  //定义百度搜索类
  TBaiduSite = class(TThread)
    procedure BaiduSite ;
    procedure ThreadSiteDone(Sender: TObject);
  protected
    procedure Execute; override;
  public
    constructor Create;
  end;


//procedure SiteDecrease;
//procedure ShowComplete(Engine: string);

implementation

uses MainFrm, CustomSearchFrm, SiteSearchFrm;

//构造每个搜索类线程
constructor TBaiduSite.Create;
begin
  FreeOnTerminate:=True;
  OnTerminate:=ThreadSiteDone;
  inherited Create(False);
end;


//定义每个线程的执行操作
procedure TBaiduSite.Execute;
begin
  BaiduSite;
end;


//用百度搜索引擎进行搜索
procedure TBaiduSite.BaiduSite ;
var
  Code,Link,Head,Content,AURL:string;
  i,j,Index,Total,Page:Integer;
  Match:Boolean;
  ASource:TStringList;
  idhttpHTTP:TIdHTTP;
  qrySearch,qryCheck:TADOQuery;
begin
  //初始化每个用到的控件
  ASource:=TStringList.Create;
  idhttpHTTP:=TIdHTTP.Create(nil);
 // 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(chr(6)));
  qrySearch.Edit;
 // qryCheck:=TQuery.Create(nil);
 // qryCheck.DatabaseName:=extractfilepath(application.ExeName)+'database';
 // frmMain.MyExecSQL(qryCheck,'select * from temp');
  qryCheck:=TADOQuery.Create(nil);
  qryCheck.Connection:=frmMain.AdocnDate;
  frmMain.MyExecSQL(qryCheck,'select * from temp where ID='+quotedstr(chr(6)));
  qryCheck.Active:=True;

  with qrySearch do
  begin
    try
      //向第一个搜索引擎发送信息
      AURL:='http://www1.baidu.com/baidu?word='+frmSiteSearch.edtKeyword.text;
      ASource.Add('');

      Code:=idhttpHTTP.Post(AURL,ASource);
      //获取总搜索条数
      Total:=strtoint(DelSubStr(',',GetStrBetween(Code,'百度为您找到相关网页约','篇')));
      //计算页数
      Page:=Total div 10;
      if (Total mod 10)<>0 then
        Page:=Page+1;

      //处理所有结果
      for i:=0 to Page-1 do
      begin
        AURL:='http://www1.baidu.com/baidu?word='+frmSiteSearch.edtKeyword.text+'&pn='+IntToStr(i*10);
        //向第一个搜索引擎发送信息
        Code:=idhttpHTTP.Post(AURL,ASource);

        for j:=1 to 10 do
        begin

          FieldByName('ID').AsString:=chr(6);

          Match:=False;
          Index:=i*10+j;

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

          //截取序号后面的代码
          Code:=Copy(Code,Pos('<p class=p2>',Code),Length(Code));

          //截取链接
          Link:=GetStrBetween(Code,'href=',' target=_blank>');
          domain:=DelSubStr('http://',domain);
          domain:=DelSubStr('www.',domain);
          if pos(domain,link)>0 then
          begin
          //检测重复
            with qryCheck do
            begin
              SQL.Clear;
              SQL.Add('select * from temp where ID='+quotedstr(chr(6))+' and link='''+Link+'''');
              Open;
              if RecordCount>0 then
              begin
                //截取结束标记后面的代码
                Code:=Copy(Code,Pos('</a>',Code),Length(Code));
                Continue;
              end;
            end;
            if Pos('.com',domain)>0 then FieldByName('Type').AsString:='商业网';
            if Pos('.net',domain)>0 then FieldByName('Type').AsString:='公众网';
            if Pos('.edu',domain)>0 then FieldByName('Type').AsString:='教育网';
            if not(Pos('.com',Link)>0) and not(Pos('.net',Link)>0) and not(Pos('.edu',Link)>0)
              then FieldByName('Type').AsString:='其它';
            FieldByName('Link').AsString:=Link;
          end
          else
          begin
          //截取结束标记后面的代码
            Code:=Copy(Code,Pos('</a>',Code),Length(Code));
            Continue;
          end;
         

          //截取标题   end;
          Head:=GetStrBetween(Code,'target=_blank>','</a>');
          //删除无用的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);
          //放入数据库
          FieldByName('Head').AsString:=Head;

          //截取内容
          Content:=GetStrBetween(Code,'<font size=-1>','<font color=#008000>');
          //删除无用的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);
          //无内容
          if (Pos(#13,Content)>0) or (Content='') then
            Content:='无可显示内容';
          //放入数据库
          FieldByName('Content').AsString:=Content;

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

          Insert;

          //截取结束标记后面的代码
          Code:=Copy(Code,Pos('</a>',Code),Length(Code));
        end;
      end;
    except
    end;
  end;
end;

//定义每个线程结束的动作
procedure TBaiduSite.ThreadSiteDone(Sender: TObject);
begin
  frmSiteSearch.lblState.Caption:='搜索完成!';
  frmSiteSearch.tmRefresh.Enabled:=false;
  frmSiteSearch.Refresh;
  frmSiteSearch.bbtnOK.Caption:='搜索';
  //SiteDecrease;
  //ShowComplete('百度');

end;
{
procedure SiteDecrease;
begin
  Dec(EngineAmount);
  if EngineAmount=0 then
    with frmCustomSearch do
    begin
      CustomSearchFrm.Finished:=True;
      stbStatusBar.Panels[0].Text:='完成';
      sbSearch.BringToFront;
      sbPause.Enabled:=False;
      sbResume.Enabled:=False;
      fraInput.Enabled:=True;
    end;
end;

//提示完成
procedure ShowComplete(Engine: string);
begin
  ShowMessage(Engine+'搜索完成！');
end; }

end.