<% 
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 
'天楓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 
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 

'**************************************************** 
'函數名：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) or 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 
%>