这是多线程部分源码
unit Unit_TSearch;interface
uses
  Classes,inifiles,MSHTML,IdHTTP,Forms,StdCtrls,Dialogs,Controls,
  SysUtils,ShDocVw,Variants,ActiveX,StrUtils,
  AllFunction{部分函数};Type
  TSearch = class(TThread)
  private    MyINI:Tinifile;
    OldHTML,NewHTML:String;     //新源码,旧源码
    Links_BBS,Links_All,Links_URLKey:TStringList;    URL:String;     //搜索URL
    SearchKey,SearchType:String;  //搜索关键字,类型
    SearchStart:Integer;          //搜索开始位置    bShowTip:Boolean;             //搜索提示
  protected
    Procedure Search;
    Procedure GetURL;
    Procedure GetKey(iType:integer);
    Procedure OpenURL;
    Procedure GetAllLinks;
    Procedure GetLinks;
    Procedure SaveURLtoFile;
  public
    constructor Create(sKey,sType:String;CreateSuspended: Boolean);
    destructor  Destroy;override;
    Procedure   Execute;override;
End;implementation
{------------------------------------------------------------------------------}
constructor TSearch.Create(sKey,sType:String;CreateSuspended: Boolean);
Begin
  SearchKey:=UpperCase(sKey);
  SearchType:=UpperCase(sType);
  SearchStart:= -10;
  
  MyINI:=Tinifile.Create(GetAppPath+'BBS.ini');
  Links_BBS:=TStringList.Create;
  Links_All:=TStringList.Create;
  Links_URLKey:=TStringList.Create;
  inherited Create(CreateSuspended);
  Priority := tpIdle;
End;
{------------------------------------------------------------------------------}
destructor  TSearch.Destroy;
Begin
  MyINI.Free;
  Links_BBS.Destroy;
  Links_All.Destroy;
  Links_URLKey.Destroy;
  inherited Destroy;
End;
{------------------------------------------------------------------------------}
Procedure TSearch.Execute;
Begin
  while not Terminated do
  Begin
    Synchronize(Search);
    Application.ProcessMessages;
  End;
End;
{------------------------------------------------------------------------------}
Procedure TSearch.Search;
Begin
  GetURL;
  OpenURL;
  GetAllLinks;
  GetLinks;
  //SaveURLtoFile;
End;
{------------------------------------------------------------------------------}
Procedure TSearch.GetURL;
Begin
  if (Myini.ReadInteger('Search','Completed',1)=0) and (NOT bShowTip) Then   // 0未完成 1完成
  Begin
    if MessageDlg('上次搜索未完成,是否载入上次搜索进度?',mtInformation,[mbYes,mbNo],0) = mrYes Then
      GetKey(0)
    Else
      GetKey(1);
  End
  Else
    GetKey(1);  if SearchType='BAIDU' Then
    URL:='http://www.baidu.com/s?lm=0&si=&rn=10&ie=gb2312&ct=0&wd='+URLEncode(SearchKey)+'&pn='+InttoStr(SearchStart)+'&cl=3'
  Else if SearchType='GOOGLE' Then
    URL:='http://www.google.com/search?q='+URLEncode(SearchKey)+'&hl=zh-CN&lr=&newwindow=1&start='+Inttostr(SearchStart)+'&sa=N';
End;
{------------------------------------------------------------------------------}
Procedure TSearch.GetKey(iType:integer);
Begin
  Case iType OF
    0:Begin
        //载入
        SearchKey:=MyINI.ReadString('Search','Key','论坛');
        SearchType:=MyINI.ReadString('Search','Type','BAIDU');
        SearchStart:=MyINI.ReadInteger('Search','Start',-10);
      End;
    1:Begin
        //不载入
        MyINI.WriteString('Search','Key',SearchKey);
        MyINI.WriteString('Search','Type',SearchType);
      End;
  End;
  
  bShowTip:=True;
  SearchStart:=SearchStart+10;
  Myini.WriteInteger('Search','Start',SearchStart);
  Myini.WriteInteger('Search','Completed',0);
End;
{------------------------------------------------------------------------------}
Procedure TSearch.OpenURL;
var
  IdHTTP:TidHTTP;
Begin
  IdHTTP:=TidHTTP.Create(Application);
  Try
    NewHTML:=IdHTTP.Get(URL);
  Finally
    IdHTTP.Free;
  End;  //判断是否结束
  if (Length(NewHTML)>0) and (Length(OldHTML)>0) Then
  Begin
    if Length(NewHTML)=Length(OldHTML) Then
    Begin
      MyINI.WriteInteger('Search','Completed',1);
      bShowTip:=False;
      OldHTML:='';
      ShowMessage('搜索完成');
      Self.Terminate;
    End
    Else
      OldHTML:=NewHTML;
  End
  Else
    OldHTML:=NewHTML;
End;
{------------------------------------------------------------------------------}
Procedure TSearch.GetAllLinks;
var
  IDoc:IHtmlDocument2;
  Link:IHTMLElement;
  MyVariant:oleVariant;
  WB:TWebBrowser;
  iTmp,iLinkLength:integer;
  sLink:String;
Begin
  if Length(NewHTML)<500 Then EXIT;  WB:=TWebBrowser.Create(NIL);
  WB.Silent:=True;  Try
    WB.Navigate('about:blank');
    IDoc:=WB.Document as IHtmlDocument2;    if (Assigned(IDoc)) then
    Begin
      MyVariant:=VarArrayCreate([0,0],varVariant);
      MyVariant[0]:=NewHTML;
      IDoc.Write(PSafeArray(TVarData(MyVariant).VArray));
      iLinkLength:=IDoc.Links.Length;      if iLinkLength<2 Then
      Begin
        WB.Free;
        EXIT;
      End;      for iTmp:=0 to (iLinkLength - 1) do
      Begin
        Link:=IDoc.Links.Item(iTmp,0) as IHTMLElement;
        sLink:=Link.ToString;        if Pos('about:blank',sLink)>0 Then
          sLink:=URL+'/'+MidBStr(sLink,12,Length(sLink));
        if Pos('javascript',sLink)>0 Then Continue;
        Links_All.Add(sLink);
      End;
    End;
  Finally
    IDoc.close;
    WB.Free;
  End;
End;
{------------------------------------------------------------------------------}
Procedure Tsearch.GetLinks;
var
  SearchKey1,SearchKey2:String;
  i:Integer;
  sTmp:String;
  Label DELStart;
Begin
  if SearchType='BAIDU' then
    SearchKey1:='BAIDU'
  Else if SearchType='GOOGLE' then
  Begin
    SearchKey1:='GOOGLE';
    SearchKey2:='72.14.235.104';
  end;  DELStart:
  if Links_All.Count<1 then EXIT;  For i:=0 to Links_All.Count - 1 DO
  Begin
    sTmp:=UpperCase(Links_All.Strings[i]);
    if Pos(SearchKey1,sTmp)>0 then
    Begin
      Links_All.Delete(i);
      Goto DELStart;
    End
    Else
    Begin
      if SearchKey2<>'' then
      Begin
        if Pos(SearchKey2,sTmp)>0 Then
        Begin
          Links_All.Delete(i);
          Goto DELStart;
        End
        Else
        Begin
          RightPos('/',sTmp);
          Links_BBS.Add(LowerCase(sTmp));
          Links_All.Delete(i);
          Goto DELStart;
        End;
      End
      Else
      Begin
        RightPos('/',sTmp);
        Links_BBS.Add(LowerCase(sTmp));
        Links_All.Delete(i);
        Goto DELStart;
      End;
    End;
  End;
End;
{------------------------------------------------------------------------------}
Procedure TSearch.SaveURLtoFile;
Begin
  Links_BBS.SaveToFile(GetAppPath+'SearchBBS.txt');
End;
{------------------------------------------------------------------------------}
end.
主界面调用
procedure TForm1.Button_SerchClick(Sender: TObject);
begin
  Button_SearchStop.Enabled:=True;
  TMySearch:=TSearch.Create(Edit_SearchKey.Text,ComboBox_Search.Text,False);
end;procedure TForm1.Button_SearchStopClick(Sender: TObject);
begin
  if Button_SearchStop.Caption='暂停' Then
  Begin
    Button_SearchStop.Caption:='继续';
    TMySearch.Suspend;
  End
  Else
  Begin
    Button_SearchStop.Caption:='暂停';
    TMySearch.Resume;
  End;
end;