siteconfig.asp

依蓝旅游网站管理系统Elan2008.SP2

<!--#Include File="Inc/CacheConfig.asp"-->
<!--#Include File="Inc/ClassCache.asp"-->
<%
Dim Action, ComeURL, StrConnection, Conn, IsDebug, EL_SendErrorURL, EL_Cache
Dim EL_Now, EL_True, EL_False, EL_BadChar, EL_Sn, EL_CurrentScriptName, EL_PicHack
Dim InstallDir, SiteName, SiteTitle, SiteUrl, SiteLogo, WebmasterName, WebmasterEmail
Dim MetaKeywords, MetaDescription, CopyRight, EnableSaveRemote, Object_FSO, EnableCounter, AdminDir
Dim IpLockType, BlackIp, PermitIP, RemoteIp, EnableWatermark, EnableCreateThumb, ConsumeProportion
Dim PointItemName, PointItemUnit, ExpItemName, ExpItemUnit, ShowAdminLogin, SiteOpened, CloseReason, PostInterval
Dim DefaultFaceSize, FaceMaxSize, SearchInterval
	  
Action = Trim(Request("Action"))
ComeURL = Trim(Request("ComeURL"))

DefaultFaceSize = 40 '会员默认头像尺寸
FaceMaxSize = 120    '会员最大头像尺寸

If ComeURL = "" Then ComeUrl = Trim(Request.ServerVariables("HTTP_REFERER"))
RemoteIp = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If RemoteIp = "" Then RemoteIp = Request.ServerVariables("REMOTE_ADDR")

IsDebug = True   '是否扑捉程序执行过程中的错误，True为是，False为否
EL_SendErrorURL = "" '发送错误报告的链接地址

EL_Now = "getdate()"
EL_True = "1"
EL_False = "0"

 '非法参数列表
EL_BadChar = "',%,^,&,?,(,),<,>,[,],{,},/,\,;,:,@,--,+" & Chr(34) & "," & Chr(0)

'图片木马检测列表
EL_PicHack = ".getfolder,.createfolder,.createtextfile,.createdirectory,.deletedirectory,.saveas,<script,<iframe,location.,this.,parent.,top.,self.,window.,filesystemobject,wscript.shell,script.encode,server.,.createobject,execute,activexobject,language=,vbscript,jscript,javascript,request,response,adodb.stream"

StrConnection = "Provider = Sqloledb; User ID = " & SqlUsername & "; Password = " & SqlPassword & "; Initial Catalog = " & SqlDatabaseName & "; Data Source = " & SqlLocalName & ";"
Set Conn = Server.CreateObject("ADODB.Connection")
Set EL_Cache = New ClassCache

Call OpenConnection()
Call GetSiteConfig()
Call LockIp(IpLockType, PermitIP, BlackIp, RemoteIp)
EL_Sn = Replace(Replace(Request.ServerVariables("SERVER_NAME") & InstallDir, "/", ""), ".", "")
EL_CurrentScriptName = Right(Request.ServerVariables("SCRIPT_NAME"), Len(Request.ServerVariables("SCRIPT_NAME"))-InstrRev(Request.ServerVariables("SCRIPT_NAME"), "/"))


Sub GetSiteConfig()
   Dim ConfigCmd, rsConfig, CacheConfig
   
   If Cache_SysConfig = 1 Then CacheConfig = EL_Cache.GetCache("Sys.Config", 0)
   If Not IsArray(CacheConfig) Or InstallDir = "" Or IsNULL(InstallDir) Then
      Set ConfigCmd = Server.CreateObject("ADODB.COMMAND")
      With ConfigCmd
         .ActiveConnection = Conn
         .CommandText  = "EL_SP_BaseConfig"
         .CommandType = 4   
         .Prepared = True
      End With
      Set rsConfig = ConfigCmd.Execute()
      If rsConfig.EOF And rsConfig.BOF Then
         Set rsConfig = Nothing
	     Set ConfigCmd = Nothing
	     Call CloseConn()
         Response.Clear()
	     Response.Write "无法读取网站配置，系统无法正常运行"
	     Response.End()
      Else
         SiteName = rsConfig(0)
	     SiteTitle = rsConfig(1)
	     SiteUrl = rsConfig(2)
	     SiteLogo = rsConfig(3)
	     InstallDir = rsConfig(4)
	     WebmasterName = rsConfig(5)
	     WebmasterEmail = rsConfig(6)
	     MetaKeywords = rsConfig(7)
	     MetaDescription = rsConfig(8)
	     CopyRight = rsConfig(9)
	     EnableSaveRemote = rsConfig(10)
	     Object_FSO = rsConfig(11)
	     AdminDir = rsConfig(12)
	     IpLockType = rsConfig(13)
	     BlackIp = rsConfig(14)
	     PermitIP = rsConfig(15)
	     EnableWatermark = rsConfig(16)
	     EnableCreateThumb = rsConfig(17)
	     PointItemName = rsConfig(18)
	     PointItemUnit = rsConfig(19)
	     ExpItemName = rsConfig(20)
	     ExpItemUnit = rsConfig(21)
	     ShowAdminLogin = rsConfig(22)
	     ConsumeProportion = rsConfig(23)
	     SiteOpened = rsConfig(24)
	     CloseReason = rsConfig(25)
	     EnableCounter = rsConfig(26)
		 PostInterval = rsConfig(27)
		 SearchInterval = rsConfig(28)
	     rsConfig.Close()
	     Set rsConfig = Nothing
	     Set ConfigCmd = Nothing
		 
		 If Cache_SysConfig = 1 Then 
		    ReDim CacheConfig(28)
		    CacheConfig(0) = SiteName
	        CacheConfig(1) = SiteTitle
	        CacheConfig(2) = SiteUrl
	        CacheConfig(3) = SiteLogo
	        CacheConfig(4) = InstallDir
	        CacheConfig(5) = WebmasterName
	        CacheConfig(6) = WebmasterEmail
	        CacheConfig(7) = MetaKeywords
	        CacheConfig(8) = MetaDescription
	        CacheConfig(9) = CopyRight
	        CacheConfig(10) = EnableSaveRemote
	        CacheConfig(11) = Object_FSO
	        CacheConfig(12) = AdminDir
	        CacheConfig(13) = IpLockType
	        CacheConfig(14) = BlackIp
	        CacheConfig(15) = PermitIP
	        CacheConfig(16) = EnableWatermark
	        CacheConfig(17) = EnableCreateThumb
	        CacheConfig(18) = PointItemName
	        CacheConfig(19) = PointItemUnit
	        CacheConfig(20) = ExpItemName
	        CacheConfig(21) = ExpItemUnit
	        CacheConfig(22) = ShowAdminLogin
	        CacheConfig(23) = ConsumeProportion
	        CacheConfig(24) = SiteOpened
	        CacheConfig(25) = CloseReason
	        CacheConfig(26) = EnableCounter
			CacheConfig(27) = PostInterval
			CacheConfig(28) = SearchInterval
		    Call EL_Cache.SetCache("Sys.Config", CacheConfig, -1)
		 End If
      End If
   Else
      SiteName = CacheConfig(0)
	  SiteTitle = CacheConfig(1)
	  SiteUrl = CacheConfig(2)
	  SiteLogo = CacheConfig(3)
	  InstallDir = CacheConfig(4)
	  WebmasterName = CacheConfig(5)
	  WebmasterEmail = CacheConfig(6)
	  MetaKeywords = CacheConfig(7)
	  MetaDescription = CacheConfig(8)
	  CopyRight = CacheConfig(9)
	  EnableSaveRemote = CacheConfig(10)
	  Object_FSO = CacheConfig(11)
	  AdminDir = CacheConfig(12)
	  IpLockType = CacheConfig(13)
	  BlackIp = CacheConfig(14)
	  PermitIP = CacheConfig(15)
	  EnableWatermark = CacheConfig(16)
	  EnableCreateThumb = CacheConfig(17)
	  PointItemName = CacheConfig(18)
	  PointItemUnit = CacheConfig(19)
	  ExpItemName = CacheConfig(20)
	  ExpItemUnit = CacheConfig(21)
	  ShowAdminLogin = CacheConfig(22)
	  ConsumeProportion = CacheConfig(23)
	  SiteOpened = CacheConfig(24)
	  CloseReason = CacheConfig(25)
	  EnableCounter = CacheConfig(26)
	  PostInterval = CacheConfig(27)
	  SearchInterval = CacheConfig(28)
   End If   
   
   If EL_Cache.GetCache("Sys.Edition", 0) = "" Then
      Dim SysEdition
	  SysEdition = Conn.Execute("SELECT Edition FROM EL_Config")(0)
	  Call EL_Cache.SetCache("Sys.Edition", SysEdition, -1)
   End If
End Sub

Sub OpenConnection()
   On Error Resume Next
   Conn.Open StrConnection
   If Err Then
      Err.Clear
	  Set Conn=Nothing	  
      Response.Write " 数据库连接出错，请检查Conn.asp文件中的数据库参数设置。"
      Response.End()
   End If
End Sub

Sub CloseConn()
  On Error Resume Next
  If IsObject(Conn) Then
     Conn.close()
	 Set Conn = Nothing
  End If
End Sub

Sub LockIp(ByVal nLockType, ByVal sPermitIP, ByVal sBlackIp, Byval sUserIp)
   Dim IpCode, Passed
   IpCode = IpEncode(sUserIp)
   Passed = True
   Select Case nLockType
	  Case 1: '只允许白名单
	      Passed = CheckIp(IpCode, sPermitIP)
		  
	  Case 2: '只禁止黑名单
	      If CheckIp(IpCode, sBlackIp) = True Then
		     Passed = False
		  End If
		  
	  Case 3: '白名单优先
	      If CheckIp(IpCode, sPermitIP) = False Then
		     Passed = False
		  Else
		     If CheckIp(IpCode, sBlackIp) = True Then
			    Passed = False
			 End If
		  End If
		  
	  Case 4: '黑名单优先
	     If CheckIp(IpCode, sBlackIp) = True Then
		     Passed = False
		  Else
		     If CheckIp(IpCode, sPermitIP) = False Then
			    Passed = False
			 End If
		  End If
		  
	  Case Else: Exit Sub
   End Select
   If Passed = False Then
      Response.Write "对不起，您的IP："& RemoteIp &" 被禁止访问本站"
	  Call CloseConn()
	  Response.End()
   End If
End Sub

Function CheckIp(ByVal Code, ByVal IpList)
   Dim i, ArrTemp, ArrIp
   ArrTemp = Split(IpList, "$")
   CheckIp = False
   For i = 0 To Ubound(ArrTemp)
      ArrIp = Split(ArrTemp(i), "-")
	  If Csng(Code) >= Csng(ArrIp(0)) And Csng(Code) <= Csng(ArrIp(1)) Then
	     CheckIp = True
		 Exit Function
	  End If
   Next
End Function

Function IpEncode(ip)
    On Error Resume Next
	Dim ArrIp
    ArrIp = Split(ip, ".")    
	IpEncode = Clng(ArrIp(0)) * 256 * 256 * 256 + Clng(ArrIp(1)) * 256 * 256 + Clng(ArrIp(2)) * 256 + Clng(ArrIp(3)) - 1
    If Err Then
	   Err.Clear()
	   IpEncode = 0
	End If
End Function

%>