推薦下天楓常用ASP函數(shù)封裝，推薦大家使用
更新時(shí)間：2007年09月08日 22:20:16 作者：
復(fù)制代碼 代碼如下:
<%
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'天楓ASP class v1.0，集常用asp函數(shù)于一體
'天楓版權(quán)所有http://www.52515.net
'QQ:76994859 EMAIL:Chenshaobo@gmail.com
'所有功能函數(shù)名如下：
' StrLength(str) 取得字符串長(zhǎng)度
' CutStr(str,strlen) 字符串長(zhǎng)度切割
' CheckIsEmpty(tstr) 檢測(cè)是否為空
' isInteger(para) 整數(shù)檢驗(yàn)
' CheckName(str) 名字字符校驗(yàn)
' CheckPassword(str) 密碼檢驗(yàn)
' CheckEmail(email) 郵箱格式檢驗(yàn)
' Alert(msg,goUrl) 彈出對(duì)話框提示
' GoBack(Str1,Str2,isback) 出錯(cuò)信息提示
' Suc(str1,str2,url) 操作成功信息提示
' ChkPost() 檢測(cè)是否站外提交表單
' PSql() 防止sql注入
' FiltrateHtmlCode(Str) 防止生成HTML
' HtmlCode(str) 過濾HTML
' Replacehtml(tstr) 清濾HTML
' GetIP() 獲取客戶端IP
' GetBrowser 獲取客戶端瀏覽器信
' GetSystem 獲取客戶端操作系統(tǒng)
' GetUrl() 獲取當(dāng)前頁(yè)面URL包含參數(shù)
' CUrl() 獲取當(dāng)前頁(yè)面URL
' GetExtend 取得文件擴(kuò)展名
' CheckExist(table,fieldname,fieldcontent,isblur) 檢測(cè)某個(gè)表中某個(gè)字段的內(nèi)容是否存在
' GetNum(table,fieldname,resulttype,args) 檢測(cè)某個(gè)表某個(gè)字段有多少條，最大值 ，最小值等
' GetFolderSize(Folderpath) 計(jì)算某個(gè)文件夾的大小
' GetFileSize(Filename) 計(jì)算某個(gè)文件的大小
' IsObjInstalled(strClassString) 檢測(cè)組件是否安裝
' SendMail JMAIL發(fā)送郵件
' ResponseCookies 寫入cookies
' CleanCookies 清除cookies
' GetTimeover 取得程序頁(yè)面執(zhí)行時(shí)間
' FormatSize 大小格式化
' FormatTime 時(shí)間格式化
' Zodiac 取得生肖
' Constellation 取得星座
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Class Cls_fun
'－－－－－－－－字符處理－－－－－－－－－－－－－－－－－－－－－－－－－－
'****************************************************
'函數(shù)名：StrLength
'作 用：取得字符串長(zhǎng)度（漢字為2)
'參 數(shù)：str ----字符串內(nèi)容
'返回值：字符串長(zhǎng)度
'****************************************************
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
'****************************************************
'函數(shù)名：CutStr
'作 用：字符串長(zhǎng)度切割，超過顯示省略號(hào)
'參 數(shù)：str ----字符串內(nèi)容
' strlen ------要顯示的長(zhǎng)度
'返回值：切割后字符串內(nèi)容
'****************************************************
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
'－－－－－－－－－－－－－－系列驗(yàn)證－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'****************************************************
'函數(shù)名：CheckIsEmpty
'作 用：檢查是否為空
'參 數(shù)：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
'****************************************************
'函數(shù)名：isInteger
'作 用：整數(shù)檢驗(yàn)
'參 數(shù)：tstr ----字符
'返回值：true是整數(shù)，false不是整數(shù)
'****************************************************
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
'****************************************************
'函數(shù)名：CheckName
'作 用：名字字符檢驗(yàn)
'參 數(shù)：str ----字符串
'返回值：true無(wú)誤，false有誤
'****************************************************
Public Function CheckName(Str)
Checkname=true
Dim Rep,pass
Set Rep=New RegExp
Rep.Global=True
Rep.IgnoreCase=True
'匹配字母、數(shù)字、下劃線、漢字且必須以字母或下劃線或漢字開始
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
'****************************************************
'函數(shù)名：CheckPassword
'作 用：密碼檢驗(yàn)
'參 數(shù)：str ----字符串
'返回值：true無(wú)誤，false有誤
'****************************************************
Public Function CheckPassword(Str)
Dim pass
CheckPassword=true
If Str <> "" Then
Dim Rep
Set Rep = New RegExp
Rep.Global = True
Rep.IgnoreCase = True
'匹配字母、數(shù)字、下劃線、點(diǎn)號(hào)
Rep.Pattern="[a-zA-Z0-9_\.]+$"
Pass=rep.Test(Str)
Set Rep=nothing
If not Pass Then CheckPassword=false
End If
End Function
'****************************************************
'函數(shù)名：CheckEmail
'作 用：郵箱格式檢測(cè)
'參 數(shù)：str ----Email地址
'返回值：true無(wú)誤，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
'－－－－－－－－－－－－－－信息提示－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'****************************************************
'函數(shù)名：Alert
'作 用：彈出對(duì)話框提示
'參 數(shù)：msg ----對(duì)話框信息
' gourl ----提示后轉(zhuǎn)向哪里
'返回值：無(wú)
'****************************************************
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
'****************************************************
'函數(shù)名：GoBack
'作 用：錯(cuò)誤信息提示
'參 數(shù)：str1 ----信息提示標(biāo)題
' str2 ----信息提示內(nèi)容
' isback ----是否顯示返回
'返回值：無(wú)
'****************************************************
Public Function GoBack(Str1,Str2,isback)
If Str1="" Then Str1="錯(cuò)誤信息"
If Str2="" Then Str2="請(qǐng)?zhí)顚懲暾靥铐?xiàng)目"
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
'****************************************************
'函數(shù)名：Suc
'作 用：成功提示信息
'參 數(shù)：str1 ----信息提示標(biāo)題
' str2 ----信息提示內(nèi)容
' url ----返回地址
'返回值：無(wú)
'****************************************************
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&""" >返回繼續(xù)管理</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
'－－－－－－－－－－－－－－安全處理－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'****************************************************
'函數(shù)名：ChkPost
'作 用：禁止站外提交表單
'返回值：true站內(nèi)提交，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
'****************************************************
'函數(shù)名：PSql
'作 用：防止SQL注入
'返回值：為空則無(wú)注入，不為空則注入并返回注入的字符
'****************************************************
public Function PSql()
Psql=""
badwords= "'防''防;防and防exec防insert防select防update防delete防count防*防%防chr防m(xù)id防m(xù)aster防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
'****************************************************
'函數(shù)名：FiltrateHtmlCode
'作 用：防止生成html代碼
'參 數(shù)：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
'****************************************************
'函數(shù)名：HtmlCode
'作 用：過濾Html標(biāo)簽
'參 數(shù)：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
'****************************************************
'函數(shù)名：Replacehtml
'作 用：清理html
'參 數(shù)：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
'－－－－－－－－－－－－－－－獲取客戶端和服務(wù)端的一些信息－－－－－－－－－－－－－－－－－－－
'****************************************************
'函數(shù)名：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
'****************************************************
'函數(shù)名：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
'****************************************************
'函數(shù)名：GetSystem
'作 用：獲取客戶端操作系統(tǒng)
'返回值：客戶端操作系統(tǒng)
'****************************************************
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
'****************************************************
'函數(shù)名：GetUrl
'作 用：獲取url包括參數(shù)
'返回值：獲取url包括參數(shù)
'****************************************************
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
'****************************************************
'函數(shù)名：CUrl
'作 用：獲取當(dāng)前頁(yè)面URL的函數(shù)
'返回值：當(dāng)前頁(yè)面URL的函數(shù)
'****************************************************
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
'****************************************************
'函數(shù)名：GetExtend
'作 用：取得文件擴(kuò)展名
'參 數(shù)：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
'－－－－－－－－－－－－－－－－－－數(shù)據(jù)庫(kù)的操作－－－－－－－－－－－－－－－－－－－－－－－
'****************************************************
'函數(shù)名：CheckExist
'作 用：檢測(cè)某個(gè)表中某個(gè)字段是否存在某個(gè)內(nèi)容
'參 數(shù)：table ----表名
' fieldname ----字段名
' fieldcontent ----字段內(nèi)容
' 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
'****************************************************
'函數(shù)名：GetNum
'作 用：檢測(cè)某個(gè)表某個(gè)字段的數(shù)量或最大值或最小值
'參 數(shù)：table ----表名
' fieldname ----字段名
' resulttype ----還回結(jié)果(count/max/min)
' args ----附加參加(order by ...)
'返回值：數(shù)值
'****************************************************
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
'****************************************************
'函數(shù)名：UpdateValue
'作 用：更新表中某字段某內(nèi)容的值
'參 數(shù)：table ----表名
' fieldname ----字段名
' fieldvalue ----更新后的值
' id ----id
' url -------更新后轉(zhuǎn)向地址
'返回值：無(wú)
'****************************************************
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
'－－－－－－－－－－－－－－－服務(wù)端信息和操作－－－－－－－－－－－－－－－－－－－－－－－
'****************************************************
'函數(shù)名：GetFolderSize
'作 用：計(jì)算某個(gè)文件夾的大小
'參 數(shù)：FileName ----文件夾路徑及文件夾名稱
'返回值：數(shù)值
'****************************************************
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
'****************************************************
'函數(shù)名：GetFileSize
'作 用：計(jì)算某個(gè)文件的大小
'參 數(shù)：FileName ----文件路徑及文件名
'返回值：數(shù)值
'****************************************************
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
'****************************************************
'函數(shù)名：IsObjInstalled
'作 用：檢查組件是否安裝
'參 數(shù)：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
'****************************************************
'函數(shù)名：SendMail
'作 用：用Jmail組件發(fā)送郵件
'參 數(shù)：ServerAddress ----服務(wù)器地址
' AddRecipient ----收信人地址
' Subject ----主題
' Body ----信件內(nèi)容
' Sender ----發(fā)信人地址
'****************************************************
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
'****************************************************
'函數(shù)名：ResponseCookies
'作 用：寫入COOKIES
'參 數(shù)：Key ----cookie名
' value ----cookie值
' expires ---- cookie過期時(shí)間
'****************************************************
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
'****************************************************
'函數(shù)名：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
'****************************************************
'函數(shù)名：GetTimeOver
'作 用：清除COOKIES
'參 數(shù)：flag ---顯示時(shí)間單位1=秒，否則毫秒
'****************************************************
Public Function GetTimeOver(flag)
Dim EndTime
If flag = 1 Then
EndTime=FormatNumber(Timer() - StartTime, 6, true)
getTimeOver = " 本頁(yè)執(zhí)行時(shí)間: " & EndTime & " 秒"
Else
EndTime=FormatNumber((Timer() - StartTime) * 1000, 3, true)
getTimeOver =" 本頁(yè)執(zhí)行時(shí)間: " & EndTime & " 毫秒"
End If
End function
'－－－－－－－－－－－－－－－－－系列格式化－－－－－－－－－－－－－－－－－－－－－－－－
'****************************************************
'函數(shù)名：FormatSize
'作 用：大小格式化
'參 數(shù)：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
'****************************************************
'函數(shù)名：FormatTime
'作 用：時(shí)間格式化
'參 數(shù)：DateTime ----要格式化的時(shí)間
' 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
'－－－－－－－－－－－－－－－－－－－－－－雜項(xiàng)－－－－－－－－－－－－－－－－－－－－－
'****************************************************
'函數(shù)名：Zodiac
'作 用：取得生消
'參 數(shù)：birthday ----生日
'****************************************************
public Function Zodiac(birthday)
if IsDate(birthday) then
birthyear=year(birthday)
ZodiacList=array("猴","雞","狗","豬","鼠","牛","虎","兔","龍","蛇","馬","羊")
Zodiac=ZodiacList(birthyear mod 12)
end if
End Function
'****************************************************
'函數(shù)名：Constellation
'作 用：取得星座
'參 數(shù)：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 title='魔羯座 Capricorn'>"
elseif MyConstellation < 0219 then
constellation="<img src=images/Constellation/h.gif title='水瓶座 Aquarius'>"
elseif MyConstellation < 0321 then
constellation="<img src=images/Constellation/i.gif title='雙魚座 Pisces'>"
elseif MyConstellation < 0420 then
constellation="<img src=images/Constellation/^.gif title='白羊座 Aries'>"
elseif MyConstellation < 0521 then
constellation="<img src=images/Constellation/_.gif title='金牛座 Taurus'>"
elseif MyConstellation < 0622 then
constellation="<img src=images/Constellation/`.gif title='雙子座 Gemini'>"
elseif MyConstellation < 0723 then
constellation="<img src=images/Constellation/a.gif title='巨蟹座 Cancer'>"
elseif MyConstellation < 0823 then
constellation="<img src=images/Constellation/b.gif title='獅子座 Leo'>"
elseif MyConstellation < 0923 then
constellation="<img src=images/Constellation/c.gif title='處女座 Virgo'>"
elseif MyConstellation < 1024 then
constellation="<img src=images/Constellation/d.gif title='天秤座 Libra'>"
elseif MyConstellation < 1122 then
constellation="<img src=images/Constellation/e.gif title='天蝎座 Scorpio'>"
elseif MyConstellation < 1222 then
constellation="<img src=images/Constellation/f.gif title='射手座 Sagittarius'>"
elseif MyConstellation > 1221 then
constellation="<img src=images/Constellation/g.gif title='魔羯座 Capricorn'>"
end if
end if
End Function
'=================================================
'函數(shù)名：autopage
'作 用：長(zhǎng)文章自動(dòng)分頁(yè)
'參 數(shù)：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>頁(yè)碼:</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&"非法操作！頁(yè)號(hào)超出！<a href=javascript:history.back(-1)><u>返回</u></a>"
end if
Else
AutoPage=content
end if
End Function
End Class
%>
調(diào)用：set fun=new cls_fun
相關(guān)文章
不錯(cuò)的主要用于加密的vbs(asp)位移運(yùn)算類
2008-01-01
ASP中一個(gè)用VBScript寫的隨機(jī)數(shù)類
ASP中一個(gè)用VBScript寫的隨機(jī)數(shù)類...2006-08-08
CacheCls緩存的應(yīng)用...2006-08-08
ASP怎么談到應(yīng)用到類的？...2006-09-09
域名查詢系統(tǒng)用到的類...2006-09-09
發(fā)一個(gè)ASP的ADODB類代碼...2007-11-11
ASP實(shí)現(xiàn)緩存類無(wú)錯(cuò)版
ASP實(shí)現(xiàn)緩存類無(wú)錯(cuò)版...2007-08-08
【先鋒海盜類】Ver2005 最終版...2006-08-08
遭遇ASP類的事件設(shè)計(jì)...2006-08-08
日期函數(shù)擴(kuò)展類Ver0.1.1...2006-10-10