<%
' +----------------------------------------------------------------------
' | KCMS [ 启点在线网站管理系统 ]
' | Copyright (c) 2018 http://www.kelvinvt.com All rights reserved.
' | Licensed ( http://www.kelvinvt.com )
' | Author: kelvinvt <kelvinvt@qq.com>
' +----------------------------------------------------------------------
dim conn : set conn=new DBClass
Class DBClass
	public dbConn,dbRs,isConnect,fetchCount
	private connStr,vqueryCount,dbType
	private errid,errdes
	Private Sub Class_Initialize
		isConnect=false
		vqueryCount=0
		fetchCount=0
	End Sub	
	Public Property Get err_id
		err_id=errid
	End Property
	Public Property Get err_des
		err_des=errdes
	End Property	
	Public Property Get queryCount
		queryCount=vqueryCount
	End Property

	Public Sub connect()
		on error resume next
		if dbType="1" then
			connstr="Provider=Sqloledb;User ID="&dataUser&";Password="&datapass&";Initial CataLog="&dataName&";Data Source="&dataServer&iif(isnul(dbPort),"",","&dbPort)&";"
		elseif dbType="0" then
			if isnul(dbPass) then
				ConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source="& server.mappath(sitePath&dbPath&dbfile)
			else
				ConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source="& Server.MapPath(sitePath&dbPath&dbfile) &";Jet OLEDB:Database Password="& dbPass&";"
			end if
		end if
		if isObject(dbConn)=false or isConnect=false then
			On Error Resume Next
			set dbConn=server.CreateObject("ADODB.connection")
			dbConn.open connStr
			isConnect=true
			if Err then
			if not isfile(sitePath&dbPath&dbfile) then gotoerr 500,"数据库地址错误","1.请确认路径是否正确<br>2.请修改config/cms_config.asp配置信息",errdes
			errid=Err.number:errdes=Err.description:Err.Clear:dbConn.close:set dbConn=nothing:isConnect=false
			gotoerr errid,"数据库连接失败","<a href='http://www.kelvinvt.com' target='_blank'>1.检查是否启用32位应用程序。</a><br><a href='http://www.kelvinvt.com' target='_blank'>2.检查数据库文件夹权限。</a>",errdes
			end if
		end if	
	End Sub

	Function exec(byval sqlStr,byval sqlType)	
		on error resume next
		if not isConnect=true then connect
		If Not showsql Then On Error Resume Next		
		set exec=server.CreateObject("adodb.recordset")
		if isnul(sqlStr) then exit function
		If showsql Then echop sqlStr &"<hr>"
		sqlStr=replacestr(sqlStr,"[dbpre]",dbpre)
		select case sqlType
			case "exe"	
				set Exec=dbConn.execute(sqlStr)
				if Err then		
			        errid=Err.number:errdes=Err.description
					dbConn.close:set dbConn=nothing:isConnect=false
			    end if
			case "r1"
				exec.open sqlStr,dbConn,1,1
			case "r3"
				exec.open sqlStr,dbConn,3,3
			csae "openschema"
				exec.OpenSchema(16)
			case "arr"
				exec.open sqlStr,dbConn,1,1				
				if not exec.eof then
					if fetchCount=0 then  exec=exec.getRows() else exec=exec.getRows(fetchCount)
				end if
		end select
		vqueryCount=vqueryCount+1
		
	End Function

	Public Sub Class_Terminate()
		on error resume next
		if isObject(dbRs) then set dbRs=nothing
		if isConnect then dbConn.close:set dbConn=nothing:isConnect=false
	End Sub
End Class

	'后台执行sql，并记录
	Function dbconn(ByVal sql)
		on error resume next
		dim logstr,userid
		logstr=encode(sql)
		Set dbconn =conn.exec(sql,"exe")
		if err then	die "<h2>执行SQL出现错误</h2><br>"&conn.err_id&conn.err_des&"<br>出错sql语句如下:<br>"&sql
		if logSql=1 then 		
		  dbsql "insert into [dbpre]log_dbsql(Lid,userid,username,ip,addtime,Ldesc,content)values("&zset.LID&",0,'"&getcookie("adminname")&"','"&getip()&"','"&sqltime&"','"&err.description&"...','"&logstr&"')"
		end if		
	End Function
	
	'执行sql
	Function dbsql(ByVal sql)
		on error resume next
		Set dbsql =conn.exec(sql,"exe")
		if err then	die "<h2>执行SQL出现错误</h2><br>"&conn.err_id&conn.err_des&"<br>出错sql语句如下:<br>"&sql
	End Function

	'执行
	function dbsqlr1(byval sql)
		on error resume next		
		Set dbsqlr1 =conn.exec(sql,"r1")
	end function
	
	function dbsqlone(byval sql)
  		on error resume next
		dbsqlone =conn.exec(sql,"exe")(0)
		if err then dbsqlone=0
	end function
	
  function dbselect(byval table,byval colstr,byval wherestr)
  		on error resume next
		if len(wherestr)>0 then wherestr=" where "&wherestr
		 dbselect=conn.exec("select "&colstr&" from "&table&" "&wherestr&"","exe")(0)
		if err then dbselect=""			
	end function
	
	public function dbload(byval table,byval colstr,byval num,byval wherestr,byval orderstr)
		if len(num)>0 then num=" top "&num
		if len(colstr)=0 then colstr=" * "
		if len(wherestr)>0 then wherestr=" where "&wherestr
		if left(lcase(orderstr),3)="rnd" then
			if datatype then
				randomize
				dim orderid
				if len(orderstr)>4 then orderid=right(orderstr,len(orderstr)-4)
				if len(orderid)=0 then orderid="id"
				orderstr="rnd(-("&orderid&" +"&rnd()&"))"
			else
				orderstr="newid()"
			end if
		end if
		if len(orderstr)>0 then orderstr=" order by "&orderstr
		if colstr<>" * " then
			dim str:str=""
			dim arr:arr=split(colstr,",")
			dim i
			for i=0 to ubound(arr)
				if i>0 then str=str&","
				if instr(arr(i),"(")>0 or instr(arr(i),")")>0 or instr(arr(i)," ")>0 or instr(arr(i),".")>0 then
					str=str&arr(i)
				else
					str=str&"["&arr(i)&"]"
				end if
			next
			colstr=str
		end if
		dim rs :	set rs=conn.exec("select "&num&" "&colstr&" from "&table&" "&wherestr&" "&orderstr,"r1")	
		if err then echop "select "&num&" "&colstr&" from "&table&" "&wherestr&" "&orderstr
		if rs.eof then
			dbload=array()
		else
			dbload=rs.getrows()
		end if
		rs.close
		set rs=nothing
	end function
	
	function dbdel(byval table,byval wherestr)
		on error resume next
		dim sql
		sql="delete from "&table
		if len(wherestr)>0 then sql=sql&" where "&wherestr
		dbsql(sql)
	end function
	
	function dbcount(byval table,byval wherestr)
		on error resume next
		dim sql
		sql="select count(1) from "&table
		if len(wherestr)>0 then sql=sql&" where "&wherestr
		'echo sql
		dbcount=dbsql(sql)(0)
	end function
	
	function dbmaxid(byval table,byval colstr)
		on error resume next
		dbmaxid=dbsql("select max("&colstr&") from "&table&"")(0)
	end function
	
	function dbmaxidby(byval table,byval colstr,byval wherestr)
		on error resume next
		if len(wherestr)>0 then wherestr=" where "&wherestr
		dbmaxidby=dbsql("select max("&colstr&") from "&table&" "&wherestr&"")(0)
	end function
		
	'表是否存在(返回true或false)
	public function isTablein(byval table)
		on error resume next
		dim rs
		set rs=conn.exec("SELECT 1 FROM ["& table &"]","r1")			
		if err then
			isTablein = false			
		else 
			isTablein=true
		end if	
		closeRs rs	
	end function
	
		'字段是否存在(返回true或false)
	public function isColin(byval table, byval f)
		dim i,rs,result : result = false
		set rs = dbsqlr1("SELECT * FROM ["& table &"]")
		for i=0 to rs.fields.count-1 
			if lcase(rs.fields(i).name) = lcase(f) then
				result = true
				exit for
			end if
		next
		closeRs rs
		isColin = result
	end function
	
	public sub closeRs(ByRef rs)
		if isObject(rs) then
			on error resume next
			rs.close
			set rs = nothing
			err.clear
			on error goto 0
		end if
	end sub
	
	
'获取当前类下所有子类 sorttype 1带父级，0所有最小类
	Function getSortid(sortID, sorttype)
	  if ifnum(isnum(sortid)) then		  
		if sorttype=0 then '获取顶级分类id
			if 	sortid=0 then 
				getSortid=0
			else
				getSortid=dbselect("cms_sort","S_tid","S_tid="&sortID&"")
			end if
		elseif sorttype=1 then '获取上级分类id
			if 	sortid=0 then 
				getSortid=0
			else
				getSortid=dbselect("cms_sort","S_PID","S_PID="&sortID&"")
			end if
		elseif sorttype=3 then '获取下级所有分类id，输出数组
			dim rs:	set rs=dbsql("select (select count(*) from [dbpre]Sort where S_PID="&sortID&"), SID from [dbpre]Sort where S_PID="&sortID)
			if rs.eof then 
				getSortid=sortID&","
			else
				getSortid=sortID&","
				do while not rs.eof 
				getSortid=getSortid&getSortid(rs("SID"), 3)
				rs.movenext
				loop
			end if	
		 end if	
	 end if	
	End Function
	
	Function getOption(sql,this)
	dim rs,sel
	set rs=conn.Exec(sql,"r1")
		Do While Not rs.Eof	
			IF CSTR(this)=CSTR(rs(0)) Then sel = "selected=""selected""" else sel="" end if
			dim rscount:rscount=0		
				echo "<option value="""& rs(0) &""" "&sel&">"&rs(1)&"</option>" & vbcr				
			rs.MoveNext
		Loop
		Closers rs
	end Function
	
	Function getsortOption(pid,thisid,stype,nopid)
	  on error resume next
	  Dim rs,sql,sortType,sel,nopidstr	
	  if not isnul(nopid) then nopidstr=" and S_PID not in("&nopid&") "
	  sql= "select SID,s_name,s_PID,S_Level,(select count(0) from [dbpre]Sort where S_PID=t.SID "&nopidstr&") as c,S_type from [dbpre]Sort as t where  S_PID="&pid&sortType	
	  set rs =dbsql(sql)
	  Do While Not rs.Eof
	  	  sel="" 
		  if rs(5)<>stype and stype<>"" Then sel = "disabled=""disabled"""
		  IF thisid>0 and cint(thisid)=cint(rs(0)) Then sel = "selected=""selected"""
		  if nopid<>"" and ifstrin(","&nopid&",",","&rs(0)&",")  Then sel = "disabled=""disabled"""
		  if not isnul(stype) then 
		  	if stype=rs(5) then  
				echo "<option value="""&rs(0)&""" "&sel&">"&getLevel(rs(3))&rs(1) &"</option>"&vbcrlf
			end if
		  else
		    echo "<option value="""&rs(0)&""" "&sel&">"&getLevel(rs(3))&rs(1) &"</option>"&vbcrlf
		  end if
		    if rs(4)>0 then
			 getsortOption rs(0),thisid,stype,nopid
		   end if
	  rs.MoveNext
	  Loop
	End Function	
	
	function getLevel(num)
		if not ifnum(num) then  exit Function
		dim i
		getLevel=""
		for i=2 to num
			getLevel=getLevel&"　"
		next
		if num<>"1" then getLevel=getLevel&"└"	
	end function
	
	function getLevel_(num)
		if not ifnum(num) then  exit Function
		dim i
		getLevel_=""
		for i=2 to num
			getLevel_=getLevel_&"┃"
		next
		if num<>"1" then getLevel_=getLevel_&"┝"	
	end function
	
	function getGroupOption(gid,isadmin)		
		dim rs,selected,Groupoption
		if isadmin=1 then
		sql="select GID,G_Name from [dbpre]User_Group where G_OnOff=1 and IsAdmin=1  and G_Mark<="&getsession("adminmark")&" and G_Mark>0 order by G_Order asc,GID desc"
		elseif isadmin=2 then
		sql="select GID,G_Name from [dbpre]User_Group where G_OnOff=1 and IsAdmin=0  and G_Mark>0 order by G_Order asc,GID desc"
		elseif isadmin=0 then
		sql="select GID,G_Name from [dbpre]User_Group where G_OnOff=1 and IsAdmin=0  order by G_Order asc,GID desc"
		end if
		set rs=dbsql(sql)			
		do while not rs.eof
			if rs("GID")=isnum(gid) then selected="selected" else selected=""
			Groupoption=Groupoption&"<option value='"&rs("GID")&"' "&selected&">"&rs("G_Name")&"</option>"		
			rs.movenext
		Loop	 
	  closers rs
	  getGroupOption=Groupoption
	end function
	
	Function groupMenuChecked(col, val)	
		dim i, menus
		groupMenuChecked=""
		if col="all" then 
			groupMenuChecked="checked=""checked"""
		elseif not isnul(col) then	
			menus=split(col, ",")
			for i=0 to ubound(menus)
	
				if  cstr(trim(menus(i)))=cstr(trim(val)) then groupMenuChecked="checked=""checked""" : exit for
			next 
		end if
	End Function

		'获取导航栏链接
	Function getSortLink(sortType, SID, sortUrl,iswap,page)	
		sortUrl=replacestr(repnul(sortUrl), "{path}", sitePath)
		dim abouturl,listurl	
		if iswap=1 then 
			listurl=sitePath&"wap/?"&sortType&"/"
		else
			if isnul(sortUrl) or page>1 then
			 select case sortType
				case "about" : 	listurl=sitePath&"about/"&linkmark&Sid&"_"&page&siteExt	
				case "brand" : 	listurl=sitePath&"brandlist/"&linkmark&Sid&"_"&page&siteExt			
				case else	:	listurl=sitePath&"list/"&linkmark&Sid&"_"&page&siteExt
			  end select
			else
				if sortType="links" then
					listurl=sortUrl
				else
					if runMode=1 then sortUrl=sitePath&"go/?"&sortUrl else  sortUrl=sitePath&linkmark&sortUrl
					listurl=sortUrl
				end if
			end if
			getSortLink=listurl
		end if		
	End Function
	
	Function getContentLink(sid,Id,outlink,pageFileName,SortType,iswap)	
		on error resume next		
		dim contenturl
		contenturl=sitePath&SortType&"/"&linkmark
		dim linkStr,rs
		if not isnul(outlink) then
			getContentLink=outlink
		elseif not isnul(PageFileName) then
			getContentLink=contenturl&PageFileName&siteExt
		else
			getContentLink=contenturl&sid&"_"&Id&siteExt
		end if
	End Function
	
	sub errlog(byval strs,byval t1)
		if strs="" then exit sub
		dim userid,username
		userid=getsession("adminid")
		if isnul(userid) then
			userid=getsession("uid")	:	if isnul(userid) then userid=0
			username=getsession("username")
		else
			username=getsession("adminName") 
		end if
		 conn.exec "insert into [dbpre]log_err (userid,username,ip,addtime,content)values("&userid&",'"&username&"','"&getip()&"','"&sqltime&"','"&enhtml(strs)&"')","exe"
		if t1=0 then goto404 "注入威胁，已记录。" else die strs
	end sub
		  
	  '防止注入
	  dim qs,errc,iii
	  qs=request.servervariables("query_string")
	  'response.write(qs)
	  dim deStr(19)
	  deStr(0)="net user"
	  deStr(1)="xp_cmdshell"
	  deStr(2)="/add"
	  deStr(3)="exec%20master.dbo.xp_cmdshell"
	  deStr(4)="net localgroup administrators"
	  deStr(5)="select"
	  deStr(6)="count"
	  deStr(8)="char"
	  deStr(9)="mid"
	  deStr(10)="'"
	  deStr(11)=":"
	  deStr(12)=""""
	  deStr(13)="insert"
	  deStr(14)="delete"
	  deStr(15)="drop"
	  deStr(16)="truncate"
	  deStr(17)="execute"
	  deStr(18)="request"
	  deStr(19)="eval"
	  errc=false
	  for iii= 0 to ubound(deStr)
	  if instr(qs,deStr(iii))<>0 and not isnul(deStr(iii)) then
	  	errc=true
	  	errlog "试图注入："&qs&"<br>函数："&deStr(iii),0		
	  end if
	  next
%>