简体   繁体   中英

VB Script to vb.net

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

End Function

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

End Sub

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM