只做了一部份，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
%>
