unit GetHttpInfo;

interface

uses Classes, WinINet, Sysutils, windows, IDURI, IdSSLOpenSSL

  , IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,

  IdHTTP;

procedure Get(url: string; res: TStream); overload;

procedure Post(url, data: string; res: TStream); overload;

function Get(url: string): string; overload;

function WebPagePost(sURL, sPostData: string): Pointer; stdcall;

function WinPost(url, data: string):string;

implementation

function Get(url: string): string;

var

  s: TStringStream;

begin

  s := TStringStream.Create('');

  try

    Get(url, s);

    result := UTF8ToAnsi(s.DataString);

  finally

    s.Free;

  end;

end;

procedure Post(url, data: string; res: TStream);

var

  hInt, hConn, hreq: HINTERNET;

  buffer: PChar;

  dwRead, dwFlags: cardinal;

  port: Word;

  uri: TIdURI;

  proto, host, path, Params: string;

begin

  uri := TIdURI.Create(url);

  host := uri.Host;

  path := uri.Path + uri.Document;

  proto := uri.Protocol;

  Params := uri.Params;

  uri.Free;

  if UpperCase(proto) = 'HTTPS' then

  begin

    port := INTERNET_DEFAULT_HTTPS_PORT;

    dwFlags := INTERNET_FLAG_SECURE or INTERNET_FLAG_RELOAD;

  end

  else

  begin

    port := INTERNET_INVALID_PORT_NUMBER;

    dwFlags := INTERNET_FLAG_RELOAD;

  end;

  hInt := InternetOpen('Delphi', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, );

  hConn := InternetConnect(hInt, PChar(host), port, nil, nil, INTERNET_SERVICE_HTTP, , );

  hreq := HttpOpenRequest(hConn, 'POST', PChar(Path + Params), 'HTTP/1.1', nil, nil, dwFlags, );

  GetMem(buffer, );

  data := AnsiToUTF8(data);

  //if HttpSendRequestEx(hReq, nil, 0, PChar(data), Length(data) then

  //if HttpSendRequestA(hReq, nil, 0, PChar(data), Length(data)) then

  if HttpSendRequest(hReq, nil, , PChar(data), Length(data)) then

  begin

    dwRead := ;

    repeat

      InternetReadFile(hreq, buffer, , dwRead);

      if dwRead <>  then

        res.Write(buffer^, dwRead);

    until dwRead = ;

  end;

  InternetCloseHandle(hreq);

  InternetCloseHandle(hConn);

  InternetCloseHandle(hInt);

  FreeMem(buffer);

end;

procedure Get(url: string; res: TStream);

var

  hInt, hUrl: HINTERNET;

  buffer: PChar;

  dwRead: cardinal;

begin

  GetMem(buffer, );

  hInt := InternetOpen('Delphi', INTERNET_OPEN_TYPE_DIRECT, nil, nil, );

  dwRead := ;

  hurl := InternetOpenUrl(hInt, PChar(url), nil, , INTERNET_FLAG_RELOAD, );

  repeat

    InternetReadFile(hUrl, buffer, , dwRead);

    if dwRead <>  then

      res.Write(buffer^, dwRead);

  until dwRead = ;

  InternetCloseHandle(hUrl);

  InternetCloseHandle(hInt);

  FreeMem(buffer);

end;

function WebPagePost(sURL, sPostData: string): Pointer; stdcall;

const

  RequestMethod = 'POST';

  HTTP_VERSION = 'HTTP/1.1'; //HTTP版本 我抓包看过 HTTP/1.0 HTTP/1.1。尚未仔细了解其区别。按MSDN来写的。留空默认是1.0

var

  dwSize: DWORD;

  dwFileSize: Int64;

  dwBytesRead, dwReserved: DWORD;

  hInte, hConnection, hRequest: HInternet;

  ContentSize: array[..] of Char;

  HostPort: Integer;

  HostName, FileName, sHeader: string;

  procedure ParseURL(URL: string; var HostName, FileName: string; var HostPort: Integer);

  var

    i, p, k: DWORD;

    function StrToIntDef(const S: string; Default: Integer): Integer;

    var

      E: Integer;

    begin

      Val(S, Result, E);

      if E <>  then Result := Default;

    end;

  begin

    if lstrcmpi('http://', PChar(Copy(URL, , ))) =  then System.Delete(URL, , );

    HostName := URL;

    FileName := '/';

    HostPort := INTERNET_DEFAULT_HTTP_PORT;

    i := Pos('/', URL);

    if i <>  then

    begin

      HostName := Copy(URL, , i - );

      FileName := Copy(URL, i, Length(URL) - i + );

    end;

    p := pos(':', HostName);

    if p <>  then

    begin

      k := Length(HostName) - p;

      HostPort := StrToIntDef(Copy(HostName, p + , k), INTERNET_DEFAULT_HTTP_PORT);

      Delete(HostName, p, k + );

    end;

  end;

begin

  Result := Pointer(-);

  dwFileSize := ;

  ParseURL(sURL, HostName, FileName, HostPort);

  // 函数原型见 http://technet.microsoft.com/zh-cn/subscriptions/aa385096(v=vs.85).aspx

  hInte := InternetOpen('', //UserAgent

    INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, );

  if hInte <> nil then

  begin

    hConnection := InternetConnect(hInte, // 函数原型见 http://technet.microsoft.com/zh-cn/query/ms909418

      PChar(HostName),

      HostPort,

      nil,

      nil,

      INTERNET_SERVICE_HTTP,

      ,

      );

    if hConnection <> nil then

    begin

      hRequest := HttpOpenRequest(hConnection, // 函数原型见 http://msdn.microsoft.com/zh-cn/library/aa917871

        PChar(RequestMethod),

        PChar(FileName),

        HTTP_VERSION,

        '', //Referrer 来路

        nil, //AcceptTypes 接受的文件类型 TEXT/HTML */*

        INTERNET_FLAG_NO_CACHE_WRITE or

        INTERNET_FLAG_RELOAD,

        );

      if hRequest <> nil then

      begin

        sHeader := 'Content-Type: application/x-www-form-urlencoded' + ##;

    //    +'CLIENT-IP: 216.13.23.33'+#13#10

    //    'X-FORWARDED-FOR: 216.13.23.33' + #13#10+; 伪造代理IP

        // 函数原型见 http://msdn.microsoft.com/zh-cn/library/aa384227(v=VS.85)

        HttpAddRequestHeaders(hRequest, PChar(sHeader),

          Length(sHeader),

          HTTP_ADDREQ_FLAG_ADD or HTTP_ADDREQ_FLAG_REPLACE);

        // 函数原型见 http://msdn.microsoft.com/zh-cn/library/windows/desktop/aa384247(v=vs.85).aspx

        if HttpSendRequest(hRequest, nil, , PChar(sPostData), Length(sPostData)) then

        begin

          dwReserved := ;

          dwSize := SizeOf(ContentSize);

          // 函数原型 http://msdn.microsoft.com/zh-cn/subscriptions/downloads/aa384238.aspx

          if HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH, @ContentSize, dwSize, dwReserved) then

          begin

            dwFileSize := StrToInt(StrPas(@ContentSize));

            GetMem(Result, dwFileSize);

            InternetReadFile(hRequest, Result, dwFileSize, dwBytesRead);

          end;

        end;

      end;

      InternetCloseHandle(hRequest);

    end;

    InternetCloseHandle(hConnection);

  end;

  InternetCloseHandle(hInte);

end;

function WinPost(url, data:string):string;

var

  IdHttp : TIdHTTP;

  ResponseStream : TStringStream; //返回信息

  ResponseStr : string;

  idSSL : TIdSSLIOHandlerSocket;

  RequestList : TStringList;     //请求信息

  RequestStream : TStringStream;

begin

  //创建IDHTTP控件

  IdHttp := TIdHTTP.Create(nil);

  idSSL  := TIdSSLIOHandlerSocket.Create(nil);

  //TStringStream对象用于保存响应信息

  //res := TStringStream.Create('');

  ResponseStream := TStringStream.Create('');

  RequestStream := TStringStream.Create('');

  RequestList := TStringList.Create;

  try

    try

      idSSL.SSLOptions.Method:= sslvSSLv3;

      IdHttp.IOHandler:= idSSL;

      //以列表的方式提交参数

      //RequestList.Add('text=love');

      //IdHttp.Post(Url,RequestList,res);

       IdHttp.Request.ContentType :='application/json';

      //以流的方式提交参数

      RequestStream.WriteString(data);

      IdHttp.Post(Url,RequestStream,ResponseStream);

    except

    end;

    //获取网页返回的信息

    ResponseStr := ResponseStream.DataString;

    result:= ResponseStr;

    //网页中的存在中文时，需要进行UTF8解码

//    ResponseStr := UTF8Decode(ResponseStr);

  finally

    IdHttp.Free;

    RequestList.Free;

    RequestStream.Free;

  end;

end;

end.