cls_main.asp

来自「小游戏网站演示www.4399.io 拥有4万条游戏数据」· ASP 代码 · 共 1,731 行 · 第 1/5 页

	Public Sub ReloadConfig()
		Dim SQL, Rs
		SQL = "SELECT * from [NC_Config] "
		Set Rs = Execute(SQL)
		Value = Rs.GetRows(1)
		Set Rs = Nothing
	End Sub
	'=============================================================
	'过程名：ReloadChannel
	'作  用：再装频道设置
	'参  数：ChannelID   ----频道ID
	'=============================================================
	Private Sub ReloadChannel(ChannelID)
		Dim SQL, Rs
		SQL = "SELECT ChannelID,ChannelName,ChannelDir,StopChannel,ChannelType,modules,ModuleName,BindDomain,DomainName,ChannelSkin,IsCreateHtml,HtmlExtName,StopUpload,MaxFileSize,UpFileType,IsAuditing,AppearGrade,PostGrade,LeastString,MaxString,PaginalNum,LeastHotHist,Channel_Setting,SortDestination,InfoDestination,MoreDestination,setEditor,NamedPath from NC_Channel where ChannelType <= 1 And ChannelID = " & CLng(ChannelID)
		Set Rs = Execute(SQL)
		If Rs.BOF And Rs.EOF Then
			Response.Write "错误的频道参数！"
			Exit Sub
		End If
		Value = Rs.GetRows(1)
		Set Rs = Nothing
	End Sub
	'=============================================================
	'过程名：ReadChannel
	'作  用：读取频道设置
	'参  数：ChannelID   ----频道ID
	'=============================================================
	Public Sub ReadChannel(ChannelID)
		If Not IsNumeric(ChannelID) Then ChannelID = 1
		ChannelID = Clng(ChannelID)
		Name = "Channel" & ChannelID
		If ObjIsEmpty() Then Call ReloadChannel(ChannelID)
		CacheChannel = Value
		If CLng(CacheChannel(0, 0)) <> ChannelID Then
			Call ReloadChannel(ChannelID)
			CacheChannel = Value
		End If
		m_intChannelID = CacheChannel(0, 0): ChannelName = CacheChannel(1, 0): ChannelDir = CacheChannel(2, 0): StopChannel = CacheChannel(3, 0): ChannelType = CacheChannel(4, 0): modules = CacheChannel(5, 0): ModuleName = CacheChannel(6, 0): BindDomain = CacheChannel(7, 0): DomainName = CacheChannel(8, 0): ChannelSkin = CacheChannel(9, 0)
		IsCreateHtml = CacheChannel(10, 0): HtmlExtName = CacheChannel(11, 0): StopUpload = CacheChannel(12, 0): MaxFileSize = CacheChannel(13, 0): UpFileType = CacheChannel(14, 0): IsAuditing = CacheChannel(15, 0): AppearGrade = CacheChannel(16, 0)
		PostGrade = CacheChannel(17, 0): LeastString = CacheChannel(18, 0): MaxString = CacheChannel(19, 0): PaginalNum = CacheChannel(20, 0): LeastHotHist = CacheChannel(21, 0): Channel_Setting = CacheChannel(22, 0)
		SortDestination = CacheChannel(23, 0):InfoDestination = CacheChannel(24, 0):MoreDestination = CacheChannel(25, 0): setEditor = CacheChannel(26, 0) & "":NamedPath = CacheChannel(27, 0) & ""
		If CInt(StopChannel) = 1 And Not Admin_Page Then Response.Redirect (SiteUrl & InstallDir & "showerr.asp?action=ChanStop")
		If setEditor = "" Then setEditor = "0|AdminMode|590|350|editor/|||0|Simple|560|350|0|0|0|0|0|1|0|0|0|0|0|550|5000|1|1|1|1|1|0|0|0|0|0|0|0|0|0"
		setEditorArray		= Split(setEditor, "|||")
		setAdminEditor		= Split(setEditorArray(0), "|")
		setUserEditor		= Split(setEditorArray(1), "|")
		If BindDomain <> "0" Then IsBindDomain = 1
	End Sub

	Public Sub LoadChannel(ByVal chanid)
		Dim Rs,SQL,tmpdata
		chanid = CLng(chanid)
		Name = "MyChannel" & chanid
		If ObjIsEmpty() Then
			SQL = "SELECT ChannelID,ChannelDir,ModuleName,IsCreateHtml,HtmlExtName,StopUpload,SortDestination,InfoDestination,MoreDestination,BindDomain,DomainName FROM NC_Channel WHERE ChannelType<=1 And ChannelID= " & Clng(chanid)
			Set Rs = Execute(SQL)
			If Rs.BOF And Rs.EOF Then
				Set Rs = Nothing
				Exit Sub
			End If
			tmpdata = Rs.GetString(, , "|||", "@@@", "")
			tmpdata = Left(tmpdata, Len(tmpdata) - 3)
			Set Rs = Nothing
			Value = tmpdata
		End If
		
		ChannelData = Split(Value, "|||")
		m_ChannelDir = ChannelData(1)
		ChannelModule = ChannelData(2)
		ChannelUseHtml = ChannelData(3)
		ChannelHtmlExt = ChannelData(4)
		m_SortDestination = ChannelData(6)
		m_InfoDestination = ChannelData(7)
		m_MoreDestination = ChannelData(8)
		
		If IsBindDomain = 0 Then
			If ChannelData(9) = "0" Then
				ChannelPath = InstallDir & ChannelData(1)
				ChannelDomain = ""
			Else
				If ChannelUseHtml <> "1" Then
					ChannelPath = Trim(ChannelData(10)) &"/"
				Else
					ChannelPath = Trim(ChannelData(10)) & ""
				End If
				ChannelDomain = Trim(ChannelData(10)) & ""
			End If
		Else
			If ChannelData(9) = "0" Then
				ChannelPath = Trim(SiteUrl) & "/" & ChannelData(1)
				ChannelDomain = Trim(SiteUrl) & "/"
			Else
				If CInt(ChannelData(0)) = CInt(m_intChannelID) Then
					ChannelPath = "/"
					ChannelDomain = ""
				Else
					If ChannelUseHtml <> "1" Then
						ChannelPath = Trim(ChannelData(10)) &"/"
					Else
						ChannelPath = Trim(ChannelData(10)) & ""
					End If
					ChannelDomain = Trim(ChannelData(10)) & ""
				End If
			End If
		End If
	End Sub
	
	'=============================================================
	'过程名：LoadTemplates
	'作  用：载入模板
	'参  数：Page_Mark   ----StyleID
	'=============================================================
	Public Sub LoadTemplates(ChannelID, pageid, StyleID)
		Dim rstmp, TempSkinID
		ChannelID = CLng(ChannelID)
		ThisChannelID = ChannelID
		pageid = CInt(pageid)
		Name = "DefaultSkinID"
		If ObjIsEmpty() Then
			Set rstmp = Execute("SELECT skinid FROM [NC_Template] WHERE pageid=0 And isDefault=1")
			Value = rstmp(0)
			Set rstmp = Nothing
		End If
		TempSkinID = Value
		If StyleID = 0 Or StyleID = "" Then
			skinid = TempSkinID
		Else
			Set rstmp = Execute("SELECT skinid FROM [NC_Template] WHERE pageid=0 And skinid=" & StyleID)
			If Not rstmp.EOF Then
				skinid = rstmp(0)
			Else
				skinid = TempSkinID
			End If
			Set rstmp = Nothing
		End If
		skinid = CLng(skinid)
		Name = "MainStyle" & skinid
		If ObjIsEmpty() Then TemplatesMainCache (skinid)
		Main_Style = Value
		SkinPath = Main_Style(0, 0)
		Main_Setting = Split(Main_Style(2, 0), "|||")
		MainStyle = Main_Style(1, 0)
		'MainStyle = Replace(MainStyle, "{$InstallDir}", ReadInstallDir(BindDomain))
		MainStyle = Replace(MainStyle, "{$SkinPath}", SkinPath)
		MainStyle = Replace(MainStyle, "|||","")
		
		If pageid <> 0 Then
			Name = "Templates" & ChannelID & skinid & pageid
			If ObjIsEmpty() Then
				TemplatesToCache ChannelID, pageid
			End If
			ByValue = Value
		End If
	End Sub
	Private Sub TemplatesToCache(ChannelID, pageid)
		Dim Rs, SQL, rstmp
		SQL = "SELECT skinid,page_content,page_setting FROM [NC_Template] WHERE ChannelID=" & ChannelID & " And skinid=" & skinid & " And pageid=" & pageid
		Set Rs = Execute(SQL)
		If Not Rs.EOF Then
			Value = Rs.GetRows(1)
		Else
			Set rstmp = Execute("SELECT skinid,page_content,page_setting FROM [NC_Template] WHERE ChannelID=" & ChannelID & " And isDefault=1 And pageid=" & pageid)
			Value = rstmp.GetRows(1)
			Set rstmp = Nothing
		End If
		Set Rs = Nothing
	End Sub
	Private Sub TemplatesMainCache(skinid)
		Dim Rs, SQL, rstmp
		SQL = "SELECT TemplateDir,page_content,page_setting FROM [NC_Template] WHERE pageid=0 And skinid=" & skinid & " And ChannelID=0"
		Set Rs = Execute(SQL)
		If Not Rs.EOF Then
			Value = Rs.GetRows(1)
		Else
			Set rstmp = Execute("SELECT TemplateDir,page_content,page_setting FROM [NC_Template] WHERE pageid=0 And isDefault=1 And ChannelID=0")
			Value = rstmp.GetRows(1)
			Set rstmp = Nothing
		End If
		Set Rs = Nothing
	End Sub
	Public Property Let ByValue(ByVal vNewValue)
		Dim tmpstr
		tmpstr = vNewValue
		Html_Setting = tmpstr(2, 0)
		Html_Setting = Split(Html_Setting, "|||")
		HtmlContent = tmpstr(1, 0)
		
		HtmlContent = TemplateCustom(HtmlContent)
		HtmlContent = Replace(HtmlContent, "{$Style_CSS}", MainStyle)
		HtmlContent = Replace(HtmlContent, "{$SkinPath}", SkinPath)
		HtmlContent = Replace(HtmlContent, "{$Width}", Main_Setting(0))
		HtmlContent = Replace(HtmlContent, "{$ChannelMenu}", ChannelMenu)
		HtmlContent = Replace(HtmlContent, "{$WebSiteName}", SiteName)
		HtmlContent = Replace(HtmlContent, "{$WebSiteUrl}", SiteUrl)
		HtmlContent = Replace(HtmlContent, "{$MasterMail}", MasterMail)
		HtmlContent = Replace(HtmlContent, "{$Keyword}", keywords)
		HtmlContent = Replace(HtmlContent, "{$Copyright}", Copyright)
		HtmlContent = Replace(HtmlContent, "{$IndexName}", IndexName)
		HtmlContent = Replace(HtmlContent, "{$Version}", version)
		HtmlContent = Replace(HtmlContent, "{$PublishedDate}", Now())
		HtmlContent = Replace(HtmlContent, "{$siteAdsCode1}", ArraySiteAdsCode(0))
		HtmlContent = Replace(HtmlContent, "{$siteAdsCode2}", ArraySiteAdsCode(1))
		HtmlContent = Replace(HtmlContent, "{$siteAdsCode3}", ArraySiteAdsCode(2))
		HtmlContent = Replace(HtmlContent, "{$siteAdsCode4}", ArraySiteAdsCode(3))
		HtmlContent = Replace(HtmlContent, "{$siteAdsCode5}", ArraySiteAdsCode(4))
		HtmlContent = Replace(HtmlContent, "{$siteAdsCode6}", ArraySiteAdsCode(5))
		HtmlContent = HtmlContent
	End Property
	Public Property Get ByValue()
		ByValue = HtmlContent
	End Property
	Public Property Let HTMLValue(ByVal vNewValue)
		Dim TempStr
		TempStr = TemplateCustom(vNewValue)
		TempStr = Replace(TempStr, "{$Style_CSS}", MainStyle)
		TempStr = Replace(TempStr, "{$SkinPath}", SkinPath)
		TempStr = Replace(TempStr, "{$Width}", Main_Setting(0))
		TempStr = Replace(TempStr, "{$ChannelMenu}", ChannelMenu)
		TempStr = Replace(TempStr, "{$WebSiteName}", SiteName)
		TempStr = Replace(TempStr, "{$WebSiteUrl}", SiteUrl)
		TempStr = Replace(TempStr, "{$MasterMail}", MasterMail)
		TempStr = Replace(TempStr, "{$Keyword}", keywords)
		TempStr = Replace(TempStr, "{$Copyright}", Copyright)
		TempStr = Replace(TempStr, "{$IndexName}", IndexName)
		TempStr = Replace(TempStr, "{$Version}", version)
		TempStr = Replace(TempStr, "{$PublishedDate}", Now())
		TempStr = Replace(TempStr, "{$siteAdsCode1}", ArraySiteAdsCode(0))
		TempStr = Replace(TempStr, "{$siteAdsCode2}", ArraySiteAdsCode(1))
		TempStr = Replace(TempStr, "{$siteAdsCode3}", ArraySiteAdsCode(2))
		TempStr = Replace(TempStr, "{$siteAdsCode4}", ArraySiteAdsCode(3))
		TempStr = Replace(TempStr, "{$siteAdsCode5}", ArraySiteAdsCode(4))
		TempStr = Replace(TempStr, "{$siteAdsCode6}", ArraySiteAdsCode(5))
		sHtmlContent = TempStr
	End Property
	Public Property Get HTMLValue()
		HTMLValue = sHtmlContent
	End Property
	Public Property Get HtmlSetting(n)
		HtmlSetting = Html_Setting(n)
	End Property
	Public Property Get MainSetting(n)
		MainSetting = Main_Setting(n)
	End Property
	Public Function TemplateCustom(ByVal strHTML)
		Dim Custom,strContent
		strContent = strHTML
		Set Custom = New LabelCustom_Cls
		Custom.Template = strContent
		Custom.Channel = ThisChannelID
		Custom.Execute
		strContent = Custom.Template
		Set Custom = Nothing
		TemplateCustom = strContent
	End Function
	'================================================
	'过程名：GetSiteUrl
	'作  用：取得带端口的URL
	'================================================
	Public Property Get GetSiteUrl()
		If Request.ServerVariables("SERVER_PORT") = "80" Then
			GetSiteUrl = "http://" & Request.ServerVariables("server_name")
		Else
			GetSiteUrl = "http://" & Request.ServerVariables("server_name") & ":" & Request.ServerVariables("SERVER_PORT")
		End If
	End Property
	'================================================
	'函数名：FormEncode
	'作  用：过虑提交的表单数据
	'参  数：str ----原字符串  n ----字符长度
	'================================================
	Public Function FormEncode(ByVal str, ByVal n)
		If Not IsNull(str) And Trim(str) <> "" Then
			str = Left(str, n)
			str = Replace(str, ">", "&gt;")
			str = Replace(str, "<", "&lt;")
			str = Replace(str, "&#62;", "&gt;")
			str = Replace(str, "&#60;", "&lt;")
			str = Replace(str, "'", "&#39;")
			str = Replace(str, Chr(34), "&quot;")
			str = Replace(str, "%", "％")
			str = Replace(str, vbNewLine, "")
			FormEncode = Trim(str)
		Else
			FormEncode = ""
		End If
	End Function
	'================================================
	'函数名：ChkKeyWord
	'作  用：过滤关键字
	'参  数：keyword ----关键字
	'================================================
	Public Function ChkKeyWord(ByVal keyword)
		Dim FobWords, i
		On Error Resume Next
		FobWords = Array(91, 92, 304, 305, 430, 431, 437, 438, 12460, 12461, 12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 12471, 12472, 12473, 12474, 12475, 12476, 12477, 12478, 12479, 12480, 12481, 12482, 12483, 12485, 12486, 12487, 12488, 12489, 12490, 12496, 12497, 12498, 12499, 12500, 12501, 12502, 12503, 12504, 12505, 12506, 12507, 12508, 12509, 12510, 12521, 12532, 12533, 65339, 65340)
		For i = 1 To UBound(FobWords, 1)
			If InStr(keyword, ChrW(FobWords(i))) > 0 Then
				keyword = Replace(keyword, ChrW(FobWords(i)), "")
			End If
		Next
		keyword = Left(keyword, 100)
		FobWords = Array("~", "!", "@", "#", "$", "%", "^", "&", "*", "(", ")", "_", "+", "=", "`", "[", "]", "{", "}", ";", ":", """", "'", ",", "<", ">", ".", "/", "\", "?", "--")
		For i = 0 To UBound(FobWords, 1)
			If InStr(keyword, FobWords(i)) > 0 Then
				keyword = Replace(keyword, FobWords(i), "")
			End If
		Next
		ChkKeyWord = keyword
	End Function
	'================================================
	'函数名：JAPEncode
	'作  用：日文片假名编码
	'参  数：str ----原字符
	'================================================
	Public Function JAPEncode(ByVal str)
		Dim FobWords, i
		On Error Resume Next
		If IsNull(str) Or Trim(str) = "" Then
			JAPEncode = ""
			Exit Function
		End If
		FobWords = Array(92, 304, 305, 430, 431, 437, 438, 12460, 12461, 12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 12471, 12472, 12473, 12474, 12475, 12476, 12477, 12478, 12479, 12480, 12481, 12482, 12483, 12485, 12486, 12487, 12488, 12489, 12490, 12496, 12497, 12498, 12499, 12500, 12501, 12502, 12503, 12504, 12505, 12506, 12507, 12508, 12509, 12510, 12521, 12532, 12533, 65340)
		For i = 1 To UBound(FobWords, 1)
			If InStr(str, ChrW(FobWords(i))) > 0 Then
				str = Replace(str, ChrW(FobWords(i)), "&#" & FobWords(i) & ";")
			End If
		Next
		JAPEncode = str
	End Function
	'================================================
	'函数名：JAPUncode
	'作  用：日文片假名解码
	'参  数：str ----原字符
	'================================================
	Public Function JAPUncode(ByVal str)
		Dim FobWords, i
		On Error Resume Next
		If IsNull(str) Or Trim(str) = "" Then
			JAPUncode = ""
			Exit Function
		End If
		FobWords = Array(92, 304, 305, 430, 431, 437, 438, 12460, 12461, 12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 12471, 12472, 12473, 12474, 12475, 12476, 12477, 12478, 12479, 12480, 12481, 12482, 12483, 12485, 12486, 12487, 12488, 12489, 12490, 12496, 12497, 12498, 12499, 12500, 12501, 12502, 12503, 12504, 12505, 12506, 12507, 12508, 12509, 12510, 12521, 12532, 12533, 65340)
		For i = 1 To UBound(FobWords, 1)
			If InStr(str, "&#" & FobWords(i) & ";") > 0 Then
				str = Replace(str, "&#" & FobWords(i) & ";", ChrW(FobWords(i)))
			End If