common.asp

网站 QCNEWS后台管理程序,风格流行功能强大

<%
Class Qcdn_newsFun
Public function HTMLcode(fString)
if not isnull(fString) then
    fString = Replace(fString, ">", "&gt;")
    fString = Replace(fString, "<", "&lt;")

    fString = Replace(fString, CHR(32), " ")
    fString = Replace(fString, CHR(9), "&nbsp;")
    fString = Replace(fString, CHR(34), "&quot;")
    fString = Replace(fString, CHR(39), "&#39;")
    fString = Replace(fString, CHR(13), "")
    fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
    fString = Replace(fString, CHR(10), "<BR> ")

    HTMLcode = fString
end if
end function

Public Sub Toplist(num,field,id)
	if num = "" or field = "" then exit Sub
		if field = "week" then
			SqlT="SELECT top "& num &" Unid,Title,Nclassid,classid,pic FROM article_info where flag = 0 and DateDiff('d',intime,date())<=7 and Audit = 0 order by hits desc,title"
		else
			SqlT = "Select top "& num &" Unid,Title,Nclassid,classid,pic from article_info where flag = 0 and Audit = 0 order by "& field &" desc,title"
		end if	
	Set Rst = Conn.execute(SqlT)
	if Rst.eof and Rst.bof then
		Response.write "还没有添加文章。"
	else
		do while not Rst.eof
			Response.Write(bullet)
			if id = 1 then 
				Response.Write("[<a href=2j.asp?id="& Rst(3) &"&cid="& Rst(2) &" title="& Qcdn.ReplaceP(Rst(1)) &">"& Qcdn.Classlist(Rst(2)) &"</a>] ")
			end if
			Response.Write "<a href=list.asp?unid=" & Rst(0) &" target='"& AddOpenWin &"' title="& Qcdn.ReplaceP(Rst(1)) &">" & HTMLcode(GetString(Rst(1),23)) & "</a><br>"
		Rst.movenext
		loop
	end if
	Rst.close
end Sub


Public Function ReplaceP(str)
	ReplaceP = Replace(str,"""",chr(34))
End Function

Public sub Searchlist()
	Response.Write("<table align=center>")
	Response.Write("<tr>")
	Response.Write("<form method=post action=search.asp name=frmSearch>")
	Response.Write("<td align=center height=30>")
	Response.Write("<!----------- Search Start----------->")
	Response.Write("文章搜索：<input type=text name=keyword size=20>")
	Response.Write("<input type=radio name=where value=title checked>标题")
	Response.Write("<input type=radio name=where value=content>内容")
	Response.Write("<input type=radio name=where value=writer>作者")
	Response.Write("&nbsp;<script>function proLoadimg(){var i=new Image;i.src='image/search_over.gif';}proLoadimg();			  </script><input type='image' src='image/search.gif' onmouseover=""this.src='image/search_over.gif'"" onmouseout=""this.src='image/search.gif'"" align=absmiddle>")
	Response.Write("<!----------- Search End----------->")
	Response.Write("</td>")
	Response.Write("</form>")
	Response.Write("</tr>")
	Response.Write("</table>")
end sub

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

Public function isInteger(para)
       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
end function


Public function GetString(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
	GetString=left(str,i)&"..."
	exit for
	else
	GetString=str&" "
	end if
	next
end function

Public function Classlist(id)
	if id = "" or isnull(id) then
		Classlist = ""
	else
		Sqld = "Select classname from article_class where unid = " & id
		Set rsd = conn.execute(Sqld)
		if not rsd.eof then
			Classlist = rsd(0)
		else
			Classlist = ""
		end if
		rsd.close
	end if
End function

Public function checkStr(str)
	if isnull(str) then
		checkStr = ""
		exit function 
	end if
	checkStr=replace(str,"'","''")
end function

Public sub Err_List(errmsg,var)
	Response.write"<BR><BR><table width=413 border=0 align=center cellpadding=0 cellspacing=0 bgcolor=#EEEAD6>"
Response.write"    <tr>"
Response.write"      <td height=29 colspan=3 background=image/topbg.gif> <table width=95% align=right border=0 cellspacing=0 cellpadding=0>"
Response.write"          <tr> "
Response.write"            <td align=left valign=middle><font color=#FFFFFF><B>系统提示信息</B></font></td>"
Response.write"            <td width=8% align=right><a href=# onclick=javascript:window.open('readme.htm','','width=640,height=300,left=100,top=10,scrollbars=yes')><img src=image/help.gif align=middle border=0 alt=帮助文档></a>&nbsp;</td>"
Response.write"          </tr>"
Response.write"        </table></td>"
Response.write"    </tr>"
Response.write"    <tr>"
Response.write"      <td width=3 background=image/link.GIF></td>"
Response.write"      <td><table width=100% border=0 cellspacing=0 cellpadding=0>"
Response.write"          <tr>"
Response.write"            <td height=50 background=image/bgtop.gif valign=top>"
Response.write"			<table width=100% height=75 border=0 cellpadding=0 cellspacing=0>"
Response.write"        <tr>"
Response.write"          <td width=30% align=left valign=bottom> <font color=#FFFFFF><img src=image/xpbg.gif width=409></td>"
Response.write"				</tr>"
Response.write"				</table>"
Response.write"</td>"
Response.write"          </tr>"
Response.write"          <tr>"
Response.write"            <td><table width=95% border=0 align=center> "
Response.write"	  <tr><td>"
Response.write"	  <fieldset><legend align=left>提示内容</legend> "
Response.write"	          <table width=100% border=0 cellspacing=2 cellpadding=2>"
Response.write"                <tr> "
Response.write"                  <td colspan=3 style=line-height:150% align=left>"& errmsg &"</td>"
Response.write"                </tr>"
Response.write"                <tr> "
	if var = 1 then
		Response.write "<tr><td colspan=3 align=center><input type=button name=button value=' 返 回 ' onclick=javascript:history.go(-1); class=tbutton></td></tr>"
	elseif var = 2 then
		Response.write "<tr><td colspan=3 align=center><input type=button name=button value=' 返 回 ' onclick=location.href='"& Request.ServerVariables("HTTP_REFERER") &"'  class=tbutton></td></tr>"
	elseif var = 3 then
		Response.write "<tr><td colspan=3 align=center><input type=button name=button value=' 关 闭 ' onclick=javascript:window.close(); class=tbutton></td></tr>"
	end if
Response.write"                </tr>"
Response.write"              </table>"
Response.write"	  </fieldset> "
Response.write"	  &nbsp;</td></tr>"
Response.write"	  </table></td>"
Response.write"          </tr>"
Response.write"        </table></td>"
Response.write"      <td width=3 background=image/link.GIF></td>"
Response.write"    </tr>"
Response.write"	<tr><td height=3 background=image/linkbom.GIF colspan=3></td></tr>"
Response.write"  </table> "
End Sub

Public Sub OptionList(id)
	SqlS = "Select setname from article_setting where flag = "& id &" order by Unid asc"
	Set RsS = Conn.execute(SqlS)
	if RsS.eof and RsS.bof then
		Response.Write("<option></option>")
	else
		do while not RsS.eof
			Response.Write("<option value='"& HTMLcode(RsS(0)) &"'>"& HTMLcode(RsS(0)) &"</option>")
		RsS.movenext
		loop
	end if
	RsS.close : set RsS = nothing
End Sub

Public Sub ClassOptionlist()
			sqlc = "Select Unid,Classname,flag from article_class where flag <> 0 order by Unid asc"
			Set Rsc = Conn.execute(sqlc)
			if not Rsc.eof then
				do while not Rsc.eof
					Response.write "<option value="& Rsc(0) &"|"& Rsc(2) &">---|"& Rsc(1) &"</option>"
				Rsc.movenext
				loop
			else
				Response.write "<option value=>还没有添加栏目</option>"
			end if
			Rsc.close
End Sub

Public function Ubbcode(strContent)


dim re,ii,po
dim reContent
Set re=new RegExp
re.IgnoreCase =true
re.Global=True

	strContent=Replace(strContent,"file:","file :")
	strContent=Replace(strContent,"files:","files :")
	strContent=Replace(strContent,"script:","script :")
	strContent=Replace(strContent,"js:","js :")

re.Pattern="\[IMG\](http|https|ftp):\/\/(.[^\[]*)\[\/IMG\]"
strContent=re.Replace(strContent,"<a onfocus=this.blur() href=""$1://$2"" target=_blank><IMG SRC=""$1://$2"" border=0 alt=按此在新窗口浏览图片 onload=""javascript:if(this.width>screen.width-333)this.width=screen.width-333""></a>")

re.Pattern="\[UPLOAD=(gif|jpg|jpeg|bmp)\](.[^\[]*)(gif|jpg|jpeg|bmp)\[\/UPLOAD\]"
strContent= re.Replace(strContent,"<br><IMG SRC=""image/$1.gif"" border=0>此主题相关链接如下：<br><A HREF=""$2$1"" TARGET=_blank><IMG SRC=""$2$1"" border=0 alt=按此在新窗口浏览图片 onload=""javascript:if(this.width>screen.width-333)this.width=screen.width-333""></A>")

re.Pattern="\[UPLOAD=(doc|xls|ppt|htm|swf|rar|zip|exe)\](.[^\[]*)(doc|xls|ppt|htm|swf|rar|zip|exe)\[\/UPLOAD\]"
strContent= re.Replace(strContent,"<br><IMG SRC=""image/$1.gif"" border=0>此主题相关链接如下：<br><a href=""$2$1"" target='_blank'>点击浏览该文件</a>")


re.Pattern="(\[FLASH\])(http://.[^\[]*(.swf))(\[\/FLASH\])"
strContent= re.Replace(strContent,"<a href=""$2"" TARGET=_blank><IMG SRC=image/swf.gif border=0 alt=点击开新窗口欣赏该FLASH动画! height=16 width=16>[全屏欣赏]</a><br><center><OBJECT codeBase=http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=4,0,2,0 classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000 width=500 height=400><PARAM NAME=movie VALUE=""$2""><PARAM NAME=quality VALUE=high><embed src=""$2"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=500 height=400>$2</embed></OBJECT></center>")

re.Pattern="(\[FLASH=*([0-9]*),*([0-9]*)\])(http://.[^\[]*(.swf))(\[\/FLASH\])"
strContent= re.Replace(strContent,"<a href=""$4"" TARGET=_blank><IMG SRC=image/swf.gif border=0 alt=点击开新窗口欣赏该FLASH动画! height=16 width=16>[全屏欣赏]</a><br><center><OBJECT codeBase=http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=4,0,2,0 classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000 width=$2 height=$3><PARAM NAME=movie VALUE=""$4""><PARAM NAME=quality VALUE=high><embed src=""$4"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=$2 height=$3>$4</embed></OBJECT></center>")


re.Pattern="(\[URL\])(.[^\[]*)(\[\/URL\])"
strContent= re.Replace(strContent,"<A HREF=""$2"" TARGET=_blank>$2</A>")
re.Pattern="(\[URL=(.[^\[]*)\])(.[^\[]*)(\[\/URL\])"
strContent= re.Replace(strContent,"<A HREF=""$2"" TARGET=_blank>$3</A>")