只做了一部分，IP查詢請大家自己照我裡邊的範例自己完成吧！
示範：http://www.goalercn.com/demo/searcher.asp
<%@LANGUAGE=VBSCRIPT CODEPAGE=936%>
<!DOCTYPE html PUBLIC -//W3C//DTD XHTML 1.0 Transitional//EN http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd>
<html>
<head>
<meta http-equiv=Content-Type content=text/html; charset=gb2312 />
<META NAME=Author CONTENT=goaler />
<META NAME=Keywords CONTENT=手機號碼歸屬地,ip,google pr,郵編,身分證,查詢,升位,goaler,www.goalercn.com />
<META NAME=Description CONTENT=手機號碼歸屬地,ip,google pr,郵編,身分證,查詢,升位,goaler,www.goalercn.com />
<title>常用查詢</title>
<style type=text/css>
<!--
body {font:14px Tahoma,Verdana,宋體}
input,object {color: #000000;font:12px Tahoma,Verdana,宋體;}
form {margin:0}
A:link{COLOR:#000066;TEXT-DECORATION:none}
A:visited{COLOR:#000066;TEXT-DECORATION:none}
A:hover{COLOR:#FF8D00;TEXT-DECORATION:underline}
-->
</style>
<SCRIPT LANGUAGE=JavaScript>
<!--
String.prototype.Trim = function()
{
return this.replace(/(^/s*)|(/s*$)/g, );
}
function checkMobile(){
var sMobile = document.mobileForm.MobileNumber.value.Trim();
if(!(/^13[0-9]/d{4,8}$/.test(sMobile))){
alert(請輸入完整的11位手機號碼或手機號碼前七位);
document.mobileForm.MobileNumber.focus();
return false;
}
}
function checkPR()
{
if (document.prForm.domainName.value.Trim() == )
{
return false;
}
}
function checkZone2NumberForm()
{
if (document.Zone2NumberForm.zoneName.value.Trim() == )
{
alert(請輸入地區名稱！);
document.Zone2NumberForm.zoneName.focus();
return false;
}
}
function checkNumber2ZoneForm()
{
var sZoneNumber = document.Number2ZoneForm.zoneNumber.value.Trim();
if (!(/^0/d{2,3}$/.test(sZoneNumber)))
{
alert(請輸入3位或4位區號);
document.Number2ZoneForm.zoneNumber.focus();
return false;
}
}
function checkIdentityForm()
{
var sIdentityNumber = document.identityForm.identityNumber.value.Trim();
if (!(/^/d{15}$|^/d{18}$|^/d{17}x$/.test(sIdentityNumber)))
{
alert(請輸入15位或18位身分證號碼);
document.identityForm.identityNumber.focus();
return false;
}
}
function checkIdentityUpForm()
{
var sIdentityNumber = document.identityUpForm.identityNumber.value.Trim();
if (!(/^/d{15}$/.test(sIdentityNumber)))
{
alert(請輸入15位身分證號碼);
document.identityUpForm.identityNumber.focus();
return false;
}
}
//-->
</SCRIPT>
</head>
<body>
<%
'==========請保留以下資訊===============
'作者(Author)：goaler
'首頁(homepage)：http://www.goalercn.com
'=========================================
on error resume next
Dim url,PostStr,sType,getContent,i
sType = Trim(Request.QueryString(sType))
%>
<fieldset>
<legend><strong>手機號碼歸屬地查詢</strong></legend>
<div>
<%
Dim MobileNumber
MobileNumber = Trim(Request.Form(MobileNumber))
%>
<div style=padding-left:23px;margin-bottom:8px;>
<form method=post name=mobileForm action=searcher.asp?sType=mobile onsubmit=return checkMobile()>
請輸入手機號碼段：<input type=text name=MobileNumber value=<%=MobileNumber%> onfocus=select() /> <input type=submit id=subBtn value=查詢/>
輸入完整的11位手機號碼或手機號碼前七位
</form>
</div>
<%
IF(sType = mobile AND MobileNumber<>)THEN
Dim getArea,getType
PostStr = action=mobile&mobile=&MobileNumber
getContent=GetURL(http://www.ip138.com:8080/search.asp,PostStr)
getArea = RegExpText(getContent,卡號歸屬地</TD>((.|/n)*?)</TD>)
getType = RegExpText(getContent,卡片類型</TD>((.|/n)*?)</TD>)
Response.Write(<UL>)
Response.Write(<li><strong>手機號碼區段：</strong><font color=#008000><strong> & MobileNumber & </strong></font></li>)
Response.Write(<li><strong>號碼歸屬地：</strong><font color=#008000><strong> & Replace(getArea,,,) & </strong></font></li>)
Response.Write(<li><strong>卡片類型：</strong><font color=#008000><strong> & Replace(getType,,,) & </strong></font></li>)
Response.Write(</UL>)
END IF
%>
</div>
</fieldset>
<fieldset>
<legend><strong>Google PR 值查詢</strong></legend>
<div>
<%
Dim domainName
domainName = Replace(Replace(LCASE(Trim(Request.Form(domainName))),www.,),http://,)
%>
<div style=padding-left:23px;margin-bottom:8px;>
<form name=prForm method=post action=searcher.asp?sType=pr onsubmit=return checkPR()>
請輸入網域：www.<input type=text name=domainName value=<%=domainName%> /> <input type=submit value=提交/>
不要帶http://www.
</form>
</div>
<%
IF(sType = pr AND domainName<>)THEN
PostStr =
getContent=GetURL(http://so.5eo.com/info.php?action=ra ... &domainName,PostStr)
getContent=RegExpText(getContent,在滿分10分評價中獲得<font color=#FB5E3C>((.|/n)*?)</font> 分)
'getContent=ReplaceKey(getContent,在滿分10分評估中獲得<font color=#FB5E3C>|||||</font> 分)
Dim ArrayPr
ArrayPr=Split(getContent,,)
Response.Write(<UL>)
Response.Write(<li><a href=http://&domainName& target=new><font color= ... t;&domainName&</strong></font></a>的Google PageRank值：<font color =#FF0000><strong>&ArrayPr(0)&</strong></font></li>)
Response.Write(<li><a href=http://www.&domainName& target=new><font color= ... uot;&domainName&</font></strong></a>的Google PageRank值：< font color=#FF0000><strong>&ArrayPr(1)&</strong></font>)
Response.Write(</UL>)
END IF
%>
</div>
</fieldset>
<fieldset>
<legend><strong>地區<->區號查詢</strong></legend>
<div>
<div style=padding-left:23px;margin-bottom:8px;>
<%
Dim zoneName
zoneName = Trim(Request.Form(zoneName))
%>
<form name=Zone2NumberForm method=post action=searcher.asp?sType=zone2number onsubmit=return checkZone2NumberForm()>
地區<strong>→</strong> 區號：<input type=text name=zoneName value=<%=zoneName%> onfocus=select() /> <input type=submit value=提交/>
</form>
</div>
<%
IF(sType = zone2number AND zoneName <> )THEN
Dim getNumber,ArrayNumber
PostStr = area= & escape(zoneName) & &action=area2zone
getContent=GetURL(http://www.ip138.com/post/search.asp,PostStr)
getNumber = RegExpText(getContent,<TR><TD class=tdc2>◎((.|/n)*?)</TD>)
Response.Write(<UL>)
IF(getNumber=)THEN
Response.Write(<li><strong><font color=#FF0000>沒有搜尋到記錄</font></strong></li>)
ELSE
ArrayNumber = split(getNumber,,)
IF(isArray(ArrayNumber))THEN
For i=0 TO UBOUND(ArrayNumber)-1
Response.Write(<li><strong><font color=#008000>&Replace(ArrayNumber(i),,,)&</font></strong></li>)
Next
ELSE
Response.Write(<li><strong><font color=#008000>&Replace(getNumber,,,)&</font></strong></li>)
END IF
END IF
Response.Write(</UL>)
END IF
Dim zoneNumber
zoneNumber = Trim(Request.Form(zoneNumber))
%>
<div style=padding-left:23px;margin-bottom:8px;>
<form name=Number2ZoneForm method=post action=searcher.asp?sType=number2zone onsubmit=return checkNumber2ZoneForm()>
區號<strong>→</strong> 地區：<input type=text name=zoneNumber value=<%=zoneNumber%> onfocus=select() /> <input type=submit value=提交/>
</form>
</div>
<%
IF(sType = number2zone AND zoneNumber <> )THEN
Dim getZone,ArrayZone
PostStr = action=zone2area&zone=&zoneNumber
getContent=GetURL(http://www.ip138.com/post/search.asp,PostStr)
getZone = RegExpText(getContent,<TR><TD class=tdc2>◎((.|/n)*?)</TD>)
Response.Write(<UL>)
IF(getZone=)THEN
Response.Write(<li><strong><font color=#FF0000>沒有搜尋到記錄</font></strong></li>)
ELSE
ArrayZone = split(getZone,,)
IF(isArray(ArrayZone))THEN
For i=0 TO UBOUND(ArrayZone)-1
Response.Write(<li><strong><font color=#008000>&Replace(ArrayZone(i),,,)&</font></strong></li>)
Next
ELSE
Response.Write(<li><strong><font color=#008000>&Replace(getZone,,,)&</font></strong></li>)
END IF
END IF
Response.Write(</UL>)
END IF
%>
</div>
</fieldset>
<fieldset>
<legend><strong>ＩＰ地理位置查詢</strong></legend>
<div>
<div style=padding-left:23px;margin-bottom:8px;>
<form name=ipForm method=post action=searcher.asp?sType=ip onsubmit=return checkIPForm()>
待查詢的ＩＰ位址：<input type=text name=ipAddress value=<%=ipAddress%> /> <input type=submit value=提交/>
</form>
</div>
</div>
</fieldset>
<fieldset>
<legend><strong>身分證號碼查詢</strong></legend>
<div>
<%
Dim identityNumber
identityNumber = Trim(Request.Form(identityNumber))
%>
<div style=padding-left:23px;margin-bottom:8px;>
<form name=identityForm method=post action=searcher.asp?sType=identity onsubmit=return checkIdentityForm()>
15或18位元身分證號碼：<input type=text name=identityNumber value=<%=identityNumber%> /> <input type=submit value=提交/>
</form>
</div>
<%
IF(sType = identity AND identityNumber<>)THEN
Dim ArrayIDCardInfo
PostStr = action=idcard&userid=&identityNumber
getContent=GetURL(http://www.oicq88.com/idsearch/index.asp,PostStr)
getContent=RegExpText(getContent,：</font>((.|/n)*?)<BR>)
Response.Write(<UL>)
IF(getContent=)THEN
Response.Write(<li>身分證號碼錯誤或沒有查詢到相關資料</li>)
ELSE
ArrayIDCardInfo = split(getContent,,)
Response.Write(<li><strong>性別：</strong><font color=#008000><strong>&Replace(ArrayIDCardInfo(0),,,)&</strong></font></li>)
Response.Write(<li><strong>出生日期：</strong><font color=#008000><strong>&Replace(ArrayIDCardInfo(1),,,)&</strong></font></li> )
Response.Write(<li><strong>發證區：</strong><font color=#008000><strong>&Replace(ArrayIDCardInfo(2),,,)&</strong></font></li >)
END IF
Response.Write(</UL>)
END IF
%>
<div style=padding-left:23px;margin-bottom:8px;>
<form name=identityUpForm method=post action=searcher.asp?sType=upIdentity onsubmit=return checkIdentityUpForm()>
15位號碼升至18位：<input type=text name=identityNumber value=<%=identityNumber%> /> <input type=submit value=投稿/>
</form>
</div>
<%
IF(sType = upIdentity AND identityNumber<>)THEN
PostStr = action=upto18&userid=&identityNumber
getContent=GetURL(http://www.oicq88.com/idsearch/index.asp,PostStr)
getContent=RegExpText(getContent,升位後號碼：((.|/n)*?)</TD>)
Response.Write(<UL>)
IF(getContent=)THEN
Response.Write(<li>身分證號碼錯誤或沒有查詢到相關資料</li>)
ELSE
Response.Write(<li><strong>升位(18位)後號碼是：</strong><font color=#008000><strong>&Replace(getContent,,,)&</strong></font> </li>)
END IF
Response.Write(</UL>)
END IF
%>
</div>
</fieldset>
<div style=padding:15px;text-align:center;>
DESIGNED BY <a href=http://www.goalercn.com target= ... R</a><BR />
</div>
</body>
</html>
<%
Function ByteToStr(vIn)
Dim strReturn,i,ThisCharCode,innerCode,Hight8,Low8,NextCharCode
strReturn =
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
End If
Next
ByteToStr = strReturn
End Function
Function GetURL(url,PostStr)
Set Retrieval = Server.CreateObject(Microsoft.XMLHTTP)
With Retrieval
.Open POST, url, false , ,
.setRequestHeader Content-Type,application/x-www-form-urlencoded
.Send(PostStr)
GetURL = .ResponseBody
End With
Set Retrieval = Nothing
GetURL=ByteToStr(GetURL)
End Function
Function RegExpText(strng,regStr)
Dim regEx,Match,Matches,RetStr
Set regEx = New RegExp
regEx.Pattern = regStr
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(strng)
For Each Match in Matches
RetStr = RetStr & regEx.Replace(Match.Value,$1) & ,
Next
RegExpText = RetStr
set regEx=nothing
End Function
%>