Source code of ASP utility Library (1)

<%

'Determine whether the file name is legal
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

'Remove the consecutive carriage return and space at the beginning and end of the string.
Function trimvbcrlf (STR)
Trimvbcrlf = rtrimvbcrlf (ltrimvbcrlf (STR ))
End Function

'Remove the consecutive carriage returns and spaces starting with a string.
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

'Remove the consecutive carriage return and space at the end of the string.
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

'Check whether the email is valid. The returned value is 1, indicating that the email is correct.
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

'Testing purpose: Display Server Information
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

'Testing purpose: display the RS result set and field name
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> <TD>" & RS. getstring (, "</TD> <TD>", "</tr> <TD> ","") & "</TD> </tr> </table> </center>"
Response. Write (strtable)
End sub

'Display text in HTML Format
Function txt2html (STR)
If isnull (STR) then
Txt2html = ""
Exit Function
End if
STR = Replace (STR, CHR (34), "& quot ;")
STR = Replace (STR, "<", "& lt ")
STR = Replace (STR, ">", "& gt ")
STR = Replace (STR, CHR (13) + CHR (10), "<br> ")
STR = Replace (STR, CHR (9), "& nbsp ;")
STR = Replace (STR, "", "& nbsp ;")
Txt2html = Str
End Function

'Testing purpose: Display debugging error information
Sub showerror
Dim serrmsg
Serrmsg = err. Source & "& err. Description
Response. Write "<center>" & serrmsg & "</center>"
Err. Clear
End sub

'Display text counters
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> views:" & 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
%>