asp开发中常用函数

<%
'是否是安全访问
function isselfrefer()
 server_v1=lcase(request.servervariables("http_referer"))
 server_v2=lcase(request.servervariables("server_name"))
 if instr(server_v1,server_v2)<1 then
  isselfrefer = false'不是
  else
   isselfrefer = true'是
 end if
end function

'页面出错
private sub page_err(msg)
 response.write(msg)
 response.end()
end sub

'格式化日期
function formatdate(sdate,ssplit)
 y = cstr(year(sdate))
 m = cstr(month(sdate))
 if len(m)=1 then m = "0" & m
 d = cstr(day(sdate))
 if len(d)=1 then d = "0" & d
 formatdate = y & ssplit & m & ssplit & d
end function

function mycdbl(str)
 if str = "" or not isnumeric(str) then
  call page_err("参数错误：要求为数字型。")
  else
   mycdbl = cdbl(str)
 end if
end function

function getnumber(str)
 if str = "" or not isnumeric(str) then
  call page_err("参数错误：要求为数字型。")
  else
   getnumber = str
 end if
end function

private sub messagebox(msg,gotourl)
 response.write("")
 response.end()
end sub

'自定义left
function leftx(str,n)
 dim i,j,ch,strtmp
 j = 0
 strtmp = ""
 for i = 1 to len(str)
  ch = mid(str,i,1)
  strtmp = strtmp & ch
  if asc(ch)<0 then
   j = j + 2
   else
    j = j + 1
  end if
  if j >= n then exit for
 next
 leftx = strtmp
end function

'输出字符串
function outstr(str)
  strer=str
  if strer="" or isnull(strer) then
    outstr="":exit function
  end if
  strer=replace(strer,"<","<")
  strer=replace(strer,">",">")
  strer=replace(strer,chr(13) & chr(10),"
")    '换行
  strer=replace(strer,chr(32)," ")    '空格
  strer=replace(strer,chr(9)," ")    'table
  strer=replace(strer,chr(39),"'")    '单引号
  strer=replace(strer,chr(34),""")    '双引号
  outstr = strer
end function

'过滤html标签
function filterhtml(fstring)
    if isnull(fstring) or trim(fstring)="" then
        filterhtml=""
        exit function
    end if
    set  re = new  regexp
    re.ignorecase=true
    re.global=true
    re.pattern="<(.+?)>"
    fstring = re.replace(fstring, "")
    set   re=nothing
 filterhtml = fstring
end function

'执行sql，返一行一列的值
function execsqlreturnonevalue(sql)
 set oprs = server.createobject("adodb.recordset")
 oprs.open sql,conn,0,1
 if  oprs.eof and oprs.bof then
  execsqlreturnonevalue = ""
  else
   execsqlreturnonevalue = oprs(0)
 end if
 oprs.close
 set oprs = nothing
end function

'格式化日期
function format_time(s_time,n_flag)
 dim y, m, d, h, mi, s
 format_time = ""
 if isdate(s_time) = false then exit function
 y = cstr(year(s_time))
 m = cstr(month(s_time))
 if len(m) = 1 then m = "0" & m
 d = cstr(day(s_time))
 if len(d) = 1 then d = "0" & d
 h = cstr(hour(s_time))
 if len(h) = 1 then h = "0" & h
 mi = cstr(minute(s_time))
 if len(mi) = 1 then mi = "0" & mi
 s = cstr(second(s_time))
 if len(s) = 1 then s = "0" & s
 select case n_flag
 case 1
  ' yyyy-mm-dd hh:mm:ss
  format_time = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
 case 2
  ' yyyy-mm-dd
  format_time = y & "-" & m & "-" & d
 case 3
  ' hh:mm:ss
  format_time = h & ":" & mi & ":" & s
 case 4
  ' yyyy年mm月dd日
  format_time = y & "年" & m & "月" & d & "日"
 case 5
  ' yyyymmdd
  format_time = y & m & d
 end select
end function

function cmdsafelikesqlstr(str)
 str = replace(str,"'","''")
 str = replace(str,"[","[[]")
 str = replace(str,"%","[%]")
 str = replace(str,"_","[_]")
 cmdsafelikesqlstr = str
end function

function replacetest(str,patrn, replstr)
  dim regex, str1
  str1 = str
  set regex = new regexp
  regex.pattern = patrn
  regex.ignorecase = true
  regex.global=true
  replacetest = regex.replace(str1, replstr)
end function

function getpageurlpath()
 server_name = request.servervariables("server_name")
 server_port = request.servervariables("server_port")
 path_info = request.servervariables("path_info")
 path_tmp = split(path_info,"/")
 path_info = replace(path_info,path_tmp(ubound(path_tmp)),"")
 url = "http://" & server_name
 if server_port<>80 then url = url & ":" & server_port
 url = url & path_info
 getpageurlpath = url
end function

function getadsense(id)
 sql="select code from ok3w_adsense where id=" & id
 set ors = conn.execute(sql)
 if ors.eof and ors.bof then
  getadsense = "广告不存在，id=" & id
  else
   getadsense = ors("code")
 end if
 ors.close
 set ors = nothing
end function

'频道名称
function getchannelname(channelid)
 if channelid="" then
  getchannelname = "--------"
  exit function
 end if
 sql = "select channelname from ok3w_channel where channelid=" & channelid
 getchannelname = execsqlreturnonevalue(sql)
end function

'栏目名称
function getclassname(classid)
 if classid="0" then
  getclassname = "--------"
  exit function
 end if
 sql = "select sortname from ok3w_class where id=" & classid
 getclassname = execsqlreturnonevalue(sql)
end function

function getcommentscount(typeid,tableid)
 sql="select count(id) from ok3w_guest where ispass=1 and typeid=" & typeid & " and tableid=" & tableid
 getcommentscount = execsqlreturnonevalue(sql)
end function

'分类id下拉列表选择菜单
private sub initclassselectoption(channelid,parentid,chkid)
 dim oprs,ctmp,clen,ccount
 set oprs = server.createobject("adodb.recordset")
 sql = "select id,sortname,sortpath from ok3w_class where channelid=" & channelid & " and parentid=" & parentid & " order by orderid"
 oprs.open sql,conn,0,1
 do while not oprs.eof
  response.write("   if chkid = oprs("id") then response.write(" selected=""selected""")
  response.write(">")
  ctmp = split(oprs("sortpath"),",")
  clen = ubound(ctmp) - 2
  for ccount=1 to clen
   response.write("│ ")
  next
  response.write("├" & oprs("sortname") & "")
  
  call initclassselectoption(channelid,oprs("id"),chkid)
  oprs.movenext
 loop
 oprs.close
 set oprs = nothing
end sub

private sub outthispagecontent(aid,content,pagepath)
 thispage = request.querystring("thispage")
 if thispage<>"" then thispage = mycdbl(thispage)
 if thispage="" then thispage=1
 thispage = cint(thispage)
 content_tmp = split(content,"[ok3w_nextpage]")
 page_count = ubound(content_tmp)+1
 if thispage> page_count then thispage = page_count
 
 response.write(replacetest(content_tmp(thispage-1),"  
 if page_count>1 then
  response.write("

")
  for ipage=1 to page_count
   if ipage = 1 then
    url = "?id=" & aid
    else
     url = "?id=" &  aid & "&thispage=" & ipage
   end if
   if ipage = thispage then
    response.write("第" & ipage & "页 ")
    else
     response.write("第" & ipage & "页 ")
   end if
  next
  response.write("

")
 end if
end sub
%>