I've acquires an old VBScript that was used to retrived test score that I'm trying to convert to a VB.net Form app. I'm stuck with this function
Function getit()
Dim xmlhttp
Dim pageNum
Dim objStream
Dim objDebugStream
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = 1 'adTypeBinary
pageNum = 1
Do While pageNum > 0
Set xmlhttp=CreateObject("MSXML2.ServerXMLHTTP")
'strURL = DownloadDest
Wscript.Echo "Download-URL: " & strURL & "&page_num=" & pageNum
'For basic auth, use the line below together with user+pass variables above
xmlhttp.Open "GET", strURL & "&page_num=" & pageNum, false
xmlhttp.Send
Wscript.Echo "Download-Status: " & xmlhttp.Status & " " & xmlhttp.statusText
If xmlhttp.Status = 200 Then
If Left(LCase(xmlhttp.responseText),16) <> "no records found" Then
If objStream.State = 0 Then
objStream.Open
End If
objStream.Write xmlhttp.responseBody
If debugEachPage Then
Set objDebugStream = CreateObject("ADODB.Stream")
objDebugStream.Type = 1 'adTypeBinary
objDebugStream.Open
objDebugStream.Write xmlhttp.responseBody
objDebugStream.SaveToFile ".\sortest_aleks_" & classCode & "_page_" & pageNum & ".csv"
objDebugStream.Close
Set objDebugStream = Nothing
End If
Else
If pageNum = 1 Then
WScript.Echo "No Records Found for " & classCode
End If
pageNum = 0 ' Have to set this to exit loop
End If
Else
WScript.Echo "Response Status of " & xmlhttp.Status & " for " & classCode
End If
If pageNum <> 0 Then
pageNum = pageNum + 1
End If
Set xmlhttp=Nothing
Loop
If objStream.State <> 0 Then
objStream.SaveToFile LocalFile
objStream.Close
End If
Set objStream = Nothing
What I wrote looks like this
Private Sub GetALEKSData(ByVal strURL As String)
REM ======================================================================================================
' This Module will access the ALEKS Web Site and access the CofC foreign language scores for the terms indicated days
' The Comma Seperated Values (CSV) as then stored in the main form Text Box
'=========================================================================================================
Dim ALEKStr As System.IO.Stream = Nothing
Dim srRead As System.IO.StreamReader = Nothing
Try
'Create a WebReq for the URL
Dim WebReq As System.Net.WebRequest = System.Net.HttpWebRequest.Create(strURL)
'If required by the server, set the credentials.
WebReq.Credentials = CredentialCache.DefaultNetworkCredentials
'Get the Respponse.
Dim WebResp As System.Net.WebResponse = WebReq.GetResponse
' Display the status.
' If required by the server, set the credentials.
ALEKStr = WebResp.GetResponseStream
srRead = New System.IO.StreamReader(ALEKStr)
' read all the text
TextBox1.Text = srRead.ReadToEnd
Catch ex As Exception
TextBox1.Text = QQ REM Wipe Text box to indicate No DATA to Process
Finally
' Close Stream and StreamReader when done
srRead.Close()
ALEKStr.Close()
End Try
Debug.Print(TextBox1.Text)
REM Remove NO Data message
If InStr(TextBox1.Text, "No records match criteria.") > 0 Then TextBox1.Text = QQ
DataFileHasData = Len(TextBox1.Text) > 0
It is returning with :Access denied: wrong3 HTTP header from
Not sure what I'm missing
Try this:
Private Sub GetALEKSData(ByVal strURL As String)
REM ======================================================================================================
' This Module will access the ALEKS Web Site and access the CofC foreign language scores for the terms indicated days
' The Comma Seperated Values (CSV) as then stored in the main form Text Box
'=========================================================================================================
Using wc As New System.Net.WebClient()
Try
wc.Credentials = CredentialCache.DefaultNetworkCredentials
TextBox1.Text = wc.DownloadString(strURL)
Catch
TextBox1.Text = QQ
End Try
End Using
Debug.Print(TextBox1.Text)
If TextBox1.Text.Contains("No records match criteria.") Then TextBox1.Text = QQ
DataFileHasData = Not String.IsNullorWhiteSpace(TextBox1.Text)
End Sub
And if that doesn't work, the error message says, "Access Denied", so the problem is probably this line:
wc.Credentials = CredentialCache.DefaultNetworkCredentials
If that still doesn't help, install fiddler and compare the HTTP requests sent by the old vbscript to the new VB.Net code. You'll be able to see exactly what you're missing.
Setting the UserAgent fixed the issue Private Sub GetWEBData(ByVal strURL As String) REM ====================================================================================================== ' This Module will access the WEB Web Site and access the CofC foreign language scores for the terms indicated days ' The Comma Seperated Values (CSV) as then stored in the main form Text Box '========================================================================================================= 'Clear existing data
Try
'Create a WebReq for the URL
Dim WebReq As HttpWebRequest = CType(WebRequest.Create(strURL), HttpWebRequest)
'If required by the server, set the credentials.
WebReq.Credentials = CredentialCache.DefaultNetworkCredentials
WebReq.UserAgent = "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/41.0.2228.0 Safari/537.36"
'Get the Respponse.
'Dim WebResp As System.Net.WebResponse = WebReq.GetResponse
Dim WebResp As HttpWebResponse = CType(WebReq.GetResponse(), HttpWebResponse)
' Display the status.
' Console.WriteLine(WebResp.StatusDescription)
' Open the stream using a StreamReader for easy access.
Dim WEBtream As Stream = WebResp.GetResponseStream()
' Open the stream using a StreamReader for easy access.
Dim srRead As New StreamReader(WEBtream)
' Read the content.
Dim responseFromServer As String = srRead.ReadToEnd()
' Display the content.
TextBox1.Text = responseFromServer
TextBox1.Refresh()
'Console.WriteLine(responseFromServer)
' Cleanup the streams and the response.
srRead.Close()
WEBtream.Close()
WebResp.Close()
Catch ex As Exception
MsgBox("WEB DATA READ ERROR OCCURED", MsgBoxStyle.Critical, "Program Error")
End Try
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.