VB GET-POST

'=======GET方式获取网页源代码================
Function GetCode(Url As String, CodeBase As String)
    '第一个参数是地址,第二个参数是设置编码方式(GB2312或UTF-8).
    Dim xmlHTTP1
    Set xmlHTTP1 = CreateObject("Microsoft.XMLHTTP")
    xmlHTTP1.Open "get", Url, True
    xmlHTTP1.send
    
    While xmlHTTP1.readyState <> 4
        DoEvents
    Wend
    
    GetCode = xmlHTTP1.responseBody
    
    If CStr(GetCode) <> "" Then GetCode = BytesToBstr(GetCode, CodeBase)
    
    Set xmlHTTP1 = Nothing
End Function

Function BytesToBstr(strBody, ByVal CodeBase As String)
    Dim ObjStream
    Set ObjStream = CreateObject("Adodb.Stream")
    With ObjStream
        .Type = 1
        .Mode = 3
        .Open
        .write strBody
        .Position = 0
        .Type = 2
        .Charset = CodeBase
        BytesToBstr = .ReadText
        .Close
    End With
    Set ObjStream = Nothing
End Function


'=======POST方式获取网页源代码================
'先引用Microsoft XML, V3.0
Function PostData(url As String, strData As String)
    Dim xml As New XMLHTTP
    Dim str1 As String
        
    'url = "http://www.0575.com/"
    'strData = "a=1&b=1"
    
    xml.Open "POST", url, False

    xml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"

    xml.send strData
    
    
    If xml.Status = 200 Then
        str1 = StrConv(xml.responseBody, vbUnicode) '返回的内容
    End If

    PostData = str1
    
End Function

'==========新方法获取网页源码===============
'需要Inet
'新获取网页源码方法Inet
Function getHtmlFrom(u)
    Dim BinBuff() As Byte
    Dim StrUrl As String
    
    StrUrl = u
    BinBuff = Inet1.OpenURL(StrUrl, icByteArray)
    getHtmlFrom = Utf8ToUnicode(BinBuff)
End Function

'下面这是个模块
'utf- 8转换UNICODE代码
Option Explicit

Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Const CP_UTF8 = 65001

Function Utf8ToUnicode(ByRef Utf() As Byte) As String
    Dim lRet As Long
    Dim lLength As Long
    Dim lBufferSize As Long
    lLength = UBound(Utf) - LBound(Utf) + 1
    If lLength <= 0 Then Exit Function
    lBufferSize = lLength * 2
    Utf8ToUnicode = String$(lBufferSize, Chr(0))
    lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(Utf(0)), lLength, StrPtr(Utf8ToUnicode),     lBufferSize)
    If lRet <> 0 Then
        Utf8ToUnicode = Left(Utf8ToUnicode, lRet)
    Else
        Utf8ToUnicode = ""
    End If
End Function

 

posted @ 2013-09-08 20:11  巫妖天下  阅读(877)  评论(0编辑  收藏  举报