потребовалось, потому постарался по возможности создать "fine example of source code" Уверен новичкам пригодится. Требуется: кинуть на форму Button1, Edit1, Label1 создать событие Form1.OnCreate затем полностью заменить данным кодом код модуля Unit1. Code: 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 разу Конструктор - добавил счетчик живых потоков - добавил Буду рад комментам по увеличению эффкетивности (если такое возможно).
>>Конструктор.. не проще, но прикольнее. 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" прийти не может? мб есть смысл переводить все в нижний регистр? форма будет висеть до тех пор пока не кончатся прокси?
По моему не самый лучший вариант. Зачем ему использовать максимальный размер буфера? Лучше объявить свою константу BUF_LEN и присвоить ей нужное значение.
константу объявил, пусть будет - все удобнее. 'GET /index.php HTTP/1.1'+ #13#10 + 'Host: vkontakte.ru'+ #13#10#13#10; так и задумано. Если у юзера в запросе не 2 а 7,8 или даже 10 строк - очень удобно писать именно в таком формате. не понял о чем ты. Правильнее сразу считывать весь файл в память и раздавать данные из памяти, нежели с винта. Тут я это не делал т.к. это увеличит код, хотя повысит скорость работы за счет уменьшения времени, в течение которого может быть "затор" на критической секции. with : +3^4символьных слова в данном случае смотрятся лучше, чем +5 слов, образующие 3 дополнительные строки. Хотя вообще, согласен, удобная вещь. открытие\закрытие файлов и освобождение крит-секций в try...finally добавил. Обработку ошибок на connect (сразу говорю) считаю излишней, т.к. в случае, если коннекта нет, то никаких действий не просиходит и никаких "нештатных" ситуаций тоже. Означает же это что либо проксик совсем мертвый, либо что у юзера нет инета. В первом случае все норм, во втором - проблемы индейцев шерифа не волнуют. На WsaStartup тоже обработку ошибок не делал - лишний код. Если WsaStartup успешно, то все будет работать, а если нет, то юзер и сам догадается, что пора поставить XP вместо win-95 Set-Cookie - там приходит именно так. В нижнем регистре не приходит. Да и не суть важно за какую фразу "цепляться", главное чтобы она была в 100% нужных ответов и в минимуме (>>0) ненужных. Форма будет висеть пока её не закроют крестиком Если юзер снова нажмет кнопку - надпись на ней снова сменится на "Proceccing..." и программа безбажно отработает цикл еще раз. При закрытии формы - закрывается файл proxy и освобождаются крит-секции. Если даже завершение пройдет некорректно, это все равно не страшно. Контроль за фактом завершения программы по количеству незавершенных потоков (равному 0) добавил. Теперь программа пишет Ready только после того, как завершатся все созданные ею потоки.
ты в танке. мне одному так кажется? ErrorNeo >>не проще ли передавать прокси и учетку в поток? 1 поток - 1 проверка у тебя поток сам выдергивает из списка прокси, не проще потоку прокси выдавать? и вынеси класс - поток в отдельный модуль. Намного проще читается
Знал что сказать... Сказал бы еще что в бронепоезде... Нет-нет. Лучше в Protoss Mothership. Это немного глупо. Не лучше бы поровну распределить список прокси между всеми потоками, и сразу передать этот список соответствующему потоку? Если следовать твоему методу, то если было бы 10 000 входных проксей, то создавать и уничтожать потоки 10 000 раз было бы немного не правильно.
W!z@rD насчет передачи данных в потоки - понял. не знаю, насколько это будет эффективнее при значительных нагрузках, попробую - создам перегруженный конструктор с параметрами для передачи прокси в поток. Думаю выигрыш в скорости за счет полного отказа от 1 из крит-секций будет. Выносить в отдельный модуль не буду, у меня в 2 прогах он разбит на 2 модуля - и все равно мне такие небольшие коды удобнее читать одним модулем. ред. хотя нет. при 1000+ прокси вопрос будет в том, что быстрее - 1000+ раз выдернуть значение из файла с помощью крит-секции(или, если уж делать по-нормальному то не из файла а из массива памяти, куда все значения уже были предварительно считаны) или же создать\удалить 10к потоков. Я думаю первый метод намного быстрее. При этом +-5 секунд в случае, если требуется сделать <1000 Запросов - не важны. А вот если этот код будет переписан под что-либо "тяжеловесное", делающее 10-ки тысяч запросов и обрабатывающее их (одновременно в ~500 потоков) - тут думаю рациональнее таки выдирать данные из массива памяти.
добавил "правильное" закрытие программы (в случае, если юзер решит закрыть её крестиком посреди процесса чека прокси): при попытке закрытия программы она предварительно завершает все потоки, и только после этого закрывается сама. Кроме того сделал чтобы программа больше не "висела" ни на одном из этапов работы, добавив так не хватавший в этом коде application.processmessages()
- почему 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
mazaxaka [Warning]'и не мешают коду компилироваться. кроме того ты не указал строку, на которую ругается компилятор. у меня все компилируется, более того эту прогу юзает "по назначению" мой друг. Hellsp@wn на recv таймаут "реализован", хоть и несколько другим методом. Благодарю за +1 метод, попробую. Юзать как я понял надо: Code: 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? Так же буду благодарен если кто-либо покажет кусочек кода с образцом таймаута для connect. Сокс 4\5 - попробую добавить.
