unit autoclick;    interface    uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ToolWin, ComCtrls, OleCtrls, SHDocVw, ExtCtrls, StdCtrls,
  Buttons,MSHTML, ImgList, Menus, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP, IdAntiFreezeBase, IdAntiFreeze,
  Grids;    type
  TMainForm = class(TForm)
    StatusBar1: TStatusBar;
    ToolBar1: TToolBar;
    CoolBar1: TCoolBar;
    BackBtn: TToolButton;
    ForwardBtn: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    Panel1: TPanel;
    Panel2: TPanel;
    Label1: TLabel;
    Panel3: TPanel;
    BitBtn1: TBitBtn;
    Urls: TComboBox;
    Splitter1: TSplitter;
    ToolButton10: TToolButton;
    CheckBox1: TCheckBox;
    Edit1: TEdit;
    Panel5: TPanel;
    Panel6: TPanel;
    ListBox1: TListBox;
    Label2: TLabel;
    Edit2: TEdit;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ProgressBar1: TProgressBar;
    ImageList1: TImageList;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    IdAntiFreeze1: TIdAntiFreeze;
    Panel4: TPanel;
    Splitter2: TSplitter;
    WebBrowser1: TWebBrowser;
    SpeedButton1: TSpeedButton;
    Panel7: TPanel;
    StringGrid2: TStringGrid;
    StringGrid1: TStringGrid;
    Panel8: TPanel;
    ComboCs: TComboBox;
    Label3: TLabel;
    procedure ToolButton9Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure UrlsKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure BitBtn1Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure BackBtnClick(Sender: TObject);
    procedure ForwardBtnClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormDestroy(Sender: TObject);
    procedure WebBrowser1StatusTextChange(Sender: TObject;
      const Text: WideString);
    procedure ToolButton5Click(Sender: TObject);
    procedure ToolButton10Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure WebBrowser1NavigateComplete2(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure N1Click(Sender: TObject);
    procedure httpWork(Sender: TObject; AWorkMode: TWorkMode;const AWorkCount: Integer);
    procedure httpWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
    procedure SpeedButton1Click(Sender: TObject);      private
    { Private declarations }
    HistoryIndex: Integer;
    HistoryList: TStringList;
    UpdateCombo: Boolean;
    TranCount : Integer;
    ThreadsRunning: Integer;
    procedure FindAddress;
    procedure ThreadDone(Sender: TObject);
  public
    { Public declarations }
  end;      //定义进程类
 cThread = class(TThread)
 private
    fi,Fti:integer;
    fOleName:TListBox;
    fHttpOld:TIDHTTP;
  protected
    procedure Execute; override;
   public
    constructor Create(var i:integer;var OleName:TListBox;var HttpOld:TIDHTTP;var ti:integer);
  end;
var
  MainForm: TMainForm;
  TTHe: array of cThread;
  IDDL: array of TidHttp;
  fs:array of TStringList;
implementation    {$R *.dfm}    constructor cThread.Create(var i:integer;var OleName:TListBox;var HttpOld:TIDHTTP;var ti:integer);
begin
    fi:=i;
    fOleName:=OleName;
    fHttpOld:=HttpOld;
    FreeOnTerminate := True;
    FTi:=ti;
    inherited Create(False);
end;    procedure cThread.Execute;
var
  url:string;
  CountPost:integer;
begin
  CountPost:=0;
  while fi'' then begin
    try
        fHttpOld.post(Url,fs[FTi]);
        Inc(CountPost);
    except
    //finally
    on E: Exception do begin
          showMessage(E.Message);
          fHttpOld.Disconnect;
          E.Free;
    end;
    //end;
    end;
    mainForm.StringGrid1.Cells[2,fi 1]:=Inttostr(strtoint(mainForm.StringGrid1.Cells[2,fi 1]) 1);
    mainForm.StringGrid2.Cells[1,FTi 1]:=inttostr(fi 1) '/' inttostr(mainForm.ListBox1.Items.Count) '/' IntToStr(CountPost);
    Inc(fi);
    if (mainForm.CheckBox1.Checked) and (fi>fOleName.Items.Count) then fi:=0;
    //mainForm.Edit1.Text:=IntToStr(StrtoInt(mainForm.Edit1.Text) 1);
  end;
end;    procedure TMainForm.FindAddress;
var
  Flags: OLEVariant;    begin
  Flags := 0;
  UpdateCombo := True;
  WebBrowser1.Navigate(WideString(Urls.Text), Flags, Flags, Flags, Flags);
end;    procedure TMainForm.ToolButton9Click(Sender: TObject);
var
    Count_jc,i,ii,tii:integer;
begin
    ToolButton9.Enabled:=False;
    ThreadsRunning := StrtoInt(ComboCS.Text) 1;
    StatusBar1.Panels[1].Text := '共整理收集' inttostr(ListBox1.Items.Count) '个链接';
    StringGrid1.RowCount:=ListBox1.Items.Count  1;
    for i:=0 to ListBox1.Items.Count -1 do begin
       StringGrid1.Cells[1,i 1]:=ListBox1.Items.Strings[i];
       StringGrid1.Cells[2,i 1]:='0';
       StringGrid1.Cells[0,i 1]:=inttostr(i 1);
    end;
    ComBoCs.Enabled:=False;
    //生成数组
    Count_jc:=strtoint(ComboCs.Text);
    setLength(IDDL,Count_jc);
    setLength(TThe,Count_jc);
    SetLength(fs,Count_jc);
    for i:=0 to strtoint(ComboCs.Text)-1 do begin
        IDDL[i]:=TIDHTTP.Create(self);
        IDDL[i].ReadTimeout:=30000;
        IDDL[i].OnWorkBegin:=httpWorkBegin;
        IDDL[i].OnWork:=httpWork;
        IDDL[i].OnWorkEnd:=WorkEnd;
        IDDL[i].HandleRedirects:=true;
        fs[i]:=TStringList.Create();
        fs[i].Add('');
        //IDDL[i].Request.ContentType:='application/x-www-form-urlencoded';
    end;
    //取得链接的总数
    Edit1.Text := inttostr(0);
    CheckBox1.State := cbchecked;
    for ii:=0 to Count_jc-1 do begin
      TThe[ii] := nil;
    end;
    //开始线程
    i:=0;
    StringGrid2.RowCount:=Count_jc;
    for ii:=0 to Count_jc-1 do begin
      Tii:=ii;
      if TThe[ii] = nil then
      begin
          TThe[ii]:=cThread.Create(i,mainform.ListBox1,IDDL[Tii],Tii);
          StringGrid2.Cells[0,Tii 1]:='进程［' Inttostr(Tii 1) '］';
          StringGrid2.Cells[1,Tii 1]:='0/' Inttostr(ListBox1.Items.Count);
          Inc(i);
          if(i>ListBox1.Items.Count) then i:=0;
      end;
    end;
end;    procedure TMainForm.FormCreate(Sender: TObject);
begin
HistoryIndex := -1;
HistoryList := TStringList.Create;
StatusBar1.Panels[0].Width := StatusBar1.Width - 350;
StatusBar1.Panels[1].Width := 200;
StatusBar1.Panels[2].Width := 150;
//Panel4.Visible := False;
WEBBrowser1.Navigate('about:blank');
StringGrid1.Cells[0,0]:='序号';
StringGrid1.Cells[1,0]:='链接地址';
StringGrid1.Cells[2,0]:='本次点击';
StringGrid2.Cells[0,0]:='进程数';
StringGrid2.Cells[1,0]:='点击进度';
end;    procedure TMainForm.FormResize(Sender: TObject);
begin
StatusBar1.Panels[0].Width := StatusBar1.Width - 350;
StatusBar1.Panels[1].Width := 200;
StatusBar1.Panels[2].Width := 150;
end;    procedure TMainForm.ToolButton3Click(Sender: TObject);
begin
WebBrowser1.Stop;
end;    procedure TMainForm.UrlsKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_Return then
  begin
    FindAddress;
  end;
end;    procedure TMainForm.BitBtn1Click(Sender: TObject);
begin
FindAddress;
end;    procedure TMainForm.ToolButton4Click(Sender: TObject);
begin
WebBrowser1.Refresh;
end;    procedure TMainForm.BackBtnClick(Sender: TObject);
begin
  URLs.Text := HistoryList[HistoryIndex - 1];
  FindAddress;
end;    procedure TMainForm.ForwardBtnClick(Sender: TObject);
begin
  URLs.Text := HistoryList[HistoryIndex   1];
  FindAddress;
end;    procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Shift = [ssAlt] then
    if (Key = VK_RIGHT) and ForwardBtn.Enabled then
      ForwardBtn.Click
    else if (Key = VK_LEFT) and BackBtn.Enabled then
      BackBtn.Click;
end;    procedure TMainForm.FormDestroy(Sender: TObject);
begin
HistoryList.Free;
end;    procedure TMainForm.WebBrowser1StatusTextChange(Sender: TObject;
  const Text: WideString);
begin
StatusBar1.Panels[0].Text := Text;
end;    procedure TMainForm.ToolButton5Click(Sender: TObject);
var
doc:IHTMLDocument2;
all:IHTMLElementCollection;
len,i:integer;
item:OleVariant;
begin
doc:=WebBrowser1 .Document as IHTMLDocument2;
all:=doc.Get_links;
len:=all.length;
ListBox1.Clear;
for i:=0 to len-1 do begin
item:=all.item(i,varempty);
if pos(Edit2.Text,item.href)>0 then begin
  ListBox1.Items.Add(item.href);
end;
StatusBar1.Panels[1].Text := '共收集' inttostr(ListBox1.Items.Count) '个链接';
ToolButton9.Enabled:=True;
end;
end;    procedure TMainForm.ToolButton10Click(Sender: TObject);
begin
    CheckBox1.State := cbUnchecked ;
    ThreadDone(nil);
    ToolButton9.Enabled:=True;
end;    procedure TMainForm.ToolButton2Click(Sender: TObject);
begin
close;
end;    procedure TMainForm.WebBrowser1NavigateComplete2(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
  var
  NewIndex: Integer;
  begin
  NewIndex := HistoryList.IndexOf(URL);
  if NewIndex = -1 then
  begin
    { Remove entries in HistoryList between last address and current address }
    if (HistoryIndex >= 0) and (HistoryIndex < HistoryList.Count - 1) then
      while HistoryList.Count > HistoryIndex do
        HistoryList.Delete(HistoryIndex);
    HistoryIndex := HistoryList.Add(URL);
  end
  else
    HistoryIndex := NewIndex;
  if UpdateCombo then
  begin
    UpdateCombo := False;
    NewIndex := URLs.Items.IndexOf(URL);
    if NewIndex = -1 then
      URLs.Items.Insert(0, URL)
    else
      URLs.Items.Move(NewIndex, 0);
  end;
  URLs.Text := URL;
  Statusbar1.Panels[0].Text := URL;    end;    procedure TMainForm.N1Click(Sender: TObject);
begin
ListBox1.DeleteSelected;
end;    procedure TMainForm.httpWork(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
//ProgressBar1.Position := Round(AWorkCount/TranCount*100);
end;    procedure TMainForm.httpWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
TranCount := AWorkCountMax;
end;    procedure TMainForm.WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
//当前点击完成后
//Edit1.Text:=IntToStr(StrtoInt(Edit1.Text) 1);
end;    procedure TMainForm.SpeedButton1Click(Sender: TObject);
begin
ListBox1.Items.Add(Urls.Text)
end;    procedure TMainForm.ThreadDone(Sender: TObject);
var
  i,ci:Integer;
begin
  Dec(ThreadsRunning);
  ci:=strtoint(ComboCs.Text);
    for i:=0 to ci do begin
        if IDDL[i]<>nil then
        begin
            if TThe[i]<>nil then TThe[i].WaitFor;
            IDDL[i].Disconnect;
            freeandnil(IDDL[i]);
        end;
    end;
    Combocs.Enabled:=True;
end;
end.