分享
 
 
 

纯ASP(VBscript)写的全球IP地址搜索程序

王朝asp·作者佚名  2006-12-16
窄屏简体版  字體: |||超大  

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>

<html>

<head>

<title>Untitled Document</title>

<meta http-equiv="Content-Type" content="text/html; charset=gb2312">

</head>

<body>

<%

dim finishgetip,showip,allip

'////////////////////////////////////////////////////////////////////////////////////////

'本文信息

'本程序由 Arrow 原创,如要转载,请注明原作者 Arrow

要看源代码及下载IP数据库和Script56.CHM(包括JScript全部语法,VBscript全部语法,正则表达式语法)的朋友,请留下E-Mail!

' Copyright by Arrow mailto:;E-Mail:Arrowy@163.net QQ:9791769

'程序还不是很精简,以后再修改

'本程序所用的数据库为-- “冯志宏”-- 所写的--“追捕”--软件中所带IP数据库和

' “国华软件 Guohua Soft”的作者 --“冯国华”—所写的“全球IP地址分配表.chm”合二为一得到的

'感谢“冯志宏”和“冯国华”提供的数据

'数据库中还有不少的重复IP地址,希望有心人能将其删除,减小数据库

'我的程序写的还很笨拙,希望大家能多提意见,多多交流,谢谢!

'////////////////////////////////////////////////////////////////////////////////////////

'解决思路:

'取得的客户端IP一般是202.11.25.1这种,而数据库中的IP格式为202.011.025.001,这就需要将取得的

'客户端IP转换为与数据库中IP一样的格式

'因为目前我们所用的IP是分为4段,每段3位,中间以“.”分隔

'所以我的思路是将客户端IP以“.”符号分割为4段,即202/11/25/1

'然后再分别核对每一段,如果是3位,则不变;如不足3位,为2位,该段前补1个0,为1,同理,则补2个0

'得到格式化后的IP后,去掉IP的最后一段,即取包括“.”的前11位,与数据库中的startip字段的前11位相比较,查找相同的值

'因为从数据库中可以看到,startip和endip的前三段都是一样的,而最后一段不过是内部子网地址,可以去掉

'所以只要取startip或endip的任意一个字段的前11位与客户端IP的前11位相比较就可以查到正确的所在地

'/////////////////////////////////////////////////////////////////////////////////////////

function checkip_trueip()

'取客户端真实IP

getclientip = Request.ServerVariables("HTTP_X_FORWARDED_FOR") '如果客户端用了代理服务器,则用Request.ServerVariables("REMOTE_ADDR")方法只能得到空值,则应该用ServerVariables("HTTP_X_FORWARDED_FOR")方法

If getclientip = "" Then

getclientip = Request.ServerVariables("REMOTE_ADDR")'如果客户端没用代理,则Request.ServerVariables("HTTP_X_FORWARDED_FOR")得到是空值,应该用Request.ServerVariables("REMOTE_ADDR")方法

end if

checkip_trueip = getclientip

end function

'/////////////////////////////////////////////////////////////////////////////

function getaccessrecordset(db,sql,mark,read)'取得Recordset对象

set conn=getaccessconn(db)'输入参数为db-数据库的相对路径,sql-SQL语句,mark,read为数据库读取方式,1,1为只读,1,3为读写

'constr="Provider=microsoft.jet.oledb.4.0;"&"data Source="&Server.MapPath(db)

' conn.open constr

set getaccessrecordset=server.CreateObject("ADODB.Recordset")

getaccessrecordset.open sql,conn,mark,read

End function

'//////////////////////////////////////////////////////////////////////////

function getaccessconn(db)'取得connection对象

set getaccessconn=server.CreateObject("ADODB.Connection")

'constr="DRIVER={MICROSOFT ACCESS DRIVER (*.MDB)};DBQ="&SERVER.MAPPATH("allcon/#bbsall.mdb")

constr="Provider=microsoft.jet.oledb.4.0;"&"data Source="&Server.MapPath(db)

getaccessconn.open constr

end function

'/////////////////////////////////////////////////////////////////////////

dim getip

'getip=(trim(request.ServerVariables("REMOTE_ADDR")))'从客户端获取IP

'getip=(trim(request.QueryString("comes"))) '自己输入IP测试

'response.Write(getip&"<br>")

'////////////////////////////////////////////////////////////////////////

function checkip_locations(checkstring) '返回IP中分隔字符的位置函数

checkip_locations=Instr(checkstring,".") '将位置的值赋予给函数

end function

'///////////////////////////////////////////////////////////////////////

'以下函数为分割IP,取得每次分割后“.”符号右边的IP剩余的字符串

function checkip_left(checkstring)

locations_left=checkip_locations(checkstring) '得到在IP剩余的字符串中“.”第一次出现的位置

iplength_left=Len(checkstring) '取得IP剩余的字符串的长度

divide_locations_left=iplength_left-locations_left '取得在IP剩余的字符串中“.”第一次出现的位置,从右往左数是多少位

ipstr_left=Right(checkstring,divide_locations_left) '取得本次分割后,“.”符号右边的IP剩余的字符串

checkip_left=ipstr_left '将上面得到的字符串赋给函数

end function

'///////////////////////////////////////////////////////////////////////

'以下函数为分割IP,取得每次分割后“.”符号左边的IP字符串,即将IP分为四段,每一段的字符串

function checkip_right(checkstring)

locations_right=checkip_locations(checkstring) '取得在IP中“.”第一次出现的位置

iplength_right=Len(checkstring) '取得IP字符串长度

divide_locations_right=iplength_right-locations_right '取得在IP剩余的字符串中“.”第一次出现的位置,从右往左数是多少位

ipstr11=Trim(Replace(Left(checkstring,locations_right),".","")) '将得到的“.”左边的字符串去掉"."符号

'如果IP分为4段后每一段不足3位则补0

if Len(ipstr11)="2" then ipstr11="0"&ipstr11

if Len(ipstr11)="3" then ipstr11=ipstr11

if Len(ipstr11)="1" then ipstr11="00"&ipstr11

checkip_right=ipstr11 '得到“.”符号之前的字符串,即本次分割后得到的IP分割为四段后其中的一段

end function

'//////////////////////////////////////////////////////////////////////

'检查IP是否为内部网IP

'我写的判断是以:127.0.0.0-127.XXX.XXX.255和192.0.0.0-192.XXX.XXX.255为依据,如果为这二者,则是内部网IP,反之为外部网

'判断内部IP的依据是什么,我也不清楚,所以这里要高手多多指点,并加以修正,与我联系

function checkiplocal(checkstring)

dim re1

set re1=new RegExp '取得正则表达式对象

're1.pattern中的表达式为,内部网的IP应为127或192开头,中间为0-9中任意1-3个数字加"."组成一段

re1.pattern="^(127\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})|(192\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})$"

re1.global=false

re1.Ignorecase=false

checkiplocal=re1.test(checkstring)

set re1=nothing

end function

'//////////////////////////////////////////////////////////////////////

function checkip_remote(checkstring)

dim iplength 'IP字符串的长度

dim locations '"."字符出现的位置

iplength=Len(checksting)

locations=Instr(checkstring,".") '从左到右检索“.”符号在IP字符串中第一次出现的位置

'以“.”字符将IP分割为4段

locations2=iplength-locations

ipstring1=Left(checkstring,locations)

ipstring2=Right(checkstring,locations2)

end function

'//////////////////////////////////////////////////////////////////////

||||||'///////////////////////////////////////////////////////////////////////

ipinfo_local="您的IP是内部网IP!"

ipinfo_remote="外部网IP!"

getip=checkip_trueip()

currentip=checkiplocal(getip) '调用checkiplocal()函数对得到的IP进行检查,确定是内部网地址还是外部网地址

'if currentip=true then'测试代码

'response.Write(ipinfo_local)

if currentip=true then '为假

response.Write(ipinfo_local)'说明为内部网IP

else

'进行转换

'以下为循环提取并按位补0将IP分为4段

locations=checkip_locations(getip)'取得“.”在第一次分割前在IP中第一次出现的位置

iplength=Len(getip) '取得客户端IP的长度

divide_locations=iplength-locations '取得将客户端IP从右向左数到IP从左往右数第一个“.”的位置

ipstr1=Trim(Replace(Left(getip,locations),".",""))

ipstr2=Right(getip,divide_locations)'取得第一次分割后客户端右边剩下的数值

'如果IP分为4段后每一段不足3位则补0

if Len(ipstr1)="2" then ipstr1="0"&ipstr1 '长度为二,不足三位,在字符串之前补一个0

if Len(ipstr1)="3" then ipstr1=ipstr1 '据上类推

if Len(ipstr1)="1" then ipstr1="00"&ipstr1 '这时的ipstr1为IP的第一段

ipstr12=checkip_right(ipstr2) '这时的ipstr12为IP的第二段

ipstr122=checkip_left(ipstr2)

ipstr13=checkip_right(ipstr122) '这时的ipstr13为IP的第三段

ipstr14=checkip_left(ipstr122) '这时的ipstr14为IP的第四段

if Len(ipstr14)="1" then ipstr14="00"&ipstr14 '对得到的IP的第四段进行补0,此步骤可不要

if Len(ipstr14)="2" then ipstr14="0"&ipstr14

if Len(ipstr14)="3" then ipstr14=ipstr14

'response.write ipstr1&"<br>" '写出IP分割后的每段的值

'response.write ipstr12&"<br>"

'response.write ipstr13&"<br>"

'response.write ipstr14

allip=ipstr1&"."&ipstr12&"."&ipstr13&"."&ipstr14

finishgetip=left(allip,11)

dim ipaddr,iplocal,sqls

'以下SQL语句为提取startip字段左边11位值是否等于客户端IP的左边的11位的值

sqls="SELECT country_state,areauser FROM ip WHERE Left(startip,11)='"&finishgetip&"'"

set rs=getaccessrecordset("#worldip.mdb",sqls,"1","1") '得到查询值

if rs.eof then '如果没找到与客户端IP相等的值

showip=checkip_trueip() '把客户端IP赋予showip

ipaddr="未知地区" '国家或省份

iplocal="未知地点" '具体的地方

else

showip=checkip_trueip()

ipaddr=rs("country_state")

iplocal=rs("areauser")

end if

'response.write("您的IP是:"&showip&"&nbsp;")

'response.write("您来自:"&ipaddr&"&nbsp;")

'response.write("您是:"&iplocal)

rs.close

set rs=nothing

%>

<%="您的IP是:"&showip&"&nbsp;"%>

<%="您来自:"&ipaddr&"&nbsp;"%>

<%="您是:"&iplocal&"<br>"%>

如果IP地址有错误,请与我联系,或下载数据库更正,谢谢!<br>

<table width="760" border="0" cellspacing="0" cellpadding="0">

<tr>

<td width="203"><a href="Script56.rar">下载Script56.CHM</a>--&gt;1.34M</td>

<td width="548">简介:Microsoft的帮助文档,有VBscript语法,JScript语法,正则表达式&nbsp;&nbsp;</td>

<td width="3">&nbsp;</td>

<td width="6">&nbsp;</td>

</tr>

<tr>

 

[1] [2] 下一页

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有