火车采集器官方博客

 Function GetPhoneInfo(number, Optional para As Byte = 1)

 '获取手机号对应的基本信息 默认为城市

 'para:1-城市，2-省，3-运营商,4,全部

    Dim s As String

    s = GetBody("http://v.showji.com/Locating/showji.com2016234999234.aspx?

    output=json&callback=querycallback&m=" & number)

    Select Case para

    Case 1

        GetPhoneInfo = HtmlFilter(s, "City"":""", """")

    Case 2

        GetPhoneInfo = HtmlFilter(s, "Province"":""", """")

    Case 3

        GetPhoneInfo = HtmlFilter(s, "TO"":""", """")

    Case 4

        GetPhoneInfo = HtmlFilter(s, "City"":""", """") & "," & 

        HtmlFilter(s, "Province"":""", """") & "," & HtmlFilter(s, "TO"":""", """")

    End Select

    GetPhoneInfo = Replace(GetPhoneInfo, " ", "")

End Function

Private Sub Test()

    Dim i&, j&, k&, arr, brr

    url = "http://v.showji.com/Locating/showji.com2016234999234.aspx?

    output=json&callback=querycallback&m=15098051755"

    Debug.Print GetBody(url)

End Sub

'''如果出现乱码，UTF-8可改为GB2312

Public Function GetBody(ByVal url$, Optional ByVal Coding$ = "utf-8")

    On Error Resume Next

    Set ObjXML = CreateObject("Microsoft.XMLHTTP")

    With ObjXML

        .Open "Get", url, False, "", ""

        '.setRequestHeader "If-Modified-Since", "0"

        '.setRequestHeader "User-Agent", _

            ".Mozilla/5.0 (Windows NT 6.1; WOW64; rv:47.0) Gecko/20100101 Firefox/47.0"

        .Send

        GetBody = .ResponseBody

    End With

    GetBody = BytesToBstr(GetBody, Coding)

    Set ObjXML = Nothing

End Function

Public Function BytesToBstr(strBody, CodeBase)

    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

Public Function HtmlFilter(ByVal htmlText$, ByVal Label1$, ByVal label2$)

'返回html字符串lable1和最近的lable2标签中的数据

    Dim pStart As Long, pStop As Long

    pStart = InStr(htmlText, Label1) + Len(Label1)

    If pStart <> 0 Then

        pStop = InStr(pStart, htmlText, label2)

        HtmlFilter = Mid(htmlText, pStart, pStop - pStart)

    End If

End Function