苗景云的博客-有点用的代码

程序代码
<%
db="Database.mdb" '这里改成您的数据库地址
set conn=server.createobject("Adodb.Connection")
connstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Server.MapPath(db)
conn.open connstr
conn.execute("create table ET_NotDownload(NotDown oleobject)")
set rs=server.createobject("adodb.recordset")
sql="select * from ET_NotDownload"
rs.open sql,conn,1,3
rs.addnew
rs("NotDown").appendchunk(chrB(asc("<")) & chrB(asc("%")))
rs.update
rs.close
set rs=nothing
conn.close
set conn=nothing
%>

二。让IFRAME自动适应高度

三。提交时自动复制内容到剪贴板

程序代码

<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>提交时自动复制到剪贴板</title>
</head>

function copyText(obj) {
ie = (document.all)? true:false
if (ie){
var rng = document.body.createTextRange();
rng.moveToElementText(obj);
rng.scrollIntoView();
rng.select();
rng.execCommand("Copy");
rng.collapse(false);
}
}

function autocopy() {
if (this.document.formname.isautocopy.checked) {
copyText(this.document.formname.icontent);
}
}
</script>

<body>
<form action="" method="post" name="formname" onsubmit="autocopy();">
<textarea name="icontent" rows="4" cols="50"></textarea><br>
<input name="isautocopy" checked="checked" value="1" type="checkbox" />
提交时复制内容到剪贴板
<input type="submit" value="提交" /> </form>

</body>
</html>

四。一个生成HTML的类
不知道是谁写的，不过倒是个好东西

Htmlmaker.asp 类文件
<%
Class Htmlmaker
'/ 属性设置说明
'/ foldename "文件夹名"
'/ 如果不设置,将自动生成[年月日]时间格式的文件夹名
'/ Filename "文件名"(含前后缀)
'/ 如果不设置,将自动生成[时分秒]时间格式的文件名,后缀为.html
'/ Htmlstr "生成的代码内容"
'/*************************
Private HtmlFolder,HtmlFilename,HtmlContent
Public property let foldename(str)
HtmlFolder=str
End property
Public property let Filename(str)
HtmlFilename=str
End property
Public property let Htmlstr(str)
HtmlContent=str
End property
'/*************************
'/ 文件名转换日期函数
'/*************************
Private Function Datename1(timestr)
dim s_year,s_month,s_day
s_year=year(timestr)
if len(s_year)=2 then s_year="20"&s_year
s_month=month(timestr)
if s_month<10 then s_month="0"&s_month
s_day=day(timestr)
if s_day<10 then s_day="0"&s_day
Datename1=s_year & s_month & s_day
End Function
Private Function Datename2(timestr)
dim s_hour,s_minute,s_ss
s_hour=hour(timestr)
if s_hour<10 then s_hour="0"&s_hour
s_minute=minute(timestr)
if s_minute<10 then s_minute="0"&s_minute
s_ss=second(timestr)
if s_ss<10 then s_ss="0"&s_ss
Datename2 = s_hour & s_minute & s_ss
End Function
'/*************************
'/ 初试化
'/*************************

Private Sub class_initialize()
HtmlFolder=Datename1(now)
HtmlFilename=Datename2(now)&".html"
HtmlContent=""
End Sub
Private Sub class_terminate()
End Sub
'/*************************
'/ Html文件生成
'/*************************
Public Sub Htmlmake()
On Error Resume Next
dim filepath,fso,fout
filepath = HtmlFolder&"/"&HtmlFilename
Set fso = Server.CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(HtmlFolder) Then
Else
fso.CreateFolder(Server.MapPath(HtmlFolder))
End If
Set fout = fso.CreateTextFile(Server.MapPath(filepath),true)
fout.WriteLine HtmlContent
fout.close
End Sub
'/*************************
'/ Html文件删除
'/*************************
Public Sub Htmldel()
dim filepath,fso
filepath = HtmlFolder&"/"&HtmlFilename
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile(Server.mappath(filepath))
Set fso = nothing
End Sub
End class
%>

test.asp

<%
set myhtml= new Htmlmaker
'myhtml.foldename = "test"
'myhtml.Filename = "ok.shtml"
myhtml.Htmlstr = "<head></head><html><body>测试测试测试测试</body></html>"
myhtml.Htmlmake
set myhtml=nothing
Response.Write("生成成功!!")
%>

五。超级漂浮的代码

<html>
<head>
<title>超级漂浮的代码（漂的够猛）</title>
<SCRIPT>
var imagepath="/Learning/UploadFiles_9072/200608/20060831225502598.gif" //这里写图片的URL
var imagewidth=100 //这两行写图片的大小
var imageheight=100
var speed=3;
var imageclick="http://miaojingyun.com/" //这里写点击到的广告地址
var hideafter=0
var isie=0;
if(window.navigator.appName=="Microsoft Internet Explorer"&&window.navigator.appVersion.substring(window.navigator.appVersion.indexOf("MSIE")+5,window.navigator.appVersion.indexOf("MSIE")+8)>=5.5) {
isie=1;
}
else {
isie=0;
}
if(isie){
var preloadit=new Image()
preloadit.src=imagepath
}
function pop() {
if(isie) {
x=x+dx;y=y+dy;
oPopup.show(x, y, imagewidth, imageheight);
if(x+imagewidth+5>screen.width) dx=-dx;
if(y+imageheight+5>screen.height) dy=-dy;
if(x<0) dx=-dx;
if(y<0) dy=-dy;
startani=setTimeout("pop();",50);
}
}
function dismisspopup(){
clearTimeout(startani)
oPopup.hide()
}
function dowhat(){
if (imageclick=="dismiss")
dismisspopup()
else
window.open(imageclick);
}
if(isie) {
var x=0,y=0,dx=speed,dy=speed;
var oPopup = window.createPopup();
var oPopupBody = oPopup.document.body;
oPopupBody.style.cursor="hand"
oPopupBody.innerHTML = '<IMG SRC="'+preloadit.src+'">';
oPopup.document.body.onmouseover=new Function("clearTimeout(startani)")
oPopup.document.body.onmouseout=pop
oPopup.document.body.onclick=dowhat
pop();
if (hideafter>0)
setTimeout("dismisspopup()",hideafter*1000)
}
</SCRIPT>
</head>
<body>
</body>
</html>

六。asp文件生成js文件

Creatjs.asp代码

<%
set rs = server.CreateObject("ADODB.RecordSet")
sql="select top 10 * from news order by newsid desc"
set rs = conn.Execute (Sql)
do while not rs.eof
title=rs("title")
AddNewsDate=rs("AddNewsDate")
goaler = goaler + "<li><a target=_blank href=shownews.asp?id="&rs("newsid")&">" &title&" "&AddNewsDate&"</a></li><br>"
rs.movenext
loop
'生成JS文件
goaler = "" + goaler + ""
goaler = "document.write('" & goaler & "')"
FolderPath = Server.MapPath("./jsfile")
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set fout = fso.CreateTextFile(FolderPath&"\top.js")
fout.WriteLine goaler
'关闭连接
fout.close
set fout = nothing
rs.close
set rs = nothing
conn.close
set conn=nothing
%>

然后在你需要的页面写入这句代码：<script src="jsfile/top.js"></script>
在后台页面你可以点击按钮进行生成js代码：
生成最新新闻10条js文件：<button onclick="window.location='Creatjs.asp'">生成js文件</button>

七。input高级限制级用法及下拉框选项分组

1.取消按钮按下时的虚线框
　　在input里添加属性值 hideFocus 或者 HideFocus=true

2.只读文本框内容
在input里添加属性值 readonly

3.防止退后清空的TEXT文档(可把style内容做做为类引用)
　　<INPUT style=behavior:url(#default#savehistory); type=text id=oPersistInput>

4.ENTER键可以让光标移到下一个输入框
　　<input onkeydown="if(event.keyCode==13)event.keyCode=9" >

5.只能为中文(有闪动)
　　<input onkeyup="value=value.replace(/[ -~]/g,'')" onkeydown="if(event.keyCode==13)event.keyCode=9">

6.只能为数字(有闪动)
　　<input onkeyup="value=value.replace(/[^\d]/g,'') "onbeforepaste="clipboardData.setData('text',clipboardData.getData('text').replace(/[^\d]/g,''))">

7.只能为数字(无闪动)
　　<input style="ime-mode:disabled" onkeydown="if(event.keyCode==13)event.keyCode=9" onKeyPress="if ((event.keyCode<48 || event.keyCode>57)) event.returnValue=false">

8.只能输入英文和数字(有闪动)
　　<input onkeyup="value=value.replace(/[\W]/g,'')" onbeforepaste="clipboardData.setData('text',clipboardData.getData('text').replace(/[^\d]/g,''))">

9.屏蔽输入法
　　<input type="text" name="url" style="ime-mode:disabled" onkeydown="if(event.keyCode==13)event.keyCode=9">

10. 只能输入数字，小数点，减号（-）字符(无闪动)
　　<input onKeyPress="if (event.keyCode!=46 && event.keyCode!=45 && (event.keyCode<48 || event.keyCode>57)) event.returnValue=false">

11. 只能输入两位小数，三位小数(有闪动)
　　<input maxlength=9 onkeyup="if(value.match(/^\d{3}$/))value=value.replace(value,parseInt(value/10)) ;value=value.replace(/\.\d*\./g,'.')" onKeyPress="if((event.keyCode<48 || event.keyCode>57) && event.keyCode!=46 && event.keyCode!=45 || value.match(/^\d{3}$/) || /\.\d{3}$/.test(value)) {event.returnValue=false}" id=text_kfxe name=text_kfxe>
======================================================
下拉框选项分组
<select name="f" onchange="this.form.submit();">
<optgroup label="网站范围">
<option value="-1" selected="selected">请选择一个</option>
<option value="cp" >控制面板</option>
<option value="pm" >私人信息</option>
<option value="subs" >订阅</option>
<option value="wol" >看谁在线</option>
<option value="search" >搜索论坛</option>
<option value="home" >论坛首页</option>
<option value="-1">--------------------</option>
</optgroup>
</select>

======================================================

取得数组最大值：
snum="345,231,56,786,1100,356,1200,300,685,111,134,765"

function GetMax(str)
num=split(str,",")
max=num(0)
for ii=0 to ubound(num)
if cint(num(ii))>cint(max) then max=num(ii)
response.Write "num="&num(ii)&",max="&max&"<br />"
next
GetMax=max
end function

response.Write "数组"&snum&"<br />最大值:"&GetMax(snum)

八。大臉娃娃符號表
01. <(￣︶￣)> 02. <(￣︶￣)/ 03. b(￣▽￣)d 04. 汗(￣口￣)!!

05. ╮(￣▽￣)╭ 06. ╰(￣▽￣)╭ 07. ╮(￣﹏￣)╭ 08. (￣▽￣@)

09. ○(￣﹏￣)○ 10. <(￣oo,￣)/ 11. ╮(￣▽￣")╭ 12. ︿(￣︶￣)︿

13. /(￣▽￣)♂ 14. /(￣▽￣)♀ 15. ╭（￣m￣*)╮ 16. ╰(￣▽￣)╯

17. <(@￣︶￣@)> 18. 帥(￣▽￣)σ" 19. 羞(#￣▽￣#) 20. （￣Ｑ￣）╯

21. 漲(￣︶￣)↗ 22. 跌(┬＿┬)↘ 23. <(￣ c￣)y▂ξ 24. ε(￣□￣)3||

25. ╮(╯▽╰)╭ 26. ╮(╯_╰)╭ 27. ╮(﹀_﹀")╭ 28. ╰(‵□′)╯

29. （＃－.－）/　30. (︶︿︶)=凸 31. (((‵□′))怒 32. ╭(─?─)╮

33. ˋ(′～‵")ˊ 34. ˋ(′o‵")ˊ 35. ˋ(′ε‵")ˊ 36. \(╯▼╰)/

37. ┐(─__─)┌ 38. <(‵^′)>氣! 39. ┌(‵▽′)╭ 40. #(┬＿┬)泣!

41. <(￣︶￣)> <(￣︶￣)><(￣︶￣)> 42. <(￣︶￣)/<(￣︶￣)/<(￣︶￣)/

43. 看拳o(╬￣皿￣)=○# (￣#)3￣) 44. K.O <(o一-一)=○# (￣#)3￣)

45. (╯‵□′)╯︵ ┴─┴ 翻桌啦! 46. 翻桌啦! ┴─┴ ︵ ╰(‵□′╰)

47. ╭∩╮(￣▽￣)╭∩╮你有沒有搞錯! 48. 哼.哼.哼 <(︶︿︶)_╭∩╮╭∩╮

49. \("▔□▔)/\("▔□▔)/\("▔□▔)/ 50. ~(￣▽￣)~(￣▽￣)~爽到不行~

51. ~(￣3￣)~(︺ε﹀)~(￣3￣)~快送醫! 52. 無影腳<( ￣^￣)︵θ︵θ☆( >_<)

53. 笨蛋<( ‵□′)───Cε(┬＿┬)3 54. 夾!<( ‵□′)───C＜─___-)||

55. ╭ (′▽`)╭(′▽`)╭(′▽`)╯Go! 56. ︿(￣︶￣)︽(￣︶￣)︿飛.飛.飛.

57. 兇手!兇手就是你! <(￣﹌￣)@m 58. 我..我..是大豬頭╭(﹊∩∩﹊#)╮

59. 來嘛!╮(╯◇╰)╭口禾火～口禾火～ 60. …(⊙_⊙;)… ○圭~○列~怎麼醬？

61. <(￣oo,￣)/豬頭不是一天造成的! 62. ˋ(′o‵")ˊ這個你問我也不知道~

63. 有火星人~ \("▔□▔)/\("▔□▔)/ 64. 不要以為我不知道咩!┌(‵▽′)╭

65. <(￣ c￣)y▂ξ 真煩,來哈根草吧~ 66. 叔叔~這樣很冷耶! （＃－.－）/

67. 我是優質大帥哥一枚. \(￣▽￣)♂ 68. ♀(￣▽￣)/ 我是優質大美女一枚.

69. ┐(─__─)┌ 你說我有啥米辦法咧~ 70. 吃飽飽，睡好好! ○(*￣︶￣*)○

71. 有沒有被豬揍過啊? ○(#‵︿′#)○ 72. ε(┬┬＿┬┬)3 我真命苦 ..

73. 拆屋 ┴┴ ︵╰(‵□′)╯︵ ┴┴ 74. 冷到不行 ≡￣﹏￣≡ 冷到不行..

75. <(‵^′)> 我看你還是回火星去好了! 76. <(￣oo,￣)/ 沒看過豬哥嗎??...

77. <(￣︶￣)/ 喜歡嗎？把拔買給你～ 78. ︿(￣︶￣)︿這學期歐趴歐趴啦～

79. 無影腳昇級版 <( ￣^￣)︵θ︵θ︵θ︵θ︵θ︵θ︵θ︵θ︵θ☆( >_<)~啊!

80. 惡魔集團o(‵▽′)ψ 81. ψ(╰_╯)σ??☆咒 82. ψ(￣︶￣)ψ(￣︶￣)ψ

83. 嘟著嘴 (￣)︿(￣) 84.（⊙ｏ⊙）目瞪口呆 85. \(～__～)/ 要抱抱啦...

86. (＞﹏＜) 不～要～啦 87. （⊙.⊙）a...怎樣？ 88. 〒▽〒哇哇～人家不依

89. o(一︿一+)o 怨.念 90. (─.─|||| 很多條線 91. （＃－－）/ 下次小心.

92. 鬼魂團ㄟ(川.一ㄟ) 93. √(─皿─)√ 讓我咬　94. (′ 3`)y==~ 人生海海..

95. (￣y▽￣)╭ 唉唷唷~ 96. \(╯-╰)/ 不是我殺的 97. (￣▽￣＃) = ﹏﹏飄走

98. m(_ _)m 大人饒命啊! 99. ╭(′▽`)╭(′▽`)╯(讓咱們一起奔向夕陽吧...)

九。转一个注册时阅读条款时间控制

<form action="http://bbs.etosky.com" method="post" name="agree">
欢迎注册E天娱乐：
条款若干........

<input type="submit" value="请认真查看<服务条款和声明> (10)" name="agreeb">
</form>

<SCRIPT language=javascript>

</SCRIPT>

十。一个格式化时间日期函数

我们有时候遇到的日期格式可能是2004-1-12 ,系统自动将月份中的0去掉了，但是有时候我们需要完整的日期格式，如：2004-01-12 那么怎么办呢？下面的几个函数可以轻松搞定。
'将一个一位的数字前面加零

function FillZero(str)
ttt=str
if len(str)=1 then
ttt="0" & str
end if
FillZero=ttt
end function

'转化日期，将一位补上零 2003-1-2 --> 2003-01-02

function ConvertDate(tDate)
ttt=tDate
if isdate(tDate) then
ttt=year(tDate) & "-" & FillZero(month(tDate)) & "-" & FillZero(day(tDate))
end if
ConvertDate=ttt
end function

'输入一个日期时间串，转换成年四位，其他两位的新的日期时间串

function ConvertDateTime(tDateTime)
ttt=tDateTime
if isdate(tDateTime) then
ttt=year(tDateTime) & "-" & FillZero(month(tDateTime)) & "-" & FillZero(day(tDateTime)) & " " & FillZero(cstr(hour(tDateTime))) & ":" & FillZero(cstr(minute(tDateTime))) & ":" & FillZero(cstr(second(tDateTime)))
end if
ConvertDateTime=ttt
end function

十一。又一个格式化时间日期函数

函数名称：FormatDate
作用：将获得的时间格式化成你想要的样式显示出来，并且如果日期时间某个数值是1位数，则在其前面添加0
    如：获得的时间格式是 2006-6-25 14:6:41，在单位数字前加0将其变更成两位 2006-06-25 14:06:41
函数所含参数：DateAndTime, para
    DateAndTime：获得具体时间参数如 Now
    para：格式化后的时间样式，目前有10种样式可自行修改
    样式效果（Y 表示年，M 表示月，D 表示日，H 表示小时，MI 表示分钟，S 表示秒）：
        1. Y-M-D H:MI:S
        2. Y-M-D
        3. Y/M/D
        4. Y年M月D日
        5. M-D
        6. M/D
        7. M月D日
        8. Y年M月
        9. Y-M
        10. Y/M

Function FormatDate(DateAndTime, para)
On Error Resume Next
Dim y, m, d, h, mi, s, strDateTime
FormatDate = DateAndTime
If Not IsNumeric(para) Then Exit Function
If Not IsDate(DateAndTime) Then Exit Function
y = Mid(CStr(Year(DateAndTime)),3)
m = CStr(Month(DateAndTime))
If Len(m) = 1 Then m = "0" & m
d = CStr(Day(DateAndTime))
If Len(d) = 1 Then d = "0" & d
h = CStr(Hour(DateAndTime))
If Len(h) = 1 Then h = "0" & h
mi = CStr(Minute(DateAndTime))
If Len(mi) = 1 Then mi = "0" & mi
s = CStr(Second(DateAndTime))
If Len(s) = 1 Then s = "0" & s
Select Case para
Case "1"
   strDateTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case "2"
   strDateTime = y & "-" & m & "-" & d
Case "3"
   strDateTime = y & "/" & m & "/" & d
Case "4"
   strDateTime = y & "年" & m & "月" & d & "日"
Case "5"
   strDateTime = m & "-" & d
Case "6"
   strDateTime = m & "/" & d
Case "7"
   strDateTime = m & "月" & d & "日"
Case "8"
   strDateTime = y & "年" & m & "月"
Case "9"
   strDateTime = y & "-" & m
Case "10"
   strDateTime = y & "/" & m
Case Else
   strDateTime = DateAndTime
End Select
FormatDate = strDateTime
End Function

十二。ASP连接数据库的6种方法

第一种 - 这种方法用在ACCESS中最多
strconn = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" _
& Server.MapPath("aspfree.mdb")
set conn = server.createobject("adodb.connection")
conn.open strconn

第二种－这种方法用在SQL SERVER中多
strconn = "Driver={SQL Server};Description=sqldemo;SERVER=127.0.0.1;" _
&"UID=LoginID;Password=;DATABASE=Database_Name"
set conn = server.createobject("adodb.connection")
conn.open strconn

第三种
strconn="Driver={Microsoft Access Driver(*.mdb)};" _
&"DBQ=F:\\Inetpub\\wwwroot\\somedir\\db1.mdb;DefaultDir=" _
&"f:\\Inetpub\\wwwroot\\somedir;uid=LoginID;" _
&"pwd=Password;DriverId=25;FIL=MSAccess;"
set conn = server.createobject("adodb.connection")
conn.open strconn

第四种运用系统数据源
The following uses a Data Source Name: Example
set conn = server.createobject("adodb.connection")
conn.open "Example"

第五种运用ODBC数据源，前提是你必须在控制面板的ODBC中设置数据源
set rs = server.createobject("adodb.recordset")
rs.open "tblname", "DSNName", 3, 3 第一种 - 这种方法用在ACCESS中最多
strconn = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" _
& Server.MapPath("aspfree.mdb")
set conn = server.createobject("adodb.connection")
conn.open strconn

第六种ASP连接Oracle
ConnString = "Provider=OraOLEDB.Oracle;PLSQLRSet=1;Password=gqshad;User ID=gqshad;Data Source=mip"
Set objConn = Server.CreateObject("ADODB.Connection")
objConn.Open ConnString

十三。JS倒计时代码
<SCRIPT LANGUAGE="JavaScript">

</SCRIPT>

十四。仿动易2006限制IP功能代码

在数据库中新建一个字段用来存放IP，字段格式为备注
IP在该字段中格式如：1033218851----1033218865$$$1033218816----1033218848|||1033218851----1033218865$$$1033218816----1033218848
$$$表示IP在文本框内换行的回车符，也就是每个IP段用回车分隔，然后替换成$$$
|||表示黑白名单分隔符
1033218851----1033218865表示一个IP段

添加多个限定IP段，请用回车分隔。
限制IP段的书写方式，中间请用英文四个小横杠连接
如：255.255.255.0----255.255.255.255

///////////////////////////////////////////////////////////////////////////////////
在conn.asp中插入以下代码，并 Call IsIpLock 来判断和限制IP访问，此部分尚未调试
///////////////////////////////////////////////////////////////////////////////////
<%
Sub IsIpLock()
    If Session("IPlock") = "" Then
        Session("IPlock") = ChecKIPlock(/*取得限制IP属性*/, /*取得数据库中IP段*/, /*取得用户真实IP*/)    '//ip属性1为白名单，2为黑名单
    End If
    If Session("IPlock") = True Then
        Response.Write "<html>" & vbCrLf
        Response.Write "<head>" & vbCrLf
        Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">" & vbCrLf
        Response.Write "<title></title>" & vbCrLf
        Response.Write "</head>" & vbCrLf
        Response.Write "<body>" & vbCrLf
        Response.write "<br><p align=center><font color=""#ff0000"">对不起！您的IP（" & /*取得用户真实IP*/ & "）被系统限制。</font></p>" & vbCrLf
        Response.Write "</body>" & vbCrLf
        Response.Write "</html>"
        Response.End
    End If
End Sub

Function ChecKIPlock(ByVal sLockType, ByVal sLockList, ByVal sUserIP)
    Dim IpLock,rsLockIP,i
    Dim arrLockIPW, arrLockIPB, arrLockIPWCut, arrLockIPBCut
    IpLock = False
    ChecKIPlock = IpLock
    If sLockType = "" or IsNull(sLockType) Then Exit Function
    If sLockList = "" or IsNull(sLockList) Then Exit Function
    If sUserIP = "" or IsNull(sUserIP) Then Exit Function
    sUserIP = Etosky.EncodeIP(sUserIP)
    rsLockIP = Split(sLockList, "|||")
    If sLockType = 1 Then
        arrLockIPW = Split(Trim(rsLockIP(0)), "$$$")
        For i = 0 To UBound(arrLockIPW)
            If arrLockIPW(i) <> "" Then
                arrLockIPWCut = Split(Trim(arrLockIPW(i)), "----")
                IpLock = True
                If arrLockIPWCut(0) <= sUserIP And sUserIP <= arrLockIPWCut(1) Then IpLock = False
                If IpLock Then Exit For
            End If
        Next
    End If
    If IPlock = False And sLockType = 2 Then
        arrLockIPB = Split(Trim(rsLockIP(1)), "$$$")
        For i = 0 To UBound(arrLockIPB)
            If arrLockIPB(i) <> "" Then
                arrLockIPBCut = Split(Trim(arrLockIPB(i)), "----")
                IpLock = True
                If arrLockIPBCut(0) > sUserIP And sUserIP > arrLockIPBCut(1) Then IpLock = False
                If IpLock Then Exit For
            End If
        Next
    End If
    ChecKIPLock = IpLock
End Function
%>

///////////////////////////////////////////////////////////////////////////////////
在适当位置插入以下代码，用来简单加密、解密IP地址
///////////////////////////////////////////////////////////////////////////////////
<%
'加密IP
Public Function EncodeIP(Sip)
    Dim strIP
    strIP = Split(Sip, ".")
    If UBound(strIP) < 3 Then
        EncodeIP = 0
        Exit Function
    End If
    If IsNumeric(strIP(0)) = 0 or IsNumeric(strIP(1)) = 0 or IsNumeric(strIP(2)) = 0 or IsNumeric(strIP(3)) = 0 Then
        Sip = 0
    Else
        Sip = Int(strIP(0)) * 256 * 256 * 256 + Int(strIP(1)) * 256 * 256 + Int(strIP(2)) * 256 + Int(strIP(3)) - 1
    End If
    EncodeIP = Sip
End Function

'解密IP
Public Function DecodeIp(Sip)
    Dim strIp,sIp1,sIp2,sIp3,sIp4
    strIp = Sip
    If Not IsNumeric(strIp) Then
        DecodeIP = 0
        Exit Function
    End If
    sIp1 = Int(strIp / 256 / 256 / 256)
    sIp2 = Int((strIp - sIp1 * 256 * 256 * 256) / 256 / 256)
    sIp3 = Int((strIp - sIp1 * 256 * 256 * 256 - sIp2 *256 * 256) / 256)
    sIp4 = Int((strIp - sIp1 * 256 * 256 * 256 - sIp2 *256 * 256 - sIp3 * 256) + 1)
    Sip = sIp1 & "." & sIp2 & "." & sIp3 & "." & sIp4
    DecodeIp = Sip
End Function
%>

///////////////////////////////////////////////////////////////////////////////////
格式化显示IP地址，用后后台编辑限制的IP段
///////////////////////////////////////////////////////////////////////////////////
<%
'用来格式化最后得到的IP段
Function RightCut(Tempstr,strTemp,sNum)
    If Right(Tempstr,sNum) = strTemp Then
        RightCut = Left(Tempstr,Len(Tempstr)-sNum)
    Else
        RightCut = Tempstr
    End If
End Function

'这个用来表示读出数据库中的限制IP的字段内容
LockIp = "1033218851----1033218865$$$1033218816----1033218848|||1033218851----1033218865$$$1033218816----1033218848"
LockIp = Split(LockIP,"|||"
%>
白名单
<textarea name="LockIpWhite" id="LockIpWhite" cols="50" rows="5">
<%
Dim arrLockIPW,arrLockIPWCut,arrLockIpWhite,LockIpWhite
arrLockIPW = Split(LockIp(0),"$$$")
For i = 0 To UBound(arrLockIPW)
    arrLockIPWCut = Split(Trim(arrLockIPW(i)), "----")
    arrLockIpWhite = DecodeIp(arrLockIPWCut(0)) & "----" & DecodeIp(arrLockIPWCut(1))
    LockIpWhite = LockIpWhite + arrLockIpWhite & "$$$"
Next
Response.Write Replace(RightCut(LockIpWhite,"$$$",3),"$$$",Chr(13))
%></textarea>

黑名单
<textarea name="LockIpBlack" id="LockIpBlack" cols="50" rows="5">
<%
Dim arrLockIPB,arrLockIPBCut,arrLockIpBlack,LockIpBlack
arrLockIPB = Split(LockIp(1),"$$$")
For i = 0 To UBound(arrLockIPB)
    arrLockIPBCut = Split(Trim(arrLockIPB(i)), "----")
    arrLockIpBlack = DecodeIp(arrLockIPBCut(0)) & "----" & DecodeIp(arrLockIPBCut(1))
    LockIpBlack = LockIpBlack + arrLockIpBlack & "$$$"
Next
Response.Write Replace(RightCut(LockIpBlack,"$$$",3),"$$$",Chr(13))
%></textarea>

///////////////////////////////////////////////////////////////////////////////////
IP段提交保存部分
///////////////////////////////////////////////////////////////////////////////////
Function ChkIP(Ip,Num)   '用正则判断IP和IP段格式是否正确
    Dim RegEx
    Set RegEx = New RegExp
    If Num = 1 Then
        RegEx.Pattern = "^\d{1,3}.\d{1,3}.\d{1,3}.\d{1,3}$"
    Else
        RegEx.Pattern = "^\d{1,3}.\d{1,3}.\d{1,3}.\d{1,3}----\d{1,3}.\d{1,3}.\d{1,3}.\d{1,3}$"
    End If
    ChkIP = RegEx.Test(Ip)
End Function

Dim WhiteIP,arrLockIPW,arrLockIPWCut,arrLockIpWhite,LockIpWhite
Dim BlackIP,arrLockIPB,arrLockIPBCut,arrLockIpBlack,LockIpBlack

'IP白名单保存
WhiteIP = Trim(Request.Form("LockIpWhite"))
WhiteIP = Replace(WhiteIP,Chr(10),"")
arrLockIPW = Split(WhiteIP,Chr(13))

For i = 0 To Ubound(arrLockIPW)
    If Instr(arrLockIPW(i),"----") = 0 Then
        Response.Write "<br><li>请正确填写黑白名单IP地址。</li>"
        Exit For
    End If
    arrLockIPWCut = Split(arrLockIPW(i),"----")
    If Not ChkIP(arrLockIPWCut(0),1) or Not ChkIP(arrLockIPWCut(1),1) or Not ChkIp(arrLockIPWCut(0) & "----" & arrLockIPWCut(1),0) Then
        Response.Write "<br><li>请正确填写黑白名单IP地址。</li>"
        Exit For
    End If
    arrLockIpWhite = EncodeIP(arrLockIPWCut(0)) & "----" & EncodeIP(arrLockIPWCut(1))
    LockIpWhite = LockIpWhite & arrLockIpWhite & "$$$"
Next
LockIpWhite = RightCut(LockIpWhite,"$$$",3)

'IP黑名单保存
BlackIP = Trim(Request.Form("LockIpBlack"))
BlackIP = Replace(BlackIP,Chr(10),"")
arrLockIPB = Split(BlackIP,Chr(13))

For i = 0 To Ubound(arrLockIPB)
    If Instr(arrLockIPB(i),"----") = 0 Then
        Response.Write "<br><li>请正确填写黑白名单IP地址。</li>"
        Exit For
    End If
    arrLockIPBCut = Split(arrLockIPB(i),"----")
    If Not ChkIP(arrLockIPBCut(0),1) or Not ChkIP(arrLockIPBCut(1),1) or Not ChkIp(arrLockIPBCut(0) & "----" & arrLockIPBCut(1),0) Then
        Response.Write "<br><li>请正确填写黑白名单IP地址。</li>"
        Exit For
    End If
    arrLockIpBlack = EncodeIP(arrLockIPBCut(0)) & "----" & EncodeIP(arrLockIPBCut(1))
    LockIpBlack = LockIpBlack & arrLockIpBlack & "$$$"
Next
LockIpBlack = RightCut(LockIpBlack,"$$$",3)

'保存进数据库的IP段
LockIp = LockIpWhite & "|||" & LockIpBlack

Conn.Execute("Update [TableName] Set LockIp = '" & LockIp & "'")

====代码完，收工============================================================

评论:(0)复制地址

QQ空间新浪微博腾讯微博人人网网易微博更多

发布:苗景云 | 分类:IT技术&设计 | Tags:

上一篇：科讯CMS取消过滤关键词的方法下一篇：JS获取Input值，赋值embed Src进行播放的办法(兼容IE,chrome)

发表评论:

◎欢迎参与讨论，请在这里发表您的看法、交流您的观点。

苗景云的博客

有点用的代码

相关文章

发表评论: