网站 › 『编程语言区』 › 手机号码归属地查询

Demo 发表于 2014-8-20 12:30

手机号码归属地查询

本帖最后由 Demo 于 2014-8-20 12:43 编辑

'Demo
'吾爱破解
'转载请保持完整出处
'http://www.52pojie.cn/space-uid-153321.html
Function HttpGet(url)

    With CreateObject("Msxml2.ServerXMLHTTP")
      .open "GET", url, False
      .send
      HttpGet = .responseText
    End With

End Function

Private Sub Command1_Click()
    PhoneNumber = ""
    All = HttpGet("http://wap.ip138.com/sim_search138.asp?mobile=" & PhoneNumber)
    a = Split(All, "归属地：")
    a = a(1)
    a = Split(a, "<br/>")
    a = a(0)
    MsgBox a
   
    b = Split(All, "卡类型：")
    b = b(1)
    b = Split(b, "<br/>")
    b = b(0)
    MsgBox b
   
End Sub

gdyabc 发表于 2016-4-7 22:20

Option Explicit
Private Sub Form_Load()
Debug.Print getphonedata("13800138000")
End Sub
Public Function getphonedata(strphone As String) As String
On Error Resume Next
Dim global_NetworkAddress As Object
Dim targetUrl As String, cardLocal As String, cardType As String, codeZip As String
Dim i As Byte
    targetUrl = "http://m.ip138.com/mobile.asp?mobile=" & strphone    '//从这里提取外网数据
    Set global_NetworkAddress = CreateObject("MSXML2.SERVERXMLHTTP")'//创建xmlHttp对象
      With global_NetworkAddress
            Do
                   i = i + 1: Err.Clear                        '//记录Try的次数，并清空Err信息
                  .Open "GET", targetUrl, False
                  .Send
            Loop Until i = 4 Or Err.Number = 0   '//如果第一次获取失败，再尝试3次
            '//如果获取成功就返回OK，失败返回错误信息
            getphonedata = IIf(Err.Number = 0, "OK", Err.Description)
            cardLocal = Split(Split(.ResponseText, "卡号归属地</td><td><span>")(1), "</span>")(0)
            cardType = Split(Split(.ResponseText, "卡 类 型</td><td><span>")(1), "</span>")(0)
            codeZip = Split(Split(.ResponseText, "邮 编</td><td><span>")(1), "</span>")(0)
            getphonedata = getphonedata & "," & strphone & "," & _
                           cardLocal & "," & cardType & "," & codeZip
      End With
Set global_NetworkAddress = Nothing       '//释放对象
End Function

东苑 发表于 2014-8-20 12:48

这个怎么用呢。

淡然出尘 发表于 2014-8-20 12:36

用WAP确实可以省不少事{:301_1002:}

Demo 发表于 2014-8-20 12:43

淡然出尘 发表于 2014-8-20 12:36
用WAP确实可以省不少事

WWW返回的格式经常变，不懂怎么处理。

yang10560 发表于 2014-8-20 13:06

{:301_997:}不错。。。。。亲测可行

1013356744 发表于 2014-8-20 13:14

虽然用不上但还是支持一下

yang10560 发表于 2014-8-20 13:28

Function HttpGet(url)

With CreateObject("Msxml2.ServerXMLHTTP")
.open "GET", url, False
.send

HttpGet = .responseText
End With

End Function

Private Sub Command1_Click()
PhoneNumber = "13804452101"
All = HttpGet("http://wap.ip138.com/sim_search138.asp?mobile=" & PhoneNumber)


s = InStr(All, "归属地：")
q = InStr(s, All, "<br/>")
f = Mid(All, s, q - s)
Print f

s = InStr(All, "卡类型：")
q = InStr(s, All, "<br/>")
f = Mid(All, s, q - s)
Print f


End Sub

Demo 发表于 2014-8-20 16:14

@ruoxin找份VB代码出来。立马20CB给你！

Demo 发表于 2014-8-20 16:15

@ruoxin找份VB代码出来。立马20CB给你！

opelwang 发表于 2015-3-21 14:16

在线通过IP138完成的,不错，学习一下。

查看完整版本: 手机号码归属地查询