|
<%
' Determine if the file name is legitimate
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 ' Get rid of consecutive carriage returns and spaces at the ends of a string
function Trimvbcrlf (str)
TRIMVBCRLF=RTRIMVBCRLF (Ltrimvbcrlf (str))
End Function ' Remove 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 ' Remove consecutive 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 ' Determines whether an email is valid, and returns 1 for the 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 ' Display 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 (), "<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 ' Show 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
%> |
