用XMLHTTP来偷东西哈！

只做了一部份，IP查询请大家自己照着我里边的样例自己完成吧！演示：http://www.goalercn.com/demo/searcher.asp<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%><!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "' target=_blank rel=nofollow>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"></style><SCRIPT LANGUAGE="JavaScript"></SCRIPT></head><body><%'==========请保留以下信息==============='作者(Author)：goaler'主页(homepage)：http://www.goalercn.com'=======================================on error resume nextDim url,PostStr,sType,getContent,isType = 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="""&domainName&" ' target=_blank rel=nofollow>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&" ' target=_blank rel=nofollow>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="goaler' target=_blank rel=nofollow>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 FunctionFunction 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 FunctionFunction 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=nothingEnd Function%>

　　推荐阅读

　　在线统计代码 application

首先要设置好global.asa 文件,如下以下内容为程序代码 <script language="vbscript" runat="server"> sub application_onstart application("activeusers") = 0 　//初始值 end sub sub session_on>>>详细阅读

本文标题：用XMLHTTP来偷东西哈！

地址：http://www.17bianji.com/kaifa2/ASP/33296.html

1/2 1