推薦下天楓常用ASP函數封裝，推薦大家使用
代碼如下:
<%
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'所有功能函數名如下：
' 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="]*)>"
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 (""&vbnewline&"alert('" & msg & "');"&gourl&vbnewline&"")
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&" 返回重填"
else
str2=str2
end if
response.write"
"&str1&"
×
"&str2&""
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&" 返回繼續管理"
response.write"
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&" 返回繼續管理"
response.write"
"&str1&"
√
"&str2&""
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="]*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=""
elseif myconstellation < 0219 then
constellation=""
elseif myconstellation < 0321 then
constellation=""
elseif myconstellation < 0420 then
constellation=""
elseif myconstellation < 0521 then
constellation=""
elseif myconstellation < 0622 then
constellation=""
elseif myconstellation < 0723 then
constellation=""
elseif myconstellation < 0823 then
constellation=""
elseif myconstellation < 0923 then
constellation=""
elseif myconstellation < 1024 then
constellation=""
elseif myconstellation < 1122 then
constellation=""
elseif myconstellation < 1222 then
constellation=""
elseif myconstellation > 1221 then
constellation=""
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&"
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="]*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=""
elseif myconstellation < 0219 then
constellation=""
elseif myconstellation < 0321 then
constellation=""
elseif myconstellation < 0420 then
constellation=""
elseif myconstellation < 0521 then
constellation=""
elseif myconstellation < 0622 then
constellation=""
elseif myconstellation < 0723 then
constellation=""
elseif myconstellation < 0823 then
constellation=""
elseif myconstellation < 0923 then
constellation=""
elseif myconstellation < 1024 then
constellation=""
elseif myconstellation < 1122 then
constellation=""
elseif myconstellation < 1222 then
constellation=""
elseif myconstellation > 1221 then
constellation=""
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&"
頁碼:"
for i=0 to pagesize
if i=pagenum-1 then
autopage=autopage&"["&i+1&"] "
else
if instr(paramater,"?")>0 then
autopage=autopage&"["&(i+1)&"]"
else
autopage=autopage&"["&(i+1)&"]"
end if
end if
next
autopage=autopage&""
else
autopage=autopage&"非法操作！頁號超出！返回"
end if
else
autopage=content
end if
end function
end class
%>
調用：set fun=new cls_fun
for i=0 to pagesize
if i=pagenum-1 then
autopage=autopage&"["&i+1&"] "
else
if instr(paramater,"?")>0 then
autopage=autopage&"["&(i+1)&"]"
else
autopage=autopage&"["&(i+1)&"]"
end if
end if
next
autopage=autopage&""
else
autopage=autopage&"非法操作！頁號超出！返回"
end if
else
autopage=content
end if
end function
end class
%>
調用：set fun=new cls_fun
ASP技巧