<%
'=======================================================
' 欢迎使用《阿赛大型门户网站系统V3.0》，简称“AsaiMHV3”
' 技术支持、商业版咨询、官方唯一指定联系QQ“4941172”
' 官方网站：http://77ya.com      程序负责人：阿赛
'=======================================================

Class Cls_ClassMain
	Public web_name,web_url,Web_RealURL,web_email,web_dir,web_now_dir,web_urls,web_cookies,web_skin,web_skindir,web_unit,now_time,today_time,timer_start,pro_edition,num_rs
	Public Web_InfoNo, Web_Common, IsHealth, R_tstyle
	Public SuperAdmins, AdminFolder, Web_Upload, Web_BadWords, Web_LockIP, Web_SqlInword, Web_NoChkFiles, Web_AdsFilter
	Public Web_LockTime, Web_Boy, Web_Girl, Web_Index
	Public Web_AdminCodes ,Web_LKNumber ,Web_UploadType ,Web_MailServer ,Web_RegBadWords, Web_RegUserName
	Public Web_CopyRight, Web_Closer, Web_Mode
	Public Web_UserLevel, Web_PerPay, Web_Medal, Web_Gbook, Web_BbsData, Web_Payment, Web_BbsConfig
	Public IsDeBug, Reloadtime, CacheName, ScriptTmpstr, ScriptName, UserTrueIP
	Private LocalCacheName,Cache_Data
	Public IsConn											'Conn 是否开启
	Private WebConfig										'网站常规设置，数组
	Public total_counter									'统计流量
	Public IsView
	Public PageModTrue										'判断栏目是否设置模板
	Private isLoadTemplate,LoadTemplateID,itdir,ctcss,tsid,tstyle                         '模板变量定义
	Private itname,itconfig,itmark,ctname,ctmain,ctconfig,ctmark,ctmarks
	Public ChannelTrue                                      '频道变量
	Public ChannelName,ChannelTit,ChannelDir,ChannelTable,ChannelUnit,ChannelListNum,FrontEditorType,EmpressEditorType
	Public ChannElsetup,ClassDepth,ChannelRssField,ChannelPutType,ChannelCuteNum,ChannelLeftCuteNum,ChannelCount,ChannelHits,ChannelOption,ChannelPreSet
	Public ChannelUpType,ChannelUpMax,ChannelUpDayNum,ChannelUpFileType,ChannelUploadDir
	Public ChannelPicWidth, ChannelPicHeight
	Public ReviewTrue, SpecialTrue, KeyWordTrue, ErrTrue, RssTrue
	Public ChannelSpecial, ChannelKeyWord, Channelpower
    Public Web_IsCreatIndex, Web_IndexFile
	Public ChannelData, ChannelPath, ChannelModule,ChannelModuleType,ChannelModType, ChannelHtmPath, ChannelHtmForm, ChannelUseHtml, ChannelHtmlExt, ChannelPrefix
	Public ChannelIsCreatHtml, ChannelHtmlExtName, ChannelHtmlPrefix, ChannelHtmlPath, ChannelHtmlForm, ChannelIsNewWindow ,ChannelDBtable
	Public pNum, pNum2
	Public Fso_Sys_Var	

	'//* 类初始化 *//
	Private Sub Class_Initialize()
		If Not Response.IsClientConnected Then Response.End
		IsDeBug = 1
		IsView = 0
		pNum = 1 : pNum2 = 0
		'Web_Cookies = Replace(Replace(Replace(Replace(Server.MapPath("Index.asp"),"Index.asp",""),":",""),"\","")," ","")
		Reloadtime = 14400
		total_counter=0
		LK_Online=0
		LK_UserOnline=0
		LK_GuestOnline=0
		IsConn = False
		ChannelTrue = False
		ReviewTrue = False
		SpecialTrue = False
		KeyWordTrue = False
		ErrTrue = False
		RssTrue = False
		IsHealth = False
		isLoadTemplate = False
		LoadTemplateID = 0
		now_time=time_type(now(),1)
		today_time=time_type(now(),4)
		timer_start=timer()
		ScriptTmpstr	= Split(Request.ServerVariables("PATH_INFO"),"/")
		ScriptName	= Lcase(ScriptTmpstr(UBound(ScriptTmpstr)))
		UserTrueIP	= CheckStr(Request.ServerVariables("REMOTE_ADDR"))
		Pro_Edition	="A"&"s"&"a"&"i"&"M"&"H"&"V"&"3"&" / "&" 阿"&"赛"&"大"&"型"&"门"&"户"&"网站系统"&"(AC"&"CES"&"S/S"&"QL)"&" V"&"3.0"
		num_rs=0
		Call Own_Dir()		'检测链接地址
	End Sub

	Private Sub Class_Terminate()
	End Sub

	Public Sub Cms_InitLoad()
		Cms_InfoInit()
		Web_Name = Web_Common(1)
		Web_Url = Web_Common(2)
		Web_Unit = Web_Common(8)
		Web_Boy = Web_Common(9)
		Web_Girl = Web_Common(10)
		Web_Index = Web_Common(11)
		Web_Mode = Int(Web_Common(12))
		'MainMod_Load()
		Online_Init()
	End Sub

	'//* 载入系统常规配置 *//
	Private Sub Cms_InfoInit()
		Dim Tmpstr
		'0-注册人数、1-最后注册用户、2-访问人数、3-最高在线人数，4-最高访问时间、5-网站开始时间
		'6-今日时间、7-今日新贴、8-配置参数、9-超级用户、10-网站安装目录、11-后台目录、12-上传目录
		'13-不健康字符、14-锁定IP、15-用户等级、16-预付费、17-留言参数、18-当前论坛数据表信息
		'19-支付参数
		Name = "Web_Info"
		If Cache_Chk() Then
			If SqlType = 1 Then
			   Sql="execute AsaiMHInit_Info"
			Else		
			   SQL = "Select Num_Reg,New_Username,Counter,Max_Online,Max_Tim,Start_Tim,Today_Tim,Num_New,Configs,SuperAdmin,CookiesName,AdminFolder,UploadFolder,BadWords,LockIP,UserLevel,PerPay,Medal,Gbook,BbsData,Payment,IsCreatIndex,IndexFile,BbsConfig,SqlInword,NoChkFiles,AdsFilter from AsaiMHConfigs Where ID=1"
			End If
			Set Rs=Exec(SQL,1)
			If Rs.Eof Then
				Rs.Close
                		Call ClsErr("网站配制为空,请确认程序完整性!")
			End If
			Value=Rs.GetRows(1)
			Rs.Close
		End If
		Web_InfoNo = Value
		total_counter=Web_InfoNo(2,0)
		'--- 每日刷新一次统计信息
		If Cstr(time_type(Web_InfoNo(6,0),4))<>Cstr(time_type(now_time,4)) Then
			Call Day_Initialize()
			total_counter=total_counter+1
		End If
		Web_Dir = InstallDir                '网站目录
		Web_cookies = InstallCookies        '网站cookies
		SuperAdmins = Web_InfoNo(9,0)
		Fso_Sys_Var= Web_InfoNo(10,0)
		FsoString = Web_InfoNo(10,0)
		AdminFolder = Web_InfoNo(11,0)
		If Right(AdminFolder,1)<>"/" Then AdminFolder = AdminFolder & "/"
		Web_Upload = Web_InfoNo(12,0)
		Web_BadWords = Web_InfoNo(13,0)
		Web_LockIP = Web_InfoNo(14,0)
		Web_UserLevel = Split(Web_InfoNo(15,0),"|||")
		Web_PerPay = Split(Web_InfoNo(16,0),"|||")
		Web_Medal=Split(Web_InfoNo(17,0),"|||")
		Web_Gbook=Web_InfoNo(18,0)
		Web_Payment=Web_InfoNo(20,0)
		Web_BbsData=Web_InfoNo(19,0)
		Tmpstr = Web_InfoNo(8,0)
		Tmpstr = Split(Tmpstr,"|||")
		Web_Common = Split(Tmpstr(0),",")
		Web_AdminCodes = Tmpstr(1)
		Web_LKNumber = Split((Tmpstr(2)),",")
		Web_UploadType = Split((Tmpstr(3)),",")
		Web_MailServer = Tmpstr(4)
		Web_RegBadWords = Tmpstr(5)
		Web_RegUserName = Tmpstr(6)
		Web_CopyRight = Tmpstr(7)
		Web_Closer = Tmpstr(8)
		Web_IsCreatIndex = Web_InfoNo(21,0)
		Web_IndexFile = Web_InfoNo(22,0)
		Web_BbsConfig = Web_InfoNo(23,0)
		Web_SqlInword = Web_InfoNo(24,0)
		Web_NoChkFiles = Web_InfoNo(25,0)
		Web_AdsFilter = Web_InfoNo(26,0)
		Erase TmpStr
		If int(Format_Mid_Num(44))=1 and Not NoChkSqlInFiles Then ChkSQLInWord	'检测Sql防注入调用
  	End Sub

	'--- 更新总设置表部分缓存数组，入口：更新内容、数组位置
	Public Sub ReloadInfo(MyValue,N)
		Web_InfoNo(N,0) = MyValue
		Name = "Web_Info"
		value = Web_InfoNo
		Web_InfoNo = value
	End Sub

	'--- 每日简单初始化
	Private Sub Day_Initialize()
		Dim dTim
		dTim = Time_Type(Now_Time,4)
		Call Exec("Update AsaiMHConfigs Set Num_New=0,Today_Tim='"&dTim&"'",0)
		Call Exec("Update AsaiMHBbsClass Set bbs_New_Num=0",0)
		ReloadInfo 0,7
		ReloadInfo dTim,6
	End Sub

	'--- 取缓存总数
	Public Property Get Cache_Num
		Cache_Num=Application.Contents.count
	End Property

	'--- 取用户组总数
	Public Property Get UserGroupLen
		UserGroupLen=0
		Name="user_group"
		If Cache_Chk() Then UserGroup_To_Cache()
		If IsArray(Value) Then
			UserGroupLen=Ubound(Value,2)
		End If
	End Property

	'--- 浏览器前一页URL，返回Encode
	Public Property Get BrowseUrl
		BrowseUrl=Trim(Request.ServerVariables("url"))&"?"&Trim(Request.ServerVariables("QUERY_STRING"))
		BrowseUrl=Server.UrlEncode(BrowseUrl)
	End Property

	Public Property Get WebBrowseUrl
		WebBrowseUrl=Trim(Request.ServerVariables("http_referer"))
	End Property

	Public Property Get CurrentUrl
		CurrentUrl=Trim(Request.ServerVariables("http_referer"))&"?"&Trim(Request.ServerVariables("QUERY_STRING"))
	End Property

	'判断用户是否在线
	Public Function IsONline(vUserName)
		'IsONline=False
		'If Trim(vUserName)="" Then Exit Function
		'If IsArray(session_get(vUserName)) And vAction=1 Then
				'IsONline=True:Exit Function
		'End If
		Dim oRs
		Set oRs=Exec("Select Count(*) from AsaiMHUserLogin Where l_username='"&vUserName&"'",1)
		If oRs(0)<>0 Then
		   IsONline=True
		Else
		   IsONline=False
		End If
		oRs.Close:Set oRs = Nothing
	End Function

	'用户信息载入
	Public Function LoadUserInfo()
		Dim User_Info,last_tim
		If ChkName(login_username)=False Or ChkPassWord(Cls.Code_Encrypt(login_password))=False Then
			Call Cookies_Clear(0)
		Else
			Dim NeedToUpdate,NeedTrue
			NeedTrue=False
			NeedToUpdate=","&Cls.Cache_Get("NeedToUpdate")&","
			If InStr(NeedToUpdate,","&login_username&",")>0 Then
				NeedTrue=True
			End If
			'User_Info=Cls.Session_Get(login_username)
			User_Info=Cls.Session_Get(User_Info)
			If Not IsArray(User_Info) Or NeedTrue=True Then
			Call Cls.NeedUpdateList(login_username,0)
'			If SqlType = 1 Then
'				Sql="execute AsaiMHUserLogin '"&login_username&"','"&login_password&"'"						
'			Else
				Sql="Select top 1 id,username,power,m_level,emoney,integral,last_tim,face,face_w,face_h,bbs_counter,onlinetime,login_msg,email,whe,phone,strength,expression,ok_counter,ok_helpnum,ok_reply,estate,islock,ispb,otim from AsaiMHUserData where hidden=1 and username='"&login_username&"' and password='"&login_password&"'"
'			End If
			Call Cls.Exe_Conn(Rs,SQL,3)
			If Rs.Eof Then
				Call Cookies_Clear(0)
			Else
				Rs("last_tim")=Cls.now_time
				Rs.Update
				User_Info=Rs.GetRows()
				'--- (0-12) + 3
				'--- 0:用户ID、1:用户名、2:等级、3:权限、4:币、5:积分、6:最后登陆时间、7:头像、8:头像宽、9:头像高
				'--- 10:发贴数、11:用户在线时间、12:短信数、13:email、14:所在地、15:电话		
				Call Cls.Session_Set(login_username,User_Info)			
			End If
			Rs.Close
		End If
		login_id=User_Info(0,0)
		login_name=User_Info(1,0)
		login_username=User_Info(1,0)
		login_mode=User_Info(2,0)
		login_level=User_Info(3,0)
		login_emoney=User_Info(4,0)    'Cint(User_Info(4))
		login_integral=User_Info(5,0)  'Cint(User_Info(5))
		login_lasttime=User_Info(6,0)
		login_faces=User_Info(7,0)&"|"&User_Info(8,0)&"|"&User_Info(0,0)
		login_bbs_counter=Cint(User_Info(10,0))
		User_OnlineTime=User_Info(11,0)
		login_msg=User_Info(12,0)
		login_email=User_Info(13,0)
		login_whe=User_Info(14,0)
		login_phone=User_Info(15,0)
		login_strength=User_Info(16,0)
		login_expression=User_Info(17,0)
		login_ok_counter=User_Info(18,0)
		login_ok_helpnum=User_Info(19,0)
		login_ok_reply=User_Info(20,0)
		login_estate=User_Info(21,0)
		login_islock=User_Info(22,0)
		login_ispb=User_Info(23,0)
		login_otim=User_Info(24,0)
		Erase User_Info
		login_modep=Format_Power(login_mode,2)
		Cls.Cookies_Set "login_id",login_id
		Cls.Cookies_Set "login_mode",login_mode
		Cls.Cookies_Set "login_password",Cls.Code_Encrypt(login_password)
		Is_LoginTrue=True
		End If
		'用户在线时间识别
		If Is_LoginTrue Then
			last_tim = Cls.Session_Get(login_username&",last_time")
			If not isDate(last_tim) then last_tim = Cls.now_time
			today_onlinetime = DateDIff("n",last_tim,Cls.now_time)
			If today_onlinetime > 5 Then '在线大于5分钟，刚更新用户体力和在线时间
				If today_onlinetime < Format_Mid_Num(14) Then  '登陆超时就不与更新
					'更新用户在线时间
					Call Cls.exec("update AsaiMHUserData set onlinetime=onlinetime+"&today_onlinetime&" where username='"&login_username&"'",0)
					'增加用户体力
					Call Cls.exec("update AsaiMHUserData set strength=strength+"&Format_Mid_Num(35)&"*"&today_onlinetime&" where username='"&login_username&"'",0)
				End If
				Call Cls.Session_Set(login_username&",last_time",Cls.now_time) '更新间隔时间	
			Else
				If last_tim = Cls.now_time Then Call Cls.Session_Set(login_username&",last_time",Cls.now_time) '更新间隔时间	
			End If
		End If
		'判断计时用户
		If Is_LoginTrue=true And login_estate=True Then
			dim login_otim,Ok_msg
			Sql="Select top 1 otim,estate from AsaiMHUserData where hidden=1 and username='"&login_username&"'"
			Set Rs=Cls.exec(sql,1)
			If not rs.eof then
				login_otim=rs("otim")
			End If
			Rs.Close					
			If  datedIff("d",login_otim,Cls.now_time)>0 then                
				Sql="update AsaiMHUserData set estate=0,power='"&format_powers(0)&"',otim='"&Cls.time_type(Cls.now_time,4)&"' where username='"&login_username&"'"
				call cls.exec(sql,0)
				Ok_msg="\n\n您也同时降级为 "&format_power(format_powers(0),1)&"!"
				Response.Write Cls.js_put("alert(""您的计时"&format_power(login_mode,1)&"用户帐号已过期！"&Ok_msg&""");location.href='?'" & VbCrlf,1)
			End If
		End If
	End Function

	'更新用户在线信息
	Public Function UpdateUserOnline(wTit)
		'载入用户信息
		'用户在线时间识别,以分钟计算(5分钟)
		'五分更新一次上次活动时间
		Dim ttt,ofID,UserInfo,Online_Num,Cookies_True
		ofID = Code_id("fid")
		If ofID="" Then
			ofID = "0"
		End If
		If wTit<>"" Then
			Tit=""&wTit&""
		Else
			Tit=""&Tit&""
		End If
		Cookies_True = True
		If Cls.Cookies_Get("cookies_true")<>"yes" Then
			Cls.Cookies_Set "cookies_true","yes"
			Cookies_True = False
		End If
		user_ip = Cls.Ip_Sys(0)
		user_sys = Cls.Code_Var(Left(Cls.Ip_Sys(1),250))
		'载入用户信息
		If Cookies_True And ChannelIDs<>10 Then Call Cls.LoadUserInfo()
		'===游客用户识别===
		If Int(Cls.Web_Mode)>1 And Not Is_LoginTrue Then
			ttt=Cls.Cookies_Get("guest_name")
			ttt=Cls.Code_Html(ttt,1,0)
			If ttt="" Then
				ttt="游客"&Session.SessionID
				Call Cls.Cookies_Set("guest_name",ttt)
			End If
			login_name=ttt
			If Cls.IsONline(ttt) Then
				Call Cls.Exec("update AsaiMHUserLogin set l_where='"&left(tit,50)&"',l_tim_End='"&Cls.now_time&"',l_power='other',l_bbs_id="&ofID&",l_login_id="&login_id&" where l_username='"&ttt&"'",0)
			Else
				Call Cls.Exec("insert into AsaiMHUserLogin(l_username,l_type,l_where,l_tim_login,l_tim_End,l_ip,l_sys,l_power,l_bbs_id,l_login_id) values('"&ttt&"',0,'"&left(tit,50)&"','"&Cls.now_time&"','"&Cls.now_time&"','"&user_ip&"','"&user_sys&"','other',"&ofID&",0)",0)
				'更新在线人数
				If Format_Mid_Num(35) = 0 Then Cls.total_counter=Cls.total_counter+1
				Cls.LK_Online=Cls.LK_Online+1
				Cls.Cache_Set "LK_Online",Cls.LK_Online
			End If
		End If
	        '===注册用户===
	        If Int(Cls.Web_Mode)>0 And Is_LoginTrue then
			UserInfo=Cls.Session_Get(login_username)
			If Cls.IsOnline(login_username) Then
				Call Cls.Exec("update AsaiMHUserLogin set l_where='"&left(tit,50)&"',l_tim_End='"&Cls.now_time&"',l_power='"&login_mode&"',l_bbs_id="&ofID&",l_login_id="&login_id&" where l_username='"&login_username&"'",0)
			Else
				Call Cls.Exec("insert into AsaiMHUserLogin(l_username,l_type,l_where,l_tim_login,l_tim_End,l_ip,l_sys,l_power,l_bbs_id,l_login_id) values('"&login_username&"',1,'"&left(tit,50)&"','"&Cls.now_time&"','"&Cls.now_time&"','"&user_ip&"','"&user_sys&"','"&login_mode&"',"&ofID&","&login_id&")",0)
				'更新在线人数
				If Format_Mid_Num(35) = 0 Then Cls.total_counter=Cls.total_counter+1
				Cls.LK_Online=Cls.LK_Online+1
				Cls.Cache_Set "LK_Online",Cls.LK_Online
				Cls.LK_UserOnline=Cls.LK_UserOnline+1
				Cls.Cache_Set "LK_UserOnline",Cls.LK_UserOnline
			End If
			'Call Cls.Session_Set(login_username,UserInfo)
			'--- 删除用户Session
			' Call Cls.Session_Del(login_username)
		End If
		'--- 删除过期时间用户，更新在线人数
		Cls.UpdateOnline
		online_num=Cls.LK_Online
		'UserOnline_Num=Cls.LK_UserOnline
		If Cint(online_num)>Cint(Cls.Web_InfoNo(3,0)) Then
			Call Cls.ReloadInfo(online_num,3)
			Call Cls.ReloadInfo(Cls.now_time,4)
			Call Cls.Exec("update AsaiMHConfigs set max_online="&online_num&",max_tim='"&Cls.now_time&"'",0)
		End If
		If Format_Mid_Num(35) = 1 Then Cls.total_counter=Cls.total_counter+1
		If Int(Cls.total_counter)>Int(Cls.Web_InfoNo(2,0)) Then
			Call Cls.ReloadInfo(Cls.total_counter,2)
			Call Cls.Exec("update AsaiMHConfigs set counter="&Cls.total_counter,0)
		End If
	End Function

	'--- 查询在某版面的在线总数
	Public Property Get bbs_Online
		bbs_Online=bbs_UserOnline+bbs_GuestOnline
	End Property

	Public Property Get bbs_UserOnline
		Dim l_Online, oRs
		l_Online=-1
		If bbs_ID>0 Then
			Set oRs=Exec("Select Count(l_id) from AsaiMHUserLogin Where l_bbs_id="&bbs_ID&" And l_type=1",1)
			l_Online=oRs(0)
			oRs.Close:Set oRs=Nothing
		End If
		bbs_UserOnline=l_Online
	End Property

	Public Property Get bbs_GuestOnline
		Dim l_GuestOnline, oRs
		l_GuestOnline=-1
		If bbs_ID>0 Then
			Set oRs=Exec("Select Count(l_id) from AsaiMHUserLogin Where l_bbs_id="&bbs_ID&" And l_type=0",1)
			l_GuestOnline=oRs(0)
			oRs.Close:Set oRs=Nothing
		End If
		bbs_GuestOnline=l_GuestOnline
	End Property

	'更新用户资料缓存(缓存用户名,是否需要添加)[0=不添加,只作清理,1=需要添加]
	Public Sub NeedUpdateList(vUserName,vAct)
		Dim Tmpstr,TmpUsername
		Name="NeedToUpdate"
		If Cache_Chk() Then Value=""
		Tmpstr=Value
		TmpUsername=","&vUserName&","
		Tmpstr=Replace(Tmpstr,TmpUsername,",")
		Tmpstr=Replace(Tmpstr,",,",",")
		If vAct=1 Then
			If IsONline(vUserName) Then
				If Tmpstr="" Then
					Tmpstr=TmpUsername
				Else
					Tmpstr=Tmpstr&TmpUsername
				End If
			End If
		End If
		Tmpstr=Replace(Tmpstr,",,",",")
		Value=Tmpstr
	End Sub

	'--- 论坛ID ---
	Public Property Get bbs_ID
		bbs_ID=Code_id("fid")
	End Property

	'--- 页面执行时间 ---
	Public Property Get Exec_Tim
		Exec_Tim=FormatNumber((Timer()-Timer_Start),3)
		If Left(Exec_Tim,1)="." Then Exec_Tim="0"&Exec_Tim
	End Property

	'//* 模板操作部分开始 *//
	'-----------取模板数据---------
	Private Sub LoadTemplateFir(ByVal tcid)
		Dim oSQL, oRs, ncid, nSQLAdd, nSelSQL
		'取频道模板
		nSelSQL = "t_name,t_sid,t_css,t_main,t_config"
		oSQL = "Select Top 1 "&nSelSQL&" From [AsaiMHTemplate] Where t_cid="&tcid&" And t_sid<>0 And IsDefault=1"
		Set oRs = Exec(oSQL,1)
		If Not oRs.Eof Then
			Value = oRs.GetRows()
			oRs.Close
			Set oRs=Nothing
			Exit Sub
		Else
			oRs.Close
		    oSQL = "Select Top 1 "&nSelSQL&" ,t_id From [AsaiMHTemplate] Where t_cid="&tcid&" And t_sid<>0 Order By t_id Desc"
			Set oRs = Exec(oSQL,1)
			If not oRs.Eof Then
			      Call Exec("Update [AsaiMHTemplate] Set IsDefault=True Where t_id="&oRs(5),1)
				  Value = oRs.GetRows()
			      oRs.Close
			      Set oRs=Nothing
			      Exit Sub
			 Else
			      Call ClsErr("频道模板数据是空的，请先添加或拷贝！")
			 End If
		End If
	End Sub

	Private Sub LoadTemplateSec(ByVal ts_id)
	    Dim oSQL, oRs, ncid, nSQLAdd, nSelSQL
	    '取界面方案 
		nSelSQL = "t_name,t_dir,t_config"
		oSQL = "Select Top 1 "&nSelSQL&" From [AsaiMHTemplate] Where t_id="&ts_id
		Set oRs = Exec(oSQL,1)
		If Not oRs.Eof Then
			Value = oRs.GetRows()
			oRs.Close
			Set oRs=Nothing
			Exit Sub
		Else
			Call ClsErr("界面模板数据是空的，请先添加或拷贝！")
		End If			
	End Sub

	'--------分配模板数组------------
	Public Sub LoadTempLate(ByVal ChID)
	    If isLoadTemplate And LoadTemplateID = ChID Then Exit Sub
		On Error Resume Next
		Dim AllStr, Tmpstr
		    '取频道模板数组
			Name="CT_"&ChID
			If Cache_Chk() Then Call LoadTemplateFir(ChID)
			AllStr = Value
			If Not IsArray(AllStr) Then
				ClsErr("频道模板数据不正常！请联系管理员！")
				Exit Sub
			End If
			'If Ubound(AllStr,1)<>4 Then
			'	ClsErr("频道模板的数据不正常！请联系管理员！")
			'	Exit Sub
			'End If
			ctname = AllStr(0,0)
			tsid = AllStr(1,0)
			ctcss = AllStr(2,0)
			'获取数据	
			tmpstr = Split(AllStr(3,0),"@@@")(0)
			ctmain = Split(Tmpstr,"|||")
			tmpstr = Split(AllStr(3,0),"@@@")(1)
			ctmark = Split(Tmpstr,"|||")
			Tmpstr = Split(AllStr(4,0),"@@@")(0)
			ctconfig = Split(Tmpstr,"|||")
			Tmpstr = Split(AllStr(4,0),"@@@")(1)
			ctmarks = Split(Tmpstr,"|||")
			'取界面方案
			Name="IT_"&tsid
			If Cache_Chk() Then Call LoadTemplateSec(tsid)
			AllStr = Value
			If Not IsArray(AllStr) Then
				ClsErr("界面模板数据不正常！请联系管理员！")
				Exit Sub
			End If
			If Ubound(AllStr,1)<>2 Then
				ClsErr("界面模板的数据不正常！请联系管理员！")
				Exit Sub
			End If
			itname = AllStr(0,0)
			itdir = AllStr(1,0)
			'获取数据	
			Tmpstr = Split(AllStr(2,0),"@@@")(0)
			itconfig = Split(Tmpstr,"|||")
			Tmpstr = Split(AllStr(2,0),"@@@")(1)
			itmark = Split(Tmpstr,"|||")
		    '取CSS路径
            R_tstyle = Cls.Web_Dir&"Skin/Template_"&tsid&".css"
			If ctcss <> "" Then 
			
			
			'tstyle = tstyle & Vbcrlf & "<style>" & Vbcrlf & "<!-- 频道 CSS " & Vbcrlf & ctcss & Vbcrlf & "-->" & Vbcrlf & "</style>"
			
			'tstyle = "<link type=""text/css"" href=""/Skin/Gys/Gys_Bbs.css"" rel=stylesheet media=""all"" />"
			
			tstyle =ctcss
			Else
			tstyle = "<link type=""text/css"" href="""&R_tstyle&""" rel=stylesheet media=""all"" />"
            End If
            Erase AllStr
			'常用赋值
			Web_SkinDir = Cls.Web_Dir&"Skin/"&itdir&"/"
			ukong=ReadSkin(8)
            redx=ReadSkin(7)
            go_back=ReadSkin(9)
            web_nologin=ReadSkin(6)
            web_nopost=ReadSkin(5)
			isLoadTemplate = True
			LoadTemplateID = ChID
	End Sub
	
	'--- 模板中常用配置替换 ---
	Public Function ReHtml(ByVal HtmlStr,ByVal HtmlType)
		Dim Rii,OnlineURL,AsaiMHTypes,Online_Num,UserOnline_Num
		ReHtml = Cstr(HtmlStr)
		online_num=Cls.LK_Online
		UserOnline_Num=Cls.LK_UserOnline
		If HtmlType=0 Then
			For Rii=0 To UBound(ctconfig)-1
				ReHtml=Replace(ReHtml,"{$"&ctmarks(Rii)&"}",ctconfig(Rii))
			Next
		End If
	If tit_fir="" Then
		ReHtml = replace(ReHtml,"{$tit_now}","<font title='"&Cls.code_html(Tit,1,0)&"'>"&tit&"</font>")
	Else
		If Index_Url <> "" Then
'			ReHtml = replace(ReHtml,"{$tit_now}","<a href='"&Index_Url&".asp'>"&tit_fir&"</a>&nbsp;→&nbsp;"&Tit&"")
			ReHtml = replace(ReHtml,"{$tit_now}","<a href='"&Index_Url&".asp'>"&tit_fir&"</a>")
		Else
'			ReHtml = replace(ReHtml,"{$tit_now}","<a href='./'>"&tit_fir&"</a>&nbsp;→&nbsp;"&Tit&"")
			ReHtml = replace(ReHtml,"{$tit_now}","<a href='./' class=dvaat>"&tit_fir&"</a>")
		End If
	End If
        If login_username="" Then 
        ReHtml = replace(ReHtml,"{$wel}","<font color=red>游客你好 <script language=javascript src='"&Cls.web_dir&"Style/time.js'></script></font>")  
        ReHtml = replace(ReHtml,"","")
        ReHtml = replace(ReHtml,"{$pass}","<a href='"&Cls.web_dir&"User/Register.asp'>免费注册</a>" ) 
        ReHtml = replace(ReHtml,"{$login}","<a href='"&Cls.web_dir&"User/Login.asp?old_url=back'>用户登陆</a>" ) 
        ReHtml = replace(ReHtml,"{$blog}","<a href='"&Cls.web_dir&"Blog/User.asp?action=reg'>申请博客</a>" ) 
        Else
        ReHtml = replace(ReHtml,"{$wel}","<font color=red><b>"&Format_User_Name(Login_Username,0,"")&"</b>,<script language=javascript src='"&Cls.web_dir&"Style/time.js'></script></font>")   
        ReHtml = replace(ReHtml,"{$pass}","<a href='"&Cls.web_dir&"User/Index.asp'>用户中心</a>" ) 
		ReHtml = replace(ReHtml,"{$login}","<a href='"&Cls.web_dir&"User/Login.asp?action=logout'>退出登陆</a>" ) 
        ReHtml = replace(ReHtml,"{$blog}","<a class=red href='"&Cls.web_dir&"Blog/User.asp?"&Login_Username&"'>我的博客</a>" )    
        End If
        ReHtml = replace(ReHtml,"{$help}","<a style='cursor: help' href='"&Cls.web_dir&"Common/Help.asp'>帮助中心</a>" ) 
		ReHtml = Replace(ReHtml,"{$online}","总在线 <font color=red>"&Online_Num&"</font>&nbsp;人，用户 <font color=blue>"&UserOnline_Num&"</font>&nbsp;人，游客 <font color=green>"&Online_Num - UserOnline_Num&"</font>&nbsp;人")		
	    If Instr(ReHtml,"{$menu}") > 0 then ReHtml = Replace(ReHtml,"{$menu}",Web_XMenuLoad())'两字链接
'	    If Instr(ReHtml,"{$menu}") > 0 then ReHtml = Replace(ReHtml,"{$menu}",Web_MenuLoad())'四字链接
	    If Instr(ReHtml,"{$menubbs}") > 0 then ReHtml = Replace(ReHtml,"{$menubbs}",Web_MenuLoadBbs())
	   	ReHtml = Replace(ReHtml,"{$ggao}",Web_Dim(13))
		ReHtml = Replace(ReHtml,"{$skin_css}",tstyle)
		ReHtml = Replace(ReHtml,"{$pro_edtion}",pro_edition)
		ReHtml = Replace(ReHtml,"{$web_copyright}",Web_CopyRight)		
		ReHtml = Replace(ReHtml,"{$upload_dir}",Web_Upload)
		ReHtml = Replace(ReHtml,"{$download_dir}",Web_Dir&Web_Upload)
		ReHtml = Replace(ReHtml,"{$web_tit}",tit)
		ReHtml = Replace(ReHtml,"{$web_unit}",Web_Common(8))
		ReHtml = Replace(ReHtml,"{$web_url}",Web_Url)
		ReHtml = Replace(ReHtml,"{$web_name}",Web_Name)
		ReHtml = Replace(ReHtml,"{$AsaiMHtopic}",AsaiMHTypes)
		ReHtml = Replace(ReHtml,"{$temp_name}",ctname)					
		ReHtml = Replace(ReHtml,"{$skin_name}",itname)
		ReHtml = Replace(ReHtml,"{$web_email}",Web_Common(6))
	    'ReHtml = Replace(ReHtml,"{$today_time}",today_time)	
	    ReHtml = Replace(ReHtml,"{$today_time}","当前日期："&FormatDateTime(Cls.today_time,1))	
		ReHtml = Replace(ReHtml,"{$ukong}",ukong)
		ReHtml = Replace(ReHtml,"{$redx}",redx)		
		ReHtml = Replace(ReHtml,"{$skin_dir}",Web_SkinDir)
		ReHtml = Replace(ReHtml,"{$AMH_dir}",Cls.AdminFolder)
		ReHtml = Replace(ReHtml,"{$channel_dir}",Web_Dir&ChannelDir&"/")
		ReHtml = Replace(ReHtml,"{$web_dir}",Web_Dir)
		ReHtml = Replace(ReHtml,"{$web_br}",""&vbcrlf&"")
		ReHtml = Replace(ReHtml,"{{$$","{$")
	End Function

	Public Function ReWord(ByVal HtmlStr)
		ReWord = Replace(HtmlStr,"{$","{{$$")
	End Function

	'读取模板数据1
	Public Function ReadTemplate(ByVal tmark)
		If Is_Num(tmark) Then
			ReadTemplate = ctmain(tmark)
		Else
			ReadTemplate = HtmlStream(tmark,ctmark,ctmain)
		End If
	End Function

	'读取模板数据2	
	Public Function ReadSkin(ByVal tmark)
		If Is_Num(tmark) Then
			ReadSkin = itconfig(tmark)
		Else
			ReadSkin = HtmlStream(tmark,itmark,itconfig)
		End If
	End Function

	'通用模板读取	
	Public Sub ReadPage(ByVal str)
		Call Cls.LoadTemplate(ChannelIDs)
		NewContent = Cls.ReadTemplate(str)
		NewContent = LoadWebHead(NewContent)
		NewContent = LoadWebEnd(NewContent)
	End Sub

	Public Sub OutPage()
		NewContent = Cls.ReHtml(NewContent,0)
		Response.Write NewContent
	End Sub
	
	'模板标签替换

	Public Sub HtmlRcod(Mod_Str,View_Str)
	'Microsoft VBScript 运行时错误 错误 800a005e
	'无效使用 Null: Replace	
		If IsDeBug=1 Then On Error Resume Next
		NewContent=Replace(NewContent,"{$"&Mod_Str&"}",View_Str)
	End Sub	

	'命名方式读取HTML流数据
	Private Function HtmlStream(ByVal Mname,ByVal sName,ByVal sValue)
		HtmlStream=""
		If Mname="" Then Exit Function
		If Not IsArray(sName) Or Not IsArray(sValue) Then Exit Function
		If Ubound(sName)<>Ubound(sValue) Then Exit Function
		Dim Sii
		For Sii=0 To UBound(sName)-1
			If LCase(sName(Sii))=LCase(Mname) Then
				HtmlStream=sValue(Sii)
				Exit For
			End If
		Next
	End Function

	'//* 模板操作结束 *//
	'//*页面生成操作开始*//
	'-----生成输出信息初始化1
	Public Sub progress_init1()
		Response.Write ("<table width=""400"" border=""0"" align=""center"" cellpadding=""3"" cellspacing=""1"">")
		Response.Write ("<tr><td style=""text-align:center;""><span id=txt1 Name=txt1 ></span></td></tr>")
		Response.Write ("<tr><td><img src=""images/bar.gIf"" width=0 height=10 id=img1 Name=img1 align=absmiddle></td></tr>")
		Response.Write ("<tr><td><span id=txt2 Name=txt2 ></span></td></tr></table>")
	End Sub

	'--- 生成输出信息初始化2
	Public Sub progress_init()
		Response.Write ("系统消息：<span id=""pstr""></span><div class=""progress1""><div class=""progress2"" id=""progress""></div></div>")
	End Sub

	'--- 生成输出信息
	Public Sub progress(num, str)
		Response.Write "<script>progress.style.width=""" & num & "%"";progress.innerHTML=""" & num & "%"";pstr.innerHTML=""" & str & """;</script>" & vbCrLf
		Response.Flush
	End Sub

	'--- 免防SQL注入检测文件或IP
	Public Function NoChkSqlInFiles()
		NoChkSqlInFiles=False
		If UserTrueIP="127.0.0.1" or Request.ServerVariables("server_name")="localhost" or int(login_modep)=1 or InStr(ScriptName,"Install.asp")>0 then NoChkSqlInFiles=True : Exit Function
		If Instr(Lcase(Web_NoChkFiles),ScriptName)>0 then NoChkSqlInFiles=True
	End Function

	'--- 防SQL注入检测
	Public Sub ChkSQLInWord()
		Dim InWordStr,NameStr,i
		Dim FormWord,QueryStringWord,CookiesWord
		Web_SqlInword = Trim(Web_SqlInword)
		If Web_SqlInword="" then Exit Sub
		InWordStr = Split(LCase(Web_SqlInword),"|")
		For Each NameStr In Request.Form  'POST
			FormWord = FormWord & "|" & Request.Form(NameStr)
		Next
		For Each NameStr In Request.QueryString 'GET
			QueryStringWord = QueryStringWord & "|" & Request.QueryString(NameStr)
		Next
		For Each NameStr In Request.Cookies(Cls.web_cookies) 'Cookies
			CookiesWord = CookiesWord & "|" & Request.Cookies(Cls.web_cookies)(NameStr)
		Next
		FormWord	= LCase(FormWord) & ""
		QueryStringWord	= LCase(QueryStringWord) & ""
		CookiesWord	= LCase(CookiesWord) & ""
		For i=0 To Ubound(InWordStr)
			If Instr(LCase(FormWord & ""),InWordStr(i))<>0 Then
				Call SaveSQLLOG(2,FormWord)
			End If
			If Instr(LCase(QueryStringWord & ""),InWordStr(i))<>0 Then
				Call SaveSQLLOG(3,QueryStringWord)
			End If
			If Instr(LCase(CookiesWord & ""),InWordStr(i))<>0 Then
				Call SaveSQLLOG(4,CookiesWord)
			End If
		Next
	End Sub

	'--- 记录Sql注入事件
	Public Sub SaveSQLLOG(sSqlType,sCommand)
		Dim StrType,sTemp,ErrNum
		ErrNum=Session("ErrNum")
		If Not IsNumeric(ErrNum) then
			ErrNum=1
		Else
			ErrNum=Clng(ErrNum)+1
		End If
		Session("ErrNum")=ErrNum
		If ErrNum >= "&SqlInNumber&" then
			Dim IPstr
			IPstr=Cstr(UserTrueIP)
			If IPstr<>"" And Trim(Web_LockIP)<>"" Then
				Web_LockIP=Replace(Trim(Web_LockIP),IPstr,"")
				Web_LockIP=Replace(Web_LockIP,"||","|")
				IPstr=Web_LockIP & "|" & Replace(IPstr,"|","")
				IPstr=Replace(IPstr,"'","''")
			End If
			If IPstr<>"" and ErrNum < "&SqlInNumber+2&" then
				Call Cls.Exec("Update AsaiMHConfigs Set LockIP='"&IPstr&"'",0)
				Call Cls.Cache_Del("Web_Info")
			End If
			If IPstr<>"" and ErrNum >= "&SqlInNumber+1&" then
				Call Cls.Exec("Update AsaiMHConfigs Set LockIP='"&IPstr&"'",0)
				Call Cls.Cache_Del("Web_Info")
			End If
			Session("ErrNum")= "&SqlInNumber+2&"
			Response.Write "您执行了非法操作次数已经超过"&SqlInNumber&"次，IP已经自动过滤(IP已经自动封闭)！"
			Response.Write "<meta http-equiv=""Refresh"" content=""3; url=" & Request.ServerVariables("script_name") & """ />"
			Response.End
		End If
		Select Case CInt(sSqlType)
		Case 2 : StrType="SQL注入(POST)"
		Case 3 : StrType="SQL注入(GET)"
		Case 4 : StrType="SQL注入(Cookies)"
		Case Else : StrType="非法查询数据表"
		End Select
		Call Cls.Exec("insert into [AsaiMHSqlLog] (ScriptName,S_Info,ip,Type) values ('"&Server.URLEnCode(Request.ServerVariables("PATH_INFO"))&"','"&Checkstr(Server.HTMLEnCode(Left(sCommand,250)))&"','"&UserTrueIP&"','"&StrType&"')",0)
		sTemp="您执行了非法操作，操作已被禁止并作了如下记录↓<br />"
		sTemp=sTemp & "操作ＩＰ："&UserTrueIP&"<br />"
		sTemp=sTemp & "操作时间："&Now()&"<br />"
		sTemp=sTemp & "操作页面："&Request.ServerVariables("PATH_INFO")&"<br />"
		sTemp=sTemp & "操作方式："&StrType&"<br />"
		sTemp=sTemp & "提交数据："&sCommand
		Response.Write sTemp
		Response.End
	End Sub

	'//*页面生成操作结束*//
	'//* 网站、菜单频道信息处理开始 *//
	'//* mType:( 0=前台；1=后台 ) *//
	Private Sub MenuToCache(ByVal mType)
		Dim oRs, oSQL
		If mType = 0 Then
		    If Sqltype = 1 Then
			   oSql="execute AsaiMHInit_Channel"
			Else
			   oSql="Select ChannelIDs,ChannelName,ChannelPicUrl,ChannelRemark,ChannelColor,ChannelBold,ChannelOpenType,ChannelHidden,ChannelType,LinkUrl,ChannelOrder,ModuleType,ChannelDir,ChannelTit,ChannelDataName,ChannelUnit,ChannelListNum,ShowName,ChannElsetup,ClassDepth,RssField,ChannelPut,UploadType,MaxFileSize,PicWidth,PicHeight,UpFileType,CuteNum,LeftCuteNum,ChannelCount,ChannelHits,ChannelOption,ChannelPreSet,UploadDir,IsCreateHtml,HtmlExtName,HtmlPrefix,HtmlPath,HtmlForm,IsNewWindow From [AsaiMHChannel] Where ChannelHidden=0 Order By ChannelOrder,ChannelIDs"
		    End If
		Else
		    If Sqltype = 1 Then
			   oSql="execute AsaiMHInit_Menu"
			Else		
			   oSql="Select MenuID,ChannelIDs,MenuName,MenuTit,MenuSort,MenuUrl,MenuHidden,MenuLevel,MenuDataName,MenuOrder,MenuHelp,MenuTitFir,MenuOpen From [AsaiMHMenu] Order By ChannelIDs,MenuOrder,MenuID"
		    End If		
		End If
		Set oRs=Exec(oSQL,1)
		If Not oRs.Eof Then
			Value=oRs.GetRows(-1)
		Else
			Value=""
		End If
		oRs.Close:Set oRs=Nothing
	End Sub

	'--- 取频道常用信息
	Public Property Get Channel_Menu
		Channel_Menu=Cache_Get("web_menu")
	End Property

	'//* 网站、菜单频道信息处理结束 *//
	'//* 频道信息处理 *//
	'--- 快速载入频道数据
	Public Sub LoadChannel(chanid)
		On Error Resume Next
		Dim Rs,SQL,tmpdata
		chanid = CLng(chanid)
		Name = "MyChannel_" & chanid
		If Cache_Chk() Then
		    If SqlType = 1 Then
			   SQL = "execute AsaiMHLoad_Channel "&chanid
			Else
			   SQL = "Select ChannelName,ChannelDir,ChannelTit,ChannelDataName,ModuleType,HtmlPath,HtmlForm,IsCreateHtml,HtmlExtName,HtmlPrefix FROM [AsaiMHChannel] WHERE  ChannelIDs= " & Clng(chanid)
		    End If
			Set Rs = Exec(SQL,1)
			tmpdata = Rs.GetString(, , "|||", "@@@", "")
			tmpdata = Left(tmpdata, Len(tmpdata) - 3)
			Set Rs = Nothing
			Value = tmpdata
		End If
		ChannelData = Split(Value, "|||")
		ChannelPath = InstallDir & ChannelData(1) & "/"
		ChannelModule = ChannelData(2)
		ChannelDBTable = ChannelData(3)
		ChannelModType = ChannelData(4)
		ChannelHtmPath = ChannelData(5)
		ChannelHtmForm = ChannelData(6)
		ChannelUseHtml = ChannelData(7)
		ChannelHtmlExt = ChannelData(8)
		ChannelPrefix = ChannelData(9)
	End Sub

	'--- 频道初始化操作
	Public Sub Channel_Initialize(ByVal nChannelIDs)
		Dim ChannelDim, Cii, iUpFileType
		If nChannelIDs =< 0 Then Exit Sub
		'--- 载入前台频道设置
		ChannelDim = Channel_Menu
		'--- 遍列菜单设置数据并进行赋值
		For Cii=0 To Ubound(ChannelDim,2)
			If Int(nChannelIDs)=Int(ChannelDim(0,Cii)) Then
				ChannelName		= Code_Html(ChannelDim(1,Cii),1,0)
				ChannelModuleType	= ChannelDim(11,Cii)
				ChannelDir		= Replace(Replace(ChannelDim(12,Cii),"/",""),"\","")
				ChannelTit		= Code_Html(ChannelDim(13,Cii),1,0)
				ChannelTable		= ChannelDim(14,Cii)
				ChannelUnit		= Code_Html(ChannelDim(15,Cii),1,0)
				ChannelListNum		= Int(ChannelDim(16,Cii))
				ChannElsetup		= Cstr(ChannelDim(18,Cii))
				ClassDepth		= ChannelDim(19,Cii)
				ChannelRssField		= ChannelDim(20,Cii)
				ChannelUpType		= Int(ChannelDim(22,Cii))
				ChannelUpMax		= Int(ChannelDim(23,Cii))
				ChannelPicWidth		= Int(ChannelDim(24,Cii))
				ChannelPicHeight	= Int(ChannelDim(25,Cii))
				ChannelUpFileType	= Cstr(ChannelDim(26,Cii))
				ChannelCuteNum		= Int(ChannelDim(27,Cii))
				ChannelLeftCuteNum	= Int(ChannelDim(28,Cii))
				ChannelCount		= ChannelDim(29,Cii)
				ChannelHits		= ChannelDim(30,Cii)
				ChannelOption		= ChannelDim(31,Cii)
				ChannelPreSet		= ChannelDim(32,Cii)
				ChannelUploadDir	= ChannelDim(33,Cii)
				ChannelHtmlPath		= ChannelDim(37,Cii)
				ChannelHtmlForm     	= ChannelDim(38,Cii)
				ChannelIsCreatHtml  	= ChannelDim(34,Cii)
				ChannelHtmlExtName  	= ChannelDim(35,Cii)
				ChannelHtmlPrefix   	= ChannelDim(36,Cii)
				ChannelIsNewWindow  	= ChannelDim(39,Cii)
				ChannelTrue		= True
				Exit For
			End If
		Next
		Erase ChannelDim
		If Not ChannelTrue Then Exit Sub
		If ClassDepth = 0 Then ClassDepth = 99999999
		iUpFileType = Split(ChannelUpFileType,"@@@")
		If Not IsArray(iUpFileType) Then
			ChannelUpFileType = Split("@@@@@@@@@@@@","@@@")
		Else
			ChannelUpFileType = iUpFileType
			Erase iUpFileType
		End If
		If Get_ChannElsetup(ChannElsetup,2) = 1 Then ReviewTrue = True
		If Get_ChannElsetup(ChannElsetup,3) = 1 Then SpecialTrue = True
		If Get_ChannElsetup(ChannElsetup,4) = 1 Then KeyWordTrue = True
		If Get_ChannElsetup(ChannElsetup,5) = 1 Then ErrTrue = True
		If Get_ChannElsetup(ChannElsetup,6) = 1 Then RssTrue = True
		If Get_ChannElsetup(ChannElsetup,8) = 1 Then IsHealth = True
		FrontEditorType = Get_ChannElsetup(ChannElsetup,9)		'前台编辑器参数
		EmpressEditorType = Get_ChannElsetup(ChannElsetup,10)		'后台编辑器参数
	End Sub

	'--- 获取某个频道的某个数组值
	Public Function Get_ChannelRes(ByVal nChannelIDs, ByVal iNum)
		Dim Rii, sChannel
		Get_ChannelRes = ""
		If nChannelIDs = 0 Or Not Is_Int(iNum) Then Exit Function
		sChannel = Channel_Menu
		If Int(iNum) > Int(Ubound(sChannel,1)) Then
			Exit Function
			Erase sChannel
		End If
		For Rii = 0 To Ubound(sChannel,2)
			If Int(nChannelIDs) = sChannel(0,Rii) Then
				Get_ChannelRes = sChannel(iNum,Rii)
				Exit For
			End If
		Next
		Erase sChannel
	End Function

	'--- 读取频道参数值
	'--- 0-发布权、1-分类、2-评论、3-专题、4-关键字、5-报错
	'--- 6-RSS、7-空、8-过滤字符、9-前台编辑器、10-后台编辑器
	Public Function Get_ChannElsetup(ByVal cSetup,ByVal sNum)
		Get_ChannElsetup = 0
		sNum = sNum + 1
		If Len(cSetup) <> 20 Or sNum > 20 Then Exit Function
		Get_ChannElsetup = Int(Mid(cSetup,sNum,1))
	End Function

	'//* 频道专题、关键字处理 *//
	Public Sub Special_KeyWord_ToCache(ByVal oChannelIDs,ByVal oType)
		Dim oRs, oSQL
		If oChannelIDs = 0 Then Exit Sub
		oSql="Select * From [AsaiMHSpecial] Where ChannelIDs="&oChannelIDs&" Order By ID"
		If oType = 1 Then
			oSql="Select * From [AsaiMHKeyWord] Where ChannelIDs="&oChannelIDs&" Order By ID"
		End If
		Set oRs=Exec(oSQL,1)
		If Not oRs.Eof Then
			Value=oRs.GetRows()
		Else
			Value=""
		End If
		oRs.Close:Set oRs=Nothing
	End Sub

	'//分类生成
	Public Function GetClassMenu(sChannelID)
		Call Channel_Initialize(sChannelID)
		Dim GudideColor,GudideColor2,ModNum
		Dim sTemp ,UrlTo
		'定义相关颜色
		GudideColor="#000000"'大菜单的颜色
		GudideColor2="#EE0000"'大菜单鼠标移到上面的颜色
		Sql="select top 1 BornClassRowNum from AsaiMHChannel where ChannelIDs="&sChannelID 
		set rs=Cls.exec(Sql,1) 
		if not rs.eof then 
			ModNum=rs("BornClassRowNum") 
			rs.close
		end if 
		if ModNum = "" Or ModNum = 0 then ModNum = 12
		sTemp = "<!--" & vbcrlf
		sTemp = sTemp & "stm_bm(['uueoehr',400,'','"&Cls.Web_Dir&"Images/Blank.gIf',0,'','',0,0,0,0,0,1,0,0]);" & vbcrlf
		sTemp = sTemp & "stm_bp('p0',[0,4,0,0,2,2,0,0,100,'',-2,'',-2,90,0,0,'#000000','transparent','',3,0,0,'#000000']);" & vbcrlf
		sTemp = sTemp & "stm_ai('p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#EEFFFF',1,'#EEFFFF',1,'','',3,3,0,0,'#FFFFFF','#000000','"&GudideColor&"','"&GudideColor2&"','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf
		sTemp = sTemp & "stm_aix('p0i1','p0i0',[0,'"&Cls.ChannelName&"','','',-1,-1,0,'" & Cls.Web_Dir & Cls.ChannelDir & "','_self','" & Cls.Web_Dir & Cls.ChannelDir & "','','','',0,0,0,'','',0,0,0,0,1,'#EEFFFF',1,'#EEFFFF',1,'','',3,3,0,0,'#FFFFFF','#DD0000','"&GudideColor&"','"&GudideColor2&"','9pt 宋体','9pt 宋体']);" & vbcrlf
		sTemp = sTemp & "stm_aix('p0i2','p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#EEFFFF',1,'#EEFFFF',1,'','',3,3,0,0,'#FFFFFF','#000000','"&GudideColor&"','"&GudideColor2&"','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf
		dim SQL,Rs,j
		Sql="Select C_ID,ClassName,ClassParentStr,HtmlFileDir,ClassDepth,ClassChild From AsaiMHClass where ChannelIDs="&Cint(sChannelID)&" and ClassDepth=0  order by ClassID"
		Set rs = Cls.Exec(SQL,1)
		If Not (Rs.bof and Rs.eof) then
			SQL = Rs.GetRows(-1)
			Cls.pNum = 1 : Cls.pNum2 = 0
			For j=0 to Ubound(SQL,2)
				If (j+1) mod ModNum=0 then
					sTemp = sTemp & "stm_em();" & vbcrlf
					sTemp = sTemp & "//-->" & vbcrlf
					sTemp = sTemp & "<!--" & vbcrlf
					sTemp = sTemp & "stm_bm(['uueoehr',400,'','"&Cls.Web_Dir&"images/blank.gIf',0,'','',0,0,0,0,0,1,0,0]);" & vbcrlf
					sTemp = sTemp & "stm_bp('p0',[0,4,0,0,2,2,0,0,100,'',-2,'',-2,90,0,0,'#000000','transparent','',3,0,0,'#000000']);" & vbcrlf
					sTemp = sTemp & "stm_ai('p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#EEFFFF',1,'#EEFFFF',1,'','',3,3,0,0,'#FFFFFF','#000000','"&GudideColor&"','"&GudideColor2&"','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf
				End If
                    If Cls.ChannelIsCreatHtml = True then
					   Urlto=Cls.Web_Dir & Cls.ChannelDir&"/"&SQL(3,j) & "index_1"&Cls.ChannelHtmlExtName
				    Else
					   Urlto=Cls.Web_Dir & Cls.ChannelDir&"/List.asp?c_id="&SQL(0,j)
				    End If
					sTemp = sTemp & "stm_aix('p0i"&j&"','p0i0',[0,'" & SQL(1,j) & "','','',-1,-1,0,'" & UrlTo & "','_self','" & UrlTo & "','" & SQL(1,j) & "','','',0,0,0,'','',0,0,0,0,1,'#EEFFFF',1,'#EEFFFF',1,'','',3,3,0,0,'#FFFFFF','#DD0000','"&GudideColor&"','"&GudideColor2&"','9pt 宋体','9pt 宋体']);" & vbcrlf
				If SQL(5,j)>0 then
					sTemp = sTemp & GetChildMenu(SQL(0,j),0,sChannelID)
				End If
				sTemp = sTemp & "stm_aix('p0i2','p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#EEFFFF',1,'#EEFFFF',1,'','',3,3,0,0,'#FFFFFF','#000000','"&GudideColor&"','"&GudideColor2&"','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf
			Next
			Sql=Empty
		End If
		Rs.Close : Set Rs=Nothing
		sTemp = sTemp & "stm_em();" & vbcrlf
		GetClassMenu = Cls.ReHtml(sTemp,1) & "//-->"
		sTemp=Empty
	End Function

	Public Function GetChildMenu(ID,ShowType,sChannelID)
		dim SQL,Rs,k,sTemp,tUrlTo
		If Cls.pNum=1 then
			sTemp = "stm_bp('p" & Cls.pNum & "',[1,4,0,0,2,3,6,7,100,'progid:DXImageTransform.Microsoft.Fade(overlap=.5,enabled=0,Duration=0.43)',-2,'',-2,67,2,3,'#D5DEE2','#FFFFFF','',3,1,1,'#C6D8E0']);" & vbcrlf
		Else
			If ShowType=0 then
				sTemp = "stm_bpx('p" & Cls.pNum & "','p" & Cls.pNum2 & "',[1,4,0,0,2,3,6]);" & vbcrlf
			Else
				sTemp = "stm_bpx('p" & Cls.pNum & "','p" & Cls.pNum2 & "',[1,2,-2,-3,2,3,0]);" & vbcrlf
			End If
		End If
		Sql="Select C_ID,ClassName,ClassParentStr,HtmlFileDir,ClassDepth,ClassChild From AsaiMHClass where ChannelIDs="&Cint(sChannelID)&"and ClassParent=" & ID & " order by ClassOrder asc"
		Set rs = Cls.Exec(SQL,1)
		If Not (Rs.Bof and Rs.Eof) THen
			SQL = Rs.GetRows(-1)
			For k=0 to Ubound(SQL,2)
					If SQL(5,k) > 0 then
                      If Cls.ChannelIsCreatHtml = True then
					     tUrlto=Cls.Web_Dir & Cls.ChannelDir&"/"&SQL(3,k) & "index_1"&Cls.ChannelHtmlExtName
				      Else
					     tUrlto=Cls.Web_Dir & Cls.ChannelDir&"/List.asp?c_id="&SQL(0,k)
				      End If					
					sTemp = sTemp & "stm_aix('p"&Cls.pNum&"i"&k&"','p"&Cls.pNum2&"i0',[0,'" & SQL(1,k) & "','','',-1,-1,0,'" & tUrlTo & "','_self','" & tUrlTo & "','" & SQL(1,k) & "','','',6,0,0,'"&Cls.Web_Dir&"images/arrow_r.gIf','"&Cls.Web_Dir&"Images/Arrow_w.gIf',7,7,0,0,1,'#FFFFFF',0,'#DD0000',0,'','',3,3,0,0,'#FFFFFF','#000000','#000000','#FFFFFF','9pt 宋体']);" & vbcrlf
					Cls.pNum=Cls.pNum+1 : Cls.pNum2=Cls.pNum2+1
					sTemp = sTemp & GetChildMenu(SQL(0,k),1,sChannelID)
					Else
                      If Cls.ChannelIsCreatHtml = True then
					     tUrlto=Cls.Web_Dir & Cls.ChannelDir&"/"&SQL(3,k) & "index_1"&Cls.ChannelHtmlExtName
				      Else
					     tUrlto=Cls.Web_Dir & Cls.ChannelDir&"/List.asp?c_id="&SQL(0,k)
				      End If						
					sTemp = sTemp & "stm_aix('p"&Cls.pNum&"i"&k&"','p"&Cls.pNum2&"i0',[0,'" & SQL(1,k) & "','','',-1,-1,0,'" & tUrlTo & "','_self','" & tUrlTo & "','" & SQL(1,k)& "','','',0,0,0,'','',0,0,0,0,1,'#EEFFFF',1,'#F3F6E3',0,'','',3,3,0,0,'#FFFFFF','#DD0000','#000000','#DD0000','9pt 宋体']);" & vbcrlf
					End If
			Next
			Sql=Empty
		End If
		Rs.Close : Set Rs=Nothing
		GetChildMenu = sTemp & "stm_ep();" & vbcrlf
		sTemp=Empty
	End Function	

	'//* 模板缓存操作部分开始 *//
	'--- 转换缓存名称小写
	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(InstallCookies & "_" & LocalCacheName) = Cache_Data
			Application.unLock
		Else
			ClsErr("缓存名称未设置 或 与已有的重复！请重新设置！")
		End If
	End Property

	'--- 缓存取值，数组0
	Public Property Get Value()
		If LocalCacheName<>"" Then
			Cache_Data=Application(InstallCookies & "_" & LocalCacheName)
			If IsArray(Cache_Data) Then
				Value=Cache_Data(0)
			Else
				ClsErr("缓存 ("&LocalCacheName&") 没有内容 ！")
			End If
		Else
			ClsErr("缓存名称未设置 或 与已有的重复！请重新设置！")
		End If
	End Property

	'//* 打印类错误页面 *//
	Private Sub ClsErr(ClsStr)
		Response.Clear
		Response.Write "<b><font size=8 color=red>Error!</font></b><br/>"
		Response.Write "# 阿赛大型门户网站系统在运行时发生错误<br/>"
		Response.Write "# 以下是错误信息:<br /><hr width=500 align=left>"
		Response.Write ClsStr
		If Err.Number <> 0 then    
				Response.Write "<hr width=500 align=left>"
				Response.Write "ASP内置错误描述："&Err.Description &"<br/> "
				Err.Clear
		End If
		Response.Write "<hr width=500 align=left>"
		Response.Write "# 请联系  阿赛大型门户网  技术人员求助解决!<br/>"
		Response.Write "# 支持方式：<b>QQ（<font color=blue>4941172</font>） </b><br/>"
		Response.Write "# 系统版本："&pro_edition&""&"<br/>"
		Response.Write "# 官方网站：Http://77ya.Com"&"<br/>"
		Response.Write "# "&Now()
		Response.End
	End Sub

	'//* 数据库操作部分开始 *//
	Public Function Exec(Esql,Etype)
		If IsConn=False Then Call Conn_Open()
		If IsDeBug=1 Then On Error Resume Next
		Select Case Etype
		Case 0
			Conn.Execute(Esql)
		Case 1
			Set Exec=Conn.Execute(Esql)
		End Select
		If IsView=1 Then Call ClsErr ("错误的SQL语句："&esql&"<br />")
		If Err And IsDeBug=1 Then
			Call ClsErr ("错误的SQL语句："&esql &"<br />")
			Response.End
		End If
		Num_Rs=Num_Rs+1
	End Function

	Public Function Exe_Conn(Ers,Esql,Etype)
		If IsConn=False Then Call Conn_Open()
		If IsDeBug=1 Then On Error Resume Next
		Ers.Open Esql,Conn,1,Etype
		If IsView=1 Then Call ClsErr ("错误的SQL语句："&esql&"<br />")
		If Err And IsDeBug=1 Then
			Call ClsErr ("错误的SQL语句："&esql&"<br />")
			Response.End
		End If
		Num_Rs=Num_Rs+1
	End Function

	Private Sub Conn_Open()
                On Error Resume Next
		Set Conn=Server.CreateObject("Adodb.Connection")
		Set Rs=Server.CreateObject("Adodb.Recordset")
		Conn.Open SqlConnstr
		If Err And IsDeBug=1 Then
			Call ClsErr ("数据库连接失败,请打开Include/Conn.asp并修改数据库连接字符串!")
			Response.End
                Else
		        IsConn=True
		End If
	End Sub

	'函数:SqlServer(97-2000) to Access(97-2000)
	'参数:Sql,数据库类型(ACCESS,SQLSERVER)
	'说明:
	Private Function Sql_To_Access(ByVal vNewSql)
		Dim regEx, Matches, Match, vSql
		vSql=vNewSql
		'创建正则对象
		Set regEx = New RegExp
		regEx.IgnoreCase = True
		regEx.Global = True
		regEx.MultiLine = True
		'转:GetDate()
		regEx.Pattern = "(?=[^']?)GETDATE\(\)(?=[^']?)"
		vSql = regEx.Replace(vSql,"NOW()")
		'转:UPPER()
		regEx.Pattern = "(?=[^']?)UPPER\([\s]?(.+?)[\s]?\)(?=[^']?)"
		vSql = regEx.Replace(vSql,"UCase($1)")
		'转:日期表示方式
		'说明:时间格式必须是2004-23-23 11:11:10 标准格式
		regEx.Pattern = "'([\d]{4,4}\-[\d]{1,2}\-[\d]{1,2}(?:[\s][\d]{1,2}:[\d]{1,2}:[\d]{1,2})?)'"
		vSql = regEx.Replace(vSql,"#$1#")
		regEx.Pattern = "DATEDIfF\([\s]?(mi|second|minute|hour|d|month|year)[\s]?\,[\s]?(.+?)[\s]?\,[\s]?(.+?)([\s]?\)[\s]?)"
		Set Matches = regEx.ExeCute(vSql)
		Dim temStr
		For Each Match In Matches
		temStr = "DATEDIfF("
		Select Case lCase(Match.SubMatches(0))
		Case "mi" :
			temStr = temStr & "'n'"
                Case "second" :
			temStr = temStr & "'s'"
                Case "minute" :
			temStr = temStr & "'n'"
                Case "hour" :
			temStr = temStr & "'h'"
                Case "d" :
			temStr = temStr & "'d'"
                Case "month" :
			temStr = temStr & "'m'"
                Case "year" :
			temStr = temStr & "'y'"
		End Select
		temStr = temStr & "," & Match.SubMatches(1) & "," &  Match.SubMatches(2) & Match.SubMatches(3)
		vSql = Replace(vSql,Match.Value,temStr,1,1)
		Next
		'转:Insert函数
		regEx.Pattern = "CHARINDEX\([\s]?'(.+?)'[\s]?,[\s]?'(.+?)'[\s]?\)[\s]?"
		vSql = regEx.Replace(vSql,"INSTR('$2','$1')")
		Set regEx = Nothing
		Sql_To_Access = vSql
	End Function

	'-- 地址处理
	Function Url_True(puu,pus)
		dim pupload,pu
		pupload=puu
		pu=pus
		If instr(1,pu,"://")<>0 then
			url_true=pu
			'url_true=Web_Dir&pu
		Else
			If pupload="" then pupload=web_upload
			If right(pupload,1)<>"/" then pupload=pupload&"/"
			url_true=Web_Dir&pupload&pu
		End If
	End Function

	'-- 读取当前地址
	Function Own_Http()
		dim ssort
		ssort=trim(request.servervariables("server_port"))
		own_http="http://"&trim(request.servervariables("server_name"))
		If ssort<>"80" then own_http=own_http&":"&ssort
		If right(own_http,1)<>"/" then own_http=own_http&"/"
	End Function

	'-- 链接地址检测
	Sub Own_Dir()
		dim path_info,now_dir,ndd
		path_info=request.servervariables("path_info")
		now_dir=left(path_info,instrrev(path_info,"/"))
		web_now_dir=now_dir
		ndd=own_http()
		Web_RealURL=left(ndd,len(ndd)-1)	
		web_urls=Web_RealURL&now_dir
	End Sub

	'-----------------------------------时间格式处理------------------------------------
	Function Time_Type(tvar,tt)
		dim ttt,d_year,d_month,d_day,d_hour,d_minute,d_second
		ttt=tvar
		If ttt="" or isnull(ttt) then ttt=now_time
		If not(isdate(ttt)) then
			time_type=""
			exit function
		End If
		d_year=year(ttt)
		d_month=month(ttt)
		If len(d_month)<2 then d_month="0"&d_month
		d_day=day(ttt)
		If len(d_day)<2 then d_day="0"&d_day
		d_hour=hour(ttt)
		If len(d_hour)<2 then d_hour="0"&d_hour
		d_minute=minute(ttt)
		If len(d_minute)<2 then d_minute="0"&d_minute
		d_second=second(ttt)
		If len(d_second)<2 then d_second="0"&d_second
		Select Case tt
		Case 1	'2000-10-10 23:45:45
			time_type=d_year&"-"&d_month&"-"&d_day&" "&d_hour&":"&d_minute&":"&d_second
		Case 11	'20001010234545
			time_type=d_year&d_month&d_day&d_hour&d_minute&d_second
		Case 2	'年(4)-月-日 时:分:秒
			time_type=d_year&"年"&d_month&"月"&d_day&"日 "&d_hour&"时"&d_minute&"分"&d_second&"秒"
		Case 3	'10-10 23:45
			time_type=d_month&"-"&d_day&" "&d_hour&":"&d_minute
		Case 4	'2003-10-10
			time_type=d_year&"-"&d_month&"-"&d_day
		Case 5	'2003年10月10日
			time_type=d_year&"年"&d_month&"月"&d_day&"日"
		Case 6	'10-10
			time_type=d_month&"-"&d_day
		Case 7	'03-10-10
			time_type=right(d_year,len(d_year)-2)&"-"&d_month&"-"&d_day
		Case 8	'20001010234545(同11)
			time_type=d_year&d_month&d_day&d_hour&d_minute&d_second
		Case Else
			time_type=ttt
		End Select
	End Function

	'//* 字符类型处理 *//  
	Public Function ChkBoolean(ByVal Values)
		If TypeName(Values) = "Boolean" Or IsNumeric(Values) Or LCase(Values) = "false" Or LCase(Values) = "true" Then
			ChkBoolean = CBool(Values)
		Else
			ChkBoolean = False
		End If
	End Function

	Public Function CheckNumeric(ByVal CHECK_ID)
		If CHECK_ID <> "" And IsNumeric(CHECK_ID) Then
			CHECK_ID = CCur(CHECK_ID)
		Else
			CHECK_ID = 0
		End If
		CheckNumeric = CHECK_ID
	End Function

	Public Function ChkNumeric(ByVal CHECK_ID)
		If CHECK_ID <> "" And IsNumeric(CHECK_ID) Then
			CHECK_ID = CLng(CHECK_ID)
			If CHECK_ID < 0 Then CHECK_ID = 0
		Else
			CHECK_ID = 0
		End If
		ChkNumeric = CHECK_ID
	End Function

	Public Function CheckStr(ByVal str)
		If IsNull(str) Then
			CheckStr = ""
			Exit Function
		End If
		str = Replace(str, Chr(0), "")
		CheckStr = Replace(str, "'", "''")
	End Function

	'-- 进行脚本过滤
	Function CheckScript(Content)
		Dim oRegExp,oMatch,spamCount
		Set oRegExp = New Regexp
		oRegExp.IgnoreCase = True
		oRegExp.Global = True
		oRegExp.pattern ="<script.+?/script>"
		Content=oRegExp.replace(Content,"")
		oRegExp.pattern ="<Iframe.+?/Iframe>"
		Content=oRegExp.replace(Content,"")		
		Set oRegExp=Nothing
		CheckScript=Content
	End Function

	'//* 字符串处理 *//
	'-- 判断字符串是否为空
	Public Function Is_Null(ByVal sVal)
		Is_Null=Trim(sVal)
		If Is_Null="" Or IsNull(Is_Null) Then Is_Null=""
	End Function

	'-- 判断是否为整数类型，返回布尔值
	Public Function Is_Int(ByVal sVal)
		Is_Int=True
		If Is_Null(sVal)="" Or Not(IsNumeric(sVal)) Or Instr(sVal,".")>0 Then Is_Int=False
	End Function

	'-- 判断是否为数字类型，返回布尔值
	Public Function Is_Num(ByVal sVal)
		Is_Num=True
		If Is_Null(sVal)="" Or Not(IsNumeric(sVal)) Then Is_Num=False
	End Function

	'-- E-Mail判断
	Public Function Is_Email(ByVal sEmail,ByVal sEn)
		Dim names,name,ei,c
		Is_Email=False
		names=Split(sEmail,"@")
		If Ubound(names)<>1 Or sEmail="" Then
			Exit Function
		End If
		For Each name In names
			If Len(name) <= 0 Then
				Exit Function
			End If
			For ei=1 To Len(name)
				c=LCase(Mid(name,ei,1))
				If Instr("abcdefghijklmnopqrstuvwxyz-_.",c)<= 0 And Not(IsNumeric(c)) Then
					Exit Function
				End If
			Next
			If Left(name,1)="." Or Right(name,1)="." Then
				Exit Function
			End If
		Next
		If Instr(names(1),".")<=0 Or Len(sEmail)>sEn Then
			Exit Function
		End If
		Is_Email=True
	End Function

	'-- 字符处理
	Public Function Code_Var(ByVal sVal)
		Dim Strer
		Strer=Is_Null(sVal)
		If Strer="" Then
			Code_Var=""
			Exit Function
		End If
		Strer=Replace(Strer,"'","""")
		Code_Var=Strer
	End Function

	Public Function Code_Encrypt(ByVal sVal)
		Dim Strer
		Strer=Is_Null(sVal)		
		If Strer="" Then
			Code_Encrypt=""
			Exit Function
		End If		
		Code_Encrypt=Strer
	End Function

	'-- 处理 Form 值
	Public Function Code_Form(ByVal sVal)
		Dim Strer
		Strer=Trim(Request.Form(sVal))
		Strer=Replace(Strer,"'","""")
		Code_Form=Strer
	End Function

	Public Function Code_Sel(ByVal sVal, ByVal sType)
		Dim Strer, TmpStr, Tmp, TmpDim, m
		For Each Strer In Request.Form(sVal)
			TmpStr = Replace(Replace(Strer,",","")," ","")
			If sType = 1 Then
				If Not Is_Int(TmpStr) Then TmpStr = ""
			End If
			If TmpStr<>"" Then
				If Tmp = "" Then
					Tmp = TmpStr
				Else
					Tmp = Tmp & "," & TmpStr
				End If
			End If
		Next
		Code_Sel = Tmp
	End Function

	'-- 处理 Query 值
	Public Function Code_Query(ByVal sVal)
		Dim Strer
		Strer=Trim(Request.Querystring(sVal))
		Strer=Replace(Strer,"'","")
		Strer=Replace(Strer,"""","")
		Code_Query=Strer
	End Function

	Public Function Code_Remark(ByVal sVal)
		Dim Strer
		Strer=Request.Form(sVal)
		Code_Remark=SaveContent(Strer)
	End Function

	'-- 处理 ID 传入值
	Public Function Code_Id(ByVal sVal)
		Dim Strer
		Strer=Trim(Request.Querystring(sVal))
		If Not(Is_Int(Strer)) Then Strer=0
		Code_Id=Clng(Strer)
	End Function

	'-- 处理整数值
	Public Function Code_Int(ByVal Strers,ByVal Sint)
		Dim Strer
		Strer=Code_Form(Strers)
		If Not(Is_Int(Strer)) Then
			Code_Int=Sint
			Exit Function
		End If
		Code_Int=Int(Strer)
	End Function

	'取各种返回值
	'Strers:字符串
	'At    :类型
	'Acut  :截短字符串数
	Public Function Code_Admin(ByVal Strers,ByVal At,ByVal Acut)
		Dim Strer
		Strer=Trim(Strers)
		Select Case Int(At)
		Case 1
			Strer=Trim(Request.Form(Strer))
		Case 2
			Strer=Trim(Request.QueryString(Strer))
		End Select
		If Is_Null(Strer)="" Then
			Code_Admin=""
			Exit Function
		End If
		Strer=Replace(Strer,"'","""")
		If Int(Acut)>0 Then Strer=Left(Strer,Acut)
		Code_Admin=Strer
	End Function

	Public Function Code_Word(ByVal Strers)
		Dim Strer
		Strer=Trim(Strers)
		If Is_Null(Strer)="" Then
			Code_Word=""
			Exit Function
		End If
		Strer=Replace(Strer,Chr(39),"&#39;")		'单引号
		Strer=Replace(Strer,"<textarea","&lt;textarea")
		Strer=Replace(Strer,"</textarea>","&lt;/textarea&gt;")
		Strer=Replace(Strer,"<","&lt;")
		Strer=Replace(Strer,">","&gt;")
		Code_Word=Strer
	End Function

	Public Function Code_Js(ByVal Strers,ByVal Tt)
		Dim Strer
		Strer=Trim(Strers)
		If Is_Null(Strer)="" Then
			Code_Js=""
			Exit Function
		End If
		Strer=Replace(Strer,"\","\\")
		Strer=Replace(Strer,Chr(39),"&#39;")		'单引号
		'Strer=Replace(Strer,Chr(39),"\'")
		Strer=Replace(Strer,Chr(34),"&quot;")		'双引号
		'Strer=Replace(Strer,Chr(34),"\""")
		Select Case Tt
		Case 0
			'Strer=Replace(Strer,VbCrlf,"")			'回车
			Strer=Replace(Strer,Chr(10),"")
			Strer=Replace(Strer,Chr(13),"")
		Case 1
			'Strer=Replace(Strer,VbCrlf,"\n")			'回车
			Strer=Replace(Strer,Chr(10),"\n")
			Strer=Replace(Strer,Chr(13),"")
		End Select
		If Right(Strer,1)="\" Then
			Strer=Strer&"n"
		End If
		Code_Js=Strer
	End Function

	Public Function Code_Html(ByVal Strers,ByVal Chtype,ByVal CuteNum)
		Dim Strer
		Strer=Trim(Strers)
		If Is_Null(Strer)="" Then
			Code_Html=""
			Exit Function
		End If
		If CuteNum>0 Then Strer=Cuted(Strer,CuteNum)
		Strer=Replace(Strer,"<","&lt;")
		Strer=Replace(Strer,">","&gt;")
		Strer=Replace(Strer,Chr(39),"&#39;")		'单引号
		Strer=Replace(strer,Chr(34),"&quot;")		'双引号
		Strer=Replace(strer,Chr(33),"&nbsp;")		'空格
		Select Case Chtype
		Case 1
			Strer=Replace(Strer,Chr(9),"&nbsp;")		'table
			'Strer=Replace(Strer,VbCrlf,"")			'回车
			Strer=Replace(Strer,"{$web_dir}",Web_Dir)
			Strer=Replace(Strer,"{$download_dir}",Web_Dir&Web_Upload)
			Strer=Replace(Strer,Chr(10),"")
			Strer=Replace(Strer,Chr(13),"")
		Case 2
			Strer=Replace(Strer,Chr(9),"&nbsp;　&nbsp;")	'table
			'Strer=Replace(Strer,VbCrlf,"<br \>")		'回车
			Strer=Replace(Strer,Chr(10),"<br \>")
			Strer=Replace(Strer,Chr(13),"")
		End Select
		Code_Html=Strer
	End Function

	'获取指定数字的简介内容并除去标签
	Public Function Code_Cut(ByVal str, ByVal strLen)
		On Error Resume Next
		Dim HtmlStr, l, re, strContent
		HtmlStr = str
		HtmlStr = Replace(HtmlStr, "&nbsp;", " ")
		HtmlStr = Replace(HtmlStr, "&quot;", Chr(34))
		HtmlStr = Replace(HtmlStr, "&#39;", Chr(39))
		HtmlStr = Replace(HtmlStr, "&#123;", Chr(123))
		HtmlStr = Replace(HtmlStr, "&#125;", Chr(125))
		HtmlStr = Replace(HtmlStr, "&#36;", Chr(36))
		HtmlStr = Replace(HtmlStr, vbCrLf, "")
		HtmlStr = Replace(HtmlStr, "====", "")
		HtmlStr = Replace(HtmlStr, "----", "")
		HtmlStr = Replace(HtmlStr, "////", "")
		HtmlStr = Replace(HtmlStr, "\\\\", "")
		HtmlStr = Replace(HtmlStr, "####", "")
		HtmlStr = Replace(HtmlStr, "@@@@", "")
		HtmlStr = Replace(HtmlStr, "****", "")
		HtmlStr = Replace(HtmlStr, "~~~~", "")
		Set re = New RegExp
		re.IgnoreCase = True
		re.Global = True
		re.Pattern = "\[br\]"
		HtmlStr = re.Replace(HtmlStr, "")
		re.Pattern = "\[align=right\](.*)\[\/align\]"
		HtmlStr = re.Replace(HtmlStr, "")
		re.Pattern = "<(.[^>]*)>"
		HtmlStr = re.Replace(HtmlStr, "")
		Set re = Nothing
		HtmlStr = Replace(HtmlStr, "&gt;", ">")
		HtmlStr = Replace(HtmlStr, "&lt;", "<")
		l = Len(HtmlStr)
		If l >= strLen Then
			strContent = Left(HtmlStr, strLen) & "..."
		Else
			strContent = HtmlStr & " "
		End If
		strContent = Replace(strContent, Chr(34), "&quot;")
		strContent = Replace(strContent, Chr(39), "&#39;")
		strContent = Replace(strContent, Chr(36), "&#36;")
		strContent = Replace(strContent, Chr(123), "&#123;")
		strContent = Replace(strContent, Chr(125), "&#125;")
		strContent = Replace(strContent, ">", "&gt;")
		strContent = Replace(strContent, "<", "&lt;")
		Code_Cut = strContent
	End Function

	'过滤非法的SQL字符
	Public Function ReplaceBadChar(Byval strChar)
		strChar = Replace(Replace(strChar," ",""),"'","")
		strChar = Replace(Replace(strChar,">",""),"<","")
		strChar = Replace(Replace(strChar,")",""),"(","")
		strChar = Replace(Replace(strChar,"?",""),"*","")
		strChar = Replace(Replace(strChar,Chr(0),""),".","")
		'strChar = Replace(Replace(strChar,"/",""),"\","")
		ReplaceBadChar = strChar
	End Function

	'过滤不健康的字符串
	Public Function Code_Health(ByVal Strer)
		Dim i,BadWords,iBadWords,lBadWords,rBadWords
		Code_Health=Strer
		If Not IsHealth Then Exit Function
		BadWords=Split(Web_BadWords,"|")
		For i=0 To Ubound(BadWords)
		  iBadWords=Split(BadWords(i),"=")
		  lBadWords=iBadWords(0)
		  rBadWords=iBadWords(1)
		  Code_Health=Replace(Code_Health,lBadWords,rBadWords)
		Next
		Erase BadWords
	End Function

	Public Function LoadContent(ByVal Strers)
		Dim Strer
		Strer=Trim(Strers)
		If Is_Null(Strer)="" Then
			LoadContent=""
			Exit Function
		End If
		Strer=Replace(Strer,"{$web_dir}", Web_RealURL & Web_Dir)		
		Strer=Replace(Strer,"{$download_dir}", Web_RealURL & Web_Dir & Web_Upload)
		LoadContent=Strer
	End Function

	Public Function SaveContent(ByVal Strers)
		Dim Strer
		Strer=Trim(Strers)
		If Is_Null(Strer)="" Then
			SaveContent=""
			Exit Function
		End If
		Strer=Replace(Strer, Web_RealURL & Web_Dir & Web_Upload,"{$download_dir}")
		'Strer=Replace(Strer, Web_RealURL & Web_Dir,"{$web_dir}")
		Strer=Replace(Strer,""&Web_Dir&"Common/ResourcesUp.Asp","{$web_dir}Common/ResourcesUp.Asp")
		SaveContent=Strer
	End Function

	'能识别中文字的通用字符分割器(取指定长度的字符，标题显示用）OK
	'Types      为输入的待分割字符
	'Num        为分割的长(字节数，中文为２字节),左起第几个
	Public Function Cuted(ByVal Types,ByVal Num)
		If Is_null(Types) = "" Or Types = "" Then
			Cuted = ""
			Exit Function
		Else
			If Str_Length(Types) > Cint(Num) Then
				Types = Str_Left(Types,Cint(Num))
				Cuted = Types & ".."
			Else
				Cuted = Types
			End If
		End If
	End Function

	'能识别中文字的left(),中文为２字节 OK
	'Strers 为原字符串
	'Num 为需要(左)截取的位数
	Public Function Str_Left(ByVal Strers,ByVal Num)
		Dim Temp_Str, Test_Str, Lens, i
		Temp_Str = Len(Strers)
		For i = 1 To Temp_Str
		Test_Str = Mid(Strers, i, 1)
		Str_Left = Str_Left & Test_Str
		If Asc(Test_Str) > 0 Then
			Lens = Lens + 1
		Else
			Lens = Lens + 2
		End If
		If Lens >= Cint(Num) Then
			Exit For
		End If
		Next
	End Function

	'能识别中文字的len(),中文为２ OK
	'Strers 为待检测长度的字符串
	Public Function Str_Length(ByVal Strers)
		On Error Resume Next
		Dim Winnt_Chinese
		Winnt_Chinese = (Len("中国") = 2)
		If Winnt_Chinese = True Then
			Dim LNum, TNum, CNum, i
			LNum = Len(Strers)
			TNum = LNum
			For i = 1 To LNum
				CNum = Asc(Mid(Strers, i, 1)) '返回字符的代码值
				If CNum < 0 Then
					CNum = CNum + 65536
				End If
				If CNum > 255 Then
					TNum = TNum + 1
				End If
			Next
			Str_Length = TNum
		Else
			Str_Length = Len(Strers)
		End If
		If Err.Number <> 0 Then
			Err.Clear()
		End If
	End Function

	'显示验证码
	Public Function GetCode()
		If int(Format_Mid_Num(7))=0 Then
			GetCode="<font class=red2>验证码机制已关闭</font>"
			Exit function
		End If
		Dim test
		On Error Resume Next
		Set test=Server.CreateObject("Adodb.Stream")
		Set test=Nothing
		If Err Then
			Dim zNum
			Randomize timer
			zNum = cint(8999*Rnd+1000)
			Session("GetCode") = zNum
			GetCode="<input type=text class=txt name=CodeStr maxlength=4 size=4>&nbsp;"&Session("GetCode")		
		Else
			GetCode="<input type=text class=txt name=CodeStr maxlength=4 size=4>&nbsp;<img src='"&Cls.Web_Dir&"Include/Inc_GetCode.asp' align=absMiddle title= '验证码，看不清楚?请点击刷新验证码！' style=""cursor:pointer;"" onclick=""this.src='"&Cls.Web_Dir&"Include/Inc_GetCode.asp?'+Math.random();"">"		
		End If
	End Function

	'检查验证码是否正确
	Public Function CodeIsTrue()
		If int(Format_Mid_Num(7))=0 Then
			CodeIsTrue=True
			Exit function
		End If
		Dim CodeStr
		CodeStr=LCase(Trim(Request("CodeStr")))
		If CStr(Session("GetCode"))=CStr(CodeStr) And CodeStr<>""  Then
			CodeIsTrue=True
			'Session("GetCode")=empty
		Else
			CodeIsTrue=False
			'Session("GetCode")=empty
		End If	
	End Function

	'//* 随机数 *//
	'-- 随机N位数字
	Public Function Rand_Num(ByVal rNum)
		Dim ri,rmax,rmin,rndnum
		rmax=10^(rNum)-1
		rmin=10^(rNum-1)
		Randomize
		rndnum=Int((rmax-rmin+1)*rnd)+rmin
		For ri=1 To rnum-Len(rndnum)
			rndnum="0"&rndnum
		Next
		Rand_Num=rndnum
	End Function

	'-- 随机文件名
	Public Function Rand_File(ByVal LeftVar)
		Dim temp1
		temp1=""
		If Is_Null(LeftVar)<>"" Then temp1=Left(LeftVar,1)
		Rand_File=temp1&Time_Type(now_time,11)&Rand_Num(2)
	End Function

	'//* 外部发言 *//
	'-- 判断发言是否来自外部
	Public Function Post_Chk()
		Dim server_v1,server_v2
		server_v1=Request.ServerVariables("http_referer")
		server_v2=Request.ServerVariables("server_name")
		If server_v1<>"" Then
			'mid(server_v1,8,len(server_v2))=server_v2
			server_v2="http://"&server_v2
			If Left(server_v1,Len(server_v2))=server_v2 Then
				Post_Chk=True
				Exit Function
			End If
		End If
		Post_Chk=False
	End Function

	Public Function Chk()
		Chk=False
		If Code_Form("chk")="yes" Then
			Chk=Post_Chk()
		End If
	End Function

	'//* 用户IP *//
	'-- IP SYS
	'-- 0=ip，1=sys
	Public Function Ip_Sys(ByVal St)
		If St=1 Then
			Ip_Sys=Request.ServerVariables("http_user_agent")
			Exit Function
		End If
		Dim userip,userip2
		userip=Request.ServerVariables("http_x_forwarded_for")
		userip2=Request.ServerVariables("remote_addr")
		If Instr(userip,",")>0 Then userip=Left(userip,Instr(userip,",")-1)
		If Instr(userip2,",")>0 Then userip2=Left(userip2,Instr(userip2,",")-1)
		If userip="" Then
			Ip_Sys=userip2
		Else
			Ip_Sys=userip
		End If
	End Function

	Public Sub Out_Msg(ByVal strMsg,ByVal strUrl)
		If strUrl="" then strUrl="javascript:history.back(1)"
		Response.Write "<Script Language=""JavaScript"">alert('"&strMsg&"');location.href='"&strUrl&"';</Script>"
		'Cls.HtmlView(0)
		Response.End
	End Sub

	Public Function GetSize(size,unit)
		If isEmpty(size) or Not Isnumeric(size) then Exit Function
		size=CheckUnit(size,unit)
 		If size>1024 then
 			size=(size/1024)
 			getsize=formatnumber(size,2) & " MB"
		Else
			getsize=size & " KB"
			Exit Function
 		End If
 		If size>1024 then
 			size=(size/1024)
 			getsize=formatnumber(size,2) & " GB"
 		End If
	End Function

	Public Function CheckUnit(size,unit)
		Select Case LCase(Unit)
		Case "b"
			CheckUnit=formatnumber(size/1024,2)
		Case "k"
			CheckUnit=size
		Case "m"
			CheckUnit=(size*1024)
		Case "g"
			CheckUnit=(size*1024*1024)
		Case Else
			CheckUnit=size
		End Select
	End Function

	'//* JS输出 *//
	'-- 0 src  1 code
	Public Function Js_Put(ByVal j_var,ByVal j_type)
		Select Case Cint(j_type)
		Case 0
			Js_Put=VbCrlf&"<Script Language=""JavaScript"" src='"&j_var&"'></Script>"
		Case 1
			Js_Put=VbCrlf&"<Script Language=""JavaScript"">" & _
				   VbCrlf& j_var & _
				   VbCrlf&"</Script>"
		Case 2
			Js_Put=VbCrlf&"<Script Language=""JavaScript"">"
		Case 3
			Js_Put=VbCrlf&"</Script>"
		End Select
	End Function

	'//* 数字处理 *//
	Public Function Fix_Num(ByVal f_num,ByVal f_type)
		Dim fnum:fnum=f_num
		If Not(IsNumeric(fnum)) Then Fix_Num=0:Exit Function
		Select Case f_type
		Case 0
			Fix_Num=Int(fnum)
		Case 1
			If Instr(fnum,".")=0 Then
				Fix_Num=fnum
			Else
				Fix_Num=Int(fnum)+1
			End If
		Case 2
			If Instr(fnum,".")=0 Then
				Fix_Num=fnum
			Else
				If Cint(Mid(fnum,Instr(fnum,".")+1,1))>=5 Then
					Fix_Num=Int(fnum)+1
				Else
					Fix_Num=Int(fnum)
				End If
			End If
		End Select
	End Function

	'//* COOKIES、CACHE、SESSION操作部分开始 *//
	'-----------Cookies操作-------------
	Public Sub Cookies_Set(MyCookieName,CookieStr)
		Response.Cookies(Web_Cookies)(MyCookieName)=CookieStr
	End Sub

	Public Function Cookies_Get(MyCookieName)
		Cookies_Get=Trim(Request.Cookies(Web_Cookies)(MyCookieName))
	End Function

	Public Sub Cookies_Del(MyCookieName)
		Response.Cookies(Web_Cookies)(MyCookieName)=Empty
	End Sub

	Public Sub Cookies_Delele()
		Dim Cookies_Name
		For Each Cookies_Name In Request.Cookies(Web_Cookies)
			Response.Cookies(Web_Cookies)(Cookies_Name)=Empty
		Next
	End Sub

	'-----------Session操作-------------
	Public Sub Session_Set(MySessionName,SessionStr)
		Session(Web_Cookies&"_"&MySessionName )=SessionStr
	End Sub

	Public Function Session_Get(MySessionName)
		Session_get=Session(Web_Cookies&"_"&MySessionName )
	End Function

	Public Sub Session_Del(MySessionName)
		Session(Web_Cookies&"_"&MySessionName )=Empty
	End Sub

	Public Sub Session_Delele()
		Session.Abandon
	End Sub

	'------------缓存操作-------------
	Public Sub Cache_Del(MyCaheName)
		MyCaheName = LCase(MyCaheName)
		Application.Lock
		Application.Contents.Remove(Web_Cookies&"_"&MyCaheName)
		Application.UnLock
	End Sub

	Public Sub Cache_Delete()
		Dim Cacheobj
		For Each Cacheobj in Application.Contents
			If CStr(Left(Cacheobj,Len(Web_Cookies)+1))=CStr(Web_Cookies&"_") Then
				Application.Lock
				Application.Contents.Remove(Cacheobj)
				Application.UnLock
			End If
		Next
	End Sub

	Public Function Cache_Chk()
		Cache_Chk=True
		Cache_Data=Application(InstallCookies & "_" & 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 Cache_Chk=False
	End Function

	Public Sub Cache_Set(MyCaheName,CaheStr)
		Name=MyCaheName
		Value=CaheStr
	End Sub

	Public Function Cache_Get(MyCaheName)
		Name=LCase(MyCaheName)
		If Cache_Chk() Then
			Select Case LCase(MyCaheName)
			Case "web_menu"
				MenuToCache(0)
			Case "amh_menu"
				MenuToCache(1)
			Case "user_group"
				UserGroup_To_Cache()
			Case "mainstyle_list"
				MainSkinList()
			Case "needtoupdate"
				Value=""
			Case "LK_Online","LK_UserOnline"
				Online_Init()
			Case "bbs_class"
				bbs_class_To_Cache()
			Case "bbs_istops"
				Value=""
			Case "bbs_istop_"&bbs_ID
				Value=""
			Case "bbs_istopz_"&zid
				Value=""
			Case "bbs_cast"
				Value=""
			Case "bbs_class_select"
				Value=""
			End Select
		End If
		Name=LCase(MyCaheName)
		Cache_Get=Value
	End Function

	'//* 发布信息间隔限制 *//
	Public Function Put_Space(ByVal Types,ByVal Num)
		Dim pt_var,pt_num
		Put_Space=True
		pt_var=Cls.Session_Get(Types)
		If IsDate(pt_var) Then
			pt_num=DateDIff("s",pt_var,Cls.now_time)
			If Int(Num)>0 And Int(pt_num)<=Int(Num) Then
				Put_Space=False
			End If
		End If
		Cls.Session_Set Types,Cls.now_time
	End Function

	Public Function Img(ByVal vImg)
		Img="<img src='"&Web_SkinDir&"sys/"&vImg&".gIf' border=0 align=absmiddle>"
	End Function

	Public Function Max_ID(ByVal vData,ByVal vID,ByVal vWhere)
		Dim oRs
		Max_ID=0
		If vWhere<>"" Then vWhere="Where "&vWhere
		Set oRs=Exec("Select Top 1 "&vID&" From "&vData&" "&vWhere&" Order By "&vID&" Desc",1)
		If Not (oRs.Eof And oRs.Bof) Then Max_ID=oRs(vID)
		oRs.Close:Set oRs=Nothing
	End Function

	Private Sub UserGroup_To_Cache()
		Dim oSQL, oRs
		If SqlType = 1 Then
		   oSQL = "execute AsaiMHInit_UserGroup"
		Else
		   oSQL = "Select GroupPower,GroupName,GroupType,GroupGrade,GroupConfig,FontColor,GlowColor From [AsaiMHUserGroup] Order By GroupOrder"
		End If
		Set oRs = Exec(oSQL,1)
		If Not (oRs.Eof And oRs.Bof) Then
			Value = oRs.GetRows(-1)
			oRs.Close:Set oRs = Nothing
			Exit Sub
		End If
		oRs.Close:Set oRs = Nothing
		Call ClsErr("用户组初始化失败！")
	End Sub

	Public Sub bbs_class_To_Cache()
		Dim oSQL, oRs
		If SqlType = 1 Then
			oSQL = "execute AsaiMHBbs_class"
		Else		
			oSQL = "Select Class_ID,bbs_ID,bbs_Name,bbs_F,bbs_N,bbs_W,bbs_Star,bbs_Parent,bbs_Power,bbs_Type,bbs_Pro,bbs_User,bbs_Config,bbs_New_Num,bbs_Special,bbs_Rule from AsaiMHBbsClass Where bbs_Hidden=0 Order By Class_ID,bbs_Order,bbs_Star"
		End If
		Set oRs = Exec(oSQL,1)
		If Not (ORs.Eof And ORs.Bof) Then
			Value=ORs.GetRows(-1)
			ORs.Close:Set oRs = Nothing
			Exit Sub
		End If
		'Value=""
		oRs.Close:Set oRs = Nothing
		Call ClsErr("论坛分类初始化失败！")
	End Sub

	'//* 网站人数统计类 *//
	Public LK_Online						'网站在线人数
	Public LK_UserOnline						'用户登陆人数
	Public LK_GuestOnline						'游客人数

	'--- 统计人数初始化
	Private Sub Online_Init()
		Name = "LK_Online"
		Reloadtime = 60
		If Cache_Chk() Then ReLoadOnlineNum
		Name = "LK_Online"
		LK_Online = Value
		Name = "LK_UserOnline"
		If Cache_Chk() Then ReLoadOnlineNum
		LK_UserOnline = Value
		If LK_Online < 0  Or LK_UserOnline < 0 Or LK_UserOnline > LK_Online Then ReLoadOnlineNum
		LK_GuestOnline = LK_Online - LK_UserOnline
		Reloadtime = 14400
	End Sub

	Public Sub AsaiMHDelOnlineNum(ByVal vName, ByVal uType)
		If vName="" Then Exit Sub
		Call Exec("delete from AsaiMHUserLogin where l_username='"&vName&"'",0)
		LK_Online=LK_Online-1
		Cache_Set "LK_Online",LK_Online
		If uType = 1 then
		  LK_UserOnline=LK_UserOnline-1
		  Cache_Set "LK_UserOnline",LK_UserOnline
		End If
	End Sub

	'--- 更新在线人数，删除过期用户
	Public Sub UpdateOnline()
		'Call Online_Init()
		Dim SQL,SQL1
		Dim TempNum,TempNum1
		Reloadtime = 60
		Name="Online_DelTime"
		If Cache_Chk() Then Value=now_time
		If DateDIff("s",Value,now_time) > Clng(Format_Mid_Num(15))*60 Or DateDIff("s",Value,now_time) = 0 Then
			Value=now_time
				Sql="delete from AsaiMHUserLogin where l_type=0 and datedIff("&SqlQ&"s"&SqlQ&",l_tim_End,'"&now_time&"')>"&Format_Mid_Num(15)&"*60"
				sql1="delete from AsaiMHUserLogin where l_type=1 and datedIff("&SqlQ&"s"&SqlQ&",l_tim_End,'"&now_time&"')>"&Format_Mid_Num(15)&"*60"
			call exec("",-1)
			Conn.Execute SQL,TempNum
			Conn.Execute SQL1,TempNum1
			'如果删除客人数大于0，则应该更新总数
			If TempNum>0 Then
				'更新缓存总在线数据
				LK_Online = LK_Online - TempNum
				LK_GuestOnline = LK_GuestOnline - TempNum
			End If
			'如果删除用户数大于0，则应该更新总数和用户数
			If TempNum1>0 Or TempNum>0 Then
				'更新缓存总在线数据
				LK_Online = LK_Online - TempNum1
				LK_UserOnline = LK_UserOnline - TempNum1
			End If
			Name="LK_Online"
			Value=LK_Online
			'更新缓存总用户在线数据
			Name="LK_UserOnline"
			Value=LK_UserOnline
			'LK_Online = LK_Online - TempNum1
		End If
		Reloadtime = 14400
	End Sub

	'--- 刷新在线数据缓存
	Public Sub ReLoadOnlineNum
		Dim oRs
		Name="LK_Online"
		Set oRs=Exec("Select Count(l_id) from AsaiMHUserLogin",1)
		Value = oRs(0)
		oRs.Close
		LK_Online = Value
		Name="LK_UserOnline"
		Set oRs=Exec("Select Count(l_id) from AsaiMHUserLogin Where l_type=1",1)
		Value=oRs(0)
		LK_UserOnline = Value
		oRs.Close:Set oRs=Nothing
	End Sub

	'--- 频道数据统计
	Public Function Channel_Count(iChannelID)
		Dim iCount, iHits
		If iChannelID=4 Then
		  Sql="Select Count(*) From AsaiMHBbsTopic"
		ElseIf iChannelID=10 then
		  Sql="Select Count(*) From ["&Cls.ChannelTable&"] Where Hidden=True"
		Else
		  Sql="Select Count(*) From ["&Cls.ChannelTable&"] Where Hidden=1 And ChannelIDs="&iChannelID
		End If
		Set Rs=Cls.Exec(SQL,1)
		iCount=Rs(0)
		Rs.Close
		If Not Cls.Is_Int(iCount) Then iCount=0
		If iChannelID=4 Then
		  Sql="Select Count(*) From AsaiMHBbsData"
		ElseIf iChannelID=10 then
		  Sql="Select Count(*) From ["&Cls.ChannelTable&"] Where Hidden=True"
		Else
		  Sql="Select Sum(Counter) From ["&Cls.ChannelTable&"] Where Hidden=1 And ChannelIDs="&iChannelID
		End If
		Set Rs=Cls.Exec(SQL,1)
		iHits=Rs(0)
		Rs.Close
		If Not Cls.Is_Int(iHits) Then iHits=0
		Call Cls.Exec("Update [AsaiMHChannel] Set ChannelCount="&iCount&",ChannelHits="&iHits&" Where ChannelIDs="&iChannelID,0)
		Set Rs=Nothing
		Call Cache_Del("web_menu")
	End Function

	'=============================================================
	'函数名：ShowDateTime
	'作  用：读取日期格式
	'参  数：DateAndTime ---- 当前时间
	'        para ---- 时间格式
	'=============================================================
	Public Function ShowDateTime(DateAndTime, para)
		ShowDateTime = ""
		Dim strDate
		If Not IsDate(DateAndTime) Then Exit Function
		If para=999 Then
			strDate = "<font color='#666666'>"
			strDate = strDate & time_type(DateAndTime, 7)
			strDate = strDate & "</font>"
		ElseIf DateAndTime >= Date Then
			strDate = "<font class='tim'>"
			strDate = strDate & time_type(DateAndTime, para)
			strDate = strDate & "</font>"
		Else
			strDate = "<font class='tims'>"
			strDate = strDate & time_type(DateAndTime, para)
			strDate = strDate & "</font>"
		End If
		ShowDateTime = strDate
	End Function

	Public Function ShowDatePath(strval, n)
		ShowDatePath = ""
		If Trim(strval) = "" Then Exit Function
		Dim strTempPath, strTime
		Dim y, m, d
		strTime = Left(strval, 8)
		y = Left(strTime, 4)
		m = Mid(strTime, 5, 2)
		d = Right(strTime, 2)
		Select Case CInt(n)
			Case 1
				strTempPath = y & "/" & m & "/" & d & "/"
			Case 2
				strTempPath = y & "/" & m & "/"
			Case 3
				strTempPath = y & m & "/"
			Case 4
				strTempPath = y & "/"
			Case 5
				strTempPath = y & "-" & m & "-" & d & "/"
			Case 6
				strTempPath = y & "-" & m & "/"
			Case 7
				strTempPath = "Html/"
			Case 8
				strTempPath = "Show/"
		Case Else
			strTempPath = ""
		End Select
		strTempPath = Replace(strTempPath, " ", "")
		ShowDatePath = CStr(strTempPath)
	End Function

	'================================================
	'函数名：ReadFileName
	'作  用：读取HTML文件名
	'参  数：strname ----文件名称
	'        id ----数据ID
	'        ExtName ----HTML扩展名
	'        PrefixStr ----HTML名称前缀
	'        HtmlForm ----HTML文件格式
	'        n ----HTML分页
	'================================================
	Public Function ReadFileName(ByVal strname, ByVal id, ByVal ExtName, ByVal PrefixStr, ByVal HtmlForm, ByVal n)		
		Dim strFileName, strExtName, CurrentPage
		If Trim(strname) = "" Then Exit Function
		If Trim(ExtName) = "" Then ExtName = ".html"
		If Not IsNumeric(n) Then n = 0
		On Error Resume Next
		If CInt(n) <= 1 Then
			CurrentPage = ""
		Else
			CurrentPage = "_" & n
		End If
		If Left(ExtName, 1) <> "." and ExtName<>"_" Then
			strExtName = "." & Trim(ExtName)
		Else
			strExtName = Trim(ExtName)
		End If
		Select Case Trim(HtmlForm)
			Case "1"
				strFileName = Trim(Supplemental(id, 3))
			Case "2"
				strFileName = Trim(PrefixStr) & Trim(Supplemental(id, 3))
			Case "3"
				strFileName = Left(strname, 8)
				strFileName = strFileName & Trim(Supplemental(id, 3))
			Case "4"
				strFileName = Right(strname, 7)
				strFileName = strFileName & Trim(Supplemental(id, 3))
			Case Else
				strFileName = strname
		End Select
		strFileName = Replace(strFileName & CurrentPage & strExtName, " ", "")
		ReadFileName = CStr(strFileName)
	End Function

	'================================================
	'过程名：HtmlRndFileName
	'作  用：取HTML的随机文件名
	'================================================
	Public Function HtmlRndFileName()
		Dim sRnd
		Randomize
		sRnd = Int(90 * Rnd) + 10
		'HtmlRndFileName = Replace(Replace(Replace(Time_Type(Now(), 1), "-", ""), ":", ""), " ", "") & sRnd
		HtmlRndFileName = Time_Type(Now(), 11) & sRnd
	End Function

	'================================================
	'函数名：Supplemental
	'作  用：补足参数
	'参  数：para ----原参数
	'        n ----增补的位数
	'================================================
	Public Function Supplemental(para, n)
		Supplemental = ""
		If Not IsNumeric(para) Then Exit Function
		If Len(para) < n Then
			Supplemental = String(n - Len(para), "0") & para
		Else
			Supplemental = para
		End If
	End Function

	'================================================
	'函数名：IsValidChar
	'作  用：判断字符串中是否含有非法字符和中文
	'参  数：str   ----原字符串
	'返回值：False,True -----布尔值
	'================================================
	Public Function IsValidChar(ByVal str)
		IsValidChar = False
		On Error Resume Next
		If IsNull(str) Then Exit Function
		If Trim(str) = Empty Then Exit Function
		Dim ValidStr
		Dim i, l, s, c
		ValidStr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ.-_:~\/0123456789"
		l = Len(str)
		s = UCase(str)
		For i = 1 To l
			c = Mid(s, i, 1)
			If InStr(ValidStr, c) = 0 Then
				IsValidChar = False
				Exit Function
			End If
		Next
		IsValidChar = True
	End Function

	'================================================
	'函数名：CutMatchContent
	'作  用：截取相匹配的内容
	'参  数：Str   ----原字符串
	'        PatStr   ----符合条件字符
	'================================================
	Public Function CutMatchContent(ByVal str, ByVal start, ByVal last, ByVal Condition)
		Dim Match,s,re
		Dim FilterStr,MatchStr
		Dim strContent,ArrayFilter
		Dim i, n,bRepeat
		If Len(start) = 0 Or Len(last) = 0 Then Exit Function
		On Error Resume Next
		MatchStr = "(" & CorrectPattern(start) & ")(.+?)(" & CorrectPattern(last) & ")"
		Set re = New RegExp
		re.IgnoreCase = True
		re.Global = True
		re.Pattern = MatchStr
		Set s = re.Execute(str)
		n = 0
		For Each Match In s
			If n = 0 Then
				n = n + 1
				ReDim ArrayFilter(n)
				ArrayFilter(n) = Match
			Else
				bRepeat = False
				For i = 0 To UBound(ArrayFilter)
					If UCase(Match) = UCase(ArrayFilter(i)) Then
						bRepeat = True
						Exit For
					End If
				Next
				If bRepeat = False Then
					n = n + 1
					ReDim Preserve ArrayFilter(n)
					ArrayFilter(n) = Match
				End If
			End If
		Next
		Set s = Nothing
		Set re = Nothing
		If CBool(Condition) Then
			strContent = Join(ArrayFilter, "|||")
		Else
			strContent = Join(ArrayFilter, "|||")
			strContent = Replace(strContent, start, "")
			strContent = Replace(strContent, last, "")
		End If
		CutMatchContent = Replace(strContent, "|||", vbNullString, 1, 1)
	End Function

	Function CutFixContent(ByVal str, ByVal start, ByVal last, ByVal n)
		Dim strTemp
		On Error Resume Next
		If InStr(str, start) > 0 Then
			Select Case n
			Case 0  '左右都截取（都取前面）（去处关键字）
				strTemp = Right(str, Len(str) - InStr(str, start) - Len(start) + 1)
				strTemp = Left(strTemp, InStr(strTemp, last) - 1)
			Case Else  '左右都截取（都取前面）（保留关键字）
				strTemp = Right(str, Len(str) - InStr(str, start) + 1)
				strTemp = Left(strTemp, InStr(strTemp, last) + Len(last) - 1)
			End Select
		Else
			strTemp = ""
		End If
		CutFixContent = strTemp
	End Function

	Private Function CorrectPattern(ByVal str)
		str = Replace(str, "\", "\\")
		str = Replace(str, "~", "\~")
		str = Replace(str, "!", "\!")
		str = Replace(str, "@", "\@")
		str = Replace(str, "#", "\#")
		str = Replace(str, "%", "\%")
		str = Replace(str, "^", "\^")
		str = Replace(str, "&", "\&")
		str = Replace(str, "*", "\*")
		str = Replace(str, "(", "\(")
		str = Replace(str, ")", "\)")
		str = Replace(str, "-", "\-")
		str = Replace(str, "+", "\+")
		str = Replace(str, "[", "\[")
		str = Replace(str, "]", "\]")
		str = Replace(str, "<", "\<")
		str = Replace(str, ">", "\>")
		str = Replace(str, ".", "\.")
		str = Replace(str, "/", "\/")
		str = Replace(str, "?", "\?")
		str = Replace(str, "=", "\=")
		str = Replace(str, "|", "\|")
		str = Replace(str, "$", "\$")
		CorrectPattern = str
	End Function

	'--- 内容相关
	Public Function GetIncInfo(IInfo)
		Select Case IInfo
		Case 1
			GetIncInfo="<font class=yellow>[话题]</font>"
		Case 2
			GetIncInfo="<font class=blue>[图文]</font>"
		Case 3
			GetIncInfo="<font class=read>[组图]</font>"
		Case 4
			GetIncInfo="<font class=red2>[推荐]</font>"
		Case 5
			GetIncInfo="<font color=red>[观点]</font>"
		Case 6
			GetIncInfo="<font color='green'>[转载]</font>"  
		Case Else
			GetIncInfo=""
		End Select
	End Function

	'//* 关键字搜索显亮 *//
	'--* sTitle：	 内容
	Public Function Channel_Search(ByVal sTitle) 
	Dim tmp_keyword,stmp_keyword,j,tmp_keywords 
	tmp_keywords=Cls.Code_Query("keyword")   
	'tmp_keywords=Trim(request.QueryString("keyword")) 
	tmp_keyword=replace(tmp_keywords,"+"," ") 
	stmp_keyword=split(tmp_keyword," ") 
	For j=0 To ubound(stmp_keyword) 
		sTitle=KeyWord_Highlight(sTitle,stmp_keyword(j),"<font color=red><b>","</b></font>") 
	Next 
	Erase stmp_keyword 
	Channel_Search = sTitle 
	End Function

	'//* 关键字显亮 *//
	'--* strText：	 内容
	'--* strKeyWord：关键字
	'--* strText：	 关键字前部设置
	'--* strKeyWord：关键字后部设置
	Public Function KeyWord_Highlight(ByVal strText,ByVal strKeyWord,ByVal strBefore,ByVal strAfter)
    Dim nPos
    Dim nLen
    Dim nLenAll
    nLen = Len(strKeyWord)
    nLenAll = nLen + Len(strBefore) + Len(strAfter)
    KeyWord_Highlight = strText
    If nLen > 0 And Len(KeyWord_Highlight) > 0 Then
        nPos = InStr(1, KeyWord_Highlight, strKeyWord, 1)
        Do While nPos > 0
            KeyWord_Highlight = Left(KeyWord_Highlight, nPos - 1) & _
                strBefore & Mid(KeyWord_Highlight, nPos, nLen) & strAfter & _
                Mid(KeyWord_Highlight, nPos + nLen)
            nPos = InStr(nPos + nLenAll, KeyWord_Highlight, strKeyWord, 1)
        Loop
    End If
	End Function

	'--- 标题颜色
	Public Function GetTcolor(titles,tcolors,IsB)
		If Isb=true then titles="<b>"&titles&"</b>"
		If tcolors<>"" then titles="<font color='#"&tcolors&"'>"&titles&"</font>"
		GetTcolor=titles
	End Function

	'--- 图片边框
	Public Function GetPic(PicUrl)
		dim HtmlStr
		HtmlStr = ReadSkin("pic_fk")
		HtmlStr = Replace(HtmlStr,"{$burl}",Cls.Web_Dir&"Images/Fk/")
		HtmlStr = Replace(HtmlStr,"{$picurl}",PicUrl)
		GetPic=HtmlStr
	End Function

	'--- 论坛贴子属性读取 
	Public Function GetDot(b_top,b_focus,b_good)
		If b_top=1 then
			GetDot=Img_Alt("t_top","固顶"&Cls.ChannelModule)
			ElseIf b_focus=True then
			GetDot=Img_Alt("t_focus","焦点"&Cls.ChannelModule)
		ElseIf b_good=True then
			GetDot=Img_Alt("t_good","推荐"&Cls.ChannelModule)
		Else
			GetDot=Img_Alt("t_pu","普通"&Cls.ChannelModule)
		End If
	End Function

	'--- 论坛贴子属性读取 
	Public Function GetBBSDot(b_top,b_lock,b_good,b_vote)
		If b_top > 0 then
			GetBBSDot=Img_Alt("t_top","固顶贴子")
		ElseIf b_lock > 0 then
			GetBBSDot=Img_Alt("t_lock","锁定贴子")
		ElseIf b_good > 0 then
			GetBBSDot=Img_Alt("t_good","精华贴子")
		ElseIf b_vote = true then
			GetBBSDot=Img_Alt("t_vote","投票贴子")	  
		Else
			GetBBSDot=Img_Alt("t_pu","普通贴子")
		End If
	End Function

	'--- 爱问解决否确认 
	Public Function GetOkDot(b_replys,b_Solves,b_Expired)
		If b_replys=0 and b_Solves=0 and b_Expired>now() then
			GetOkDot=Img_Alt("ico_Solves0","未解决的"&Cls.ChannelModule)
		ElseIf b_replys>0 and b_Solves=0 and b_Expired>now() then 
			GetOkDot=Img_Alt("ico_Solves1","解决中的"&Cls.ChannelModule)
		ElseIf b_Expired<now() and b_Solves=0 then 
			GetOkDot=Img_Alt("ico_Expired","已过期的"&Cls.ChannelModule)
		Else
			GetOkDot=Img_Alt("ico_Solves2","已解决的"&Cls.ChannelModule)
		End If
	End Function

	'--- 商城操作
	Public Function Note_Emoney_pay(p_emoney,p_nsort,p_id,p_ut)
		dim Temp1
		Call Channel_Initialize(p_nsort)
		If int(p_emoney)>0 Then
			Temp1="<a href='"&Cls.Web_Dir&Cls.ChannelDir&"/Emoney_Pay.asp?ChannelIDs="&p_nsort&"&id="&p_id&"' target=_blank><img src='"&Cls.Web_SkinDir&"sys/Emoney.gIf' border=0 width=14 title='"&Cls.web_unit&"支付' align=absmiddle></a>&nbsp;<font class=red2>"&p_emoney&"</font> "
		Else
			Temp1="<img src='"&Cls.Web_SkinDir&"sys/Emoney.gIf' border=0 title='"&Cls.web_unit&"支付' align=absmiddle>&nbsp;<font class=Gys>不可用</font>"
		End If
		If p_ut=1 Then Temp1=Temp1
		note_emoney_pay=Temp1
	End Function

	Public Function Shop_Emoney_Pay(p_is_emoney,p_emoney,ChannelIDs,p_id,p_ut)
		dim nemoney
		nemoney=0
		If p_is_emoney=true then nemoney=p_emoney
		Shop_Emoney_Pay=note_emoney_pay(nemoney,ChannelIDs,p_id,p_ut)
	End Function

	Public Function FM_Discount(dvar)
		If dvar>=100 then
			fm_discount="不打折"
			exit Function
		End If
		fm_discount=cstr(dvar/10)&"折"
	End Function

	'--- 频道服务器读取 
	Public Function Server_Url(oChannelid,ser_id,ser_url) 
		dim s_url 
		Sql="Select S_Url from AsaiMHServer where ChannelIDs="&ChannelIDs&" and S_ID="&ser_id 
		Set Rs=Cls.exec(sql,1) 
		If not rs.eof then 
			S_Url=rs(0) 
			If right(S_Url,1)<>"/" then s_url=s_url&"/" 
			Server_Url=s_url&ser_url 
		Else 
			Server_Url=ser_url 
		End If 
		Rs.Close 
	End Function

	'--- 文件后续识别
	Public Function GetFileExt(Byval strFile)
		GetFileExt="rar"
		Dim strExt
		if Isnull(strFile) then Exit Function
		if Instr(strFile,".")<=0 then Exit Function
		strExt=Split(strFile,".")
		GetFileExt=strExt(Ubound(strExt))
	End Function
End Class
%>
