common.asp

本源代码为大学生购物网的源代码,欢迎大家的下载,学习与交流

<%
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

function sqlcheck(Str)
	if Instr(LCase(Str),"select ") > 0 or Instr(LCase(Str),"insert ") > 0 or Instr(LCase(Str),"delete ") > 0 or Instr(LCase(Str),"delete from ") > 0 or Instr(LCase(Str),"count(") > 0 or Instr(LCase(Str),"drop table") > 0 or Instr(LCase(Str),"update ") > 0 or Instr(LCase(Str),"truncate ") > 0 or Instr(LCase(Str),"asc(") > 0 or Instr(LCase(Str),"mid(") > 0 or Instr(LCase(Str),"char(") > 0 or Instr(LCase(Str),"xp_cmdshell") > 0 or Instr(LCase(Str),"exec master") > 0 or Instr(LCase(Str),"net localgroup administrators") > 0  or Instr(LCase(Str),"and ") > 0 or Instr(LCase(Str),"net user") > 0 or Instr(LCase(Str),"or ") > 0 then
		 Call Qcdn.Err_List("请不要在参数中包含非法字符尝试注入！",1)
		 Response.End
		 exit function
	end if
	Str=Replace(Str,"_","")     '过滤SQL注入_
	Str=Replace(Str,"*","")     '过滤SQL注入*
	Str=Replace(Str," ","")     '过滤SQL注入空格
	Str=Replace(Str,chr(34),"")   '过滤SQL注入"
	Str=Replace(Str,chr(39),"")            '过滤SQL注入'
	Str=Replace(Str,chr(91),"")            '过滤SQL注入[
	Str=Replace(Str,chr(93),"")            '过滤SQL注入]
	Str=Replace(Str,chr(37),"")            '过滤SQL注入%
	Str=Replace(Str,chr(58),"")            '过滤SQL注入:
	Str=Replace(Str,chr(59),"")            '过滤SQL注入;
	Str=Replace(Str,chr(43),"")            '过滤SQL注入+
	Str=Replace(Str,"{","")            '过滤SQL注入{
	Str=Replace(Str,"}","")            '过滤SQL注入}
	sqlcheck=Str            '返回经过上面字符替换后的Str
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 2s_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 2s_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>")