Friends who use ASP to develop websites can learn from his ASP functions to facilitate learning and improve development efficiency . Copy the code as follows:
<%
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'Tianfeng ASP class v1.0, integrating common asp functions into one
'Tianfeng All Rights Reserved
'QQ:76994859 EMAIL:[email protected]
'All function names are as follows:
' StrLength(str) gets the string length
' CutStr(str,strlen) string length cutting
' CheckIsEmpty(tstr) checks whether it is empty
' isInteger(para) integer test
' CheckName(str) name character check
' CheckPassword(str) password check
' CheckEmail(email) Email format check
'Alert(msg,goUrl) pops up a dialog box prompt
' GoBack(Str1,Str2,isback) error message
' Suc(str1,str2,url) operation success message prompt
' ChkPost() detects whether the form is submitted outside the site
' PSql() prevents sql injection
' FiltrateHtmlCode(Str) prevents HTML from being generated
' HtmlCode(str) filter HTML
'Replacehtml(tstr) Clean HTML
'GetIP() Get the client IP
'GetBrowser Gets the client browser information
' GetSystem gets the client operating system
'GetUrl() Gets the current page URL including parameters
'CUrl() Get the current page URL
' GetExtend gets the file extension
' CheckExist(table,fieldname,fieldcontent,isblur) checks whether the content of a field in a table exists
' GetNum(table,fieldname,resulttype,args) detects how many fields there are in a table, maximum value, minimum value, etc.
' GetFolderSize(Folderpath) calculates the size of a folder
' GetFileSize(Filename) calculates the size of a file
' IsObjInstalled(strClassString) detects whether the component is installed
'SendMail JMAILSend mail
'ResponseCookies write cookies
' CleanCookies Clear cookies
' GetTimeover gets the program page execution time
'FormatSize size formatting
'FormatTime time formatting
' Zodiac gets the zodiac sign
' Constellation gets the constellation
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Class Cls_fun
'－－－－－－－－Character processing－－－－－－－－－－－－－－－－－－－－－－－－－
'************************************************ ***
'Function name: StrLength
'Function: Get the length of the string (Chinese characters are 2)
'Parameter: str ---- string content
'Return value: string length
'************************************************ ***
Public function StrLength(str)
Dim Rep,lens,i
Set rep=new regexp
rep.Global=true
rep.IgnoreCase=true
rep.Pattern=[/u4E00-/u9FA5/uF900-/uFA2D]
For each i in rep.Execute(str)
lens=lens+1
Next
Set Rep=Nothing
lens=lens + len(str)
strLength=lens
End Function
'************************************************ ***
'Function name: CutStr
'Function: Cut the string length, and display ellipses if it exceeds the length
'Parameter: str ---- string content
' strlen ------The length to be displayed
'Return value: string content after cutting
'************************************************ ***
Public Function CutStr(str,strlen)
Dim l,t,i,c
If str= Then
cutstr=
Exit Function
End If
str=Replace(Replace(Replace(Replace(Replace(str, , ),,Chr(34)),>,>),<,<),|,|)
l=Len(str)
t=0
For i=1 To l
c=Abs(Asc(Mid(str,i,1)))
If c>255 Then
t=t+2
Else
t=t+1
End If
If t>=strlen Then
cutstr=Left(str,i) & ...
Exit For
Else
cutstr=str
End If
Next
cutstr=Replace(Replace(Replace(Replace(replace(cutstr, , ),Chr(34),),>,>),<,<),|,|)
End Function
'－－－－－－－－－－－－－－Series verification－－－－－－－－－－－－－－－－－－－－－－－－－－－
'************************************************ ***
'Function name: CheckIsEmpty
'Function: Check whether it is empty
'Parameter: tstr ---- string
'Return value: true is not empty, false is empty
'************************************************ ***
Public Function CheckIsEmpty(tstr)
CheckIsEmpty=false
If IsNull(tstr) or Tstr= Then Exit Function
Dim Str,re
Str=Tstr
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
str= Replace(str, vbNewLine, )
str = Replace(str, Chr(9), )
str = Replace(str, , )
str = Replace(str, , )
re.Pattern=<img(.[^>]*)>
str =re.Replace(Str,94kk)
re.Pattern=<(.[^>]*)>
Str=re.Replace(Str,)
Set Re=Nothing
If Str<> Then CheckIsEmpty=true
End Function
'************************************************ ***
'Function name: isInteger
'Function: Integer test
'Parameter: tstr ---- character
'Return value: true is an integer, false is not an integer
'************************************************ ***
Public function isInteger(para)
on error resume Next
Dim str
Dim l,i
If isNUll(para) then
isInteger=false
exit function
End if
str=cstr(para)
If trim(str)= then
isInteger=false
exit function
End if
l=len(str)
For i=1 to l
If mid(str,i,1)>9 or mid(str,i,1)<0 then
isInteger=false
exit function
End if
Next
isInteger=true
If err.number<>0 then err.clear
End Function
'************************************************ ***
'Function name: CheckName
'Function: Name character check
'Parameter: str ---- string
'Return value: true is correct, false is incorrect
'************************************************ ***
Public Function CheckName(Str)
Checkname=true
Dim Rep,pass
Set Rep=New RegExp
Rep.Global=True
Rep.IgnoreCase=True
'Match letters, numbers, underscores, Chinese characters and must start with letters or underscores or Chinese characters
Rep.Pattern=^[a-zA-Z_u4e00-/u9fa5][/w/u4e00-/u9fa5]+$
Set pass=Rep.Execute(Str)
If pass.count=0 Then CheckName=false
Set Rep=Nothing
End Function
'************************************************ ***
'Function name: CheckPassword
'Function: Password verification
'Parameter: str ---- string
'Return value: true is correct, false is incorrect
'************************************************ ***
Public Function CheckPassword(Str)
Dim pass
CheckPassword=true
If Str <> Then
Dim Rep
Set Rep = New RegExp
Rep.Global = True
Rep.IgnoreCase = True
'Match letters, numbers, underscores, periods
Rep.Pattern=[a-zA-Z0-9_/.]+$
Pass=rep.Test(Str)
Set Rep=nothing
If not Pass Then CheckPassword=false
End If
End Function
'************************************************ ***
'Function name: CheckEmail
'Function: Email format detection
'Parameter: str ----Email address
'Return value: true is correct, false is incorrect
'************************************************ ***
Public function CheckEmail(email)
CheckEmail=true
Dim Rep
Set Rep = new RegExp
rep.pattern=([/.a-zA-Z0-9_-]){2,10}@([a-zA-Z0-9_-]){2,10}(/.([a-zA- Z0-9]){2,}){1,4}$
pass=rep.Test(email)
Set Rep=Nothing
If not pass Then CheckEmail=false
End function
'－－－－－－－－－－－－－－Information prompt－－－－－－－－－－－－－－－－－－－－－－－－－－－
'************************************************ ***
'Function name: Alert
'Function: Pop up a dialog box prompt
'Parameter: msg ---- dialog box information
' gourl ---- where to turn after prompt
'Return value: None
'************************************************ ***
Public Function Alert(msg,goUrl)
msg = replace(msg,',/')
If goUrl= Then
goUrl=history.go(-1);
Else
goUrl=window.location.href='&goUrl&'
End IF
Response.Write (<script language=JavaScript type=text/javascript>&vbNewLine&alert(' & msg & ');&goUrl&vbNewLine&</script>)
Response.End
End Function
'************************************************ ***
'Function name: GoBack
'Function: error message prompt
'Parameter: str1 ---- information prompt title
' str2 ---- information prompt content
'isback----Whether to display return
'Return value: None
'************************************************ ***
Public Function GoBack(Str1,Str2,isback)
If Str1= Then Str1=Error message
If Str2= Then Str2=Please fill in all required fields
If isback= Then
Str2=Str2& <a href=javascript:history.go(-1)>Return to refill</a></li>
else
Str2=Str2
end if
Response.Write<div style=margin-left:5px;border:1px solid #0066cc;width:98%><div style=height:22px;font-weight:bold;color: white;font-size:14px;background:#799AE1;background:url(images/th.gif);;text-align:left;line-height:20px;padding:3px;>&Str1& </div><div style=line-height:50px;background:#F7F7F7;vertical-align:middle;font-size:14px;width:100%><div style=color:red;font:50px/50px 宋体;float:left;width :5%>×</div><div style=margin-top:8px;float:right;width:90%;text-align:left;padding-left:3px;>&str2&</div></div></div>
response.end
End Function
'************************************************ ***
'Function name: Suc
'Function: success prompt message
'Parameter: str1 ---- information prompt title
' str2 ---- information prompt content
' url ---- return address
'Return value: None
'************************************************ ***
Public Function Suc(str1,str2,url)
If str1= Then Str1=Operation successful
If str2= Then Str2=This operation was successfully completed!
If url= Then url=javascript:history.go(-1)
str2=str2& <a href=&url& >Return to continue management</a>
Response.Write<div style=margin-left:5px;border:1px solid #0066cc;width:98%><div style=height:22px;font-weight:bold;color: white;font-size:14px;background:#799AE1;background:url(images/th.gif);;text-align:left;line-height:20px;padding:3px;>&Str1& </div><div style=line-height:50px;background:#F7F7F7;vertical-align:middle;font-size:14px;width:100%><div style=color:red;font:50px/50px 宋体;float:left;width :5%>√</div><div style=margin-top:8px;float:right;width:90%;text-align:left;padding-left:3px;>&str2&</div></div></div>
End Function
'－－－－－－－－－－－－－－Safe handling－－－－－－－－－－－－－－－－－－－－－－－－－－－
'************************************************ ***
'Function name: ChkPost
'Function: prohibit form submission outside the site
'Return value: true for on-site submission, false for off-site submission
'************************************************ ***
Public Function ChkPost()
Dim url1,url2
chkpost=true
url1=Cstr(Request.ServerVariables(HTTP_REFERER))
url2=Cstr(Request.ServerVariables(SERVER_NAME))
If Mid(url1,8,Len(url2))<>url2 Then
chkpost=false
exit function
End If
End function
'************************************************ ***
'Function name: PSql
'Function: Prevent SQL injection
'Return value: If it is empty, there will be no injection. If it is not empty, it will be injected and the injected character will be returned.
'************************************************ ***
public Function PSql()
Psql=
badwords= 'anti' anti; anti and anti exec anti insert anti select anti update anti delete anti count anti * anti % anti chr anti mid anti master anti truncate anti char anti declare anti |
badword=split(badwords,defense)
If Request.Form<> Then
For Each TF_Post In Request.Form
For i=0 To Ubound(badword)
If Instr(LCase(Request.Form(TF_Post)),badword(i))>0 Then
Psql=badword(i)
exit function
End If
Next
Next
End If
If Request.QueryString<> Then
For Each TF_Get In Request.QueryString
For i=0 To Ubound(badword)
If Instr(LCase(Request.QueryString(TF_Get)),badword(i))>0 Then
Psql=badword(i)
exit function
End If
Next
Next
End If
End Function
'************************************************ ***
'Function name: FiltrateHtmlCode
'Function: prevent html code from being generated
'Parameter: str ---- string
'************************************************ ***
Public Function FiltrateHtmlCode(Str)
If Not isnull(str) And str<> then
Str=Replace(Str,Chr(9),)
Str=replace(Str,|,|)
Str=replace(Str,chr(39),')
Str=replace(Str,<,<)
Str=replace(Str,>,>)
Str = Replace(str, CHR(13),)
Str = Replace(str, CHR(10),)
FiltrateHtmlCode=Str
End If
End Function
'************************************************ ***
'Function name: HtmlCode
'Function: filter Html tags
'Parameter: str ---- string
'************************************************ ***
Public function HtmlCode(str)
If Not isnull(str) And str<> then
str = replace(str, >, >)
str = replace(str, <, <)
str = Replace(str, CHR(32), )
str = Replace(str, CHR(9), )
str = Replace(str, CHR(34), )
str = Replace(str, CHR(39), ')
str = Replace(str, CHR(13), )
str = Replace(str, CHR(10), )
str = Replace(str, script, script)
HtmlCode = str
End If
End Function
'************************************************ ***
'Function name: Replacehtml
'Function: clean html
'Parameter: tstr ---- string
'************************************************ ***
Public Function Replacehtml(tstr)
Dim Str,re
Str=Tstr
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern=<(p|//p|br)>
Str=re.Replace(Str,vbNewLine)
re.Pattern=<img.[^>]*src(=| )(.[^>]*)>
str=re.replace(str,[img]$2[/img])
re.Pattern=<(.[^>]*)>
Str=re.Replace(Str,)
Set Re=Nothing
Replacehtml=Str
End Function
'------------Get some information about the client and server------------------
'************************************************ ***
'Function name: GetIP
'Function: Get the client IP address
'Return value: client IP address
'************************************************ ***
Public Function GetIP()
Dim Temp
Temp = Request.ServerVariables(HTTP_X_FORWARDED_FOR)
If Temp = or isnull(Temp) or isEmpty(Temp) Then Temp = Request.ServerVariables(REMOTE_ADDR)
If Instr(Temp,')>0 Then Temp=0.0.0.0
GetIP=Temp
End Function
'************************************************ ***
'Function name: GetBrowser
'Function: Get client browser information
'Return value: client browser information
'************************************************ ***
Public Function GetBrowser()
info=Request.ServerVariables(HTTP_USER_AGENT)
if Instr(info,NetCaptor 6.5.0)>0 then
browser=NetCaptor 6.5.0
elseif Instr(info,MyIe 3.1)>0 then
browser=MyIe 3.1
elseif Instr(info,NetCaptor 6.5.0RC1)>0 then
browser=NetCaptor 6.5.0RC1
elseif Instr(info,NetCaptor 6.5.PB1)>0 then
browser=NetCaptor 6.5.PB1
elseif Instr(info,MSIE 5.5)>0 then
browser=Internet Explorer 5.5
elseif Instr(info,MSIE 6.0)>0 then
browser=Internet Explorer 6.0
elseif Instr(info,MSIE 6.0b)>0 then
browser=Internet Explorer 6.0b
elseif Instr(info,MSIE 5.01)>0 then
browser=Internet Explorer 5.01
elseif Instr(info,MSIE 5.0)>0 then
browser=Internet Explorer 5.00
elseif Instr(info,MSIE 4.0)>0 then
browser=Internet Explorer 4.01
else
browser=other
end if
End Function
'************************************************ ***
'Function name: GetSystem
'Function: Get the client operating system
'Return value: client operating system
'************************************************ ***
Function GetSystem()
info=Request.ServerVariables(HTTP_USER_AGENT)
if Instr(info,NT 5.1)>0 then
system=Windows XP
elseif Instr(info,Tel)>0 then
system=Telport
elseif Instr(info,webzip)>0 then
system=webzip
elseif Instr(info,flashget)>0 then
system=flashget
elseif Instr(info,offline)>0 then
system=offline
elseif Instr(info,NT 5)>0 then
system=Windows 2000
elseif Instr(info,NT 4)>0 then
system=Windows NT4
elseif Instr(info,98)>0 then
system=Windows 98
elseif Instr(info,95)>0 then
system=Windows 95
elseif instr(info,unix) or instr(info,linux) or instr(info,SunOS) or instr(info,BSD) then
system=Unix-like
elseif instr(thesoft,Mac) then
system=Mac
else
system=other
end if
End Function
'************************************************ ***
'Function name: GetUrl
'Function: Get the url including parameters
'Return value: Get the url including parameters
'************************************************ ***
Public Function GetUrl()
Dim strTemp
strTemp=Request.ServerVariables(Script_Name)
If Trim(Request.QueryString)<> Then
strTemp=strTemp&?
For Each M_item In Request.QueryString
strTemp=strTemp&M_item&=&Server.UrlEncode(Trim(Request.QueryString(&M_item&)))
next
end if
GetUrl=strTemp
End Function
'************************************************ ***
'Function name: CUrl
'Function: function to obtain the URL of the current page
'Return value: function of the current page URL
'************************************************ ***
FunctionCUrl()
Domain_Name = LCase(Request.ServerVariables(Server_Name))
Page_Name = LCase(Request.ServerVariables(Script_Name))
Quary_Name = LCase(Request.ServerVariables(Quary_String))
If Quary_Name = Then
CUrl = http://&Domain_Name&Page_Name
Else
CUrl = http://&Domain_Name&Page_Name&?&Quary_Name
End If
End Function
'************************************************ ***
'Function name: GetExtend
'Function: Get the file extension
'Parameter: filename ---- file name
'************************************************ ***
Public Function GetExtend(filename)
dim tmp
if filename<> then
tmp=mid(filename,instrrev(filename,.)+1,len(filename)-instrrev(filename,.))
tmp=LCase(tmp)
if instr(1,tmp,asp)>0 or instr(1,tmp,php)>0 or instr(1,tmp,php3)>0 or instr(1,tmp,aspx)>0 then
getextend=txt
else
getextend=tmp
end if
else
getextend=
end if
End Function
'－－－－－－－－－－－－－－－－－－Database operation－－－－－－－－－－－－－－－－－－－－－－
'************************************************ ***
'Function name: CheckExist
'Function: Detect whether a certain content exists in a certain field in a certain table
'Parameter: table ---- table name
'fieldname ----field name
'fieldcontent ----Field content
' isblur ---- whether to fuzzy match
'Return value: false does not exist, true exists
'************************************************ ***
Function CheckExist(table,fieldname,fieldcontent,isblur)
CheckExist=false
If isblur=1 Then
set rsCheckExist=conn.execute(select * from &table& where &fieldname& like '%&fieldcontent&%')
else
set rsCheckExist=conn.execute(select * from &table& where &fieldname&= '&fieldcontent&')
End if
if not (rsCheckExist.eof and rsCheckExist.bof) then CheckExist=true
rsCheckExist.close
set rsCheckExist=nothing
End Function
'************************************************ ***
'Function name: GetNum
'Function: Detect the number, maximum or minimum value of a field in a table
'Parameter: table ---- table name
'fieldname ----field name
'resulttype ----Return results (count/max/min)
' args ---- additional participation (order by ...)
'Return value: numerical value
'************************************************ ***
Function GetNum(table,fieldname,resulttype,args)
GetFieldContentNum=0
if fieldname= then fieldname=*
sqlGetFieldContentNum=select &resulttype&(&fieldname&) from &table& args
set rsGetFieldContentNum=conn.execute(sqlGetFieldContentNum)
if not (rsGetFieldContentNum.eof and rsGetFieldContentNum.bof) then GetFieldContentNum=rsGetFieldContentNum(0)
rsGetFieldContentNum.close
set rsGetFieldContentNum=nothing
End Function
'************************************************ ***
'Function name: UpdateValue
'Function: Update the value of a certain field in the table
'Parameter: table ---- table name
'fieldname ----field name
'fieldvalue----updated value
'id ----id
' url -------redirected address after update
'Return value: None
'************************************************ ***
Public Function UpdateValue(table,fieldname,fieldvalue,id,url)
conn.Execute(update &table& set &fieldname&=&fieldvalue& where id=&CLng(trim(id)))
if url<> then response.redirect url
End Function
'－－－－－－－－－－－－－Server information and operations－－－－－－－－－－－－－－－－－－－－－
'************************************************ ***
'Function name: GetFolderSize
'Function: Calculate the size of a folder
'Parameters: FileName ----Folder path and folder name
'Return value: numerical value
'************************************************ ***
Public Function GetFolderSize(Folderpath)
dim fso,d,size,showsize
set fso=server.createobject(scripting.filesystemobject)
drvpath=server.mappath(Folderpath)
if fso.FolderExists(drvpath) Then
set d=fso.getfolder(drvpath)
size=d.size
GetFolderSize=FormatSize(size)
Else
GetFolderSize=Folderpath&Folder does not exist
End If
End Function
'************************************************ ***
'Function name: GetFileSize
'Function: Calculate the size of a file
'Parameter: FileName ----File path and file name
'Return value: numerical value
'************************************************ ***
Public Function GetFileSize(FileName)
Dim fso,drvpath,d,size,showsize
set fso=server.createobject(scripting.filesystemobject)
filepath=server.mappath(FileName)
if fso.FileExists(filepath) then
set d=fso.getfile(filepath)
size=d.size
GetFileSize=FormatSize(size)
Else
GetFileSize=FileName&File does not exist
End If
set fso=nothing
End Function
'************************************************ ***
'Function name: IsObjInstalled
'Function: Check whether the component is installed
'Parameter: strClassString ---- component name
'Return value: false does not exist, true exists
'************************************************ ***
Public Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled=False
Err=0
DimxTestObj
Set xTestObj=Server.CreateObject(strClassString)
If 0=Err Then IsObjInstalled=True
Set xTestObj=Nothing
Err=0
End Function
'************************************************ ***
'Function name: SendMail
'Function: Use Jmail component to send emails
'Parameter: ServerAddress ---- server address
'AddRecipient----recipient address
' Subject ---- subject
'Body----letter content
'Sender ---- sender's address
'************************************************ ***
Public function SendMail(MailServerAddress,AddRecipient,Subject,Body,Sender,MailFrom)
on error resume next
Dim JMail
Set JMail=Server.CreateObject(JMail.SMTPMail)
if err then
SendMail= JMail component is not installed
err.clear
exit function
end if
JMail.Logging=True
JMail.Charset=gb2312
JMail.ContentType = text/html
JMail.ServerAddress=MailServerAddress
JMail.AddRecipient=AddRecipient
JMail.Subject=Subject
JMail.Body=MailBody
JMail.Sender=Sender
JMail.From = MailFrom
JMail.Priority=1
JMail.Execute
Set JMail=nothing
if err then
SendMail=err.description
err.clear
else
SendMail=OK
end if
end function
'************************************************ ***
'Function name: ResponseCookies
'Function: write COOKIES
'Parameter: Key ---- cookie name
' value ----cookie value
' expires ---- cookie expiration time
'************************************************ ***
Public Function ResponseCookies(Key,Value,Expires)
DomainPath=Left(Request.ServerVariables(script_name),inStrRev(Request.ServerVariables(script_name),/))
Response.Cookies(Key)=&Value&
if Expires<>0 then Response.Cookies(Key).Expires=date+Expires
Response.Cookies(Key).Path=DomainPath
End Function
'************************************************ ***
'Function name: CleanCookies
'Function: Clear COOKIES
'************************************************ ***
Public Function CleanCookies()
DomainPath=Left(Request.ServerVariables(script_name),inStrRev(Request.ServerVariables(script_name),/))
For Each objCookie In Request.Cookies
Response.Cookies(objCookie)=
Response.Cookies(objCookie).Path=DomainPath
Next
End Function
'************************************************ ***
'Function name: GetTimeOver
'Function: Clear COOKIES
'Parameter: flag ---Display time unit 1=seconds, otherwise milliseconds
'************************************************ ***
Public Function GetTimeOver(flag)
DimEndTime
If flag = 1 Then
EndTime=FormatNumber(Timer() - StartTime, 6, true)
getTimeOver = Execution time of this page: & EndTime & seconds
Else
EndTime=FormatNumber((Timer() - StartTime) * 1000, 3, true)
getTimeOver = Execution time of this page: & EndTime & milliseconds
End If
End function
'－－－－－－－－－－－－－－－－－Series formatting－－－－－－－－－－－－－－－－－－－－－－－
'************************************************ ***
'Function name: FormatSize
'Function: size formatting
'Parameter: size ----The size to be formatted
'************************************************ ***
Public Function FormatSize(dsize)
if dsize>=1073741824 then
FormatSize=Formatnumber(dsize/1073741824,2) & GB
elseif dsize>=1048576 then
FormatSize=Formatnumber(dsize/1048576,2) & MB
elseif dsize>=1024 then
FormatSize=Formatnumber(dsize/1024,2) & KB
else
FormatSize=dsize & Byte
end if
End Function
'************************************************ ***
'Function name: FormatTime
'Function: time formatting
'Parameter: DateTime ---- time to be formatted
'Format ----Format form
'************************************************ ***
Public Function FormatTime(DateTime,Format)
select case Format
case 1
FormatTime=&year(DateTime)&year&month(DateTime)&month&day(DateTime)&day
case 2
FormatTime=&month(DateTime)&month&day(DateTime)&日
case 3
FormatTime=&year(DateTime)&/&month(DateTime)&/&day(DateTime)&
case 4
FormatTime=&month(DateTime)&/&day(DateTime)&
case 5
FormatTime=&month(DateTime)&month&day(DateTime)&日&FormatDateTime(DateTime,4)&
case 6
temp=Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday
temp=split(temp,,)
FormatTime=temp(Weekday(DateTime)-1)
case Else
FormatTime=DateTime
end select
End Function
'－－－－－－－－－－－－－－－－－－－－Miscellaneous－－－－－－－－－－－－－－－－－－－－
'************************************************ ***
'Function name: Zodiac
'Function: obtain life and death
'Parameter: birthday ---- birthday
'************************************************ ***
public Function Zodiac(birthday)
if IsDate(birthday) then
birthyear=year(birthday)
ZodiacList=array(monkey, chicken, dog, pig, rat, ox, tiger, rabbit, dragon, snake, horse, sheep)
Zodiac=ZodiacList(birthyear mod 12)
end if
End Function
'************************************************ ***
'Function name: Constellation
'Function: Get the constellation
'Parameter: birthday ---- birthday
'************************************************ ***
public Function Constellation(birthday)
if IsDate(birthday) then
ConstellationMon=month(birthday)
ConstellationDay=day(birthday)
if Len(ConstellationMon)<2 then ConstellationMon=0&ConstellationMon
if Len(ConstellationDay)<2 then ConstellationDay=0&ConstellationDay
MyConstellation=ConstellationMon&ConstellationDay
if MyConstellation < 0120 then
constellation=<img src=images/Constellation/g.gif />elseif MyConstellation < 0219 then
constellation=<img src=images/Constellation/h.gif />elseif MyConstellation < 0321 then
constellation=<img src=images/Constellation/i.gif />elseif MyConstellation < 0420 then
constellation=<img src=images/Constellation/^.gif />elseif MyConstellation < 0521 then
constellation=<img src=images/Constellation/_.gif />elseif MyConstellation < 0622 then
constellation=<img src=images/Constellation/`.gif />elseif MyConstellation < 0723 then
constellation=<img src=images/Constellation/a.gif />elseif MyConstellation < 0823 then
constellation=<img src=images/Constellation/b.gif />elseif MyConstellation < 0923 then
constellation=<img src=images/Constellation/c.gif />elseif MyConstellation < 1024 then
constellation=<img src=images/Constellation/d.gif />elseif MyConstellation < 1122 then
constellation=<img src=images/Constellation/e.gif />elseif MyConstellation < 1222 then
constellation=<img src=images/Constellation/f.gif />elseif MyConstellation > 1221 then
constellation=<img src=images/Constellation/g.gif />end if
end if
End Function
'==================================================
'Function name: autopage
'Function: Automatic pagination of long articles
'Parameters: id, content, urlact
'==================================================
Function AutoPage(content,paramater,pagevar)
contentStr=split(content,pagevar)
pagesize=ubound(contentStr)
if pagesize>0 then
If Int(Request(page))= or Int(Request(page))=0 Then
pageNum=1
Else
pageNum=Request(page)
End if
if pageNum-1<=pagesize then
AutoPage=AutoPage&contentStr(pageNum-1)
AutoPage=AutoPage&<div style=margin-top:10px;text-align:right;padding-right:15px;><font color=blue>Page number:</font><font color=red>
For i=0 to pagesize
if i=pageNum-1 then
AutoPage=AutoPage&[<font color=red>&i+1&</font>]
else
if instr(paramater,?)>0 then
AutoPage=AutoPage&<a href=¶mater&&page=&i+1&>[&(i+1)&]</a>
else
AutoPage=AutoPage&<a href=¶mater&?page=&i+1&>[&(i+1)&]</a>
end if
end if
Next
AutoPage=AutoPage&</font></div>
else
AutoPage=AutoPage&Illegal operation! Page number exceeded! <a href=javascript:history.back(-1)><u>Back</u></a>
end if
Else
AutoPage=content
end if
End Function
End Class
%>