unit1.pas

检测URL有效工具(批量检测)检测 URL有效工具(批量检测)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, StdCtrls, Unit2, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    IdHTTP1: TIdHTTP;
    OpenDialog1: TOpenDialog;
    Label2: TLabel;
    Button2: TButton;
    Button3: TButton;
    Edit2: TEdit;
    Label3: TLabel;
    ProgressBar1: TProgressBar;
    GroupBox2: TGroupBox;
    Memo2: TMemo;
    GroupBox1: TGroupBox;
    Memo1: TMemo;
    Button4: TButton;
    Edit3: TEdit;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    Timer2: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure AlexaRun(Sender: TObject);
    procedure AlexaExit;
    procedure Button4Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    //procedure AlexaRun;
  public
    AlexaIndex: integer;
    Alexalist: Tlist;
  end;

var
  Form1: TForm1;
  Thread1: array of T1;
  StopAlexa: Boolean;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
   // Finifile: TIniFile;
    DownFile: TMemoryStream;
    HttpGet: TIdhttp;
    Geturl: TStringList;
begin
    try
    HttpGet:= TIdhttp.Create(nil);
    HttpGet.ReadTimeout:= 30000;
    Geturl:= TStringList.Create;
    try
    
    except
    showmessage('出错啦！');
    end;
    finally
    Memo1.Lines.Text:= Geturl.Text;
    HttpGet.Free;
    Geturl.Free;
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if opendialog1.Execute then
  begin
    Edit3.Text:= opendialog1.FileName;
    Memo1.Lines.LoadFromFile(opendialog1.FileName);
  end;
  GroupBox1.Caption:= '总工查询'+inttostr(Memo1.Lines.count)+'个SHELL';
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  n,threadid: integer;
begin
  timer1.Enabled:=true;
  timer2.Enabled:=true;
  Memo2.Clear;
  StopAlexa:= False;
  ProgressBar1.Min :=0;
  ProgressBar1.Max :=Memo1.Lines.Count;
  ProgressBar1.Step :=1;
  ProgressBar1.Position :=0;
  Alexalist:= Tlist.Create;
  AlexaIndex:= 0;
  //AlexaGet(AlexaIndex);
  threadid:= strtoint(edit2.Text);
  if (threadid > memo1.Lines.Count) then threadid:= memo1.Lines.Count;
  SetLength(Thread1,threadid);
  for n := 0 to threadid-1 do
  begin
      Thread1[n] := T1.Create(Memo1,Memo2,AlexaIndex);
      Thread1[n].OnTerminate:= AlexaRun;
      Alexalist.Add(Thread1[n]);
      AlexaIndex:= AlexaIndex+1;
      ProgressBar1.StepIt;
      GroupBox2.Caption:= '得到'+inttostr(Memo2.Lines.Count)+'个可以挂的SHELL';
      StatusBar1.Panels[0].Text:= '已经查询完'+inttostr(AlexaIndex)+'个SEHLL';
  end;
  //MessageBox(handle,'真不容易呀，分析完毕！','完成啦',mb_ok+mb_iconinformation);
end;

procedure TForm1.AlexaRun(Sender: TObject);
var
  Index: integer;
begin
  if (StopAlexa = True) or (AlexaIndex > Memo1.Lines.Count) then exit;
  if (AlexaIndex = Memo1.Lines.Count) then
  begin
  Alexalist.Free;
  StopAlexa:= True;
  StatusBar1.Panels[0].Text:= '查询完成';
  exit;
  end;
  Index := AlexaList.IndexOf(Sender); //在Filst 中查找刚才的线程对象
  AlexaList.Delete(Index);
  Thread1[Index] := T1.Create(Memo1,Memo2,AlexaIndex);
  Thread1[Index].OnTerminate:= AlexaRun;
  Alexalist.Add(Thread1[Index]);
  AlexaIndex:= AlexaIndex+1;
  ProgressBar1.StepIt;
  GroupBox2.Caption:= '得到'+inttostr(Memo2.Lines.Count)+'个可以挂的SHELL';
  StatusBar1.Panels[0].Text:= '已经查询完'+inttostr(AlexaIndex)+'个SHELL';
end;

procedure TForm1.AlexaExit;
var
  i: integer;
  tmp: T1;
begin
  try
  for i:=0 to Alexalist.Count-1 do
  begin
    tmp:= Alexalist.Items[i];
    tmp.Terminate;  //结束线程
  end;
  Alexalist.Free;
  //showmessage('线程全部结束！');
  StopAlexa:= True;
  except
  end;
end;


procedure TForm1.Button4Click(Sender: TObject);
begin
  AlexaExit;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var   sl:TStringList;
begin
  sl:=TStringList.Create;
  sl.LoadFromFile('c:/1.txt');
  sl.Strings[0]:='已经检测了'+inttostr(AlexaIndex)+'个SEHLL';
  sl.Strings[sl.Count-1]:='可以挂的有'+inttostr(Memo2.Lines.Count)+'个SEHLL';
  sl.savetofile('c:/1.txt');



end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
memo2.Lines.SaveToFile('c:/1.txt');
end;

end.