個人記事

    'httpsend_get("http://www.zzip.com.cn/?id=12")
    Function httpsend_get(ByVal geturl As String) As String
        Dim myHttpWebRequest As System.Net.HttpWebRequest
        Dim myHttpWebResponse As System.Net.HttpWebResponse
        Try

            Dim URL As String = geturl
            Dim myUri As Uri = New Uri(geturl)
            Dim myWebRequest As System.Net.WebRequest = System.Net.WebRequest.Create(URL)
            myHttpWebRequest = CType(myWebRequest, System.Net.HttpWebRequest)
            myHttpWebRequest.KeepAlive = True
            myHttpWebRequest.Timeout = 300000
            myHttpWebRequest.Method = "GET"
            Dim myWebResponse As System.Net.WebResponse = myHttpWebRequest.GetResponse()

            '獲得響應信息
            myHttpWebResponse = CType(myWebResponse, System.Net.HttpWebResponse)
            Dim iStatCode As Integer = CInt(myHttpWebResponse.StatusCode)
            myHttpWebRequest = CType(myWebRequest, System.Net.HttpWebRequest)
            myHttpWebResponse = CType(myWebResponse, System.Net.HttpWebResponse)
            Dim myStream As System.IO.Stream = myHttpWebResponse.GetResponseStream()
            Dim srReader As System.IO.StreamReader = New System.IO.StreamReader(myStream, System.Text.Encoding.Default)


            Dim sTemp As String = srReader.ReadToEnd()
            httpsend_get = sTemp

            srReader.Close()
            myStream.Close()
            myWebResponse.Close()
            myWebRequest.Abort()
        Catch WebExcp As System.Net.WebException

            'Response.Write(Replace(WebExcp.Message.ToString(), "The remote server returned an error: (500) Internal Server Error.", "服務器出現故障無法連接"))

            httpsend_get = Replace(WebExcp.Message.ToString(), "The remote server returned an error: (500) Internal Server Error.", "服務器出現故障無法連接")

        Catch ex As Exception

            'Response.Write(ex.ToString())
            httpsend_get = ex.ToString

        End Try

    End Function

    '===========================================================================================
    'HTTP請求/回應 _END
    '===========================================================================================


    'HTTP讀取
    'HTTP 1.1 POST方式
    'geturl=網址
    'other=？號後面的參數
    Function http_post(ByVal geturl As String, ByVal text As String) As String
        Dim myHttpWebRequest As System.Net.HttpWebRequest

        Dim myHttpWebResponse As System.Net.HttpWebResponse

        Try
            Dim URL As String = geturl
            Dim myUri As Uri = New Uri(geturl)
            Dim myWebRequest As System.Net.WebRequest = System.Net.WebRequest.Create(URL)
            myHttpWebRequest = CType(myWebRequest, System.Net.HttpWebRequest)
            myHttpWebRequest.KeepAlive = True
            myHttpWebRequest.Timeout = 3000000
            myHttpWebRequest.Method = "POST"
            Dim postdata As String = URLEncoding(text)
            Dim encoding As New System.Text.ASCIIEncoding
            Dim byte1 As Byte() = encoding.GetBytes(postdata)
            myHttpWebRequest.ContentType = "application/x-www-form-urlencoded"
            myHttpWebRequest.ContentLength = postdata.Length
            Dim newStream As System.IO.Stream = myHttpWebRequest.GetRequestStream()
            newStream.Write(byte1, 0, byte1.Length)
            newStream.Close()
            Dim myWebResponse As System.Net.WebResponse = myHttpWebRequest.GetResponse()
            myHttpWebResponse = CType(myWebResponse, System.Net.HttpWebResponse)
            Dim iStatCode As Integer = CInt(myHttpWebResponse.StatusCode)
            myHttpWebResponse = CType(myWebResponse, System.Net.HttpWebResponse)
            Dim myStream As System.IO.Stream = myHttpWebResponse.GetResponseStream()
            Dim srReader As System.IO.StreamReader = New System.IO.StreamReader(myStream, encoding.Default)
            Dim sTemp As String = srReader.ReadToEnd()
            http_post = sTemp


            srReader.Close()
            myStream.Close()
            myWebResponse.Close()
            myWebRequest.Abort()


        Catch WebExcp As System.Net.WebException

            http_post = Replace(WebExcp.Message.ToString(), "The remote server returned an error: (500) Internal Server Error.", "服務器出現故障無法連接")


        Catch ex As Exception

            http_post = ex.ToString()

        End Try

    End Function

    'Unicode轉換
    Function URLEncoding(ByVal vstrIn) As String
        Dim strReturn As String
        Dim i As Integer
        Dim ThisChr As String
        Dim innerCode As Integer
        Dim Hight8 As Integer
        Dim Low8 As Integer
        strReturn = ""
        For i = 1 To Len(vstrIn)
            ThisChr = Mid(vstrIn, i, 1)
            If Math.Abs(Asc(ThisChr)) < &HFF Then
                strReturn = strReturn & ThisChr
            Else
                innerCode = Asc(ThisChr)
                If innerCode < 0 Then
                    innerCode = innerCode + &H10000
                End If
                Hight8 = (innerCode And &HFF00) \ &HFF
                Low8 = innerCode And &HFF
                strReturn = strReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
            End If
        Next
        URLEncoding = strReturn
        strReturn = Nothing
        i = Nothing
        ThisChr = Nothing
        innerCode = Nothing
        Hight8 = Nothing
        Low8 = Nothing
    End Function

    '反解 URLEncoding
    Function UTF2GB(ByVal UTFStr)
        Dim gbstr
        Dim dig
        For dig = 1 To Len(UTFStr)
            If Mid(UTFStr, dig, 1) = "%" Then
                If Len(UTFStr) >= dig + 8 Then
                    gbstr = gbstr & ConvChinese(Mid(UTFStr, dig, 9))
                    dig = dig + 8
                Else
                    gbstr = gbstr & Mid(UTFStr, dig, 1)
                End If
            Else
                gbstr = gbstr & Mid(UTFStr, dig, 1)
            End If
        Next
        UTF2GB = gbstr
    End Function

    Function ConvChinese(ByVal x)

        Dim A = Split(Mid(x, 2), "%")
        Dim i = 0
        Dim j = 0
        Dim un_icode
        Dim digs
        For i = 0 To UBound(A)
            A(i) = c16to2(A(i))
        Next

        For i = 0 To UBound(A) - 1
            digs = InStr(A(i), "0")
            un_icode = ""
            For j = 1 To digs - 1
                If j = 1 Then
                    A(i) = Right(A(i), Len(A(i)) - digs)
                    un_icode = un_icode & A(i)
                Else
                    i = i + 1
                    A(i) = Right(A(i), Len(A(i)) - 2)
                    un_icode = un_icode & A(i)
                End If
            Next

            If Len(c2to16(un_icode)) = 4 Then
                ConvChinese = ConvChinese & ChrW(Int("&H" & c2to16(un_icode)))
            Else
                ConvChinese = ConvChinese & Chr(Int("&H" & c2to16(un_icode)))
            End If
        Next
    End Function

    Function c2to16(ByVal x)
        Dim i = 1
        For i = 1 To Len(x) Step 4
            c2to16 = c2to16 & Hex(c2to10(Mid(x, i, 4)))
        Next
    End Function

    Function c2to10(ByVal x)
        c2to10 = 0
        If x = "0" Then Exit Function
        Dim i = 0
        For i = 0 To Len(x) - 1
            If Mid(x, Len(x) - i, 1) = "1" Then c2to10 = c2to10 + 2 ^ (i)
        Next
    End Function

    Function c16to2(ByVal x)
        Dim i = 0
        Dim tempstr

        For i = 1 To Len(Trim(x))
            tempstr = c10to2(CInt(Int("&h" & Mid(x, i, 1))))
            Do While Len(tempstr) < 4
                tempstr = "0" & tempstr
            Loop
            c16to2 = c16to2 & tempstr
        Next
    End Function

    Function c10to2(ByVal x)
        Dim mysign = System.Math.Sign(x)
        Dim tempnum
        Dim i
        x = System.Math.Abs(x)
        Dim DigS = 1
        Do
            If x < 2 ^ DigS Then
                Exit Do
            Else
                DigS = DigS + 1
            End If
        Loop
        tempnum = x

        i = 0
        For i = DigS To 1 Step -1
            If tempnum >= 2 ^ (i - 1) Then
                tempnum = tempnum - 2 ^ (i - 1)
                c10to2 = c10to2 & "1"
            Else
                c10to2 = c10to2 & "0"
            End If
        Next
        If mysign = -1 Then c10to2 = "-" & c10to2
    End Function