[转载]ASP 中常用函数（备查）

1，登录验证函数

<%
Function chk_regist(requestname,requestpwd,tablename,namefield,pwdfield,reurl)
dim cn_name,cn_pwd
cn_name=trim(request.form(""&requestname&""))
cn_pwd=trim(request.form(""&requestpwd&""))
if cn_name="" or cn_pwd="" then
    response.Write("<script language=javascript>alert(""请将帐号密码填写完整，谢谢合作。"");history.go(-1)</script>")
end if
Set rs = Server.CreateObject ("ADODB.Recordset")
sql = "Select * from "&tablename&" where "&namefield&"=’"&cn_name&"’"
rs.open sql,conn,1,1
if rs.eof then
    response.Write("<script language=javascript>alert(""没有该会员ID，请确认有没有被申请。"");history.go(-1)</script>")
else
    if rs(""&pwdfield&"")=cn_pwd then
    session("cn_name")=rs(""&namefield&"")
    response.Redirect(reurl)
    else
    response.Write("<script language=javascript>alert(""提醒，您的帐号和密码是不吻合。注意数字和大小写。"");history.go(-1)</script>")
    end if
end if
rs.close
Set rs = Nothing
End Function
%>



参数说明：
chk_regist(requestname,requestpwd,tablename,namefield,pwdfield,reurl)

requestname 为接受HTML页中输入名称的INPUT控件名
requestpwd 为接受HTML页中输入密码的INPUT控件名
tablename 为数据库中保存注册信息的表名
namefield 为该信息表中存放用户名称的字段名
pwdfield 为该信息表中存放用户密码的字段名
reurl 为登录正确后跳转的页

引用示例如下：

<%
call chk_regist("b_name","b_pwd","cn_admin","cn_name","cn_pwd","admin.asp")
%>



调试地址：http://www.cnbruce.com/test/function/regist.asp

2，经常有可能对某个事物进行当前状态的判断，一般即做一字段（数值类型，默认滴?）
通过对该字段值的修改达到状态切换的效果。那么，我又做了个函数，让自己轻松轻松。

<%
Function pvouch(tablename,fildname,autoidname,indexid)
dim fildvalue
Set rs = Server.CreateObject ("ADODB.Recordset")
sql = "Select * from "&tablename&" where "&autoidname&"="&indexid
rs.Open sql,conn,2,3
fildvalue=rs(""&fildname&"")
if fildvalue=0 then
fildvalue=1
else
fildvalue=0
end if
rs(""&fildname&"")=fildvalue
rs.update
rs.close
Set rs = Nothing
End Function
%>



参数说明：
pvouch(tablename,fildname,autoidname,indexid)

tablename 该事物所在数据库中的表名
fildname 该事物用以表明状态的字段名（字段类型是数值型）
autoidname 在该表中的自动编号名
indexid 用以修改状态的对应自动编号的值

引用示例如下：


<%
dowhat=request.QueryString("dowhat")
p_id=cint(request.QueryString("p_id"))

if dowhat="tj" and p_id<>"" then
call pvouch("cn_products","p_vouch","p_id",p_id)
end if
%>

<%if rs("p_vouch")=0 then%>
<a href=showpro.asp?dowhat=tj&p_id=<%=rs("p_id")%>>推荐</a>
<%else%>
<a href=showpro.asp?dowhat=tj&p_id=<%=rs("p_id")%>>取消推荐</a>
<%end if%>




3.HTML转换函数

动作转换成HTML

Function HTMLEncode(reString) ’转换HTML代码(显示数据时使用)
     Dim Str:Str=reString
     If Not IsNull(Str) Then
           Str = Replace(Str, "&", "&")
           Str = Replace(Str, ">", ">")
           Str = Replace(Str, "<", "<")
           Str = Replace(Str, CHR(32), " ")
        Str = Replace(Str, CHR(9), " ")
           Str = Replace(Str, CHR(34), """)
           Str = Replace(Str, CHR(39), "’")
           Str = Replace(Str, CHR(13), "")
           Str = Replace(Str, CHR(10), "<br>")
           HTMLEncode = Str
     End If
End Function



HTML解码函数

Function HTMLDecode(reString) ’HTML解码函数(保存或提交数据时使用,可以不使用)
     Dim Str:Str=reString
     If Not IsNull(Str) Then
           Str = Replace(Str, "&", "&")
           Str = Replace(Str, ">", ">")
           Str = Replace(Str, "<", "<")
           Str = Replace(Str, " ", CHR(32))
        Str = Replace(Str, " ", CHR(9))
           Str = Replace(Str, "    ", CHR(9))
           Str = Replace(Str, """, CHR(34))
           Str = Replace(Str, "’", CHR(39))
           Str = Replace(Str, "", CHR(13))
           Str = Replace(Str, "<br>", CHR(10))
           HTMLDecode = Str
     End If
End Function



4.日期转换函数

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
     If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
     Select Case ShowType
     Case "Y-m-d"   
           DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay
     Case "Y-m-d H:I A"
           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       
           DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&" "&DateAMPM
     Case "Y-m-d H:I:S"
           Dim DateSecond
           DateSecond=Second(DateTime)
           If Len(DateHour)<2 Then DateHour="0"&DateHour       
           If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
           DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&":"&DateSecond
     Case "YmdHIS"
           DateSecond=Second(DateTime)
           If Len(DateHour)<2 Then DateHour="0"&DateHour       
           If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
           DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond       
     Case "ym"
           DateToStr=Right(Year(DateTime),2)&DateMonth
     Case "d"
           DateToStr=DateDay
     Case Else
           If Len(DateHour)<2 Then DateHour="0"&DateHour
           DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute
     End Select
End Function


5.删除附件函数:
sub Delfile(filepath)
     on error resume next
     set DelObj=Server.CreateObject("Scripting.FileSystemObject")
     filepath="../"&filepath
     Delpath=server.mappath(filepath)
’      response.write delpath&"<br>"
     set DelFi=DelObj.getfile(Delpath)
     DelFi.Delete
     set Delobj=nothing
end sub


6.提交表单时出现的提示框:

<html>
<head>
<SCRIPT language=javascript>
function ConfirmDel()
{
   if(confirm("确定要删除选中的产品吗？一旦删除将不能恢复！"))
     return true;
   else
     return false;
       
}
</SCRIPT>
</head>
<body>
<form name="del" method="Post" action="aa.asp" οnsubmit="return ConfirmDel();">
<input name="submit" type=’submit’ value=’删除选定的产品’>
</form>
</body>
</html>


7.经常有可能对某个事物进行当前状态的判断，一般即做一字段（数值类型，默认值为0）
通过对该字段值的修改达到状态切换的效果。那么，我又做了个函数，让自己轻松轻松。

<%
Function pvouch(tablename,fildname,autoidname,indexid)
dim fildvalue
Set rs = Server.CreateObject ("ADODB.Recordset")
sql = "Select * from "&tablename&" where "&autoidname&"="&indexid
rs.Open sql,conn,2,3
fildvalue=rs(""&fildname&"")
if fildvalue=0 then
fildvalue=1
else
fildvalue=0
end if
rs(""&fildname&"")=fildvalue
rs.update
rs.close
Set rs = Nothing
End Function
%>



参数说明：
pvouch(tablename,fildname,autoidname,indexid)

tablename 该事物所在数据库中的表名
fildname 该事物用以表明状态的字段名（字段类型是数值型）
autoidname 在该表中的自动编号名
indexid 用以修改状态的对应自动编号的值

引用示例如下：

<%
dowhat=request.QueryString("dowhat")
p_id=cint(request.QueryString("p_id"))

if dowhat="tj" and p_id<>"" then
call pvouch("cn_products","p_vouch","p_id",p_id)
end if
%>

<%if rs("p_vouch")=0 then%>
<a href=showpro.asp?dowhat=tj&p_id=<%=rs("p_id")%>>推荐</a>
<%else%>
<a href=showpro.asp?dowhat=tj&p_id=<%=rs("p_id")%>>取消推荐</a>
<%end if%>



调试地址：http://www.cnbruce.com/test/function/showpro.asp

8.为很多中小企业写站点，一般产品展示是个大项目，那么做成的页面也就不同。
要不就是横排来几个，要不就是竖排来几个，甚至全站要翻来覆去的搞个好几次，麻烦也很累。
索性写个函数能缓解一下，于是就成了下面


<%
function showpros(tablename,topnum,fildname,loopnum,typenum)
Set rs = Server.CreateObject ("ADODB.Recordset")
sql = "Select top "&topnum&" * from "&tablename
rs.Open sql,conn,1,1
if rs.eof and rs.bof then
response.Write("暂时无该记录")
else
response.Write("<table width=’100%’>")
for i=1 to rs.recordcount
if (i mod loopnum=1) then
response.write"<tr>"
end if
select case typenum
case "1"
response.Write("<td><table width=’100%’><tr><td bgcolor=red width=’50%’>")
response.Write(rs(""&fildname&""))
response.Write("</td><td bgcolor=black>")
response.Write("方式1之"&i&"记录")’此处的“方式1”可以替换显示为其余字段的值
response.Write("</td></tr>")’如果字段比较多，继续添加新个表格行来显示
response.Write("</table></td>")
case "2"
response.Write("<td><table width=’100%’><tr><td bgcolor=red>")
response.Write(rs(""&fildname&""))
response.Write("</td></tr>")
response.Write("<tr><td bgcolor=black>")
response.Write("方式2之"&i&"记录")
response.Write("</td></tr>")
response.Write("</table></td>")
end select
if (i mod loopnum=0) then
response.write"</tr>"
end if
rs.movenext
next
response.Write("</table>")
end if
rs.close
Set rs = Nothing
end function
%>



参数说明：showpros(tablename,topnum,fildname,loopnum,typenum)

whichpro为选择何类型的产品种类
topnum表示提取多少条记录
fildname表示调试显示的字段，具体应用的时候可以省去该参数，在函数内部直接使用
loopnum表示显示的循环每行的记录条数
typenum表示循环显示的方法：目前分了两类，横向并列、纵向并列显示同一数据记录行的不同记录

引用示例如下：


<%
if request.form("submit")<>"" then
topnum=request.form("topnum")
loopnum=request.form("loopnum")
typenum=request.form("typenum")
else
topnum=8
loopnum=2
typenum=1
end if
%>
<%call showpros("cn_products",topnum,"p_name",loopnum,typenum)%>
<form action=index.asp method=post>
显示的记录总数：<input name=topnum value=<%=topnum%>>
显示的行循环数：<input name=loopnum value=<%=loopnum%>>
显示的方式类型：<select name=typenum>
<option value="1">方式1</option>
<option value="2">方式2</option>
</select>
<input type=submit name=submit value=Sure>
</form>



调试地址：http://www.cnbruce.com/test/function/index.asp


可以选择文件下载查看： Download file

9.IP转换成数字，限制IP时用

’//IP转换成数字，限制IP时用
’@使用示例
’// userIPnum = IP2Num(Request.ServerVariables("REMOTE_ADDR"))
’// if userIPnum > IP2Num("192.168.0.0") and userIPnum < IP2Num("192.168.0.255") then
’// response.write ("<center>您的IP被禁止</center>")
’// response.end’
// end if

function IP2Num(sip)
dim str1,str2,str3,str4
dim num IP2Num=0
if isnumeric(left(sip,2)) then
str1=left(sip,instr(sip,".")-1)
sip=mid(sip,instr(sip,".")+1)
str2=left(sip,instr(sip,".")-1)
sip=mid(sip,instr(sip,".")+1)
str3=left(sip,instr(sip,".")-1)
str4=mid(sip,instr(sip,".")+1)
num=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1
IP2Num = num
end if
end function


10.ASP安全检测与过滤函数SafeCheck

<%
’作用:安全字符串检测函数
’名字:SafeCheck
’参数:CheckString,CheckType,CheckLength
’说明:
’Checkstring待检测字符串:任意字符.
’CheckType检测类型0正常短字符1数字2日期3金钱4编码HTML5解码HTML6登录字符串7防攻击检测
’CheckLength检测类型长度:类型为int,当为金钱时为小数点的位置
’返回值:如果通过检测,返回正确字符串,
’如果未通过则返回错误代码SYSTEM_ERROR|ERROR_CODE
’Script Writen by :SnowDu(杜雪.NET)
’Web:http://www.snsites.com/
’Web:http://www.knowsky.com/
’-------------------------------------------
function SafeCheck(CheckString,CheckType,CheckLength)
    On Error Resume Next
    ErrorRoot="SYSTEM_ERROR|"
    if checkString="" then
        SafeCheck=ErrorRoot&"00001"
        exit function
    end if

    CheckString=Replace(CheckString,"’","’")
    select case CheckType
        case 0
            CheckString=trim(CheckString)
            SafeCheck=Left(CheckString,CheckLength)

        case 1
            if not isnumberic(CheckString) then
               SafeCheck=ErrorRoot&"00002"
               exit function
            else
               SafeCheck=Left(CheckString,CheckLength)
            end if

        case 2
            tempVar=IsDate(CheckString)
            if Not TempVar then
               SafeCheck=ErrorRoot&"00003"
               exit function
            else
               select case CheckLength
                    case 0
                        SafeCheck=FormatDateTime(CheckString,vbShortDate)
                    case 1
                        SafeCheck=FormatDateTime(CheckString,vbLongDate)
                    case 2
                        SafeCheck=CheckString
               end select
            end if

        case 3
            tempVar=FormatCurrency(CheckString,0)
            if Err then
               SafeCheck=ErrorRoot&"00004"
               exit function
            else
               SafeCheck=FormatCurrency(CheckString,CheckLength)
            end if

        case 4
            sTemp = CheckString
            If IsNull(sTemp) = True Then
               SafeCheck=ErrorRoot&"00005"
               Exit Function
            End If
            sTemp = Replace(sTemp, "&", "&")
            sTemp = Replace(sTemp, "<", "<")
            sTemp = Replace(sTemp, ">", ">")
            sTemp = Replace(sTemp, Chr(34), """)
            sTemp = Replace(sTemp, Chr(10), "<br>")
            SafeCheck = Left(sTemp,CheckLength)

        case 5
            sTemp = CheckString
            If IsNull(sTemp) = True Then
               SafeCheck=ErrorRoot&"00006"
               Exit Function
            End If
            sTemp = Replace(sTemp, "&", "&")
            sTemp = Replace(sTemp, "<", "<")
            sTemp = Replace(sTemp, ">", ">")
            sTemp = Replace(sTemp, """, Chr(34))
            sTemp = Replace(sTemp, "<br>",Chr(10))
            SafeCheck = Left(sTemp,CheckLength)

        case 6
            s_BadStr = "’ 　&<>?%,;:()`~!@#$^*{}[]|+-=" & Chr(34) & Chr(9) & Chr(32)
            n = Len(s_BadStr)
            IsSafeStr = True
            For i = 1 To n
            If Instr(CheckString, Mid(s_BadStr, i, 1)) > 0 Then
            IsSafeStr = False
            End If
            Next
            if IsSafeStr then
            SafeCheck=left(CheckString,CheckLength)
            else
            SafeCheck=ErrorRoot&"00007"
            Exit Function
            end if

        case 7
            s_Filter="net user|xp_cmdshell|/add|select|count|asc|char|mid|’|""|"
            S_Filter=S_Filter&"insert|delete|drop|truncate|from|%|declare|-"
            S_Filters=split(S_Filter,"|")
            isFound=false
            for i=0 to ubound(S_Filters)-1
               if Instr(lcase(CheckString),lcase(S_Filters(i)))<>0 then
                    isFound=true
                    exit for
               end if
            next
            if isFound then
               SafeCheck=ErrorRoot&"00008"
               Exit Function
            else
               SafeCheck=left(CheckString,CheckLength)
            end if
    end select
end function
%>


11.控制输出字符串的长度，可以区别中英文
　　函数在下面，是方法是：
　　strvalue("复请Email通知如果不填写则取注册Email",26)
　　这里26是指26个英文字母，也就是13个汉字


function strlen(str)
dim p_len
p_len=0
strlen=0
if trim(str)<>"" then
p_len=len(trim(str))
for xx=1 to p_len
if asc(mid(str,xx,1))<0 then
strlen=int(strlen) + 2
else
strlen=int(strlen) + 1
end if
next
end if
end function

function strvalue(str,lennum)
dim p_num
dim i
if strlen(str)<=lennum then
strvalue=str
else
p_num=0
x=0
do while not p_num > lennum-2
x=x+1
if asc(mid(str,x,1))<0 then
p_num=int(p_num) + 2
else
p_num=int(p_num) + 1
end if
strvalue=left(trim(str),x)&"…"
loop
end if
end function


12.一个把数字转英文的实用程序
　　原数字格式：2000
　　格式化后：TWO THOUSAND ONLY
　　引用：<%=make("2000")%>
　　自定义函数：


<%
function zr4(y)’准备数据
dim z(10)
z(1)="ONE"
z(2)="TWO"
z(3)="THREE"
z(4)="FOUR"
z(5)="FIVE"
z(6)="SIX"
z(7)="SEVEN"
z(8)="EIGHT"
z(9)="NINE"
zr4=z(MID(y,1,1))
end function

function zr3(y)’准备数据
dim z(10)
z(1)="ONE"
z(2)="TWO"
z(3)="THREE"
z(4)="FOUR"
z(5)="FIVE"
z(6)="SIX"
z(7)="SEVEN"
z(8)="EIGHT"
z(9)="NINE"
zr3=z(MID(y,3,1))
end function

function zr2(y)’准备数据
dim z(20)
z(10)="TEN"
z(11)="ELEVEN"
z(12)="TWELVE"
z(13)="THIRTEEN"
z(14)="FOURTEEN"
z(15)="FIFTEEN"
z(16)="SIXTEEN"
z(17)="SEVENTEEN"
z(18)="EIGHTEEN"
z(19)="NINETEEN"
zr2=z(MID(y,2,2))
end function

function zr1(y)’准备数据
dim z(10)
z(1)="TEN"
z(2)="TWENTY"
z(3)="THIRTY"
z(4)="FORTY"
z(5)="FIFTY"
z(6)="SIXTY"
z(7)="SEVENTY"
z(8)="EIGHTY"
z(9)="NINETY"
zr1=z(MID(y,2,1))
end function

function dw(y)’准备数据
dim z(5)
z(0)=""
z(1)="THOUSAND"
z(2)="MILLION"
z(3)="BILLION"
dw=z(y)
end function

function w2(y)’用来制作2位数字转英文     
if MID(y,2,1)="0" then’判断是否小于十
value=zr3(y)
elseif MID(y,2,1)="1" then’判断是否在十到二十之间
value=zr2(y)
elseif MID(y,3,1)="0" then’判断是否为大于二十小于一百的能被十整除的数（为了去掉尾空格）
value=zr1(y)
else
value=zr1(y)+" "+zr3(y)’加上十位到个位的空格    
end if
w2=value
end function

function w3(y)’用来制作3位数字转英文
if MID(y,1,1)="0" then’判断是否小于一百
value=w2(y)
elseif MID(y,2,2)="00" then ’判断是否能被一百整除
value=zr4(y)+" "+"HUNDRED"
else
value=zr4(y)+" "+"HUNDRED"+" "+"AND"+" "+w2(y)’不能整除的要后面加“AND”
end if
w3=value
end function

function make(x)
z=instr(1,x,".",1)’取小数点位置
if z<>0 then’判断有没有小数
lstr=mid(x,1,z-1)’取小数点左边的字串
rstr=mid(x,z+1,2)’取小数点右边的字串
else
lstr=x’没有小数的情况
end if
lstrev=StrReverse(lstr)’对左边的字串取反字串
dim a(5)’定义5个字串变量用来存放解析出的三位一组的字串
select case len(lstrev) mod 3’字串长度不能被整除，需补齐
case "1"
lstrev=lstrev+"00"
case "2"
lstrev=lstrev+"0"
end select
lm=""’用来存放转换后的整数部分
for i=0 to len(lstrev)/3-1’计算有多少个三位
a(i)=StrReverse(mid(lstrev,3*i+1,3))’截取第1个三位
if a(i)<>"000" then ’用来避免这种情况“1000000=ONE MILLION THOUSAND ONLY”
if i<>0 then
lm=w3(a(i))+" "+dw(i)+" "+lm’用来加上“THOUSAND OR MILLION OR BILLION”
else
lm=w3(a(i))’防止i=0时“lm=w3(a(i))+" "+dw(i)+" "+lm”多加两个尾空格
end if
else
lm=w3(a(i))+lm
end if
NEXT
xs=""’用来存放转换后的小数部分
if z<>0 then
xs="AND CENTS"+" "+w2("$"+rstr)+" "’小数部分存在时转换小数部分      
end if
make=lm+" "+xs+"ONLY"’最后结果，加上ONLY
end function
%>

13.把长的数字用逗号隔开显示
　　文字格式：12345678
　　格式化数字：12,345,678
　　自定义函数：

<%
Function Comma(str)
If Not(IsNumeric(str)) Or str = 0 Then
Result = 0
ElseIf Len(Fix(str)) < 4 Then
Result = str
Else
Pos = Instr(1,str,".")
If Pos > 0 Then
Dec = Mid(str,Pos)
End if
Res = StrReverse(Fix(str))
LoopCount = 1
While LoopCount <= Len(Res)
TempResult = TempResult + Mid(Res,LoopCount,3)
LoopCount = LoopCount + 3
If LoopCount <= Len(Res) Then
TempResult = TempResult + ","
End If
Wend
Result = StrReverse(TempResult) + Dec
End If
Comma = Result
End Function
%>



　　引用：
<%
aLongNumber = "12345678"
response.wirte Comma(aLongNumber)
%>


14.随机生成文件名的函数
<%
　Function Generator(Length)
　　dim i, tempS, v
　　dim c(39)
　　tempS = ""
　　c(1) = "a": c(2) = "b": c(3) = "c": c(4) = "d": c(5) = "e": c(6) = "f": c(7) = "g"
　　c(8) = "h": c(9) = "i": c(10) = "j": c(11) = "k": c(12) = "l": c(13) = "m": c(14) = "n"
　　c(15) = "o": c(16) = "p": c(17) = "q": c(18) = "r": c(19) = "s": c(20) = "t": c(21) = "u"
　　c(22) = "v": c(23) = "w": c(24) = "x": c(25) = "y": c(26) = "z": c(27) = "1": c(28) = "2"
　　c(29) = "3": c(30) = "4": c(31) = "5": c(32) = "6": c(33) = "7": c(34) = "8": c(35) = "9"
　　c(36) = "-": c(37) = "_": c(38) = "@": c(39) = "!"
　　If isNumeric(Length) = False Then
   Response.Write "A numeric datatype was not submitted to this function."
   Exit Function
　　End If
　　For i = 1 to Length
   Randomize
   v = Int((39 * Rnd) + 1)
   tempS = tempS & c(v)
　　Next
　　Generator = tempS
　End Function
      
　For i = 1 to 20
　　Randomize
　　x = Int((20 * Rnd) + 1) + 10
　　Response.Write Generator(x) & "<br>" & vbnewline
　Next
%>


15.每行显示n个字母，自动换行

Function rowscode(str,n)
If len(str)<=n/2 Then
rowscode=str
Else
Dim TStr
Dim l,t,c
Dim i
l=len(str)
TStr=""
t=0
for i=1 to l
c=asc(mid(str,i,1))
If c<0 then c=c+65536
If c>255 then
t=t+2
Else
t=t+1
End If
TStr=TStr&(mid(str,i,1))
If t>n Then
TStr=TStr&"<br>"
t=0
End if
next
rowscode= TStr
End If
End Function


16.截取字符串多余用省略号显示（支持中文）

Function CutStr(byVal Str,byVal 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



17.注册帐号时密码随机生成的ASP代码
ASP生成随机密码的两个函数：
函数一
<%
function makePassword(byVal maxLen)
Dim strNewPass
Dim whatsNext, upper, lower, intCounter
Randomize
For intCounter = 1 To maxLen
whatsNext = Int((1 - 0 + 1) * Rnd + 0)
If whatsNext = 0 Then
’character
upper = 90
lower = 65
Else
upper = 57
lower = 48
End If
strNewPass = strNewPass & Chr(Int((upper - lower + 1) * Rnd + lower))
Next
makePassword = strNewPass
end function
%>


makePassword(str) ’str 密码的位数
函数二
<% Function gen_key(digits)
dim char_array(35)
char_array(0) = "0"
char_array(1) = "1"
char_array(2) = "2"
char_array(3) = "3"
char_array(4) = "4"
char_array(5) = "5"
char_array(6) = "6"
char_array(7) = "7"
char_array(8) = "8"
char_array(9) = "9"
char_array(10) = "A"
char_array(11) = "B"
char_array(12) = "C"
char_array(13) = "D"
char_array(14) = "E"
char_array(15) = "F"
char_array(16) = "G"
char_array(17) = "H"
char_array(18) = "I"
char_array(19) = "J"
char_array(20) = "K"
char_array(21) = "L"
char_array(22) = "M"
char_array(23) = "N"
char_array(24) = "O"
char_array(25) = "P"
char_array(26) = "Q"
char_array(27) = "R"
char_array(28) = "S"
char_array(29) = "T"
char_array(30) = "U"
char_array(31) = "V"
char_array(32) = "W"
char_array(33) = "X"
char_array(34) = "Y"
char_array(35) = "Z"
randomize
do while len(output) < digits
num = char_array(Int(35 * Rnd + 0))
output = output + num
loop
gen_key = output
End Function
%>


gen_key(str) ’str为密码位数
这个函数还可以扩展。。如果你还要加上“大小写敏感区分大小写”特性的话，修改数组大小为char_array(50)，然后在后面列出所有可能的小写字符。例如：
char_array(36) = "a"
char_array(37) = "b"
...............类推

18.获得ASP的中文日期字符串

    我们通常需要在WEB页面上写上当前的日期，可能使用客户端script ，或者使用ASP。使用ASP的一个特点是，它产生的效果看起来是静态的页面，但实际上它是动态生成的。如果你希望用ASP显示一个中文的日期，则需要转化一下。下面是用来转化的函数及其调用实例。
<<<< 函数实现 >>>>
<%
’======================================================
’ 函数 Date2Chinese
’ 功能：获得中文日期的字符串（如一九九八年五月十二日）
’ 参数: iDate 要转化的日期
’ 返回: 中文日期的字符串
’======================================================
Function Date2Chinese(iDate)
    Dim num(10)
    Dim iYear
    Dim iMonth
    Dim iDay

    num(0) = "〇"
    num(1) = "一"
    num(2) = "二"
    num(3) = "三"
    num(4) = "四"
    num(5) = "五"
    num(6) = "六"
    num(7) = "七"
    num(8) = "八"
    num(9) = "九"

    iYear = Year(iDate)
    iMonth = Month(iDate)
    iDay = Day(iDate)
    Date2Chinese = num(iYear / 1000) + _
        num((iYear / 100) Mod 10) + num((iYear _
        / 10) Mod 10) + num(iYear Mod _
        10) + "年"
    If iMonth >= 10 Then
        If iMonth = 10 Then
            Date2Chinese = Date2Chinese + _
            "十" + "月"
        Else
            Date2Chinese = Date2Chinese + _
            "十" + num(iMonth Mod 10) + "月"
        End If
    Else
        Date2Chinese = Date2Chinese + _
            num(iMonth Mod 10) + "月"
    End If
    If iDay >= 10 Then
        If iDay = 10 Then
            Date2Chinese = Date2Chinese + _
            "十" + "日"
        ElseIf iDay = 20 Or iDay = 30 Then
            Date2Chinese = Date2Chinese + _
            num(iDay / 10) + "十" + "日"
        ElseIf iDay > 20 Then
            Date2Chinese = Date2Chinese + _
            num(iDay / 10) + "十" + _
            num(iDay Mod 10) + "日"
        Else
           Date2Chinese = Date2Chinese + _
           "十" + num(iDay Mod 10) + "日"
        End If
    Else
        Date2Chinese = Date2Chinese + _
        num(iDay Mod 10) + "日"
    End If
End Function
%>


<<<< 调 用 举 例 >>>>
<%
response.write date2Chinese(date())
%>

19.判断输入域名是否正确的函数：

dim c,words,word,i,wnum
function IsValiddomin(word)
IsValiddomin = true
words = Split(word, ".")
wnum=UBound(words)
if words(0)="www" then
IsValiddomin = IsValidword(words(1))
IsValiddomin = IsValidword2(words(2))
if words(wnum)="cn" then
if wnum<>3 then
IsValiddomin = false
exit function
end if
else
if wnum<>2 then
IsValiddomin = false
exit function
end if
end if
else
IsValiddomin = IsValidword(words(0))
IsValiddomin = IsValidword2(words(1))
if words(wnum)="cn" then
if wnum<>2 then
IsValiddomin = false
exit function
end if
else
if wnum<>1 then
IsValiddomin = false
exit function
end if
end if
end if
end function

function IsValidword2(word)
IsValidword2 = true
IsValidword2 = IsValidword(word)
if word<>"net" and word<>"com" and word<>"cc" and word<>"org" and word<>"info" and word<>"gov" then ’ 自己添加
IsValidword2 = false
exit function
end if
end function

function IsValidword(word)
IsValidword = true

if Len(word) <= 0 then
IsValidword = false
exit function
end if
for i = 1 to Len(word)
c = Lcase(Mid(word, i, 1))
if InStr("abcdefghijklmnopqrstuvwxyz-", c) <= 0 and not IsNumeric(c) then
IsValidword = false
exit function
end if
next
end function

if IsValiddomin("wrclub.net.cn") then
response.write "right"
else
response.write "wrong"
end if


20.判断是否含有中文字符函数，函数主要用于设置密码，如ftp密码设置：

function nothaveChinese(para)
dim str
nothaveChinese=true
str=cstr(para)
for i = 1 to Len(para)
c=asc(mid(str,i,1))
if c<0 then
nothaveChinese=false
exit function
end if
next
end function

21.限制字符是否中文代码：

function isChinese(para)
on error resume next
dim str
dim i
if isNUll(para) then
isChinese=false
exit function
end if
str=cstr(para)
if trim(str)="" then
isChinese=false
exit function
end if
for i=1 to len(str)
c=asc(mid(str,i,1))
if c>=0 then
isChinese=false
exit function
end if
next
isChinese=true
if err.number<>0 then err.clear
end function



22.判断Email是否正确函数：

function IsValidEmail(email)
dim names, name, i, c
’Check for valid syntax in an email address.
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



23.判断电话号码是否正确函数：

function IsValidTel(para)
on error resume next
dim str
dim l,i
if isNUll(para) then
IsValidTel=false
exit function
end if
str=cstr(para)
if len(trim(str))<7 then
IsValidTel=false
exit function
end if
l=len(str)
for i=1 to l
if not (mid(str,i,1)>="0" and mid(str,i,1)<="9" or mid(str,i,1)="-") then
IsValidTel=false
exit function
end if
next
IsValidTel=true
if err.number<>0 then err.clear
end function



24.判断文件名是否合法

<%
’判断文件名是否合法
Function isFilename(aFilename)
Dim sErrorStr,iNameLength,i
isFilename=TRUE
sErrorStr=Array("/","/",":","*","?","""","<",">","|")
iNameLength=Len(aFilename)
If iNameLength<1 Or iNameLength=null Then
isFilename=FALSE
Else
For i=0 To 8
If instr(aFilename,sErrorStr(i)) Then
isFilename=FALSE
End If
Next
End If
End Function



25.去掉字符串头尾的连续的回车和空格

function trimVBcrlf(str)
trimVBcrlf=rtrimVBcrlf(ltrimVBcrlf(str))
end function

’去掉字符串开头的连续的回车和空格
function ltrimVBcrlf(str)
dim pos,isBlankChar
pos=1
isBlankChar=true
while isBlankChar
if mid(str,pos,1)=" " then
pos=pos+1
elseif mid(str,pos,2)=VBcrlf then
pos=pos+2
else
isBlankChar=false
end if
wend
ltrimVBcrlf=right(str,len(str)-pos+1)
end function

’去掉字符串末尾的连续的回车和空格
function rtrimVBcrlf(str)
dim pos,isBlankChar
pos=len(str)
isBlankChar=true
while isBlankChar and pos>=2
if mid(str,pos,1)=" " then
pos=pos-1
elseif mid(str,pos-1,2)=VBcrlf then
pos=pos-2
else
isBlankChar=false
end if
wend
rtrimVBcrlf=rtrim(left(str,pos))
end function



26.测试用:显示服务器信息

Sub showServer
Dim name
Response.write "<Table border=1 bordercolor=lightblue CELLSPACING=0>"
for each name in request.servervariables
Response.write "<tr>"
Response.write "<td>"&name&"</td>"
Response.write "<td>"&request.servervariables(name)&"<br></td>"
Response.write "</tr>"
next
Response.write "</table>"
End Sub



27.测试用:显示Rs结果集以及字段名称

Sub showRs(rs)
Dim strTable,whatever
Response.write "<center><table><tr>"
for each whatever in rs.fields
response.write "<td><b>" & whatever.name & "</B></TD>"
next
strTable = "</tr><tr><td>"&rs.GetString(,,"</td><td>","</tr><tr><td>"," ") &"</td></tr></table></center>"
Response.Write(strTable)
End Sub


28.测试用:显示调试错误信息

Sub showError
Dim sErrMsg
sErrMsg=Err.Source&" "&Err.Description
Response.write "<center>"&sErrMsg&"</center>"
Err.clear
End Sub


29.显示文字计数器

Sub showCounter
Dim fs,outfile,filename,count
filename=server.mappath("count.txt")
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.fileExists(filename) Then
Set outfile=fs.openTextFile(filename,1)
count=outfile.readline
count=count+1
Response.write "<center>浏览人次："&count&"<center>"
outfile.close
Set outfile=fs.CreateTextFile(filename)
outfile.writeline(count)
Else
Set outfile=fs.openTextFile(filename,8,TRUE)
count=0
outfile.writeline(count)
END IF
outfile.close
set fs=nothing
End Sub