Question

谁能给我asp Function类

我想要一些asp Function公共类
越多越好，带标注。
谢谢，asp高手了。
满意后一定加分。

Answer 1

' Server.UrlEncode
' Server.UrlDecode
public function urldecode(byval encodestr)
dim i
dim newstr,havechar,lastchar,char_c,next_1_c,next_1_num
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
newstr = replace(newstr,"&","&")
urldecode = newstr
end function

'******************随机数************************

Public Function suiji(ByVal intNum)
If intNum <= 0 Then Exit Function
Dim i
Dim intLength
Const Stringsource = "23456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijklmnpqrstuvwxyz"
intLength = Len(Stringsource)-1
Randomize
For i = 1 To intNum
suiji = suiji & Mid(Stringsource,Int(Rnd * intLength + 1),1)
Next
End Function

'******************组件检测************************
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function

'******************加密************************
function jiami(num)
num=CDbl(num)
jiami=(num+99)^ 2 -13
end function
'******************解密************************
function jiemi(num)
jiemi=sqr(CDbl(num)+13)-99
end function

'******************解密************************

'****************

function nohtml(str)
str=replace(str,"<","<")
str=replace(str,">",">")

dim re
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.Pattern="(\<.[^\<]*\>)"
str=re.replace(str," ")
re.Pattern="(\<\/[^\<]*\>)"
str=re.replace(str," ")
nohtml=str
nohtml = Replace(nohtml, CHR(32), "") ' 
nohtml = Replace(nohtml, CHR(9), "") ' 

nohtml=replace(nohtml,Chr(10),"")
nohtml=replace(nohtml,CHR(10) & CHR(10),"")

nohtml=Trim(HTMLEncode(nohtml))

nohtml=replace(nohtml," ",Chr(32))
' nohtml=replace(nohtml,"<BR>"," ")
' nohtml=replace(nohtml,"</P><P> "," ")
set re=nothing
end function

'******************过渡非法字符************************

Function CheckStr(Str)
If Isnull(Str) Then
CheckStr = ""
Exit Function
End If
Str = Replace(Str,Chr(0),"")
CheckStr = Replace(Str,"'","")
End Function

Function ChkPost()
dim Server_v1,Server_v2
ChkPost=False
Server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
Server_v2=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

Function write(VarValue)
response.Write VarValue
end function

Function text(VarValue)
response.Write VarValue
response.End()
end function

Function alert(VarName,VarValue,num)
select case num
case 0
alert ="<Script language=JavaScript>alert("""&VarName&""");history.back();</Script>"&VBCRLF
case 1
alert ="<Script language=JavaScript>alert("""&VarName&""");location.href="""&VarValue&""";</Script>"&VBCRLF
case 2
alert ="<Script language=JavaScript>alert("""&VarName&""");</Script>"&VBCRLF
case 3
alert ="<Script language=JavaScript>alert("""&VarName&""");top.location.href="""&VarValue&""";</Script>"&VBCRLF

end select
response.Write alert
response.end()
End Function
'**************************************************
'函数名：strLen
'作 用：求字符串长度。汉字算两个字符，英文算一个字符。
'参 数：str ----要求长度的字符串
'返回值：字符串长度
'**************************************************
Function StrLen(str)
If IsNull(str) Or Str = "" Then
strLen = 0
Exit Function
End If
Dim WINNT_CHINESE,l,t,i,c
WINNT_CHINESE=(Len("例子")=2)
If WINNT_CHINESE Then
l=Len(str)
t=l
For i=1 To l
c=Asc(Mid(str,i,1))
If c<0 Then c=c+65536
If c>255 Then t=t+1
Next
strLen=t
Else
strLen=Len(str)
End If
End Function
'**************************************************
'函数名：StrLeft
'作 用：截字符串，汉字一个算两个字符，英文算一个字符
'参 数：str ----原字符串
' strlen ----截取长度
'返回值：截取后的字符串
'**************************************************
Function StrLeft(str,strlen)
Dim WINNT_CHINESE,l,t,i,c
If str="" or isNull(str) Then
StrLeft=""
Exit Function
End If
l=Len(Replace(Replace(Replace(Replace(str," "," "),""",Chr(34)),">",">"),"<","<"))
t=0
For i=1 To l
c=Abs(Asc(Mid(str,i,1)))
If c>255 Then
t=t+2
Else
t=t+1
End If
If t>=strlen Then
StrLeft=Left(str,i) & ".."
Exit For
Else
StrLeft=str
End If
Next
StrLeft=Trim(StrLeft)
End Function

'*******************
'屏蔽字符
'*******************
Function ChkBadWords(Str)
If IsNull(Str) Then Exit Function
if Not IsArray(BadWords) Then Exit Function
Dim i
For i = 0 To UBound(BadWords)
If InStr(Str,BadWords(i))>0 Then
Str = Replace(Str,BadWords(i),"*")
End If
Next
ChkBadWords = Str
End Function
'用于用户发布的各种信息过滤，不带脏话过滤
Function HTMLEncode(fString)
If Not IsNull(fString) Then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = replace(fString, """", "1"")
fString = Replace(fString, CHR(32), " ") ' 
fString = Replace(fString, CHR(9), " ") ' 
fString = Replace(fString, CHR(34), """)
fString = Replace(fString, CHR(39), "'") '单引号过滤
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(0), "")
fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
fString = Replace(fString, CHR(10), "<BR> ")
fString = Replace(fString, "<BR>", "<BR>")
fString = Replace(fString, "<P>", "<P>")
fString = Replace(fString, "</P>", "</P>")
fString=fString
HTMLEncode = fString
else
' HTMLEncode="错误"
End If
End Function
'用于论坛本身的过滤，带脏话过滤
Function iHTMLEncode(fString)
If Not IsNull(fString) Then
fString = replace(fString, "<BR>", CHR(10))
fString = replace(fString, "</P><P>",CHR(10) & CHR(10))
iHTMLEncode = fString
End If
End Function

Function write(Str)
Response.write Str
'Response.Buffer
End Function

'**************************************************
'函数名：IsValidEmail
'作 用：检查Email地址合法性
'参 数：email ----要检查的Email地址
'返回值：True ----Email地址合法
' False ----Email地址不合法
'**************************************************
function IsValidEmail(email)
dim names, name, i, c
IsValidEmail = true
names = Split(email, "@")
if UBound(names) <> 1 then
IsValidEmail = false
exit function
end if
for each name in names
if Len(name) <= 0 then
IsValidEmail = false
exit function
end if
for i = 1 to Len(name)
c = Lcase(Mid(name, i, 1))
if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
IsValidEmail = false
exit function
end if
next
if Left(name, 1) = "." or Right(name, 1) = "." then
IsValidEmail = false
exit function
end if
next
if InStr(names(1), ".") <= 0 then
IsValidEmail = false
exit function
end if
i = Len(names(1)) - InStrRev(names(1), ".")
if i <> 2 and i <> 3 then
IsValidEmail = false
exit function
end if
if InStr(email, "..") > 0 then
IsValidEmail = false
end if
end function

'*********************************************************************************************

'日期加减 GetDateDiif("2008-1-14",100)
Function GetDateDiif(strDate,intDays)
If strDate="" or isNull(strDate) Then
strDate=now()
End If

sDate = CDate(strDate)+ intDays
GetDateDiif = sDate
End Function

function One2two(obj)
if len(obj)<2 then
One2two="0"&obj
else
One2two=obj
end if
end function

'该函数作用：按指定参数格式化显示时间。
'numformat=1:将时间转化为yyyy-mm-dd hh:nn格式。
'numformat=2:将时间转化为yyyy-mm-dd格式。
'numformat=3:将时间转化为hh:nn格式。
'numformat=4:将时间转化为yyyy年mm月dd日 hh时nn分格式。
'numformat=5:将时间转化为yyyy年mm月dd日格式。
'numformat=6:将时间转化为hh时nn分格式。
'numformat=7:将时间转化为yyyy年mm月dd日 星期×格式。
'numformat=8:将时间转化为yymmdd格式。
'numformat=9:将时间转化为mmdd格式。

function formatdate(shijian,numformat)
dim ystr,mstr,dstr,hstr,nstr '变量含义分别为年字符串，月字符串，日字符串，时字符串，分字符串

if isnull(shijian) then
numformat=0
else
ystr=DatePart("yyyy",shijian)

if DatePart("m",shijian)>9 then
mstr=DatePart("m",shijian)
else
mstr="0"&DatePart("m",shijian)
end if

if DatePart("d",shijian)>9 then
dstr=DatePart("d",shijian)
else
dstr="0"&DatePart("d",shijian)
end if

if DatePart("h",shijian)>9 then
hstr=DatePart("h",shijian)
else
hstr="0"&DatePart("h",shijian)
end if

if DatePart("n",shijian)>9 then
nstr=DatePart("n",shijian)
else
nstr="0"&DatePart("n",shijian)
end if
end if

select case numformat
case 0
formatdate=""
case 1
formatdate=ystr&"-"&mstr&"-"&dstr&" "&hstr&":"&nstr
case 2
formatdate=ystr&"-"&mstr&"-"&dstr
case 3
formatdate=hstr&":"&nstr
case 4
formatdate=ystr&"年"&mstr&"月"&dstr&"日 "&hstr&"时"&nstr&"分"
case 5
formatdate=ystr&"年"&mstr&"月"&dstr&"日"
case 6
formatdate=hstr&"时"&nstr&"分"
case 7
formatdate=ystr&"年"&mstr&"月"&dstr&"日 "&WeekdayName(Weekday(shijian))
case 8
formatdate=right(ystr,2)&mstr&dstr
case 9
formatdate=mstr&dstr
case 10
formatdate=right(ystr,2)&"-"&mstr&"-"&dstr
case 11
formatdate=mstr&"-"&dstr

end select
end function

Answer 2

可以看看这个：
ASP各种函数功能木块集合

http://www.030904.com/blog/blogview.asp?logID=1002