gpt4 book ai didi

VBA setRequestHeader "Authorization"失败

转载 作者:可可西里 更新时间:2023-11-01 17:28:10 30 4
gpt4 key购买 nike

我正在尝试使用以下代码连接到 Web 数据库,但在 VBA 中自动化时它似乎不起作用。登录名和密码很好,因为我可以手动连接它们。

对象:“WinHttp.WinHttpRequest.5.1”是否可能不适用于这种数据库连接?还是我的 Connect sub 中缺少参数?对此事的任何帮助将不胜感激。

Sub Connect()

Dim oHttp As Object
Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
Call oHttp.Open("GET", "http://qrdweb/mg/loan/loans.html?show=all", False)

oHttp.setRequestHeader "Content-Type", "application/xml"
oHttp.setRequestHeader "Accept", "application/xml"
oHttp.setRequestHeader "Authorization", "Basic " + Base64Encode("login123" + ":" + "pass123")


Call oHttp.send

Sheets("Sheet1").Cells(1, 1).Value = oHttp.getAllResponseHeaders
Sheets("Sheet1").Cells(1, 2).Value = oHttp.ResponseText

End Sub

Private Function Base64Encode(sText)
Dim oXML, oNode
Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
Set oNode = oXML.createElement("base64")
oNode.DataType = "bin.base64"
oNode.nodeTypedValue = StringToBinary(sText)


Base64Encode = oNode.Text
Set oNode = Nothing
Set oXML = Nothing
End Function

Private Function StringToBinary(Text)
Const adTypeText = 2
Const adTypeBinary = 1

Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")

BinaryStream.Type = adTypeText
BinaryStream.Charset = "us-ascii"
BinaryStream.Open
BinaryStream.WriteText Text

'Change stream type To binary
BinaryStream.Position = 0
BinaryStream.Type = adTypeBinary

'Ignore first two bytes - sign of
BinaryStream.Position = 0

StringToBinary = BinaryStream.Read

Set BinaryStream = Nothing
End Function

显示 getAllresponseHeaders 的 oHttp.getAllResponseHeaders 输出以下信息:

缓存控制:必须重新验证,无缓存,无存储

连接:保持活跃

日期:2017 年 2 月 24 日星期五 17:19:54 GMT

内容长度:30633

内容类型:text/html;charset=ISO-8859-1

服务器:nginx/1.11.6

WWW-Authenticate: Digest realm="QRDWEB-MNM", domain="", nonce="aB5DLmvuCfok9Zo112jo4S0evgOuXntE", algorithm=MD5, qop="auth", stale=true

当显示 ResponseText 的 oHttp.ResponseText 输出以下信息时:

<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"/>
<title>Error 401 Server Error</title>
</head>
<body>

编辑1

当我注释掉包含 oHttp.setRequestHeader 的 3 行代码并更改该行时:Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1") by Set oHttp = CreateObject("MSXML2.XMLHTTP"), a弹出窗口显示登录名和密码。如果我填写信息,以下响应是不同的:

显示 getAllresponseHeaders 的 oHttp.getAllResponseHeaders 输出以下信息:

服务器:nginx/1.11.6

日期:2017 年 2 月 24 日星期五 18:19:02 GMT

传输编码:分块

连接:保持活跃

当显示 ResponseText 的 oHttp.ResponseText 输出以下信息时:

<html>

<head>

<title>M&M - Loan Viewer</title>

<script language="javascript" type="text/javascript">

function showTransactionComments(loanId, date, type, commentsTableWidth) {

//alert(loanId + " " + date + " " + type + " " + commentsTableWidth);
if (window.ActiveXObject) {
return;

编辑2

我现在正尝试使用以下子程序将摘要式身份验证集成到 VBA 中,我得到两种可能的结果:第一个结果是使用错误的登录信息时出现相同的 401 错误,并且立即返回。但是,当我提供正确的登录信息时,操作超时...可能是什么原因造成的?

Sub digest()
Dim http As New WinHttpRequest
Dim strResponse As String

Set http = New WinHttpRequest

http.Open "GET", "http://qrdweb/mg/loan/loans.html?show=all", False
http.SetCredentials "login123", "pass123", HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
http.send

Sheets("Sheet1").Cells(1, 1).Value = http.getAllResponseHeaders
Sheets("Sheet1").Cells(1, 2).Value = http.ResponseText

http.Open "PROPFIND", "http://qrdweb/mg/loan/loans.html?show=all", False
http.send

End Sub

最佳答案

根据 Microsoft docs ,JScript 示例,看起来身份验证需要同一连接上的两个连续的 Open/Send 对。第一个告诉 HTTP 请求对象需要摘要式身份验证,第二个实际执行。试试这个(未测试):

Sub digest()
Dim http As WinHttpRequest ' *** Not "New" - you do it below
Dim strResponse As String

Set http = New WinHttpRequest

http.Open "GET", "http://qrdweb/mg/loan/loans.html?show=all", False
http.Send ' *** Try it without authentication first

if http.Status <> 401 then Exit Sub ' *** Or do something else

http.Open "GET", "http://qrdweb/mg/loan/loans.html?show=all", False
' *** Another Open, same as the JScript example

http.SetCredentials "login123", "pass123", HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
http.Send

MsgBox CStr(http.Status) & ": " & http.StatusText ' *** Just to check

Sheets("Sheet1").Cells(1, 1).Value = http.getAllResponseHeaders
Sheets("Sheet1").Cells(1, 2).Value = http.ResponseText

' *** Not sure what these two lines are for --- I have commented them out
'http.Open "PROPFIND", "http://qrdweb/mg/loan/loans.html?show=all", False
'http.send

End Sub

关于VBA setRequestHeader "Authorization"失败,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/42444795/

30 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com