main.pas

Delphi中处理线程池的一个组件,非常好用.

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  MyThreadPool,
  MyHTTPTask,
  ThreadPool,
  Define,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls, ActnList, ToolWin, ImgList, Menus;

type
  TfrmDemo = class(TForm)
    LvPxy: TListView;
    pnl1: TPanel;
    btnStart: TButton;
    btnPause: TButton;
    btnGoon: TButton;
    btnStop: TButton;
    tkbPxy: TTrackBar;
    edtChkPxyTimeOut: TEdit;
    udChkPxyTimeOut: TUpDown;
    edtPxyChkUrl: TEdit;
    edtPxySuccStr: TEdit;
    lbl1: TLabel;
    lbl2: TLabel;
    lbl3: TLabel;
    stat: TStatusBar;
    pnl2: TPanel;
    pbChkPxy: TProgressBar;
    lblThreadCount: TLabel;
    tlb: TToolBar;
    btn1: TToolButton;
    btn2: TToolButton;
    btn3: TToolButton;
    actlst: TActionList;
    actLvPxyImport: TAction;
    actLvPxyExport: TAction;
    btn4: TToolButton;
    btn5: TToolButton;
    actLvPxyDelSel: TAction;
    actLvPxyDelFail: TAction;
    actLvPxyClear: TAction;
    pm: TPopupMenu;
    il: TImageList;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    dlgOpen: TOpenDialog;
    dlgSave: TSaveDialog;
    procedure btnStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure tkbPxyChange(Sender: TObject);
    procedure actLvPxyImportExecute(Sender: TObject);
    procedure actLvPxyExportExecute(Sender: TObject);
    procedure actLvPxyDelSelExecute(Sender: TObject);
    procedure actLvPxyDelFailExecute(Sender: TObject);
    procedure actLvPxyClearExecute(Sender: TObject);
    procedure btnPauseClick(Sender: TObject);
    procedure btnGoonClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure LvPxyColumnClick(Sender: TObject; Column: TListColumn);
    procedure LvPxyCompare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
  private
    CheckProxyPool : TCheckProxyPool;
    procedure CheckProxyPoolDone(Sender : TObject);
  public
    procedure SaveLvPxy(fn : string);
    procedure LoadLvPxy(fn : string);
    procedure LvPxyTraceLog(Log : string; Row : Integer; Column : Byte; ImgIdx : SmallInt; Sender : TObject);
    procedure SetChkPxyTaskBtnStat(Stat : TBtnStat);
    procedure LockLvPxy(Lock : boolean);
  end;

var
  frmDemo: TfrmDemo;

implementation

uses
  HTTPutil;

{$R *.dfm}

procedure TfrmDemo.LvPxyTraceLog(Log : string; Row : Integer; Column : Byte; ImgIdx : SmallInt; Sender : TObject);
begin
  RfhLvItem(lvPxy,Log,Row,Column,False,False,ImgIdx);
end;


procedure TfrmDemo.SetChkPxyTaskBtnStat(Stat : TBtnStat);
begin
  btnStart.Enabled := ABtnEnable[Integer(Stat),Integer(btStart)];
  btnPause.Enabled := ABtnEnable[Integer(Stat),Integer(btPause)];
  btnGoon.Enabled :=  ABtnEnable[Integer(Stat),Integer(btGoon)];
  btnStop.Enabled :=  ABtnEnable[Integer(Stat),Integer(btStop)];
end;


procedure TfrmDemo.LockLvPxy(Lock : boolean);
begin

end;


procedure TfrmDemo.CheckProxyPoolDone(Sender : TObject);
begin
  FreeAndNil(CheckProxyPool);
  MsgBox('^_^ 代理验证完毕！',0);
  SetChkPxyTaskBtnStat(bsNull);
  LockLvPxy(True);
end;


procedure TfrmDemo.SaveLvPxy(fn : string);
begin
  eplstV(LvPxy,fn,':');
end;

procedure TfrmDemo.LoadLvPxy(fn : string);
var
  f : TextFile;
  S : String;
  Subs : TStringList;
begin
  try
    Assignfile(f, fn);
    Reset(f);
    Subs := TStringList.Create;
    try
      while not Eof(f) do
      begin
        Readln(F,S);
        Subs.Clear;
        Subs.Add(GetDigAt(s,':',TRUE)) ;
        Subs.Add(GetDigAt(s,':',FALSE)) ;
        Subs.Add('');
        Subs.Add('');
        AddLv(lvPxy,Subs,False,False);
      end;
    finally
      Subs.Free;
    end;
  finally
    CloseFile(f);
  end;
end;

procedure TfrmDemo.btnStartClick(Sender: TObject);

  procedure LoadCheckProxyTask(TaskList : TThreadList);
  var
    Param : PCheckProxyParam;
    i: Integer;
  begin
    for i:=0 to lvPxy.Items.Count-1 do
    begin
      GetMem(Param,SizeOf(TCheckProxyParam));
      Param^.IP := #0;
      StrPCopy(Param^.IP, Trim(lvPxy.Items[i].SubItems[0]));
      Param^.Port := StrToInt(Trim(lvPxy.Items[i].SubItems[1]));
      LoadTask(i,Param,TaskList);
    end;
  end;

begin
  if lvPxy.Items.Count=0 then Exit;
  if (Trim(edtPxyChkUrl.Text)='') or (Trim(edtPxySuccStr.Text)='') then exit;
  if CheckProxyPool <> nil then Exit;
  SetChkPxyTaskBtnStat(bsRunning);
  LockLvPxy(False);
  CheckProxyPool := TCheckProxyPool.Create;
  with CheckProxyPool do
  begin
    _THREAD_CLASS := TCheckProxy ;
    _THREAD_COUNT := tkbPxy.Position;
    _OnTerminate := CheckProxyPoolDone;
    _PROGRESS_BAR := pbChkPxy;
    LoadCheckProxyTask(_TASK_LIST);
    Start;
  end;
end;


procedure TfrmDemo.FormCreate(Sender: TObject);
begin
  SetChkPxyTaskBtnStat(bsNull);
end;

procedure TfrmDemo.tkbPxyChange(Sender: TObject);
begin
  lblThreadCount.Caption := IntToStr(tkbPxy.Position);
end;

procedure TfrmDemo.actLvPxyImportExecute(Sender: TObject);
var
  Dialog : TOpenDialog;
begin
  try
  Dialog := TOpenDialog.Create(Self);
  try
    with Dialog do
    begin
      Filter := '文本文件(*.txt)|*.txt';
      DefaultExt := '.txt';
      if Execute then
      try
        LoadLvPxy(FileName);
      except
        ShowMessage('ImErr!');
      end;
    end;
  finally
    Dialog.Free;
  end;
  except
    ShowMessage('ImDlgErr');
  end;
end;

procedure TfrmDemo.actLvPxyExportExecute(Sender: TObject);
var
  Dialog : TSaveDialog;
begin
  try
  Dialog := TSaveDialog.Create(Self);
  try
    with Dialog do
    begin
      Filter := '文本文件(*.txt)|*.txt';
      DefaultExt := '.txt';
      if Execute then
      try
        SaveLvPxy(FileName);
      except
        ShowMessage('ExErr!');
      end;
    end;
  finally
    Dialog.Free;
  end;
  except
    ShowMessage('ExDlgErr');
  end;
end;

procedure TfrmDemo.actLvPxyDelSelExecute(Sender: TObject);
begin
  lvPxy.DeleteSelected;
end;

procedure TfrmDemo.actLvPxyDelFailExecute(Sender: TObject);
var
  i : Integer;
begin
  with lvPxy do
  begin
    for i:=items.Count-1 downto 0 do
      if items[i].ImageIndex = 2 then
        items[i].Selected := true
        else
        items[i].Selected := False;
    DeleteSelected;
  end;
end;

procedure TfrmDemo.actLvPxyClearExecute(Sender: TObject);
begin
  LvPxy.Clear;
end;

procedure TfrmDemo.btnPauseClick(Sender: TObject);
begin
  if CheckProxyPool = nil then Exit;
  SetChkPxyTaskBtnStat(bsPaused);
  CheckProxyPool.Pause;
end;

procedure TfrmDemo.btnGoonClick(Sender: TObject);
begin
  if CheckProxyPool = nil then Exit;
  SetChkPxyTaskBtnStat(bsRunning);
  CheckProxyPool.Goon;
end;

procedure TfrmDemo.btnStopClick(Sender: TObject);
begin
  if CheckProxyPool = nil then Exit;
  SetChkPxyTaskBtnStat(bsNull);
  CheckProxyPool.Stop;
end;

procedure TfrmDemo.LvPxyColumnClick(Sender: TObject; Column: TListColumn);
begin
  if lvPxy.Tag = 1 then Exit;
  ColToSort := Column.Index;
  (Sender as TCustomListView).AlphaSort;
  RfhLstV(LvPxy);
  bUp := not bUp;
end;

procedure TfrmDemo.LvPxyCompare(Sender: TObject; Item1, Item2: TListItem;
  Data: Integer; var Compare: Integer);
var
  ix: Integer;
begin
  if ColToSort = 0 then
    if bUp then
    Compare := CompareText(Item1.Caption,Item2.Caption)
    else
    Compare := CompareText(Item2.Caption,Item1.Caption)
  else begin
   ix := ColToSort - 1;
   if bUp then
   Compare := CompareText(Item1.SubItems[ix],Item2.SubItems[ix])
   else
   Compare := CompareText(Item2.SubItems[ix],Item1.SubItems[ix]);
  end;
end;

end.