include.asp

时代购物系统 4.0功能升级说明 <1>完善了3.0的VIP

<!--METADATA TYPE="TypeLib" UUID="{00000205-0000-0010-8000-00aa006d2ea4}"-->
<%
 dim fo,gPath,gAct,gFileName,gFilePath,g,gRootUrl,gBaseUrl,gPage,gSearch,gEachPage,gFolder,gFilter
 dim gPageSize,sTemp,gNoFile
 dim sfor(28,2)
 gPageSize=100
 gRootUrl=Session("webeditbase")
 if right(gRootUrl,1)<>"/" then gRootUrl=gRootUrl&"/"
 gNoFile=array("asp","aspx") '禁止访问的脚本
 set fo=Server.CreateObject("Scripting.FileSystemObject")
 
 sFor(0,0)="txt":sFor(0,1)=1
 sFor(1,0)="chm":sFor(1,1)=2
 sFor(2,0)="hlp":sFor(2,1)=2
 sFor(3,0)="doc":sFor(3,1)=3
 sFor(4,0)="type":sFor(4,1)=4
 sFor(5,0)="gif":sFor(5,1)=6
 sFor(6,0)="jpg":sFor(6,1)=6
 sFor(7,0)="png":sFor(7,1)=6
 sFor(8,0)="bmp":sFor(8,1)=6
 sFor(9,0)="asp":sFor(9,1)=7
 sFor(10,0)="jsp":sFor(10,1)=7
 sFor(11,0)="js" :sFor(11,1)=7
 sFor(12,0)="htm":sFor(12,1)=8
 sFor(13,0)="html":sFor(13,1)=8
 sFor(14,0)="shtml":sFor(14,1)=8
 sFor(15,0)="zip":sFor(15,1)=9
 sFor(16,0)="rar":sFor(16,1)=9
 sFor(17,0)="exe":sFor(17,1)=10
 sFor(18,0)="avi":sFor(18,1)=11
 sFor(19,0)="mpg":sFor(19,1)=11
 sFor(20,0)="ra" :sFor(20,1)=12
 sFor(21,0)="ram":sFor(21,1)=12
 sFor(22,0)="mid":sFor(22,1)=13
 sFor(23,0)="wav":sFor(23,1)=13
 sFor(24,0)="mp3":sFor(24,1)=13
 sFor(25,0)="asf":sFor(25,1)=11
 sFor(26,0)="php":sFor(26,1)=7
 sFor(27,0)="php3":sFor(27,1)=7
 sFor(28,0)="aspx":sFor(28,1)=7
 gFilePath=Request.ServerVariables("SCRIPT_NAME")
 gFileName=mid(gFilePath,instrRev(gFilePath,"/")+1)
 gFilePath=lcase(left(gFilePath,instrRev(gFilePath,"/")))
 gPath=lcase(getVar("path","str",gRootUrl))
 
 if left(gPath,1)<>"/" then gPath=gRootUrl&gPath
 gPage=getVar("page","num",1)
 gAct=getVar("act","str","")
 gFilter=getVar("filter","str","")
 setBaseUrl 
 
  
sub setBaseUrl()
 gBaseUrl=gFileName&"?page="&gPage&"&path="&gPath
 if gFilter<>"" then gBaseUrl=gBaseUrl&"&filter="&gFilter
end sub


function getVar(theStr,strType,defValue)
 select case strType
  case "str"
   if isEmpty(Request.QueryString(theStr)) or trim(Request.QueryString(theStr))="" then
    getVar=defValue
   else
    getVar=trim(Request.QueryString(theStr))
   end if
  case "num"
   if isEmpty(Request.QueryString(theStr)) or not isNumeric(Request.QueryString(theStr)) then
    getVar=defValue
   else
    getVar=cint(Request.QueryString(theStr))
   end if
  case else
    getStr=defValue
 end select
end function

function getForm(theStr,strType,defValue)
 select case strType
  case "str"
   if isEmpty(Request.form(theStr)) or trim(Request.form(theStr))="" then
    getForm=defValue
   else
    getForm=trim(Request.form(theStr))
   end if
  case "num"
   if isEmpty(Request.form(theStr)) or not isNumeric(Request.form(theStr)) then
    getForm=defValue
   else
    getForm=cint(Request.form(theStr))
   end if
  case else
    getForm=defValue
 end select
end function

sub HtmEnd(info,isback,dir)
 set fo=nothing
 set gFolder=nothing
 if info<>"" then Response.Write("<script language=""javascript"">alert('"&info&"');</script>")
 select case isback
   case 1
     Response.Write("<script language=""javascript"">history.back();</script>")
   case 2 
     Response.Write("<script language=""javascript"">location.href='"&dir&"';</script>") 
 end select
 Response.write("</body></html>")
 Response.End
end sub

function procIsEdit(sName)
dim i1,i,isEdit
isEdit=Array(1,7,8)
 procIsEdit=0
 i1=procGetFormat(sName)
for i=0 to ubound(isEdit)
 if isEdit(i)=i1 then
  procIsEdit=1
  exit for
 end if
next 
end function

function procGetExtName(sName)
 procGetExtName=""
 if instrRev(sName,".")<1 then exit function
 procGetExtName=lcase(mid(sName,instrRev(sName,".")+1))
end function

function procGetFormat(sName)
 dim i,str
 procGetFormat=0
 if instrRev(sName,".")=0 then exit function
 str=lcase(mid(sName,instrRev(sName,".")+1))
 for i=0 to uBound(sFor,1)
  if str=sFor(i,0) then 
    procGetFormat=sFor(i,1)
    exit for
  end if
 next
end function

function procCheckFile(sName,ischeck)
 dim sExt,sPath,i,errorchar
 errorchar=array("'","""","\","/","*","?","&","|","<",">")
 procCheckFile="ok"
 sExt=lcase(procGetExtName(sName))
 if gFilter<>"" then
  if instr(sName,gFilter)<1 then
   procCheckFile="没有权限访问此文件!"
   exit function
  end if 
 end if
 if Session("webeditrun")="0" then
  for i=0 to ubound(gNoFile)
   if gNoFile(i)=sExt then 
     procCheckFile="没有权限访问此文件!"
     exit function
   end if
  next
 end if
 if ischeck>0 then
  sPath=left(sName,instrRev(sName,"/"))
  sPath=procCheckDir(sPath,1)
  if sPath<>"ok" then 
   procCheckFile=sPath
   exit function
  end if
  if ischeck=1 and not fo.FileExists(Server.MapPath(sName)) then
    procCheckFile="文件没有找到!"
    exit function
  end if
 else
   for i=0 to ubound(errorchar)
     if instr(sName,errorchar(i))>0 then
       procCheckFile="文件名中含有非法字符!"
       exit function
    end if
    next
 end if 
 procCheckFile="ok"
end function

function procCheckDir(sPath,mode)
   dim errorchar,i,hd,str
   sPath=lcase(sPath)
   procCheckDir="ok"
   errorchar=array("'","""","\","..","//","*","?","&","|","<",">")
   if isempty(sPath) or trim(sPath)="" then
    procCheckDir="目录不能为空!"
    exit function
   end if 
   for i=0 to ubound(errorchar)
     if instr(sPath,errorchar(i))>0 then
       procCheckDir="目录名中含有非法字符"
       exit function
    end if
   next
      
   if gFilePath=left(sPath,len(gFilePath)) then
    procCheckDir="没有权限访问此目录!"
    exit function
   end if
   
   if mode=0 then exit function
   if not  fo.FolderExists(Server.MapPath(sPath)) then
    procCheckDir="目录"&sPath&"没有找到!"
    exit function
   end if
   
   if left(sPath,len(gRootUrl))<>gRootUrl then
     procCheckDir="没有权限访问此目录!"
     exit Function
   end if
end function
%>