websearchholder.pas

ThreadPro 是本人开发的一套用于多线程编程的 Delphi 基础类库

{ used in demo3

demo3 中我独立出了这个单元专门封装了一个TWebSearchHolder类来直接从最上层控制搜索宝的基本操作
这样逻辑更为清晰，层次更加明了，main单元中的代码也简化了，无需再定义并实现对应的事件处理函数
因为所有这些都在该类中做了。
你可以在main单元的FormCreate中看到该类的初始化

}
unit WebSearchHolder;

interface

uses
  SysUtils, ComCtrls, StdCtrls, Classes, Forms, CheckLst,
  ThreadPool, ThreadTask, MyHTTPtask, MyThreadPool,
  ActnList, Define;

type
  TWebSearchHolder = class
  private
    _WebSearchPool : TWebSearchPool;
  protected
    function LoadWebSearchTask(TaskList : TThreadList) : Integer;
    procedure WebSearchPoolDone(Sender : TObject);
    procedure WebSearchPoolStop(Sender : TObject);
    procedure Terminate;
  public
    _EngineChkLst : TCheckListBox;
    _OnTerminate : TNotifyEvent;
    H_KEYWORD : string;
    H_PAGENUM : Integer;
    H_TERM_PRO_BAR : TProgressBar;
    H_PROGRESS_BAR : TProgressBar;
    H_OnSrhRetFind : TSrhRetFindEvent;
    //
    _AC_START : TAction;
    _AC_PAUSE : TAction;
    _AC_GOON  : TAction;
    _AC_STOP  : TAction;
    //
    procedure SetActStatus(Status : TBtnStatEx);
    procedure Start;
    procedure Pause;
    procedure Goon;
    procedure Stop;
    constructor Create;
    destructor Destroy;override;
  end;

implementation

uses
  HTTPutil;

constructor TWebSearchHolder.Create;
begin
  inherited;
  H_PAGENUM := 10;
end;

destructor TWebSearchHolder.Destroy;
begin
  if _WebSearchPool<>nil then
  begin
    _WebSearchPool.Stop;
    FreeAndNil(_WebSearchPool);
  end;
  inherited;
end;

procedure TWebSearchHolder.SetActStatus(Status : TBtnStatEx);
  procedure SetAct(Act : TAction; Enable : Boolean);
  begin
    if Act <> nil then Act.Enabled := Enable;
  end;
begin
  SetAct(_AC_START,ABtnEnabEx[Integer(Status),Integer(btxStart)]);
  SetAct(_AC_GOON ,ABtnEnabEx[Integer(Status),Integer(btxGoon )]);
  SetAct(_AC_STOP ,ABtnEnabEx[Integer(Status),Integer(btxStop )]);
  SetAct(_AC_PAUSE,ABtnEnabEx[Integer(Status),Integer(btxPause)]);
end;

procedure TWebSearchHolder.WebSearchPoolDone(Sender : TObject);
begin
  FreeAndNil(_WebSearchPool);
  SetActStatus(bsxNull);
  Terminate;
end;

procedure TWebSearchHolder.WebSearchPoolStop(Sender : TObject);
begin
  FreeAndNil(_WebSearchPool);
end;

procedure TWebSearchHolder.Terminate;
begin
  if Assigned(_OnTerminate) then
  _OnTerminate(Self);
end;

function TWebSearchHolder.LoadWebSearchTask(TaskList : TThreadList): Integer;
var
  i : Integer;
  Param,P : PWebEngineObj;
begin
  Result := 0;
  with _EngineChkLst do
  for i:=Count-1 downto 0 do
  begin
    if Checked[i] then
    begin
      GetMem(Param,SizeOf(TWebEngineObj));
      P := PWebEngineObj(Items.Objects[i]);
      Param^.Site := P^.Site ;
      LoadTask(i,Param,TaskList);
      Inc(Result);
    end;
  end;
end;

procedure TWebSearchHolder.Start;
begin
  if _WebSearchPool <> nil then exit;
  SetActStatus(bsxRunning);
  _WebSearchPool := TWebSearchPool.Create;
  with _WebSearchPool do
  begin
    P_KEY_WORD := H_KEYWORD;
    P_PAGE_NUM := H_PAGENUM;
    P_OnSrhRetFind := H_OnSrhRetFind;
    _OnForceStop := WebSearchPoolStop;
    _OnTerminate := WebSearchPoolDone;
    _THREAD_COUNT := LoadWebSearchTask(_TASK_LIST);
    if _THREAD_COUNT=0 then
    begin
      MsgBox('你必须至少选择一个引擎！',0);
      SetActStatus(bsxNull);
      FreeAndNil(_WebSearchPool);
      Exit;
    end;
    Start;
  end;
end;

procedure TWebSearchHolder.Pause;
begin
  if _WebSearchPool=nil then exit;
  SetActStatus(bsxPaused);
  _WebSearchPool.Pause;
end;

procedure TWebSearchHolder.Goon;
begin
  if _WebSearchPool=nil then exit;
  SetActStatus(bsxRunning);
  _WebSearchPool.Goon;
end;

procedure TWebSearchHolder.Stop;
begin
  if _WebSearchPool=nil then exit;
  SetActStatus(bsxNull);
  _WebSearchPool.Stop;
end;

end.