Delphi 使用WinInet 进行get post

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, dxGDIPlusClasses;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}     //Windows7_64 + Delphi7 测试通过

uses
  WinInet;

const MAXBLOCKSIZE = 1024;

//代码改自: http://www.voidcn.com/article/p-ppalpuhd-bcn.html
function WinInetDownload(Url: PChar): TMemoryStream;
var
  hSession : HINTERNET;
  hOpenUrl : HINTERNET;
  Temp     : array [0..MAXBLOCKSIZE-1] of Byte;
  dwRead   : DWORD;
begin
  Result := nil;
  hSession := InternetOpen('RookIE/1.0', //指定调用 WinINet 函数的应用程序或入口。该入口用作HTTP协议中用户代理项。
                           INTERNET_OPEN_TYPE_PRECONFIG,//访问要求类型，该参数可为下列值之一：
                           {　　INTERNET_OPEN_TYPE_DIRECT 解析所有本地主机；
                            　　INTERNET_OPEN_TYPE_PRECONFIG 返回注册表中代理或直接的配置；
                            　　INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY 返回注册表中代理或直接的配置，并防止对Microsoft Jscript 或 INS文件的使用；
                            　　INTERNET_OPEN_TYPE_PROXY 为代理传递请求，除非代理提供了旁路列表且解析的名字可以绕过代理；此时，函数使用INTERNET_OPEN_TYPE_DIRECT。}
                           nil, //指定了当lAccessType类型为INTERNET_OPEN_TYPE_PROXY时，代理服务器的名字。
                           nil, //指向一个字符串，它指定一个可选的主机名列表或IP地址，列表可包括未知元素。
                           0);
                           {该参数可为下列值的任意组合：
                        　　INTERNET_FLAG_ASYNC 仅能用于作用在该函数返回的句柄的子句柄上的异步请求。
                        　　INTERNET_FLAG_FROM_CACHE 不做网络请求。所有的实体都由缓存返回。如果请求条目不在缓存中，一个适当的错误将返回。
                        　　INTERNET_FLAG_OFFLINE 与 INTERNET_FLAG_FROM_CACHE 一样。}
  //成功：返回一个有效的句柄，该句柄将由应用程序传递给接下来的WinINet函数。
  //失败：返回NULL。

  if hSession = nil then Exit;

  //通过一个完整的FTP，Gopher或HTTP网址打开一个资源。
  hOpenUrl := InternetOpenUrl(hSession, //当前的 Internet 会话句柄。句柄必须由前期的 InternetOpen 调用返回。
                             Url,      //一个空字符结束的字符串变量的指针，指定读取的网址。只有以ftp:, gopher:, http:, 或者 https: 开头的网址被支持。
                             nil,      //一个空字符结束的字符串变量的指针，指定发送到HTTP服务器的头信息。欲了解更多信息，请参阅HttpSendRequest函数里lpszHeaders参数的说明。
                             0,        //额外的头的大小，以TCHAR为单位。如果这个参数是-1L并且lpszHeaders不是NULL，lpszHeaders被假设为零终止（ ASCIIZ ），而长度被自动计算。
                             0,
                             //INTERNET_FLAG_DONT_CACHE,   //不添加返回实体到缓存
                             {INTERNET_FLAG_EXISTING_CONNECT
                          　　如果使用相同的必须属性创建会话，会尝试利用现有的InternetConnect对象。这只对FTP操作非常有用，因为FTP是唯一在同一会话中执行多种操作的协议。WinINet API 为每个由InternetOpen产生的HINTERNET句柄缓冲一个单独链接句柄。InternetOpenUrl使用此标志的HTTP和FTP连接。
                          　　INTERNET_FLAG_HYPERLINK
                          　　当决定何时从网络重载时，如果服务器没有返回 Expires time 和 LastModified，那么强制重载。
                          　　INTERNET_FLAG_IGNORE_CERT_CN_INVALID
                          　　停用检查从服务器对必须的主机名称返回的SSL/PCT-based证书。 WinINet函数使用简单的比较匹配主机名称和通配符的规则检查证书。
                          　　INTERNET_FLAG_IGNORE_CERT_DATE_INVALID
                          　　停用检查的SSL/PCT-based的证书的适当的有效日期。
                          　　INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTP
                          　　禁用检测这中特殊的重定向。当使用此标志， WinINet 透明允许从HTTPS到HTTP URL的重定向。
                          　　INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTPS
                          　　禁用检测这中特殊的重定向。当使用此标志， WinINet 透明的允许的HTTP到HTTPS URL的重定向。
                          　　INTERNET_FLAG_KEEP_CONNECTION
                          　　如果可能的话，为连接使用保活语义。这个标志要求微软网络（ MSN ），NTLM和其他类型的身份验证。
                          　　INTERNET_FLAG_NEED_FILE
                          　　如果要创建的文件不能被缓存，创建临时文件。
                          　　INTERNET_FLAG_NO_AUTH
                          　　不试图自动验证。
                          　　INTERNET_FLAG_NO_AUTO_REDIRECT
                          　　不自动处理HttpSendRequest中的重定向。
                          　　INTERNET_FLAG_NO_CACHE_WRITE
                          　　不添加返回实体到缓存。
                          　　INTERNET_FLAG_NO_COOKIES
                          　　不会自动添加的Cookie头到请求，并且不自动添加返回的cookie到cookie数据库。
                          　　INTERNET_FLAG_NO_UI
                          　　禁用Cookie的对话框。
                          　　INTERNET_FLAG_PASSIVE
                          　　使用被动FTP语义。InternetOpenUrl为FTP的文件和目录使用此标志。
                          　　INTERNET_FLAG_PRAGMA_NOCACHE
                          　　即使代理中存在缓存副本，也强制要求由源服务器返回。
                          　　INTERNET_FLAG_RAW_DATA
                          　　检索的Gopher目录信息时，传回的数据作为GOPHER_FIND_DATA结构，如果检索的FTP目录信息时，作为一个WIN32_FIND_DATA结构。如果此标志没有指定，或者请求通过CERN代理创建， InternetOpenUrl返回的HTML版本的目录。
                          　　INTERNET_FLAG_RELOAD
                          　　从原服务器强制下载所要求的文件，对象，或目录列表，而不是从缓存下载。
                          　　INTERNET_FLAG_RESYNCHRONIZE
                          　　重新加载的HTTP资源，如果资源在最后一次下载后已被修改。所有FTP和Gopher资源将被重载。
                          　　INTERNET_FLAG_SECURE
                          　　使用安全传输语义。这次传输使用安全套字节层/专用通信技术（的SSL / PCT ），这只有在HTTP请求时有意义。
                              }
                             0);
//　返回值
//　如果已成功建立到FTP，Gopher，或HTTP URL的连接，返回一个有效的句柄，如果连接失败返回NULL。要检索特定的错误讯息，请GetLastError 。要确定为什么对服务器的访问被拒绝，请调用InternetGetLastResponseInfo。
  if hOpenUrl = nil then
    Exit;
  try
    Result := TMemoryStream.Create;
    dwRead := 1;
    while (dwRead > 0) do begin
      InternetReadFile(hOpenUrl,
                        @Temp,
                        MAXBLOCKSIZE,
                        dwRead
      );
      Result.Write(Temp, dwRead);
    end;
  finally
    InternetCloseHandle(hOpenUrl);
    InternetCloseHandle(hSession);
  end;
end;


function CheckUrl(Url: string): boolean;
var
  hSession, hFile: hInternet;
  dwIndex, dwCodeLen: dword;
  dwCode: array [1..20] of char;
  res: PChar;
begin
  Result:=false;
  hSession:=InternetOpen('Mozilla/4.0 (MSIE 6.0; Windows NT 5.1)', INTERNET_OPEN_TYPE_PRECONFIG, nil,nil,0);
  if Assigned(hSession) then begin
    if Copy(LowerCase(Url), 1, 8) = 'https://' then
      hFile:=InternetOpenURL(hSession, PChar(Url), nil, 0, INTERNET_FLAG_SECURE, 0)
    else
      hFile:=InternetOpenURL(hSession, PChar(Url) , nil, 0, INTERNET_FLAG_RELOAD, 0);
    dwIndex:=0;
    dwCodeLen:=10;
    HttpQueryInfo(hFile, HTTP_QUERY_STATUS_CODE, @dwCode, dwCodeLen, dwIndex);
    res:=PChar(@dwCode);
    Result:=(res='200') or (res='302');
    if Assigned(hFile) then
      InternetCloseHandle(hFile);
    InternetCloseHandle(hSession);
  end;
end;

//改自 http://www.delphitop.com/html/hanshu/3807.html
function HTTPGet(Url: string): string;
var
  hSession, hConnect, hRequest: hInternet;
  FHost, FScript, SRequest, Uri: string;
  Ansi: PAnsiChar;
  Buff: array [0..1023] of Char;
  BytesRead: Cardinal;
  Res, Len: DWORD;
  https: boolean;
const
  Header = 'Content-Type: application/x-www-form-urlencoded' + #13#10;
  iPORT: array[boolean] of INTERNET_PORT = (INTERNET_DEFAULT_HTTP_PORT, INTERNET_DEFAULT_HTTPS_PORT);
  iFlags: array[boolean] of DWORD = (INTERNET_FLAG_RELOAD, INTERNET_FLAG_SECURE);
begin
  https := false;
  Result := '';
  if Copy(LowerCase(Url),1,8) = 'https://' then begin
    https := true;
    Delete(Url, 1, 8);
  end
  else if Copy(LowerCase(Url), 1, 7) = 'http://' then
    Delete(Url, 1, 7)
  else
    Exit;//Url不全
  Uri := Url;
  Uri := Copy(Uri, 1, Pos('/', Uri) - 1);
  FHost := Uri;
  FScript := Url;
  Delete(FScript, 1, Pos(FHost, FScript) + Length(FHost));
  hSession := InternetOpen('Mozilla/4.0 (MSIE 6.0; Windows NT 5.1)', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if not Assigned(hSession) then
    Exit;
  try
    hConnect := InternetConnect(hSession, PChar(FHost), iPORT[https], nil,'HTTP/1.0', INTERNET_SERVICE_HTTP, 0, 0);
    if not Assigned(hConnect) then
      exit;
    try
      Ansi:='text/*';
      hRequest := HttpOpenRequest(hConnect, 'GET', PChar(FScript), 'HTTP/1.1', nil, @Ansi, iFlags[https], 0);
      if not Assigned(hRequest) then
        Exit;
      try
        if not (HttpAddRequestHeaders(hRequest, Header, Length(Header), HTTP_ADDREQ_FLAG_REPLACE or HTTP_ADDREQ_FLAG_ADD or HTTP_ADDREQ_FLAG_COALESCE_WITH_COMMA)) then
          exit;
        Len := 0;
        Res := 0;
        SRequest := '';
        HttpQueryInfo(hRequest, HTTP_QUERY_RAW_HEADERS_CRLF or HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], Len, Res);
        if Len > 0 then begin
          SetLength(SRequest, Len);
          HttpQueryInfo(hRequest, HTTP_QUERY_RAW_HEADERS_CRLF or HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], Len, Res);
        end;
        if not (HttpSendRequest(hRequest, nil, 0, nil, 0)) then
          exit;
        FillChar(Buff, SizeOf(Buff), 0);
        repeat
          Application.ProcessMessages;
          Result:=Result + Buff;
          FillChar(Buff, SizeOf(Buff), 0);
          InternetReadFile(hRequest, @Buff, SizeOf(Buff), BytesRead);
        until BytesRead = 0;
      finally
        InternetCloseHandle(hRequest);
      end;
    finally
      InternetCloseHandle(hConnect);
    end;
  finally
    InternetCloseHandle(hSession);
  end;
end;

//代码来源： http://www.delphitop.com/html/wangluo/2652.html
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;

//获取 https://mybank.icbc.com.cn/icbc/newperbank/perbank3/frame/frame_index.jsp 网页顶部的 logo
procedure TForm1.Button1Click(Sender: TObject);
const
  hosts = 'https://mybank.icbc.com.cn';
  url = '/icbc/perbank/index.jsp';
  bS = '';
var
  s: String;
  i: integer;
  ms: TMemoryStream;
begin
  s := HTTPGet(hosts + url);
  i := pos(bS, s);
  delete(s, 1, i + length(bS) - 1);
  i := pos('"', s);
  delete(s, i, length(s));
  ms := WinInetDownLoad(pansichar(hosts + s));
  try
    if ms.Size > 0 then begin
      ms.Position := 0;
      Image1.Picture.Graphic.LoadFromStream(ms);
    end;
  finally
    ms.Free;
  end;
end;

end.

感谢中国软件群 广州佬哥分享