关于winapi：Delphi。 WinInet 思科 NTLM。 12045 和 12057 错误

Delphi. WinInet + cisco + NTLM. 12045 and 12057 errors

我通过 Cisco 连接到公司网络，然后通过域 NTLM 授权到公司 https 站点。

所以我通过代理(在 IE 中使用密码登录一次就足够了)并且程序转到除公司站点之外的所有站点，它失败并出现错误 12045 (ERROR_INTERNET_INVALID_CA) 或 12057。

如何从商店获得证书？自然，无需使用带有密码和证书名称的用户名。
请帮忙，谁知道呢。我也通过http尝试过。

这里是函数：

function WinInetRequest(AUrl, AParam, AMethod, AType_Access: String; APostData: boolean): AnsiString;

function GetHostName(AUrl: string): string;
var
s: string;
begin // Host name
if Pos('https://', AUrl) > 0 then
s:= 'https://'
else
if Pos('http://', AUrl) > 0 then
s:= 'http://'
else
s:= EmptyStr;
if s <> EmptyStr then
if Pos(s, AUrl) > 0 then
Delete(AUrl, 1, Length(s));
if Pos('/', AUrl) > 0 then
SetLength(AUrl, Pos('/', AUrl) - 1);
Result:= AUrl;
end;

function GetScriptName(AUrl, AHostname: string): string;
begin
Result:= EmptyStr;
Delete(AUrl, 1, Pos(AHostname, AUrl) + Length(AHostname));
Result:= AUrl;
end;

procedure SetFlags(AUrl: string; out Flags_connection, Flags_Request: Cardinal);
begin // http or https choosing
if Pos('https', AUrl) > 0 then
begin
Flags_connection:= INTERNET_DEFAULT_HTTPS_PORT;
Flags_Request:= INTERNET_FLAG_RELOAD
or INTERNET_FLAG_IGNORE_CERT_CN_INVALID
or INTERNET_FLAG_IGNORE_CERT_DATE_INVALID
or SECURITY_FLAG_IGNORE_UNKNOWN_CA
or INTERNET_FLAG_NO_CACHE_WRITE
or INTERNET_FLAG_SECURE
or INTERNET_FLAG_PRAGMA_NOCACHE
or INTERNET_FLAG_KEEP_CONNECTION;
end else
begin
Flags_connection:= INTERNET_DEFAULT_HTTP_PORT;
Flags_Request:= INTERNET_FLAG_RELOAD or INTERNET_FLAG_IGNORE_CERT_CN_INVALID or INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_PRAGMA_NOCACHE or INTERNET_FLAG_KEEP_CONNECTION;
end;
end;

var
hInet, hCon, hReq: HINTERNET;
Status, Index, dwErrorCode, StatusSize: DWORD;
bytes, b, pos: Cardinal;
hostname, script: string;
Flags_connection, Flags_Request : Cardinal;
IsSended: Boolean;

label
again;
begin
Result:= EmptyAnsiStr;

hostname:= GetHostName(AUrl); // hostname
script:= GetScriptName(AUrl, hostname); // script
// установка доп. параметров
if not APostData then // if passing params through URL
if AParam <> EmptyStr then // then add to script
if script[Length(script)] = '?' then
script:= script + AParam
else
script:= script + '?' + AParam;

// Type_Access
if AType_Access = EmptyStr then
AType_Access:= 'Content-Type: application/x-www-form-urlenDELPHId' + #13#10 +
'Content-Length:' + IntToStr(length(AParam)) ;

try
// set flags (http или https)
SetFlags(AUrl, Flags_connection, Flags_Request);
// WinInet init
hInet:= InternetOpen(PChar(Application.ExeName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); //
if Assigned(hInet) then
try
// open session
hCon:= InternetConnect(hInet, PChar(hostname), Flags_connection, nil, nil, INTERNET_SERVICE_HTTP, 0, 1);
if Assigned(hCon) then
try
// open request
hReq:= HttpOpenRequest(hCon, PChar(UpperCase(AMethod)), PChar(script), HTTP_VERSION, nil, nil, Flags_Request, 1);
if Assigned(hReq) then
try // send request
case APostData of
False: IsSended:= HttpSendRequest(hReq, nil, 0, nil, 0);
True: IsSended:= HttpSendRequest(hReq, PChar(AType_Access), Length(AType_Access), PChar(AParam), Length(AParam));
end;
if not IsSended then // cert error
begin
// autorization window
{InternetErrorDlg(Application.Handle,
hReq,
ERROR_INTERNET_INVALID_CA,
FLAGS_ERROR_UI_FILTER_FOR_ERRORS
or FLAGS_ERROR_UI_FLAGS_GENERATE_DATA
or FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS,
hReq);}
dwErrorCode:= GetLastError;
if (dwErrorCode = 12045) then
begin
ShowMessage('cert error!');
Status:= INTERNET_FLAG_SECURE
or INTERNET_FLAG_IGNORE_CERT_CN_INVALID
or INTERNET_FLAG_IGNORE_CERT_DATE_INVALID
or SECURITY_FLAG_IGNORE_REVOCATION;
StatusSize:= SizeOf(Status);
InternetQueryOption(hReq, INTERNET_OPTION_SECURITY_FLAGS, @Status, StatusSize);
Status:= Status or SECURITY_FLAG_IGNORE_UNKNOWN_CA;
InternetSetOption(hReq, INTERNET_OPTION_SECURITY_FLAGS, @Status, SizeOf(Status));

case APostData of
False: IsSended:= HttpSendRequest(hReq, nil, 0, nil, 0);
True: IsSended:= HTTPSendRequest(hReq, PChar(AType_Access), Length(AType_Access), PChar(AParam), Length(AParam));
end;
end;

end;
if IsSended then
begin
StatusSize:= SizeOf(Status);
Index:= 0;
HttpQueryInfo(hReq, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER, @Status, StatusSize, Index);
if Status <> HTTP_STATUS_OK then
Result:= AnsiString('Код ответа сервера: ' + IntToStr(Status) + sLineBreak + SysErrorMessage(GetLastError));
pos:= 1;
b:= 1;
while b > 0 do
begin
if not InternetQueryDataAvailable(hReq, bytes, 0, 0) then
Result:= AnsiString('data is empty! (function InternetQueryDataAvailable)' + sLineBreak + SysErrorMessage(GetLastError));
SetLength(Result, Cardinal(Length(Result)) + bytes);
// get data from server
InternetReadFile(hReq, @Result[Pos], bytes, b);
Inc(Pos, b);
end;
end else
Result:= AnsiString('Error ' + IntToStr(GetLastError) + '!');
finally
InternetCloseHandle(hReq); // close request
end else
Result:= AnsiString('Error (function HttpOpenRequest)' + sLineBreak + SysErrorMessage(GetLastError));
finally
InternetCloseHandle(hCon); // close session
end else
Result:= AnsiString('Error (function InternetConnect)' + sLineBreak + SysErrorMessage(GetLastError));
finally
InternetCloseHandle(hInet); // close connection
end else
Result:= AnsiString('Error (function InternetOpen)' + sLineBreak + SysErrorMessage(GetLastError));
except
On E: Exception do
Result:= AnsiString('Error! ' + E.ClassName + ': ' + E.Message);
end;
end;

加法

我使用密钥解决了证书问题：

1
2
3
4

SECURITY_FLAG_IGNORE_UNKNOWN_CA
or SECURITY_FLAG_IGNORE_CERT_CN_INVALID
or SECURITY_FLAG_IGNORE_CERT_DATE_INVALID or
SECURITY_FLAG_IGNORE_REVOCATION

但现在我收到 401 身份验证错误。

节目记录：

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

CONNECT site.ru:443 HTTP/1.0
User-Agent: C:\\Dev\\Testing.exe
Host: site.ru:443
Content-Length: 0
Connection: Keep-Alive
Pragma: no-cache

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 08:58:58.805
Connection: close
EndTime: 08:59:16.562
ClientToServerBytes: 1946
ServerToClientBytes: 6185

------------------------------------------------------------------

GET http://site.ru/cert/root.crt HTTP/1.1
Proxy-Connection: Keep-Alive
Accept: */*
User-Agent: Microsoft-CryptoAPI/10.0
Host: site.ru

HTTP/1.1 502 Fiddler - Connection Failed
Date: Mon, 27 Jan 2020 05:59:20 GMT
Content-Type: text/html; charset=UTF-8
Connection: close
Timestamp: 08:59:20.404

------------------------------------------------------------------

IE 日志(不完整但最后响应代码为 200)：

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

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:42:39.636
Connection: close
EndTime: 09:42:54.716
ClientToServerBytes: 205
ServerToClientBytes: 3183

------------------------------------------------------------------

GET http://site.ru/cert/root.crt HTTP/1.1
Proxy-Connection: Keep-Alive
Accept: */*
User-Agent: Microsoft-CryptoAPI/10.0
Host: site.ru

HTTP/1.1 502 Fiddler - Connection Failed
Date: Mon, 27 Jan 2020 06:43:00 GMT
Content-Type: text/html; charset=UTF-8
Connection: close
Timestamp: 09:43:00.722

------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:42:54.747
Connection: close
EndTime: 09:42:54.785
ClientToServerBytes: 205
ServerToClientBytes: 3183

------------------------------------------------------------------ This site is not secure, I press"Go on to the webpage (not recommended)"

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:44:14.163
Connection: close
EndTime: 09:44:29.231
ClientToServerBytes: 205
ServerToClientBytes: 3183

------------------------------------------------------------------

GET http://site.ru/cert/root.crt HTTP/1.1
Proxy-Connection: Keep-Alive
Accept: */*
User-Agent: Microsoft-CryptoAPI/10.0
Host: site.ru

HTTP/1.1 502 Fiddler - Connection Failed
Date: Mon, 27 Jan 2020 06:44:35 GMT
Content-Type: text/html; charset=UTF-8
Connection: close
Timestamp: 09:44:35.225

------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:44:29.294
Connection: close
EndTime: 09:44:29.362
ClientToServerBytes: 205
ServerToClientBytes: 3183

------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:44:29.384
Connection: close
EndTime: 09:45:20.611
ClientToServerBytes: 36558
ServerToClientBytes: 168803

------------------------------------------------------------------ - entering password

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.675
Connection: close
EndTime: 09:45:20.620
ClientToServerBytes: 24661
ServerToClientBytes: 284264

------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.674
Connection: close
EndTime: 09:45:20.628
ClientToServerBytes: 21760
ServerToClientBytes: 117787

------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.674
Connection: close
EndTime: 09:45:12.743
ClientToServerBytes: 10519
ServerToClientBytes: 17470

------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.674
Connection: close
EndTime: 09:45:14.875
ClientToServerBytes: 12684
ServerToClientBytes: 57032

------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.673
Connection: close
EndTime: 09:45:27.157
ClientToServerBytes: 19947
ServerToClientBytes: 462607

------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.673
Connection: close
EndTime: 09:45:12.729
ClientToServerBytes: 10348
ServerToClientBytes: 26830

------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.668
Connection: close
EndTime: 09:45:29.979
ClientToServerBytes: 27178
ServerToClientBytes: 645488

------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.673
Connection: close
EndTime: 09:45:14.866
ClientToServerBytes: 23141
ServerToClientBytes: 63723

------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.673
Connection: close
EndTime: 09:45:29.563
ClientToServerBytes: 17702
ServerToClientBytes: 1107864

------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.675
Connection: close
EndTime: 09:45:13.329
ClientToServerBytes: 5053
ServerToClientBytes: 43534

------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.675
Connection: close
EndTime: 09:45:14.880
ClientToServerBytes: 19979
ServerToClientBytes: 91116

------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:12.974
Connection: close
EndTime: 09:45:21.599
ClientToServerBytes: 15295
ServerToClientBytes: 198021

------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:12.987
Connection: close
EndTime: 09:45:20.589
ClientToServerBytes: 21600
ServerToClientBytes: 221667

------------------------------------------------------------------

CONNECT piwik.mts.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: piwik.mts.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:13.368
Connection: close
EndTime: 09:45:28.443
ClientToServerBytes: 201
ServerToClientBytes: 2048

------------------------------------------------------------------

GET http://site.ru/cert/win.crt HTTP/1.1
Proxy-Connection: Keep-Alive
Accept: */*
User-Agent: Microsoft-CryptoAPI/10.0
Host: site.ru

HTTP/1.1 502 Fiddler - Connection Failed
Date: Mon, 27 Jan 2020 06:45:34 GMT
Content-Type: text/html; charset=UTF-8
Connection: close
Timestamp: 09:45:34.440

------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:16.694
Connection: close
EndTime: 09:45:21.579
ClientToServerBytes: 20336
ServerToClientBytes: 179279

应用程序不发送带有基本身份验证的标头...如何解决？

相关讨论

必须使用域名登录，例如 Domain\\\\Login

下面的代码对我有用：

//If you don`t pass credentials (while creating object or after that) then request window will appear

unit UnitWinInet;

interface

uses
System.SysUtils, System.Types, WinInet, Winapi.Windows;

type

TWinInet = class
private
FHWND: THandle;
FClientName,
FParam,
FMethod,
FType_Access,
FLogin,
FPass: string;
FPostData: boolean;
procedure SetMethod(AMethod: string);
public
property HWND: THandle read FHWND write FHWND;
property ClientName: string read FClientName write FClientName;
property Param: string read FParam write FParam;
property Method: string read FMethod write SetMethod;
property Type_Access: string read FType_Access write FType_Access;
property Login: string read FLogin write FLogin;
property Pass: string read FPass write FPass;
property PostData: boolean read FPostData write FPostData;
function GetHTTP(AURL: string): AnsiString;
constructor Create(AHWND: THandle);
end;

implementation

constructor TWinInet.Create(AHWND: THandle);
begin
FHWND:= AHWND;
FClientName:= 'WinInet';
FMethod:= 'GET';
FType_Access:= 'Content-Type: application/x-www-form-urlenDELPHId' + #13#10 +
'Content-Length:' + IntToStr(length(FParam));
FPostData:= False;
end;

procedure TWinInet.SetMethod(AMethod: string);
begin
FMethod:= UpperCase(AMethod);
end;

function TWinInet.GetHTTP(AURL: string): AnsiString;

function GetHostName(AUrl: string): string;
var
s: string;
begin
if Pos('https://', AUrl) > 0 then
s:= 'https://'
else
if Pos('http://', AUrl) > 0 then
s:= 'http://'
else
s:= EmptyStr;
if s <> EmptyStr then
if Pos(s, AUrl) > 0 then
Delete(AUrl, 1, Length(s));
if Pos('/', AUrl) > 0 then
SetLength(AUrl, Pos('/', AUrl) - 1);
Result:= AUrl;
end;

function GetScriptName(AUrl, AHostname: string): string;
begin
Result:= EmptyStr;
Delete(AUrl, 1, Pos(AHostname, AUrl) + Length(AHostname));
Result:= AUrl;
end;

procedure SetFlags(AUrl: string; out Flags_connection, Flags_Request: Cardinal);
begin
if Pos('https', AUrl) > 0 then
begin
Flags_connection:= INTERNET_DEFAULT_HTTPS_PORT;
Flags_Request:= INTERNET_FLAG_RELOAD
or INTERNET_FLAG_NO_CACHE_WRITE
or INTERNET_FLAG_SECURE
or INTERNET_FLAG_IGNORE_CERT_CN_INVALID
or INTERNET_FLAG_IGNORE_CERT_DATE_INVALID
or INTERNET_FLAG_KEEP_CONNECTION
end else
begin
Flags_connection:= INTERNET_DEFAULT_HTTP_PORT;
Flags_Request:= INTERNET_FLAG_RELOAD
or INTERNET_FLAG_IGNORE_CERT_CN_INVALID
or INTERNET_FLAG_NO_CACHE_WRITE
or INTERNET_FLAG_PRAGMA_NOCACHE
or INTERNET_FLAG_KEEP_CONNECTION;
end;
end;

function GetResponseHeader(const hRequest: Pointer): string;
var
dwSize, Index: DWORD;
szBuff: array [0..1024] of Char;
begin
Index:= 0;
dwSize:= SizeOf(szBuff);
HttpQueryInfo(hRequest, HTTP_QUERY_RAW_HEADERS_CRLF, @szBuff, dwSize, Index);
Result:= PChar(@szBuff);
end;

function GetStatus(const hRequest: Pointer): DWORD;
var
dwSize, dwStatus, Index: DWORD;
begin
Index:= 0;
dwSize:= SizeOf(dwStatus);
HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER, @dwStatus, dwSize, Index);
Result:= dwStatus;
end;

function AddSecurityFlags(httpReq: Pointer): Boolean;
var
dwSize, dwFlags: DWORD;
begin
Result:= False;
dwSize:= SizeOf(dwFlags); // Get the current security flags
if (InternetQueryOption(httpReq, INTERNET_OPTION_SECURITY_FLAGS, @dwFlags, dwSize)) then
begin // Add desired flags
dwFlags:= dwFlags
or SECURITY_FLAG_IGNORE_UNKNOWN_CA
or SECURITY_FLAG_IGNORE_CERT_CN_INVALID
or SECURITY_FLAG_IGNORE_CERT_DATE_INVALID
or SECURITY_FLAG_IGNORE_REVOCATION;
Result:= (InternetSetOption(httpReq,
INTERNET_OPTION_SECURITY_FLAGS,
@dwFlags,
dwSize));
end
end;

function SendRequest(httpRequest: Pointer; AType_Access, AParam: string): boolean;
begin
case FPostData of
False: Result:= HttpSendRequest(httpRequest, nil, 0, nil, 0);
True: Result:= HttpSendRequest(httpRequest, PChar(AType_Access), Length(AType_Access), PChar(AParam), Length(AParam));
end;
end;

var
httpSession, httpConnect, httpRequest: HINTERNET;
bytes, b, pos: Cardinal;
hostname, script: string;
Flags_connection, Flags_Request: Cardinal;
DlgError: DWORD;
begin
Result:= EmptyAnsiStr;
hostname:= GetHostName(AURL);
script:= GetScriptName(AURL, hostname);
if not FPostData then
if FParam <> EmptyStr then
if script[Length(script)] = '?' then
script:= script + FParam
else
script:= script + '?' + FParam;
try
SetFlags(AURL, Flags_connection, Flags_Request);
httpSession:= InternetOpen(PChar(FClientName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if Assigned(httpSession) then
try
httpConnect:= InternetConnect(httpSession, PChar(hostname), Flags_connection, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);
if Assigned(httpConnect) then
try
httpRequest:= HttpOpenRequest(httpConnect, PChar(FMethod), PChar(script), HTTP_VERSION, nil, nil, Flags_Request, 0);
if Assigned(httpRequest) then
try
AddSecurityFlags(httpRequest);
SendRequest(httpRequest, FType_Access, FParam);
if GetStatus(httpRequest) = HTTP_STATUS_DENIED then
begin
if FLogin <> EmptyStr then
begin
InternetSetOption(httpRequest, INTERNET_OPTION_USERNAME, PChar(FLogin), SizeOf(FLogin));
InternetSetOption(httpRequest, INTERNET_OPTION_PASSWORD, PChar(FPass), SizeOf(FPass));
end
else
begin
DlgError:= InternetErrorDlg(FHWND, httpRequest,
ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED,
FLAGS_ERROR_UI_FILTER_FOR_ERRORS
or FLAGS_ERROR_UI_FLAGS_GENERATE_DATA
//or FLAGS_ERROR_UI_SERIALIZE_DIALOGS
or FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS,
PPointer(nil)^ );
if DlgError = 0 then
begin
Result:= AnsiString('Access Denied! Credential Entry Canceled.'
+ sLineBreak + SysErrorMessage(GetLastError));
Exit;
end;
end;
SendRequest(httpRequest, FType_Access, FParam);
end;
if GetStatus(httpRequest) = HTTP_STATUS_OK then
begin
pos:= 1;
b:= 1;
while b > 0 do
begin
if not InternetQueryDataAvailable(httpRequest, bytes, 0, 0) then
Result:= AnsiString(SysErrorMessage(GetLastError));
SetLength(Result, Cardinal(Length(Result)) + bytes);
InternetReadFile(httpRequest, @Result[Pos], bytes, b);
Inc(Pos, b);
end;
Result:= Result + AnsiString(SysErrorMessage(GetLastError));
end else
Result:= AnsiString(SysErrorMessage(GetLastError));
finally
InternetCloseHandle(httpRequest);
end else
Result:= AnsiString(SysErrorMessage(GetLastError));
finally
InternetCloseHandle(httpConnect);
end else
Result:= AnsiString(sLineBreak + SysErrorMessage(GetLastError));
finally
InternetCloseHandle(httpSession);
end else
Result:= AnsiString(SysErrorMessage(GetLastError));
except
On E: Exception do
Result:= AnsiString('Error! ' + E.ClassName + ': ' + E.Message);
end;
end;

end.

使用方法：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

uses
..., WinInet;
...
Client:= TWinInet.Create(FrmTesting.Handle);
with Client do
try
if FrmTesting.CheckBox1.Checked then
begin
Login:= 'Domain\\login';
Pass:= 'Password';
end;
FHTTPResult:= GetHTTP(FrmTesting.Edt1.Text);
finally
FreeAndNil(Client);
end;