Public Enum WinHttpRequestOption
WinHttpRequestOption_UserAgentString
WinHttpRequestOption_URL
WinHttpRequestOption_URLCodePage
WinHttpRequestOption_EscapePercentInURL
WinHttpRequestOption_SslErrorIgnoreFlags
WinHttpRequestOption_SelectCertificate
WinHttpRequestOption_EnableRedirects
WinHttpRequestOption_UrlEscapeDisable
WinHttpRequestOption_UrlEscapeDisableQuery
WinHttpRequestOption_SecureProtocols
WinHttpRequestOption_EnableTracing
WinHttpRequestOption_RevertImpersonationOverSsl
WinHttpRequestOption_EnableHttpsToHttpRedirects
WinHttpRequestOption_EnablePassportAuthentication
WinHttpRequestOption_MaxAutomaticRedirects
WinHttpRequestOption_MaxResponseHeaderSize
WinHttpRequestOption_MaxResponseDrainSize
WinHttpRequestOption_EnableHttp1_1
WinHttpRequestOption_EnableCertificateRevocationCheck
End Enum
Public Function GetUrl(szUrl As String) As String
On Error Resume Next
Dim Timeout As Long
Timeout = 2000 'milliseconds
Dim xhr As Object
Set xhr = CreateObject("WinHttp.WinHttpRequest.5.1")
'https://msdn.microsoft.com/en-us/library/windows/desktop/aa384108(v=vs.85).aspx
xhr.Option(WinHttpRequestOption_EnableRedirects) = True 'true by default
'xhr.Option(WinHttpRequestOption_EnableHttpsToHttpRedirects) = True 'false by default
xhr.SetTimeouts Timeout, Timeout, Timeout, Timeout
If xhr Is Nothing Then Set xhr = CreateObject("MSXML2.ServerXMLHTTP")
If xhr Is Nothing Then Set xhr = CreateObject("Microsoft.XMLHTTP")
If xhr Is Nothing Then Set xhr = CreateObject("WinHttp.WinHttpRequest")
xhr.Open "GET", szUrl, False
xhr.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:60.0) Gecko/20100101 Firefox/60.0"
xhr.setRequestHeader "Content-Type", "text/css" '"application/x-www-form-urlencoded"
'xhr.setRequestHeader "Content-Length", Len(sEntityBody)
On Error GoTo ErrorHandler:
xhr.send 'URLEncode(sEntityBody)
GetUrl = xhr.responseText
Set xhr = Nothing
Exit Function
ErrorHandler:
'ErrorMsg Err, "GetUrl", szUrl
'If inIDE Then Stop: Resume Next
End Function
debug.? GetUrl("https://raw.githubusercontent.com/dragokas/hijackthis/devel/src/HiJackThis-update.txt")
is work.
debug.? GetUrl("https://github.com/dragokas/hijackthis/raw/devel/src/HiJackThis-update.txt")
is not work (return 0x80072F7D).
Public Enum WinHttpRequestOption
WinHttpRequestOption_UserAgentString
WinHttpRequestOption_URL
WinHttpRequestOption_URLCodePage
WinHttpRequestOption_EscapePercentInURL
WinHttpRequestOption_SslErrorIgnoreFlags
WinHttpRequestOption_SelectCertificate
WinHttpRequestOption_EnableRedirects
WinHttpRequestOption_UrlEscapeDisable
WinHttpRequestOption_UrlEscapeDisableQuery
WinHttpRequestOption_SecureProtocols
WinHttpRequestOption_EnableTracing
WinHttpRequestOption_RevertImpersonationOverSsl
WinHttpRequestOption_EnableHttpsToHttpRedirects
WinHttpRequestOption_EnablePassportAuthentication
WinHttpRequestOption_MaxAutomaticRedirects
WinHttpRequestOption_MaxResponseHeaderSize
WinHttpRequestOption_MaxResponseDrainSize
WinHttpRequestOption_EnableHttp1_1
WinHttpRequestOption_EnableCertificateRevocationCheck
End Enum
Public Function GetUrl(szUrl As String) As String
On Error Resume Next
Dim Timeout As Long
Timeout = 2000 'milliseconds
Dim xhr As Object
Set xhr = CreateObject("WinHttp.WinHttpRequest.5.1")
'https://msdn.microsoft.com/en-us/library/windows/desktop/aa384108(v=vs.85).aspx
xhr.Option(WinHttpRequestOption_EnableRedirects) = True 'true by default
'xhr.Option(WinHttpRequestOption_EnableHttpsToHttpRedirects) = True 'false by default
xhr.SetTimeouts Timeout, Timeout, Timeout, Timeout
If xhr Is Nothing Then Set xhr = CreateObject("MSXML2.ServerXMLHTTP")
If xhr Is Nothing Then Set xhr = CreateObject("Microsoft.XMLHTTP")
If xhr Is Nothing Then Set xhr = CreateObject("WinHttp.WinHttpRequest")
xhr.Open "GET", szUrl, False
xhr.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:60.0) Gecko/20100101 Firefox/60.0"
xhr.setRequestHeader "Content-Type", "text/css" '"application/x-www-form-urlencoded"
'xhr.setRequestHeader "Content-Length", Len(sEntityBody)
On Error GoTo ErrorHandler:
xhr.send 'URLEncode(sEntityBody)
GetUrl = xhr.responseText
Set xhr = Nothing
Exit Function
ErrorHandler:
'ErrorMsg Err, "GetUrl", szUrl
'If inIDE Then Stop: Resume Next
End Function
debug.? GetUrl("https://raw.githubusercontent.com/dragokas/hijackthis/devel/src/HiJackThis-update.txt")
is work.
debug.? GetUrl("https://github.com/dragokas/hijackthis/raw/devel/src/HiJackThis-update.txt")
is not work (return 0x80072F7D).
Thanks,
Alex.
Code:
Public Function API_Http(sURL As String, _
sMethod As Method, _
sRequestHeads As String, _
cookie As String, _
sPostData As String)
',
',
'
Dim iRetVal As Integer
Dim sBuffer As String * 1024
Dim lBufferLen As Long
Dim vDllVersion As tWinInetDLLVersion
Dim sStatus As String
Dim sOptionBuffer As String
Dim lOptionBufferLen As Long
Dim SecFlag As Long
Dim dwSecFlag As Long
Dim dwPort As Long
Dim hInternetConnect As Long, hHttpOpenRequest As Long
Dim HttpORhttps As String, sHost As String, sPort As String, sURI As String
Dim bUseSecure As Boolean, lService As Integer
Screen.MousePointer = vbHourglass '
lBufferLen = Len(sPostData)
If m_bbUseProxy = True Then
hInternetSession = InternetOpen(m_StrsUserAgent, INTERNET_OPEN_TYPE_PROXY, "http=" + m_StrsProxyAddress, vbNullString, 0)
Else
hInternetSession = InternetOpen(m_StrsUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
End If
'// select which port should API use (cocus 19-feb-14)
'// parse the url (cocus 19-feb-14)
If Not ParseURL(sURL, HttpORhttps, m_StrUseName, m_StrUsePassword, sHost, sPort, sURI, , "-1") Then
'// error parsing url
Exit Function
End If
Select Case LCase$(HttpORhttps)
Case "http": lService = INTERNET_SERVICE_HTTP
Case "https": lService = INTERNET_SERVICE_HTTP: bUseSecure = True
Case "ftp": lService = INTERNET_SERVICE_FTP
End Select
dwPort = CInt(sPort)
If CBool(hInternetSession) Then
'
InternetQueryOption hInternetSession, INTERNET_OPTION_VERSION, vDllVersion, Len(vDllVersion)
' Debug.Print vDllVersion.lMajorVersion
' Debug.Print vDllVersion.lMinorVersion
' Debug.Print "InternetConnect" '~~~
If bUseSecure = True Then
SecFlag = INTERNET_FLAG_SECURE Or INTERNET_FLAG_IGNORE_CERT_CN_INVALID Or INTERNET_FLAG_IGNORE_CERT_DATE_INVALID
End If
'// select which port should API use (cocus 19-feb-14)
If dwPort = -1 Then
If LCase$(sPort) = "ftp" Then
dwPort = INTERNET_DEFAULT_FTP_PORT
ElseIf bUseSecure Then
dwPort = INTERNET_DEFAULT_HTTPS_PORT
Else
dwPort = INTERNET_DEFAULT_HTTP_PORT
End If
End If
If m_bAutomatiRedirection = True Then 'AutomatiRedirection
SecFlag = INTERNET_FLAG_NO_AUTO_REDIRECT
End If
If m_bNocookieAndcache = True Then
SecFlag = SecFlag Or (INTERNET_FLAG_NO_CACHE_WRITE + INTERNET_FLAG_NO_COOKIES) '
End If
'
hInternetConnect = InternetConnect(hInternetSession, sHost, dwPort, m_StrUseName, m_StrUsePassword, lService, 0, 0)
'hInternetConnect = InternetConnect(hInternetSession, CheckUrl, dwPort, vbNullString, vbNullString, INTERNET_SERVICE_HTTP, 0, 0)
If hInternetConnect > 0 Then '
Debug.Print "HttpOpenRequest" '
If sMethod = 1 Then
sOptionBuffer = vbNullString
lOptionBufferLen = 0
hHttpOpenRequest = HttpOpenRequest(hInternetConnect, "GET", sURI, "HTTP/1.1", vbNullString, 0, INTERNET_FLAG_RELOAD Or SecFlag, 0)
Else
sOptionBuffer = sPostData
lOptionBufferLen = Len(sPostData)
hHttpOpenRequest = HttpOpenRequest(hInternetConnect, "POST", sURI, "HTTP/1.1", vbNullString, 0, INTERNET_FLAG_RELOAD Or SecFlag, 0)
End If
If CBool(hHttpOpenRequest) Then
Debug.Print "HttpSendRequest" '
Debug.Print sOptionBuffer
Dim sHeader As String
If InStr(sRequestHeads, "Accept:") = 0 Then '
sRequestHeads = sRequestHeads + vbCrLf + "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, */*" + vbCrLf
End If
If InStr(sRequestHeads, "Referer:") = 0 Then '
sRequestHeads = sRequestHeads + "Referer: " + sURL + vbCrLf
End If
sHeader = sRequestHeads
sRequestHeads = vbNullString
'
iRetVal = HttpAddRequestHeaders(hHttpOpenRequest, sHeader, Len(sHeader), HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD)
If cookie <> "" Then '
'
cookie = "Cookie: " + cookie + vbCrLf
' szHeaders = szHeaders + Cookie
iRetVal = HttpAddRequestHeaders(hHttpOpenRequest, cookie, Len(cookie), HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD)
End If
'
Dim dwTimeOut As Long
dwTimeOut = m_intTimeOut ' time out is set to 5 minutes
iRetVal = InternetSetOption(hHttpOpenRequest, INTERNET_OPTION_CONNECT_TIMEOUT, dwTimeOut, 4)
Debug.Print iRetVal & " " & Err.LastDllError & " " & "INTERNET_OPTION_CONNECT_TIMEOUT"
iRetVal = InternetSetOption(hHttpOpenRequest, INTERNET_OPTION_RECEIVE_TIMEOUT, dwTimeOut, 4)
Debug.Print iRetVal & " " & "INTERNET_OPTION_RECEIVE_TIMEOUT"
iRetVal = InternetSetOption(hHttpOpenRequest, INTERNET_OPTION_SEND_TIMEOUT, dwTimeOut, 4)
Debug.Print iRetVal & " " & "INTERNET_OPTION_SEND_TIMEOUT"
If sPostData <> "" Then
If InStr(sHeader, "Content-Type:") = 0 Then
sRequestHeads = sRequestHeads + "Content-Type: application/x-www-form-urlencoded" + vbCrLf
End If
sRequestHeads = sRequestHeads + "Content-Length: " + CStr(Len(sPostData)) + vbCrLf
End If
Resend: '
iRetVal = HttpSendRequest(hHttpOpenRequest, sRequestHeads, Len(sRequestHeads), sOptionBuffer, lOptionBufferLen)
If (iRetVal <> 1) And (Err.LastDllError = 12045) Then
MsgBox "Invalid CA"
'
'Certificate Authority is invalid.
Debug.Print "Invalid Cert Auth, resending" & " "
dwSecFlag = SECURITY_FLAG_IGNORE_UNKNOWN_CA
'.
iRetVal = InternetSetOption(hHttpOpenRequest, INTERNET_OPTION_SECURITY_FLAGS, dwSecFlag, 4)
Debug.Print iRetVal & " " & Err.LastDllError & " " & "INTERNET_OPTION_SECURITY_FLAGS"
GoTo Resend
End If
If iRetVal Then
Dim dwStatus As Long, dwStatusSize As Long
dwStatusSize = Len(dwStatus)
HttpQueryInfo hHttpOpenRequest, HTTP_QUERY_FLAG_NUMBER Or HTTP_QUERY_STATUS_CODE, dwStatus, dwStatusSize, 0
If m_bbUseProxyLogin = True And dwStatus = HTTP_STATUS_PROXY_AUTH_REQ Then '
iRetVal = InternetSetOptionStr(hHttpOpenRequest, INTERNET_OPTION_PROXY_USERNAME, m_StrsProxyUser, Len(m_StrsProxyUser) + 1)
iRetVal = InternetSetOptionStr(hHttpOpenRequest, INTERNET_OPTION_PROXY_PASSWORD, m_StrsProxyPass, Len(m_StrsProxyPass) + 1)
GoTo Resend
End If
If m_bUseLogin = True And dwStatus = HTTP_STATUS_DENIED Then '
iRetVal = InternetSetOptionStr(hHttpOpenRequest, INTERNET_OPTION_USERNAME, m_StrUseName, Len(m_StrUseName) + 1)
iRetVal = InternetSetOptionStr(hHttpOpenRequest, INTERNET_OPTION_PASSWORD, m_StrUsePassword, Len(m_StrUsePassword) + 1)
GoTo Resend
End If
Debug.Print "HttpQueryInfo"
'response headers ReturnHeads
Dim lblContentType As String, lblContentLength As String, lblLastModified As String
Dim lblVersion As String, lblStatusCode As String, lblRawHeaders As String, lblStatusText As String
Dim txtRequestHeaders As String
Dim lblForwarded As String, lblServer As String, lblRequestMethod As String, lblPragma As String, lblUserAgent As String, lblRequestMethod2 As String
' GetQueryInfo hHttpOpenRequest, lblContentType, HTTP_QUERY_CONTENT_TYPE
' GetQueryInfo hHttpOpenRequest, lblContentLength, HTTP_QUERY_CONTENT_LENGTH
' GetQueryInfo hHttpOpenRequest, lblLastModified, HTTP_QUERY_LAST_MODIFIED
' GetQueryInfo hHttpOpenRequest, lblVersion, HTTP_QUERY_VERSION
' GetQueryInfo hHttpOpenRequest, lblStatusCode, HTTP_QUERY_STATUS_CODE
' GetQueryInfo hHttpOpenRequest, lblStatusText, HTTP_QUERY_STATUS_TEXT
' GetQueryInfo hHttpOpenRequest, lblRawHeaders, HTTP_QUERY_RAW_HEADERS
GetQueryInfo hHttpOpenRequest, m_StrRequestHeaders, HTTP_QUERY_RAW_HEADERS_CRLF '
' GetQueryInfo hHttpOpenRequest, lblForwarded, HTTP_QUERY_FORWARDED
' GetQueryInfo hHttpOpenRequest, lblServer, HTTP_QUERY_SERVER
' GetQueryInfo hHttpOpenRequest, lblRequestMethod, HTTP_QUERY_REQUEST_METHOD
' GetQueryInfo hHttpOpenRequest, lblPragma, HTTP_QUERY_FLAG_REQUEST_HEADERS + HTTP_QUERY_PRAGMA
' GetQueryInfo hHttpOpenRequest, txtRequestHeaders, HTTP_QUERY_FLAG_REQUEST_HEADERS + HTTP_QUERY_RAW_HEADERS_CRLF
' GetQueryInfo hHttpOpenRequest, lblUserAgent, HTTP_QUERY_FLAG_REQUEST_HEADERS + HTTP_QUERY_USER_AGENT
' GetQueryInfo hHttpOpenRequest, lblRequestMethod2, HTTP_QUERY_FLAG_REQUEST_HEADERS + HTTP_QUERY_REQUEST_METHOD
sStatus = "ok~~~"
If InStr(m_StrRequestHeaders, "Set-Cookie: ") > 0 Then
'ReturnCookies = Cookie(ReturnHeads)
m_StrRequestCookies = LiteCookies(m_StrRequestHeaders)
If m_bSaveCookietoIE = True Then
Dim i As Integer, buff() As String
buff = Split(m_StrRequestCookies, ";")
'InternetSetCookie "http://" + CheckUrl(sURL), "cookie:", ReturnCookies'
For i = 0 To UBound(buff) - 1
InternetSetCookie "http://" + CheckUrl(sURL), Split(buff(i), "=")(0), Split(buff(i), "=")(1) '& ";expires=Sun,22-Feb-2099 00:00:00 GMT;path=/; "
Next
End If
End If
RaiseEvent RequestHeads(sURL, m_StrRequestHeaders)
'
Dim lBytesRead As Long, bBuffer() As Byte, lRead As Long
ReDim bBuffer(0 To CHUNK_SIZE)
Do
InternetReadFile hHttpOpenRequest, bBuffer(0), CHUNK_SIZE, lRead
If lRead Then
ReDim Preserve m_BytReturnBytArry(0 To lBytesRead + lRead - 1&)
CopyMemory m_BytReturnBytArry(lBytesRead), bBuffer(0), lRead
lBytesRead = lBytesRead + lRead
' If lRead < CHUNK_SIZE Then Exit Do
Else
Exit Do
End If
Loop
API_Http = True
RaiseEvent RequestFinished(sURL, m_BytReturnBytArry, lBytesRead)
Else
' HttpSendRequest failed
sStatus = "HttpSendRequest call failed; Error code: " & Err.LastDllError & "."
API_Http = False
RaiseEvent RequestError(sURL, sStatus)
End If
Else
' HttpOpenRequest failed
sStatus = "HttpOpenRequest call failed; Error code: " & Err.LastDllError & "."
API_Http = False
End If
Else
' InternetConnect failed
sStatus = "InternetConnect call failed; Error code: " & Err.LastDllError & "."
API_Http = False
End If
Else
' hInternetSession handle not allocated
sStatus = "InternetOpen call failed: Error code: " & Err.LastDllError & "."
API_Http = False
End If
ReturnStatus = sStatus
Dim bret As Integer
bret = InternetCloseHandle(hHttpOpenRequest)
bret = InternetCloseHandle(hInternetConnect)
bret = InternetCloseHandle(hInternetSession)
Screen.MousePointer = 0 '
End Function
{"given_cipher_suites":["TLS_RSA_WITH_RC4_128_MD5","TLS_RSA_WITH_RC4_128_SHA","TLS_RSA_WITH_3DES_EDE_CBC_SHA","TLS_RSA_WITH_ DES_CBC_SHA","TLS_RSA_EXPORT1024_WITH_RC4_56_SHA","TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA","TLS_RSA_EXP ORT_WITH_RC4_40_MD5","TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5","TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA","TLS_D HE_DSS_WITH_DES_CBC_SHA","TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA"],"ephemeral_keys_supported":true,"session_ticket_supported":false,"tls_compression_supported":false, "unknown_cipher_suite_supported":false,"beast_vuln":true,"able_to_detect_n_minus_one_splitting":fals e,"insecure_cipher_suites":{"TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA":["uses keys smaller than 128 bits in its encryption"],"TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA":["uses 3DES which is vulnerable to the Sweet32 attack but was not configured as a fallback in the ciphersuite order"],"TLS_DHE_DSS_WITH_DES_CBC_SHA":["uses keys smaller than 128 bits in its encryption"],"TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA":["uses keys smaller than 128 bi
ts in its encryption"],"TLS_RSA_EXPORT1024_WITH_RC4_56_SHA":["uses keys smaller than 128 bits in its encryption","uses RC4 which has insecure biases in its output"],"TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5":["uses keys smaller than 128 bits in its encryption"],"TLS_RSA_EXPORT_WITH_RC4_40_MD5":["uses keys smaller than 128 bits in its encryption","uses RC4 which has insecure biases in its output"],"TLS_RSA_WITH_3DES_EDE_CBC_SHA":["uses 3DES which is vulnerable to the Sweet32 attack but was not configured as a fallback in the ciphersuite order"],"TLS_RSA_WITH_DES_CBC_SHA":["uses keys smaller than 128 bits in its encryption"],"TLS_RSA_WITH_RC4_128_MD5":["uses RC4 which has insecure biases in its output"],"TLS_RSA_WITH_RC4_128_SHA":["uses RC4 which has insecure biases in its output"]},"tls_version":"TLS 1.0","rating":"Bad"}
Code:
WINHTTP_OPTION_SECURE_PROTOCOLS
Sets an unsigned long integer value that specifies which secure protocols are acceptable. By default only SSL3 and TLS1 are enabled in Windows 7 and Windows 8. By default only SSL3, TLS1.0, TLS1.1, and TLS1.2 are enabled in Windows 8.1 and Windows 10. The value can be a combination of one or more of the following values.
WINHTTP_OPTION_SECURE_PROTOCOLS
Sets an unsigned long integer value that specifies which secure protocols are acceptable. By default only SSL3 and TLS1 are enabled in Windows 7 and Windows 8. By default only SSL3, TLS1.0, TLS1.1, and TLS1.2 are enabled in Windows 8.1 and Windows 10. The value can be a combination of one or more of the following values.
{"given_cipher_suites":["TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384","TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256","TLS_ECDHE_RSA_WITH_ AES_256_CBC_SHA","TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA","TLS_DHE_RSA_WITH_AES_256_GCM_SHA384","TLS_DHE _RSA_WITH_AES_128_GCM_SHA256","TLS_RSA_WITH_AES_256_GCM_SHA384","TLS_RSA_WITH_AES_128_GCM_SHA256","T LS_RSA_WITH_AES_256_CBC_SHA256","TLS_RSA_WITH_AES_128_CBC_SHA256","TLS_RSA_WITH_AES_256_CBC_SHA","TL S_RSA_WITH_AES_128_CBC_SHA","TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384","TLS_ECDHE_ECDSA_WITH_AES_128_ GCM_SHA256","TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384","TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256","TLS _ECDHE_ECDSA_WITH_AES_256_CBC_SHA","TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA","TLS_DHE_DSS_WITH_AES_256_ CBC_SHA256","TLS_DHE_DSS_WITH_AES_128_CBC_SHA256","TLS_DHE_DSS_WITH_AES_256_CBC_SHA","TLS_DHE_DSS_WI TH_AES_128_CBC_SHA","TLS_RSA_WITH_3DES_EDE_CBC_SHA","TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA","TLS_RSA_WIT H_RC4_128_SHA","TLS_RSA_WITH_RC4_128_MD5"],"ephemeral_keys_supported":true,"session_ticket_supporte
d":false,"tls_compression_supported":false,"unknown_cipher_suite_supported":false,"beast_vuln":false ,"able_to_detect_n_minus_one_splitting":false,"insecure_cipher_suites":{"TLS_DHE_DSS_WITH_3DES_EDE_C BC_SHA":["uses 3DES which is vulnerable to the Sweet32 attack but was not configured as a fallback in the ciphersuite order"],"TLS_RSA_WITH_3DES_EDE_CBC_SHA":["uses 3DES which is vulnerable to the Sweet32 attack but was not configured as a fallback in the ciphersuite order"],"TLS_RSA_WITH_RC4_128_MD5":["uses RC4 which has insecure biases in its output"],"TLS_RSA_WITH_RC4_128_SHA":["uses RC4 which has insecure biases in its output"]},"tls_version":"TLS 1.2","rating":"Bad"}
Last edited by xxdoc123; Jun 6th, 2018 at 08:49 PM.
Const WINHTTP_FLAG_SECURE_PROTOCOL_SSL2 As Long = &H8&
Const WINHTTP_FLAG_SECURE_PROTOCOL_SSL3 As Long = &H20&
Const WINHTTP_FLAG_SECURE_PROTOCOL_TLS1 As Long = &H80&
Const WINHTTP_FLAG_SECURE_PROTOCOL_TLS1_1 As Long = &H200&
Const WINHTTP_FLAG_SECURE_PROTOCOL_TLS1_2 As Long = &H800&
Const WINHTTP_FLAG_SECURE_PROTOCOL_ALL As Long = (WINHTTP_FLAG_SECURE_PROTOCOL_SSL2 Or _
WINHTTP_FLAG_SECURE_PROTOCOL_SSL3 Or _
WINHTTP_FLAG_SECURE_PROTOCOL_TLS1)
xhr.Option(WinHttpRequestOption_SecureProtocols) = WINHTTP_FLAG_SECURE_PROTOCOL_TLS1_2
Last edited by DEXWERX; Jun 7th, 2018 at 09:18 AM.
Can you, please, also give me your ParseURL(), CheckUrl(), LiteCookies() parsers?
Code:
Private Function ParseURL(ByVal sURL As String, _
ByRef sProtocol As String, _
ByRef sUser As String, _
ByRef sPassword As String, _
ByRef sHost As String, _
ByRef sPort As String, _
ByRef sURI As String, _
Optional ByVal sDefaultProtocol As String = "http", _
Optional ByVal sDefaultPort As String = "80") As Boolean
Dim iProtocolDelimiter As Integer
Dim iLoginDelimiter As Integer
Dim iLoginPass As Integer
Dim iHostDelimiter As Integer
Dim iHostPort As Integer
Dim sTemp As String
'// obtain the protocol delimiter
iProtocolDelimiter = InStr(1, sURL, "://") - 1
If iProtocolDelimiter = -1 Then
sProtocol = sDefaultProtocol
Else
sProtocol = Left$(sURL, iProtocolDelimiter)
'// trim out the protocol
sURL = Right$(sURL, Len(sURL) - iProtocolDelimiter - 3)
End If
'// obtain the user & pass
iLoginDelimiter = InStr(1, sURL, "@") - 1
If Not (iLoginDelimiter = -1) Then
sTemp = Left$(sURL, iLoginDelimiter)
iLoginPass = InStr(1, sTemp, ":") - 1
If Not (iLoginPass = -1) Then
sUser = Left$(sTemp, iLoginPass)
sPassword = Right$(sTemp, Len(sTemp) - iLoginPass - 1)
Else
sUser = sTemp
End If
'// trim out the login
sURL = Right$(sURL, Len(sURL) - iLoginDelimiter - 1)
End If
'// obtain the host
iHostDelimiter = InStr(1, sURL, "/") - 1
If iHostDelimiter = -1 Then
'// ***?
If Len(sURL) = 0 Then
Exit Function
End If
sTemp = sURL
sURL = ""
sPort = sDefaultPort
Else
sTemp = Left$(sURL, iHostDelimiter)
'// trim out the host
sURL = Right$(sURL, Len(sURL) - iHostDelimiter)
End If
'// grab the host and its port
iHostPort = InStr(1, sTemp, ":") - 1
If iHostPort = -1 Then
sHost = sTemp
sPort = sDefaultPort
Else
sHost = Left$(sTemp, iHostPort)
sPort = Right$(sTemp, Len(sTemp) - iHostPort - 1)
End If
If Len(sURL) = 0 Then
sURI = "/"
Else
sURI = sURL
End If
ParseURL = True
End Function
Code:
Private Function CheckUrl(ByVal txtURL As String) As String
'urHost: translate.google.cn
If Right$(txtURL, 1) = "/" Then
txtURL = Mid$(txtURL, 1, Len(txtURL) - 1)
End If
txtURL = Replace(txtURL, "http://", "")
If Len(txtURL) = 0 Then txtURL = "www.microsoft.com"
Dim posSlash As Long
posSlash = InStr(txtURL, "/")
If InStr(txtURL, "/") <> 0 Then
CheckUrl = Left(txtURL, InStr(txtURL, "/") - 1)
Else
CheckUrl = txtURL
End If
End Function
Code:
Public Function LiteCookies(cookies As String) As String
Dim rStr As String
Dim reg As Object
Dim matchs As Object, match As Object
cookies = Replace$(cookies, ";HttpOnly", ";", , , vbTextCompare)
cookies = Replace$(cookies, vbCrLf, ";" & vbCrLf)
cookies = Replace$(cookies, ";;", ";")
cookies = Replace$(cookies, ";", "; ")
Set reg = CreateObject("vbscript.regExp")
reg.Global = True
reg.IgnoreCase = True
reg.MultiLine = True
reg.Pattern = "Set-Cookie: (.+?);"
Set matchs = reg.Execute(cookies)
For Each match In matchs
'Debug.Print match.Value
' Debug.Print match.SubMatches(0)
rStr = GetCleanCookie(rStr, match.SubMatches(0) & ";")
Next
LiteCookies = rStr
End Function
My code logic is not very good, I hope you find it useful, and it can be modified to be more perfect
tips:In addition: Many people say wininet APi is outdated technology, I think it should be better with winhttp, or winsock (i tested is ok). Look forward to your better suggestions
Last edited by xxdoc123; Jun 9th, 2018 at 01:34 AM.
Ahh, found simplier: your HttpQueryInfo() + HTTP_QUERY_FLAG_NUMBER Or HTTP_QUERY_STATUS_CODE returns 404, (or 200 if everything is ok). Exactly what I need.
Public Enum WinHttpRequestOption
WinHttpRequestOption_UserAgentString
WinHttpRequestOption_URL
WinHttpRequestOption_URLCodePage
WinHttpRequestOption_EscapePercentInURL
WinHttpRequestOption_SslErrorIgnoreFlags
WinHttpRequestOption_SelectCertificate
WinHttpRequestOption_EnableRedirects
WinHttpRequestOption_UrlEscapeDisable
WinHttpRequestOption_UrlEscapeDisableQuery
WinHttpRequestOption_SecureProtocols
WinHttpRequestOption_EnableTracing
WinHttpRequestOption_RevertImpersonationOverSsl
WinHttpRequestOption_EnableHttpsToHttpRedirects
WinHttpRequestOption_EnablePassportAuthentication
WinHttpRequestOption_MaxAutomaticRedirects
WinHttpRequestOption_MaxResponseHeaderSize
WinHttpRequestOption_MaxResponseDrainSize
WinHttpRequestOption_EnableHttp1_1
WinHttpRequestOption_EnableCertificateRevocationCheck
End Enum
Public Function GetUrl(szUrl As String) As String
On Error Resume Next
Dim Timeout As Long
Timeout = 2000 'milliseconds
Dim xhr As Object
Set xhr = CreateObject("WinHttp.WinHttpRequest.5.1")
'https://msdn.microsoft.com/en-us/library/windows/desktop/aa384108(v=vs.85).aspx
xhr.Option(WinHttpRequestOption_EnableRedirects) = True 'true by default
'xhr.Option(WinHttpRequestOption_EnableHttpsToHttpRedirects) = True 'false by default
xhr.SetTimeouts Timeout, Timeout, Timeout, Timeout
If xhr Is Nothing Then Set xhr = CreateObject("MSXML2.ServerXMLHTTP")
If xhr Is Nothing Then Set xhr = CreateObject("Microsoft.XMLHTTP")
If xhr Is Nothing Then Set xhr = CreateObject("WinHttp.WinHttpRequest")
xhr.Open "GET", szUrl, False
xhr.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:60.0) Gecko/20100101 Firefox/60.0"
xhr.setRequestHeader "Content-Type", "text/css" '"application/x-www-form-urlencoded"
'xhr.setRequestHeader "Content-Length", Len(sEntityBody)
On Error GoTo ErrorHandler:
xhr.send 'URLEncode(sEntityBody)
GetUrl = xhr.responseText
Set xhr = Nothing
Exit Function
ErrorHandler:
'ErrorMsg Err, "GetUrl", szUrl
'If inIDE Then Stop: Resume Next
End Function
debug.? GetUrl("https://raw.githubusercontent.com/dragokas/hijackthis/devel/src/HiJackThis-update.txt")
is work.
debug.? GetUrl("https://github.com/dragokas/hijackthis/raw/devel/src/HiJackThis-update.txt")
is not work (return 0x80072F7D).
Thanks,
Alex.
I tried your code .. it worked.
I managed to read a file on Dropbox.
What I want is to work with this HttpHelps class.
can you give an example please ..