Эксперт
Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005
Репутация: 3
Всего: 50
|
| Код |
unit Inet;
interface
uses
Windows, Classes, SysUtils, Wininet, Dialogs;
type
TParam=record
Name: String;
Value: String;
end;
TParams=array of TParam;
TTypeQuery=(tqGET,tqPOST);
TProxyType=(ptNone,ptIE,ptList);
PPageResult=^TPageResult;
TPageResult=record
Page: AnsiString;
Error: Integer;
end;
THttpQuery=class
private
FQuery: AnsiString;
FParams: TStringList;
FCookieSend: AnsiString;
FCookieReceived: AnsiString;
FHost: AnsiString;
FScript: AnsiString;
FPage: AnsiString;
procedure SetQuery(const Value: AnsiString);
public
Proxy: AnsiString;
ProxyType: TProxyType;
constructor Create;
destructor Destroy; override;
class function Encode(const Src: AnsiString): AnsiString;
function ExecQuery(QueryType: TTypeQuery=tqGET): TPageResult;
procedure ParamClear;
procedure ParamAdd(const Name,Value: AnsiString);
procedure ParamsAdd(Params: TParams);
procedure ParamDelete(const Name: AnsiString);
function ParamGet(const Name: AnsiString): AnsiString;
property CookieSend: AnsiString read FCookieSend write FCookieSend;
property CookieRec: AnsiString read FCookieReceived;
property Query: AnsiString read FQuery write SetQuery;
end;
const
HTTP_PORT = 80;
CRLF = #13#10;
Header = 'Content-Type: application/x-www-form-urlencoded' + CRLF;
implementation
{ THttpQuery }
constructor THttpQuery.Create;
begin
FParams := TStringList.Create;
end;
destructor THttpQuery.Destroy;
begin
FParams.Free;
inherited;
end;
class function THttpQuery.Encode(const Src: AnsiString): AnsiString;
var
i: Integer;
s: AnsiString;
begin
Result :='';
if Src='' then Exit;
for i := 1 to Length(Src) do
begin
case Src[i] of
'a'..'z','A'..'Z','0'..'9','=','&','_': Result := Result+Src[i];
else
begin
s := IntToHex(Ord(Src[i]),2);
Result := Result+'%'+s[1]+s[2];
end;
end;
end;
end;
procedure THttpQuery.ParamAdd(const Name, Value: AnsiString);
var
i: Integer;
begin
i := FParams.IndexOfName(Name);
if i=-1
then FParams.Add(Encode(Name+'='+Value))
else FParams[i] := Encode(Name+'='+Value);
end;
procedure THttpQuery.ParamClear;
begin
FParams.Clear;
end;
procedure THttpQuery.ParamDelete(const Name: AnsiString);
var
Num: Integer;
begin
Num := FParams.IndexOfName(Name);
if Num<>-1 then FParams.Delete(Num);
end;
function THttpQuery.ParamGet(const Name: AnsiString): AnsiString;
begin
Result := FParams.Values[Name];
end;
procedure THttpQuery.SetQuery(const Value: AnsiString);
var
Num: Integer;
TempString: AnsiString;
begin
Num := Pos('//',Value);
if Num=0 then raise Exception.Create('Query is invalid');
TempString := Copy(Value,Num+2,Length(Value)-Num-1);
Num := Pos('/',TempString);
if Num>0 then
begin
FHost := Copy(TempString,1,Num-1);
FScript := Copy(TempString,Num+1,Length(TempString)-Num);
end
else FHost := Trim(TempString);
FQuery := Value;
end;
function THttpQuery.Execquery(QueryType: TTypeQuery=tqGET): TPageResult;
var
FSession, FConnect, FRequest: HINTERNET;
SRequest: AnsiString;
FAccept: PAnsiChar;
Buff: array [0..102300] of Char;
BytesRead: Cardinal;
Index, Len: DWORD;
QType: AnsiString;
Parm: AnsiString;
i: Integer;
Cookie: AnsiString;
TmpScript: AnsiString;
UserAgent: AnsiString;
begin
UserAgent := 'Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.1; Trident/4.0; .NET CLR 1.1.4322; .NET CLR 2.0.50727; .NET CLR 3.0.04506.30; .NET CLR 3.0.04506.648; .NET CLR 3.0.4506.2152; .NET CLR 3.5.30729)';
Result.Error := -1;
Result.Page := '';
FPage := '';
FSession := nil;
FConnect := nil;
FRequest := nil;
if FParams.Count>0 then
begin
for i := 0 to FParams.Count-1 do
begin
if i=0
then Parm := Parm+FParams[i]
else Parm := Parm+'&'+FParams[i];
end;
end;
case QueryType of
tqPOST:
begin
QType := 'POST';
Parm := Parm+CrLf;
end;
else
begin
QType := 'GET';
TmpScript := FScript+'?'+Parm;
Parm :='';
end;
end;
try
if ProxyType=ptList
then FSession := InternetOpen(PAnsiChar(UserAgent), INTERNET_OPEN_TYPE_PROXY,
PChar(Proxy), nil, 0)
else if ProxyType=ptNone then
FSession := InternetOpen(PAnsiChar(UserAgent), INTERNET_OPEN_TYPE_DIRECT,
nil, nil, 0)
else
FSession := InternetOpen(PAnsiChar(UserAgent), INTERNET_OPEN_TYPE_PRECONFIG,
nil, nil, 0);
if FSession=nil then
begin
Result.Error := GetLastError;
Exit;
end;
FConnect := InternetConnect(FSession, PAnsiChar(FHost), HTTP_PORT, nil,
nil {'HTTP/1.0'}, INTERNET_SERVICE_HTTP, 0, 0);
if FConnect=nil then
begin
Result.Error := GetLastError;
Exit;
end;
FAccept := 'text/*';
FRequest := HttpOpenRequest(FConnect, PAnsiChar(QType), PAnsiChar(FScript), 'HTTP/1.1',
nil, @FAccept, INTERNET_FLAG_RELOAD, 0);
if FRequest=nil then
begin
Result.Error := GetLastError;
Exit;
end;
//Если подготовлены кукисы - добавляем в запрос
if FCookieSend<>''
then Cookie := Header+'Cookie: ' + FCookieSend + CRLF
else Cookie := Header;
if not (HttpAddRequestHeaders(FRequest, PAnsiChar(Cookie), Length(Cookie),
HTTP_ADDREQ_FLAG_REPLACE or
HTTP_ADDREQ_FLAG_ADD or
HTTP_ADDREQ_FLAG_COALESCE_WITH_COMMA)) then
begin
Result.Error := GetLastError;
Exit;
end;
if not (HttpSendRequest(FRequest, PAnsiChar(Cookie), Length(Cookie), PAnsiChar(Parm), Length(Parm))) then
begin
Result.Error := GetLastError;
Exit;
end;
//Получим кукисы из ответа
Len := 0;
Index := 0;
SRequest := ' ';
//После первого вызова вернётся ошибка (не хватает длины буфера) - игнорируем.
HttpQueryInfo(FRequest, HTTP_QUERY_RAW_HEADERS_CRLF or
HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], Len, Index);
if Len > 0 then
begin
SetLength(SRequest, Len);
if HttpQueryInfo(FRequest, HTTP_QUERY_RAW_HEADERS_CRLF or
HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], Len, Index) then
begin
i := Pos('Cookie:',SRequest);
if i>0 then
begin
FCookieReceived := SRequest;
Delete(FCookieReceived,1,i+7);
i := Pos(CrLf,FCookieReceived);
if i>0 then FCookieReceived := Copy(FCookieReceived,1,i-1);
end;
end;
end;
while InternetReadFile(FRequest, @Buff, SizeOf(Buff), BytesRead) do
begin
if BytesRead=0 then Break;
Buff[BytesRead] := #0;
FPage := FPage + Buff;
end;
Result.Page := FPage;
Result.Error := 0;
finally
InternetCloseHandle(FRequest);
InternetCloseHandle(FConnect);
InternetCloseHandle(FSession);
end;
end;
procedure THttpQuery.ParamsAdd(Params: TParams);
var
i: Integer;
begin
for i := 0 to High(Params) do ParamAdd(Params[i].Name,Params[i].Value);
end;
end.
|
|
Подмена COOKIES, компонент, позволяющий подменять COOKIES 
Загрузка ...
