Delphi - 我的代码之简单封装WinHttpRequest

技术交流,DH讲解.

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

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

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

96

97

98

99

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421

422

423

424

425

426

427

428

429

430

431

432

433

434

435

436

437

438

439

440

441

442

443

444

445

446

447

448

449

450

451

452

453

454

455

456

457

458

459

460

461

462

463

464

465

466

467

468

469

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 FCreatedthen

    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 FCreatedthen

    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 FCreatedthen

    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.

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

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

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=[e-mail]&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;

再来个下载文件的例子:

1

2

3

4

5

6

7

8

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;

我是DH.