Утилита для проверки файлов которые еще живы на Turbobit (TurbobitLinkChecker)

Данная утилита написана по просьбе NoSch, который является администратором сайта и тесно связан с этим файлообменником.
Программа написана с использованием библиотеки Indy входящей в комплект поставки Delphi 2010, просто нужно было быстро это сделать, а ни чего другого под рукой не было.
Думаю кому нибудь эта утилита пригодиться и мой труд не пропадет даром.
Внешний вид программы весьма аскетичный, чтобы ни чего не отвлекало.

  
Имеется 3 списка в первом указываем все ссылки которые необходимо проверить, во втором и третьем получаем список рабочих ссылок и список нерабочих ссылок соответственно.


Имеется ползунок с помощью которого можно задавать интервал между подключениями к серверу (маленькая защита от бана)


Сам код

unit unitMain;

interface

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

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    mmoAllLinks: TMemo;
    mmoJobLink: TMemo;
    mmoNotJobLinks: TMemo;
    pnlButtons: TPanel;
    btnStart: TButton;
    btnStop: TButton;
    pbProgress: TProgressBar;
    lblProgress: TLabel;
    IdHTTP1: TIdHTTP;
    IdAntiFreeze1: TIdAntiFreeze;
    trckbrTimeOut: TTrackBar;
    lblTimeOut: TLabel;
    Label1: TLabel;
    procedure btnStartClick(Sender: TObject);
    function GetStatusLink(aHtml:string):Boolean;
    procedure btnStopClick(Sender: TObject);
    procedure Label1Click(Sender: TObject);
    procedure Label1MouseEnter(Sender: TObject);
    procedure Label1MouseLeave(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  boolStop:Boolean;
implementation

{$R *.dfm}

procedure TForm1.btnStartClick(Sender: TObject);
var
  i:Integer;
begin
  boolStop:=False;
  if mmoAllLinks.Lines.Count=0 then Exit;
  mmoAllLinks.Enabled:=False;
  mmoJobLink.Enabled:=False;
  mmoNotJobLinks.Enabled:=False;
  pbProgress.Position:=0;
  mmoJobLink.Clear;
  mmoNotJobLinks.Clear;
  pbProgress.Max:=mmoAllLinks.Lines.Count;
  for i := 0 to mmoAllLinks.Lines.Count - 1 do
  begin
    if boolStop then
    begin
      Break;
    end;
    pbProgress.Position:=pbProgress.Position+1;
    try
      if GetStatusLink(IdHTTP1.Get(mmoAllLinks.Lines[i])) then
      begin
        Application.ProcessMessages;
        Sleep(trckbrTimeOut.Position);
        Application.ProcessMessages;
        mmoJobLink.Lines.Add(mmoAllLinks.Lines[i])
      end
      else
        mmoNotJobLinks.Lines.Add(mmoAllLinks.Lines[i]);
    except
      ShowMessage('Ошибка при получении страницы. Проверти ссылки на правильность ввода!');
      Next;
    end;
  end;
  pbProgress.Position:=pbProgress.Max;
  mmoAllLinks.Enabled:=True;
  mmoJobLink.Enabled:=True;
  mmoNotJobLinks.Enabled:=True;
end;

//получение статуса страницы
procedure TForm1.btnStopClick(Sender: TObject);
begin
  boolStop:=True;
end;

function TForm1.GetStatusLink(aHtml: string): Boolean;
begin
  if AnsiPos('<h1>Файл не найден. Возможно он был удален.</h1>',aHtml)>0 then
  begin
    Result:=False;
  end;
  if AnsiPos('<b>Скачай этот файл мгновенно! Всего за 2,5 руб.*</b>',aHtml)>0 then
  begin
    Result:=True;
  end;

end;

procedure TForm1.Label1Click(Sender: TObject);
begin
  ShellExecute (Form1.Handle, nil, 'http://nmdsoft.blogspot.com/', nil, nil, SW_RESTORE);
end;

procedure TForm1.Label1MouseEnter(Sender: TObject);
begin
  Label1.Font.Color:=clBlue;
end;

procedure TForm1.Label1MouseLeave(Sender: TObject);
begin
  Label1.Font.Color:=clBlack;
end;

end.


Программу можно скачать отсюда Download
Исходники скачать отсюда  Download 

Критикуем в комментах