unit Unit1;
interface

uses
Forms, Controls, Classes, StdCtrls, Windows, SysUtils, winsock,
SYNCOBJS, dialogs;

const
  {количество потоков, создаваемых программой}
  threads=100;
  {максимальная объем информации, считываемый из ответа на наш http запрос}
  MAX_BUF_LEN=20000;

type

  {объявляем класс потока}
  TMyThread = class(TThread)
     public
        constructor Create(); overload;
     protected
        procedure Execute; override;
     end;

  {объявляем класс формы}
  TForm1 = class(TForm)
     Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
     procedure Button1Click(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     public
        MyThread : array of TMyThread;   {объявление массива потоков}
     end;

var
  Form1: TForm1;
  {файл с списком прокси и выходной файл с хорошими прокси}
  proxy,good:textfile;
  {2 критические секции для исключения одновременного
   доступа к файлам из разных потоков}
  cs,cs2:TCriticalSection;
  {служебный счетчик_1}
  counter_1:integer;
  {количество активных в данный момент потоков}
  threads_alive:integer;
  {максимальное время ожидания ответа от сервера при http запросе.
  Препятствует "зависанию" функции recv на метрвых хостах
   оно же "тайм-аут прокси"}
  REPLY_TIMEOUT:integer;


implementation

{$R *.dfm}

{при создании формы}
procedure TForm1.FormCreate(Sender: TObject);
var {требуется для объявления использования Windows Sockets DLL}
   wData:WSAData;
begin

   {не обязательные красивости}
   with Form1 do
   begin
    Caption:='VK Proxy Checker';
    height:=130;
    width:=350;
    OnClose:=FormClose;
    OnCloseQuery:=FormCloseQuery;
   end;

   with Button1 do
   begin
    Left:=120;
    Top:=24  ;
    Width:=75;
    Height:=25;
    Caption:='Check';
    OnClick:=Button1Click;
   end;

   with Label1 do
   begin
    Left:=8;
    Top:=60;
    Width:=112;
    Height:=13;
    Caption:='Тайм-аут прокси (сек)';
   end;

   with Edit1 do
   begin
    Left:=128;
    Top:=56;
    Width:=65;
    Height:=21;
    Text:='15';
   end;

   {считываем значение тайм-аута прокси
   и умножаем на 1000, т.к. нам нужно время в миллисекундах}
   try
   REPLY_TIMEOUT:=strtoint(Edit1.text)*1000;
   except
      begin
      showmessage('тайм-аут прокси надо вводить цифрами');
      halt(0);
      end;
   end;

   {открываем файл прокси}
   assignfile(proxy,'proxy.txt');
   try
   reset(proxy)
   except
      begin
      showmessage('файла proxy.txt не существует');
      halt(0);
      end;
   end;

   {перезаписываем файл good}
   assignfile(good,'good.txt');
   try
   rewrite(good)
   except
      begin
      closefile(proxy);
      showmessage('файл good.txt заблокирован другим приложением');
      halt(0);
      end;
   end;
   closefile(good);

   {создаем критичесике секции}
   cs := tcriticalsection.create;
   cs2 := tcriticalsection.create;

   {объявляем использование Windows Sockets DLL}
   WSAStartup(makeword(1,1),wData);
end;


{при нажатии Button1}
procedure TForm1.Button1Click(Sender: TObject);
begin
   Button1.Caption:='Proceccing...';
   {задаем длинну массива потоков}
   setlength(MyThread,threads);
   {количество активных в данный момент потоков устанавливаем равным нулю}
   threads_alive:=0;
   {создаем потоки}
   for counter_1:=0 to threads-1 do MyThread[counter_1] := TMyThread.Create;
   {ждем, пока не отработали ли все созданные нами треды}
   while threads_alive<>0 do Application.ProcessMessages();
   {программа завершена.}
   Button1.Caption:='Ready';
end;


{функция ограничивающая время ожидания ответа при http запросе}
function recvdata(sock:TSocket):string;
var
   tv : timeval;
   fds : TFDSet;
   buf : array [1..MAX_BUF_LEN] of char;
   res : string;
   r,i : integer;
begin
   r:=1;
   while (r>0) do
   begin
      FD_ZERO(fds);
      FD_SET(sock, fds);
      tv.tv_sec := REPLY_TIMEOUT div 1000;
      tv.tv_usec := (REPLY_TIMEOUT mod 1000) * 1000;
      i := select(0, @fds, nil, nil, @tv);
      if (i <= 0) then  break;
      r := recv(sock, buf, 20000, 0);
      res:=res+copy(buf,1,r);
   end;
   result:=res;
end;


{создаем поток с низким приоритетом и запускаем его}
constructor TMyThread.Create();
begin
   {создаём}
   Create(true);
   {ставим true, чтобы поток самоуничтожался по завершении своей работы}
   FreeOnTerminate := True;
   {ставим потоку низкий приоритет}
   Priority := tpLower;
   {запускаем}
   Resume;
end;


{выполнение потока}
procedure TMyThread.Execute;
var
   s:TSOCKET;
   addr:sockaddr_in;
   {строка содержащая тело http запроса}
   sendbuff,
   {переменные для ip и порта, считываемых из файла}
   ip,port,
   {строка, в которую читаем строки из файла proxy}
   str,
   {строка, содержащая ответ на наш http хапрос от сервера}
   reply:string;

begin
{увеличиваем счетчик незавершенных(активных) потоков на 1}
InterlockedIncrement(threads_alive);
{пока не кончатся прокси в файле выполняме код}
  while not (eof(proxy) or terminated) do
  begin
     {считываем строку из файла с использованием критической секции
     во избежание попытки одновременного доступа к файлу разными потоками}
     cs.Enter;
     readln(proxy,str);
     cs.Leave;

     ip:=copy(str,0,pos(':',str)-1);
     port:=copy(str,pos(':',str)+1,length(str)-pos(':',str));
     {если в конце строки есть пробелы - убираем их}
     while pos(' ',port)<>0 do setlength(port,length(port)-1);
     {создаем сокет}
     s:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
     FillChar(addr, SizeOf(sockaddr_in), 0);
     addr.sin_family:=AF_Inet;
     addr.sin_port:=htons(strtoint(port));
     addr.sin_addr.S_addr:=inet_addr(PChar(ip));
     {коннектимся}
     Connect(S,addr,SizeOf(TSockAddr));
     sendbuff := 'GET /index.php HTTP/1.1'+ #13#10 +
                 'Host: vkontakte.ru'+ #13#10#13#10;
     {шлем запрос}
     send(s, sendbuff[1] , Length(sendbuff), 0);
     {считываем ответ}
     reply:=recvdata(s);
     {закрываем сокет}
     closesocket(s);
     {если в ответе есть нужная нам строка - дописываем в файл "good"
     ip и port использованной прокси
     (с использованием критической секции)}
     if pos('Set-Cookie',reply)<>0 then
     begin
        cs2.Enter;
          append(good);
          writeln(good,ip+':'+port);
          try
          closefile(good);
          finally;
          end;
        cs2.Leave;
     end;
  end; {eof()}
{уменьшаем счетчик незавершенных(активных) потоков на 1}
InterlockedDecrement(threads_alive);
end;{procedure}


{при попытке закрыть программу}
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
{если программа уже закрывается - не мешаем ей}
if Button1.Caption='Closing.. wait' then CanClose:=false else
{иначе если есть незавершенные потоки}
if threads_alive<>0  then
   begin
   if MessageDlg('Проверка еще не закончена, вы уверены,'+
   'что хотите завершить работу?',
      mtWarning, [mbYes, mbNo], 0) = mrYes
   then
      begin
      Button1.Caption:='Closing.. wait';
      {"проходимся" по всем потокам, и всем, что еще не завершены
      даем команду на завершение работы}
      for counter_1:=0 to threads-1 do
          if MyThread[counter_1].Terminated=false then
          MyThread[counter_1].Terminate;
      {ждем, пока все потоки завершит работу}
      while threads_alive<>0 do application.ProcessMessages;
      CanClose:=true;
      end
   else {если юзер ответит No то программа не будет закрыта}
      CanClose:=false
   end;{if treads alive end}
end; {CloseQuery end}


{при закрытии программы}
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  {объявляем о прекращении использования Windows Sockets DLL}
  WSACleanup;
  {освобождаем критические секции и закрываем файл прокси}
  try
   cs.free;
   cs2.free;
   closefile(proxy);
  finally;
  end;
end;


end.
{example written by ErrorNeo}