📄 ixs_char.asp
字号:
<%
Class iXuEr_Core
' 系统缓存信息
Public Sys_Info, AcInfo, SpecialInfo, Affiche, GroupSetting, FriendSiteInfo
' 系统模板变量
Public Main_Style, Page_Style, PageTitle, Style_Type, Where
' 客户端环境
Public TimeZone, User_Agent, SystemSN
' 用户缓存信息
Public UserID, UserInfo, UserBrowser, UserSetting, UserName, PassWord, RndNum, LoginTime, LoginType, CooEntType, CooPath, UserCooErr
' 管理员缓存信息
Public Master, MasterInfo, MasterSetting
' HTML代码过滤
Public AllowHTML, DeCode, ReqStrLen, ReqNumLen
' 获取文件名称
Public ScriptName, Referer
' Sql查询次数统计
Public Sql_Use
' 需要检测的组件的对象名称
Public TheTestObj(26, 1)
' 公用循环变量
Private i
' 系统缓存信息
Public ReloadTime, CacheNameFlag, CacheName, LocalCacheName, CacheData, CachePowered
' ============================================
' 类模块初始化
' ============================================
Private Sub Class_Initialize()
If Not Response.IsClientConnected Then Response.End
Dim TmpStr
TmpStr = Split(Request.ServerVariables("PATH_INFO"), "/")
ScriptName = LCase(TmpStr(UBound(TmpStr)))
PageTitle = ""
Sql_Use = 0
LoginType = 0
CooEntType = 0
UserCooErr = 0
' 初始化缓存参数
ReloadTime = 2880 ' 默认缓存生存周期，单位：分钟
CacheNameFlag = "iXuEr-PAMS"
CacheName = Replace(Replace(Replace(UCase(Server.MapPath("Index.asp")), UCase("Index.asp"), ""), ":", ""), "\", "") & "_" & CacheNameFlag ' 默认缓存主名称
CachePowered = "Powered By iXuEr Cache Server" ' 缓存创建信息，用以区别是否本系统创建的缓存，同一空间存在多个相同系统的时候推荐不要使用相同的值
SystemSN = Replace(Replace(CacheName, "-", ""), "_", "")
' 转入页面，用于操作之后返回
If Session(CacheName & "Referer") <> "" And (Not IsNull(Session(CacheName & "Referer"))) Then Referer = Session(CacheName & "Referer")
Call LoadSetup() ' 加载常规缓存
AllowHTML = False ' 所有表单数据不兼容HTML 默认
DeCode = Sys_Info(97) ' 在此之前必须先运行常规缓存
ReqStrLen = Sys_Info(89) ' 还需要设置字符串读取的长度
ReqNumLen = Sys_Info(67) ' 允许获取数字型变量的最大长度
CooPath = Replace(Sys_Info(0), LCase("http://" & Request.ServerVariables("HTTP_HOST")), "")
TimeZone = Session(CacheName & "iXs_TimeZone")
If TimeZone = "" Or IsNull(TimeZone) Then
TimeZone = ReqNum("iXs_TimeZone")
If TimeZone = "" Then TimeZone = Sys_Info(31) ' 如果没有指定时区，则默认是当前系统时区
End If
If ReqNum("iXs_TimeZone") <> "" Then
TimeZone = ReqNum("iXs_TimeZone") ' 如果指定了时区则设置自定义
Session(CacheName & "iXs_TimeZone") = TimeZone
Call Redirect("Help.asp", 0)
End If
Session(CacheName & "iXs_TimeZone") = TimeZone
' 获取用户Cookies验证错误代码，没有错误返回0
UserCooErr = Session(CacheName & "UserCooErr")
End Sub
' ============================================
' 根据用户指派并设定缓存
' ============================================
Private Sub SetCache(SetName, NewValue)
Application.Lock
Application(SetName) = NewValue
Application.UnLock
End Sub
' ============================================
' 根据用户指派清空某个缓存
' ============================================
Private Sub MakeEmpty(SetName)
Application.Lock
Application(SetName) = Empty
Application.UnLock
End Sub
' ============================================
' 根据用户指派设定一个指定名称的缓存
' ============================================
Public Property Let Name(ByVal vNewValue)
LocalCacheName = LCase(vNewValue)
End Property
' ============================================
' 根据用户指派设定指定缓存的数值
' ============================================
Public Property Let Value(ByVal vNewValue)
If LocalCacheName <> "" Then
CacheData = Application(CacheName & "_" & LocalCacheName)
If IsArray(CacheData) Then
CacheData(0) = vNewValue
CacheData(1) = Now()
CacheData(2) = CachePowered
Else
ReDim CacheData(2)
CacheData(0) = vNewValue
CacheData(1) = Now()
CacheData(2) = CachePowered
End If
Call SetCache(CacheName & "_" & LocalCacheName, CacheData)
Else
' 输出自定义错误 错误标题 错误信息
Err.Raise vbObjectError + 1, "iXuEr_CacheServer", " Please Change The CacheName."
End If
End Property
' ============================================
' 根据用户指派读取缓存数值
' ============================================
Public Property Get Value()
If LocalCacheName <> "" Then
CacheData = Application(CacheName & "_" & LocalCacheName)
If IsArray(CacheData) Then
Value = CacheData(0)
Else
Err.Raise vbObjectError + 1, "iXuEr_CacheServer" , " The CacheData(" & LocalCacheName & ") Is Empty."
'Value = ""
End If
Else
Err.Raise vbObjectError + 1, "iXuEr_CacheServer", " Please Change The CacheName."
End If
End Property
' ============================================
' 判断当前缓存是否过期
' ============================================
Public Function ObjIsEmpty()
ObjIsEmpty = True
CacheData = Application(CacheName & "_" & LocalCacheName)
If Not IsArray(CacheData) Then Exit Function
If Not IsDate(CacheData(1)) Then Exit Function
If DateDiff("n", CDate(CacheData(1)), Now()) < ReloadTime Then ObjIsEmpty = False
End Function
' ============================================
' 删除缓存
' ============================================
Public Sub DelCache(MyCaheName, DelType)
'Response.Write(MyCaheName & "<br>")
If DelType = 1 Then
' 根据用户指派清除某个缓存的数值，但不删除该缓存
MakeEmpty(CacheName & "_" & MyCaheName)
ElseIf DelType = 0 Then
' 根据用户指派删除该缓存
Application.Contents.Remove(CacheName & "_" & MyCaheName)
End If
End Sub
' ============================================
' 删除所有缓存对象
' ============================================
Public Sub DelAll()
Application.Contents.RemoveAll()
End Sub
' ============================================
' 检测缓存数量
' ============================================
Public Function Cache_Use()
Dim App, Item, Temp, i
i = 0
Set App = Application.Contents
On Error Resume Next
For Each Item In App
Temp = App(Item)
If CStr(Left(Item, Len(CacheName) + 1)) = CacheName & "_" And IsArray(Temp) Then ' 缓存变量应该是数组
If Ubound(Temp) = 2 Then ' 缓存数组的最大下标为2
' 缓存数组的第二个元素是时间，第三个元素是创建信息
If IsDate(Temp(1)) And CStr(Temp(2)) = CStr(CachePowered) Then i = i + 1
End If
End If
Next
Cache_Use = i
End Function
' ============================================
' 类模块执行完毕
' ============================================
Private Sub Class_Terminate
If IsObject(Conn) Then Call CloseDB()
End Sub
' ============================================
' 检测组件是否被安装（支持）
' ============================================
Public Function IsObjInstalled(Obj)
On Error Resume Next
Dim xTestObj
Set xTestObj = Server.CreateObject(TheTestObj(Obj, 0))
If Err Then
Err.Clear
IsObjInstalled = False
Else
IsObjInstalled = True
End If
Set xTestObj = Nothing
End Function
' ============================================
' 检测组件的版本
' ============================================
Public Function GetObjVersion(Obj)
On Error Resume Next
Dim xTestObj
Set xTestObj = Server.CreateObject(TheTestObj(Obj, 0))
If Err Then
Err.Clear
GetObjVersion = ""
Else
GetObjVersion = xTestObj.Version
End If
Set xTestObj = Nothing
End Function
' ============================================
' 装载要测试的组件对象数组
' ============================================
Public Sub LoadTheTestObj()
' 内建类
TheTestObj(0, 0) = "MSWC.AdRotator"
TheTestObj(0, 1) = "MSWC.AdRotator"
TheTestObj(1, 0) = "MSWC.BrowserType"
TheTestObj(1, 1) = "MSWC.BrowserType"
TheTestObj(2, 0) = "MSWC.NextLink"
TheTestObj(2, 1) = "MSWC.NextLink"
TheTestObj(3, 0) = "MSWC.Tools"
TheTestObj(3, 1) = "MSWC.Tools"
TheTestObj(4, 0) = "MSWC.Status"
TheTestObj(4, 1) = "MSWC.Status"
TheTestObj(5, 0) = "MSWC.Counters"
TheTestObj(5, 1) = "MSWC.Counters"
TheTestObj(6, 0) = "MSWC.PermissionChecker"
TheTestObj(6, 1) = "MSWC.PermissionChecker"
TheTestObj(7, 0) = "WScript.Shell"
TheTestObj(7, 1) = "WScript.Shell"
TheTestObj(8, 0) = "Microsoft.XMLHTTP"
TheTestObj(8, 1) = "Microsoft.XMLHTTP"
TheTestObj(9, 0) = "Scripting.FileSystemObject"
TheTestObj(9, 1) = "FSO 文本文件读写"
TheTestObj(10, 0) = "ADODB.Connection"
TheTestObj(10, 1) = "ActiveX Data Object [ADO]"
' 上传类
TheTestObj(11, 0) = "SoftArtisans.FileUp"
TheTestObj(11, 1) = "SA-FileUp 文件上传"
TheTestObj(12, 0) = "SoftArtisans.FileManager"
TheTestObj(12, 1) = "SoftArtisans 文件管理"
TheTestObj(13, 0) = "LyfUpload.UploadFile"
TheTestObj(13, 1) = "刘云峰的文件上传组件"
TheTestObj(14, 0) = "Persits.Upload"
TheTestObj(14, 1) = "ASPUpload 文件上传"
TheTestObj(15, 0) = "w3.upload"
TheTestObj(15, 1) = "Dimac 文件上传"
' 邮件类
TheTestObj(16, 0) = "JMail.SmtpMail"
TheTestObj(16, 1) = "Dimac JMail 邮件收发</a>"
TheTestObj(26, 0) = "JMail.Message"
TheTestObj(26, 1) = "Dimac JMail 4.3/4.4</a>"
TheTestObj(17, 0) = "CDONTS.NewMail"
TheTestObj(17, 1) = "虚拟 SMTP 发信"
TheTestObj(18, 0) = "Persits.MailSender"
TheTestObj(18, 1) = "ASPemail 发信"
TheTestObj(19, 0) = "SMTPsvg.Mailer"
TheTestObj(19, 1) = "ASPmail 发信"
TheTestObj(20, 0) = "DkQmail.Qmail"
TheTestObj(20, 1) = "dkQmail 发信"
TheTestObj(21, 0) = "Geocel.Mailer"
TheTestObj(21, 1) = "Geocel 发信"
TheTestObj(22, 0) = "IISmail.Iismail.1"
TheTestObj(22, 1) = "IISmail 发信"
TheTestObj(23, 0) = "SmtpMail.SmtpMail.1"
TheTestObj(23, 1) = "SmtpMail 发信"
' 图像类
TheTestObj(24, 0) = "SoftArtisans.ImageGen"
TheTestObj(24, 1) = "SA 的图像读写组件"
TheTestObj(25, 0) = "W3Image.Image"
TheTestObj(25, 1) = "Dimac 的图像读写组件"
End Sub
' ============================================
' 检测网站常规信息并设置缓存
' ============================================
Public Sub LoadSetup()
Name = "iXsTemp_System_Settings"
' 如果需要更新缓存则去掉这里的单引号
'Call DelCache("iXsTemp_System_Settings", 0)
If ObjIsEmpty Then
Call DelCache("iXsTemp_System_Settings", 0)
' 关于系统的设置信息暂时使用内核类属性代替，系统完善之后再加入数据库并使用缓存
Dim System_Settings(140)
' 网站的访问地址，自动获取，如果在子文件夹，则会自动检测
System_Settings(0) = "http://" & LCase(Replace(Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL"), Split(Request.ServerVariables("SCRIPT_NAME"), "/")(UBound(Split(Request.ServerVariables("SCRIPT_NAME"), "/"))), ""))
System_Settings(5) = "Index.asp" ' 首页文件名称
System_Settings(31) = 8 ' 当前时区
'-----------------------------------------------------
' 附件调用限制，多个域名用“,”隔开
System_Settings(32) = "http://www.xlfw.cn/,http://xlfw.cn/,http://www.psysch.com/,http://psysch.com/,http://www.114xp.cn/,http://pams.114xp.cn/"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -