Delphi 我的代码之简单封装WinHttpRequest

技术交流,DH讲解.

前段时间,和群里面的朋友讨论提交包的时候,结果发现Indy被大家狂批,哈哈,后来有人推荐用WinHttp,查看了下MSDN,WinHttp主要是靠system32目录下面的WinHttp.dll这个文件,而它又有2种用法,一个是直接API,复杂些,但是功能强大,另外一个就是直接使用WinHttpRequest这个ActiveX.

为了使用方便,对WinHttpRequest进行了简单封装,但是感觉不完善,有空补足.还有好多方法没有封装进来,但是留了一个属性property Http:OleVariant read FHttp write FHttp; 这样大家可以直接调用WinHttpRequest.来看看代码:(直接下载)

unit utWinHttp;

interface
uses
  SysUtils,Classes,Windows;

const
  request_headers:array[0..14] of string = (
    'Accept','Accept-Encoding','Accept-Language','Cache-Control',
    'CharSet','Connection','Content-Encoding','Content-Language',
    'Content-Type','Date','Expires','From',
    'Referer','UserAgent','Cookie'
  );

const
  WinHttpRequestOption_UserAgentString = $00000000;
  WinHttpRequestOption_URL = $00000001;
  WinHttpRequestOption_URLCodePage = $00000002;
  WinHttpRequestOption_EscapePercentInURL = $00000003;
  WinHttpRequestOption_SslErrorIgnoreFlags = $00000004;
  WinHttpRequestOption_SelectCertificate = $00000005;
  WinHttpRequestOption_EnableRedirects = $00000006;
  WinHttpRequestOption_UrlEscapeDisable = $00000007;
  WinHttpRequestOption_UrlEscapeDisableQuery = $00000008;
  WinHttpRequestOption_SecureProtocols = $00000009;
  WinHttpRequestOption_EnableTracing = $0000000A;
  WinHttpRequestOption_RevertImpersonationOverSsl = $0000000B;
  WinHttpRequestOption_EnableHttpsToHttpRedirects = $0000000C;
  WinHttpRequestOption_EnablePassportAuthentication = $0000000D;
  WinHttpRequestOption_MaxAutomaticRedirects = $0000000E;
  WinHttpRequestOption_MaxResponseHeaderSize = $0000000F;
  WinHttpRequestOption_MaxResponseDrainSize = $00000010;
  WinHttpRequestOption_EnableHttp1_1 = $00000011;
  WinHttpRequestOption_EnableCertificateRevocationCheck = $00000012;

  AutoLogonPolicy_Always = $00000000;
  AutoLogonPolicy_OnlyIfBypassProxy = $00000001;
  AutoLogonPolicy_Never = $00000002;

  SslErrorFlag_UnknownCA = $00000100;
  SslErrorFlag_CertWrongUsage = $00000200;
  SslErrorFlag_CertCNInvalid = $00001000;
  SslErrorFlag_CertDateInvalid = $00002000;
  SslErrorFlag_Ignore_All = $00003300;

  SecureProtocol_SSL2 = $00000008;
  SecureProtocol_SSL3 = $00000020;
  SecureProtocol_TLS1 = $00000080;
  SecureProtocol_ALL = $000000A8;

const
  IStream_GUID:TGUID = '{0000000C-0000-0000-C000-000000000046}';

type
  TCustomWinHttp = class;
  //请求信息类
  TRequest = class(TPersistent)
  private
    FAccept,FAcceptEncoding,FAcceptLanguage:string;
    FCacheControl,FCharSet,FConnection:string;
    FContentEncoding,FContentLanguage,FContentType:string;
    FDate,FExpires,FFrom:string;
    FReferer,FUserAgent:string;
    FCookie:string;
    FCustomHeader:TStringList;
  public
    constructor Create;
    destructor Destroy; override;
  published
    property Accept:string  read FAccept write FAccept;
    property AcceptEncoding:string read FAcceptEncoding write FAcceptEncoding;
    property AcceptLanguage:string read FAcceptLanguage write FAcceptLanguage;
    property CacheControl:string read FCacheControl write FCacheControl;
    property CharSet:string read FCharSet write FCharSet;
    property Connection:string read FConnection write FConnection;
    property ContentEncoding:string read FContentEncoding write FContentEncoding;
    property ContentLanguage:string read FContentLanguage write FContentLanguage;
    property ContentType:string read FContentType write FContentType;
    property Date:string read FDate write FDate;
    property Expires:string read FExpires write FExpires;
    property From:string read FFrom write FFrom;
    property Referer:string read FReferer write FReferer;
    property UserAgent:string read FUserAgent write FUserAgent;
    property Cookie:string read FCookie write FCookie;
    property CustomHeader:TStringList  read FCustomHeader write FCustomHeader;
  end;
  //返回信息类
  TResponse = class(TPersistent)
  private
    FOwner:TCustomWinHttp;
    FHeaderList:TStringList;
    procedure Check;
    function Get_Header(const header_name:string):string;
    function Get_Status:Integer;
    function Get_StatusText:string;
    function Get_ResponseBody:string;
    function Get_HeadersText:string;
  public
    constructor Create(http:TCustomWinHttp);
    destructor Destroy; override;
    property Header[const Name:string]:string  read Get_Header;
    property Status:Integer  read Get_Status;
    property StatusText:string  read Get_StatusText;
    property ResponseBody:string  read Get_ResponseBody;
    property HeadersText:string read Get_HeadersText;
  end;

  TCustomWinHttp = class(TComponent)
  private
    FCreated:Boolean;
    FHttp:OleVariant;
    FRequest:TRequest;
    FResponse:TResponse;
    FRequestTime:Integer;
    FOnRequestTimeOut:TNotifyEvent;

    procedure SetRequestHeaders;
    procedure Set_Option(idx:Integer;value:OleVariant);
    function Get_Option(idx:Integer):OleVariant;

    procedure Set_Redirects(B:Boolean);
    function Get_Redirects:Boolean;

    procedure Set_MaxRedirects(N:Integer);
    function Get_MaxRedirects:Integer;
  public
    procedure Abort;
    procedure ClearRequestHeaders;
    function Get(const URL:string):string;overload;
    procedure Get(Const URL:string;res:TStream);overload;
    function Post(const URL:string;Req:TStream):string;overload;
    function Post(const URL,Req:string):string;overload;
    procedure Post(const URL:string;Req,Res:TStream);overload;
    procedure Post(const URL,Req:string;Res:TStream);overload;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property Http:OleVariant  read FHttp write FHttp;
    property EnableRedirects:Boolean  read Get_Redirects write Set_Redirects;
    property MaxRedirects:Integer  read Get_MaxRedirects write Set_MaxRedirects;
    property Request:TRequest  read FRequest write FRequest;
    property RequestTime:Integer  read FRequestTime write FRequestTime;
    property OnRequestTimeOut:TNotifyEvent  read FOnRequestTimeOut write FOnRequestTimeOut;
    property Response:TResponse  read FResponse write FResponse;
    property Options[idx:Integer]:OleVariant  read Get_Option write Set_Option;
  end;

  TWinHttp = class(TCustomWinHttp)
  published
    property MaxRedirects;
    property EnableRedirects;
    property Request;
    property Response;
    property RequestTime;
    property OnRequestTimeOut;
  end;

implementation
uses
  ComObj,AxCtrls,ActiveX,Variants;

{ TResponse }

procedure TResponse.Check;
begin
  if FHeaderList.Count = 0 then
    FHeaderList.Text:=FOwner.FHttp.GetAllResponseHeaders;
end;

constructor TResponse.Create(http:TCustomWinHttp);
begin
  FOwner:=http;
  FHeaderList:=TStringList.Create;
  FHeaderList.NameValueSeparator:=':';
end;

destructor TResponse.Destroy;
begin
  FHeaderList.Free;
  inherited;
end;

function TResponse.Get_Header(const header_name: string): string;
begin
  Check;
  Result:=FHeaderList.Values[header_name];
end;

function TResponse.Get_HeadersText: string;
begin
  Check;
  Result:=FHeaderList.Text;
end;

function TResponse.Get_ResponseBody: string;
begin
  Result:=FOwner.Http.ResponseBody;
end;

function TResponse.Get_Status: Integer;
begin
  Result:=FOwner.Http.Status;
end;

function TResponse.Get_StatusText: string;
begin
  Result:=FOwner.Http.StatusText;
end;

{ TRequest }

constructor TRequest.Create;
begin
  inherited;
  FCustomHeader:=TStringList.Create;
end;

destructor TRequest.Destroy;
begin
  FCustomHeader.Free;
  inherited;
end;

{ TCustomWinHttp }

procedure TCustomWinHttp.Abort;
begin
  if FCreated then
    FHttp.Abort();
end;

procedure TCustomWinHttp.ClearRequestHeaders;
var
  I,base: Integer;
begin
  base := Integer(FRequest);
  for I := 0 to 14 do
    PDWORD(base + 4 * (I+1))^:=0;
  FRequest.CustomHeader.Clear;
end;

constructor TCustomWinHttp.Create(AOwner: TComponent);
begin
  inherited;
  FRequest:=TRequest.Create;
  FRequest.FCustomHeader.NameValueSeparator:=':';
  FResponse:=TResponse.Create(Self);
  try
    FCreated:=False;
    FHttp:=CreateOleObject('WinHttp.WinHttpRequest.5.1');
    FCreated:=True;
  except
    raise Exception.Create('创建WinHttp失败');
  end;

  FRequestTime:=4000;
end;

destructor TCustomWinHttp.Destroy;
begin
  Abort;
  FHttp:=0;
  FResponse.Free;
  FRequest.Free;
  inherited;
end;

function TCustomWinHttp.Get(const URL: string): string;
var
  ss:TStringStream;
begin
  Result:='';
  ss:=TStringStream.Create;
  try
    Get(URL,SS);
    Result:=ss.DataString;
  finally
    ss.Free;
  end;
end;

procedure TCustomWinHttp.Get(const URL: string; res: TStream);
var
  iu:IUnknown;
  os:TOlestream;
  s:IStream;
  p:OleVariant;
  w:Word;
begin
  Assert(res<>Nil);
  if Not FCreated then
    Exit;
  //清除已经有的header
  FResponse.FHeaderList.Clear;
  //请求
  try
    FHttp.Open('GET',URL,False);
    SetRequestHeaders;
    FHttp.Send(varEmpty);
    if Not FHttp.WaitForResponse(FRequestTime) then
    begin
      FHttp.Abort;
      if Assigned(FOnRequestTimeOut) then
        FOnRequestTimeOut(Self);
      Exit;
    end;
    P:=FHttp.ResponseStream ;
    W:=VarType(P);
    if w = varUnknown then
    begin
      iu:=IUnknown(P);
      iu.QueryInterface(IStream_GUID,s);
    end;
    if s=nil then
      Exit;
    res.Position:=0;
    os:=TOleStream.Create(s);
    try
      os.Position:=0;
      res.CopyFrom(os,os.Size)
    finally
      os.Free
    end;
  except
  end;
end;

function TCustomWinHttp.Get_MaxRedirects: Integer;
begin
  Result:=Get_Option(WinHttpRequestOption_MaxAutomaticRedirects) ;
end;

function TCustomWinHttp.Get_Option(idx: Integer): OleVariant;
begin
  Result:=FHttp.Option[idx];
end;

function TCustomWinHttp.Get_Redirects: Boolean;
begin
  Result:=FHttp.Option[WinHttpRequestOption_EnableRedirects];
end;

function TCustomWinHttp.Post(const URL, Req: string): string;
var
  ss:TStringStream;
begin
  Result:='';
  SS:=TStringStream.Create;
  try
    Post(URL,Req,SS);
    Result:=ss.DataString;
  finally
    ss.Free;
  end;
end;

function TCustomWinHttp.Post(const URL: string; Req: TStream): string;
var
  ss:TStringStream;
  S:string;
begin
  Assert(Req<>nil);
  ss:=TStringStream.Create;
  try
    Req.Position:=0;
    ss.CopyFrom(Req,Req.Size);
    S:=ss.DataString;
    ss.Clear;
    Post(URL,S,ss);
    Result:=ss.DataString;
  finally
    ss.Free;
  end;
end;

procedure TCustomWinHttp.Post(const URL: string; Req, Res: TStream);
var
  ss:TStringStream;
  S:string;

begin
  Assert(Req<>nil);
  ss:=TStringStream.Create;
  try
    Req.Position:=0;
    ss.CopyFrom(Req,Req.Size);
    S:=ss.DataString;
    Post(URL,s,Res)
  finally
    ss.Free;
  end;

end;

procedure TCustomWinHttp.SetRequestHeaders;
var
  I,dx,base: Integer;
  S:string;
begin
  base:=Integer(FRequest);
  for I := 0 to 14 do
  begin
    dx:=base + 4 * (I + 1);
    s:=PString(dx)^;
    if s<>'' then
      FHttp.SetRequestHeader(request_headers[I],S);
  end;
  for I := 0 to FRequest.CustomHeader.Count - 1 do
    FHttp.SetRequestHeader(FRequest.CustomHeader.Names[I],
            FRequest.CustomHeader.ValueFromIndex[I]
    );

end;

procedure TCustomWinHttp.Set_MaxRedirects(N: Integer);
begin
  Set_Option(WinHttpRequestOption_MaxAutomaticRedirects,N);
end;

procedure TCustomWinHttp.Set_Option(idx: Integer; value: OleVariant);
begin
  FHttp.Option[idx]:=value;
end;

procedure TCustomWinHttp.Set_Redirects(B: Boolean);
begin
  Set_Option(WinHttpRequestOption_EnableRedirects,B);
end;

procedure TCustomWinHttp.Post(const URL, Req: string; Res: TStream);
var
  s:IStream;
  os:TOleStream;
  p:OleVariant;
begin
  Assert(Res<>Nil);
  if Not FCreated then
    Exit;
  FResponse.FHeaderList.Clear;
  try
    FHttp.Open('POST',URL,False);
    SetRequestHeaders;
    FHttp.SetRequestHeader('Content-Length',IntToStr(Length(Req)));
    FHttp.Send(Req);
    if Not FHttp.WaitForResponse(FRequestTime) then
    begin
      FHttp.Abort;
      if Assigned(FOnRequestTimeOut) then
        FOnRequestTimeOut(Self);
      Exit;
    end;
    P:=FHttp.ResponseStream;
    if VarType(P) = varUnknown then
      IUnknown(P).QueryInterface(IStream_GUID,S);
    if s=nil then
      Exit;
    os:=TOleStream.Create(s);
    try
      Res.Position:=0;
      os.Position:=0;
      Res.CopyFrom(os,os.Size);
    finally
      os.Free;
    end;
  except
  end;
end;

end.

简单用法,表单提交来登录人人网:

type
  TForm3 = class(TForm)
    btn1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
    Http:TWinHttp;
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.btn1Click(Sender: TObject);
var
  s:string;
begin
  //清空之前的header
  Http.ClearRequestHeaders;
  //设置自己的header ,两种方法都可以
  //POST时候这个必须设置成这样
  Http.Request.ContentType:='application/x-www-form-urlencoded';
//  Http.Request.CustomHeader.Add('Content-Type: application/x-www-form-urlencoded');
  S:=Http.Post('http://www.renren.com/PLogin.do',
  'email=huangjacky@163.com&password=密码&origURL=http%3A%2F%2Fwww.renren.com%2FHome.do&domain=renren.com');
  //html代码
  ShowMessage(S);
  //返回的header
  ShowMessage(Http.Response.HeadersText);
  //状态
  ShowMessageFmt('Code:%D,Text:%S',
      [Http.Response.Status,Http.Response.StatusText]
    );
end;

procedure TForm3.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Http.Free;
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
  Http:=TWinHttp.Create(Self);
  //禁止转向
  Http.EnableRedirects:=False;
end;

再来个下载文件的例子:

procedure TForm3.btn2Click(Sender: TObject);
var
  S:TFileStream;
begin
  s:=TFileStream.Create('C:\11.rar',fmCreate);
  Http.Get('https://files.cnblogs.com/huangjacky/Delphi.Distiller.v1.83.rar',s);
  s.Free;
end;

我是DH,吃饭去了