uparseren.~pas

这是一个从指定网页格式分离单词的小程序

  if RuningT = 0 then
  begin//当线程为空时检测任务列表
    i := GetCountCondition('FURL','TEnWordClass','FType=0',ADOQtmp);//获取未完成的链接
    t := GetCountCondition('FURL','TTmpURLList','FType=0',ADOQtmp);//获取临时抓取的链接
    WaitQueue := StatusTaskCount(tsWait);
    if (i > 0) or (t > 0) then
    begin
      LastCheckLst := 0;
      SendMessage(FrmParseEnWord.Handle,
        WM_CheckTmpURLList,0,0);//发送更新相似页面消息
    end
    else//否则检测任务列表是否完成
    begin
      if WaitQueue <> 0 then
        ProWaitQueue;//处理任务列表
    end;//if
  end;//if
//  if (RuningT = 1) and (WaitQueue = 0) and (SLevel = 110) then
//  begin
//    Application.MessageBox(PAnsiChar('抓取任务完成耗时：' +
//      IntToStr(MinutesBetween(Now, StartTime)) + '分钟！'#13#10 +
//      '共搜索到 ' + IntToStr(GetCountCondition('FEnglish',
//        'TEnglish','FEnglish <> ''''',ADOQtmp)) +
//        ' 组单词。' ), '提示', MB_ICONINFORMATION or MB_OK);
//  end;//if

  if CurMsgLen < MsgQueueLen then
  begin//超过信息显示缓冲的丢失
    StrMsg[RearMsgI] := sLog;//把要显示的信息加入队尾
    inc(CurMsgLen);
    RearMsgI := (RearMsgI mod MsgQueueLen) + 1;
  end
  else
  begin
    FrontMsgI := (FrontMsgI mod MsgQueueLen) + 1;
    dec(CurMsgLen);//减少队列长度
  end;//if

  if FrmParseEnWord.Showing then
  begin
    if CurMsgLen > 0 then
    if (GetTickCount - LastShowMsg) > ShowMsgInterval then
    begin
      if not AutoAddTaskTimer.Enabled then AutoAddTaskTimer.Enabled := True;
    end;

    if SLevel = 3 then
    begin
      t := GetCountCondition('FURL','TEnWordClass','FURL <> ''''',ADOQtmp);
      i := GetCountCondition('FURL','TEnWordClass','FType=3',ADOQtmp);
      StatusBarTask.Panels[0].Text := '可用链接：' + IntToStr(t) +
        '（' + IntToStr(i) + '）';
      t := GetCountCondition('FEnglish','TEnglish',
                'FEnglish <> ''''',ADOQtmp);
      StatusBarTask.Panels[1].Text := '单词数：' + IntToStr(t);

    end;//if


    t := Length(FPQueueMsg);
    i := StatusTaskCount(tsComplete); //获取已经完成任务数
    StatusBarTask.Panels[2].Text := '任务数：' + IntToStr(t) +
      '（' + IntToStr(i) + '）';

    StatusBarTask.Panels[3].Text := '线程数：' +
      IntToStr(FMaxThreadNum) + '（' + IntToStr(RuningT) + '）';
  end;//if Showing



  if (GetTickCount - LastShowICO) > ShowICOInterval then
  begin //处理图标显示，让用户感觉程序是有响应的
    with NDICO^ do
    begin
      if ChangTaskICOED then
        hIcon := LoadIcon(HInstance,PAnsiChar('TASKONE'))
      else
        hIcon := LoadIcon(HInstance,PAnsiChar('TASKTWO'));
      //uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
    end;//with
    Shell_NotifyIcon(NIM_MODIFY, NDICO);
    ChangTaskICOED := not ChangTaskICOED;
    LastShowICO := GetTickCount;
  end;//if

end;

procedure TFrmParseEnWord.CheckTmpListMsg(var Msg: TMessage);
var NewTaskID,
    i, AddCount: integer;
    TaskMsg: PThreadTask;
begin
  if (Msg.WParam = 0) and (Msg.LParam = 0) then
  begin//如果是此类信息则处理
    if (GetTickCount - LastCheckLst) > CheckInterval then
    begin
      AddCount := 0;
      if OpenADOQ('select * from TTmpURLList where FType=0',ADOQScan) then//搜索所有新抓取的页面链接
      with ADOQScan do
      begin
        First;
        i := 0;
        while not Eof do
        begin
          NewTaskID := Length(FPQueueMsg) + 1;
          New(TaskMsg);
          with TaskMsg^ do
          begin
            sName := '搜索可用链接“' + FieldByName('FName').AsString + '”' + IntToStr(NewTaskID);
            sURL := FieldByName('FURL').AsString;
            sFileName := GetTempPathFileName;
            //sFileName := 'c:\MyHtml0' + IntToStr(NewTaskID) + '.html';
            TaskType := 0;     //0 下载文件
            OnComplete := nil; //完成后处理的事件
            TaskStatus := tsCreate; //标识为新建立的任务
          end;//with
          if AddTaskMsg(TaskMsg) then
          begin
            ShowLogMsg('添加 ' + TaskMsg^.sName + ' 任务成功!');
            TaskMsg^.TaskStatus := tsWait; //标识为等待处理的任务
            inc(AddCount);
          end;
          if i >= 3 then Break; //减少运行时间，避免窗体无响应
          Next;
        end;//while
      end;//with ADOQScan

      if OpenADOQ('select * from TEnWordClass where FType=0',ADOQScan) then//搜索所有新抓取的页面链接
      with ADOQScan do
      begin
        First;
        i := 0;
        while not Eof do
        begin
          NewTaskID := Length(FPQueueMsg) + 1;
          New(TaskMsg);
          with TaskMsg^ do
          begin
            sName := '分离页面单词“' + FieldByName('FName').AsString + '”' + IntToStr(NewTaskID);
            sURL := FieldByName('FURL').AsString;
            sFileName := GetTempPathFileName;
            //sFileName := 'c:\MyHtml0' + IntToStr(NewTaskID) + '.html';
            TaskType := -1;     //-1 下载文件 可直接分离单词的页面用此
            OnComplete := nil; //完成后处理的事件
            TaskStatus := tsCreate; //标识为新建立的任务
          end;//with
          if AddTaskMsg(TaskMsg) then
          begin
            //ShowLogMsg('添加 ' + TaskMsg^.sName + ' 任务成功!');
            TaskMsg^.TaskStatus := tsWait; //标识为等待处理的任务
            inc(AddCount);
          end;
          if i >= 3 then Break;//减少运行时间，避免窗体无响应
          Next;
        end;//while
      end;//with ADOQScan
      ProWaitQueue;//处理所有处于等待状态的任务
      //if AddCount > 0 then ShowLogMsg('添加' + IntToStr(AddCount) + '个任务!',1);
      LastCheckLst := GetTickCount;//触发时间
    end;//if Interval在时间间隔内触发
  end;//if
end;

procedure TFrmParseEnWord.Button1Click(Sender: TObject);
var t: integer;
begin
  SendMessage(FrmParseEnWord.Handle,WM_CheckTmpURLList,0,0);//发送更新相似页面消息
  //ProWaitQueue;
  t := GetCountCondition('FURL','TEnWordClass','FURL <> ''''',ADOQtmp);
  StatusBarTask.Panels[0].Text := '可用链接：' + IntToStr(t) +
    '（' + IntToStr(GetCountCondition('FURL',
    'TEnWordClass','FType=3',ADOQtmp)) + '）';

  t := Length(FPQueueMsg);
  StatusBarTask.Panels[2].Text := '任务数：' + IntToStr(t) +
    '（' + IntToStr(StatusTaskCount(tsComplete)) + '）';

  t := GetRunningThreadCount(FThreadQueue);
  StatusBarTask.Panels[3].Text := '线程数：' +
    IntToStr(FMaxThreadNum) + '（' + IntToStr(t) + '）';

  t := GetCountCondition('FEnglish','TEnglish',
            'FEnglish <> ''''',ADOQtmp);
  StatusBarTask.Panels[1].Text := '单词数：' + IntToStr(t);

  FrmParseEnWord.Caption := '单词抓取工具 By Piao40993470 ［共耗时' +
    IntToStr(MinutesBetween(Now, StartTime)) + '分钟］' + IntToStr(CurMsgLen);
end;

procedure TFrmParseEnWord.Button2Click(Sender: TObject);
var t: integer;
begin
  if Application.MessageBox('确定要清空数据吗？',
    '询问', MB_ICONQUESTION or MB_OKCANCEL) = IDOK then
  begin
    t := KillQueueThread(FThreadQueue);

    ExecADOQ('delete table from TTmpURLList',ADOQtmp);
    ExecADOQ('delete table from TEnWordClass',ADOQtmp);
    ExecADOQ('delete table from TEnglish',ADOQtmp);
    ExecADOQ('delete table from TChinese',ADOQtmp);
    FreeQueueMsg;
    InitLogGrid(StrGridLog);
    ShowLogMsg('成功释放 ' + IntToStr(t) + ' 个线程！');
  end;//if
//  TPaserWordThread.Create(FDataLinkStr,
//    'c:\ErrorTest0173.html','{0094CE9B-A21D-414D-91AB-79A001267197}', FMainForm,3,False);
//  for i := Low(FPQueueMsg) to High(FPQueueMsg) do
//  begin
//    with FPQueueMsg[i]^ do
//    begin
//      ShowLogMsg(IntToStr(i) + sName + ':' + sFileName + ' TaskType:' + IntToStr(TaskType) );
//    end;//with
//  end;//for i
end;

procedure TFrmParseEnWord.AutoAddTaskTimerTimer(Sender: TObject);
begin
  if CurMsgLen < MsgQueueLen then
  if (CurMsgLen > 0) and (FrontMsgI <> RearMsgI) then
  begin
    with StrGridLog do
    begin//此操作最耗时且影响速度最快最多，因此想办法控制显示速度
      Tag := Tag + 1;
      if RowCount < Tag then
      begin
        RowCount := Tag + 1;
      end;//if
      Cells[0,Tag] := IntToStr(Tag);
      //Cells[1,Tag] := sLog;
      Cells[1,Tag] := StrMsg[FrontMsgI];
      FrontMsgI := (FrontMsgI mod MsgQueueLen) + 1;
      dec(CurMsgLen);//减少队列长度
      LastShowMsg := GetTickCount;//记录上次显示时间
      if MenuShowCheckLast.Checked and FrmParseEnWord.Showing then
        PostMessage(StrGridLog.Handle,WM_VSCROLL,SB_BOTTOM,0);
      //StrGridLog.Perform(WM_VSCROLL,SB_BOTTOM,0);
    end;//with
  end //if 队列有数据则显示
  else
  begin
    AutoAddTaskTimer.Enabled := False;
  end;
end;

procedure TFrmParseEnWord.Button4Click(Sender: TObject);
begin
  Button4.Enabled := False;
  if SpinEditMaxT.Value > FMaxThreadNum then
  begin
    FMaxThreadNum := SpinEditMaxT.Value;
    SetLength(FThreadQueue, FMaxThreadNum);
  end
  else
  begin
    FMaxThreadNum := SpinEditMaxT.Value;
  end;//if
  ProWaitQueue;
  ShowLogMsg('限制最大线程数为(注：超过五个不能查询)：' + IntToStr(FMaxThreadNum),1);
  Button4.Enabled := True;

  BtnScan.Enabled := FMaxThreadNum < 6;
  EnglishWordEdt.Enabled := FMaxThreadNum < 6;
end;

procedure TFrmParseEnWord.PauseBtnClick(Sender: TObject);
var t: integer;
begin
  if Sender is TButton then
  with TButton(Sender) do
  begin
    Enabled := False;
    if SameText(Caption,'暂停') then
    begin
      t := PauseThread(FThreadQueue, True);
      ShowLogMsg('成功暂停了 ' + IntToStr(t) + ' 个线程！',1);
      Caption := '继续';
      AutoAddTaskTimer.Enabled := False;
    end
    else
    begin
      t := PauseThread(FThreadQueue, False);
      ShowLogMsg('成功启动了 ' + IntToStr(t) + ' 个线程！',1);
      Caption := '暂停';
    end;//if
    StrGridLog.Repaint;
    okDelay(100);
    Enabled := True;
  end;//with
end;

procedure TFrmParseEnWord.BtnScanClick(Sender: TObject);
var ScanEnWord: string;
begin
  ScanEnWord := Trim(EnglishWordEdt.Text);
  if ScanEnWord <> '' then
  begin
    OpenADOQ('SELECT TEnglish.FID, TEnglish.FEnglish, TEnWordClass.FName ' +
      'FROM TEnglish, TEnWordClass ' +
      ' WHERE TEnWordClass.FID=TEnglish.FWordClassID and ' +
      '  TEnglish.FEnglish like ''%' +
      ScanEnWord +'%'' order by TEnglish.FEnglish' ,ADOQEnglish);
    ADOQEnglish.First;
  end;//if
end;

procedure TFrmParseEnWord.MenuPauseClick(Sender: TObject);
begin
  MenuPause.Enabled := False;
  PauseBtnClick(PauseBtn);
  MenuPause.Caption := PauseBtn.Caption;
  MenuPause.Enabled := True;
end;


procedure TFrmParseEnWord.WndProc(var Messages: TMessage);
begin
  if Messages.Msg = FShowGlobalMsg then
  begin//收到此消息则显示
    //FlashWindow(Application.Handle,True);
    //ShowWindow(Application.Handle,SW_SHOWNORMAL);
    FrmParseEnWord.Show;
    SetForegroundWindow(FrmParseEnWord.Handle);
    //ShowWindow(FrmParseEnWord.Handle,SW_SHOWNORMAL);
  end
  else
  inherited;
end;

procedure TFrmParseEnWord.Panel2Resize(Sender: TObject);
begin
  EnglishWordEdt.Width := Panel2.Width - 180;
end;

procedure TFrmParseEnWord.ADOQEnglishAfterScroll(DataSet: TDataSet);
var ScanEnID: string;
begin
  ScanEnID := ADOQEnglish.FieldByName('FID').AsString;
  if ScanEnID <> '' then
  begin
    OpenADOQ('select * from TChinese where FEnglishID=''' + ScanEnID + '''',ADOQChinese);
  end;
end;

procedure TFrmParseEnWord.EnglishWordEdtKeyPress(Sender: TObject;
  var Key: Char);
begin
  if Key = #13 then BtnScanClick(nil);
end;

procedure TFrmParseEnWord.MenuShowCheckLastClick(Sender: TObject);
begin
  MenuShowCheckLast.Checked := not MenuShowCheckLast.Checked;
end;

procedure TFrmParseEnWord.N2Click(Sender: TObject);
begin
  InitLogGrid(StrGridLog);
end;

end.