對於用asp開發網站的朋友可以藉鏡下他的asp函數，方便學習與提高開發效率複製程式碼如下:
<%
'────────────────────────────────────────
'天楓ASP class v1.0，集常用asp函數於一體
'天楓版權所有
'QQ:76994859 EMAIL:[email protected]
'所有函數函數名稱如下：
' StrLength(str) 取得字串長度
' CutStr(str,strlen) 字串長度切割
' CheckIsEmpty(tstr) 偵測是否為空
' isInteger(para) 整數檢驗
' CheckName(str) 名字字元校驗
' CheckPassword(str) 密碼檢驗
' CheckEmail(email) 信箱格式檢驗
' Alert(msg,goUrl) 彈出對話框提示
' GoBack(Str1,Str2,isback) 出錯訊息提示
' Suc(str1,str2,url) 操作成功訊息提示
' ChkPost() 偵測是否站外提交表單
' PSql() 防止sql注入
' FiltrateHtmlCode(Str) 防止產生HTML
' HtmlCode(str) 過濾HTML
' Replacehtml(tstr) 清濾HTML
' GetIP() 取得客戶端IP
' GetBrowser 取得用戶端瀏覽器信
' GetSystem 取得客戶端作業系統
' GetUrl() 取得目前頁面URL包含參數
' CUrl() 取得目前頁面URL
' GetExtend 取得檔案副檔名
' CheckExist(table,fieldname,fieldcontent,isblur) 偵測某個表格中某個欄位的內容是否存在
' GetNum(table,fieldname,resulttype,args) 偵測某個表格某個欄位有多少條，最大值，最小值等
' GetFolderSize(Folderpath) 計算某個資料夾的大小
' GetFileSize(Filename) 計算某個檔案的大小
' IsObjInstalled(strClassString) 偵測元件是否已安裝
' SendMail JMAIL發送郵件
' ResponseCookies 寫入cookies
' CleanCookies 清除cookies
' GetTimeover 取得程式頁面執行時間
' FormatSize 大小格式化
' FormatTime 時間格式化
' Zodiac 取得生肖
' Constellation 取得星座
'────────────────────────────────────────
Class Cls_fun
'－－－－－－－－字元處理－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－」
'************************************************* ***
'函數名稱：StrLength
'作用：取得字串長度（漢字為2)
'參數：str ----字串內容
'傳回值：字串長度
'************************************************* ***
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
'************************************************* ***
'函數名稱：CutStr
'作用：字串長度切割，超過顯示省略號
'參數：str ----字串內容
' strlen ------要顯示的長度
'傳回值：切割後字串內容
'************************************************* ***
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
'－－－－－－－－－－－－－－系列驗證－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－」都是
'************************************************* ***
'函式名稱：CheckIsEmpty
'作用：檢查是否為空
'參數：tstr ----字串
'傳回值：true不為空，false為空
'************************************************* ***
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
'************************************************* ***
'函數名稱：isInteger
'作用：整數檢驗
'參數：tstr ----字符
'傳回值：true是整數，false不是整數
'************************************************* ***
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
'************************************************* ***
'函數名稱：CheckName
'作用：名字字元檢驗
'參數：str ----字串
'傳回值：true無誤，false有誤
'************************************************* ***
Public Function CheckName(Str)
Checkname=true
Dim Rep,pass
Set Rep=New RegExp
Rep.Global=True
Rep.IgnoreCase=True
'匹配字母、數字、底線、漢字且必須以字母或底線或漢字開始
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
'************************************************* ***
'函數名：CheckPassword
'作用：密碼檢驗
'參數：str ----字串
'傳回值：true無誤，false有誤
'************************************************* ***
Public Function CheckPassword(Str)
Dim pass
CheckPassword=true
If Str <> Then
Dim Rep
Set Rep = New RegExp
Rep.Global = True
Rep.IgnoreCase = True
'匹配字母、數字、底線、點號
Rep.Pattern=[a-zA-Z0-9_/.]+$
Pass=rep.Test(Str)
Set Rep=nothing
If not Pass Then CheckPassword=false
End If
End Function
'************************************************* ***
'函數名稱：CheckEmail
'作用：郵箱格式偵測
'參數：str ----Email位址
'傳回值：true無誤，false有誤
'************************************************* ***
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
'──────────────訊息提示────────────────────────────────
'************************************************* ***
'函數名稱：Alert
'作用：彈出對話框提示
'參數：msg ----對話框訊息
' gourl ----提示後轉向哪裡
'傳回值：無
'************************************************* ***
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
'************************************************* ***
'函數名稱：GoBack
'作用：錯誤訊息提示
'參數：str1 ----訊息提示標題
' str2 ----訊息提示內容
' isback ----是否顯示返回
'傳回值：無
'************************************************* ***
Public Function GoBack(Str1,Str2,isback)
If Str1= Then Str1=錯誤訊息
If Str2= Then Str2=請填寫完整必填項目
If isback= Then
Str2=Str2& <a href=javascript:history.go(-1)>回傳重填</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
'************************************************* ***
'函數名稱：Suc
'作用：成功提示訊息
'參數：str1 ----訊息提示標題
' str2 ----訊息提示內容
' url ----返回地址
'傳回值：無
'************************************************* ***
Public Function Suc(str1,str2,url)
If str1= Then Str1=操作成功
If str2= Then Str2=成功的完成這次操作！
If url= Then url=javascript:history.go(-1)
str2=str2& <a href=&url& >返回繼續管理</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
'－－－－－－－－－－－－－－安全處理－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－」。
'************************************************* ***
'函數名稱：ChkPost
'作用：禁止站外提交表單
'傳回值：true站內提交，flase站外提交
'************************************************* ***
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
'************************************************* ***
'函數名稱：PSql
'作用：防止SQL注入
'傳回值：為空則無注入，不為空則注入並傳回注入的字元
'************************************************* ***
public Function PSql()
Psql=
badwords= '防''防;防and防exec防insert防select防update防delete防count防*防%防chr防mid防master防truncate防char防declare防|
badword=split(badwords,防)
If Request.Form<> Then
為 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
'************************************************* ***
'函數名稱：FiltrateHtmlCode
'作用：防止產生html程式碼
'參數：str ----字串
'************************************************* ***
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
'************************************************* ***
'函數名稱：HtmlCode
'作用：過濾Html標籤
'參數：str ----字串
'************************************************* ***
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
'************************************************* ***
'函數名稱：Replacehtml
'作用：清理html
'參數：tstr ----字串
'************************************************* ***
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
'────────────────獲取客戶端與服務端的一些資訊──────────────────────
'************************************************* ***
'函數名稱：GetIP
'作用：取得客戶端IP位址
'傳回值：客戶端IP位址
'************************************************* ***
Public Function GetIP()
Dim Temp
Temp = Request.ServerVariables(HTTP_X_FORWARDED_FOR)
If Temp = or isnull(Temp) 或 isEmpty(Temp) Then Temp = Request.ServerVariables(REMOTE_ADDR)
If Instr(Temp,')>0 Then Temp=0.0.0.0
GetIP = Temp
End Function
'************************************************* ***
'函數名稱：GetBrowser
'作用：獲取客戶端瀏覽器信息
'傳回值：客戶端瀏覽器訊息
'************************************************* ***
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=其它
end if
End Function
'************************************************* ***
'函數名稱：GetSystem
'作用：取得客戶端作業系統
'傳回值：客戶端作業系統
'************************************************* ***
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
elseif instr(thesoft,Mac) then
system=Mac
else
system=其它
end if
End Function
'************************************************* ***
'函數名稱：GetUrl
'作用：取得url包含參數
'傳回值：取得url包含參數
'************************************************* ***
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
'************************************************* ***
'函數名稱：CUrl
'作用：取得目前頁面URL的函數
'傳回值：目前頁面URL的函數
'************************************************* ***
Function CUrl()
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
'************************************************* ***
'函數名稱：GetExtend
'作用：取得檔案副檔名
'參數：filename ----檔名
'************************************************* ***
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
'－－－－－－－－－－－－－－－－－－資料庫的運作－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－」。
'************************************************* ***
'函數名稱：CheckExist
'作用：偵測某個表格中某個欄位是否存在某個內容
'參數：table ----表名
' fieldname ----字段名
' fieldcontent ----字段內容
' isblur ----是否模糊匹配
'傳回值：false不存在，true存在
'************************************************* ***
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
'************************************************* ***
'函數名稱：GetNum
'作用：偵測某個表格某個欄位的數量或最大值或最小值
'參數：table ----表名
' fieldname ----字段名
' resulttype ----還回結果(count/max/min)
' args ----附加參加(order by ...)
'傳回值：數值
'************************************************* ***
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
'************************************************* ***
'函數名稱：UpdateValue
'作用：更新表格中某欄位某內容的值
'參數：table ----表名
' fieldname ----字段名
' fieldvalue ----更新後的值
' id ----id
' url -------更新後轉向地址
'傳回值：無
'************************************************* ***
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
'－－－－－－－－－－－－－－服務端訊息與操作－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－」。
'************************************************* ***
'函數名稱：GetFolderSize
'作用：計算某個資料夾的大小
'參數：FileName ----資料夾路徑及資料夾名稱
'傳回值：數值
'************************************************* ***
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&資料夾不存在
End If
End Function
'************************************************* ***
'函數名稱：GetFileSize
'作用：計算某個檔案的大小
'參數：FileName ----檔案路徑及檔案名稱
'傳回值：數值
'************************************************* ***
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&檔案不存在
End If
set fso=nothing
End Function
'************************************************* ***
'函式名稱：IsObjInstalled
'作用：檢查組件是否安裝
'參數：strClassString ----元件名稱
'傳回值：false不存在，true存在
'************************************************* ***
Public Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled=False
Err=0
Dim xTestObj
Set xTestObj=Server.CreateObject(strClassString)
If 0=Err Then IsObjInstalled=True
Set xTestObj=Nothing
Err=0
End Function
'************************************************* ***
'函數名稱：SendMail
'作用：用Jmail組件發送郵件
'參數：ServerAddress ----伺服器位址
' AddRecipient ----收信人地址
' Subject ----主題
' Body ----信件內容
' Sender ----發信人地址
'************************************************* ***
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元件
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
'************************************************* ***
'函式名稱：ResponseCookies
'作用：寫入COOKIES
'參數：Key ----cookie名
' value ----cookie值
' expires ---- cookie過期時間
'************************************************* ***
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
'************************************************* ***
'函式名稱：CleanCookies
'作用：清除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
'************************************************* ***
'函數名稱：GetTimeOver
'作用：清除COOKIES
'參數：flag ---顯示時間單位1=秒，否則毫秒
'************************************************* ***
Public Function GetTimeOver(flag)
Dim EndTime
If flag = 1 Then
EndTime=FormatNumber(Timer() - StartTime, 6, true)
getTimeOver = 本頁執行時間: & EndTime & 秒
Else
EndTime=FormatNumber((Timer() - StartTime) * 1000, 3, true)
getTimeOver = 本頁執行時間: & EndTime & 毫秒
End If
End function
'－－－－－－－－－－－－－－－－－－影集格式化－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－」
'************************************************* ***
'函數名稱：FormatSize
'作用：大小格式化
'參數：size ----要格式化的大小
'************************************************* ***
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
'************************************************* ***
'函數名稱：FormatTime
'作用：時間格式化
'參數：DateTime ----要格式化的時間
' Format ----格式的形式
'************************************************* ***
Public Function FormatTime(DateTime,Format)
select case Format
case 1
FormatTime=&year(DateTime)&年&month(DateTime)&月&day(DateTime)&日
case 2
FormatTime=&month(DateTime)&月&day(DateTime)&日
case 3
FormatTime=&year(DateTime)&/&month(DateTime)&/&day(DateTime)&
case 4
FormatTime=&month(DateTime)&/&day(DateTime)&
case 5
FormatTime=&month(DateTime)&月&day(DateTime)&日&FormatDateTime(DateTime,4)&
case 6
temp=週日,週一,週二,週三,週四,週五,週六
temp=split(temp,,)
FormatTime=temp(Weekday(DateTime)-1)
case Else
FormatTime=DateTime
end select
End Function
'──────────────────────雜項────────────────────────
'************************************************* ***
'函數名稱：Zodiac
'作用：取得生消
'參數：birthday ----生日
'************************************************* ***
public Function Zodiac(birthday)
if IsDate(birthday) then
birthyear=year(birthday)
ZodiacList=array(猴,雞,狗,豬,鼠,牛,虎,兔,龍,蛇,馬,羊)
Zodiac=ZodiacList(birthyear mod 12)
end if
End Function
'************************************************* ***
'函數名稱：Constellation
'作用：取得星座
'參數：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
'==================================================
'函數名稱：autopage
'作用：長文章自動分頁
'參數：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>頁碼:</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&非法操作！頁號超出！ <a href=javascript:history.back(-1)><u>回傳</u></a>
end if
Else
AutoPage=content
end if
End Function
End Class
%>