我是想收集的链接全部点击(真到我叫它停止),可我写的这个代码,它只会运行一次,有时一次都不会运行,代码有很多错误,可我就是找不出来,那位大帮忙看看:代码如下:
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.