Pyhin
09.06.2010, 07:14
function GetURL2HTML (url : string; method : string; proxy: string): AnsiString;
var
FHost, FScript : String;
hInternet, hConnect, hRequest : pointer;
dwBytesRead, I, L : Cardinal;
Flags_connection,Flags_Request : Cardinal;
sss: String;
dwcode: array[1..20] of char;
res: String;
begin
sss := 'Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8' + #13#10 +
'Accept-Language: ru,en-us;q=0.7,en;q=0.3' + #13#10 +
'Accept-Encoding: gzip,deflate' + #13#10 +
'Accept-Charset: windows-1251,utf-8;q=0.7,*;q=0.7';
fHost := GetHostName(url);
fScript := GetScriptName(url, fHost);
SetFlags (url, Flags_connection, Flags_request);
hInternet := InternetOpen(PChar ('Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.2.3) Gecko/20100401 Firefox/3.6.3'), INTERNET_OPEN_TYPE_PROXY, PChar(proxy),Nil,0);
if Assigned(hInternet) then
begin
hConnect := InternetConnect (hInternet, PChar(fHost), Flags_connection, nil, nil, INTERNET_SERVICE_HTTP, 0 ,1);
if Assigned(hConnect) then
begin
hRequest:= HttpOpenRequest(hConnect,PChar(uppercase(method)), PChar(fScript), HTTP_VERSION, nil, nil, Flags_Request, 1);
if Assigned(hRequest) then
begin
I:=1;
if HttpSendRequest(hRequest,PChar(sss), Length(sss), nil, 0) then
begin
repeat
dataAvaible(hRequest, L);
if L = 0 then break;
SetLength(result, L+I);
if InternetReadFile(hRequest, @result[I], sizeof(L), dwBytesRead) then
else break;
inc(I, dwBytesRead);
until dwBytesRead = 0;
result[I] := #0;
res := PChar(@dwcode);
end;
end;
InternetCloseHandle(hRequest);
end;
InternetCloseHandle(hConnect);
end;
InternetCloseHandle(hInternet);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
html_cod : ANSIString;
proxy, ip_num , url : String;
i, ph: Integer;
begin
Form1.button1.Enabled := false;
url := 'http://ipchicken.com/';
for i:=0 to Form1.Memo1.Lines.Count-1 do
begin
Application.ProcessMessages();
proxy := Form1.Memo1.Lines[i];
Application.ProcessMessages();
html_cod := GetURL2HTML(url, 'get', proxy);
if (html_cod <> '') then
begin
ph := pos ('Address: ', html_cod);
if ph > 0 then
begin
ip_num := trim(copy(html_cod, ph+ 9,30));
Form1.Memo2.Lines.add(ip_num);
end
else
Form1.Memo2.Lines.add('Error...');
end
else
begin
Form1.Memo2.Lines.add('Bad proxy: '+proxy);
end;
end;
Form1.button1.Enabled := true;
end;
Данный код подключается через прокси к сайту, два вопроса:
1. При нажатии Button1 форма виснет не смотря на использование Application.ProcessMessages() (пробовал запускать при нажатии Button1 в отдельном потоке, зависание конечно пропадает , но такое решение меня не устраивает), что не так?
2. Как выставить максимальный таймаут подключения а то после перебора нескольких прокси программа останавливается?
var
FHost, FScript : String;
hInternet, hConnect, hRequest : pointer;
dwBytesRead, I, L : Cardinal;
Flags_connection,Flags_Request : Cardinal;
sss: String;
dwcode: array[1..20] of char;
res: String;
begin
sss := 'Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8' + #13#10 +
'Accept-Language: ru,en-us;q=0.7,en;q=0.3' + #13#10 +
'Accept-Encoding: gzip,deflate' + #13#10 +
'Accept-Charset: windows-1251,utf-8;q=0.7,*;q=0.7';
fHost := GetHostName(url);
fScript := GetScriptName(url, fHost);
SetFlags (url, Flags_connection, Flags_request);
hInternet := InternetOpen(PChar ('Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.2.3) Gecko/20100401 Firefox/3.6.3'), INTERNET_OPEN_TYPE_PROXY, PChar(proxy),Nil,0);
if Assigned(hInternet) then
begin
hConnect := InternetConnect (hInternet, PChar(fHost), Flags_connection, nil, nil, INTERNET_SERVICE_HTTP, 0 ,1);
if Assigned(hConnect) then
begin
hRequest:= HttpOpenRequest(hConnect,PChar(uppercase(method)), PChar(fScript), HTTP_VERSION, nil, nil, Flags_Request, 1);
if Assigned(hRequest) then
begin
I:=1;
if HttpSendRequest(hRequest,PChar(sss), Length(sss), nil, 0) then
begin
repeat
dataAvaible(hRequest, L);
if L = 0 then break;
SetLength(result, L+I);
if InternetReadFile(hRequest, @result[I], sizeof(L), dwBytesRead) then
else break;
inc(I, dwBytesRead);
until dwBytesRead = 0;
result[I] := #0;
res := PChar(@dwcode);
end;
end;
InternetCloseHandle(hRequest);
end;
InternetCloseHandle(hConnect);
end;
InternetCloseHandle(hInternet);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
html_cod : ANSIString;
proxy, ip_num , url : String;
i, ph: Integer;
begin
Form1.button1.Enabled := false;
url := 'http://ipchicken.com/';
for i:=0 to Form1.Memo1.Lines.Count-1 do
begin
Application.ProcessMessages();
proxy := Form1.Memo1.Lines[i];
Application.ProcessMessages();
html_cod := GetURL2HTML(url, 'get', proxy);
if (html_cod <> '') then
begin
ph := pos ('Address: ', html_cod);
if ph > 0 then
begin
ip_num := trim(copy(html_cod, ph+ 9,30));
Form1.Memo2.Lines.add(ip_num);
end
else
Form1.Memo2.Lines.add('Error...');
end
else
begin
Form1.Memo2.Lines.add('Bad proxy: '+proxy);
end;
end;
Form1.button1.Enabled := true;
end;
Данный код подключается через прокси к сайту, два вопроса:
1. При нажатии Button1 форма виснет не смотря на использование Application.ProcessMessages() (пробовал запускать при нажатии Button1 в отдельном потоке, зависание конечно пропадает , но такое решение меня не устраивает), что не так?
2. Как выставить максимальный таймаут подключения а то после перебора нескольких прокси программа останавливается?