function.asp

大部分功能模块可以方便快捷地建立多个频道、栏目、二/三级栏目

<%
Dim rs,sql,classid,thispage,PagePara

Dim classname,classname_en
classname=""
classname_en=""

Dim UserID,username,userpwd,weblevel
UserID=Request.Cookies(cookies_name)("UserID")
username=sqlchkchar(Request.Cookies(cookies_name)("username"))
userpwd=Request.Cookies(cookies_name)("pwd")
weblevel=Request.Cookies(cookies_name)("weblevel")
Dim ChannelID,keywords
ChannelID=Request("ChannelID")
if ChannelID<>"" then Call IsNum(ChannelID)
keywords=Trim(Request("keywords"))
if keywords<>"" then call sqlchkchar(keywords)

Set rs=Server.Createobject("ADODB.Recordset")


Function Getclassname(classid,lang)
Dim scn,sqlstr
if lang=0 then sqlstr="select classname from cnk_ProductClass where classid="&classid
if lang=1 then sqlstr="select classname_en from cnk_ProductClass where classid="&classid
set scn=conn.execute(sqlstr)
Getclassname=scn(0)
set scn=nothing
End Function

'==userinfo==
Function GetWebLevelName(n)
Select Case n
Case 0 GetWebLevelName="普通会员"
Case 1 GetWebLevelName="VIP会员"
Case 2 GetWebLevelName="代理商"
Case 3 GetWebLevelName="高级代理"
End Select
End Function
'==userinfo End==

'==order==
Function OrderStateName(n)
Select Case n
Case 0 OrderStateName="已下订单，等待买家付款"
Case 1 OrderStateName="买家已经付款，等待卖家发货"
Case 2 OrderStateName="卖家已经发货，等待买家确认"
Case 3 OrderStateName="买家确认收到货，交易完成"
End Select
End Function
'==order End==

'==CONFIG==
Function GetIsStop(cid)
Dim rscon
set rscon=conn.execute("select isStop from cnk_Channel where ChannelID="&cid)
GetIsStop=rscon(0)
set rscon=nothing
End Function

Function GetChannelName(cid,l)
Dim rs
set rs=conn.execute("select ChannelName,ChannelName_en from cnk_Channel where ChannelID="&cid)
if not rs.eof then
	if l=0 then GetChannelName=rs(0)
	if l=1 then GetChannelName=rs(1)
else
	GetChannelName=""
end if
set rs=nothing
End Function

Function GetChannelPageSize(cid)
Dim rs
set rs=conn.execute("select PerPageSize from cnk_Channel where ChannelID="&cid)
GetChannelPageSize=rs(0)
set rs=nothing
End Function

Function GetDanwei(cid,l)
Dim rs
set rs=conn.execute("select ChannelItemName,ChannelItemName_en,ChannelItemUnit from cnk_Channel where ChannelID="&cid)
if l=0 then GetDanwei=rs(2)&rs(0)
if l=1 then GetDanwei=rs(1)
set rs=nothing
End Function

Function GetChannelDisplayType(cid)
Dim rs
set rs=conn.execute("select ListDisplayType from cnk_Channel where ChannelID="&cid)
GetChannelDisplayType=rs(0)
set rs=nothing
End Function

Sub UserChannelRight(uname,cid,lang)
 Dim rs,tsmsg
if lang=0 then tsmsg="对不起，您没有权限浏览" else tsmsg="Sorry,you can not browse this page"
set rs=conn.execute("select ChannelRight from cnk_Channel where ChannelID="&cid)
if rs(0)>0 then
if uname="" then Call alertmsg(tsmsg)
if rs(0)=2 and GetWebLevel(uname)<1 then Call alertmsg(tsmsg)
end if
End Sub
'==CONFIGend==

'==SYSTEM COMMON==
Sub msg(Str)
Response.Write("<script>alert('"&Str&"');</script>")
End Sub

Sub alertmsg(Str)
Response.Write("<script>alert('"&Str&"');history.go(-1);</script>")
Response.End()
End Sub

Sub alertmsgc(Str)
Response.Write("<script>alert('"&Str&"');window.close();</script>")
Response.End()
End Sub

Sub alertmsg_url(msg,url)
Response.Write("<script>alert('"&msg&"');window.location.href='"&url&"';</script>")
Response.End()
End Sub

Sub alertmsg_url_top(msg,url)
Response.Write("<script>alert('"&msg&"');top.location.href='"&url&"';</script>")
Response.End()
End Sub

Sub IsNum(id)
if Not IsNumeric(id) then
	alertmsg("非法的参数！")
	Response.End()
end if
End Sub

Function GetRealIP() 
Dim userip
userip = request.ServerVariables("HTTP_X_FORWARDED_FOR")
If userip = "" Then userip = request.ServerVariables("REMOTE_ADDR")
GetRealIP=userip
End Function

Function PartIP(ip)
dim oip  
oip=split(ip,".")   
PartIP=oip(0)&"."&oip(1)&"."&oip(2)&".***"   
End Function

'===格式:2007-08-02 08:36
Function zhuan_time(shijian)
Dim s_year,s_month,s_day,s_hour,s_minute
'shijian=DateAdd("h",ServerTimeDiff,shijian) '时差
s_year=year(shijian)
if len(s_year)=2 then s_year="20"&s_year
s_month=month(shijian)
if s_month<10 then s_month="0"&s_month
s_day=day(shijian)
if s_day<10 then s_day="0"&s_day
s_hour=hour(shijian)
if s_hour<10 then s_hour="0"&s_hour
s_minute=minute(shijian)
if s_minute<10 then s_minute="0"&s_minute
zhuan_time=s_year &"-"& s_month &"-"& s_day &"&nbsp;"& s_hour &":"& s_minute
End Function

'===格式:2007-08-02
Function zhuan_date(shijian)
Dim s_year,s_month,s_day
'shijian=DateAdd("h",ServerTimeDiff,shijian) 
s_year=year(shijian)
if len(s_year)=2 then s_year="20"&s_year
s_month=month(shijian)
if s_month<10 then s_month="0"&s_month
s_day=day(shijian)
if s_day<10 then s_day="0"&s_day
zhuan_date=s_year &"-"& s_month &"-"& s_day
End Function 

'===格式:200708
Function zhuan_month(shijian)
Dim s_year,s_month
'shijian=DateAdd("h",ServerTimeDiff,shijian) 
s_year=year(shijian)
if len(s_year)=2 then s_year="20"&s_year
s_month=month(shijian)
if s_month<10 then s_month="0"&s_month
zhuan_date=s_year & s_month
End Function 


'***翻页
Sub ShowPage(pcount,thispage,PagePara,Lang)
Dim str,str_en
str="第"&thispage&"/"&pcount&"页 "
str_en=thispage&"/"&pcount&" page "
if thispage<>1 then 
	str=str&"<a href="&PagePara&"&page_code=1>第一页</a> "
	str=str&"<a href="&PagePara&"&page_code="&(thispage-1)&">上一页</a> "
	str_en=str_en&"<a href="&PagePara&"&page_code=1>First</a> "
	str_en=str_en&"<a href="&PagePara&"&page_code="&(thispage-1)&">Previous</a> "	
end if
if thispage<>pcount then 
	str=str&" <a href="&PagePara&"&page_code="&(thispage+1)&">下一页</a>"
	str=str&" <a href="&PagePara&"&page_code="&pcount&">最后页</a>"
	str_en=str_en&" <a href="&PagePara&"&page_code="&(thispage+1)&">Next</a>"
	str_en=str_en&" <a href="&PagePara&"&page_code="&pcount&">Last</a>"	
end if
if Lang =0 then Response.Write(str)
if Lang =1 then Response.Write(str_en)
End Sub


'***显示页列表
Sub ShowPageList(pcount,thispage,link,Lang)
Dim str,str_en,j,startpage,endpage
str=""
str_en=""
if pcount<=10 then 
	str=str&"第 "
	str_en=str_en&" "
	for j=1 to pcount
		if thispage=j then
			str=str&"<span style=""color:#0000FF""><strong>"&j&"</strong></span> "
			str_en=str_en&"<span style=""color:#0000FF""><strong>"&j&"</strong></span> "
		else
			str=str&"<a href="&link&"&page_code="&j&">"&j&"</a> "
			str_en=str_en&"<a href="&link&"&page_code="&j&">"&j&"</a> "
		end if
	next
	str=str&"页"
	str_en=str_en&" Page"
else
	if thispage<=8 then
		str=str&"第 "
		str_en=str_en&" "
		for j=1 to 10
			if thispage=j then
				str=str&"<span style=""color:#0000FF""><strong>"&j&"</strong></span> "
				str_en=str_en&"<span style=""color:#0000FF""><strong>"&j&"</strong></span> "
			else
				str=str&"<a href="&link&"&page_code="&j&">"&j&"</a> "
				str_en=str_en&"<a href="&link&"&page_code="&j&">"&j&"</a> "
			end if
		next
		str=str&"...页"
		str_en=str_en&"...Page"
	end if
	if thispage>=9 then
		str=str&"第..."
		str_en=str_en&"..."
		startpage=thispage-5
		if startpage<1  then startpage=1
		endpage=thispage+5
		if endpage>pcount then endpage=pcount
		for j=startpage to endpage
			if thispage=j then
				str=str&"<span style=""color:#0000FF""><strong>"&j&"</strong></span> "
				str_en=str_en&"<span style=""color:#0000FF""><strong>"&j&"</strong></span> "
			else
				str=str&"<a href="&link&"&page_code="&j&">"&j&"</a> "
				str_en=str_en&"<a href="&link&"&page_code="&j&">"&j&"</a> "
			end if
		next
		if j<=pcount then
		str=str&"...页"
		str_en=str_en&"...Page"
	else
		str=str&"页"
		str_en=str_en&"Page"
	end if
end if
end if
if Lang =0 then Response.Write(str)
if Lang =1 then Response.Write(str_en)
End Sub

'***************************************************
'检查组件是否已经安装
'参  数: strClassString ----组件名
'返回值: True  ----已经安装  False ----没有安装
'***************************************************
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


Sub CheckUserLogin(uname)
	if uname="" then
 		Call alertmsg_url("您未登录，请登录！","../")
	else
		if GetGroupRight(24)<>1 then Call alertmsg_url("您没权限进入后台或登录超时！","../index.asp")
	end if
End Sub

Function GetCnkConfig(zd) 
Dim zdm
set zdm=conn.execute("select "&zd&" from cnk_config")
GetCnkConfig=zdm(0)
set zdm=nothing
End Function

'清除HTML，用正则表达式
Function clearHTMLCode(originCode) 
dim reg 
set reg = new RegExp 
reg.Pattern = "<[^>]*>" 
reg.Global = true 
clearHTMLCode = reg.Replace(originCode, "") 
End Function

'==SYSTEM COMMON END==

'==Admin==
Function ShowModuleName(id) 
select case id
case 0
	ShowModuleName="外部链接"
case 1
	ShowModuleName="单页内容模块"
case 2
	ShowModuleName="文章/新闻模块"
case 3
	ShowModuleName="产品/商品模块"
case 4
	ShowModuleName="图片模块"
case 5
	ShowModuleName="下载模块"
case 6
	ShowModuleName="留言模块"
case 7
	ShowModuleName="人才招聘模块"
case 8
	ShowModuleName="网点分布模块"
case 9
	ShowModuleName="友情链接模块"
case else
	ShowModuleName="其他模块"
end select
End Function

Sub CheckAdmin()
	if session("Admin")="" then Call alertmsg_url("超时，请重新登录！","index.asp")
End Sub

Sub foot()
	Response.Write"<div class=""cnkbox"">"&vbcrlf
	Response.Write"<div class=""content"" align=""center"">"&GetCnkConfig("VersionName")&" ("&GetCnkConfig("VersionNumber")&") , Copyright (c)  <a href=""http://www.cnetking.com"" target=""_blank"">www.cnetking.com</a>. All Rights Reserved .</div>"&vbcrlf
	Response.Write"</div>"&vbcrlf
	Response.Write"</body>"&vbcrlf
	Response.Write"</html>"&vbcrlf
End Sub
Sub Head()
	Response.Write "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN"" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"">"&vbcrlf
	Response.Write "<html xmlns=""http://www.w3.org/1999/xhtml"">"&vbcrlf
	Response.Write "<head>"&vbcrlf
	Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">"&vbcrlf
	Response.Write "<title>中网景网站系统</title>"&vbcrlf
	Response.Write "<meta name=""Author"" content=""www.cnetking.com"">"&vbcrlf
	Response.Write "<link href=""admin.css"" rel=""stylesheet"" type=""text/css"">"&vbcrlf
	Response.Write "<script language=""JavaScript"" type=""text/javascript"" src=""inc/cnkgl.js""></script>"&vbcrlf
	Response.Write "</head>"&vbcrlf
End Sub
'==Admin END==


'====安全区====

Sub ChkHackWord(fname)
	Dim MyFile,sFile,MyText,sTextAll,sStr,sNoString,dFile
	set MyFile = server.CreateObject ("Scripting.FileSystemObject")
	sFile = Server.MapPath(fname)  
	set MyText = MyFile.OpenTextFile (sFile,1) '读取文本文件
	sTextAll = lcase(MyText.ReadAll):MyText.close
	'判断用户文件中的危险操作
	sStr ="34|.getfolder|.createfolder|.deletefolder|.createdirectory|.deletedirectory|.saveas|wscript.shell|script.encode|script|execute|etucexe|encode|unencode|function|noitcnuf|response|esnopser|write|etirw|request|form|mrof|dim|html|lmth|const|server|createobject|mappath|servervariables|createtextfile|eval|lave|cmd|dmc"
	sNoString=split(sStr,"|")
	for i=1 to sNoString(0)
		if instr(sTextAll,sNoString(i))<>0 then
			Set dFile = MyFile.GetFile(sFile)
			dFile.Delete True '删除文件
			'Call RecordEvent("企图上传木马",Request.ServerVariables("SCRIPT_NAME"))
			Response.write "<span style=""font-size: 9pt"">警告: 不要上传马马，已记录你的操作，如继续攻击，后果自负![ <a href=# onclick=history.go(-1)>重新上传</a> ]</span>"
			Response.end
		end if
	next
End Sub

'禁从站外进入
Sub DisableOutSite()
    Dim server_v1,server_v2
	server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
    server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
    if mid(server_v1,8,len(server_v2))<>server_v2 then alertmsg("你提交的路径有误，禁止从站点外部提交数据！你的所有操作已经被记录，如果您企图攻击网站，将受法律严惩!!")
    if instr(request.servervariables("http_referer"),"http://"&request.servervariables("host") )<1 then alertmsg("你提交的路径有误，禁止从站点外部提交数据！你的所有操作已经被记录，如果您企图攻击网站，将受法律严惩!!!")
End Sub

Sub CnkAdminRight(n) 
Dim qx,theitem,isok,qxlist
set qx=conn.execute("select AdminRight from [cnk_Admin] where AdminName='"&session("admin")&"'")
isok=0
qxlist=qx(0)
if not isnull(qxlist) then
	qx=Split(qxlist, ",")
	for each theitem in qx
		if cint(theitem)=cint(n) then
			isok=1
			exit for
		end if
	next
end if
If isok=0 Then
	Call alertmsg("您没有管理本页面的权限!")
End If
set qx=nothing
End Sub

Function sqlchkchar(Str)
Str=Replace(Str," ","")
Str=Replace(Str,"%20","")
Str=Replace(Str,"request","")
sqlchkchar=Str
End Function
'====安全区END====
%>