titleb.asp

Art2008 CMS是一款具有强大的功能的基于ASP语言的网站管理软件

<%
'*************************************************************************************
'函数名an_Replace
'修复相对路径问题
'参数str要处理的字符串,root_path程序工作目录
'*************************************************************************************
Function an_Replace(str,root_path)
Dim regEx,temp,str_o,str_i             ' 建立变量
Set regEx = New RegExp     ' 建立正则表达式对象
str_i="art2008|images|js|script|edit/uploadfile|html|flash|css" '要处理的目录,用"|"隔开
str_end="html|htm|asp|jsp|php|cgi|shtml|gif|jpg|jpeg|bmp|png|txt|doc|exe|css|js|text|mdb|swf|xls|ini|war|rar|"
str_sed=str_end&"zip|reg|dat|inf|arj|cab|chm|text|inc|ppt|dll" '要处理的文件后缀名,用"|"隔开
patrnl="(=)([^\w/<|()=&+*-]){0,2}("&str_i&")(?!\.)|([^&+*-])([=\s""'])([a-zA-Z0-9-_]+[.]("&str_end&"))(?![a-zA-Z0-9])"'正则表达式 
regEx.Pattern = patrnl      ' 设置模式
regEx.IgnoreCase = false   ' 设置是否区分大小写
'i=0                        ' 测试，用防止死循环
   do while true
     i=i+1
     'if temp<>str and i<2000 then '测试使用
	 if temp<>str then
       temp=str
       str=regEx.Replace(str,"$1$2$4$5"&root_path&"$3$6")'替换操作
     else
       exit do
     end if
   loop
  an_Replace = str     '返回给函数。
End Function 

'*************************************************************************************
	'函数名:finddir
	'作  用:寻找路径
'*************************************************************************************
Function finddir(filepath)                             '修改一下这个函数,2006-9-14
	finddir=""
	for hzh_i=1 to len(filepath)                   '-2006-9-14日发现，原取值for i=1 有问题，改为：for hzh_i没有冲突。奇哉。
	if left(right(filepath,hzh_i),1)="/" or left(right(filepath,hzh_i),1)="\" then
	  abc=hzh_i
	  exit for
	end if
	next
	if abc <> 1 then
	finddir=left(filepath,len(filepath)-abc+1)
	finddir=replace(finddir,"admin/","")            '2007.12.27解决“path”路径问题
       end if
end Function



'*************************************************************************************
	'函数名:titleb
	'作  用:控制字符显示个数
'*************************************************************************************
function titleb(str,strlen)
	dim l,t,c, i
	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
	titleb=left(str,i)&"…"
	exit for
	else
	titleb=str&""
	end if
	next
end function

'*************************************************************************************
	'函数名： fun_html_url(news_id)
	'作用：一个取得静态文件的链接地址
    '参数：news_id---新闻的ID号。
    '返回值：在显示新闻时，代替：
    '<a href="news_view.asp?newsid=XXX">新闻标题</a>
    '中的链接地址：news_view.asp?nesid=XXX
    '代替后为:<a href="""&fun_html_url(news_id)&""">新闻标题</a>
'*************************************************************************************
function fun_html_url(news_id)
  newsid=news_id

'2006年11月10日-发现，下面一句移到这里。解决了网站调用网页与程序目录不相同时，路径出错的问题。
  
  root_path=finddir(request.servervariables("URL"))   '取出系统程序的工作目录.
  path=config("path")
  if newsid="" then 
     fun_html_url="#"
  end if

  if (not isNumeric(newsid)) then
     fun_html_url="#"
  end if

  
  if fun_html_url="#" then exit function

  fun_html_url_sql = "select id,file_path,file_name from news where id="&newsid
  Set fun_html_url_rs = Server.CreateObject("ADODB.RecordSet")
  fun_html_url_rs.Open fun_html_url_sql,conn,1,1
 
  if fun_html_url_rs.recordcount=0 then
     fun_html_url="#"
  
  else  '是recordcount=0的否则条件.

     if config("file_html")=1 and fun_html_url_rs("file_path")<>"" and fun_html_url_rs("file_name")<>"" then  '输出静态文件
   
    array_file_name=split(fun_html_url_rs("file_name"),"|")
    file_name=array_file_name(0)
    file_path=fun_html_url_rs("file_path")
   
  '把一下一句移到251行了。--解决网页调用的路径错误。
  '判断是否有文件存在，如果存在，则调用静态文件，不存在，调用数据库显示
	'root_path=finddir(request.servervariables("URL"))   '取出系统程序的工作目录.

	wl_root_path=server.mappath(path)&"\"   '栏目物理存放的目录 
    wl_file=wl_root_path&file_path&file_name

    set fileobj=Server.Createobject("Scripting.FileSystemObject")
	If fileobj.FileExists(wl_file) Then
	   fun_html_url=path&file_path&file_name '跳转到静态文件
          
      else
       fun_html_url=path&"news_view.asp?newsid="&newsid
      
      end if
    set fileobj=nothing

   else  '是config("file_html")=1否则
     fun_html_url=path&"news_view.asp?newsid="&newsid
    
    end if '是config("file_html")=1的结束条件.

 end if '是recordcount=0的结束条件.

 fun_html_url_rs.close
 set fun_html_url_rs=nothing

end function

'增加结束（2006-9-13）一个取得静态文件的链接地址
'*************************************************************************************
	'函数名： list_html_url(ClassId)
	'作用：一个取得静态列表的链接地址
    '参数：ClassId---栏目的ID号。
    '返回值：在显示新闻时，代替：
    '<a href="news_more.asp?lm=XXX">更多连接</a>
    '中的链接地址：news_more.asp?lm=XXX
    '代替后为:<a href="""& list_html_url(ClassId)&""">新闻标题</a>
'*************************************************************************************
Function list_html_url(ClassId)
  Dim listHtml,lm_path
  listHtml=config("listHtml")
  path=config("path")
 if clng(ClassId)<>0 then
 Set rs_lmp = Server.CreateObject("ADODB.RecordSet")
 rs_lmp.Open "select id,lm_path from [lm] where id="& clng(ClassId)  ,conn,1,1
    lm_path=rs_lmp("lm_path")
 rs_lmp.close:set rs_lmp=nothing 
   If listHtml=0 then
   list_html_url=path&"html/"&lm_path
   Else
   list_html_url=path&"news_more.asp?lm="&ClassId
   End IF
 Else
   list_html_url=path&"news_more.asp?lm="&ClassId
 end if

End Function 


'*************************************************************************************
	'函数名:morepath
	'作  用:更多新闻里的路径标签的调用
'*************************************************************************************
function morepath()
	If config("listHtml")=0 then
	 if lmid<>""then	
	  lm=lmid
	  else
	  lm=trim(request("lm"))
	  end if
	else
	lm2 =trim(request("lm2"))
	lm=trim(request("lm"))
    if lm2="" then lm2=lm
    if lm="" then lm=lm2
	end if   
	set morepath_1_rs= Server.CreateObject("ADODB.RecordSet")  '原rs改名为morepath_1_rs
	morepath_1_rs.Open "select * from [lm] where id="&lm&" order by id desc",conn,1,1
	if morepath_1_rs.recordcount<>0 then
		lm3=morepath_1_rs("lm3")
		lm2=morepath_1_rs("lm2")
		lm1=morepath_1_rs("lm")
		id=morepath_1_rs("id")
		lmidd=morepath_1_rs("lmid")
		morepath="新闻列表"
	 end if
     morepath_1_rs.close
	 set morepath_1_rs=nothing

	if lm3<>"" then
        lm3name=lm3
		morepath="<a href="&list_html_url(id)&">"&lm3name&"</a> - "&morepath
		
		set morepath_2_rs = Server.CreateObject("ADODB.RecordSet")
		morepath_2_rs.Open "select * from [lm] where id="&lmidd&" order by id desc",conn,1,1
		if morepath_2_rs.recordcount<>0 then
			lm2name=morepath_2_rs("lm2")
			lm1id=morepath_2_rs("lmid")
			morepath="<a href="&list_html_url(morepath_2_rs("id"))&">"&lm2name&"</a> - "&morepath
		end if
	    morepath_2_rs.close
		set morepath_2_rs=nothing

		set morepath_3_rs = Server.CreateObject("ADODB.RecordSet")
		morepath_3_rs.Open "select * from [lm] where id="&lm1id&" order by id desc",conn,1,1
		if morepath_3_rs.recordcount<>0 then
			lm1name=morepath_3_rs("lm")
			morepath="<a href="&list_html_url(morepath_3_rs("id"))&">"&lm1name&"</a> - "&morepath
		end if
		morepath_3_rs.close
	    set morepath_3_rs=nothing
	
	 end if   '结束lm3<>"" 的判断

	if lm2<>"" then
        lm2name=lm2
		morepath="<a href="&list_html_url(id)&">"&lm2name&"</a> - "&morepath
		
		set morepath_2_rs = Server.CreateObject("ADODB.RecordSet")
		morepath_2_rs.Open "select * from [lm] where id="&lmid&" order by id desc",conn,1,1
		if morepath_2_rs.recordcount<>0 then
			lm1name=morepath_2_rs("lm")
			morepath="<a href="&list_html_url(morepath_2_rs("id"))&">"&lm1name&"</a> - "&morepath
		end if
		
	     morepath_2_rs.close
	     set morepath_2_rs=nothing
	
	end if

	if lm1<>"" then
		lm1name=lm1
		morepath="<a href="&list_html_url(id)&">"&lm1name&"</a> - "&morepath
	end if
		
end function



'*************************************************************************************
	'函数名:lmpath(news_id)-----news_id ---- 新闻的ID号
	'作  用:栏目路径
'*************************************************************************************
function lmpath(news_id)  '加一个参数：news_id ---- 新闻的ID号.
'	newsid=trim(request("newsid"))   '取消这一句，增以下一个判断
   root_path=finddir(request.servervariables("URL"))  
  '增加。取出系统程序的工作目录.

   if isnull(news_id) or isempty(news_id) or news_id=""  then   '增加
         newsid=trim(request("newsid")) '增加
   else '增加
        newsid=news_id  '增加
  end if   '增加
'-增加结束。  
'下面的rs全部改为：fun_lmpath_rs, 增"&root_path&".
	set fun_lmpath_rs = Server.CreateObject("ADODB.RecordSet")
	fun_lmpath_rs.Open "select * from [news] where id="&newsid&" order by id desc",conn,1,1
	if fun_lmpath_rs.recordcount<>0 then
		lm3=fun_lmpath_rs("lm3")
		lm2=fun_lmpath_rs("lm2")
		lm1=fun_lmpath_rs("lm")
		news_title=fun_lmpath_rs("title")
		'lmpath="<a href="&root_path&"news_view.asp?newsid="&newsid&">"&news_title&"</a>"
        lmpath="<a href="&fun_html_url(newsid)&">"&news_title&"</a>"
	end if
	fun_lmpath_rs.close
	set fun_lmpath_rs=nothing

	if lm3<>"0" then
		set fun_lmpath_rs = Server.CreateObject("ADODB.RecordSet")
		fun_lmpath_rs.Open "select * from [lm] where id="&lm3&" order by id desc",conn,1,1
		if fun_lmpath_rs.recordcount<>0 then
			lm3name=fun_lmpath_rs("lm3")
			lmpath="<a href="&list_html_url(fun_lmpath_rs("id"))&">"&lm3name&"</a> - "&lmpath
		end if
		fun_lmpath_rs.close
		set fun_lmpath_rs=nothing
	end if


	if lm2<>"0" then
		set fun_lmpath_rs = Server.CreateObject("ADODB.RecordSet")
		fun_lmpath_rs.Open "select * from [lm] where id="&lm2&" order by id desc",conn,1,1
		if fun_lmpath_rs.recordcount<>0 then
			lm2name=fun_lmpath_rs("lm2")
			lmpath="<a href="&list_html_url(fun_lmpath_rs("id"))&">"&lm2name&"</a> - "&lmpath
		end if
		fun_lmpath_rs.close
		set fun_lmpath_rs=nothing