ASP实用函数库(1)

函数

   <%
  '判断文件名是否合法
  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
  
  '去掉字符串头尾的连续的回车和空格
  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
  
  '判断Email是否有效,返回1表示正确
  Function isEmail(aEmail)
   Dim iLocat,v,iLength,i,checkletter
   If instr(aEmail,"@") = 0 Or instr(aEmail,".") = 0 Then
   isEmail=0
   EXIT FUNCTION
   End If
   iLocat=instr(aEmail,"@")
   If instr(iLocat,aEmail,".")=0 Or instr(iLocat+1,aEmail,"@")>0 Then
   isEmail=0
   EXIT FUNCTION
   End If
   If left(aEmail,1)="." Or right(aEmail,1)="." Or left(aEmail,1)="@" Or right(aEmail,1)="@" Then
   isEmail=0
   EXIT FUNCTION
   End If
   v="1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_-.@"
   iLength=len(aEmail)
   For i=1 To iLength
   checkletter=mid(aEmail,i,1)
   If instr(v,checkletter)=0 Then
   isEmail=0
   EXIT FUNCTION
   End If
   Next
   isEmail=1
  End Function
  
  '测试用:显示服务器信息
  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
  
  '测试用:显示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
  
  '用HTML格式显示文本
  function HTMLEncode(fString)
  if not isnull(fString) then
   fString = replace(fString, ">", ">")
   fString = replace(fString, "<", "<")
  
   fString = Replace(fString, CHR(32), " ")
   fString = Replace(fString, CHR(34), """)
   fString = Replace(fString, CHR(39), "'")
   fString = Replace(fString, CHR(13), "")
   fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
   fString = Replace(fString, CHR(10), "<BR> ")
   HTMLEncode = fString
  end if
  end function
  
  '测试用:显示调试错误信息
  Sub showError
   Dim sErrMsg
   sErrMsg=Err.Source&" "&Err.Description
   Response.write "<center>"&sErrMsg&"</center>"
   Err.clear
  End Sub
  
  '显示文字计数器
  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
  %>