ErrorNeo
25.09.2009, 13:15
потребовалось, потому постарался по возможности создать "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 запросов.
Если вы покажете изменения, которые, будучи внесены сделают его _реально_ более эффективным - велкам.
Уверен новичкам пригодится.
Требуется:
кинуть на форму 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 запросов.
Если вы покажете изменения, которые, будучи внесены сделают его _реально_ более эффективным - велкам.