ASP實用函數庫源碼

ASP實用函數庫源碼

<%
'判斷檔案名稱是否合法
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 txt2Html(str)
if isnull(str) then
  txt2Html=""
  exit Function
end if
str=Replace(str,chr(34),""")
str=Replace(str,"<","<")
str=Replace(str,">",">")
str=Replace(str,chr(13)+chr(10),"<br>")
str=Replace(str,chr(9),"    ")
str=Replace(str," "," ")
txt2Html=str
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
%>