注册
登录
| 关键词： string property WinHttpRequestOp TCustomWinHttp procedure begin end function read write |
前段时间,和群里面的朋友讨论提交包的时候,有人推荐用WinHttp,查看了下MSDN,WinHttp主要是靠system32目录下面的WinHttp.dll这个文件,而它又有2种用法,一个是直接API,复杂些,但是功能强大,另外一个就是直接使用WinHttpRequest这个ActiveX. 为了使用方便,对WinHttpRequest进行了简单封装,但是感觉不完善,有空补足.还有好多方法没有封装进来,但是留了一个属性property Http:OleVariant read FHttp write FHttp; 这样大家可以直接调用WinHttpRequest.来看看代码:(直接下载) unit utWinHttp; inte不合格字符ce 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.QueryInte不合格字符ce(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).QueryInte不合格字符ce(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 protected]&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('http://files.cnblogs.com/huangjacky/Delphi.Distiller.v1.83.rar',s); s.Free; end; |
|
声明：文章版权归原作者所有 部分文章转自互联网 如有侵权请联系
[邮箱地址] 删除
|
