asp非常实用的代码

过滤字符：
Function GetSafeStr(str)
     GetSafeStr=Replace(Replace(Replace(Replace(Replace(str,"'","‘"),"""","“"),"&",""),"<","<"),">",">")
End Function

格式化的字符串
'函数名称: ZeroFill(Num,Num_Length)
'函数功能: 前面补0
'参数说明: Num               要操作的数字      
'           Num_Length       显示的位数
'返回值   : 格式化的字符串
Function ZeroFill(Num,Num_Length)
Dim ZeroFill_i,ZeroFill_ReturnNum
For ZeroFill_i=len(Num) To Num_Length-1
ZeroFill_ReturnNum=ZeroFill_ReturnNum&"0"
Next
ZeroFill_ReturnNum=ZeroFill_ReturnNum&Num
ZeroFill=ZeroFill_ReturnNum
End Function

生成安全码的函数
function make_randomize(max_len,w_n) 'max_len 生成长度，w_n：0 可能包含字母，1：只为数字
randomize
for intcounter=1 to max_len
whatnext=int((1-0+1)*rnd+w_n)
if whatnext=0 then
upper=122
lower=97
else
upper=57
lower=48
end if
strnewpass=strnewpass & chr(int((upper-lower+1)*rnd)+lower)
next
make_randomize=strnewpass
end function
'safecode=make_randomize(4,0)
'response.Write(safecode)
%>
<%random_num=make_randomize(4,0) '生成4位数字的安全码
session("random_num")=random_num '为什么调用session，没有session的安全码是完全没有意义的。
Set Jpeg = Server.createObject("Persits.Jpeg") '调用组件
Jpeg.Open Server.MapPath("1.jpg") '打开准备的图片
Jpeg.Canvas.Font.Color = &H006699
Jpeg.Canvas.Font.Family = "Arial Black"
Jpeg.Canvas.Font.Bold = false
Jpeg.Canvas.PrintText 0, -2, random_num
jpeg.save Server.MapPath("random_index.jpg") '保存
%>  <img src="random_index.jpg" border="0" align="absmiddle">

彻底屏蔽鼠标右键
oncontextmenu="window.event.returnvalue=false"将彻底屏蔽鼠标右键
或者
<script language="javascript">
function click()
{
if (event.button==0) //event.button依环境值不同
{
alert("对不起，本页的内容不经允许不得拷备。");
}
}
window.document.onmousedown=click;
</script>

onpaste="returnfalse"不准粘贴

oncopy="returnfalse;"oncut="returnfalse;"防止复制

光标是停在文本框文字的最后
functioncc()
{
vare=event.srcElement;
varr=e.createTextRange();
r.moveStart('character',e.value.length);
r.collapse(true);
r.select();
}

判断上一页的来源
asp:request.servervariables("HTTP_REFERER")
javascript:document.referrer

网页不会被缓存
Response.Expires=-1
Response.ExpiresAbsolute=Now()-1
Response.cachecontrol="no-cache"


过滤HTML标签后的内容
'函数名：RemoveHTML
'作   用：清除HTML标签
'参   数：strHTML 内容
'返回值：过滤HTML标签后的内容
function RemoveHTML(strHTML)  
     Dim objRegExp, Match, Matches    
     Set objRegExp = New Regexp  
    
     objRegExp.IgnoreCase = True  
     objRegExp.Global = True  
     '取闭合的<>  
     objRegExp.Pattern = "<.+?>"  
     '进行匹配  
     Set Matches = objRegExp.Execute(strHTML)  
    
     '遍历匹配集合，并替换掉匹配的项目  
     For Each Match in Matches    
         strHtml=Replace(strHTML,Match.Value,"")  
     Next  
     RemoveHTML=strHTML  
     Set objRegExp = Nothing  
End function


Function IIF(Expression,ReturnTrue,ReturnFalse)
If Expression Then
IIF = ReturnTrue
Else
IIF = ReturnFalse
End If
End Function

全功能安全过滤函数
'参数:请求方式,过滤类型,请求名,值类型,默认值
Function SafeRequest(Requester,FilterType,RequestName,RequestType,DefaultValue)
Dim tmpValue
Select Case Requester
Case 0 : tmpValue = RequestName
Case 1 : tmpValue = Request(RequestName)
Case 2 : tmpValue = Request.Form(RequestName)
Case 3 : tmpValue = Request.QueryString(RequestName)
Case 4 : tmpValue = Request.Cookies(RequestName)
End Select

Select Case RequestType
Case 0
If Not IsNumeric(tmpValue) or Len(tmpValue) <=0 Then
tmpValue = CLng(DefaultValue)
Else
tmpValue = CLng(tmpValue)
End If
Case 1
If tmpValue="" or IsNull(tmpValue) Then tmpValue=DefaultValue
Select Case FilterType
Case 0 : tmpValue = tmpValue
Case 1 : tmpValue = SafeSql(tmpValue)
Case 2 : tmpValue = FilterHtml(tmpValue)
End Select
Case 2
If Not IsDate(tmpValue) or Len(tmpValue) <=0 Then
tmpValue = CDate(DefaultValue)
Else
tmpValue = CDate(tmpValue)
End If
End Select

SafeRequest = tmpValue
End Function

危险Sql过滤
'参数：Sql
'返回：过滤结果
Function SafeSql(str)
SafeSql = Replace(str, "'", "'")
End Function
'函数：过滤Html标签
'参数：字符串
'返回：过滤后的字符串
Function FilterHtml(str)
If IsNull(str) or str="" Then FilterHtml="" : Exit Function
Dim r
Set r = New RegExp
r.IgnoreCase = True
r.Global = True
r.MultiLine = True

r.Pattern = " <.+?>"
FilterHtml = r.Replace(str,"")
Set r = Nothing
End Function  


判断发言是否来自外部
'ChkPost=false 来自外部提交(非法)
'ChkPost=true   合法提交表单

function ChkPost()
dim server_v1,server_v2
chkpost=false
server_v1=LCase(Cstr(Request.ServerVariables("HTTP_REFERER")))
server_v2=LCase(Cstr(Request.ServerVariables("SERVER_NAME")))
if mid(server_v1,8,len(server_v2)) <>server_v2 then
chkpost=false
else
chkpost=true
end if
end function

格式化日期时间(显示)
' 参数：n_Flag
' 1:"yyyy-mm-dd hh:mm:ss"
' 2:"yyyy-mm-dd"
' 3:"hh:mm:ss"
' 4:"yyyy年mm月dd日"
' 5:"yyyymmdd"
' 6:"yyyymmddhhmmss"
' 7:"yy-mm-dd"  
' 8:"yy-mm-dd hh:mm:ss"
' 9:"yyyy年mm月"
' 10:"mm/dd/yyyy"
' ============================================
Function Format_Time(s_Time, n_Flag)
Dim y, m, d, h, mi, s
Format_Time = ""
If IsDate(s_Time) = False Then Exit Function
y = cstr(year(s_Time))
if y = "1900" then Exit Function
m = right("0"&month(s_Time),2)
d = right("0"&day(s_Time),2)
h = right("0"&hour(s_Time),2)
mi = right("0"&minute(s_Time),2)
s = right("0"&second(s_Time),2)

Select Case n_Flag
Case 1
Format_Time = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case 2
Format_Time = y & "-" & m & "-" & d
Case 3
Format_Time = h & ":" & mi & ":" & s
Case 4
Format_Time = y & "年" & m & "月" & d & "日"
Case 5
Format_Time = y & m & d
case 6
Format_Time= y & m & d & h & mi & s
case 7
Format_Time= right(y,2) & "-" & m & "-" & d
case 8
Format_Time= right(y,2) & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case 9
Format_Time = y & "年" & m & "月"
Case 10
Format_Time = m & "/" & d & "/" & y & "/"
End Select
End Function


小写数字转大写
function int2chn(n)
dim i,j,k,strlen,retval,x,y,z,str
z=array("零","壹","贰","叁","肆","伍","陆","柒","捌","玖")
y=array("","拾","佰","仟")
x=Array("","万","亿","万万亿")
strlen=len(n)
str1=n
for i= 1 to strlen
j=mid(str1,i,1)
retval=retval&z(j)
if j>0 then retval=retval&y((strlen-i) mod 4)'如果大于零，加入十进位字符
retval=replace(retval,z(0)&z(0),z(0))'出现两个零只留一个
if ((strlen-i) mod 4)=0 and right(retval,1)=z(0) then retval=left(retval,len(retval)-1)'每四位加入进阶
if ((strlen-i) mod 4)=0 then retval=retval&x(int((strlen-i)/4))'把最后的零去掉
next
int2chn=retval
end function

小写金额转大写
Function UMoney(money)
Dim lnP,Prc,Tmp,NoB,Dx,Xx,Zhen
Dim China : China = "分角元拾佰仟万拾佰仟亿"
Dim str: str = Array("零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")    
Zhen = True    
money = FormatNumber(money, 2)    
Prc = CStr(money)    
Prc = Replace(Prc, ",", "")        
lnP = Len(Prc)    
For i = lnP - 1 To 1 Step -1        
If Mid(Prc, i, 1) = "." Then            
Select Case lnP - i                
Case 1                    
Prc = Replace(Prc, ".", "") + "0"                
Case 2                    
Prc = Replace(Prc, ".", "")            
End Select            
Zhen = False            
Exit For        
End If    
Next    
If Zhen Then Prc = Prc + "00"    
lnP = Len(Prc)    
For i = 1 To lnP        
Tmp = str(Mid(Prc, i, 1)) & Tmp    
Next    
UMoney = ""    
fy = 1    
For i = 1 To lnP        
Xx = Mid(Tmp, i, 1)        
Dx = Mid(China, i, 1)                
If Xx <> "零" Then            
UMoney = Xx & Dx & UMoney            
f = 1        
Else            
If i = 3 Then            
UMoney = Dx & UMoney            
End If                    
If i = 7 Then                
UMoney = Dx & UMoney            
End If            
If f Then                
UMoney = "零" & UMoney            
End If            
f = 0        
End If    
Next    
If Zhen Then UMoney = UMoney + "整"    
UMoney = Replace(UMoney, "零万", "万")    
UMoney = Replace(UMoney, "零元", "元")
End Function


随机选取5组彩票
Function rndtest(m_count,r_count) ''参数m_count号码总数，r_count为要取出的号码数
dim x,st,i
i=1
st=""
do while i<=r_count
randomize
x=int(rnd*m_count)+1 ''产生1~m_count的随机数
if i=r_count then
if not instr(st,x)>0 then
st=st&x
i=i+1
end if
else
if not instr(st,x)>0 then
st=st&x&","   ''用,分割
i=i+1
end if
end if
if i>=m_count then
exit do ''如果m_count小于r_count将出现死循环，于是判断并跳出循环
end if
loop
rndtest=st
end function

冒泡函数
function sort(ary)ck=true
do Until ck = false
ck=false
For f = 0 to UBound(ary) -1
   if clng(ary(f))>clng(ary(f+1)) then
    v1=clng(ary(f))
    v2=clng(ary(f+1))
    ary(f)=v2
    ary(f+1)=v1
    ck=true
   end if
next
loop
sort=ary
end function

for i=0 to 4
Mycount=rndtest(33,7)
MyArray=split(Mycount,",")
newArray=sort(MyArray)
for i2=0 to UBound(newArray)
Response.Write(newArray(i2)&" ")
next
Response.Write("<br>")
next

搜索出的内容替换关键字
Function GoRed(Str,keyword)
'***************************************
'GoRed函数 Str,搜索出来的内容,keyword 要替换的关键字
'***************************************
     Dim RegObj
     Set RegObj= New RegExp '定义新的正则表达式
   With RegObj
   .Global = True
   .IgnoreCase = True
   .Pattern="([.\n]*)("&Keyword&")([.\n]*)"
   GoRed=.Replace(Str,"$1 <font color='red'>$2 </font>$3")
   End With
   Set RegObj=Nothing
End Function

示例：title=GoRed("Fditffdsdads","f")

输出title 会显示 Fdit f  f dsdads

设置过期策略
Response.buffer=true
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
Response.CacheControl = "no-cache"
Response.AddHeader "Pragma", "No-Cache"

验证第一个字符是否为字母
'false ：不是；true ：是

function IsFirstStr(str)                
IsFirstStr = true    
str=LCase(str)            
strSource ="abcdefghijklmnopqrstuvwxyz"                
if InStr(strSource,mid(str,1,1)) <=0 then                
IsFirstStr = false                
else                
IsFirstStr = true                
end if                
end function  

文章来自: 百度空间
引用通告: 查看所有引用 | 我要引用此文章
Tags: Asp 实用 函数 代码
相关日志: