www.gusucode.com > 漂亮的地方旅游景点景观介绍网站源代码 > inc/fun.asp
<!--#include virtual="/inc/function.asp" --> <% function outhtml(str) dim stemp stemp = str outhtml = "" if isnull(stemp) = true then exit function end if stemp = replace(stemp, "&", "&") stemp = replace(stemp, "<", "<") stemp = replace(stemp, ">", ">") stemp = replace(stemp, chr(34), """) stemp = replace(stemp, chr(10), "<br>") outhtml = stemp end function '过滤脏话/////////////////////////////////////////////////////////////////////////////////// Function gl(str) dim guolv,ii,rsgl Guolv = Split(badword,"|") For ii=0 to Ubound(Guolv) Str = Replace (Str,Guolv(ii),"*") Next Gl=Str End Function '网站META描述//////////////////////////////////////////////////////////////////////////// sub headinfo() Response.Write("<title>") if mytit<>"" then Response.Write(mytit&"——") end if Response.Write(sitename&"</title><meta http-equiv=""Content-Type"" contect=""text/html;charset=gb_2312"">"&vbcrlf&"<meta http-equiv=""Content-Language"" contect=""zh-CN"">"&vbcrlf&"<meta name=""title"" content="""&sitename&""">"&vbcrlf&"<meta name=""Robots"" contect= ""all"">"&vbcrlf&"<meta name=""keywords"" content="""&keywords&""">"&vbcrlf&"<meta name=""description"" content="""&descriptions&""">"&vbcrlf&"<meta name=""Author"" contect=""Icewolf|zhantian-1213@163.com|QQ:9902484"">"&vbcrlf&"<meta name=""Generator"" contect=""dearmweaver 8.02"">"&vbcrlf&"<script language=""javascript"" src=""/inc/main.js""></script>"&vbcrlf&"<script language=""javascript"" src=""/inc/ajaxrequest.js""></script>"&vbcrlf&"<iframe src=""/inc/hits.asp?mc="&server.URLEncode(mytit)&"&pagename="&server.URLEncode(request.ServerVariables("PATH_INFO")&"?"&request.ServerVariables("QUERY_STRING"))&""" width=""1"" height=""1""></iframe>") end sub '广告//////////////////////////////////////////////////////////////////////////////////// function ad(xid,wid,hgt) set rs=conn.execute("select top 1 * from jw_ad where id="&xid) if not rs.eof then if lcase(fileExec(rs("pic")))="gif" or lcase(fileExec(rs("pic")))="jpg" or lcase(fileExec(rs("pic")))="jpeg" or lcase(fileExec(rs("pic")))="png" then '图片——————————————————————————————————————————————— ad="<a href='"&rs("url")&"' target='_blank'><img src='"&rs("pic")&"' border='0' width='"&wid&"'/></a>" '————————————————————————————————————————————————— else 'flash——————————————————————————————————————————————— ad="<script type=""text/javascript"">AC_FL_RunContent( 'codebase','http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=7,0,19,0','width','"&wid&"','height','"&hgt&"','src','"&left(rs("pic"),(len(rs("pic"))-4))&"','quality','high','pluginspage','http://www.macromedia.com/go/getflashplayer','movie','"&left(rs("pic"),(len(rs("pic"))-4))&"' );</script><noscript><object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=7,0,19,0"" width="""&rs("wth")&"""height="""&rs("hig")&"""><param name=""movie"" value="""&rs("pic")&""" /><param name=""quality"" value=""high"" /><embed src="""&rs("pic")&""" quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash"" width="""&wid&""" height="""&hgt&"""></embed></object></noscript>" '—————————————————————————————————————————————————— end if end if call recordend(rs) end function '生成OPTION///////////////////////////////////////////////////////////////////////////// sub getoption(tab,zj,zd,xz) dim rso set rso=conn.execute("select * from "&tab&" order by "&zj&" asc") do while not rso.eof Response.Write("<option value="""&rso(zj)&"""") if xz<>"" then if int(xz)=int(rso(zj)) then Response.Write(" selected") end if end if Response.Write(">"&rso(zd)&"</option>"&vbcrlf) rso.movenext loop rso.close set rso=nothing end sub function getfid(tabs,cid) dim rsx set rsx=conn.execute("select top 1 id from "&tabs&" where fid="&cid&" and show=0 order by zd desc,qz asc") if rsx.eof then getfid=cid else getfid=getfid(tabs,rsx(0)) end if call recordend(rsx) end function '导航///////////////////////////////////////////////////////////////////////// function getdaoh(tab) dim fpath,str,i,dhstr fpath=getmc(tab,"id",fid,"fpath") str=split(fpath,",") for i=1 to ubound(str)-1 if i=ubound(str)-1 then dhstr=dhstr&"<a href="""&getmc(tab,"id",str(i),"path")&"?fid="&str(i)&"""><span class=fontr>"&getmc(tab,"id",str(i),"mc")&"</span></a> >> " else dhstr=dhstr&"<a href="""&getmc(tab,"id",str(i),"path")&"?fid="&str(i)&""">"&getmc(tab,"id",str(i),"mc")&"</a> >> " end if next getdaoh=left(dhstr,len(dhstr)-14) end function '导航2///////////////////////////////////////////////////////////////////////// function getdaoh2(tab) dim fpath,str,i,dhstr fpath=getmc(tab,"id",fid,"fpath") str=split(fpath,",") for i=1 to ubound(str)-1 if i=ubound(str)-1 then dhstr=dhstr&"<a href="""&getmc(tab,"id",str(i),"path")&"?fid="&str(i)&""">"&getmc(tab,"id",str(i),"mc")&"</a> >> " else dhstr=dhstr&"<a href="""&getmc(tab,"id",str(i),"path")&"?fid="&str(i)&""">"&getmc(tab,"id",str(i),"mc")&"</a> >> " end if next getdaoh2=left(dhstr,len(dhstr)-14) end function '导航///////////////////////////////////////////////////////////////////////// function aboutdh(tab) dim fpath,str,i,dhstr fpath=getmc(tab,"id",id,"fpath") str=split(fpath,",") for i=1 to ubound(str)-1 dhstr=dhstr&"<a href="""&getmc(tab,"id",str(i),"path")&"?id="&str(i)&""">"&getmc(tab,"id",str(i),"mc")&"</a> >> " next aboutdh=left(dhstr,len(dhstr)-14) end function '根ID/////////////////////////////////////////////////////////////////////////// function getgid(xid,tab) dim fpath,str fpath=getmc(tab,"id",xid,"fpath") str=split(fpath,",") getgid=str(1) end function sub getporop(xid,oid) dim str,i,rs if oid="" then oid=0 end if set rs=conn.execute("select * from porclass where fid="&xid) do while not rs.eof str=split(rs("fpath"),",") Response.Write("<option value="""&rs("id")&"""") if int(oid)=int(rs("id")) then Response.Write(" selected") end if Response.Write(">") for i=2 to ubound(str)-1 Response.Write(" ") next Response.Write(rs("mc")&"</option>") call getporop(rs("id"),oid) rs.movenext loop call recordend(rs) end sub '错误提示///////////////////////////////////////////////////////////// sub errs(str) call connend() response.Clear() Response.Write(escape(str)) response.End() end sub '清除格式 function qcgs(con,zs) con=removehtml(con) con=replace(con," ","") con=replace(con," ","") con=replace(con," ","") con=left(con,zs) qcgs=con end function Function cutString(txt,length) dim x,y,ii txt=trim(txt) x=len(txt) y=0 if x>= 1 then for ii = 1 to x if asc(mid(txt,ii,1))<0 or asc(mid(txt,ii,1))>255 then '如果是汉字 y=y+2 else y= y+1 end if if y>=length then txt=left(trim(txt),ii)&"..." '字符串限长 exit for end if next cutString=txt else cutString="" end if End Function function getriqi(rq) dim y,m,d y=year(rq) m=month(rq) d=day(rq) if len(m)=1 then m="0"&m end if if len(d)=1 then d="0"&d end if getriqi=m&"-"&d end function '限制IP sub xzIP() dim ip,str,i,j,x,ustr,str1,ips,ipe,ststr,enstr,st1,st2,st3,st4,en3,en4,u1,u2,u3,u4,chk if len(badip)>=10 and instr(badip,".")>0 then ip=userip '客户IP chk=0 str=split(badip,"|") ustr=split(ip,".") u1=int(trim(ustr(0))) '用户IP第三段 u2=int(trim(ustr(1))) '用户IP第四段 u3=int(trim(ustr(2))) '用户IP第三段 u4=int(trim(ustr(3))) '用户IP第四段 for i=0 to ubound(str) '取出IP if trim(str(i))<>"" then '单个IP段 str1=split(str(i),"-") ips=str1(0)'起始IP ipe=str1(1)'结束IP ststr=split(ips,".") enstr=split(ipe,".") st1=int(trim(ststr(0))) '起始第三段 st2=int(trim(ststr(1))) '起始第四段 st3=int(trim(ststr(2))) '起始第三段 st4=int(trim(ststr(3))) '起始第四段 en3=int(trim(enstr(2))) '结束第三段 en4=int(trim(enstr(3))) '结束第四段 if u1=st1 and u2=st2 then if u3>=st3 and u3<=en3 then if u4>=st4 and u4<=en4 then chk=1 exit sub end if end if end if end if next if chk=1 then Response.Write("对不起!您当前的IP不能访问本站") response.End() end if end if end sub '生成排序号///////////////////////////////////////////////////////////////////// Private function scpx(tbl,fidx) dim pxrs call record(pxrs,"select top 1 * from "&tbl&" where fid="&fidx&" order by qz desc",1) if pxrs.eof then scpx=1 else scpx=pxrs("qz")+1 end if call recordend(pxrs) end function '生成排序号/////////////////////////////////////////////////////////////////////// Private function scpx1(tbl) dim pxrs call record(pxrs,"select top 1 * from "&tbl&" order by qz desc",1) if pxrs.eof then scpx1=1 else scpx1=pxrs("qz")+1 end if call recordend(pxrs) end function %>