ASP functional Library (1)

function <%


' Determines whether the filename 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


  


' removes successive carriage returns and spaces
the string and tail

function Trimvbcrlf (str)


TRIMVBCRLF=RTRIMVBCRLF (Ltrimvbcrlf (str))


End Function


  


' removes successive carriage returns and spaces at the beginning of the 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


  


' removes successive carriage returns and spaces 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


  


' to determine whether the email is valid, return 1 to indicate 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


  


' Test: 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


  


' Test: Display 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><tr><td>" &rs. GetString (,, "</td><td>", "</tr><tr><td>", "") & "</td></tr></ Table></center> "


Response.Write (strtable)


End Sub


  


' displays text in HTML format


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 (a) & CHR (a), "</P><P>")


fstring = Replace (fstring, CHR (a), "<BR>")


HTMLEncode = fstring


End If


End Function


  


' Test: Display debug error message


Sub ShowError


Dim serrmsg


serrmsg=err.source& "" &err.description


Response.Write "<center>" &sErrMsg& "</center>"


Err.Clear


End Sub





' Display text counter


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> Visitors:" &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


%>