<%
'================================================
'手机号码归属地查询
'Coldstar 2009-10-05
'通过showji.com提供的API接口实现查询
'================================================
Dim api_url, api_Mobile, api_text, api_tmp, i
Dim api_QueryResult, api_Province, api_City, api_AreaCode, api_PostCode, api_Corp, api_Card
api_Mobile = trim(Request.QueryString("keyword"))
If Not IsNumeric(api_Mobile) Then api_Mobile = ""
If api_Mobile = "" Then
Response.write "1号码输入有误"
Response.End
Else
Call getMobileInfo(api_Mobile)
End If
If api_QueryResult = "False" Then
Response.Write "5查询失败"
Response.End
Else
Response.write "手机号码：" & api_Mobile & "
" & vbCrLf
Response.write "查询结果：" & api_QueryResult & "
" & vbCrLf
Response.write "所属省份：" & api_Province & "
" & vbCrLf
Response.write "所属城市：" & api_City & "
" & vbCrLf
Response.write "区 号：" & api_AreaCode & "
" & vbCrLf
Response.write "邮 编：" & api_PostCode & "
" & vbCrLf
Response.write "运 营 商：" & api_Corp & "
" & vbCrLf
Response.write "类 型：" & api_Card & "
" & vbCrLf
End If
Sub getMobileInfo(ByVal mobile)
api_url = "http://api.showji.com/locating/?m={MOBILE}&output=text"
api_Mobile = mobile
If Not IsNumeric(api_Mobile) Then api_Mobile = ""
If api_Mobile = "" Then
Response.write "1号码输入有误"
Response.End
Else
api_Mobile = Replace(api_Mobile,"-","")
If Len(api_Mobile) < 7 Or Len(api_Mobile) > 11 Then
Response.Write "2不是完整的11位手机号或者正确的手机号前七位"
Response.End
End If
api_url = Replace(api_url,"{MOBILE}", api_Mobile)
If Not CheckHTTP(api_url) Then
Response.Write "3数据获取错误"
Response.End
Else
api_text = GetRemoteData(api_url,"utf-8")
If Len(api_text) < 10 Then
Response.Write "4数据返回错误"
Response.End
Else
api_textArr = Split(api_text,vbCrLf)
For i = 0 To UBound(api_textArr)
api_tmp = Split(api_textArr(i),":")
Select Case api_tmp(0)
Case "Mobile"
api_Mobile = api_tmp(1)
Case "QueryResult"
api_QueryResult = api_tmp(1)
Case "Province"
api_Province = api_tmp(1)
Case "City"
api_City = api_tmp(1)
Case "AreaCode"
api_AreaCode = api_tmp(1)
Case "PostCode"
api_PostCode = api_tmp(1)
Case "Corp"
api_Corp = api_tmp(1)
Case "Card"
api_Card = api_tmp(1)
Case Else
api_QueryResult = False
End Select
Next
End If
End If
End If
End Sub
'================================================
'函数名：CheckRemoteUrl
'作 用： 判断远程URL
'================================================
Function CheckHTTP(ByVal URL)
Dim Retrieval
CheckHTTP=False
On Error Resume Next
Set Retrieval=CreateObject("MSXML2.XMLHTTP")
With Retrieval
.Open "HEAD", URL, False
.send
If .readyState=4 And .Status=200 Then
CheckHTTP=True
End If
End With
Set Retrieval=Nothing
If Err.Number<>0 Then
CheckHTTP=False
Err.Clear
End If
End Function
'================================================
'函数名：GetRemoteData
'作 用：获取HTTP远程数据
'参 数：url ----远程URL
'返回值：远程HTML代码
'================================================
Function GetRemoteData(ByVal URL, ByVal Cset)
If Len(Cset) < 2 Then Cset = "UTF-8"
Dim strHeader
Dim l
On Error Resume Next
Dim Retrieval
Dim ObjStream
Set ObjStream = CreateObject("ADODB.Stream")
ObjStream.Type = 1
ObjStream.Mode = 3
ObjStream.Open
Set Retrieval = CreateObject("MSXML2.XMLHTTP")
With Retrieval
.Open "GET", URL, False
.setRequestHeader "Referer", URL
.send
If .readyState <> 4 Then Exit Function
If .Status > 300 Then Exit Function
'--获取目标网站文件头
strHeader = .getResponseHeader("Content-Type")
strHeader = UCase(strHeader)
ObjStream.Write (.responseBody)
End With
Set Retrieval = Nothing
If Len(strHeader) > 0 Then
'--获取目标文件编码
l = InStrRev(strHeader, "CHARSET=", -1, 1)
If l > 0 Then
Cset = Right(strHeader, Len(strHeader) - l - 7)
Else
Cset = Cset
End If
End If
ObjStream.Position = 0
ObjStream.Type = 2
ObjStream.Charset = Trim(Cset)
GetRemoteData = ObjStream.ReadText
ObjStream.Close
Set ObjStream = Nothing
Exit Function
End Function
%>