Форум АНТИЧАТ - Многопоточный чеккер прокси под VK своими руками. Delphi

Форум АНТИЧАТ (https://forum.antichat.xyz/index.php)

- С/С++, C#, Delphi, .NET, Asm (https://forum.antichat.xyz/forumdisplay.php?f=24)

Многопоточный чеккер прокси под VK своими руками. Delphi

потребовалось, потому постарался по возможности создать "fine example of source code"
Уверен новичкам пригодится.

Требуется:
кинуть на форму Button1, Edit1, Label1
создать событие Form1.OnCreate

затем полностью заменить данным кодом код модуля Unit1.
;)

Код:

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}

в файле proxy.txt, находящемся в папке с этой программой должен содержаться список прокси в "стандартном" формате ip:port.
В файл good.txt пишутся хорошие прокси.

Пример может быть легко "переоборудован" практически в любую другую многопоточную программу по отсылке\приему\обработке http запросов.

Если вы покажете изменения, которые, будучи внесены сделают его _реально_ более эффективным - велкам.

в этом посте будет содержаться тот же самый код, только для консольной версии.

1. для класса лучше создавать отдельный модуль
2. есть WSAStartup а где WsaCleanUp?
3. дожидаться завершения потоков с помощью sleep в корне не верно. Статик поле - счетчик живых потоков. Либо пробегаться по массиву и проверять свойство Alive (я в дельфи не помню, в .NET'e это IsAlive)
4. for counter_1:=0 to threads-1 do MyThread[counter_1] := TMyThread.Create( True );
for counter_1:=0 to threads-1 do MyThread[counter_1].FreeOnTerminate := True;
for counter_1:=0 to threads-1 do MyThread[counter_1].Priority := tpLower;
эмм... а не проще ли создать объект, изменить свойства и добавить в массив? или сделать это в конструкторе?

это навскидку, не углублялся. То что сразу бросилось в глаза

сорцы хоть скинь, полные

AquaKlaster
сорцы полные. Программа состоит всего из 1 - этого - модуля.

W!z@rD
для наглядности 1-им модулем - лучше.
WsaCleanUp - добавил, сделал вызов стартапа и клинапа в программе всего по 1 разу
Конструктор - добавил
счетчик живых потоков - добавил

Буду рад комментам по увеличению эффкетивности (если такое возможно).

>>Конструктор.. не проще, но прикольнее.
O_o

WsaStartup/WsaCleanUp не дергай каждый раз, в каждом потоке.
Startup перед запуском потока, CleanUp при завершении последнего потока.

Смотри конструкторы/деструкторы

http://www.rsdn.ru/forum/delphi/2927396.flat.aspx - рассматривается вопрос о том как определить работает поток или нет:?

P.S. я на канале, помогу если не занят буду

W!z@rD - спс за замечания)
ты прав, с конструктором веселее.
И с WsaStartup тоже поправил уже, пока редактировал. Теперь вызываю его всего 1 раз, и 1 раз клин-ап.

Сейчас встрою контроль по счетчику живых потоков и будет вообще красота ><

не используй так называемые магические цифры...
"20000" константу делай из этого. MAX_BUF_LEN

'GET /index.php HTTP/1.1'+ #13#10 +
'Host: vkontakte.ru'+ #13#10#13#10;
аналогично
'GET /index.php HTTP/1.1'#13#10'Host: vkontakte.ru'#13#10#13#10;

не проще ли передавать прокси и учетку в поток?
1 поток - 1 проверка

addr.sin_family:=AF_Inet;
addr.sin_port:=htons(strtoint(port));
addr.sin_addr.S_addr:=inet_addr(PChar(ip));
with? (мне не хватает этого в дотнете)

cs2.Enter; append(good); writeln(good,ip+':'+port); closefile(good); cs2.Leave;
ппц, не пиши так =)

закрытие файлов и освобождение ресурсов делай в блоке try...finally, там же можно сделать обработку исключений.

"Set-Cookie", а "set-cookie" прийти не может?
мб есть смысл переводить все в нижний регистр?

форма будет висеть до тех пор пока не кончатся прокси?

Цитата:

Сообщение от W!z@rD

не используй так называемые магические цифры...
"20000" константу делай из этого. MAX_BUF_LEN

По моему не самый лучший вариант. Зачем ему использовать максимальный размер буфера? Лучше объявить свою константу BUF_LEN и присвоить ей нужное значение.

константу объявил, пусть будет - все удобнее.

'GET /index.php HTTP/1.1'+ #13#10 +
'Host: vkontakte.ru'+ #13#10#13#10;
так и задумано. Если у юзера в запросе не 2 а 7,8 или даже 10 строк - очень удобно писать именно в таком формате.

Цитата:

не проще ли передавать прокси и учетку в поток?
1 поток - 1 проверка

не понял о чем ты. Правильнее сразу считывать весь файл в память и раздавать данные из памяти, нежели с винта. Тут я это не делал т.к. это увеличит код, хотя повысит скорость работы за счет уменьшения времени, в течение которого может быть "затор" на критической секции.

with : +3^4символьных слова в данном случае смотрятся лучше, чем +5 слов, образующие 3 дополнительные строки.
Хотя вообще, согласен, удобная вещь.

открытие\закрытие файлов и освобождение крит-секций в try...finally добавил.

Обработку ошибок на connect (сразу говорю) считаю излишней, т.к. в случае, если коннекта нет, то никаких действий не просиходит и никаких "нештатных" ситуаций тоже. Означает же это что либо проксик совсем мертвый, либо что у юзера нет инета. В первом случае все норм, во втором - проблемы индейцев шерифа не волнуют.
На WsaStartup тоже обработку ошибок не делал - лишний код. Если WsaStartup успешно, то все будет работать, а если нет, то юзер и сам догадается, что пора поставить XP вместо win-95

Set-Cookie - там приходит именно так. В нижнем регистре не приходит.
Да и не суть важно за какую фразу "цепляться", главное чтобы она была в 100% нужных ответов и в минимуме (>>0) ненужных.

Форма будет висеть пока её не закроют крестиком :)
Если юзер снова нажмет кнопку - надпись на ней снова сменится на "Proceccing..." и программа безбажно отработает цикл еще раз.
При закрытии формы - закрывается файл proxy и освобождаются крит-секции.
Если даже завершение пройдет некорректно, это все равно не страшно.

Контроль за фактом завершения программы по количеству незавершенных потоков (равному 0) добавил.
Теперь программа пишет Ready только после того, как завершатся все созданные ею потоки.