По просьбе трудящихся выкладываю вот такой простенький исходник программки с помощью, которой можно получить ТИЦ и PR сайта путем выполнения POST запроса
Скрин примера
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,WinInet, StdCtrls;
type
TfrmMain = class(TForm)
Button1: TButton;
edtSite: TEdit;
lblTC_PR: TLabel;
lblSite: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
const
// дефолное название приложение через которое якобы происходит соединение
DefaultAppName ='Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.2.6) Gecko/20100625 Firefox/3.6.6';
function exam(msData: TMemoryStream):string;
function DataAvailable(hRequest: pointer; out Size: cardinal): BOOLEAN;
begin
Result := WinInet.InternetQueryDataAvailable(hRequest, Size, 0, 0);
end;
var
hInternet, hConnect, hRequest: pointer;
dwBytesRead, i, L: cardinal;
sTemp: AnsiString; // текст страницы
sHeader: String;
begin
Result:='';
try
hInternet := InternetOpen(PChar(DefaultAppName),INTERNET_OPEN_TYPE_PRECONFIG, Nil, Nil, 0);
if Assigned(hInternet) then
begin
// Открываем сессию
//http://ip-whois.net/pr_cy_check.php обратите внимание как записал в коде адрес сайта
hConnect := InternetConnect(hInternet, PWideChar('ip-whois.net'),INTERNET_DEFAULT_HTTP_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 1);
if Assigned(hConnect) then
begin
// открываем запрос
hRequest := HttpOpenRequest(hConnect, PWideChar('POST'),
PWideChar('/pr_cy_check.php'), HTTP_VERSION, nil, Nil,
INTERNET_FLAG_KEEP_CONNECTION, 1);
sHeader:='Accept: */*';
HttpAddRequestHeaders(hRequest, Pointer(sHeader), Length(sHeader), HTTP_ADDREQ_FLAG_ADD);
sHeader:= 'Content-Type: application/x-www-form-urlencoded';
HttpAddRequestHeaders(hRequest, Pointer(sHeader), Length(sHeader), HTTP_ADDREQ_FLAG_ADD);
sHeader:= 'Accept-Language: ru-ru,ru;q=0.8,en-us;q=0.5,en;q=0.3';
HttpAddRequestHeaders(hRequest, Pointer(sHeader), Length(sHeader), HTTP_ADDREQ_FLAG_ADD);
sHeader:= 'Accept-Charset: windows-1251,utf-8;q=0.7,*;q=0.7';
HttpAddRequestHeaders(hRequest, Pointer(sHeader), Length(sHeader), HTTP_ADDREQ_FLAG_ADD);
if Assigned(hRequest) then
begin
// Отправляем запрос
i := 1;
if HttpSendRequest(hRequest, nil, 0, msData.memory, msData.Size) then
begin
repeat
DataAvailable(hRequest, L); // Получаем кол-во принимаемых данных
if L = 0 then
break;
SetLength(sTemp, L + i);
if not InternetReadFile(hRequest, @sTemp[i], sizeof(L),dwBytesRead) then
break; // Получаем данные с сервера
inc(i, dwBytesRead);
until dwBytesRead = 0;
sTemp[i] := #0;
Result:=sTemp;
end;
end;
end;
end;
finally
InternetCloseHandle(hRequest);
InternetCloseHandle(hConnect);
InternetCloseHandle(hInternet);
end;
end;
function TC_PR(aValue:string):string;
var
i:Integer;
TC,PR:string;
begin
i:=AnsiPos('</h2><h3>ТИЦ: ',aValue);
if i=0 then
begin
Result:='Неизвестно!';
Exit;
end;
Delete(aValue,1,i+length('</h2><h3>ТИЦ: ')-1);
i:=AnsiPos('</h3><h3>PR: ',aValue);
TC:=Copy(aValue,0,i-1);
Delete(aValue,1,i+length('</h3><h3>PR: ')-1);
i:=AnsiPos('</h3><br>',aValue);
PR:=Copy(aValue,0,i-1);
Result:='ТИЦ '+TC+' PR '+PR;
end;
procedure TfrmMain.Button1Click(Sender: TObject);
var
zapros:TStringStream;
sTemp:string;
begin
zapros:=TStringStream.Create;
zapros.WriteString('T1='+edtSite.Text+'&B1=T2=%D3%E7%ED%E0%F2%FC+%D2%C8%D6+%E8+PR');
sTemp:=exam(zapros);
if Length(sTemp)>0 then
lblTC_PR.Caption:=TC_PR(sTemp);
zapros.Free;
end;
end.
Скачать исходник проекта можно
отсюда Download
