Question

VB读取网页内容

有效必给分

读取箭头所示的内容
以下是网页部分内容
<SCRIPT language="javascript" type="text/javascript">var wanPara = new Array(0,"6C-E8-73-32-84-7D","113.73.143.177",3,"255.255.255.0",0,0,"113.73.143.177",0,1,0,"114.114.114.114 , 202.96.134.33","0 day(s) 01:41:15",1,0,"0.0.0.0","0.0.0.0",0,0,0,2,0,0 );</SCRIPT><META http-equiv="Content-Type" content="text/html; charset=gb2312"><META http-equiv="Pragma" content="no-cache"><META http-equiv="Expires" content="wed, 26 Feb 1997 08:21:57 GMT"><LINK href="/dynaform/css_main.css" rel=stylesheet><SCRIPT language="javascript" src="/dynaform/common.js" type="text/javascript"></SCRIPT><SCRIPT language="javascript" type="text/javascript"><!--if(window.parent ==

Answer 1

Public Function GetAddress(url As String) As String
    Dim res As String
    'res = ResponseText(url) '读取网页
    
    '读取c:\html.txt本地文本,把文本放到该文件中试试效果
    res = CreateObject("scripting.filesystemobject").opentextfile("c:\html.txt").readall()
    If res <> "" Then
    
        Dim regEx As Object
        Set regEx = CreateObject("vbscript.RegExp")
        regEx.Global = True
        regEx.IgnoreCase = True
        regEx.Pattern = "var wanPara = new Array\([^\x00]+?\);"
        Dim Matches As Object
        Set Matches = regEx.execute(res) '搜索出数组定义代码
        If Matches.Count > 0 Then
            res = Matches.Item(0).Value
            MsgBox res '定义数组的js代码
            Dim js As Object
            Set js = CreateObject("MSScriptControl.ScriptControl")
            js.language = "javascript"
            js.AddCode res '添加到对象解析js代码
            
            Dim arU As Integer
            arU = js.Eval("wanPara.length") - 1
            Dim i As Integer
            Dim wanPara()
            ReDim wanPara(arU)
            For i = 0 To arU
                wanPara(i) = js.Eval("wanPara[" & i & "]")
            Next
            MsgBox Join(wanPara, vbCrLf) '数组所有元素
            
            GetAddress = wanPara(2) '读取数组元素，地址在下标2
        End If
    End If
End Function
'读取网页
Private Function ResponseText(url As String) As String
    On Error GoTo E
    Static xmlHTTP As Object
    If xmlHTTP Is Nothing Then Set xmlHTTP = CreateObject("Microsoft.XMLHTTP")
    xmlHTTP.Open "GET", url, False
    xmlHTTP.send
    If xmlHTTP.Status = 200 Then ResponseText = xmlHTTP.ResponseText
E:
End Function
Public Sub 测试()
    MsgBox GetAddress("url")
End Sub

Answer 2

忙完之后帮你搞一下