const.asp

方舟网免费空间申请程序(自助建站系统) v3.0 1 界面美观 2 后台管理功能强大：A 可以设置多种参数

<%	@LANGUAGE="VBSCRIPT" %>
<%	option explicit 
'---------方舟网http://www.99081.com----------------
    dim CharsetType			'charSet gb2312 big5 .. etc
	dim startime:startime=timer()
	dim nowTime:nowTime=now()
	dim info,i,j
	dim CooSelTitle			'页面标题
	dim md5order			'md5 排序
	dim upload_Component	'上传组件类型 /=0 ADODB.Stream /=1 SA fileUpload
	dim regFlag				'注册允许与否
	dim classid
	dim database_ver		'数据库版本 升级相关标识
	dim code_ver
		code_ver=1502		'CooSel asp Code 版本

'-------Path
	dim pathArr				'用户管理路径数组
	dim UserPath			'用户管理路径
	dim pow,SetPower(2,8)
	dim isMaster
		isMaster=false
		for i=0 to 2
			for j=0 to 8
			SetPower(i,j)=false
			next
		next
'-------Mail
	dim reg_SysEmail     '登录邮件服务器所需的用户名 密码数组
'----------------------------共用配制可自定义变量--------
	dim CONN
	dim CONNstr
	dim ManPre				'使用管理验证类型
	dim CONNECT				'使用数据库验证时的数据库类型 '当前提供1:ACCESS,0:SQL2000连接
	dim UseRootpathCreate	'用户注册根目录
	dim	ScriptOff			'禁止访问的脚本
	dim GetPageSize			'每页显示的文件数
	dim ASPreview			'脚本预览常量文件名
	dim helpID				'版面帮助ID
	dim EditSize			'允许文本编辑文件最大尺寸，单位KB
'---------------------------程序配制基本本全局变量--------
	dim SQL,rs	
	dim GetAction			'表单提交查询行为
	dim Fso					'Fso对象
	dim GetOption			'uploadForm操作行为
	dim RequestPath				'当前所查看目录文件路径
	dim GetPath				'当前所查看目录文件路径
	dim GetPathDir			'当前所查看目录路径名
	dim GetPathFileName		'当前所查看目录路径文件名
	dim GetFileName			'系统程序脚本文件名
	dim GetFileExtName		'扩展名
	dim GetFilePath			'系统程序文件路径
	dim GetRootUrl			'管理路径根UrL
	dim GetBaseUrl			'当前URL
	dim GetPage				'当前页号
	dim GetFolder			'文件夹对象
	dim SetTemp				'文件夹检测
	dim GetNoFile			'不允许访问类型脚本文件
	dim GetFilter			'搜索字符串变量
	dim GetFilterULcase		'搜索大小写配
	dim SetExtName(35,2)	'脚本扩展名配制数组
	dim Power(3,8)			'管理权限数组

	dim HTTP_REFERER
'----------------------------数据库变量----------------------

GetPage=GetValue(Request.QueryString("page"),"int",1)
GetAction=GetValue(Request.QueryString("action"),"str","")
GetFilter=GetValue(Request.QueryString("filter"),"str","")
GetFilterULcase=GetValue(Request.QueryString("ULcase"),"int",0)
GetOption=GetValue(Request.QueryString("Option"),"int",-1)
RequestPath=trim(Request.QueryString("path"))
HTTP_REFERER=CheckStr(Request.ServerVariables("HTTP_REFERER"))

'---------------------------------------------
%><!--#include file="inc/Config.ASP"--><% '基本配置文件config.asp
'----------------------------------------------
	SELECT CASE CONNECT
	CASE 0	'SQL 2000 连接
		%><!--#include file="CONN.SQLserver.ASP"--><%
	CASE 1 'ACCESS 2000连接	
		%><!--#include file="CONN.Access.ASP"--><%
	CASE 3 '其他数据库连接类型
	End SELECT

	set rs=Server.CreateObject("ADODB.RecordSet")
	rs.open "select classid,md5order,upload_Component,regFlag,database_ver,rootPath,reg_SysEmail,CooSelTitle from [config] where selected=1",CONN,0,1
	if Not rs.eof then
		classid=rs(0)
		md5order=rs(1)
		upload_Component=rs(2)
		regFlag=rs(3)
		database_ver=rs(4)
		UseRootpathCreate=rs(5)
		reg_SysEmail=rs(6)
		CooSelTitle=rs(7)
		if right(UseRootpathCreate,1)<>"/" then UseRootpathCreate=UseRootpathCreate&"/"
		if code_ver<>database_ver then
			GetError "管理数据库和代码版本不匹配,请升级数据库或代码"
		end if
	else
		GetError "配置记录不存在"
	end if
	rs.close

Function CloseDatabase
		CONN.close
	Set CONN = Nothing
End Function

SUB GetError(info) '错误中断提示
	Response.write "<table cellpadding=0 cellspacing=0 border=0 width='100%' bgcolor='#000000' align=center style='font-size: 9pt;'>"&_
			"<tr><td><table cellpadding=3 cellspacing=1 border=0 width=""100%""><tr align=center>"&_
			"<td width=""100%"" bgcolor=#FFAE88 height=26 style='font-size: 9pt;'><font color='#000000'><b>错 误 信 息</b></font></td>"&_
			"</tr><tr><td width=""100%"" bgcolor='#ffffff' align=center style='font-size: 9pt;'>"&_
			"<font color='#000000'><br>&nbsp;&nbsp;&nbsp;<b>产 生 错 误 的 原 因：&nbsp;&nbsp;&nbsp;</b><br><table align=center><tr><td>"&_
			""&info&"</td></tr></table><br></font></td></tr><tr align=center><td width=""100%"" bgcolor=#FFDCAC>"
	Response.write"<span style='line-height:150%;letter-spacing: 5px;font-size: 9pt;'>"&_
			"【<a href=javascript:history.go(-1)><font color='#000000'>返回到上一页</font></a>】<br>"&_
			"</span>"
	Response.write"<span style='line-height:150%;letter-spacing: 5px;font-size: 9pt;'>"&_
			"【<a href=login.asp?><font color='#000000'>进入登录面板</font></a>】<br>"&_
			"</span>"
	Response.write"</td></tr></table></td></tr></table></body></Html>"
	call Footer()
	Response.End()
End SUB

SUB CheckQuota() '配额检查
	if (Request.TotalBytes+useSize*1024)>useQuota*1024 then
		dim Ssize:Ssize=useQuota-useSize
		if Ssize<0 then Ssize=0
			'Response.Write("<script language=""javascript"">window.upstats.innerHTML=('');</script>")
			GetError "<br><li>当前操作超出你的空间最大配额<li>你的配额为 <font color=#ff0000><b>"&formatnumber(useQuota,0,-1)&"</b></font> <b>KB</b>,"&_
						" 剩余空间为：<font color=#ff0000><b>"&formatnumber(Ssize,0,-1)&"</b></font> <b>KB</b>"
		CheckQuotaOk=false
	end if 
End SUB

'断点调试 num=0 中断
Sub Response_write(str,num)
	dim istr:istr=str
	dim inum:inum=num
	response.write str&"<br>"
	if inum=0 then response.end
end sub

'表单函数 数据类型转换函数
Function GetValue(theStr,strType,defValue) '代替request转换
	dim tStr
	tStr=theStr
	select case strType
	case "str"
		if isEmpty(tStr) or trim(tStr)="" then
			 GetValue=defValue
		'else GetValue=CheckStr(trim(tStr))
		else GetValue=trim(tStr)
		end if
	case "int"
		if isEmpty(tStr) or not isNumeric(tStr) then
			 GetValue=defValue
		else GetValue=int(tStr)
		end if
	case "clng"
		if isEmpty(tStr) or not isNumeric(tStr) then
			 GetValue=defValue
		else GetValue=clng(tStr)
		end if
	case else GetValue=defValue
	end select
End Function
%>