从 USPS.com 获取 Zip+4 代码

• 下载源代码 - 40 Kb

引言

我必须首先强调，这仅用于教育目的！！ 好了，现在我把话说清楚了。

这个项目的目的是演示如何从网站提取数据。

让我们直接进入好的部分……代码！

代码

第一步是使用所有必需的信息格式化 URL。

Function ReplaceSpaceWithPlusSign(ByVal vStr As String) As String
    Dim strTemp As String
    Try
        strTemp = Replace(vStr, vbTab, " ")
        strTemp = Replace(strTemp, vbCr, " ")
        strTemp = Replace(strTemp, vbLf, " ")
        strTemp = Replace(strTemp, " ", "+")
        ' Remove leading and trailing spaces
        strTemp = Trim(strTemp)
        Return strTemp
    Catch ex As Exception
        MsgBox("Function: ReplaceSpaceWithPlusSign" + vbCrLf + "Message: " + ex.Message, MsgBoxStyle.Critical, "Error")
    End Try
End Function

strAdd = ReplaceSpaceWithPlusSign(txtAddress.Text)
strCity = ReplaceSpaceWithPlusSign(Trim(txtCity.Text))
strState = ReplaceSpaceWithPlusSign(cmbState.Text)
'USPS web address
urlStr = "http://zip4.usps.com/zip4/zcl_0_results.jsp?visited=1&pagenumber=0&firmname=&address2=" _
           + strAdd + "&address1=&city=" + strCity + "&state=" + strState + "&urbanization=&zip5=&submit.x=6&submit.y=15"

现在你已经有了正确格式化的 URL，将其传递给一个函数来读取网站的源代码。

Public Function ReadWebSite(ByVal URL As String) As String
    Dim req As HttpWebRequest
    Dim res As HttpWebResponse
    Dim strContents As String
    Dim StrStream As Stream
    Dim Cok As Cookie
    Dim oWebResponse As WebResponse
    Dim oReturnStream As Stream
    Dim oReturnStreamReader As StreamReader
    Dim myReq As HttpWebRequest
    Dim myResponse As HttpWebResponse
    
    req = Nothing
    res = Nothing
    strContents = Nothing
    StrStream = Nothing
    Cok = Nothing
    oWebResponse = Nothing
    oReturnStream = Nothing
    oReturnStreamReader = Nothing
    myReq = Nothing
    myResponse = Nothing
Try
'***********************************************************************************************
' Connects to web site and gets cookie
'*********************************************************************************************** 
    myReq = DirectCast(WebRequest.Create(URL), HttpWebRequest)
    myReq.CookieContainer = New CookieContainer
    myResponse = DirectCast(myReq.GetResponse, HttpWebResponse)
    myResponse.Cookies = myReq.CookieContainer.GetCookies(myReq.RequestUri)
 
    If myResponse.Cookies.Count > 0 Then
        Cok = myResponse.Cookies(0)
    Else
        Cok = Nothing
    End If
'***********************************************************************************************
'***********************************************************************************************
' Constucts html request
'*********************************************************************************************** 
    req = DirectCast(WebRequest.Create(URL), HttpWebRequest)
    req.Accept = "*/*"
    req.ContentType = "application/x-www-form-urlencoded"
    req.AllowAutoRedirect = True
    req.UserAgent = "Mozilla/4.0 (compatible;" + " MSIE 6.0; Windows NT 5.0; .NET CLR 1.0.3705)"
    req.ContentType = "application/x-www-form-urlencoded" '"text/html"
    If Not Cok Is Nothing Then
        req.CookieContainer = New CookieContainer
        req.CookieContainer.Add(Cok)
    End If
'***********************************************************************************************
'***********************************************************************************************
' Retrieves HTML Response
'*********************************************************************************************** 
    oWebResponse = req.GetResponse()
    oReturnStream = oWebResponse.GetResponseStream()
    oReturnStreamReader = New StreamReader(oReturnStream)
    strContents = oReturnStreamReader.ReadToEnd().Trim()
    oReturnStreamReader.Close()
    myResponse.Close()
    Return strContents
Catch ex As Exception
    If UCase(ex.Message) = UCase("The operation has timed-out.") Then
        MsgBox("Please try again" + vbCrLf + "Postal service website timed-out.", MsgBoxStyle.Information, "Website timed-out")
        Return ""
    ElseIf UCase(ex.Message) = UCase("The remote server returned an error: (500) Internal Server Error.") Then
        MsgBox("Please try again" + vbCrLf + "Postal service website returned an Internal Error.", MsgBoxStyle.Information, "Internal Error")
        Return ""
    ElseIf UCase(ex.Message) = UCase("Thread was being aborted.") Or UCase(ex.Message) = UCase("Thread was being aborted") Then
    'Do nothing
    Else
        MsgBox("Function: ReadWebSite" + vbCrLf + "Message: " + ex.Message, MsgBoxStyle.Critical, "Error")
        Return ""
    End If
End Try
'***********************************************************************************************
End Function

现在你有了源代码，将其传递给另一个使用正则表达式查找邮政编码的函数。

Public Function GetZipCodeFromWeb(ByVal str As String) As String
    Dim RemoveNonDigits As String
    'Removes all none digits
    Dim r1 As Regex = New Regex("[^\d]")
    'String format on usps.com's web site
    Dim r12 As Regex = New Regex("(\d{5})-(\d{4})")
    'Finds all digits
    Dim r13 As Regex = New Regex("\d\d\d\d\d\d\d\d\d")
    If str <> "" Then
        Dim m14 As MatchCollection = r12.Matches(str)
        Dim lstr As String
    Try
        If m14(1).Success Then
            RemoveNonDigits = r1.Replace(m14(1).ToString, "")
            If RemoveNonDigits <> "" Then
                Dim m15 As Match = r13.Match(RemoveNonDigits)
                If m15.Success Then
                    Return Convert.ToString(Regex.Replace(m15.ToString, "(\d{5})(\d{4})", "$1-$2"))
                Else
                    Return "1"
                End If
            Else
                Return "1"
            End If
        Else
            Return "1"
        End If
    Catch ex As Exception
        If ex.TargetSite Is Nothing Then
            'Do nothing
            Return "1"
        Else
            MsgBox("Function: GetZipCodeFromWeb" + vbCrLf + "Message: " + ex.Message, MsgBoxStyle.Critical, "Error")
            Return "1"
        End If
    End Try
      Else
   Return "1"
End If
End Function

就这些了！！