cl_clssystem.asp

淘客网上商店网站程序 淘客网上商店网站程序 淘客网上商店网站程序

		Dim winnt_chinese
		winnt_chinese=(Len("例子")=2)
		If winnt_chinese Then
			Dim l,t,c,i
			l=len(str):t=l
			For i=1 To l
				c=asc(mid(str,i,1))
				If c<0 Then c=c+65536
				If c>255 Then t=t+1
			Next
			strLength=t
		Else
			strLength=Len(str)
		End If
	End Function
	Public Function Checkstr(Byval Str)
		If Isnull(Str) Then
			CheckStr = "" : Exit Function 
		End If
		Str = Replace(Str,Chr(0),"")
		CheckStr = Trim(Replace(Str,"'","''"))
	End Function
	'截字符串，汉字一个算两个字符，英文算一个字符（str）原字符串 （strlen）截取长度
	Public Function GotTopic(Byval str,Byval strlen)
		Dim l, t, c, i
		if str="" Or Not IsNumeric(strlen) then gotTopic=str : Exit function
		str	= Replace(Replace(str,"&nbsp;"," "),"&quot;",Chr(34))
		str	= Replace(Replace(str,"&gt;",">"),"&lt;","<")
		l	= Len(str) : t = 0 : strlen	= Clng(strlen)
		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
				'if Abs(Asc(right(str,1)))>255 then
				gotTopic=Left(str,i) & "..."
				Exit For
			else
				gotTopic=str
			end if
		next
	End Function
	Public Function FormatNum(Byval num,Byval n)
		If Not IsNumeric(num) or num="" Then num=0
		If num<1 and num>0 Then
			FormatNum = "0" & FormatNumber(num,n)
		Else
			FormatNum = FormatNumber(num,n)
		End If
	End Function
	'时间格式处理
	Public Function Format_Time(Byval Tvar,Byval sType)
		dim Tt,sYear,sMonth,sDay,sHour,sMinute,sSecond
		If Not IsDate(Tvar) or sType=0 Then Format_Time = "" : Exit Function
		Tt			= Tvar
		sYear		= Year(Tt)
		sMonth		= Right("0" & Month(Tt),2)
		sDay		= Right("0" & Day(Tt),2)
		sHour		= Right("0" & Hour(Tt),2)
		sMinute		= Right("0" & Minute(Tt),2)
		sSecond		= Right("0" & Second(Tt),2)
		Select Case sType
		Case 1	'2005-10-01 23:45:45
			Format_Time = sYear & "-" & sMonth & "-" & sDay & " " & sHour & ":" & sMinute & ":" & sSecond
		Case 2	'年-月-日 时:分:秒
			Format_Time = sYear & "年" & sMonth & "月" & sDay & "日 " & sHour & "时" & sMinute & "分" & sSecond & "秒"
		Case 3	'2005-10-01
			Format_Time = sYear & "-" & sMonth & "-" & sDay
		Case 4	'2005\10\01
			Format_Time = sYear & "\" & sMonth & "\" & sDay
		Case 5	'10-01 23:45
			Format_Time = sMonth & "-" & sDay & " " & sHour & ":" & sMinute
		Case 6	'2005年10月01日
			Format_Time = sYear & "年" & sMonth & "月" & sDay & "日"
		Case 7	'10-01
			Format_Time = sMonth & "-" & sDay
		Case 8	'20051001234545
			Format_Time = sYear & sMonth & sDay & sHour & sMinute & sSecond
		Case Else
			Format_Time = Tt
		End Select
	End Function

	Public Function GetTitleFont(Byval sValue,Byval sType)
		Select Case GetClng(sType)
		Case 0 : GetTitleFont = sValue
		Case 1 : GetTitleFont = "<strong>" & sValue & "</strong>"
		Case 2 : GetTitleFont = "<em>" & sValue & "</em>"
		Case 3 : GetTitleFont = "<strong><em>" & sValue & "</em></strong>"
		Case 4 : GetTitleFont = "<u>" & sValue & "</u>"
		Case 5 : GetTitleFont = "<strong><u>" & sValue & "</u></strong>"
		Case 6 : GetTitleFont = "<em><u>" & sValue & "</u></em>"
		Case 7 : GetTitleFont = "<strong><em><u>" & sValue & "</u></em></strong>"
		Case Else : GetTitleFont = sValue
		End Select
	End Function

	Public Function FormatColor(Byval sValue,Byval sColor)
		sColor=Trim(sColor)
		if IsNull(sColor) or sColor="" Then FormatColor=sValue : Exit Function
		FormatColor = "<span style=""color:"& sColor &";"">" & sValue & "</span>"
	End Function

	'写入客人session
	Public Sub LetGuestSession()
		Dim statID,GuestSID,i
		GuestSID = checkStr(Trim(Request.Cookies(Web_Cookies)("GuestSID")))
		If Not IsNumeric(GuestSID) or GuestSID = "" Then
			statID = Split(UserTrueIP,".")
			GuestSID = ""
			for i=0 to Ubound(statID)
				GuestSID=GuestSID&right("00"&statID(i),3)
			next
			randomize
			GuestSID=GuestSID&int(600*rnd+369)
			If Not IsNumeric(GuestSID) Then GuestSID = int(10089657999*rnd+25789657939)
			'GuestSID = Ccur(GuestSID) & int(600*rnd+369) '随机验证码
			Response.Cookies(Web_Cookies).Expires=DateAdd("s",3600,Now())
			Response.Cookies(Web_Cookies)("GuestSID") = GuestSID
		End If
		GuestSID = Ccur(GuestSID)
		'客人=SessionID+活动时间+IP
		GuestSID = GuestSID & "_" & Now & "_" & Now & "_" & ScriptName
		User_Info=Split(GuestSID,"_")
		Session(CacheName & "UserID") = User_Info
	End Sub 
	'检查用户是否登录
	Public Function ChkUserLogin()
		Dim NeedToUpdate,ToUpdate,sUserMsg
		ChkUserLogin=False
		if UserID=0 Or UserGroupID=5 or MemberName="" or MemberWord="" then
			UserGroupID=5 : UserID=0
			If Not IsArray(Session(CacheName & "UserID")) Then Call LetGuestSession()
			Exit Function
		end if
		ToUpdate=False
		Name="NeedToUpdate"
		If Not ObjIsEmpty() Then 
			NeedToUpdate=","&Value&","
			If InStr(NeedToUpdate,","&MemberName&",")>0 Then
				Call NeedUpdateList(MemberName,0)
				ToUpdate=True
			End If
		End If
		If Not IsArray(Session(CacheName & "UserID")) or Toupdate Then
			GetCacheUserInfo
			if Ubound(User_Info)<22 then Exit Function
		else
			User_Info = Session(CacheName & "UserID")
			if Ubound(User_Info)<22 then
				GetCacheUserInfo
				if Ubound(User_Info)<22 then Exit Function
			end if
		end If
		UserID	 = Clng(User_Info(4))
		MemberName = Trim(User_Info(5))
		UserGroupID = Clng(User_Info(14))
		Set User_Group = Application(CacheName & "_usergrouplist").DocumentElement.SelectSingleNode("usergroup[@id="&UserGroupID&"]")
		User_Purview= Split(User_Group.SelectSingleNode("@purview").text,",")
		'groupname,groupimg,loginpoint,purview,purview_other,arrclassview,arrclassinput,arrclasscheck=38,arrclassmaster
		sUserMsg	= Split(User_Info(20),"||")
		If Ubound(sUserMsg)=2 Then
			SendMsgNum	= sUserMsg(0)
			SendMsgID	= sUserMsg(1)
			SendMsgUser	= sUserMsg(2)
		End If
		ChkUserLogin=True
	End Function

	Public Sub GetCacheUserInfo()
		dim RsLogin,SqlLogin,RsGroup,sUserInfo,sValidDays,i
		SqlLogin="Select " & Db.UserID & "," & Db.UserName & "," & Db.UserPassWord & "," & Db.UserEmail & "," & Db.UserSex & "," & Db.UserJoinDate & "," & Db.UserLastLogin & "," & Db.UserLogins & "," & Db.UserLastIP & "," & Db.DataCount & "," & Db.UserGroupID & "," & Db.UserPoint & "," & Db.UserMoney & "," & Db.ChargeType & "," & Db.BeginDate & "," & Db.ValidNum & "," & Db.UserMsg & "," & Db.UserLock & " From " & Db.UserTable & " where " & Db.UserID & "=" & UserID
		Set RsLogin = Execute_U(sqlLogin)
		if RsLogin.Bof and RsLogin.Eof then
			UserGroupID=5 : UserID=0 : EmptyCookies : LetGuestSession
			RsLogin.Close : Set RsLogin = Nothing : Exit Sub
		else
			if UserGroupID<>rsLogin(10) or RsLogin(17)<>0 or MemberWord<>rsLogin(2) then
				UserGroupID=5 : UserID=0 : EmptyCookies : LetGuestSession
				RsLogin.Close : Set RsLogin = Nothing : Exit Sub
			end if
			sValidDays	= rsLogin(15)-DateDiff("D",RsLogin(14),Now())
			if sValidDays<0 then sValidDays=0
			sUserInfo	= "ClCMS@@@"& FormatDateTime(Now(),0) & "@@@" & FormatDateTime(Now(),0) & "@@@" & ScriptName
			For i=0 to 17
			sUserInfo	= sUserInfo & "@@@" & RsLogin(i)
			Next
			sUserInfo	= sUserInfo & "@@@" & sValidDays & "@@@ClCMS"
			User_Info	= Split(sUserInfo,"@@@")
			Session(CacheName & "UserID") = User_Info
		End if
		RsLogin.Close : Set RsLogin = Nothing
	End Sub
	Public Function NewIncept(sName)
		NewIncept=Execute_U("Select Count(id) From " & Db.MessageTable & " Where incept='"&CheckStr(sName)&"' and flag=0 and delR=0 and issend=1")(0)
		if Isnull(NewIncept) or Not IsNumeric(NewIncept) then NewIncept=0
	End function
	'更新用户短信通知信息（新短信条数||新短讯ID||发信人名）
	Public Sub Update_UserMsg(sName)
		Dim msginfo,sNewIncept,UP_UserInfo
		sNewIncept=NewIncept(sName)
		If sNewIncept>0 Then
			msginfo=sNewIncept & "||" & InceptID(1,sName) & "||" & InceptID(2,sName)
		Else
			msginfo="0||0||null"
		End If
		Execute_U("Update " & Db.UserTable & " Set " & Db.UserMsg & "='"&CheckStr(msginfo)&"' Where " & Db.UserName & "='"&CheckStr(sName)&"'")
		If Lcase(sName)=Lcase(MemberName) Then
			UP_UserInfo = Session(CacheName & "UserID")
			UP_UserInfo(20) = msginfo
			Session(CacheName & "UserID") = UP_UserInfo
		Else
			Call NeedUpdateList(sName,1)
		End If
	End Sub
	Public Function InceptID(stype,iusername)
		Dim Rs
		Set Rs=Execute_U("Select top 1 id,sender From " & Db.MessageTable & " Where incept='"&CheckStr(iusername)&"' and flag=0 and delR=0 and issend=1")
		If not rs.eof Then
			If stype=1 Then
				InceptID=Rs(0)
			Else
				InceptID=Rs(1)
			End If
		Else
			If stype=1 Then
				InceptID=0
			Else
				InceptID="null"
			End If
		End If
		Rs.Close : Set Rs=Nothing
	End Function
	'检查管理员是否登录
	Public Function ChkAdminLogin()
		ChkAdminLogin=False
		if Not ChkUserLogin then Exit Function
		'Admin_Info = Session(CacheName & "AdminInfo")
		'if Not IsArray(Admin_Info) then
			Dim AdminName,AdminPass,AddUser,rsGetAdmin
			AdminName	= Trim(session("AdminName"))
			AdminPass	= Trim(session("AdminPass"))
			AddUser		= Trim(MemberName)
			if AdminName="" or AdminPass="" or AddUser="" then Exit Function
			'0(ID),1(用户),2(密码),3(权限),4(前台用户) 
			Set rsGetAdmin=Execute("select ID,UserName,Password,Purview,Purview_Other,arrClassMaster,arrClassCheck,arrClassInput,AddUser from Cl_Admin where UserName='" & Checkstr(AdminName) & "' And AddUser='"&Checkstr(AddUser)&"'")
			if rsGetAdmin.bof and rsGetAdmin.eof then
				Set rsGetAdmin=Nothing : Exit Function
			ElseIf rsGetAdmin(2) <> AdminPass then
				Set rsGetAdmin=Nothing : Exit Function
			End if
			Admin_Info = Split(rsGetAdmin.GetString(,1, "@@","",""),"@@")
			Set rsGetAdmin = Nothing
		'	Session(CacheName & "AdminInfo") = Admin_Info
		'ElseIF Ubound(Admin_Info)<8 then
		'	Session(CacheName & "AdminInfo") = Empty
		'	ChkAdminLogin = False : Exit Function
		'End if
		Admin_Purview		= Split(Admin_Info(3),",")
		ChkAdminLogin		= True
	End Function
	Public Function ChkSchoolUser()
		Dim rs_IP, sqlIP
		Dim C_sValidDays
		ChkSchoolUser=False
		set rs_IP = Execute("select PassIP,PassName,Purview,arrClassID,BeginDate,UseDayNum,IsClose,IsLogin from [Cl_PassIP] Where PassIP='"&UserTrueIP&"'")
		if rs_IP.Bof and rs_IP.Eof then
			rs_IP.close:set rs_IP=nothing : Exit Function
		end if
		C_sValidDays=Clng(rs_IP(5) - datediff("d",rs_IP(4),now))
		if C_sValidDays <= 0 then
			C_sValidDays = 0
			if rs_IP(6)=False then Execute("Update Cl_PassIP Set IsClose="&TrueType&" Where PassIP='"&UserTrueIP&"'")
		end if
		SchoolUser_Info=Array(rs_IP(0),rs_IP(1),rs_IP(2),rs_IP(3)&"",rs_IP(4),rs_IP(5),rs_IP(6),rs_IP(7),C_sValidDays)
		rs_IP.close : set rs_IP=nothing
		ChkSchoolUser=True
	End Function
	Public Function IsTrueSchoolUser(Byval sClassID)
		Dim rs_IP, sqlIP
		Dim sPurview, sarrClassID, sBeginDate, sUseDayNum, sIsClose, sIsLogin
		Dim C_sValidDays
		IsTrueSchoolUser=False
		set rs_IP = Execute("select PassIP,PassName,Purview,arrClassID,BeginDate,UseDayNum,IsClose,IsLogin from [Cl_PassIP] Where PassIP='"&UserTrueIP&"'")
		if rs_IP.Bof and rs_IP.Eof then
			rs_IP.close:set rs_IP=nothing : Exit Function
		end if
		sPurview	= rs_IP(2) : sarrClassID = rs_IP(3)
		sBeginDate	= rs_IP(4) : sUseDayNum  = rs_IP(5)
		sIsClose	= rs_IP(6) : sIsLogin	 = rs_IP(7)
		rs_IP.close : set rs_IP=nothing
		if sIsClose=True then Exit Function
		if sIsLogin=True and UserID=0 then Exit Function
		C_sValidDays=Clng(sUseDayNum - datediff("d",sBeginDate,Now()))
		if C_sValidDays <= 0 then
			Execute("Update Cl_PassIP Set IsClose="&TrueType&" Where PassIP='"&UserTrueIP&"'")
			Exit Function
		end if
		if sPurview=1 then
			IsTrueSchoolUser=True
		else
			Dim Prs,sPPath,n
			Set Prs=Execute("Select ParentPath From Cl_Class Where ClassID=" & Clng(sClassID))