Нашёл на ачате код для проверки прокси на пригодность для вконтакте. Убрал лишние для меня причуды, однако что-то так и не заработал. Ну не хочет проверять и всё тут. Гляньте, пожалуйста:
Код:
unit Unit20;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Winsock;
const
MAX_BUF_LEN=20000;
REPLY_TIMEOUT=10;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Memo2: TMemo;
Button2: TButton;
OpenDialog1: TOpenDialog;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure Delay (const Seconds: Real);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
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;
procedure TForm1.Button2Click(Sender: TObject);
var
s:TSOCKET;
addr:sockaddr_in;
{строка содержащая тело http запроса}
sendbuff,
{переменные для ip и порта, считываемых из файла}
ip,port,
{строка, в которую читаем строки из файла proxy}
str, resstr,
{строка, содержащая ответ на наш http хапрос от сервера}
reply:string;
i:integer;
begin
for i := 0 to Memo1.Lines.Count - 1 do
str:=Memo1.Lines[i];
Label1.Caption:=str;
delay(1);
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(PAnsiChar(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);
Label1.Caption:=reply;
// закрываем сокет
closesocket(s);
// ip и port использованной прокси
// с использованием критической секции)
if pos('Set-Cookie',reply)<>0 then
begin
resstr:=ip+':'+port;
Memo2.Lines.Add(resstr);
end;
end;
procedure TForm1.Delay(const Seconds: Real);
var
Later: TDateTime;
begin
Later:= Now + (Seconds / (24.0 * 60.0 * 60.0));
While Now < Later do Application.ProcessMessages;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
end;
end.
Сам проект и свежие проксики для проверки тут:
http://data.cod.ru/71454 (12 Кб)
Исходный исходный (гы) код тут:
http://forum.antichat.ru/showthread.php?t=143556