cnblogs/dcrenl/delphi 模拟POST提交数据.html

<div class="cnblogs_code">
<pre><span style="color: #0000ff;">unit</span><span style="color: #000000;"> GetHttpInfo;

</span><span style="color: #0000ff;">interface</span>

<span style="color: #0000ff;">uses</span><span style="color: #000000;"> Classes, WinINet, Sysutils, windows, IDURI, IdSSLOpenSSL
  , IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP;

</span><span style="color: #0000ff;">procedure</span> Get(url: <span style="color: #0000ff;">string</span>; res: TStream); <span style="color: #0000ff;">overload</span><span style="color: #000000;">;
</span><span style="color: #0000ff;">procedure</span> Post(url, data: <span style="color: #0000ff;">string</span>; res: TStream); <span style="color: #0000ff;">overload</span><span style="color: #000000;">;
</span><span style="color: #0000ff;">function</span> Get(url: <span style="color: #0000ff;">string</span>): <span style="color: #0000ff;">string</span>; <span style="color: #0000ff;">overload</span><span style="color: #000000;">;
</span><span style="color: #0000ff;">function</span> WebPagePost(sURL, sPostData: <span style="color: #0000ff;">string</span>): Pointer; <span style="color: #0000ff;">stdcall</span><span style="color: #000000;">;
</span><span style="color: #0000ff;">function</span> WinPost(url, data: <span style="color: #0000ff;">string</span>):<span style="color: #0000ff;">string</span><span style="color: #000000;">;

</span><span style="color: #0000ff;">implementation</span>

<span style="color: #0000ff;">function</span> Get(url: <span style="color: #0000ff;">string</span>): <span style="color: #0000ff;">string</span><span style="color: #000000;">;
</span><span style="color: #0000ff;">var</span><span style="color: #000000;">
  s: TStringStream;
</span><span style="color: #0000ff;">begin</span><span style="color: #000000;">
  s :</span>= TStringStream.<span style="color: #0000ff;">Create</span>(<span style="color: #800000;">''</span><span style="color: #000000;">);
  </span><span style="color: #0000ff;">try</span><span style="color: #000000;">
    Get(url, s);

    result :</span>=<span style="color: #000000;"> UTF8ToAnsi(s.DataString);
  </span><span style="color: #0000ff;">finally</span><span style="color: #000000;">
    s.Free;
  </span><span style="color: #0000ff;">end</span><span style="color: #000000;">;
</span><span style="color: #0000ff;">end</span><span style="color: #000000;">;

</span><span style="color: #0000ff;">procedure</span> Post(url, data: <span style="color: #0000ff;">string</span><span style="color: #000000;">; res: TStream);
</span><span style="color: #0000ff;">var</span><span style="color: #000000;">
  hInt, hConn, hreq: HINTERNET;
  buffer: PChar;
  dwRead, dwFlags: cardinal;
  port: Word;
  uri: TIdURI;
  proto, host, path, Params: </span><span style="color: #0000ff;">string</span><span style="color: #000000;">;
</span><span style="color: #0000ff;">begin</span><span style="color: #000000;">
  uri :</span>= TIdURI.<span style="color: #0000ff;">Create</span><span style="color: #000000;">(url);
  host :</span>=<span style="color: #000000;"> uri.Host;
  path :</span>= uri.Path +<span style="color: #000000;"> uri.Document;
  proto :</span>=<span style="color: #000000;"> uri.Protocol;
  Params :</span>=<span style="color: #000000;"> uri.Params;
  uri.Free;
  </span><span style="color: #0000ff;">if</span> UpperCase(proto) = <span style="color: #800000;">'</span><span style="color: #800000;">HTTPS</span><span style="color: #800000;">'</span> <span style="color: #0000ff;">then</span>
  <span style="color: #0000ff;">begin</span><span style="color: #000000;">
    port :</span>=<span style="color: #000000;"> INTERNET_DEFAULT_HTTPS_PORT;
    dwFlags :</span>= INTERNET_FLAG_SECURE <span style="color: #0000ff;">or</span><span style="color: #000000;"> INTERNET_FLAG_RELOAD;
  </span><span style="color: #0000ff;">end</span>
  <span style="color: #0000ff;">else</span>
  <span style="color: #0000ff;">begin</span><span style="color: #000000;">
    port :</span>=<span style="color: #000000;"> INTERNET_INVALID_PORT_NUMBER;
    dwFlags :</span>=<span style="color: #000000;"> INTERNET_FLAG_RELOAD;
  </span><span style="color: #0000ff;">end</span><span style="color: #000000;">;
  hInt :</span>= InternetOpen(<span style="color: #800000;">'</span><span style="color: #800000;">Delphi</span><span style="color: #800000;">'</span>, INTERNET_OPEN_TYPE_PRECONFIG, <span style="color: #0000ff;">nil</span>, <span style="color: #0000ff;">nil</span>, <span style="color: #800080;">0</span><span style="color: #000000;">);
  hConn :</span>= InternetConnect(hInt, PChar(host), port, <span style="color: #0000ff;">nil</span>, <span style="color: #0000ff;">nil</span>, INTERNET_SERVICE_HTTP, <span style="color: #800080;">0</span>, <span style="color: #800080;">0</span><span style="color: #000000;">);
  hreq :</span>= HttpOpenRequest(hConn, <span style="color: #800000;">'</span><span style="color: #800000;">POST</span><span style="color: #800000;">'</span>, PChar(Path + Params), <span style="color: #800000;">'</span><span style="color: #800000;">HTTP/1.1</span><span style="color: #800000;">'</span>, <span style="color: #0000ff;">nil</span>, <span style="color: #0000ff;">nil</span>, dwFlags, <span style="color: #800080;">0</span><span style="color: #000000;">);
  GetMem(buffer, </span><span style="color: #800080;">65535</span><span style="color: #000000;">);
  data :</span>=<span style="color: #000000;"> AnsiToUTF8(data);
  </span><span style="color: #008000;">//</span><span style="color: #008000;">if HttpSendRequestEx(hReq, nil, 0, PChar(data), Length(data) then</span>
  <span style="color: #008000;">//</span><span style="color: #008000;">if HttpSendRequestA(hReq, nil, 0, PChar(data), Length(data)) then</span>
  <span style="color: #0000ff;">if</span> HttpSendRequest(hReq, <span style="color: #0000ff;">nil</span>, <span style="color: #800080;">0</span>, PChar(data), Length(data)) <span style="color: #0000ff;">then</span>
  <span style="color: #0000ff;">begin</span><span style="color: #000000;">
    dwRead :</span>= <span style="color: #800080;">0</span><span style="color: #000000;">;
    </span><span style="color: #0000ff;">repeat</span><span style="color: #000000;">
      InternetReadFile(hreq, buffer, </span><span style="color: #800080;">65536</span><span style="color: #000000;">, dwRead);
      </span><span style="color: #0000ff;">if</span> dwRead &lt;&gt; <span style="color: #800080;">0</span> <span style="color: #0000ff;">then</span><span style="color: #000000;">
        res.Write(buffer^, dwRead);
    </span><span style="color: #0000ff;">until</span> dwRead = <span style="color: #800080;">0</span><span style="color: #000000;">;
  </span><span style="color: #0000ff;">end</span><span style="color: #000000;">;
  InternetCloseHandle(hreq);
  InternetCloseHandle(hConn);
  InternetCloseHandle(hInt);
  FreeMem(buffer);
</span><span style="color: #0000ff;">end</span><span style="color: #000000;">;


</span><span style="color: #0000ff;">procedure</span> Get(url: <span style="color: #0000ff;">string</span><span style="color: #000000;">; res: TStream);
</span><span style="color: #0000ff;">var</span><span style="color: #000000;">
  hInt, hUrl: HINTERNET;
  buffer: PChar;
  dwRead: cardinal;
</span><span style="color: #0000ff;">begin</span><span style="color: #000000;">
  GetMem(buffer, </span><span style="color: #800080;">65536</span><span style="color: #000000;">);

  hInt :</span>= InternetOpen(<span style="color: #800000;">'</span><span style="color: #800000;">Delphi</span><span style="color: #800000;">'</span>, INTERNET_OPEN_TYPE_DIRECT, <span style="color: #0000ff;">nil</span>, <span style="color: #0000ff;">nil</span>, <span style="color: #800080;">0</span><span style="color: #000000;">);
  dwRead :</span>= <span style="color: #800080;">0</span><span style="color: #000000;">;
  hurl :</span>= InternetOpenUrl(hInt, PChar(url), <span style="color: #0000ff;">nil</span>, <span style="color: #800080;">0</span>, INTERNET_FLAG_RELOAD, <span style="color: #800080;">0</span><span style="color: #000000;">);
  </span><span style="color: #0000ff;">repeat</span><span style="color: #000000;">
    InternetReadFile(hUrl, buffer, </span><span style="color: #800080;">1000</span><span style="color: #000000;">, dwRead);
    </span><span style="color: #0000ff;">if</span> dwRead &lt;&gt; <span style="color: #800080;">0</span> <span style="color: #0000ff;">then</span><span style="color: #000000;">
      res.Write(buffer^, dwRead);
  </span><span style="color: #0000ff;">until</span> dwRead = <span style="color: #800080;">0</span><span style="color: #000000;">;
  InternetCloseHandle(hUrl);
  InternetCloseHandle(hInt);
  FreeMem(buffer);
</span><span style="color: #0000ff;">end</span><span style="color: #000000;">;





</span><span style="color: #0000ff;">function</span> WebPagePost(sURL, sPostData: <span style="color: #0000ff;">string</span>): Pointer; <span style="color: #0000ff;">stdcall</span><span style="color: #000000;">;
</span><span style="color: #0000ff;">const</span><span style="color: #000000;">
  RequestMethod </span>= <span style="color: #800000;">'</span><span style="color: #800000;">POST</span><span style="color: #800000;">'</span><span style="color: #000000;">;
  HTTP_VERSION </span>= <span style="color: #800000;">'</span><span style="color: #800000;">HTTP/1.1</span><span style="color: #800000;">'</span>; <span style="color: #008000;">//</span><span style="color: #008000;">HTTP版本 我抓包看过 HTTP/1.0 HTTP/1.1。尚未仔细了解其区别。按MSDN来写的。留空默认是1.0</span>
<span style="color: #0000ff;">var</span><span style="color: #000000;">
  dwSize: DWORD;
  dwFileSize: Int64;
  dwBytesRead, dwReserved: DWORD;
  hInte, hConnection, hRequest: HInternet;
  ContentSize: </span><span style="color: #0000ff;">array</span>[<span style="color: #800080;">1</span>..<span style="color: #800080;">1024</span>] <span style="color: #0000ff;">of</span><span style="color: #000000;"> Char;
  HostPort: Integer;
  HostName, FileName, sHeader: </span><span style="color: #0000ff;">string</span><span style="color: #000000;">;
  </span><span style="color: #0000ff;">procedure</span> ParseURL(URL: <span style="color: #0000ff;">string</span>; <span style="color: #0000ff;">var</span> HostName, FileName: <span style="color: #0000ff;">string</span>; <span style="color: #0000ff;">var</span><span style="color: #000000;"> HostPort: Integer);
  </span><span style="color: #0000ff;">var</span><span style="color: #000000;">
    i, p, k: DWORD;
    </span><span style="color: #0000ff;">function</span> StrToIntDef(<span style="color: #0000ff;">const</span> S: <span style="color: #0000ff;">string</span><span style="color: #000000;">; Default: Integer): Integer;
    </span><span style="color: #0000ff;">var</span><span style="color: #000000;">
      E: Integer;
    </span><span style="color: #0000ff;">begin</span><span style="color: #000000;">
      Val(S, Result, E);
      </span><span style="color: #0000ff;">if</span> E &lt;&gt; <span style="color: #800080;">0</span> <span style="color: #0000ff;">then</span> Result :=<span style="color: #000000;"> Default;
    </span><span style="color: #0000ff;">end</span><span style="color: #000000;">;
  </span><span style="color: #0000ff;">begin</span>
    <span style="color: #0000ff;">if</span> lstrcmpi(<span style="color: #800000;">'</span><span style="color: #800000;">http://</span><span style="color: #800000;">'</span>, PChar(Copy(URL, <span style="color: #800080;">1</span>, <span style="color: #800080;">7</span>))) = <span style="color: #800080;">0</span> <span style="color: #0000ff;">then</span> System.Delete(URL, <span style="color: #800080;">1</span>, <span style="color: #800080;">7</span><span style="color: #000000;">);
    HostName :</span>=<span style="color: #000000;"> URL;
    FileName :</span>= <span style="color: #800000;">'</span><span style="color: #800000;">/</span><span style="color: #800000;">'</span><span style="color: #000000;">;
    HostPort :</span>=<span style="color: #000000;"> INTERNET_DEFAULT_HTTP_PORT;
    i :</span>= Pos(<span style="color: #800000;">'</span><span style="color: #800000;">/</span><span style="color: #800000;">'</span><span style="color: #000000;">, URL);
    </span><span style="color: #0000ff;">if</span> i &lt;&gt; <span style="color: #800080;">0</span> <span style="color: #0000ff;">then</span>
    <span style="color: #0000ff;">begin</span><span style="color: #000000;">
      HostName :</span>= Copy(URL, <span style="color: #800080;">1</span>, i - <span style="color: #800080;">1</span><span style="color: #000000;">);
      FileName :</span>= Copy(URL, i, Length(URL) - i + <span style="color: #800080;">1</span><span style="color: #000000;">);
    </span><span style="color: #0000ff;">end</span><span style="color: #000000;">;
    p :</span>= pos(<span style="color: #800000;">'</span><span style="color: #800000;">:</span><span style="color: #800000;">'</span><span style="color: #000000;">, HostName);
    </span><span style="color: #0000ff;">if</span> p &lt;&gt; <span style="color: #800080;">0</span> <span style="color: #0000ff;">then</span>
    <span style="color: #0000ff;">begin</span><span style="color: #000000;">
      k :</span>= Length(HostName) -<span style="color: #000000;"> p;
      HostPort :</span>= StrToIntDef(Copy(HostName, p + <span style="color: #800080;">1</span><span style="color: #000000;">, k), INTERNET_DEFAULT_HTTP_PORT);
      Delete(HostName, p, k </span>+ <span style="color: #800080;">1</span><span style="color: #000000;">);
    </span><span style="color: #0000ff;">end</span><span style="color: #000000;">;
  </span><span style="color: #0000ff;">end</span><span style="color: #000000;">;
</span><span style="color: #0000ff;">begin</span><span style="color: #000000;">
  Result :</span>= Pointer(-<span style="color: #800080;">1</span><span style="color: #000000;">);
  dwFileSize :</span>= <span style="color: #800080;">0</span><span style="color: #000000;">;
  ParseURL(sURL, HostName, FileName, HostPort);
  </span><span style="color: #008000;">//</span><span style="color: #008000;"> 函数原型见 http://technet.microsoft.com/zh-cn/subscriptions/aa385096(v=vs.85).aspx</span>
  hInte := InternetOpen(<span style="color: #800000;">''</span>, <span style="color: #008000;">//</span><span style="color: #008000;">UserAgent</span>
    INTERNET_OPEN_TYPE_PRECONFIG, <span style="color: #0000ff;">nil</span>, <span style="color: #0000ff;">nil</span>, <span style="color: #800080;">0</span><span style="color: #000000;">);
  </span><span style="color: #0000ff;">if</span> hInte &lt;&gt; <span style="color: #0000ff;">nil</span> <span style="color: #0000ff;">then</span>
  <span style="color: #0000ff;">begin</span><span style="color: #000000;">
    hConnection :</span>= InternetConnect(hInte, <span style="color: #008000;">//</span><span style="color: #008000;"> 函数原型见 http://technet.microsoft.com/zh-cn/query/ms909418</span>
<span style="color: #000000;">      PChar(HostName),
      HostPort,
      </span><span style="color: #0000ff;">nil</span><span style="color: #000000;">,
      </span><span style="color: #0000ff;">nil</span><span style="color: #000000;">,
      INTERNET_SERVICE_HTTP,
      </span><span style="color: #800080;">0</span><span style="color: #000000;">,
      </span><span style="color: #800080;">0</span><span style="color: #000000;">);
    </span><span style="color: #0000ff;">if</span> hConnection &lt;&gt; <span style="color: #0000ff;">nil</span> <span style="color: #0000ff;">then</span>
    <span style="color: #0000ff;">begin</span><span style="color: #000000;">
      hRequest :</span>= HttpOpenRequest(hConnection, <span style="color: #008000;">//</span><span style="color: #008000;"> 函数原型见 http://msdn.microsoft.com/zh-cn/library/aa917871</span>
<span style="color: #000000;">        PChar(RequestMethod),
        PChar(FileName),
        HTTP_VERSION,
        </span><span style="color: #800000;">''</span>, <span style="color: #008000;">//</span><span style="color: #008000;">Referrer 来路</span>
        <span style="color: #0000ff;">nil</span>, <span style="color: #008000;">//</span><span style="color: #008000;">AcceptTypes 接受的文件类型 TEXT/HTML */*</span>
        INTERNET_FLAG_NO_CACHE_WRITE <span style="color: #0000ff;">or</span><span style="color: #000000;">
        INTERNET_FLAG_RELOAD,
        </span><span style="color: #800080;">0</span><span style="color: #000000;">);
      </span><span style="color: #0000ff;">if</span> hRequest &lt;&gt; <span style="color: #0000ff;">nil</span> <span style="color: #0000ff;">then</span>
      <span style="color: #0000ff;">begin</span><span style="color: #000000;">
        sHeader :</span>= <span style="color: #800000;">'</span><span style="color: #800000;">Content-Type: application/x-www-form-urlencoded</span><span style="color: #800000;">'</span> + #<span style="color: #800080;">13</span>#<span style="color: #800080;">10</span><span style="color: #000000;">;
    </span><span style="color: #008000;">//</span><span style="color: #008000;">    +'CLIENT-IP: 216.13.23.33'+#13#10</span>
    <span style="color: #008000;">//</span><span style="color: #008000;">    'X-FORWARDED-FOR: 216.13.23.33' + #13#10+; 伪造代理IP</span>

        <span style="color: #008000;">//</span><span style="color: #008000;"> 函数原型见 http://msdn.microsoft.com/zh-cn/library/aa384227(v=VS.85)</span>
<span style="color: #000000;">        HttpAddRequestHeaders(hRequest, PChar(sHeader),
          Length(sHeader),
          HTTP_ADDREQ_FLAG_ADD </span><span style="color: #0000ff;">or</span><span style="color: #000000;"> HTTP_ADDREQ_FLAG_REPLACE);
        </span><span style="color: #008000;">//</span><span style="color: #008000;"> 函数原型见 http://msdn.microsoft.com/zh-cn/library/windows/desktop/aa384247(v=vs.85).aspx</span>
        <span style="color: #0000ff;">if</span> HttpSendRequest(hRequest, <span style="color: #0000ff;">nil</span>, <span style="color: #800080;">0</span>, PChar(sPostData), Length(sPostData)) <span style="color: #0000ff;">then</span>
        <span style="color: #0000ff;">begin</span><span style="color: #000000;">
          dwReserved :</span>= <span style="color: #800080;">0</span><span style="color: #000000;">;
          dwSize :</span>=<span style="color: #000000;"> SizeOf(ContentSize);
          </span><span style="color: #008000;">//</span><span style="color: #008000;"> 函数原型 http://msdn.microsoft.com/zh-cn/subscriptions/downloads/aa384238.aspx</span>
          <span style="color: #0000ff;">if</span> HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH, @ContentSize, dwSize, dwReserved) <span style="color: #0000ff;">then</span>
          <span style="color: #0000ff;">begin</span><span style="color: #000000;">
            dwFileSize :</span>=<span style="color: #000000;"> StrToInt(StrPas(@ContentSize));
            GetMem(Result, dwFileSize);
            InternetReadFile(hRequest, Result, dwFileSize, dwBytesRead);
          </span><span style="color: #0000ff;">end</span><span style="color: #000000;">;
        </span><span style="color: #0000ff;">end</span><span style="color: #000000;">;
      </span><span style="color: #0000ff;">end</span><span style="color: #000000;">;
      InternetCloseHandle(hRequest);
    </span><span style="color: #0000ff;">end</span><span style="color: #000000;">;
    InternetCloseHandle(hConnection);
  </span><span style="color: #0000ff;">end</span><span style="color: #000000;">;
  InternetCloseHandle(hInte);
</span><span style="color: #0000ff;">end</span><span style="color: #000000;">;

</span><span style="color: #0000ff;">function</span> WinPost(url, data:<span style="color: #0000ff;">string</span>):<span style="color: #0000ff;">string</span><span style="color: #000000;">;
</span><span style="color: #0000ff;">var</span><span style="color: #000000;">
  IdHttp : TIdHTTP;
  ResponseStream : TStringStream; </span><span style="color: #008000;">//</span><span style="color: #008000;">返回信息</span>
  ResponseStr : <span style="color: #0000ff;">string</span><span style="color: #000000;">;
  idSSL : TIdSSLIOHandlerSocket;
  RequestList : TStringList;     </span><span style="color: #008000;">//</span><span style="color: #008000;">请求信息</span>
<span style="color: #000000;">  RequestStream : TStringStream;
</span><span style="color: #0000ff;">begin</span>
  <span style="color: #008000;">//</span><span style="color: #008000;">创建IDHTTP控件</span>
  IdHttp := TIdHTTP.<span style="color: #0000ff;">Create</span>(<span style="color: #0000ff;">nil</span><span style="color: #000000;">);
  idSSL  :</span>= TIdSSLIOHandlerSocket.<span style="color: #0000ff;">Create</span>(<span style="color: #0000ff;">nil</span><span style="color: #000000;">);
  </span><span style="color: #008000;">//</span><span style="color: #008000;">TStringStream对象用于保存响应信息</span>
  <span style="color: #008000;">//</span><span style="color: #008000;">res := TStringStream.Create('');</span>
  ResponseStream := TStringStream.<span style="color: #0000ff;">Create</span>(<span style="color: #800000;">''</span><span style="color: #000000;">);
  RequestStream :</span>= TStringStream.<span style="color: #0000ff;">Create</span>(<span style="color: #800000;">''</span><span style="color: #000000;">);
  RequestList :</span>= TStringList.<span style="color: #0000ff;">Create</span><span style="color: #000000;">;
  </span><span style="color: #0000ff;">try</span>
    <span style="color: #0000ff;">try</span><span style="color: #000000;">
      idSSL.SSLOptions.Method:</span>=<span style="color: #000000;"> sslvSSLv3;
      IdHttp.IOHandler:</span>=<span style="color: #000000;"> idSSL;
      </span><span style="color: #008000;">//</span><span style="color: #008000;">以列表的方式提交参数</span>
      <span style="color: #008000;">//</span><span style="color: #008000;">RequestList.Add('text=love');</span>
      <span style="color: #008000;">//</span><span style="color: #008000;">IdHttp.Post(Url,RequestList,res);</span>
       IdHttp.Request.ContentType :=<span style="color: #800000;">'</span><span style="color: #800000;">application/json</span><span style="color: #800000;">'</span><span style="color: #000000;">;
      </span><span style="color: #008000;">//</span><span style="color: #008000;">以流的方式提交参数</span>
<span style="color: #000000;">      RequestStream.WriteString(data);
      IdHttp.Post(Url,RequestStream,ResponseStream);
    </span><span style="color: #0000ff;">except</span>

    <span style="color: #0000ff;">end</span><span style="color: #000000;">;

    </span><span style="color: #008000;">//</span><span style="color: #008000;">获取网页返回的信息</span>
    ResponseStr :=<span style="color: #000000;"> ResponseStream.DataString;
    result:</span>=<span style="color: #000000;"> ResponseStr;
    </span><span style="color: #008000;">//</span><span style="color: #008000;">网页中的存在中文时，需要进行UTF8解码</span><span style="color: #008000;">
//</span><span style="color: #008000;">    ResponseStr := UTF8Decode(ResponseStr);</span>
  <span style="color: #0000ff;">finally</span><span style="color: #000000;">
    IdHttp.Free;
    RequestList.Free;
    RequestStream.Free;

  </span><span style="color: #0000ff;">end</span><span style="color: #000000;">;
</span><span style="color: #0000ff;">end</span><span style="color: #000000;">;


</span><span style="color: #0000ff;">end</span>.</pre>
</div>
<p>使用WinPost提交数据在xp下没有问题,Post方法在win7以上没有问题.</p>
<p>WinPost只支持https提交,其它方法支持https和http</p>
<p>使用WinPost方法需要使用dll文件libeay32.dll、ssleay32.dll两个文件</p>