📄 cls_public.asp
字号:
<%
'====================================================================
'= Team Elite - Elite Article System
'= Copyright (c) 2005 Eason Chan All Rights Reserved.
'=-------------------------------------------------------------------
'= 文件名称：cls_public.asp
'= 摘 要：共用类文件
'=-------------------------------------------------------------------
'= 最后更新：eason007
'= 最后日期：2005-07-24
'====================================================================
Class cls_Public
Public SysInfo,SysStat(5)
Public Mem_Info(5),Mem_GroupSetting
Public IsMember
'*****************************
'初始化环境
'*****************************
Private Sub Class_Initialize()
Dim strConfigFile
Dim vTemp
strConfigFile=Server.MapPath (SystemFolder&"include/config.ini")
EA_Ini.OpenFile=strConfigFile
If EA_Ini.IsTrue Then
If Application(sCacheName&"IsFlush")<>1 Then
vTemp=EA_Ini.ReadNode("System","Info")
SysInfo=Split(vTemp,",")
If UBound(SysInfo)<26 Then FoundErr=True
SysStat(0)=EA_Ini.ReadNode("System","Column_Total")
SysStat(1)=EA_Ini.ReadNode("System","Topic_Total")
SysStat(2)=EA_Ini.ReadNode("System","M_Topic_Total")
SysStat(3)=EA_Ini.ReadNode("System","User_Total")
SysStat(4)=EA_Ini.ReadNode("System","Review_Total")
Else
FoundErr=True
End If
Else
FoundErr=True
End If
If FoundErr Then
vTemp=EA_DBO.Get_System_Info()
If IsArray(vTemp) Then
SysInfo=Split(vTemp(5,0),",")
Call EA_Ini.WriteNode("System","Info",vTemp(5,0))
SysStat(0)=vTemp(0,0)
SysStat(1)=vTemp(1,0)
SysStat(2)=vTemp(2,0)
SysStat(3)=vTemp(3,0)
SysStat(4)=vTemp(4,0)
Call EA_Ini.WriteNode("System","Column_Total",SysStat(0))
Call EA_Ini.WriteNode("System","Topic_Total",SysStat(1))
Call EA_Ini.WriteNode("System","M_Topic_Total",SysStat(2))
Call EA_Ini.WriteNode("System","User_Total",SysStat(3))
Call EA_Ini.WriteNode("System","Review_Total",SysStat(4))
EA_Ini.Save
Application.Lock
Application(sCacheName&"IsFlush")=0
Application.UnLock
Else
ErrMsg="加载站点配置数据错误，系统已关闭。"
Call ShowErrMsg(0,0)
End If
End If
Call Chk_IsMember
Call Chk_LockIp()
End Sub
'*********************
'关闭对象过程
'*********************
Public Sub Close_Obj()
On Error Resume Next
Erase SysInfo
Erase SysStat
Erase Mem_Info
Erase Mem_GroupSetting
If IsObject(EA_Temp) Then
EA_Temp.Close_Obj
Set EA_Temp=Nothing
End If
EA_Ini.Close
Set EA_Ini=Nothing
EA_DBO.Close_DB
Set EA_DBO=Nothing
If IsObject(EA_M_DBO) Then
EA_M_DBO.Close_DB
Set EA_M_DBO=Nothing
End If
CloseDataBase
End Sub
'**********************
'检测是否屏蔽ip过程
'**********************
Public Sub Chk_LockIp()
Dim Ip
Dim Temp
Ip=Get_UserIp
Ip=FormatIp(Ip)
Temp=EA_DBO.Get_Ip_LockInfo(Ip)
If IsArray(Temp) Then
ErrMsg="您的来访ip已被屏蔽，请与管理员联系。"
Call ShowErrMsg(0,0)
End If
End Sub
'************************
'检测是否为会员过程
'************************
Public Function Chk_IsMember()
Dim Temp,vTemp
If Len(Session("UserData"))>0 Then
IsMember=True
Else
If Len(Request.Cookies("UserData")) Then
Session("UserData")=Request.Cookies("UserData")
IsMember=True
Else
IsMember=False
End If
End If
If IsMember Then
vTemp=Split(Session("UserData"),",")
Mem_Info(0)=vTemp(0)
Mem_Info(1)=vTemp(1)
Mem_Info(2)=vTemp(2)
Mem_Info(3)=vTemp(3)
Mem_Info(4)=vTemp(4)
Mem_Info(5)=vTemp(5)
Temp=EA_DBO.Get_MemberLoginInfo(vTemp(0))
If Not IsArray(Temp) Then
IsMember=False
Else
If CLng(vTemp(4))<> CLng(Temp(16,0)) Then
IsMember=False
Else
Call Get_Member_GroupSetting(Mem_Info(3))
End If
End If
End If
Chk_IsMember=IsMember
End Function
'***********************************
'读取会员组配置信息过程
'输入参数：
' 1、组id
'***********************************
Public Sub Get_Member_GroupSetting(GroupId)
Dim vTemp,TempArray
vTemp=EA_Ini.ReadNode("GroupSetting","Group_"&GroupId)
If vTemp="" Then
TempArray=EA_DBO.Get_Group_Setting(GroupId)
If IsArray(TempArray) Then
Call EA_Ini.WriteNode("GroupSetting","Group_"&GroupId,TempArray(0,0)&","&Abs(TempArray(1,0))&","&TempArray(2,0))
EA_Ini.Save
Else
If Not EA_Ini.IsNode("GroupSetting","Group_1") Then
TempArray=EA_DBO.Get_Group_Setting(1)
If IsArray(TempArray) Then
Call EA_Ini.WriteNode("GroupSetting","Group_1",TempArray(0,0)&","&Abs(TempArray(1,0))&","&TempArray(2,0))
EA_Ini.Save
GroupId=1
Else
ErrMsg="系统读取会员信息时发生错误，系统已关闭。"
Call ShowErrMsg(0,0)
End If
Else
GroupId=1
End If
End If
Get_Member_GroupSetting GroupId
Else
Mem_GroupSetting=Split(vTemp,",")
End If
End Sub
'**********************************
'显示错误信息提示过程
'输入参数：
' 1、错误号
' 2、显示类型
'**********************************
Public Sub ShowErrMsg(ErrNum,Types)
Response.Clear
Select Case CInt(Types)
Case 0
Response.Write "<font style='font-family:Verdana;font-size:11px'>"&ErrMsg&"</font>"
Case 1
Response.Redirect SystemFolder&"error.asp?errnum="&ErrNum
Case 2
Response.Write "<script language=""JavaScript"">"&vbcrlf
Response.Write "alert("""&ErrMsg&""");"&vbcrlf
Response.Write "history.go(-1);"&vbcrlf
Response.Write "</script>"&vbcrlf
End Select
Response.End
End Sub
'****************************
'显示成功信息提示过程
'输入参数：
' 1、成功号
' 2、显示类型
'****************************
Public Sub ShowSusMsg(SusNum,Note)
Response.Clear
Response.Redirect SystemFolder&"success.asp?susnum="&SusNum&"¬e="&Note
Response.End
End Sub
'********************
'检测是否外部提交数据过程
'********************
Public Sub Chk_Post()
Dim Server_V1,Server_V2
Server_V1=Cstr(Request.ServerVariables("HTTP_REFERER"))
Server_V2=Cstr(Request.ServerVariables("SERVER_NAME"))
If Mid(Server_V1,8,Len(Server_V2))<>Server_V2 Then Call ShowErrMsg(9,1)
End Sub
'****************************************************
'检测HTML文件是否存在
'输入参数：
' 1、HTML文件地址
'****************************************************
Public Function Chk_IsExistsHtmlFile(ByVal sFilePath)
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
sFilePath=Server.MapPath (sFilePath)
Chk_IsExistsHtmlFile=objFSO.FileExists (sFilePath)
End Function
'***********************************************
'输入参数：
' 1、HTML文件地址
' 2、文件内容
'***********************************************
Public Sub Save_HtmlFile(sFilePath,sPageContent)
Dim FileName
Dim S
Set S = Server.CreateObject("ADODB.STREAM")
FileName=Server.MapPath(sFilePath)
With S
.Open
.Charset = "GB2312"
.WriteText sPageContent
.SaveToFile FileName,2
.Close
End With
Set S = Nothing
End Sub
'*********************************
'根据指定名称生成目录
'*********************************
Public Sub MakeNewsDir(foldername)
Dim fso1
Dim f
Set fso1 = CreateObject("Scripting.FileSystemObject")
Set f = fso1.CreateFolder(foldername)
Set fso1 = Nothing
End Sub
'***********************************
'检查某一目录是否存在
'***********************************
Public Function CheckDir(FolderPath)
Dim fso1
folderpath=Server.MapPath(".")&"\"&folderpath
Set fso1 = CreateObject("Scripting.FileSystemObject")
If fso1.FolderExists(FolderPath) Then
CheckDir = True
Else
CheckDir = False
End If
Set fso1 = Nothing
End Function
'***************************************
'检查定时开关状态过程
'输入参数：
' 1、时间字符串
'***************************************
Public Function Chk_SystemTimer(TimeStr)
Dim TimeArray
Dim i
FoundErr=False
TimeArray=Split(TimeStr,"|")
If UBound(TimeArray)<>1 Then
ErrMsg="定时关闭参数格式错误，请与管理员联系。"
FoundErr=True
Else
TimeArray(0)=SafeRequest(0,TimeArray(0),0,1,0)
TimeArray(1)=SafeRequest(0,TimeArray(1),0,23,0)
If TimeArray(0)>TimeArray(1) Then
ErrMsg="定时关闭参数错误，请与管理员联系。"
FoundErr=True
End If
If TimeArray(0)<=Hour(Now()) And TimeArray(1)>=Hour(Now()) Then
FoundErr=False
Else
ErrMsg=SysInfo(2)
FoundErr=True
End If
End If
Chk_SystemTimer=FoundErr
End Function
'************************************
'截取文字长度函数
'输入参数：
' 1、文字内容
' 2、文字最大长度
'************************************
Public Function Cut_Title(Title,TLen)
Dim k,i,d,c
Dim iStr
k=0
d=StrLen(Title)
iStr=""
For i=1 To Len(Title)
c=Abs(Asc(Mid(Title,i,1)))
If c>255 Then
k=k+2
Else
k=k+1
End If
iStr=iStr&Mid(Title,i,1)
If CLng(k)>CLng(TLen) Then
iStr=iStr&".."
Exit For
End If
Next
Cut_Title=iStr
End Function
'*******************************
'检测文字长度函数
'输入参数：
' 1、文字内容
'*******************************
Private Function StrLen(strText)
Dim k,i,c
k=0
For i=1 To Len(strText)
c=Abs(Asc(Mid(strText,i,1)))
If c>255 Then
k=k+2
Else
k=k+1
End If
Next
StrLen=k
End Function
'************************************************
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -