0

使用 VB 和 WinHTTP.WinHTTPrequest.5.1，我需要为驻留在网络共享上的用户自动下载二进制文件，需要 SSO 身份验证，无需硬编码或要求用户输入密码。

我已经在网上审查了一段时间的解决方案，下面的 VB 是我得到的最接近的。我在下载多个重定向而不是文件时遇到问题。

Public Sub download_SCData_test()
On Error GoTo err_me
Dim fData '() As Byte
Dim count As Long
Dim fileNum As Long
Dim ado_strm As Object
Dim winHTTP As New winHTTP.WinHttpRequest
Dim destPath As String
Dim destPath2 As String
Dim fileURL As String
Dim mainURL1 As String
Dim mainURL2 As String

' HttpRequest SetCredentials flags
' It might also be necessary to supply credentials to the proxy if you connect to the Internet through a proxy that requires authentication.
Const CREDENTIALS_FOR_SERVER = 0
Const CREDENTIALS_FOR_PROXY = 1
Const HTTPREQUEST_PROXYSETTING_PROXY = 2


mainURL1 = "http://wsso.someplace.on.the.web:XXXX/redirect.html?URL=https://someplace.on.the.web/quality/data_metrics/mac/"
mainURL2 = "http://wsso.someplace.on.the.web:XXXX/redirect.html?URL=https://someplace.on.the.web/quality/data_metrics/mac/"

'fileURL = "http://wsso.someplace.on.the.web:XXXX/redirect.html?URL=https://someplace.on.the.web/quality/data_metrics/mac/data.xlsb"
fileURL = "\\serverXXX\webdata\quality\data_metrics\mac\data.xlsb"

destPath = "C:\Temp\data.xlsb"
destPath2 = "C:\Temp\data2.xlsb"

With winHTTP
    .SetProxy proxysetting:=HTTPREQUEST_PROXYSETTING_PROXY, ProxyServer:="wsso.someplace.on.the.web:XXXX", BypassList:="*.someplace.on.the.web"

    .Option(Option:=WinHttpRequestOption_SslErrorIgnoreFlags) = 13056
    .Option(Option:=WinHttpRequestOption_MaxAutomaticRedirects) = 20 'default 10
    .Option(Option:=WinHttpRequestOption_EnableHttpsToHttpRedirects) = True
    .Option(Option:=WinHttpRequestOption_EnableRedirects) = True
    .Option(Option:=WinHttpRequestOption_RevertImpersonationOverSsl) = True

    .SetTimeouts 30000, 30000, 30000, 30000 'ms - resolve, connect, send, receive

    ' Send a request to the server and wait for a response.
    'POST authentication string to the main website address not to the direct file address
    .Open Method:="POST", URL:=mainURL1, async:=False

    '.SetCredentials UserName:="server\user", Password:="pass", Flags:=CREDENTIALS_FOR_SERVER ' this line has no effect

    'strAuthenticate = "start-url=%2F&user=" & myuser & "&password=" & mypass & "&switch=Log+In"

    .setRequestHeader Header:="Content-Type", Value:="application/x-www-form-urlencoded"
    .setRequestHeader Header:="Date", Value:=Date

    .send   'body:=strAuthenticate
    If Not .WaitForResponse(TimeOut:=30000) Then MsgBox "timeout!": GoTo exit_me

    Sleep 2000

    .Open Method:="POST", URL:=mainURL2, async:=False
    .send   'body:=strAuthenticate
    If Not .WaitForResponse(TimeOut:=30000) Then MsgBox "timeout!": GoTo exit_me

    Sleep 2000

    .Open Method:="GET", URL:=fileURL, async:=True
    .send

    If Not .WaitForResponse(TimeOut:=30000) Then MsgBox "timeout!": GoTo exit_me

    Sleep 2000

    Do While InStr(1, .responseText, "function WSSORedirect()", vbTextCompare)
        Sleep 2000
        count = count + 1: If count > 2 Then Exit Do

        Debug.Print InStr(1, .responseText, "function WSSORedirect()", vbTextCompare)

        If InStr(1, .responseText, "function WSSORedirect()", vbTextCompare) < 1 Then MsgBox "any luck?"

        .Open Method:="GET", URL:=fileURL, async:=True
        .send
        If Not .WaitForResponse(TimeOut:=30000) Then MsgBox "timeout!": GoTo exit_me


        Debug.Print count
        Sleep 2000
    Loop

    Sleep 2000

    fData = .responseBody

    ' Display the results of the request.
    Debug.Print "Credentials: "
    Debug.Print .Status & "   " & .StatusText
    Debug.Print .getAllResponseHeaders
End With


If Dir(destPath) <> vbNullString Then Kill destPath

fileNum = FreeFile
Open destPath For Binary Access Write As #fileNum
Put #fileNum, 1, fData
Close #fileNum


If Dir(destPath2) <> vbNullString Then Kill destPath2

Set strm = CreateObject("ADODB.Stream")
With strm
    .Type = 1
    .Open
    .Write winHTTP.responseBody
    .SaveToFile destPath2, 2 'overwrite
End With

MsgBox "Completed. Check 'C:\Temp\'.", vbInformation, "execution completed"
exit_me:
On Error Resume Next
Set winHTTP = Nothing
Exit Sub
eerr_me:
Err.clear
Resume Next
End Sub

响应标头

Credentials: 
200   OK
Connection: Keep-Alive
Date: Sun, 21 Feb 2016 22:52:06 GMT
Keep-Alive: timeout=15, max=495
Content-Length: 1975
Content-Type: text/html
Last-Modified: Fri, 17 Aug 2012 17:01:12 GMT
Accept-Ranges: bytes
ETag: "XXXXXX-XXX-XXXXXXXXXXXXX"
Server: Apache/X.X.XX (Unix) mod_ssl/X.X.XX OpenSSL/X.X.XX XXX/X

结果下载仍然是 WSSO 重定向页面而不是文件。

<html>
<head>
<script language="javascript" type="text/javascript">
WSSORedirect();

function WSSORedirect() {
    var destinationURL = window.location.search;
    if (destinationURL.substring(0, 5).toUpperCase() != "?URL=") {
        destinationURL = "";
    }
    else {
        destinationURL = destinationURL.substring(5, destinationURL.length);
    }

    if (destinationURL == "") {
        document.writeln("redirect.html error - no URL.  Usage: redirect.html?URL=[destination URL]");
        document.close();
        return;
    }

    location.replace(destinationURL);
}
</script>
</head>
</html>
4

0 回答 0