ASP应用中的应用函数2

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) & "
" & 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&"
"  

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 "

"&name&"

"&request.servervariables(name)&"

" 

End Sub 
 

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

Sub showRs(rs) 

Dim strTable,whatever 

Response.write "

" & whatever.name & "
"&rs.GetString(,,"	","
"," ") &"

" 

Response.Write(strTable) 

End Sub 

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

Sub showError 

Dim sErrMsg 

sErrMsg=Err.Source&" "&Err.Description 

Response.write "
"&sErrMsg&"" 

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 "
浏览人次："&count&"" 

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