ASP实用函数库

2022-07-15 80酷酷网 80kuku.com

<%
'判断文件名是否合法
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)&"
</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), "
")
    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
%>