Код:
Uses
...WinInit;
//Функция для чтения заголовка ответа сервера
function GetQueryInfo(hRequest: Pointer): string;
var code: String;
size,index:Cardinal;
begin
SetLength(code,8);//достаточная длина для чтения статус-кода
size:=Length(code);
index:=0;
if HttpQueryInfo(hRequest, HTTP_QUERY_RAW_HEADERS_CRLF ,PChar(code),size,index)then
Result:=Code
else
if GetLastError=ERROR_INSUFFICIENT_BUFFER then //увеличиваем буффер
begin
SetLength(code,size);
size:=Length(code);
if HttpQueryInfo(hRequest,HTTP_QUERY_RAW_HEADERS_CRLF,PChar(code),size,index) then
Result:=code;
end
else
Result:='';
end;
//Функция WinInit для запросов Get и Post
function GetPostSite(Method, URLRes: String; SendHeader: string=''; SendStream: TStream=nil): string;
const
Accept = 'Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8' + sLineBreak;
ProxyConnection = 'Proxy-Connection: Keep-Alive' + sLineBreak;
LNG = 'Accept-Language: ru' + sLineBreak;
AGENT = 'User-Agent: Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) '+
'Chrome/56.0.2924.87 Safari/537.36 OPR/43.0.2442.1144 (Edition Yx)' + sLineBreak;
var
Host, URL, URL_Base, URL_Page, s: String;
hInet, hCon, hReq: Pointer;
Status, StatusSize, Index, Port: DWORD;
bytes, b, posi: Cardinal;
ResponseString: AnsiString;
SRequest: String;
begin
//Разбираем строку запроса
URL:= URLRes;
if pos('http://', URL) <> 0 then
Port:= 80
else
if pos('https://', URL) <> 0 then
Port:= 443;
B:= pos('://', URL);
if b > 0 then
delete(URL, 1, B + 2);
B:= pos('/', URL);
if b > 0 then
URL_Base:= copy(URL, 1, b - 1)
else
URL_Base:= URL;
B:= pos(':', URL_Base);
if b > 0 then
begin
Port:= StrToInt(Copy(URL_Base, b + 1, MaxInt));
delete(URL_Base, b, maxint);
end;
b:= pos('/', URL);
if b <> 0 then
URL_Page:= copy(URL, b, maxint)
else
URL_Page:= '/';
hInet:= InternetOpen('My Agent',INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,0);
if not Assigned(hInet) then
begin
Showmessage('Error: InternetOpen');
exit;
end;
hCon:= InternetConnect(hInet, PChar(URL_Base), Port, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);
if not Assigned(hCon) then
begin
Showmessage('Error: InternetConnect');
exit;
end;
if Port <> 443 then
hReq:= HttpOpenRequest(hCon, PAnsichar(Method), PAnsichar(URL_Page),HTTP_VERSION, nil,nil,
INTERNET_FLAG_KEEP_CONNECTION or INTERNET_FLAG_RELOAD, 0)
else
hReq:= HttpOpenRequest(hCon, PAnsichar(Method), PAnsichar(URL_Page),HTTP_VERSION, nil,nil,
INTERNET_FLAG_SECURE, 0);
if not Assigned(hReq) then
begin
Showmessage('Error: HttpOpenRequest');
exit;
end;
// добавляем необходимые заголовки к запросу
Host:= 'Host: ' + URL_Base;
if Port <> 80 then
Host:= Format('%s:%d', [Host, Port]);
HttpAddRequestHeaders(hReq, PAnsiChar(Host),
Length(Host), HTTP_ADDREQ_FLAG_ADD);
HttpAddRequestHeaders(hReq, Accept,
Length(Accept), HTTP_ADDREQ_FLAG_ADD);
HttpAddRequestHeaders(hReq, ProxyConnection,
Length(ProxyConnection), HTTP_ADDREQ_FLAG_ADD);
HttpAddRequestHeaders(hReq, LNG,
Length(LNG), HTTP_ADDREQ_FLAG_ADD);
HttpAddRequestHeaders(hReq, AGENT,
Length(AGENT), HTTP_ADDREQ_FLAG_ADD);
if SendHeader <> '' then
begin
HttpAddRequestHeaders(hReq, PAnsichar(SendHeader),
Length(SendHeader), HTTP_ADDREQ_FLAG_ADD);
end;
// Проверяем запрос:
StatusSize := 0;
Index := 0;
SRequest := '';
HttpQueryInfo(hReq, HTTP_QUERY_RAW_HEADERS_CRLF or
HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], StatusSize, Index);
if StatusSize > 0 then
begin
SetLength(SRequest, StatusSize);
HttpQueryInfo(hReq, HTTP_QUERY_RAW_HEADERS_CRLF or
HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], StatusSize, Index);
end;
// Отправляем запрос
if (SendStream <> nil) then
begin
if not (HttpSendRequest(hReq, nil, 0, TMemoryStream(SendStream).Memory, SendStream.Size)) then
begin
Showmessage('Error: HttpSendRequest SendStream');
exit;
end;
end
else
if not (HttpSendRequest(hReq, nil, 0, nil, 0)) then
begin
Showmessage('Error: HttpSendRequest');
exit;
end;
//Смотрим заголовок ответа сервера, если это не нужно то за комментируйте это
//=========================
S:= GetQueryInfo(hReq);
Result:= Copy(S, 1, Length(S)-1);
//=========================
posi := 1;
b := 1;
ResponseString := '';
while b > 0 do
if InternetQueryDataAvailable( hReq, bytes, 0, 0 ) then
begin
SetLength(ResponseString, Length(ResponseString) + bytes );
InternetReadFile(hReq, @ResponseString[Posi], bytes, b );
Inc(Posi, b);
end;
InternetCloseHandle(hReq);
InternetCloseHandle(hCon);
InternetCloseHandle(hInet);
Result:= Result + ResponseString;
end;
//Функция Парсинг
function Pars(ForS, T_, _T: string): string;
var
a, b: integer;
begin
Result := '';
if (T_ = '') or (ForS = '') or (_T = '') then
Exit;
a := Pos(AnsiLowerCase(T_), AnsiLowerCase(ForS));
if a = 0 then
Exit
else
a := a + Length(T_);
ForS := Copy(ForS, a, Length(ForS) - a + 1);
b := Pos(AnsiLowerCase(_T), AnsiLowerCase(ForS));
if b > 0 then
Result := Copy(ForS, 1, b - 1);
end;
//Получаем нужную инфу для авторизации
procedure TForm1.Button1Click(Sender: TObject);
var
stream: TStringStream;
URL, SURL, LoginURL: String;
begin
try
stream:= TStringStream.Create('');
memo1.Text:= UTF8ToAnsi(GetPostSite('GET', 'https://login.mts.ru/amserver/UI/Login'));
Label1.Caption:= Pars(memo1.Text, '<input type="hidden" name="csrf.sign" value="', '"');
Label2.Caption:= Pars(memo1.Text, '<input type="hidden" name="csrf.ts" value="', '"');
URL:= Pars(memo1.Text, '<form id="form" action="', '"');
stream.WriteString('&csrf.sign=' + Label1.Caption + '&csrf.ts=' + Label2.Caption);
memo1.Text:= UTF8ToAnsi(GetPostSite('POST', URL, '', stream));
Label1.Caption:= Pars(memo1.Text, '<input type="hidden" name="csrf.sign" value="', '"');
Label2.Caption:= Pars(memo1.Text, '<input type="hidden" name="csrf.ts" value="', '"');
LoginURL:= Pars(memo1.Text, '<input type="hidden" name="loginURL" value="', '"');
SURL:= Pars(memo1.Text, '<iframe src="', '"'); //Получаем ссылку на вход
finally
stream.Free;
end;
end;