nc_mailcls.asp

大型黄页系统,精美黄页flash演示,10m

<%
Class DownloadClass_Cls
	Public membername, memberpass, membergrade, membertype, memberid
	Public DownLoad_sn, Version, Setting, StopReadme, Badwords, Badwordr
	Public tempid, System_ver, SetupDir, LockipList,Register_Key,Register_Code
	Public CacheName, Reloadtime, CacheData, Temp_Data
	Public SqlQueryNum, GetUserip, GetSetupDir, ScriptName
	Public TempName, TempDir, Style_CSS, skinid, Admin_Page, Unlock_Page
	Private LocalCacheName,CaCheInfo, Cache_Data, Cookiesid, Conn
	Public mainhtml, mainset, temphtml, tempset
	Public Copyright, Script_FSO, startime, Founderr, NowTime
	Public SqlString, SortingMenu, ClassMenu, SystemEdition, IsBusiness,isSqlDataBase
	Private Sub Class_Initialize()
		startime = Timer()
		SqlQueryNum = 0
		Reloadtime = 14400
		Founderr = False
		DownLoad_sn = Replace(LCase(Replace(Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL"), Split(Request.ServerVariables("SCRIPT_NAME"), "/")(UBound(Split(Request.ServerVariables("SCRIPT_NAME"), "/"))), "")), "admin/", "")
		CacheName = Replace(Replace(Replace(Replace(LCase(Server.MapPath("index.asp")), "index.asp", ""), ":", ""), "\", ""), "admin", "")
		GetSetupDir = Replace(Left(LCase(Request.ServerVariables("SCRIPT_NAME")), InStrRev(LCase(Request.ServerVariables("SCRIPT_NAME")), "/")),"admin/","")
		GetUserip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
		If Len(GetUserip) = 0 Then GetUserip = Request.ServerVariables("REMOTE_ADDR")
		GetUserip = checkStr(GetUserip)
		membername = checkStr(Request.Cookies(DownLoad_sn)("username"))
		memberpass = checkStr(Request.Cookies(DownLoad_sn)("password"))
		membergrade = checkStr(Request.Cookies(DownLoad_sn)("grade"))
		membertype = checkStr(Request.Cookies(DownLoad_sn)("usertype"))
		memberid = Request.Cookies(DownLoad_sn)("userid")
		Dim tmpstr, i
		tmpstr = Request.ServerVariables("PATH_INFO")
		tmpstr = Split(tmpstr, "/")
		i = UBound(tmpstr)
		ScriptName = LCase(tmpstr(i))
		Admin_Page = False
		If InStr(ScriptName, "showerr") > 0 Or InStr(ScriptName, "login") > 0 Or InStr(ScriptName, "admin_") > 0 Or InStr(ScriptName, "Create_") > 0 Then Admin_Page = True
		Unlock_Page = False
		If InStr(ScriptName, "showerr") > 0 Or InStr(ScriptName, "login") > 0 Or InStr(ScriptName, "Create_") > 0 Or InStr(ScriptName, "admin_index") > 0 Or InStr(ScriptName, "admin_lockip") > 0 Then Unlock_Page = True
		IsBusiness = 0
		isSqlDataBase = CInt(isSqlDataBase)
		If isSqlDataBase = 1 Then
			SqlString = "GetDate()"
		Else
			SqlString = "Now()"
		End If
	End Sub

	Private Sub Class_Terminate()
		If IsObject(Conn) Then
			Conn.Close
			Set Conn = Nothing
		End If
	End Sub

	Public Property Let Name(ByVal vNewValue)
		LocalCacheName = LCase(vNewValue)
	End Property

	Public Property Let Value(ByVal vNewValue)
		If LocalCacheName <> "" Then
			ReDim Cache_Data(2)
			Cache_Data(0) = vNewValue
			Cache_Data(1) = Now()
			Application.Lock
			Application(CacheName & "_" & LocalCacheName) = Cache_Data
			Application.UnLock
		Else
			Err.Raise vbObjectError + 1, "DownsysClassCacheServer", " please change the CacheName."
		End If
	End Property

	Public Property Get Value()
		If LocalCacheName <> "" Then
			Cache_Data = Application(CacheName & "_" & LocalCacheName)
			If IsArray(Cache_Data) Then
				Value = Cache_Data(0)
			Else
				Err.Raise vbObjectError + 1, "DownsysClassCacheServer", " The Cache_Data(" & LocalCacheName & ") Is Empty."
			End If
		Else
			Err.Raise vbObjectError + 1, "DownsysClassCacheServer", " please change the CacheName."
		End If
	End Property

	Public Function ObjIsEmpty()
		ObjIsEmpty = True
		Cache_Data = Application(CacheName & "_" & LocalCacheName)
		If Not IsArray(Cache_Data) Then Exit Function
		If Not IsDate(Cache_Data(1)) Then Exit Function
		If DateDiff("s", CDate(Cache_Data(1)), Now()) < (60 * Reloadtime) Then ObjIsEmpty = False
	End Function

	Public Sub DelCahe(MyCaheName)
		Application.Lock
		Application.Contents.Remove (CacheName & "_" & MyCaheName)
		Application.UnLock
	End Sub

	Public Sub System_Config()
		Name = "Config"
		If ObjIsEmpty() Then ReloadConfig
		CacheData = Value
		'第一次起用系统或者重启IIS的时候加载缓存
		Name = "Date"
		If ObjIsEmpty() Then
			Value = Date
		Else
			If CStr(Value) <> CStr(Date) Then
				Name = "Config"
				Call ReloadConfig
				CacheData = Value
			End If
		End If
		Setting = Split(CacheData(1, 0), "|||")
		StopReadme = CacheData(2, 0)
		Badwords = CacheData(3, 0)
		Badwordr = CacheData(4, 0)
		tempid = CacheData(5, 0)
		Register_Key = CacheData(6, 0)
		Register_Code = CacheData(7, 0)
		System_ver = CacheData(8, 0)
		SetupDir = CacheData(9, 0)
		Script_FSO = CacheData(10, 0)
		LockipList = CacheData(11, 0)
		NowTime = Now() + CInt(Setting(16)) / 24
		Version = "Xuanxi DownLoad System 3.2 Free Edition"
		Copyright = vbCrLf&"<!-- 山东大黄页技术部 -->" & vbCrLf
		'IP锁定
		If Not Unlock_Page Then
			If Request.Cookies(DownLoad_sn & "Kill")("kill") = "1" Then
				Response.redirect ("" & SetupDir & "showerr.asp?action=iplock")
			ElseIf Request.Cookies(DownLoad_sn & "Kill")("kill") <> "0" Then
				ChecKIPlock
			End If
		End If
		'关闭系统相关部分
		If CInt(Setting(7)) = 1 And Not Admin_Page Then Response.redirect ("" & SetupDir & "showerr.asp?action=stop")
		SystemEdition = "Xuanxi DownLoad System 3.2 Free Edition"
	End Sub

	Public Sub ReloadConfig()
		Dim SqlCon
		Dim RsCon
		SqlCon = "Select * from NC_Config"
		Set RsCon = Execute(SqlCon)
		Value = RsCon.GetRows(1)
		Set RsCon = Nothing
		Execute (" Update NC_Config Set SetupDir = '" & GetSetupDir & "' ")
	End Sub

	Public Sub ReloadTemplateslist()
		Dim Rs
		Dim SQL
		Dim tmpdata
		SQL = "select ID,TempName from [NC_Template]"
		Set Rs = Execute(SQL)
		tmpdata = Rs.GetString(, , "|||", "@@@", "")
		tmpdata = Left(tmpdata, Len(tmpdata) - 3)
		Set Rs = Nothing
		Value = tmpdata
	End Sub

	Public Sub LoadTemplates(Temp_Fields)
		Dim Main_Style
		Cookiesid = Request.Cookies("skin")("skinid")
		If Not IsNumeric(Cookiesid) Or Cookiesid = "" Then
			skinid = tempid
		Else
			skinid = Cookiesid
		End If
		skinid = CLng(skinid)
		Name = "TempName" & skinid
		If ObjIsEmpty() Then TemplatesToCache ("TempName")
		TempName = Value
		Name = "TempDir" & skinid
		If ObjIsEmpty() Then TemplatesToCache ("TempDir")
		TempDir = Value
		Name = "Style_CSS" & skinid
		If ObjIsEmpty() Then TemplatesToCache ("Style_CSS")
		Style_CSS = Value
		Style_CSS = Replace(Replace(Style_CSS, "{$SetupDir}", SetupDir), "{$PicUrl}", TempDir)
		Name = "Main_Style" & skinid
		If ObjIsEmpty() Then TemplatesToCache ("Main_Style")
		Main_Style = Value
		Main_Style = Replace(Main_Style, "{$SetupDir}", SetupDir)
		Main_Style = Replace(Main_Style, "{$PicUrl}", TempDir)
		Main_Style = Replace(Main_Style, "<head>", "<head>" & Copyright)
		Main_Style = Replace(Main_Style, "{$Version}", Version)
		Main_Style = Replace(Main_Style, "{$WebName}", Setting(0))
		Main_Style = Replace(Main_Style, "{$WebUrl}", Setting(1))
		Main_Style = Replace(Main_Style, "{$E-mail}", Setting(2))
		Main_Style = Replace(Main_Style, "{$Keyword}", Setting(3))
		Main_Style = Replace(Main_Style, "{$Copyright}", Setting(4))
		Main_Style = Replace(Main_Style, "{$IndexPage}", Setting(6))
		Main_Style = Split(Main_Style, "@@@")
		mainhtml = Split(Main_Style(0), "|||")
		mainset = Split(Main_Style(1), "|||")
		Name = "SortingMenu" & skinid
		If ObjIsEmpty() Then SortingMenuToCache
		SortingMenu = Value
		Name = "ClassMenu" & skinid
		If ObjIsEmpty() Then ClassMenuToCache
		ClassMenu = Value
		If Temp_Fields <> "" Then
			Name = "Temp_" & Temp_Fields & skinid
			If ObjIsEmpty() Then TemplatesToCache ("temp_" & Temp_Fields)
			ByValue = Value
		End If
	End Sub

	Public Sub TemplatesToCache(Temp_Fields)
		Dim Rs, SQL
		SQL = "Select " & Temp_Fields & " from [NC_Template] where id = " & skinid
		Set Rs = Execute(SQL)
		If Not Rs.EOF Then
			Value = Rs(0) & ""
		Else
			'处理错误
			If skinid = CLng(tempid) Then
				Call FixConfigtid
			End If
			Response.redirect "" & SetupDir & "cookies.asp?action=stylemod&skinid=0"
		End If
		Set Rs = Nothing
	End Sub

	Private Sub FixConfigtid()
		Dim Rs
		Dim SQL
		SQL = "Select Top 1 ID from [NC_Template] Order by ID"
		Set Rs = Execute(SQL)
		If Rs.EOF Then
			Response.Write "模板数据是空的，请添加。"
			Response.End
		Else
			ReloadConfigCache Rs(0), 5
			Execute (" Update NC_Config Set tempid = " & Rs(0) & " ")
		End If
		Set Rs = Nothing
	End Sub
	'*************************************************************
	'函数作用：更新总设置表部分缓存数组，入口：更新内容、数组位置
	'*************************************************************
	Public Function ReloadConfigCache(MyValue, n)
		CacheData(n, 0) = MyValue
		Name = "Config"
		Value = CacheData
	End Function

	Public Property Let ByValue(ByVal vNewValue)
		Dim tmpstr
		tmpstr = vNewValue
		tmpstr = Replace(tmpstr, "{$SetupDir}", SetupDir)
		tmpstr = Replace(tmpstr, "{$PicUrl}", TempDir)
		tmpstr = Replace(tmpstr, "<head>", "<head>" & Copyright)
		tmpstr = Replace(tmpstr, "{$Version}", Version)
		tmpstr = Replace(tmpstr, "{$WebName}", Setting(0))
		tmpstr = Replace(tmpstr, "{$WebUrl}", Setting(1))
		tmpstr = Replace(tmpstr, "{$E-mail}", Setting(2))
		tmpstr = Replace(tmpstr, "{$Keyword}", Setting(3))
		tmpstr = Replace(tmpstr, "{$Copyright}", Setting(4))
		tmpstr = Replace(tmpstr, "{$Width}", mainset(0))
		tmpstr = Replace(tmpstr, "{$IndexPage}", Setting(6))
		tmpstr = Split(tmpstr, "@@@")
		temphtml = Split(tmpstr(0), "|||")
		tempset = Split(tmpstr(1), "|||")
	End Property

	Public Sub SortingMenuToCache()
		Dim SQL, Rs, HtmlString, HtmlMenu, i, totalnumber
		If Not IsObject(Conn) Then ConnectionDatabase
		SQL = "select * from [NC_SoftSort] where depth=0 order by rootid"
		Set Rs = CreateObject("adodb.recordset")
		Rs.Open SQL, Conn, 1, 1
		SqlQueryNum = SqlQueryNum + 1
		HtmlString = mainset(3)
		If Not (Rs.EOF And Rs.bof) Then
			i = 1
			totalnumber = Rs.recordcount
			Do While Not Rs.EOF
				HtmlString = HtmlString & mainset(4)
				If CInt(Setting(5)) = 0 Then
					HtmlMenu = "<a href='" & SetupDir & "Sorting/Catalog" & Rs("sortid") & "/Sorting_Indate_Desc_1.html' class=""ToolBarLink"" title='" & Rs("Readme") & "'>" & Rs("SortName") & "</a>" & vbCrLf
				Else