?? 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 + -