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



Public Sub Toplist2s(num,field,id)
	if num = "" or field = "" then exit Sub
		if field = "week" then
			SqlT="SELECT top "& num &" s_id,Title,Nclassid,classid FROM 2s_list where sxs = 0 and DateDiff('d',intime,date())<=7  order by hits desc,title"
		elseif id <>"" then
			SqlT = "Select top "& num &" s_id,Title,Nclassid,classid from 2s_list where sxs = 0 and classid="& id &" order by "& field &" desc,title"
		else
		SqlT = "Select top "& num &" s_id,Title,Nclassid,classid from 2s_list where sxs = 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=show.asp?id="& Rst(2) &"&Unid="& Rst(0) &" title="& Qcdn.ReplaceP(Rst(1)) &">"& Qcdn.Classlist(Rst(1)) &"</a>] ")
'			end if
			Response.Write "<li><a href=show.asp?unid=" & Rst(0) &"&id="& Rst(3) &" target='"& AddOpenWin &"' title="& Qcdn.ReplaceP(Rst(1)) &">" & HTMLcode(GetString(Rst(1),23)) & "</a></li>"
		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

function InterceptString(txt,length)
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
InterceptString = txt
else
InterceptString = ""
end if

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 Classlist2s(id)
	if id = "" or isnull(id) then
		Classlist2s = ""
	else
		Sqld = "Select classname from 2s_class where unid = " & id
		Set rsd = conn.execute(Sqld)
		if not rsd.eof then
			Classlist2s = rsd(0)
		else
			Classlist2s = ""
		end if
		rsd.close
	end if
End function

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

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

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

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

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

Public function Classlistr114(id)
	if id = "" or isnull(id) then
		Classlistr114 = ""
	else
		Sqld = "Select classname from 114_class where unid = " & id
		Set rsd = conn.execute(Sqld)
		if not rsd.eof then
			Classlistr114 = rsd(0)
		else
			Classlistr114 = ""
		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></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><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