syschar.asp

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

<%
'=======通用文件访问检测和表单函数
Select CASE ManPre
'CASE 0 GetRootUrl=lcase(trim(UserPath))'实时数据库连接验证模式
CASE 0 GetRootUrl=lcase(trim(UserPath))'实时数据库连接验证模式
CASE 1 GetRootUrl=lcase(trim(Session("userpath")))'使用Session
CASE 3 GetRootUrl="/"	'完全不使用
END SELECT

if right(GetRootUrl,1)<>"/" then GetRootUrl=GetRootUrl&"/"
GetNoFile=split(lcase(ScriptOff),",") 
set Fso=Server.CreateObject("Scripting.FileSystemObject")

GetFilePath=Request.ServerVariables("SCRIPT_NAME") 
GetFileName=mid(GetFilePath,instrRev(GetFilePath,"/")+1)
GetFilePath=lcase(left(GetFilePath,instrRev(GetFilePath,"/")))
GetPath=lcase(GetValue(RequestPath,"str",GetRootUrl))
GetPathDir=lcase(left(GetPath,inStrRev(GetPath,"/")))
GetPathFileName=lcase(right(GetPath,len(GetPath)-inStrRev(GetPath,"/")))

if left(GetPath,1)<>"/" then GetPath=GetRootUrl&GetPath
	
	'GetSize=GetFsoSize(GetRootUrl)
	'response.write GetSize
	'response.write GetRootUrl
	'response.write "<br><li>超出你的空间最大配额，你的配额为："&formatnumber(GetSize/(1024*1024),2)&"MB,"&_
	'				" 剩余空间为"&formatnumber((GetSize)/(1024),2)&"KB"
if GetPage<1 then GetPage=1

Call SetBaseUrl() 
  
SUB SetBaseUrl()
	GetBaseUrl=GetFileName&"?page="&GetPage&"&path="&GetPath
	if GetFilter<>"" then GetBaseUrl=GetBaseUrl&"&filter="&GetFilter
End SUB

Function GetIsEdit(SetName)
	dim i1,i,isEdit
		isEdit=Array(1,7,8)
		GetIsEdit=0
		i1=GetFormValueat(SetName)
	for i=0 to ubound(isEdit)
		if isEdit(i)=i1 then
			GetIsEdit=1
			exit for
		end if
	next 
End Function
	
Function GetExtName(SetName)
	GetExtName=""
	if instrRev(SetName,".")<1 then exit Function
	GetExtName=lcase(mid(SetName,instrRev(SetName,".")+1))
End Function

Function GetFormValueat(SetName)
	dim i,str
	GetFormValueat=0
	if instrRev(SetName,".")=0 then exit Function
	str=lcase(mid(SetName,instrRev(SetName,".")+1))
	for i=0 to uBound(SetExtName,1)
		if str=SetExtName(i,0) then 
			GetFormValueat=SetExtName(i,1)
			exit for
		end if
	next
End Function

Function CheckFile(SetName,ischeck,mode)
	dim SetExt,SetPath,i,errorchar
	dim lenPP
	errorchar=array("'","""","\","/","*","?","&","|","<",">",":")
	CheckFile="True"
	SetExt=lcase(GetExtName(SetName))
	If Not TopMaster then
		dim scr
			scr=ubound(GetNoFile)
		Select CASE mode
		CASE "00"
			if SetPower(0,0)=false then
				for i=0 to scr
					if GetNoFile(i)=SetExt then 
						CheckFile="<br><li>没有管理脚本文件的权限！"
						exit Function
					end if
				next
			end if
		CASE "01"
			if SetPower(1,1)=true then
				if SetPower(0,1)=false then
					for i=0 to scr
						if GetNoFile(i)=SetExt then 
								CheckFile="<br><li>没有权限上传此脚本文件！"
							exit Function
						end if
					next
				end if
			else
				CheckFile="<br><li>没有权限上传文件！"
				exit Function
			end if
		CASE "02"
			if SetPower(1,2)=true then
				if SetPower(0,2)=false then
					for i=0 to scr
						if GetNoFile(i)=SetExt then 
							CheckFile="<br><li>没有权限浏览此脚本文件！"
							exit Function
						end if
					next
				end if
			else
				CheckFile="<br><li>没有权限浏览文件列表！"
				exit Function
			end if
		CASE "03"
			if SetPower(1,5)=true then
				if SetPower(0,3)=false then
					for i=0 to scr
						if GetNoFile(i)=SetExt then
							select case ischeck
							case 2	CheckFile="<br><li>没有权限保存为脚本文件！"
							case 1	CheckFile="<br><li>没有权限读取此脚本文件！"
							case else CheckFile="<br><li>没有权限编辑此脚本文件！"
							end select
							exit Function
						end if
					next
				end if
			else
				CheckFile="<br><li>没有权限编辑文件！"
				exit Function
			end if
		CASE "04"
			if SetPower(0,4)=false then
				for i=0 to scr
					if GetNoFile(i)=SetExt then 
						CheckFile="<br><li>没有权限操作脚本文件！"
						exit Function
					end if
				next
			end if
		'CASE else
		'	for i=0 to scr
		'		if GetNoFile(i)=SetExt then 
		'			CheckFile="<br><li>没有任何权限操作此此脚本文件！"
		'			exit Function
		'		end if
		'	next
		End Select
	End If

	if GetFilter<>"" then
		if ischeck=0 then
			if GetFilterULcase<>1 then 
				SetName=lcase(SetName) '可以不区分大小写,GetFilterULcase=1区分
				GetFilter=lcase(GetFilter)
			end if
			if GetFilter="**" or GetFilter="*" then
				CheckFile="True"
				exit Function
			else
				if right(GetFilter,1)="*" then
					if left(GetFilter,1)="*" then
						GetFilter=replace(GetFilter,"*","")
					else
						lenPP=len(GetFilter)-1
						if left(GetFilter,lenPP)=left(SetName,lenPP) then 
							CheckFile="True"
							exit Function
						end if
					end if
				elseif left(GetFilter,1)="*" then 
						lenPP=len(GetFilter)-1
						if right(GetFilter,lenPP)=right(SetName,lenPP) then 
							CheckFile="True"
							exit Function
						end if
				end if
			end if	
		end if
		if instr(SetName,GetFilter)<1 then
			CheckFile="<br><li>没有权限访问此文件！"
			exit Function
		end if 
	end if

	if ischeck>0 then
		SetPath=left(SetName,instrRev(SetName,"/"))
		SetPath=CheckFolder(SetPath,1)
		if SetPath<>"True" then 
			if CheckFile="True" then 
				CheckFile=SetPath
			else
				CheckFile=CheckFile&SetPath
			end if
			'2003-10-11
			call EndProc(CheckFile,1,"")
			if ischeck<>2 then exit Function
		end if
		
		if ischeck=1  then
			if not Fso.FileExists(Server.MapPath(SetName)) then
				CheckFile="<br><li>文件没有找到！"
				exit Function
			else
				CheckFile="True"
				exit Function
			end if
		elseif ischeck=2 then
			dim chkname
			chkname=Fso.GetFileName(SetName)
			for i=0 to ubound(errorchar)
				if instr(chkname,errorchar(i))>0 then
					CheckFile=SetPath+"<br><li>文件名中含有非法字符！"
					exit Function
				end if
			next
		end if
	else
		'dim chkname
			'chkname=Fso.GetFileName(SetName)
		for i=0 to ubound(errorchar)
			if instr(SetName,errorchar(i))>0 then
				CheckFile="<br><li>文件名中含有非法字符！"
				exit Function
			end if
		next
	end if 
	CheckFile="True"
End Function

Function CheckFolder(SetPath,mode)
	if SetPower(1,0)=false then
		CheckFolder="<br><li>无基本的目录察看管理权限，无法进入该位置！"
		exit Function
	end if
	dim errorchar,i
	SetPath=lcase(SetPath)
	CheckFolder="True"
	errorchar=array("'","""","\","..","//","*","?","&","|","<",">",":")
		if isempty(SetPath) or trim(SetPath)="" then
			CheckFolder="<br><li>目录不能为空！"
			exit Function
		end if 
	for i=0 to ubound(errorchar)
		if instr(SetPath,errorchar(i))>0 then
			CheckFolder="<br><li>目录名"+SetPath+"中含有非法字符！"
			exit Function
		end if
	next

	Select CASE ManPre
	CASE 0 	
		  if Not TopMaster then
			  if SetPower(0,5)=false and StrComp(GetFilePath,left(SetPath,len(GetFilePath)))=0 then
				CheckFolder="<br><li>对系统目录无访问权限！"
				exit Function
			  end if
		  end if
	CASE else 	
			CheckFolder="<<br><li>此目录访问失效！"
			exit Function
	END select

	if mode=0 then exit Function

	if not  Fso.FolderExists(Server.MapPath(SetPath)) then
		CheckFolder="<br><li>目录"&SetPath&"没有找到！"
		exit Function
	end if
	   
	if left(SetPath,len(GetRootUrl))<>GetRootUrl then
		CheckFolder="<br><li>你无权限访问该目录："&SetPath&"</li><li>你的有效访问目录："&GetRootUrl&"</li>"
		exit Function
	end if
End Function

SUB EndProc(info,historyback,redirect)
	set Fso=nothing
	set GetFolder=nothing
	if info<>"" then
		Response.write "</head><body bgcolor='#e8e8e8' text='#000000' leftmargin='0' rightmargin='0' topmargin='0' bottommargin='20'>"
		Server.Execute("TopNav1.asp")
		call GetError(info)
	end if
End SUB

Function CheckQuota11(iPath,op)
	'2003-12-11
	dim disk,ssize
	if op="mappath" then iPath=Server.mappath(iPath)
	set disk=Fso.getfolder(iPath)
	GetSize=disk.size
	sSize=GetQuota-GetSize
	if sSize<0 then sSize=0
	if GetSize>GetQuota*1024 then
		CheckQuota="<br><li>超出你的空间最大配额，你的配额为："&formatnumber(GetQuota/(1024*1024),2)&"MB,"&_
					" 剩余空间为"&formatnumber((Ssize)/(1024*1024),2)&"MB"
	else
		CheckQuota=""
	end if
		'----------------
End Function

Function GetFsoSize(iPath) '单位MB
	dim disk,Spath
	if isNull(iPath) or isEmpty(iPath) then 
		GetFsoSize=0
	else
		Spath=Server.mappath(iPath)
		'set disk=Fso.getfolder(Server.mappath(iPath))
		'GetFsoSize=(disk.size)
		if Fso.folderexists(Spath) then
			 GetFsoSize=Fso.getfolder(Spath).size
		else GetFsoSize=0
		end if
	end if
End Function

Function FixSize(pathStr,ftype,iVarType,inewSize)
	FixSize=0
	dim Spath
	dim f,fexists
		fexists=false
		Spath=server.mappath(pathStr)
	if ftype="folder" then
		if Fso.folderexists(Spath) then
			Set f = Fso.GetFolder(server.mappath(pathStr))
			fexists=true
		else 
			if iVarType="del" then exit Function
		end if
	else
		if Fso.FileExists(Spath) then
			Set f = Fso.GetFile(server.mappath(pathStr))
			fexists=true
		else 
			if iVarType="del" then exit Function
		end if
	end if
	Select CASE iVarType
	Case "del"
		FixSize=f.size
	Case "upload","editsave"
		if fexists then
			FixSize=inewSize-f.size
		else FixSize=inewSize
		end if
	case else
	end select
		set f=nothing
End Function

SUB UpdateUseSize(iSize) '更新用户使用的空间数据
		dim rs
		set rs=Server.CreateObject("ADODB.Recordset")
		rs.open "select useSize from [UserList] where UserID="&memberid,conn,1,3
	if not rs.eof then
		dim tmpArr
		tmpArr=split(rs(0),"|")
		if tmpArr(Qi)="0" or int(tmpArr(Qi))<0 then
			tmpArr(Qi)=iSize
		else
			'tmpArr(Qi)=cstr(int(tmpArr(Qi))+iSize)
			tmpArr(Qi)=cstr(iSize)
		end if
			rs(0)=join(tmpArr,"|")
		rs.update
	end if
	rs.close
	set rs=nothing
End SUB
%>