delphi 模拟POST提交数据

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, 0);
  hConn := InternetConnect(hInt, PChar(host), port, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);
  hreq := HttpOpenRequest(hConn, 'POST', PChar(Path + Params), 'HTTP/1.1', nil, nil, dwFlags, 0);
  GetMem(buffer, 65535);
  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, 0, PChar(data), Length(data)) then
  begin
    dwRead := 0;
    repeat
      InternetReadFile(hreq, buffer, 65536, dwRead);
      if dwRead <> 0 then
        res.Write(buffer^, dwRead);
    until dwRead = 0;
  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, 65536);

  hInt := InternetOpen('Delphi', INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
  dwRead := 0;
  hurl := InternetOpenUrl(hInt, PChar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);
  repeat
    InternetReadFile(hUrl, buffer, 1000, dwRead);
    if dwRead <> 0 then
      res.Write(buffer^, dwRead);
  until dwRead = 0;
  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[1..1024] 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 <> 0 then Result := Default;
    end;
  begin
    if lstrcmpi('http://', PChar(Copy(URL, 1, 7))) = 0 then System.Delete(URL, 1, 7);
    HostName := URL;
    FileName := '/';
    HostPort := INTERNET_DEFAULT_HTTP_PORT;
    i := Pos('/', URL);
    if i <> 0 then
    begin
      HostName := Copy(URL, 1, i - 1);
      FileName := Copy(URL, i, Length(URL) - i + 1);
    end;
    p := pos(':', HostName);
    if p <> 0 then
    begin
      k := Length(HostName) - p;
      HostPort := StrToIntDef(Copy(HostName, p + 1, k), INTERNET_DEFAULT_HTTP_PORT);
      Delete(HostName, p, k + 1);
    end;
  end;
begin
  Result := Pointer(-1);
  dwFileSize := 0;
  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, 0);
  if hInte <> nil then
  begin
    hConnection := InternetConnect(hInte, // 函数原型见 http://technet.microsoft.com/zh-cn/query/ms909418
      PChar(HostName),
      HostPort,
      nil,
      nil,
      INTERNET_SERVICE_HTTP,
      0,
      0);
    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,
        0);
      if hRequest <> nil then
      begin
        sHeader := 'Content-Type: application/x-www-form-urlencoded' + #13#10;
    //    +'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, 0, PChar(sPostData), Length(sPostData)) then
        begin
          dwReserved := 0;
          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.

使用WinPost提交数据在xp下没有问题,Post方法在win7以上没有问题.

WinPost只支持https提交,其它方法支持https和http

使用WinPost方法需要使用dll文件libeay32.dll、ssleay32.dll两个文件