兄弟的博客【L-BLOG，网络电视精灵】 http://www.030904.com/blog 兄弟的博客【L-BLOG，网络电视精灵】 zh-cn Copyright 2003-2004 Loveyuki webmaster@loveyuki.com 兄弟的博客【L-BLOG，网络电视精灵】 http://www.030904.com/blog/images/logos.gif http://www.030904.com/blog 兄弟的博客【L-BLOG，网络电视精灵】 http://www.030904.com/blog/blogview.asp?logID=1007<![CDATA[给L-BLOG加上智能黑名单系统]]>glenluo建站心得2010-3-13 21:49:23http://www.030904.com/blog/blogview.asp?logID=1007
现在，我们来设计数据库的表了，不用很复杂，几个字段就可以了，重点是记录错误来源的页面以及提交的IP以及时间即可，所以，字段设计如下：
Err_id  自动编号 主键
Errorip  文本 字段大小20
Errorref  文本 字段大小100
Add_time  时间/日期 默认值Now()
保存表的名字为：blackip

然后在include/library.asp的最后，也就是"%>"之前加上以下代码：
Sub Add_blackip
    Dim Errorref,Errorip
    Errorref=request.servervariables("http_referer")
    Errorip=Request.ServerVariables("REMOTE_ADDR")
    Conn.execute("Insert into blackip (Errorref,Errorip) values('"&Errorref&"','"&Errorip&"')")
End Sub

Sub Blockip
    Erroripnum=Conn.ExeCute("SELECT COUNT(Err_id) FROM blackip WHERE Errorip='"&Guest_IP&"' and Day(Add_time)=Day(Now)")(0)
    If Erroripnum>=3 then
    Response.write("<center><font color=red>由于你今天多次提交表单错误,系统自动屏蔽了你的IP,请改天再来吧!</font>")
    Response.end
    End if
End Sub

接着在你的blogcomm.asp；guestbook.asp；photoshow.asp；register.asp等页面的每个出错提示后加上Call Add_blackip

比如：
ElseIf Trim(Request.Form("validatecode"))=Empty Or Trim(Session("L-Blog_ValidateCode"))<>Trim(Request.Form("validatecode")) Then
msg_Title="出现错误"
msg_Content="<a href=""javascript:history.go(-1);"">你没有输入验证码或验证码错误，点击返回上一页</a>"
Call Add_blackip'这个是新增加的内容

最后在commond.asp里面找到站点统计代码，在End if后面加上：Call Blockip

哈哈，整个智能系统就完成了！赶快行动，给自己的博客增加防火墙吧！

按此在新窗口打开图片

为了方便大家，数据库我已经打包放上来了，大家导入你的数据库就可以使用了！

点击下载此文件]]>http://www.030904.com/blog/blogview.asp?logID=1006<![CDATA[电子科技大学许愿门事件]]>glenluo心情日记2010-3-12 21:12:06http://www.030904.com/blog/blogview.asp?logID=1006
而众多愿望中却独独有一个愿望吸引了众多人的关注，也由此引发“科大许愿门”事件。 
看图说话！ 

今天中午突然爆发了“许愿门”事件，起因就是下面这个女生节的心愿 

显示影音文件 点击显示/隐藏影音文件
影音源文件地址：http://www.tudou.com/v/XSgcEPc9nTE


按此在新窗口打开图片
按此在新窗口打开图片]]>http://www.030904.com/blog/blogview.asp?logID=1005<![CDATA[邓丽欣不雅照事件]]>glenluo心情日记2010-3-12 21:06:01http://www.030904.com/blog/blogview.asp?logID=1005
　　本报讯(记者 潘媛 实习生 吴洋)从2008年2月YANZHAOMEN爆发后，先后有7位女艺人受到牵连，其中包括张柏芝、阿娇、陈文媛以及陈冠希的正牌女友杨永晴。事件过去两年，近日再起风云：曾有玉女之称的香港女星邓丽欣被八卦杂志曝光，称其一段6分钟的不雅视频流出。不过昨日邓丽欣与其经纪公司金牌大风方面均否认此事的真实性。 

　　八卦杂志曝光邓丽欣不雅视频截图 

按此在新窗口打开图片

http://yesee.qianlong.com/3910/2010/03/12/4542@5561989.htm]]>http://www.030904.com/blog/blogview.asp?logID=1004<![CDATA[ASP中几个实用的小技巧]]>glenluo建站心得2010-3-12 19:05:05http://www.030904.com/blog/blogview.asp?logID=1004
今天自己遇到个简单的问题，不过估计太笨了，竟然还去找了资料才知道怎么用。就是ASP计算天数差的函数，下面给出函数用法：
<%=DateDiff("d","2009-12-10",Date())%>
特别注意得是，日期差的值，是用后面的日期减去前面的日期！大家顺序不要搞错了哦，否则会出现负值


判断数据库字段值为空的方法

判断数据库字段值为空的方法：
如果你用 if rs("XXX")="" then 那么很容易出错，而且得不到结果，
只能用的办法是：isnull(rs("XX"))=true
在这里把我遇到的问题和大家分享！ 


防网站小偷来采摘数据

防网站小偷来采摘数据。自己辛苦写的文章或者培养的站点不想那么快那么容易就被人采集掠夺资源吧，下面一个小函数可以帮助大家解决部

分问题：
function Appeal()
Dim AppealNum,AppealCount
   AppealNum=30 '同一IP10秒内请求限制30次
   AppealCount=Request.Cookies("AppealCount") 
   If AppealCount="" Then
    response.Cookies("AppealCount")=1
    AppealCount=1
    response.cookies("AppealCount").expires=dateadd("s",10,now())
   Else
    response.Cookies("AppealCount")=AppealCount+1
    response.cookies("AppealCount").expires=dateadd("s",10,now())
  End If
  if int(AppealCount)>int(AppealNum) then
   response.Write "<FIELDSET style='width:350px'><LEGEND>描述</LEGEND>"
   response.write "<font style='font-size:14px'>抓取很累，歇一会儿吧！</font>"
   response.Write "</FIELDSET>"
   response.end
  End If 
end function 


asp获取完整URL地址以及参数

很多人用JS来获取网站的URL，但有时候需要ASP代码来获取，下面的例子可以供大家参考：
<%
response.write "http://"&Cstr(Request.ServerVariables("SERVER_NAME"))&Cstr(Request.ServerVariables("URL"))

&"?"&request.QueryString
%> 


ASP终止死循环程序或者关闭Access数据库

利用Access做为数据库进行动态网站开发的时候我们经常会遇到些问题。就是程序遇到了死循环或者占用了大量的服务器资源导致数据库一直

呈打开锁定状态。这个时候非常麻烦。解决办法有两个。第一，如果是在本地调试，可以重新启动IIS来终止进程。或者手工打开Access数据库

，再关闭，这样也可以关闭数据库。
但要是遇到在服务器上运行时出现了问题，很明显，上面的两种方法更本无法使用。那我们如果要重新传数据库覆盖原来的文件就无法操作了

。因为数据库是打开状态，无法进行任何写操作。 不过，下面的方法可以解决在服务器上调试或运行程序遇到的问题。把下面的代码保存成

asp文件，然后传至服务器上，运行文件。一切就轻松搞定了！
<%sub ClearCache
  application.Contents.RemoveAll()
  Session.Contents.RemoveAll()
end sub
call ClearCache()
%> 


获取一个 URL地址的网页文件名

<%
'这段代码是获取一个 URL地址的网页文件名.
changdu=len(request.ServerVariables("URL"))
url=instrrev(request.ServerVariables("URL"),"/")
url=url+1
ends=changdu+1-url
finally=mid(request.ServerVariables("URL"),url,ends) 'finally是最终的文件名
response.Write finally
%> 

]]>http://www.030904.com/blog/blogview.asp?logID=1003<![CDATA[asp设置cookies过期时间的方法]]>glenluo编程技术2010-3-12 19:00:03http://www.030904.com/blog/blogview.asp?logID=1003
保留COOKIES一个小时 
Response.Cookies("MyCookie").Expires= (now()+1/24) 

Response.Cookies("MyCookie").Expires = DateAdd("h", 1, Now()) 

Response.Cookies("CookieName").Expires=DateAdd("m",60,now()) 
设置60个月以后过期 

Response.Cookies("User").expires=second()+7 
在expires后面定义的时间可以用时间函数代替 
例如：date()+7就表示在今天的时间上加上7天，而second()+7则是7秒了。 

Response.Cookies("字段名").expires=时间函数+N，例如： 
Response.Cookies("name2").expires=date+1，表示Cookies保存1天，再比如： 
Response.Cookies("name2").expires=Hour+8，表示Cookies保存8小时。 
这种方法我测试过不行（在2003server,iis6.0中)，不管second后面有无加()，访问时会出现500错误（还是无法显示网页？忘了）。 

织梦尤文：这里的时间累加建议还是使用DateAdd函数，比如我们要累加一小时，则使用： 
Response.Cookies("baidooglecom").expires = DateAdd("h", 1, Now()) 

30分钟： 
Response.Cookies("CookieName").Expires=DateAdd("n",30,now()) 

dateadd("S",30,now()) 得到秒 

Expires 指定 cookie 的过期日期。为了在会话结束后将 cookie 存储在客户端磁盘上，或在许多时候，我们希望能更长时间地在访问者的计算机上保存cookie。必须设置该日期。 
若此项属性的设置未超过当前日期，则在任务结束后 cookie 将到期。 
cookie的使用到期时间为“2010年1月1日”： Response.Cookies("CookieName").Expires=#January 01, 2010# 
cookie的过期时间为“cookie的创建时间＋365天”：Response.Cookies("CookieName").Expires=Date+365 推荐的
但最好不要随便写 Response.Cookies("CookieName").Expires=Date，这样页面之间的调用时值会为空。]]>http://www.030904.com/blog/blogview.asp?logID=1002<![CDATA[ASP各种函数功能木块集合]]>glenluo编程技术2010-3-12 18:58:51http://www.030904.com/blog/blogview.asp?logID=1002
<%

call start()
'开始执行
Function start()
  call get_rq() '安全过滤
  'call Appeal() '防小偷程序
  call webAgent() '检测客户端
End Function
Function createRs()
   dim rsObj
   set rsObj=server.CreateObject("adodb.recordset")
   set createRs=rsObj
End Function

sub showError(strval)
  response.Write "<div style=""border:1 solid #0099FF; width:500px; height:250px;"">"
  response.Write strval
  response.Write "</div>"
  response.End()
end sub

'转向
Sub RedirectUrl(strHttp)
  Response.write "<script language='javascript'>location.href='"&strHttp&"';</script>"
End Sub

sub Alert(sText)
  Response.write "<script language='javascript'>alert('" & sText & "');</script>"
end sub

sub History(iStep)
  Response.write "<script>window.history(" & iStep & ");</script>"
End Sub

sub Funmsg(iStep,sText)
Response.Write "<script>alert('"&sText&"');location.href='"&iStep&"';</script>"
end sub

'执行非法提交检测
Sub get_rq()
dim qs,errc,iii
qs=request.servervariables("query_string")
dim nothis(18)
nothis(0)="net user"
nothis(1)="xp_cmdshell"
nothis(2)="/add"
nothis(3)="exec%20master.dbo.xp_cmdshell"
nothis(4)="net localgroup administrators"
nothis(5)="select"
nothis(6)="count"
nothis(7)="asc"
nothis(8)="char"
nothis(9)="mid"
nothis(10)="'"
nothis(11)="::"
nothis(12)=""""
nothis(13)="insert"
nothis(14)="delete"
nothis(15)="drop"
nothis(16)="truncate"
nothis(17)="from"
nothis(18)="and user>0"
errc=false
for iii= 0 to ubound(nothis)
   if instr(qs,nothis(iii))<>0 then
    errc=true
   end if
next
if errc then
' Response.Write("对不起，非法URL地址请求!")
  response.Write "<meta http-equiv=""Refresh"" content=""3;URL=index.html"">"
  response.Write "<div style='border:1px solid #CCCCCC;width:600px;height:25px;padding:5px;padding-left:15px;'>"
  response.Write "<font style='font-size:14px'>Diggcms系统友情提示：<br>"
  response.Write "&nbsp;&nbsp;HTTP 错误 404 -URL地址请求出错<br>"
  response.Write "</div>"
  response.end
end if
End Sub
'初始化被过滤的客户端列表
Function webAgent()
  dim strAgentFilter
  strAgentFilter="webzip|||flashget|||offline|||teleport"
  If ChkAgent(strAgentFilter)=False Then
   response.Write "错误"
   response.End()
   ' AddErrCode(1)
   ' Call ChkError()
  End If  
End Function
' * 检查浏览站点的客户端
' * strAL  —— 屏蔽的客户端标志列表
Function ChkAgent(strAL)
  Dim Agent,iijj

  ChkAgent=True
  Agent=Trim(Lcase(Request.Servervariables("HTTP_USER_AGENT")))
  If (Not IsNull(strAL)) Then
    strAL=Split(strAL,"|||")
    For iijj=0 To Ubound(strAL)
      If Instr(Agent,strAL(iijj))>0 Then 
       ChkAgent=False
      end if 
    Next
  End If
End Function

'/*
' 防网站小偷来采摘数据
' */
function Appeal()
Dim AppealNum,AppealCount
   AppealNum=30 '同一IP10秒内请求限制30次
   AppealCount=Request.Cookies("AppealCount") 
   If AppealCount="" Then
    response.Cookies("AppealCount")=1
    AppealCount=1
    response.cookies("AppealCount").expires=dateadd("s",10,now())
   Else
    response.Cookies("AppealCount")=AppealCount+1
    response.cookies("AppealCount").expires=dateadd("s",10,now())
  End If
  if int(AppealCount)>int(AppealNum) then
   response.Write "<FIELDSET style='width:350px'><LEGEND>描述</LEGEND>"
   response.write "<font style='font-size:14px'>抓取很累，歇一会儿吧！<br><a href="&Website&">"&Website&"</a></font>"
   response.Write "</FIELDSET>"
   response.end
  End If 
end function

'/*
' 防外部提交
' 结合Chkpost函数
' */
function chpost()
If Not ChkPost(Website) then
  response.Write "<center>"
  response.Write "<FIELDSET style='width:350px'><LEGEND>系统提示</LEGEND>"
  Response.Write "<font style='font-size:14px'>"
  response.Write "&nbsp;&nbsp;&nbsp;<a href=http://www.diggcms.com>返回</a>"
  response.Write "</font></FIELDSET>"
  response.Write "<br><br><div style='border:1px solid #CCCCCC;width:235px;height:25px;padding:5px;padding-left:15px;'><a href=http://www.diggcms.com target=_blank title=免费的Diggcms内容管理系统>Diggcms－给你最好的</a></div>"
  response.Write "</center>"
response.End()
end if
End function

'/*
' 处部提交数据查
' */
Function ChkPost(web_url)
dim Server_V1,Server_V2
ChkPost=False
Server_V1=Cstr(Request.ServerVariables("HTTP_REFERER"))
Server_V2=Cstr(Request.ServerVariables("SERVER_NAME"))
''--------------------------------------------
  ''Instr(所有，其中),包括>0,否则=0
''--------------------------------------------
If Mid(Server_V1,8,Len(Server_V2))<>Server_V2 or Instr(web_url,Server_V2)=0 Then
    ChkPost=False
Else
    ChkPost=True
End If
End Function
'========================================================文件操作
'/*
' 删除文件
' */
Function DelFile(DelFilePath)
On Error Resume Next
DelFile= False
set MyFileObject=Server.CreateOBject("Scripting.FileSystemObject")
MyFileObject.DeleteFile""&Server.MapPath(""&DelFilePath&"")&""
Set MyFileObject= Nothing
If 0 = Err or 53 = Err Then
   DelFile= True
else
   CatchError(""&DelFilePath&"文件无法删除！")
end if
On Error GoTo 0
End Function

'/*
' 检查多层目录不存在，则生成
' */
function CreateDIR(LocalPath) 
  dim patharr,path_level,i,pathtmp,cpath,FileObject 
  on error resume next 
  LocalPath = Server.MapPath(LocalPath) 
  LocalPath = replace(LocalPath,"\","/") 
  set FileObject = server.createobject("Scripting.FileSystemObject") 
   patharr = split(LocalPath,"/") 
   path_level = ubound(patharr) 
   for i = 0 to path_level 
   if i=0 then pathtmp = patharr(0) & "/" else pathtmp = pathtmp & patharr(i) & "/" 
   cpath = left(pathtmp,len(pathtmp)-1) 
   if not FileObject.FolderExists(cpath) then FileObject.CreateFolder(cpath) 
   next 
   set FileObject = nothing 
   if err.number<>0 then 
   CreateDIR = false 
   err.Clear 
   else 
   CreateDIR = true 
   end if 
end function

'/*
' cookie编码加密
' */
Function CodeCookie(Str)
  Dim i
  Dim StrRtn
  For i = Len(Str) To 1 Step -1
    StrRtn = StrRtn & AscW(Mid(Str, i, 1))
    If (i <> 1) Then StrRtn = StrRtn & "a"
  Next
  CodeCookie = StrRtn
End Function
'/*
'cookie解密
' */ 
Function DecodeCookie(Str)
  Dim i
  Dim StrArr, StrRtn
  StrArr = Split(Str, "a")
  For i = 0 To UBound(StrArr)
    If IsNumeric(StrArr(i)) = True Then
      StrRtn = ChrW(StrArr(i)) & StrRtn
    Else
      StrRtn = Str
      Exit Function
    End If
  Next
  DecodeCookie = StrRtn
End Function

'/*
' * 设置Cookies
' * vparameter:参数，val:值
' */
Function SetCookies(vparameter,val)
response.Cookies(vparameter)=val
response.Cookies(vparameter).Expires=dateadd("H",12,now())
End Function

'/*
' *　读取Cookies
' */
Function GetCookies(vparameter)
GetCookies=request.Cookies(vparameter)
End Function

'============================================================安全过滤
'/*
' 安全过滤
' */
Function SafeSql(Str,Flag)
SafeSql=Str
If Flag=1 Then
  If Not IsNumeric(SafeSql) Or Trim(SafeSql)="" Then
   ' response.Write "<meta http-equiv=""Refresh"" content=""3;URL=index.asp"">"
   response.Write "<FIELDSET style='width:350px'><LEGEND>描述</LEGEND>"
   Response.Write "<font style='font-size:14px'>参数错误,参数类型应为数值型。<br>当前值是："&Str&""
   response.Write "</font></FIELDSET>"
   response.Write "<br><br><div style='border:1px solid #CCCCCC;width:235px;height:25px;padding:5px;padding-left:15px;'><a href=http://www.hcj123.com target=_blank title=行业黄页门户>好财经－给你最好的</a></div>"
   Response.End
  End If
ElseIf Flag=2 Then
    Str =trim(Str)
    Str = replace(Str, ">", "&gt;")
    Str = replace(Str, "<", "&lt;")
    Str=Replace(Str,"\","&#92;")
    Str=Replace(Str,"--","&#45;&#45;")     
    Str = Replace(Str, CHR(34), "&quot;") '过滤''
    Str = Replace(Str, CHR(39), "&#39;") '过滤'
   ' Str = Replace(Str, CHR(13)&CHR(10), "<BR>") '回车换行
   Str =Replace(Str,CHR(42),"&#42;")  '“*”
   Str =Replace(Str,CHR(44),"&#44;")  '“,”
    Str = Replace(Str, "select", "select")
    Str = Replace(Str, "join", "join")
    Str = Replace(Str, "union", "union")
    Str = Replace(Str, "where", "where")
    Str = Replace(Str, "insert", "insert")
    Str = Replace(Str, "delete", "delete")
    Str = Replace(Str, "update", "update")
    Str = Replace(Str, "like", "like")
    Str = Replace(Str, "drop", "drop")
    Str = Replace(Str, "create", "create")
    Str = Replace(Str, "modify", "modify")
    Str = Replace(Str, "rename", "rename")
    Str = Replace(Str, "alter", "alter")
    Str = Replace(Str, "cast", "cast")
  SafeSql=Str
Else
  response.Write "<FIELDSET style='width:350px'><LEGEND>描述</LEGEND>"
  Response.Write "<font style='font-size:14px'>参数错误SafeSql方法参数在1,2范围内"
  response.Write "</font></FIELDSET>"
  response.Write "<br><br><div style='border:1px solid #CCCCCC;width:235px;height:25px;padding:5px;padding-left:15px;'><a href=http://www.hcj123.com target=_blank title=行业黄页门户>好财经－给你最好的</a></div>"
  Response.End
End If
End Function

'/*
' HTML解码函数
' */
Function HTMLDecode(refStringing) 
  Dim fString
    fString=refStringing 
  If Not IsNull(fString) Then 
   fString = Replace(fString, "&gt;", ">") 
   fString = Replace(fString, "&lt;", "<") 
   fString=Replace(fString,"&#92;","\")
   fString=Replace(fString,"&#45;&#45;","--")  
   fString = Replace(fString, "&quot;",CHR(34)) '还原'' 
   fString = Replace(fString, "&#39;", "'") '还原'
'   if instr(fString,CHR(13)&CHR(10))>0 then
'     fString = Replace(fString, CHR(13)&CHR(10), "<BR>") '回车换行 
'   end if
   fString = Replace(fString, "select", "select")
   fString = Replace(fString, "join", "join")
   fString = Replace(fString, "union", "union")
   fString = Replace(fString, "where", "where")
   fString = Replace(fString, "insert", "insert")
   fString = Replace(fString, "delete", "delete")
   fString = Replace(fString, "update", "update")
   fString = Replace(fString, "like", "like")
   fString = Replace(fString, "drop", "drop")
   fString = Replace(fString, "create", "create")
   fString = Replace(fString, "modify", "modify")
   fString = Replace(fString, "rename", "rename")
   fString = Replace(fString, "alter", "alter")
   fString = Replace(fString, "cast", "cast")      
   HTMLDecode = fString
  End If 
End Function
'/*
' 防注入
' */
Function FunSQL(Str)
If Isnull(Str) Then
FunSQL = ""
Exit Function 
End If
  Str=trim(Str)
Str = Replace(Str,Chr(0),"", 1, -1, 1)
Str = Replace(Str, """", "&quot;", 1, -1, 1)
Str = Replace(Str,"<","&lt;", 1, -1, 1)
Str = Replace(Str,">","&gt;", 1, -1, 1) 
  Str = Replace(Str,CHR(42),"&#42;")  '“*”
  Str = Replace(Str,CHR(44),"&#44;")  '“,”
Str = Replace(Str, "script", "&#115;cript", 1, -1, 0)
Str = Replace(Str, "SCRIPT", "&#083;CRIPT", 1, -1, 0)
Str = Replace(Str, "Script", "&#083;cript", 1, -1, 0)
Str = Replace(Str, "script", "&#083;cript", 1, -1, 1)
Str = Replace(Str, "object", "&#111;bject", 1, -1, 0)
Str = Replace(Str, "OBJECT", "&#079;BJECT", 1, -1, 0)
Str = Replace(Str, "Object", "&#079;bject", 1, -1, 0)
Str = Replace(Str, "object", "&#079;bject", 1, -1, 1)
Str = Replace(Str, "applet", "&#097;pplet", 1, -1, 0)
Str = Replace(Str, "APPLET", "&#065;PPLET", 1, -1, 0)
Str = Replace(Str, "Applet", "&#065;pplet", 1, -1, 0)
Str = Replace(Str, "applet", "&#065;pplet", 1, -1, 1)
Str = Replace(Str, "[", "&#091;")
Str = Replace(Str, "]", "&#093;")
' Str = Replace(Str, "=", "&#061;", 1, -1, 1)
' Str = Replace(Str, "'", "''", 1, -1, 1)
Str = Replace(Str, "select", "select", 1, -1, 1)
Str = Replace(Str, "execute", "&#101xecute", 1, -1, 1)
Str = Replace(Str, "exec", "&#101xec", 1, -1, 1)
Str = Replace(Str, "join", "join", 1, -1, 1)
Str = Replace(Str, "union", "union", 1, -1, 1)
Str = Replace(Str, "where", "where", 1, -1, 1)
Str = Replace(Str, "insert", "insert", 1, -1, 1)
Str = Replace(Str, "delete", "delete", 1, -1, 1)
Str = Replace(Str, "update", "update", 1, -1, 1)
Str = Replace(Str, "like", "like", 1, -1, 1)
Str = Replace(Str, "drop", "drop", 1, -1, 1)
Str = Replace(Str, "create", "create", 1, -1, 1)
Str = Replace(Str, "rename", "rename", 1, -1, 1)
Str = Replace(Str, "count", "co&#117;nt", 1, -1, 1)
Str = Replace(Str, "chr", "c&#104;r", 1, -1, 1)
Str = Replace(Str, "mid", "m&#105;d", 1, -1, 1)
Str = Replace(Str, "truncate", "trunc&#097;te", 1, -1, 1)
Str = Replace(Str, "nchar", "nch&#097;r", 1, -1, 1)
Str = Replace(Str, "char", "ch&#097;r", 1, -1, 1)
Str = Replace(Str, "alter", "alter", 1, -1, 1)
Str = Replace(Str, "cast", "cast", 1, -1, 1)
Str = Replace(Str, "exists", "e&#120;ists", 1, -1, 1)
Str = Replace(Str,Chr(13),"<br>", 1, -1, 1)
' Str = Replace(Str, "*", "＊")
Str = Replace(Str, "%", "％")
Str = Replace(Str, "-", "&#8211;")
FunSQL =Replace(Str,"'","&#39;", 1, -1, 1)
End Function 

'/*
' 帖子内容过滤
' */ 
Function HtmlEditEncode(Str)
Str=trim(Str)
  Str=Replace(Str,"\","&#92;")
  Str=Replace(Str,"'","&#39;")
'  Str = replace(Str, ">", "&gt;")
'  Str = replace(Str, "<", "&lt;")
  'Str = replace(Str, CHR(91), "&#91;")
  vfilterKey=Split(urldecode(filterKey),",")
for vi=0 to Ubound(vfilterKey)
Str=Replace(Str,vfilterKey(vi),"*")
  next
  
  HtmlEditEncode=Str
End Function 

'UBB
Function BBCode(str)
  str=ReplaceText(str,"\[(\/|)(b|i|u|strike|center|marquee)\]","<$1$2>")
  str=ReplaceText(str,"\[COLOR=([^[]*)\]","<FONT COLOR=$1>")
  str=ReplaceText(str,"\[FONT=([^[]*)\]","<FONT face=$1>")
  str=ReplaceText(str,"\[SIZE=([0-9]*)\]","<FONT size=$1>")
  str=ReplaceText(str,"\[\/(SIZE|FONT|COLOR)\]","</FONT>")
  'str=ReplaceText(str,"\[URL\]([^[]*)","<a target=_blank href=$1>$1")
  'str=ReplaceText(str,"\[URL=([^[]*)\]","<a target=_blank href=$1>")
  'str=ReplaceText(str,"\[\/URL\]","</A>")
  str=ReplaceText(str,"\[EMAIL\](\S+\@[^[]*)(\[\/EMAIL\])","<a href=mailto:$1>$1</a>")
  str=ReplaceText(str,"\[IMG\]([^("&CHR(34)&"|[|#)]*)(\[\/IMG\])","<img border=0 src=$1>")
  str=ReplaceText(str,"\[quote\]","<blockquote>")
  str=ReplaceText(str,"\[quote user="&CHR(34)&"([^[]*)"&CHR(34)&"\]","<blockquote> <b>以下是引用$1的发言</b><br>")
  str=ReplaceText(str,"\[\/quote\]","</blockquote>")
  if instr(str,":&bq")>0 then
    for qi=1 to 16
      str=Replace(str,":&bq"&qi&";","<img src='../../style/images/biaoqing/"&qi&".gif'>")
    next
  end if
  BBCode=str
End Function

'替换模块
Function ReplaceText(fString,patrn,replStr)
  Set regEx = New RegExp   ' 建立正则表达式。
    regEx.Pattern = patrn ' 设置模式。
    regEx.IgnoreCase = True ' 设置是否区分大小写。
    regEx.Global = True ' 设置全局可用性。 
    ReplaceText = regEx.Replace(""&fString&"",""&replStr&"") ' 作替换。
  Set regEx=nothing
End Function

'===============================================================
'urldecode解码
function urldecode(encodestr) 
  newstr="" 
  havechar=false 
  lastchar="" 
  for i=1 to len(encodestr) 
  char_c=mid(encodestr,i,1) 
  if char_c="+" then 
    newstr=newstr & " " 
  elseif char_c="%" then 
    next_1_c=mid(encodestr,i+1,2) 
    next_1_num=cint("&H" & next_1_c) 
  
  if havechar then 
    havechar=false 
    newstr=newstr & chr(cint("&H"&lastchar&next_1_c)) 
  else 
  if abs(next_1_num)<=127 then 
    newstr=newstr & chr(next_1_num) 
  else 
    havechar=true 
    lastchar=next_1_c 
  end if 
  end if 
    i=i+2 
  else 
    newstr=newstr&char_c 
  end if 
  next 
  urldecode=newstr 
end function 

'/*
' 去掉HTML标记(正规表达式)
' */
Function Replacehtml(Textstr)
  Dim Str,re
  Str=Textstr
  Set re=new RegExp
    re.IgnoreCase =True
    re.Global=True
    re.Pattern="<(.[^>]*)>"
    Str=re.Replace(Str, "")
    Set Re=Nothing
    Str=Replace(Str,"<script","")
    Replacehtml=Str
End Function

'/*
' *去掉链接代码,有时候失效
' */
function MV_link(str)
  dim re
  set re=new RegExp
    re.global=true
    re.ignorecase=true
    re.pattern="<a [^>]*>([^<]*)</a>"
    str=re.Replace(str,"$1")
    MV_link=str
  set re=nothing
end function

'=========================================================
'** 函数：RemoveHref 方法1
'** 作用：正则表达式去除字符串中所有的超级链接
'=========================================================
Function RemoveHref(HTMLstr)
Set ra = New RegExp
ra.IgnoreCase = True
ra.Global = True
ra.Pattern = "<a[^>]+>(.+?)<\/a>"
RemoveHref= ra.replace(HTMLstr,"$1")
End Function

'=========================================================
'** 函数：RemoveHref　方法2
'** 作用：去除字符串中所有的超级链接
'=========================================================
Function RemoveHref_2(HTMLstr)
Dim n,str1,str2,str3,str4
HTMLstr = Lcase(HTMLstr)
For n=1 to Ubound(Split(HTMLstr,"<a"))
str1 = Instr(HTMLstr,"<a")
str2 = Instr(str1,HTMLstr,">")
HTMLstr = left(HTMLstr,str1-1)&right(HTMLstr,len(HTMLstr)-len(left(HTMLstr,str2)))
HTMLstr = replace (HTMLstr,"</a>","")
Next
RemoveHref_2=HTMLstr
End Function

'=========================================================
'** 函数：RemoveHref
'** 作用：去除字符串中所有的图片
'=========================================================
Function RemoveImg(HTMLstr)
Dim n,str1,str2,str3,str4
HTMLstr = Lcase(HTMLstr)
For n=1 to Ubound(Split(HTMLstr,"<img"))
str1 = Instr(HTMLstr,"<img")
str2 = Instr(str1,HTMLstr,">")
HTMLstr = left(HTMLstr,str1-1)&right(HTMLstr,len(HTMLstr)-len(left(HTMLstr,str2)))
Next
RemoveImg=HTMLstr
End Function
'=========================================================
'** 函数：RepScript
'** 作用：去除字符串中所有的script
'=========================================================
Function RepScript(HTMLstr)
Dim n,str1,str2,str3,str4
HTMLstr = Lcase(HTMLstr)
For n=1 to Ubound(Split(HTMLstr,"<script"))
str1 = Instr(HTMLstr,"<script")
str2 = Instr(str1,HTMLstr,"</script>")
HTMLstr = left(HTMLstr,str1-1)&right(HTMLstr,len(HTMLstr)-len(left(HTMLstr,str2)))
Next
HTMLstr=Replace(HTMLstr,"/script>","")
RepScript=HTMLstr
End Function

'/*
' 得到IP
' */
function GetIp()
   dim getclientip
   getclientip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
   If getclientip = "" Then
     getclientip = Request.ServerVariables("REMOTE_ADDR")
   end if
   GetIp = getclientip
End Function 

'/*
' 检查元素是否在数组中
' */
Function inarr(arr,e)
  Dim j
  inarr = false
  If Not IsArray(arr) Then Exit Function
  For j = 0 To UBound(arr)
    If e = arr(j) Then inarr = true : Exit For
  Next
End Function

'/*
' * 截取指定长度的字符串
' * str      —— 被截取的字符串
' * strlen  —— 要截取的长度
' */
Function CutStr(Str,StrLen)
  Dim l,t,c,i
  l=Len(str)
  t=0
  For i=1 To l
    c=AscW(Mid(str,i,1))
    If c<0 Or c>255 Then t=t+2 Else t=t+1
    IF t>=StrLen Then
      CutStr=left(Str,i)&"..."
      Exit For
    Else
      CutStr=Str
    End If
  Next
End Function

'/*
' 日期转换
' */
Function DateToStr(DateTime,ShowType) '日期转换函数
  Dim DateMonth,DateDay,DateHour,DateMinute
  DateMonth=Month(DateTime)
  DateDay=Day(DateTime)
  DateHour=Hour(DateTime)
  DateMinute=Minute(DateTime)
  If Len(DateMonth)<2 Then DateMonth="0"&DateMonth
  If Len(DateDay)<2 Then DateDay="0"&DateDay
  Select Case ShowType
  Case "YMD"
    DateToStr = Year(DateTime)&"年"&DateMonth&"月"&DateDay&"日"
  Case "Y-m-d" '2006-09-19 年－月－日
    DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay
  Case "M-D-Y" '09-19-2006 月－日－年
    DateToStr = DateMonth&"-"&DateDay&"-"&Year(DateTime)  
  Case "Y/M/D" '2006/09/19 年/月/日
    DateToStr = Year(DateTime)&"/"&DateMonth&"/"&DateDay
  Case "M/D/Y" '09/19/2006 月/日/年
    DateToStr = DateMonth&"/"&DateDay&"/"&Year(DateTime)
  Case "D/M/Y" '19/09/2006 日/月/年
    DateToStr = DateDay&"/"&DateMonth&"/"&Year(DateTime)
  Case "M.D.Y" '09.19.2006 月.日.年
    DateToStr = DateMonth&"."&DateDay&"."&Year(DateTime)
  Case "Y.M.D" '2006.09.19 年.月.日
    DateToStr = Year(DateTime)&"."&DateMonth&"."&DateDay
  Case "M-D H:M" '10-1 15:2
    DateToStr = DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&"" 
  Case "MD" '09月19日 月日
    DateToStr = DateMonth&"月"&DateDay&"日"
  Case "DH" '19日17时 日时
    DateToStr = DateDay&"日"&DateHour&"时"
  Case "DH." '19日17点 日点
    DateToStr = DateDay&"日"&DateHour&"点"
  Case "HMin"
    DateToStr = DateHour&"时"&DateMinute&"分"      
  Case "H:Min"
    DateToStr = DateHour&":"&DateMinute
  Case "Y/M/D H:M"
    DateToStr = Year(DateTime)&"/"&DateMonth&"/"&DateDay&" "&DateHour&":"&DateMinute
  Case "Y-m-d H:I A" '2006-09-19 05:37 PM
    Dim DateAMPM
    If DateHour>12 Then 
      DateHour=DateHour-12
      DateAMPM="PM"
    Else
      DateHour=DateHour
      DateAMPM="AM"
    End If
    If Len(DateHour)<2 Then DateHour="0"&DateHour  
    If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
    DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&" "&DateAMPM
  Case "Y-m-d H:I:S" '2006-09-19 17:37:53
    Dim DateSecond
    DateSecond=Second(DateTime)
    If Len(DateHour)<2 Then DateHour="0"&DateHour  
    If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
    If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
    DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&":"&DateSecond
  Case "m/d H:I" '07/02 19:02
    DateSecond=Second(DateTime)
    If Len(DateHour)<2 Then DateHour="0"&DateHour  
    If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
    If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
    DateToStr=DateMonth&"/"&DateDay&" "&DateHour&":"&DateMinute
  Case "YmdHIS" '20060919173753
    DateSecond=Second(DateTime)
    If Len(DateHour)<2 Then DateHour="0"&DateHour  
    If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
    If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
    DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond  
  Case "ym" '0609年月
    DateToStr=Right(Year(DateTime),2)&DateMonth
  Case "d" '19日
    DateToStr=DateDay
  Case Else '2006-09-19 17:37
    If Len(DateHour)<2 Then DateHour="0"&DateHour
    If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
    DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute
  End Select
End Function
'/*
' 随机英文+数字
' */
Function GetRamCode(f_number)
  Randomize
  Dim f_Randchar,f_Randchararr,f_RandLen,f_Randomizecode,f_iR
  f_Randchar="0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z"
  f_Randchararr=split(f_Randchar,",")
  f_RandLen=f_number '定义密码的长度或者是位数
  for f_iR=1 to f_RandLen
    f_Randomizecode=f_Randomizecode&f_Randchararr(Int((21*Rnd)))
  next
  GetRamCode = f_Randomizecode
End Function

'/*
' 分页函数
' iRecordCount记录总数,iRecordCount每页记录数
' iPageCount总页数,Filegs处理页
' * /
Function pagination(iRecordCount,iPageSize,iPageCount,Filegs)
Dim wzpage,wzpagecount,pagenum,arrValue(2)
dim beginpage,endpage '两者之间
  If Len(Request.QueryString("page"))<>0 Then
   wzpage = clng(Request.QueryString("page")) '当前页
   Else 
   wzpage =1
  End If
  If wzpage <= 0 Then wzpage =1
  if (wzpage-4>=1) then
   beginpage=wzpage-4
  else
   beginpage=1
  end if
  if (wzpage+4<=iPageCount) then
   endpage=wzpage+4
  else
   endpage=iPageCount
  end if
  if beginpage=1 and iPageCount>=9 then '保持有9页选择
   beginpage=1:endpage=9
  end if
  if endpage=iPageCount and iPageCount>=9 then '保持有9页选择
     beginpage=endpage-8
  end if
  if wzpage>=2 then
   arrValue(0)=arrValue(0)&"<a href="""&Filegs&"page="&wzpage-1&""" title=""上一页"">上一页</a>"
  end if
  '+----------------出现首页数字
  if beginpage=>2 then 
   arrValue(0)=arrValue(0)&" <a href="""&Filegs&"page=1"" title=""首页"">[1..]</a> "
  end if
  for beginpage=beginpage to endpage
   If beginpage = wzpage Then
       arrValue(0)=arrValue(0)&"<font color=""#ff0000"">"
       arrValue(0)=arrValue(0)&" ["& wzpage &"] "
       arrValue(0)=arrValue(0)&"</font>"
     Else
       arrValue(0)=arrValue(0)&" <a href="""&Filegs&"page="& beginpage &""">"
       arrValue(0)=arrValue(0)&"["& beginpage &"]"
       arrValue(0)=arrValue(0)&"</a> "
    End If
   If beginpage >= iPageCount Then Exit For
  next
  '+----------------出现尾页数字
  if endpage<iPageCount then 
   arrValue(0)=arrValue(0)&" <a href="""&Filegs&"page="& iPageCount &""" title=""末页"">[.."&iPageCount&"]</a> "
  end if
  if wzpage<iPageCount then
   arrValue(0)=arrValue(0)&"<a href="""&Filegs&"page="& wzpage+1 &""" title=""下一页"">下一页</a>"
  end if
  
  arrValue(1) = " 当前第"&wzpage&"页 "&iPageSize&"条/页 共"&iPageCount&"页/"&iRecordCount&"条记录"
  pagination=arrValue
End Function 

'/*
' 分页函数(用于无刷新)
' iRecordCount:记录总数,iPageSize:每页记录数
' iPageCount:总页数,Filegs:处理页
' inowpage：当前页
' * /
Function pagination_ajax(iRecordCount,iPageSize,iPageCount,inowpage,Filegs)
Dim wzpage,wzpagecount,pagenum,arrValue(2)
dim beginpage,endpage '两者之间
  If Len(inowpage)<>0 Then
   wzpage = clng(inowpage) '当前页
   Else 
   wzpage =1
  End If
  If wzpage <= 0 Then wzpage =1
  if (wzpage-4>=1) then
   beginpage=wzpage-4
  else
   beginpage=1
  end if
  if (wzpage+4<=iPageCount) then
   endpage=wzpage+4
  else
   endpage=iPageCount
  end if
  if beginpage=1 and iPageCount>=9 then '保持有9页选择
   beginpage=1:endpage=9
  end if
  if endpage=iPageCount and iPageCount>=9 then '保持有9页选择
     beginpage=endpage-8
  end if
  if wzpage>=2 then
   arrValue(0)=arrValue(0)&"<a href=#_p onclick=""showRdPL('"&Filegs&"page="&wzpage-1&"')"" title=""上一页"">上一页</a>"
  end if
  '+----------------出现首页数字
  if beginpage=>2 then 
   arrValue(0)=arrValue(0)&" <a href=#_p onclick=""showRdPL('"&Filegs&"page=1')"" title=""首页"">[1..]</a> "
  end if
  for beginpage=beginpage to endpage
   If beginpage = wzpage Then
       arrValue(0)=arrValue(0)&"<font color=""#ff0000"">"
       arrValue(0)=arrValue(0)&" ["& wzpage &"] "
       arrValue(0)=arrValue(0)&"</font>"
     Else
       arrValue(0)=arrValue(0)&" <a href=#_p onclick=""showRdPL('"&Filegs&"page="& beginpage &"')"">"
       arrValue(0)=arrValue(0)&"["& beginpage &"]"
       arrValue(0)=arrValue(0)&"</a> "
    End If
   If beginpage >= iPageCount Then Exit For
  next
  '+----------------出现尾页数字
  if endpage<iPageCount then 
   arrValue(0)=arrValue(0)&" <a href=#_p onclick=""showRdPL('"&Filegs&"page="& iPageCount &"')"" title=""末页"">[.."&iPageCount&"]</a> "
  end if
  if wzpage<iPageCount then
   arrValue(0)=arrValue(0)&"<a href=#_p onclick=""showRdPL('"&Filegs&"page="& wzpage+1 &"')"" title=""下一页"">下一页</a>"
  end if
  
  arrValue(1) = " <b>总数"&iRecordCount&"</b>"
  pagination_ajax=arrValue
End Function 

'/*
' 分页函数生成html
' iRecordCount记录总数,iPageSize每页记录数
' iPageCount总页数,Filegs处理页,nowPage:当前页
' * /
Function pagination_html(iRecordCount,iPageSize,iPageCount,Filegs,nowPage)
Dim wzpage,wzpagecount,pagenum,arrValue(2)
dim beginpage,endpage '两者之间
If Len(nowPage)<>0 Then
   wzpage = clng(nowPage) '当前页
   Else 
   wzpage =1
End If
If wzpage <= 0 Then wzpage =1
if (wzpage-4>=1) then
beginpage=wzpage-4
else
beginpage=1
end if
if (wzpage+4<=iPageCount) then
endpage=wzpage+4
else
endpage=iPageCount
end if
if beginpage=1 and iPageCount>=9 then '保持有9页选择
beginpage=1:endpage=9
end if
if endpage=iPageCount and iPageCount>=9 then '保持有9页选择
   beginpage=endpage-8
end if
if wzpage>=2 then
   arrValue(0)=arrValue(0)&"<a href="""&Filegs&wzpage-1&".html"" title=""上一页"">&laquo;上一页</a>"
end if
'+----------------出现首页数字
if beginpage=>2 then 
arrValue(0)=arrValue(0)&" <a href="""&Filegs&"1.html"" title=""首页"">[1..]</a> "
end if
for beginpage=beginpage to endpage
   If beginpage = wzpage Then
       arrValue(0)=arrValue(0)&"<font color=""#ff0000"">"
       arrValue(0)=arrValue(0)&" ["& wzpage &"] "
       arrValue(0)=arrValue(0)&"</font>"
     Else
       arrValue(0)=arrValue(0)&" <a href="""&Filegs&beginpage &".html"">"
       arrValue(0)=arrValue(0)&"["& beginpage &"]"
       arrValue(0)=arrValue(0)&"</a> "
    End If
   If beginpage >= iPageCount Then Exit For
next
'+----------------出现尾页数字
if endpage<iPageCount then 
arrValue(0)=arrValue(0)&" <a href="""&Filegs&iPageCount &".html"" title=""末页"">[.."&iPageCount&"]</a> "
end if
if wzpage<iPageCount then
arrValue(0)=arrValue(0)&"<a href="""&Filegs& wzpage+1 &".html"" title=""下一页"">下页更精彩&raquo;</a>"
end if

arrValue(1) = " 当前第"&wzpage&"页 "&iPageSize&"条/页 共"&iPageCount&"页/"&iRecordCount&"条记录"
pagination_html=arrValue
End Function 

'/*
' 文章内容加上{{page}}作为某处的分页标识
' 长文章指定{{page}}分页
' --pid：文章的ID
' --ntext:文章的内容
' --lfile：连接文件
' */
Function opage(pid,ntext,lfile)
dim temp_text,startStr,anum
temp_text=ntext
   listPage="{{page}}" '分布符
if instr(temp_text,listPage)>0 then
   anum=split(temp_text,listPage)
   page=request.QueryString("page")
   if page="" or page=0 then
     page=1
   else
     page=Clng(page)
   end if
     for i=1 to ubound(anum)+1   '分页开始
       if i=page then
         if i=1 then '特别处理page=1的情况
         numPage=numPage&"[<A href="&lfile&"?pid="&pid&"><font color=red>1</font></a>]"
         else
       numPage=numPage&"[<A href="&lfile&"?pid="&pid&"&page="&i&"><font color=red>"&i&"</font></a>]"
     end if
       else
         if i=1 then
         numPage=numPage&"[<A href="&lfile&"?pid="&pid&">1</a>]"
         else         
       numPage=numPage&"[<A href="&lfile&"?pid="&pid&"&page="&i&">"&i&"</a>]"
       end if
       end if
     next
     
     if page>ubound(anum)+1 then
       page=ubound(anum)+1
     end if      
     
     temp_text=anum(page-1)&"<div align=center>{{page}}</div>"
     temp_text=replace(temp_text,"{{page}}",numPage)
   end if   
opage=temp_text
End Function
'/*
' *写入特定行
' *使用方法，在文件14行加入内容
' *Call FSOlinewrite("/Common/aspcodes/Variable.asp",14,"annouce="""&request("annouce")&"""")
' */
Function FSOlinewrite(filename,lineNum,Linecontent)
  if linenum < 1 then exit function
  dim fso,f,temparray,tempCnt
  set fso = server.CreateObject("scripting.filesystemobject")
  if not fso.fileExists(server.mappath(filename)) then exit function
  set f = fso.opentextfile(server.mappath(filename),1)
  if not f.AtEndofStream then
  tempcnt = f.readall
  f.close
  temparray = split(tempcnt,chr(13)&chr(10))
  if lineNum>ubound(temparray)+1 then
  exit function
  else
  'temparray(lineNum-1) = temparray(lineNum-1)&chr(13)&chr(10)&lineContent '保留原内容
  temparray(lineNum-1) = lineContent '不保留原内容
  end if
  tempcnt = join(temparray,chr(13)&chr(10))
  set f = fso.createtextfile(server.mappath(filename),true)
  f.write tempcnt
  end if
  f.close
  set f = nothing
End Function
''此函数返回下拉列表字符串，arrayname为传入的数组名称, arrayvalue为传入的数组值，sltname为此下拉列表的名称，sltclass为此下拉列表的样式，sltvalue为此下拉列表默认选择的值 

Function writeselect(arrayname,arrayvalue,sltname,sltclass,sltvalue) 
dim slt,i 
slt="<select name=" & sltname & " class=" & sltclass & ">" 
for i=0 to ubound(arrayname) 
if sltvalue<>"" and trim(sltvalue)=trim(arrayvalue(i)) then
slt=slt & "<option value=" & arrayvalue(i) &" selected>" & arrayname(i) & "</option>" 
else
slt=slt & "<option value=" & arrayvalue(i) &">" & arrayname(i) & "</option>" 
end if
next 
slt=slt & "</select>" 
writeselect=slt 
End function
'+--------------------------------------
' 函数功能：用户权限
' 参数：pstr当前有效值
'+--------------------------------------
Function limits(pstr)
dim tpstr,tresult
tpstr=pstr 
   if Instr(Session("czy_right"),tpstr)>0 then
   tresult=true
   else
   tresult=false
   end if
limits=tresult
End Function

'/*
' * 获取当前Url参数的函数 　
' */
Function GetUrl() 
  Dim ScriptAddress,M_ItemUrl, M_item 
  ScriptAddress = "http://"&request.ServerVariables("SERVER_NAME")&CStr(Request.ServerVariables("SCRIPT_NAME")) '取得当前地址 
  M_ItemUrl = "" 
  If (Request.QueryString <> "") Then 
    ScriptAddress = ScriptAddress & "?" 
    For Each M_item In Request.QueryString 
    '如果页面传递参数是用page变量，那么判断一下page是否已经使用，避免重复！
      If InStr("pavge",M_Item)=0 Then 
        M_ItemUrl = M_ItemUrl & M_Item &"="& Server.URLEncode(Request.QueryString(""&M_Item&"")) & "&" 
      End If 
    Next 
  end if 
  GetUrl = ScriptAddress & M_ItemUrl
  if instr(1,GetUrl,"?",1)<1 then
    GetUrl=GetUrl&"?"
  end if
End Function 

'过滤关键字
'str原字符串
'keylist以|分隔的要过滤关键字
Function ReplaceKey(str,keylist)
dim tKey,tkeylist
tkeylist=Split(keylist,"|")
for i=0 to Ubound(tkeylist)
tKey=replace(str,tkeylist(i),"")
   str=tKey
next
'大写再转换一次
tkeylist=Split(UCase(keylist),"|")
for i=0 to Ubound(tkeylist)
tKey=replace(str,tkeylist(i),"")
   str=tKey
next 
ReplaceKey=tKey
end function

'/*
' * 页脚信息
' */
Function endpageMsn()
endpageMsn="<script src='"&Website&"/ShowWebcount.asp'></script></font>"
End Function

'/*
' * 网站维护
' */
Sub Webunkeep()
  if webIsopen=0 then
   response.Write "<font style='font-size:14px;line-height:20px'>"
   Response.Write "Diggcms系统温馨提示：网站正在维护中……,请稍候访问！</font>"
   Response.End
  end if
End Sub

'/*
' * 验证码　
' */
Function GetCode()
Randomize
nowRand=Int((10*Rnd))
Verification_code=Split("涨,一日千里,yes,Dig,GOOD,拉升,打板,帅,COOL,明日,成",",")
GetCode=Verification_code(nowRand)
end Function
'+-----------------
' 显示验证码
'+-----------------
Sub ShowCode()
response.Write "<script>"&VBCRLF
response.Write "function copyTxt(str){"&VBCRLF 
response.Write "var clipBoardContent="""";"&VBCRLF 
response.Write " clipBoardContent+=str;"&VBCRLF
response.Write " window.clipboardData.setData('Text',clipBoardContent);"&VBCRLF 
response.Write "  alert('验证码复制成功！');"&VBCRLF
response.Write "}"&VBCRLF
response.Write "</script>"&VBCRLF
Randomize
showRand=Int((9999999*Rnd))
nowgetcode=getcode()
response.Cookies("hao123.com")=nowgetcode
response.Write "<div title='点击复制验证码' onclick='copyTxt("""&request.Cookies("hao123.com")&""")' style='padding:2px;background-color:#F7F7F7;width:60px;text-align:center;border:1px dashed #2BA239;cursor:pointer' id='"&showRand&"'>"&request.Cookies("hao123.com")&"</div>"
end sub
'+---------------
' 存在再显示
'+---------------
Sub ShowCodeOver()
response.Write "<script>"&VBCRLF
response.Write "function copyTxt(str){"&VBCRLF 
response.Write "var clipBoardContent="""";"&VBCRLF 
response.Write " clipBoardContent+=str;"&VBCRLF
response.Write " window.clipboardData.setData('Text',clipBoardContent);"&VBCRLF 
response.Write "  alert('验证码复制成功！');"&VBCRLF
response.Write "}"&VBCRLF
response.Write "</script>"&VBCRLF
response.Write "<div title='点击复制验证码' onclick='copyTxt("""&request.Cookies("hao123.com")&""")' style='padding:2px;background-color:#F7F7F7;width:8px;border:1px dashed #2BA239;cursor:pointer' id='"&showRand&"'>"&request.Cookies("hao123.com")&"</div>"
End Sub

'防刷新
sub refreshtime()
if DateDiff("s",Session("RefreshTime"),Now())<iRefreshTime then
Call FunMsg("#","温馨提示：请不要在"&iRefreshTime&"秒内快速发帖\n　　　　　还剩"&iRefreshTime-DateDiff("s",Session("RefreshTime"),now())&"秒")
   Response.End
end if
Session("RefreshTime")=Now()
end sub

'/*
' * 读取模板文件内容
' */
Function Readtemplate(vdir,val)
dim p_template
  set FSO = createobject("Scripting.FileSystemObject")
  if FSO.FileExists(server.mappath(vdir&TemplateDir &"\"& val)) then
    set oFile = FSO.OpenTextFile(server.mappath(vdir&TemplateDir &"\"& val), 1)
    p_template = oFile.ReadAll
    oFile.Close
    set oFile = nothing
    if vdir<>"" then
     response.Write "更新"&val&"完成<br>"
    end if
  else
    response.write "<b>ASPTemplate Error: File [" & val & "] does not exists!</b><br>"
  end if
  set FSO = nothing
  Readtemplate=p_template
end Function

'/*
' * 设置帖子列表小图
' */
Function SetImgWH(IMGPath,MaxW,MaxH)
On Error Resume Next
  if instr(Lcase(IMGPath),"http://")>0 then
   IMGPath=IMGPath:W=MaxW:H=MaxH
  else
    Set PP = New ImgWHInfo 
    W = PP.imgW(lcase(Server.Mappath(IMGPath))) 
    H = PP.imgH(lcase(Server.Mappath(IMGPath))) 
    Set pp = Nothing  
    if W>MaxW then
      H=H*MaxW/W
      W=MaxW
    end if
    if H >MaxH then
      W=W*MaxH/H
      H=MaxH
    end if
    pp=null
  end if
  SetImgWH = "src='"&IMGPath&"' width='"&int(W)&"' height='"&int(H)&"' "
End Function

'/*
' * 更新模板缓存
' */
Sub updatetemplate()
if Application("diggcms_index")="" then
    Application.Lock
    Application("diggcms_index")=Readtemplate("","index.htm")
    Application("diggcms_top")=Readtemplate("","top.htm")
    Application("diggcms_top_list")=Readtemplate("","top_list.htm")
    Application("diggcms_search")=Readtemplate("","search.htm")
    Application("diggcms_register")=Readtemplate("","Register.htm")
    Application("diggcms_mlist")=Readtemplate("","mlist.htm")
    Application("diggcms_login")=Readtemplate("","login.htm")
    Application("diggcms_list_tyle2")=Readtemplate("","list_tyle2.htm")
    Application("diggcms_list_tyle1")=Readtemplate("","list_tyle1.htm")
    Application("diggcms_list")=Readtemplate("","list.htm")
    Application("diggcms_html")=Readtemplate("","html.htm")
    Application("diggcms_end")=Readtemplate("","end.htm")
    Application("diggcms_channel")=Readtemplate("","channel.htm")
    Application.UnLock 
    'response.Write "成功"
end if  
End Sub
%> 
]]>http://www.030904.com/blog/blogview.asp?logID=1001<![CDATA[ASP防止挂马攻击和SQL参数注入攻击函数]]>glenluo编程技术2010-3-12 18:57:35http://www.030904.com/blog/blogview.asp?logID=1001
Function FunSQL(Str)
If Isnull(Str) Then
FunSQL = ""
Exit Function 
End If
  Str=trim(Str)
Str = Replace(Str,Chr(0),"", 1, -1, 1)
Str = Replace(Str, """", "&quot;", 1, -1, 1)
Str = Replace(Str,"<","&lt;", 1, -1, 1)
Str = Replace(Str,">","&gt;", 1, -1, 1) 
  Str = Replace(Str,CHR(42),"&#42;")  '“*”
  Str = Replace(Str,CHR(44),"&#44;")  '“,”
Str = Replace(Str, "script", "&#115;cript", 1, -1, 0)
Str = Replace(Str, "SCRIPT", "&#083;CRIPT", 1, -1, 0)
Str = Replace(Str, "Script", "&#083;cript", 1, -1, 0)
Str = Replace(Str, "script", "&#083;cript", 1, -1, 1)
Str = Replace(Str, "object", "&#111;bject", 1, -1, 0)
Str = Replace(Str, "OBJECT", "&#079;BJECT", 1, -1, 0)
Str = Replace(Str, "Object", "&#079;bject", 1, -1, 0)
Str = Replace(Str, "object", "&#079;bject", 1, -1, 1)
Str = Replace(Str, "applet", "&#097;pplet", 1, -1, 0)
Str = Replace(Str, "APPLET", "&#065;PPLET", 1, -1, 0)
Str = Replace(Str, "Applet", "&#065;pplet", 1, -1, 0)
Str = Replace(Str, "applet", "&#065;pplet", 1, -1, 1)
Str = Replace(Str, "[", "&#091;")
Str = Replace(Str, "]", "&#093;")
' Str = Replace(Str, "=", "&#061;", 1, -1, 1)
' Str = Replace(Str, "'", "''", 1, -1, 1)
Str = Replace(Str, "select", "select", 1, -1, 1)
Str = Replace(Str, "execute", "&#101xecute", 1, -1, 1)
Str = Replace(Str, "exec", "&#101xec", 1, -1, 1)
Str = Replace(Str, "join", "join", 1, -1, 1)
Str = Replace(Str, "union", "union", 1, -1, 1)
Str = Replace(Str, "where", "where", 1, -1, 1)
Str = Replace(Str, "insert", "insert", 1, -1, 1)
Str = Replace(Str, "delete", "delete", 1, -1, 1)
Str = Replace(Str, "update", "update", 1, -1, 1)
Str = Replace(Str, "like", "like", 1, -1, 1)
Str = Replace(Str, "drop", "drop", 1, -1, 1)
Str = Replace(Str, "create", "create", 1, -1, 1)
Str = Replace(Str, "rename", "rename", 1, -1, 1)
Str = Replace(Str, "count", "co&#117;nt", 1, -1, 1)
Str = Replace(Str, "chr", "c&#104;r", 1, -1, 1)
Str = Replace(Str, "mid", "m&#105;d", 1, -1, 1)
Str = Replace(Str, "truncate", "trunc&#097;te", 1, -1, 1)
Str = Replace(Str, "nchar", "nch&#097;r", 1, -1, 1)
Str = Replace(Str, "char", "ch&#097;r", 1, -1, 1)
Str = Replace(Str, "alter", "alter", 1, -1, 1)
Str = Replace(Str, "cast", "cast", 1, -1, 1)
Str = Replace(Str, "exists", "e&#120;ists", 1, -1, 1)
Str = Replace(Str,Chr(13),"<br>", 1, -1, 1)
' Str = Replace(Str, "*", "＊")
Str = Replace(Str, "%", "％")
Str = Replace(Str, "-", "&#8211;")
FunSQL =Replace(Str,"'","&#39;", 1, -1, 1)
End Function

这里对 script 的大小写也进行了区分过滤，基本可以解决。我们可以再数据的存储和调用的时候进行过滤判断！]]>http://www.030904.com/blog/blogview.asp?logID=1000<![CDATA[ASP将人民币小写转换成大写]]>glenluo编程技术2010-3-12 18:55:24http://www.030904.com/blog/blogview.asp?logID=1000Function rmb(num) 


num = FormatNumber(num, 2) 


Dim numList,rmbList,numLen,numChar,numstr,n,n1,n2,hz 

numList = "零壹贰叁肆伍陆柒捌玖" 

rmbList = "分角元拾佰仟万拾佰仟亿拾佰仟万" 

If num > 9999999999999.99 Then 

rmb = "超出范围的人民币值" 

Exit Function 

End If 

numstr = CStr(num * 100) 

numLen = Len(numstr) 

n = 1 

Do While n <= numLen 

numChar = CInt(Mid(numstr, n, 1)) 

n1 = Mid(numList, numChar + 1, 1) 

n2 = Mid(rmbList, numLen - n + 1, 1) 

If Not n1 = "零" Then 

hz = hz + CStr(n1) + CStr(n2) 

Else 

If n2 = "亿" Or n2 = "万" Or n2 = "元" Or n1 = "零" Then 

Do While Right(hz, 1) = "零" 

hz = Left(hz, Len(hz) - 1) 

Loop 

End If 

If (n2 = "亿" Or (n2 = "万" And Right(hz, 1) <> "亿") Or n2 = "元") Then 

hz = hz + CStr(n2) 

Else 

If Left(Right(hz, 2), 1) = "零" Or Right(hz, 1) <> "亿" Then 

hz = hz + n1 

End If 

End If 

End If 

n = n + 1 

Loop 

Do While Right(hz, 1) = "零" 

hz = Left(hz, Len(hz) - 1) 

Loop 

If Right(hz, 1) = "元" Then 

hz = hz + "整" 

End If 

rmb = hz 

End Function 
]]>http://www.030904.com/blog/blogview.asp?logID=999<![CDATA[cookie欺骗的实现]]>glenluo编程技术2010-3-12 18:48:13http://www.030904.com/blog/blogview.asp?logID=999　　 
　　一、cookie的建立 
　　 
　　在讲如何建立cookie之前，我们先来了解一下cookie的基本格式： 
　　 
　　cookiename+cookievalue;expire=expirationdategmt;path=urlpath;domain=sitedomain 
　　 
　　其中各项以;分开，首先是指定cookie的名称，并为其赋值。接下来分别是cookie的有效期，url路径以及域名，在这几项中，除了第一项以外，其它部分均为可先项。
　　下面我们来看一段代码，了解一下cookie究竟是怎样建立的： 
　　 
　　<HTML> 
　　<HEAD> 
　　<TITLE>Set a cookie based on a form</TITLE> 
　　<SCRIPT LANGUAGE="java script" TYPE="TEXT/java script"> 
　　<!-- Hide script from older browsers 
　　 
　　expireDate = new Date 
　　expireDate.setMonth(expireDate.getMonth()+6) 
　　 
　　userName = "" 
　　if (documents .cookie != "") { 
　　userName = documents .cookie.split("=")[1] 
　　} 
　　 
　　function setCookie() { 
　　userName = document.myform.nameField.value 
　　documents .cookie = "userName="+userName+";expires=" + expireDate.toGMTString() 
　　} 
　　 
　　// End hiding script --> 
　　</SCRIPT> 
　　</HEAD> 
　　<BODY BGCOLOR="WHITE" onLoad="document.myform.nameField.value = userName"> 
　　<form NAME="myform"> 
　　<H1>Enter your name:<INPUT TYPE="TEXT" NAME="nameField" onBlur="setCookie()"></H1> 
　　</form> 
　　</BODY> 
　　</HTML> 
　　这是一锻简单的建立cookie的脚本。 
　　 
　　1，<SCRIPT LANGUAGE="java script" TYPE="TEXT/java script"> 
　　 
　　脚本开始的标记，由此一句告诉浏览器以下将是java script. 
　　 
　　2,<!-- Hide script from older browsers 
　　 
　　为了防止浏览器不能识别脚本，而让浏览器误以为是HTML注释而忽略它。 
　　 
　　3，expireDate = new Date 
　　 
　　获取当前日期，并存入变量expireDate中。 
　　 
　　4，expireDate.setMonth(expireDate.getMonth()+6) 
　　 
　　获取当前月份值，将其加6后设置为expireDate的月份总值部分。这意味着本cookie的有效期为6个月。 
　　 
　　5，if (documents .cookie != "") 
　　 
　　如果document的值不为空，相当于检查用户硬盘上是否已经有了cookie。 
　　 
　　6，userName = documents .cookie.split("=")[1] 
　　 
　　此处用到了split("=")函数，它的功能是把cookie记录分割为数组，cookie的名为cookie[0],值为cookie[1],以此累推。所以此处documents .cookie.split("=")[1]返回的值是此cookie的值。在此句中将值赋给了变量username。 
　　 
　　7，function setCookie() 
　　 
　　设置名为setCookie的函数。 
　　 
　　8，documents .cookie = "userName="+userName+";expires=" + expireDate.toGMTString() 
　　 
　　此句是将设置好的cookie写入用户硬盘。expireDate.toGMTString()把expireDate中的值转换为文本字符串，这样才能写入cookie中。 
　　 
　　9，onLoad="document.myform.nameField.value = userName" 
　　 
　　当页面载入时，把username的值写入文本框(如果有的话)。 
　　 
　　10，onBlur="setCookie()" 
　　 
　　当用户离开文本框时，onBlur调用函数setCookie。 
　　 
　　结合上面的注释，读那段代码相信不成问题吧!既然我们可以建立cookie，那么读取也不是什么难事，请接着往下看!

　　二、读取和显示cookie 
　　 
　　一般来说，cookie的作者并不希望cookie被显示出来，这是当然的!天知道里面写了些什么!？然而这也是我们想要读出它的原因!~~~:D 
　　 
　　<HTML> 
　　<HEAD> 
　　<TITLE>Cookie Check</TITLE> 
　　</HEAD> 
　　<BODY BGCOLOR="WHITE"> 
　　<H2> 
　　<SCRIPT LANGUAGE="java script" TYPE="TEXT/java script"> 
　　<!-- Hide script from older browsers 
　　 
　　if (documents .cookie == "") { 
　　document.write("There are no cookies here") 
　　} 
　　else { 
　　thisCookie = documents .cookie.split("; ") 
　　 
　　for (i=0; i<thisCookie.length; i++) { 
　　document.write("Cookie name is ’"+thisCookie.split("=")[0]) 
　　document.write("’, and the value is ’"+thisCookie.split("=")[1]+"’<BR>") 
　　} 
　　} 
　　 
　　// End hiding script --> 
　　</SCRIPT> 
　　</H2> 
　　</BODY> 
　　</HTML> 
　　 
　　以上的便是一段读取cookie的名字和值的脚本。上文中解释过的语句在此不多赘述，且看有什么新的语法： 
　　 
　　1，thisCookie = documents .cookie.split("; ")[注意：并非前文中出现过的split("=")。 
　　 
　　split("; ")可以产生数组的结果，本句中，由documents .cookie.split("; ")来获取cookie的值，并将这个数组赋值缎带变量：thisCookie。 
　　 
　　2，for (i=0; i<thisCookie.length; i++) 
　　 
　　设置计算器变量i的值为0，如果其值小于thisCookie.length(thisCookie中值的个数)，将i的值加1。 
　　 
　　3，document.write("Cookie name is ’"+thisCookie.split("=")[0]) 
　　 
　　此句中thisCookie.split("=")[0]较难理解，上面的脚本中，thiscookie已经被赋值为一个数组的值，那么thisCookie是指数组中第i个值，也就是第i个cookie，而由上文可知split("=")[0]是指cookie的名字。

　　这样thisCookie.split("=")[0]便是第i的cookie中cookie的名字! 
　　 
　　4,document.write("’, and the value is ’"+thisCookie.split("=")[1] 
　　 
　　跟3极为相似，即是第i个cookie中 cookie的值。 
　　 
　　到此，我们已经熟悉了如何建立cookie以及它的读取。这些也正是cookie欺骗也需要的主要技术!

　　三、cookie欺骗的实现 
　　 
　　要做到cookie欺骗，最重要的是理解目标cookie中的储值情况，并设法改变它。由上面的学习我们知道，基于cookie的格式所限，一般来说，只有在Cookie.split("=")[0]和Cookie.split("=")[1]中的值对我们才是有用的。也就是说只需改变这两处或是处的值即可达到我们的目的。

　　而在实际操作中，还得先解决另一个问题。由于受浏览器的内部cookie机制所限，每个cookie只能被它的原服务器所访问!可我们总不能跑到人家服务器上操作吧!这里就需要一个小技巧了。

　　在上面我们提到过cookie的格式，最后两项中分别是它的url路径和域名。不难想到，服务器对cookie的识别靠的就是这个!

　　而在平时，我们要浏览一个网站时，输入的url便是它的域名，需要经过域名管理系统dns将其转化为IP地址后进行连接的。这其中就有一个空当。如果能在dns上做手脚，把目标域名的IP地址对应到其它站点上，我们便可以非法访问目标站点的cookie了!

　　做到这一点并不难，当然我不并不是要去操纵dns，而且那也是不可能的事情。在win9下的安装目录下，有一 名为hosts.sam的文件，以文本方式打开后会看到这样的格式：

　　127.0.0.1 lockhost #注释

　　利用它，我们便可以实现域名解析的本地化!而且其优先权高于网络中的dns!

　　具体使用时，只需将IP和域名依上面的格式添加，并另存为hosts即可!(注意：此文件无后赘名，并非hosts.sam 文件本身!) 
　　 
　　到此，cookie欺骗所需的所以知识已经齐备。下面以一个“假”的例子，演示一下如何进入实战.(不便给出真实地址，以免引起犯罪!~~~:P) 
　　假设目标站点是 www.xxx.com 
　　www.self.com是自己的站点。(可以用来存放欺骗目标所需的文件，用来读取和修改对方的cookie.)

　　首先ping出www.self.com的IP地址：

　　ping www.self.com 
　　 
　　Reply from 12.34.56.78: bytes=32 time=20ms TTL=244 
　　 
　　然后修改hosts.sam文件如下： 
　　 
　　12.34.56.78 www.xxx.com 
　　并保存为hosts。 
　　 
　　将用来读取cookie的页面传至www.self.com(脚本如二所示)。 
　　此时连上www.xxx.com。由于我们已经对hosts动过手脚，这时来到的并不是www.xxx.com，而是www.self.com

　　www.xxx.com设在本地的cookie便可被读出!~~:D

　　然后根据具体情况修改一的脚本，用同样的方法，向此cookie中写入数据。修改完毕后，删掉hosts文件，再重新进入www.xxx.com，此时已经大功告成，可享受你的hack成果了!~~~:)

       当然也可以网上下载一个COOKIES修改工具,修改COOKIES达到欺骗的目的,操作简单
　　 
　　编后

　　cookie欺骗是一种发现较早，且较难使用的hack手法，除了java script 可以控制以外，asp等也可以用来对其进进设置。所以在此声明，未必能对所有站点有较。但技术真实，无须置疑! 
　　 
　　补充：在win2000中hosts文件的建立与win98不同，需要c:\winnt\system32\drivers\etc文件夹中创建!windows xp c:\windows\system32\drivers\etc

       以前飞天论坛的程序就存在cookies欺骗漏洞.

      往往新手程序员写的程序就存在COOKIES欺骗漏洞. cookies欺骗一般应用在会员系统中,如普通会员与VIP会员,大部分网站是通过一个COOKIES来识别,只要修改特定的COOKIES就可以实现.

]]>http://www.030904.com/blog/blogview.asp?logID=998<![CDATA[防止COOKIES被欺骗]]>glenluo编程技术2010-3-12 18:45:59http://www.030904.com/blog/blogview.asp?logID=998      1、加密保存COOKIES

                 COOKIES保存时对值进行加密，读取的时候再进行解密。这就需要自已写一个加密解密程序。实现起来不太方便。


       2、利用MD5加密校验COOKIES,md5函数网上很多。

                 将需要保存的COOKIES相加后加密，如：

                 写COOKIES：

                <%

                 response.cookies("login")("username")=username=username

                  response.cookies("login")("vip")=vip

                 response.cookies("login")("md5")=md5(username&vip,32)

              %>

               判断COOKIES

             <%

               a=request.cookies("login")("username")

                b=request.cookies("login")("vip")

               c=request.cookies("login")("md5")

                if c<>md5(a&b,32) then

                  response.write "cookies被修改"

               end if

            %>]]>