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