I connect to the corporate network through Cisco, and then through domain NTLM authorization to the corporate https site.
So I go through the proxy (it’s enough to log in with the password once in IE) and the program goes to all sites except the corporate one, it fails with error 12045 (ERROR_INTERNET_INVALID_CA) or 12057.
How to get a certificate from the store? Naturally, without using a username with a password and certificate name. Help, please, who knows. I tried it also through http.
Here is the function:
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;
Addition
I solved the problem with the certificate, using the keys:
SECURITY_FLAG_IGNORE_UNKNOWN_CA
or SECURITY_FLAG_IGNORE_CERT_CN_INVALID
or SECURITY_FLAG_IGNORE_CERT_DATE_INVALID or
SECURITY_FLAG_IGNORE_REVOCATION
But now I getting 401 auth error.
Program Log:
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 Log (not fully but last response code is 200):
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
The application does not send headers with basic authentication... How to fix it?
Login have to be with a domain name, eg Domain\Login
The code below is working for me:
//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.
How to use:
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;