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,吃饭去了
浙公网安备 33010602011771号