Using VB and WinHTTP.WinHTTPrequest.5.1, I need to automate the download of a binary file for users that resides on a network share, requiring SSO authentication, without hardcoding or requiring a user to enter their password.
I have been reviewing solutions on the web for awhile now and the following VB is the closest I've gotten. I am having problems with the multiple redirects, which I am downloading instead of the file.
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
Response Headers
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
Resultant download is still a WSSO redirect page not the file.
<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>
