用XMLHTTP来偷东西哈！

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

<!--

　　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>

<!--

　　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"))

　　%>

　　<legend><strong>手机号归属地查询</strong></legend>

　　<div>

　　<%

　　Dim MobileNumber

　　MobileNumber = Trim(Request.Form("MobileNumber"))

　　%>

　　请输入手机号码段：<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>

　　<legend><strong>Google PR 值查询</strong></legend>

　　<div>

　　<%

　　Dim domainName

　　domainName = Replace(Replace(LCASE(Trim(Request.Form("domainName"))),"www.",""),"http://","")

　　%>

　　请输入域名：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="""&domainName&" ' rel=nofollow target=_blank>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=""www."&domainName&" ' rel=nofollow target=_blank>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>

　　<div>

　　<%

　　Dim zoneName

　　zoneName = Trim(Request.Form("zoneName"))

　　%>

　　地区 <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>")

　　Response.Write("<li><strong><font color=""#008000"">"&Replace(getNumber,",","")&"</font></strong></li>")

　　END IF

　　Response.Write("</UL>")

　　END IF

　　Dim zoneNumber

　　zoneNumber = Trim(Request.Form("zoneNumber"))

　　%>

　　区号 <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>")

　　Response.Write("<li><strong><font color=""#008000"">"&Replace(getZone,",","")&"</font></strong></li>")

　　END IF

　　Response.Write("</UL>")

　　END IF

　　%>

　　</div>

　　</fieldset>

　　<legend><strong>ＩＰ地理位置查询</strong></legend>

　　<div>

　　待查询的ＩＰ地址：<input type="text" name="ipAddress" value="<%=ipAddress%>" /> <input type="submit" value="提交" />

　　</form>

　　</div>

　　</fieldset>

　　<legend><strong>身份证号码查询</strong></legend>

　　<div>

　　<%

　　Dim identityNumber

　　identityNumber = Trim(Request.Form("identityNumber"))

　　%>

　　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

　　%>

　　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>

　　DESIGNED BY <a href="goaler' rel=nofollow target=_blank>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

　　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") & ","

　　set regEx=nothing

　　End Function

　　%>

教程首页更多教程