customsearchfrm.pas

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

unit CustomSearchFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBTables, StdCtrls, ExtCtrls, ComCtrls, Grids, DBGrids,
  Buttons, CheckLst, QRCtrls, QuickRpt, Shellapi, Menus, InputFra;

type
  TfrmCustomSearch = class(TForm)
    pnlView: TPanel;
    pnlBar: TPanel;
    cbSort: TComboBox;
    pnlForDisplay: TPanel;
    rbAscend: TRadioButton;
    rbDescend: TRadioButton;
    fraInput: TfraInput;
    splSplitter: TSplitter;
    stbStatusBar: TStatusBar;
    tmRefresh: TTimer;
    sbSaveToInfo: TSpeedButton;
    sbStop: TSpeedButton;
    sbResume: TSpeedButton;
    sbPause: TSpeedButton;
    sbSearch: TSpeedButton;
    tmTimeCost: TTimer;
    sbOpenBrowser: TSpeedButton;
    procedure rbSelectClick(Sender: TObject);
    procedure ClearKeyword;
    procedure RestoreKeyword;
    procedure GetKeyword;
    procedure tvIDListChange(Sender: TObject; Node: TTreeNode);
    procedure FormShow(Sender: TObject);
    procedure sbMaintainClick(Sender: TObject);
    procedure sbSaveIDClick(Sender: TObject);
    procedure DeleteTempDB;
//    procedure Deal;
    procedure FormCreate(Sender: TObject);
    procedure DisplayResult(ID: string);
    procedure cbSortChange(Sender: TObject);
    procedure EnableCustom;                  
    procedure DisableCustom;
    procedure sbSearchClick(Sender: TObject);
    procedure leIDEnter(Sender: TObject);
    procedure rbAscendClick(Sender: TObject);
    procedure rbDescendClick(Sender: TObject);
    procedure fraInput1tvIDListExit(Sender: TObject);
    procedure tmRefreshTimer(Sender: TObject);
    procedure sbStopClick(Sender: TObject);
    procedure sbPauseClick(Sender: TObject);
    procedure sbResumeClick(Sender: TObject);
    procedure sbSaveToInfoClick(Sender: TObject);
    procedure fraInputleKeywordKeyPress(Sender: TObject; var Key: Char);
    procedure tmTimeCostTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure fraInputedtKeyword1KeyPress(Sender: TObject; var Key: Char);
    procedure fraInputedtKeyword2KeyPress(Sender: TObject; var Key: Char);
    procedure fraInputedtKeyword3KeyPress(Sender: TObject; var Key: Char);
    procedure sbOpenBrowserClick(Sender: TObject);
//    procedure sbSearchClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmCustomSearch: TfrmCustomSearch;
  SortString: array[0..3] of string;
  ID,Keyword: string;
  TimeLimit: Integer;
  EngineSelected: Integer;
  BaiduStarted,GoogleStarted,_21cnStarted,SinaStarted,SohuStarted,YahooStarted: Boolean;
  Finished: Boolean;
  ResultCount: Integer;
  Page: Integer;

function CheckInput:Boolean;
function SaveCustom:Boolean;

implementation

uses MainFrm, MaintainFrm, BrowserFrm, DisplayFrm, UnitSearch, SettingFrm;

{$R *.dfm}

var
  BaiduSearch:TBaiduSearch;
  GoogleSearch:TGoogleSearch;
  _21cnSearch:T_21cnSearch;
  SinaSearch:TSinaSearch;
  SohuSearch:TSohuSearch;
  YahooSearch:TYahooSearch;

//读取用户定制ID，列表显示
procedure TfrmCustomSearch.rbSelectClick(Sender: TObject);
var
  i:Integer;
begin

  with fraInput do
  begin
    sbMaintain.Enabled:=False;
    //清除关键字
    edtKeyword1.Clear;
    edtKeyword2.Clear;
    edtKeyword3.Clear;
    //还原网站类型和搜索引擎为空
    frmMain.RestoreList(clbWebType,0);
    frmMain.RestoreList(clbEngine,0);

    //点击选择ID按钮
    if rbSelect.Checked=true then
    begin
      tvIDList.FullExpand;
      tvIDList.Enabled:=True;
      PnlNewInput.Enabled:=False;
      sbSaveID.Enabled:=False;
      sbSearch.Enabled:=False;
      tvIDlist.Items.Clear;
      tvIDList.Items.AddFirst(nil,'用户定制ID');
     // with frmMain.qryCustom do
        with frmMain.AdoqCustom do
        begin
          close;
          sql.Clear;
          SQL.Add('select * from custom order by Systime desc');
          open;
          first;
          while not eof do
          begin
            tvIDList.Items.AddChild(tvIDList.Items.Item[0],FieldByName('ID').AsString);
            next;
          end;
        end;
      tvIDList.FullExpand;
      tvIDListChange(tvIDList,tvIDList.Items.Item[0]);
    end;

    //点击全新输入按钮
    if rbNew.Checked=true then
    begin
      //设定ID为临时ID
      ID:='';
      //设定关键字为空
      Keyword:='';  
      //设定默认的超时限制
      cbbTimeLimit.ItemIndex:=2;

      sbSaveID.Enabled:=True;

      PnlNewInput.Enabled:=True;
      tvIDList.Enabled:=False;
      tvIDList.FullCollapse;
      sbSearch.Enabled:=True;

      //全选网站类型和搜索引擎
      for i:=0 to WebtypeAmount-1 do
        clbWebType.Checked[i]:=True;
      for i:=0 to EngineAmount-1 do
        clbEngine.Checked[i]:=True;

    end;
  end;

end;

//清空关键字
procedure TfrmCustomSearch.ClearKeyword;
begin
  with fraInput do
  begin
    edtKeyword1.Text:='';
    edtKeyword2.Text:='';
    edtKeyword3.Text:='';
  end;
end;

//还原关键字
procedure TfrmCustomSearch.RestoreKeyword;
var
  Temp:string;
begin
  Temp:=Keyword;
  with fraInput do
  begin
    //如果不止一个关键字，则还原第一个关键字并继续
    if Pos('%2B',Temp)<>0 then
      edtKeyword1.Text:=Copy(Temp,1,Pos('%2B',Temp)-1)
    //否则还原后退出
    else
    begin
      edtKeyword1.Text:=Temp;
      Exit;
    end;

    //截取第二个关键字后面的字符串
    Temp:=Copy(Temp,Pos('%2B',Temp)+3,Length(Temp));
    //如果不止两个关键字，则还原第二个关键字并继续
    if Pos('%2B',Temp)<>0 then
      edtKeyword2.Text:=Copy(Temp,1,Pos('%2B',Temp)-1)
    //否则还原后退出
    else
    begin
      edtKeyword2.Text:=Temp;
      Exit;
    end;

    //截取第三个关键字后面的字符串
    Temp:=Copy(Temp,Pos('%2B',Temp)+3,Length(Temp));
    //还原第三个关键字
    edtKeyword3.Text:=Temp;
  end;
end;

//获取关键字
procedure TfrmCustomSearch.GetKeyword;
begin
  with fraInput do
  begin
    //获取第一个关键字
    Keyword:=edtKeyword1.Text;
    //获取第二个关键字
    if edtKeyword2.Text<>'' then
    begin
      //Keyword不为空则加上%2B
      if Keyword<>'' then
        Keyword:=Keyword+'%2B';
      Keyword:=Keyword+edtKeyword2.Text;
    end;
    //获取第三个关键字
    if edtKeyword3.Text<>'' then
    begin
      //Keyword不为空则加上%2B
      if Keyword<>'' then
        Keyword:=Keyword+'%2B';
      Keyword:=Keyword+edtKeyword3.Text;
    end;
  end;
end;

//读取所选的用户定制ID记录
procedure TfrmCustomSearch.tvIDListChange(Sender: TObject; Node: TTreeNode);
begin
  sbSearch.Enabled:=False;
  if not(fraInput.tvIDList.Items[0].Selected) then
    begin
      fraInput.sbMaintain.Enabled:=True;
     // with frmMain.qryCustom do
        with frmMain.AdoqCustom do
        begin
          sql.Clear;
          SQL.Add('select * from custom where id='+quotedstr(node.Text));
          open;
          KeyWord:=fieldbyname('KeyWord').AsString;
          ClearKeyword;
          RestoreKeyword;
          fraInput.cbbTimeLimit.ItemIndex:=fieldbyname('TimeLimit').AsInteger-TimeLimitMin;
          frmMain.RestoreList(fraInput.clbWebType,fieldbyname('webtype').AsInteger);
          frmMain.RestoreList(fraInput.clbEngine,fieldbyname('engine').AsInteger);
        end;

      if Node.Selected then
      begin
        sbSearch.Enabled:=True;
        ID:=fraInput.tvIDList.Selected.Text;
        RestoreKeyword;
        DisplayResult(ID);
        BrowserFrm.ID:=ID;
      end;
    end
  else
    with fraInput do
    begin
      sbSearch.Enabled:=false;
      sbMaintain.Enabled:=False;
      edtKeyword1.Clear;
      edtKeyword2.Clear;
      edtKeyword3.Clear;
      cbbTimeLimit.ItemIndex:=-1;
      frmMain.RestoreList(clbWebType,0);
      frmMain.RestoreList(clbEngine,0);
      {clbWebType.Checked[0]:=false;
      clbWebType.Checked[1]:=false;
      clbWebType.Checked[2]:=false;
      clbWebType.Checked[3]:=false;
      clbEngine.Checked[0]:=false;
      clbEngine.Checked[1]:=false;
      clbEngine.Checked[2]:=false;
      clbEngine.Checked[3]:=false;
      clbEngine.Checked[4]:=false;
      clbEngine.Checked[5]:=false;}
  end;
end;

//设定值
procedure TfrmCustomSearch.FormShow(Sender: TObject);
begin
  //清除显示
  frmDisplay.Clear;
  //还原页数
  DisplayFrm.Page:=Page;
  //重新显示
  DisplayResult(ID);
  //把显示窗口放到frmCustomSearch里面
  frmDisplay.pnlDisplay.Parent:=pnlForDisplay;
  //设定刷新速度
  tmRefresh.Interval:=StrToInt(frmSetting.cbbRefresh.Text)*1000;
  //如果正在搜索，则启用刷新
  if not(Finished) then
    tmRefresh.Enabled:=True;

  pnlBar.SetFocus;

  fraInput.rbSelect.TabStop:=False;
  fraInput.rbNew.TabStop:=False;
  rbAscend.TabStop:=False;
  rbDescend.TabStop:=False;
end;

procedure TfrmCustomSearch.sbMaintainClick(Sender: TObject);
begin
  frmMaintain.ShowModal;
end;

//检查输入是否正确
function CheckInput:Boolean;
var
  num:Integer;
begin
  with frmCustomSearch.fraInput do
  begin
    //检查关键字
    if (edtKeyWord1.Text='') and (edtKeyWord2.Text='') and (edtKeyWord3.Text='') then
      begin
        showmessage('请输入关键字！');
        edtKeyWord1.SetFocus;
        Result:=False;
        exit;
      end;

    //检查网站类型
    frmMain.GetList(clbWebType,num);
    if num=0 then
    begin
      ShowMessage('请至少选择一项网站类型！');
      clbWebType.SetFocus;
        Result:=False;
      Exit;
    end;

    //检查搜索引擎
    frmMain.GetList(clbEngine,num);
    if num=0 then
    begin
      ShowMessage('请至少选择一个搜索引擎！');
      clbEngine.SetFocus;
        Result:=False;
      Exit;
    end;
  end;

  //输入无误
  Result:=True;
end;

//保存定制
function SaveCustom:Boolean;
var
  Msg,SQLString:string;
  num:Integer;
begin
  //输入ID名
  while ID='' do
  begin
    if InputQuery('请输入定制ID名','',ID)=False then
    begin
      ID:='';
      Result:=False;
      Exit;
    end;
    if Length(ID)>20 then
    begin
      ID:='';
      ShowMessage('请不要超过20个字符！');
    end;
  end;

  //定制ID是否已经存在
  //frmMain.MyExecSQL(frmMain.qryCustom,'select * from custom where ID='+quotedstr(ID));
  frmMain.MyExecSQL(frmMain.AdoqCustom,'select * from custom where ID='+quotedstr(ID));
  //存在开始
 // if frmMain.qryCustom.RecordCount<>0 then
  if frmMain.AdoqCustom.RecordCount<>0 then
  begin
    Msg:='数据库中已经存在一个 '+ID+' 定制'+#13+'要覆盖吗？';
    if MessageDlg(Msg,mtWarning,[mbYes,mbNo],0)=mrNo then
    begin
      ID:='';
      Result:=False;
      Exit;
    end;

    //用户确定要覆盖
    with frmMain do
      //with qryInfo do
      with frmMain.AdoqInfo do
      begin
        //查询定制有无相应搜索记录
        SQLString:='select * from info where ID='+quotedstr(ID);
       // MyExecSQL(qryInfo,SQLString);
        MyExecSQL(AdoqInfo,SQLString);

        if RecordCount>0 then
          Msg:='将删除数据库中对应的搜速结果信息'+#13+#13+'确定要继续吗？'
        else
          Msg:='确定要继续吗？';
        if MessageDlg(Msg,mtWarning,[mbYes,mbNo],0)=mrNo then
        begin
          ID:='';
          Result:=False;
          Exit;
        end;

        //如果定制有相应搜索记录，则删除记录
        if RecordCount>0 then
        begin
          First;
          while not(Eof) do
            Delete;
        end;
      end;
      //用户确定要覆盖完毕
  end;
  //存在完毕

  //开始保存
 // with frmMain.qryCustom do
  with frmMain.AdoqCustom do
  begin
    Edit;
    //修改定制
    with frmCustomSearch.fraInput do
    begin
      FieldByName('ID').AsString:=ID;
      frmCustomSearch.GetKeyword;
      FieldByName('KeyWord').AsString:=Keyword;
      FieldByName('TimeLimit').AsInteger:=strtoint(cbbTimeLimit.Text);
      frmMain.getlist(clbEngine,num);
      FieldByName('Engine').AsInteger:=num;
      frmMain.getlist(clbWebType,num);
      FieldByName('WebType').AsInteger:=num;
      FieldByName('Systime').AsDateTime:=Now;
    end;
    Post;
  end;

  //保存成功
  Result:=True;

end;

//保存用户定制
procedure TfrmCustomSearch.sbSaveIDClick(Sender: TObject);
var
  ID:string;
begin

  ID:='';

  with fraInput do
  begin

    //检查输入
    if not(CheckInput) then
      Exit;
    //保存定制
    if not(SaveCustom) then
      Exit;
      
    rbSelect.Checked:=True;
  end;
end;

//删除临时数据库
procedure TfrmCustomSearch.DeleteTempDB;
begin
 // with frmMain.qryCustom do
  with frmMain.AdoqCustom do
  begin
    SQL.Clear;