Форум АНТИЧАТ - Многопоточный чеккер прокси под 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 только после того, как завершатся все созданные ею потоки.

Цитата:

Сообщение от Chrome~

ты в танке.
мне одному так кажется?

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

у тебя поток сам выдергивает из списка прокси, не проще потоку прокси выдавать?

и вынеси класс - поток в отдельный модуль. Намного проще читается

Цитата:

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

ты в танке.

Знал что сказать... Сказал бы еще что в бронепоезде... Нет-нет. Лучше в Protoss Mothership.

Цитата:

1 поток - 1 проверка

Это немного глупо. Не лучше бы поровну распределить список прокси между всеми потоками, и сразу передать этот список соответствующему потоку? Если следовать твоему методу, то если было бы 10 000 входных проксей, то создавать и уничтожать потоки 10 000 раз было бы немного не правильно.

W!z@rD насчет передачи данных в потоки - понял.
не знаю, насколько это будет эффективнее при значительных нагрузках, попробую - создам перегруженный конструктор с параметрами для передачи прокси в поток.
Думаю выигрыш в скорости за счет полного отказа от 1 из крит-секций будет.

Выносить в отдельный модуль не буду, у меня в 2 прогах он разбит на 2 модуля - и все равно мне такие небольшие коды удобнее читать одним модулем.

ред.
хотя нет. при 1000+ прокси вопрос будет в том, что быстрее - 1000+ раз выдернуть значение из файла с помощью крит-секции(или, если уж делать по-нормальному то не из файла а из массива памяти, куда все значения уже были предварительно считаны) или же создать\удалить 10к потоков.
Я думаю первый метод намного быстрее.
При этом +-5 секунд в случае, если требуется сделать <1000 Запросов - не важны.
А вот если этот код будет переписан под что-либо "тяжеловесное", делающее 10-ки тысяч запросов и обрабатывающее их (одновременно в ~500 потоков) - тут думаю рациональнее таки выдирать данные из массива памяти.

добавил "правильное" закрытие программы (в случае, если юзер решит закрыть её крестиком посреди процесса чека прокси):
при попытке закрытия программы она предварительно завершает все потоки, и только после этого закрывается сама.
Кроме того сделал чтобы программа больше не "висела" ни на одном из этапов работы, добавив так не хватавший в этом коде application.processmessages()

Цитата:

Сообщение от ErrorNeo

Код:

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}

Уважаю респект будут 10 месаг+ 1 обезательно

хм... чтото у меня даный код не рабоатет.. зделал..все.. запускаюю.. вылетает ошибка..

Цитата:

Сообщение от mazaxaka

хм... чтото у меня даный код не рабоатет.. зделал..все.. запускаюю.. вылетает ошибка..

Какая ошибка?

- почему socks4/5 не чекаются?
- нужен таймаут на Connect
на recv и send можно выставить таймауты таким образом:

iout := timeout * 1000;
setsockopt(sk,SOL_SOCKET,SO_RCVTIMEO,@iout,4); // timeout recv iout/1000 sec
setsockopt(sk,SOL_SOCKET,SO_SNDTIMEO,@iout,4); // timeout send iout/1000 sec

вот ошибка

Цитата:

[Warning] Unit1.pas(156): For loop control variable must be simple local variable

я вдельфи новичек.. так что может чтото упустил

mazaxaka
[Warning]'и не мешают коду компилироваться.
кроме того ты не указал строку, на которую ругается компилятор.
у меня все компилируется, более того эту прогу юзает "по назначению" мой друг.

Hellsp@wn
на recv таймаут "реализован", хоть и несколько другим методом. Благодарю за +1 метод, попробую.
Юзать как я понял надо:

Код:

iout   := timeout * 1000;

setsockopt(sk,IPPROTO_TCP,SO_RCVTIMEO,@iout,4); // timeout recv iout/1000 sec

setsockopt(sk,IPPROTO_TCP,SO_SNDTIMEO,@iout,4); // timeout send iout/1000 sec

Кстати при каких условиях может вообще понадобиться таймаут на send? :confused:
Так же буду благодарен если кто-либо покажет кусочек кода с образцом таймаута для connect.

Сокс 4\5 - попробую добавить.

Програма то компилируется..
файл с прокси есть
гуд тоже создал
ставлю таймаут
жму батом1
и нечего..

а ругается вот на ету

Цитата:

for counter_1:=0 to threads-1 do MyThread[counter_1] := TMyThread.Create;

и ету строки

Цитата:

for counter_1:=0 to threads-1 do

строки

Цитата:

Сообщение от ErrorNeo

Так же буду благодарен если кто-либо покажет кусочек кода с образцом таймаута для connect.

На асме у меня такой код для таймаута работает:

Код:

LOCAL timeout: timeval

LOCAL fds: fd_set

LOCAL block: DWORD



;подключение

        mov block, 1

        invoke ioctlsocket, hSock, FIONBIO, addr block

        invoke connect, hSock, addr sin, sizeof sin

        mov block, 0

        invoke ioctlsocket, hSock, FIONBIO, addr block

;таймаут

        mov timeout.tv_sec, 3

        mov timeout.tv_usec, 0

        mov eax, 1

        mov fds.fd_count, eax

        mov eax, hSock

        mov fds.fd_array, eax

        invoke select, 0, addr fds, addr fds, 0, addr timeout

        .if eax==0

                invoke closesocket, hSock

                mov eax, 5

                ret

        .endif

На дельфи вроде так будет выглядеть, но на работоспособность не проверял:

Код:

var

        timeout: timeval;

        fds: fd_set;

        block: DWORD;

begin

        block:=1;

        ioctlsocket(hSock, FIONBIO, block);

        connect(hSock, sin, sizeof (sin));

        block:=0;

        ioctlsocket(hSock, FIONBIO, block);

        timeout.tv_sec:= 3;

        timeout.tv_usec:= 0;

        fds.fd_count:= 1;

        fds.fd_array:= hSock;

        if select(0, fds, fds, 0, timeout)=0 then

        begin

                \\Подключиться не удалось

        end;

end;

Может быть стоит вообще поставить таймаут на поток, тогда не будет необходимости ставить таймауты на подключение, запись и чтение.
А имеет ли вообще смысл чекать прокси? Может быть лучше перед началом работы заносить все прокси в список или массив sockaddrin, а во время выполнения основного функционала (например проверка акков на валидность) занулять или удалять из списка нерабочие.

0rs
ну я не собирался писать "многопоточный спамер по личкам ВК своими руками", потому написал безобидный пример) Кому надо - тот допишет сколько то строк сам.
Спс за _примерный_ пример таймаута на коннект. Будет время погуглю как это правильно пишется и добавлю.

mazaxaka
видимо у тебя дельфи-7 - я писал на дельфи 6.
Перенеси переменную counter_1 из глобальных в переменные функции Button1.click, и все заработает.

Спс за сорцы.
Только один вопрос: почему ты используешь 2 крит. секции? Почему не одну?

2 крит секции потому что работа идет с 2 файлами.

Не имеет смысла блокировать доступ к файлу good.txt из-за того, что идет работа с proxy.txt. А вот быстродействию кода это заметно повредило бы.