📄 ixs_clsmain.asp
字号:
If UBound(Temp) <> 3 Then Exit Function
For i = 0 To 3
If Temp(i) = "*" Then Temp(i) = "***"
A = A & String(3 - Len(Temp(i)), "0") & Temp(i) & "."
Next
A = Left(A, 15)
' 对需要检查的IP地址整形
Temp = Split(Find, ".")
If UBound(Temp) <> 3 Then Exit Function
For i = 0 To 3
B = B & String(3 - Len(Temp(i)), "0") & Temp(i) & "."
Next
B = Left(B, 15)
' 开始比较
For i = 1 To 15
If (CStr(Mid(A, i, 1)) = "*") Or (CStr(Mid(A, i, 1)) = CStr(Mid(B, i, 1))) Then
CheckIp = True
Else
CheckIp = False
Exit For
End If
Next
End Function
' ============================================
' 函数名称：RsIsRepeat
' 函数功能：检测指定字段的数值是否存在重复
' 其他说明：无
' 传入参数：
' 1、p_Table：表名
' 2、p_Field：字段名
' 3、p_Value：要检查的数值
' 4、p_Type：是否数字型
' 返回结果：
' True：重复
' False = 1：没有重复
' ============================================
Public Function RsIsRepeat(p_Table, p_Field, p_Value, p_Type)
RsIsRepeat = True
Dim Rs, Sql
If p_Type = 1 Then
Sql = p_Value
Else
Sql = "'" & p_Value & "'"
End If
Set Rs = Execute("SELECT " & p_Field & " FROM " & p_Table & " WHERE " & p_Field & "=" & Sql)
If Not (Rs.Eof And Rs.Bof) Then Exit Function
Rs.Close : Set Rs = Nothing
RsIsRepeat = False
End Function
' ============================================
' 判断用户是否使用了皮肤 用于用户第一次登陆
' ============================================
Sub CheckUserSkin()
Dim p_SkinID, p_CssID, NotCookies
NotCookies = False
p_SkinID = Request.Cookies(SystemSN)("UserSkinID_" & SysID)
p_CssID = Request.Cookies(SystemSN)("UserCssID_" & SysID)
If p_SkinID = "" Or IsNull(p_SkinID) Then
NotCookies = True
Else
SkinID = CLng(p_SkinID)
End If
If p_CssID = "" Or IsNull(p_CssID) Then
NotCookies = True
Else
CssID = CLng(p_CssID)
End If
If NotCookies = True Then
Response.Cookies(SystemSN)("UserSkinID_" & SysID) = SkinID
Response.Cookies(SystemSN)("UserCssID_" & SysID) = CssID
Call UpdateCookies(0, 1)
End If
End Sub
' ============================================
' 全站验证码确认
' ============================================
Public Function CheckGetCode(RndStr, p_Type)
CheckGetCode = False
Dim Temp
Temp = Session(CacheName & "-iXuEr_GetCode")
Session.Contents.Remove(CacheName & "-iXuEr_GetCode")
If CStr(RndStr) <> CStr(Temp) Then
If p_Type = 1 Then
Call SystemError(6, 3)
Else
Exit Function
End If
End If
CheckGetCode = True
End Function
' ============================================
' 用户登陆验证
' ============================================
Public Function CheckUserLogin(UserName, UserPass, LoginTime, LoginType)
' LoginType用来标记用户登陆方式：0=网站表单登陆或者注册后自动登陆，1=Coolies登陆
' 用户缓存信息：
' 0用户名, 1密码, 2用户组编号, 3电子信箱, 4邮政编码, 5联系方式, 6签名, 7性别, 8头像地址, 9头像宽度, 10头像高度, 11用户人气, 12用户状态, 13门派编号, 14用户财富值, 15用户金钱数, 16用户经验值, 17用户魅力值, 18威望, 19头衔, 20生日, 21密码问题, 22问题答案, 23用户照片, 24用户好友分组, 25详细信息, 26用户控制参数, 27用户等级图片, 28是否隐身, 29用户短信, 30注册日期, 31上次登陆时间, 32用户登陆次数, 33上次登陆IP, 34是否拥有自定义权限
' UserName, UserPassword, UserGroupID, UserEmail, UserPost, UserIM, UserSign, UserSex, UserFace, UserWidth, UserHeight, UserViews, LockUser, UserGroup, UserWealth, UserMoney, UserEP, UserCP, UserPower, UserTitle, UserBirthday, UserQuestion, UserAnswer, UserPhoto, UserFav, UserInfo, UserSetting, TitlePic, UserHidden, UserMsg, JoinDate, LastLogin, UserLogins, UserLastIP, UserIsAccess
Dim p_UserInfo, UserTruePass
Dim Rs, i, Temp
CheckUserLogin = False
If Session(CacheName & "-UserID") <> "" And (Not IsNull(Session(CacheName & "-UserID"))) Then UserID = Session(CacheName & "-UserID")
If LoginType = 1 Then
' 如果已经登陆则不需要再次验证
If UserID > 0 Then
' 加载用户缓存
UserInfo = Session(CacheName & "-UserInfo")
' 如果用户缓存是错误的则清除所有权限信息
If Not IsArray(UserInfo) Then
' 清空用户Cookies
Call ClearCookies()
' 销毁会话变量
Session.Abandon()
End If
End If
UserName = Request.Cookies(SystemSN)("UserName")
UserPass = Request.Cookies(SystemSN)("PassWord")
If UserName = "" Or IsNull(UserName) Then Exit Function
If UserPass = "" Or IsNull(UserPass) Then Exit Function
LoginTime = 0
UserTruePass = iXs_Ent(UserPass, Asc(LCase(Right(UserPass, 1))) Mod 7)
End If
Set Rs = Execute("SELECT UserID, UserTruePass, UserName, UserPassword, UserGroupID, UserEmail, UserPost, UserIM, UserSign, UserSex, UserFace, UserWidth, UserHeight, UserViews, LockUser, UserGroup, UserWealth, UserMoney, UserEP, UserCP, UserPower, UserTitle, UserBirthday, UserQuestion, UserAnswer, UserPhoto, UserFav, UserInfo, UserSetting, TitlePic, UserHidden, UserMsg, JoinDate, LastLogin, UserLogins, UserLastIP, UserIsAccess FROM iXs_Users WHERE UserName='" & UserName & "'")
If Not (Rs.Eof And Rs.Bof) Then
If LoginType = 0 Then ' 直接对比
If CStr(Rs(3)) = CStr(UserPass) Then
CheckUserLogin = True
Else
AddErrCode = 8
Exit Function
End If
ElseIf LoginType = 1 Then ' 加密后对比
If CStr(Rs(1)) = CStr(UserTruePass) Then
CheckUserLogin = True
Else
' 清除Cookies
'Call ClearCookies()
Exit Function
End If
Else
AddErrCode = 7
Exit Function
End If
' 如果登陆成功则加载权限
If CheckUserLogin = True Then
If CLng(Rs("LockUser")) = 1 Then
AddErrCode = 9
Exit Function
End If
' 加载用户信息
Dim p_Temp
p_Temp = Rs.GetRows(-1)
For i = 2 To UBound(p_Temp, 1)
If i = 2 Then
p_UserInfo = p_Temp(i, 0)
Else
p_UserInfo = p_UserInfo & ("," & p_Temp(i, 0))
End If
Next
UserID = p_Temp(0, 0)
End If
Else
If LoginType = 1 Then
' 强制转换为客人权限
UserID = 0
Session(CacheName & "-UserID") = UserID ' 设置用户ID
' 清除Cookies
'Call ClearCookies()
Exit Function
Else
AddErrCode = 6
End If
End If
Rs.Close
Set Rs = Nothing
' ------------------------------------------------------------------------------------------------
' 如果登陆成功则加载用户信息
If CheckUserLogin = True Then
Dim CooPassWord
' 生成随机验证码
CooPassWord = GetRndCode(16)
Call UpdateCookies(LoginTime, LoginType)
Response.Cookies(SystemSN)("UserName") = UserName
Response.Cookies(SystemSN)("PassWord") = CooPassWord
If Not CLng(HaveHidden) = 0 Then Response.Cookies(SystemSN)("UserHidden") = 1
' 更新用户信息
' 加密随机验证密码，并记入数据库
UserTruePass = iXs_Ent(CooPassWord, Asc(LCase(Right(CooPassWord, 1))) Mod 7)
' 增加用户财富值、金钱数、经验值、魅力值和Cookies保留时间
i = Split(p_UserInfo, ",")
Temp = Split(i(26), "|")
Temp(1) = LoginTime
Execute("UPDATE iXs_Users SET UserTruePass='" & UserTruePass & "', UserWealth=UserWealth+" & Main_Setting(57) & ", UserMoney=UserMoney+" & Main_Setting(58) & ", UserEP=UserEP+" & Main_Setting(59) & ", UserCP=UserCP+" & Main_Setting(60) & ", UserSetting='" & Temp(0) & "|" & Temp(1) & "|" & Temp(2) & "|" & Temp(3) & "', UserLogins=UserLogins+1, LastLogin=" & SqlNowString & ", UserLastIP='" & ReqIp() & "' WHERE UserID=" & UserID)
' 设置用户缓存
Session(CacheName & "-UserID") = UserID ' 设置用户ID
Session(CacheName & "-UserInfo") = i ' 设置用户基本信息
' 重新加载用户权限
Call LoadUserInfo()
End If
End Function
' ============================================
' 更新Cookies有效期
' ============================================
Public Sub UpdateCookies(p_Time, p_Type)
Dim ExpiresTime
ExpiresTime = Request.Cookies(SystemSN)("ExpiresTime")
If Not IsDate(ExpiresTime) Then ExpiresTime = Date()
' 写入Cookies 如果登陆时间为0，或者从Cookies登陆则不更新Cookies有效期
If Not (p_Time = 0 Or p_Type = 1) Then
ExpiresTime = DateAdd("d", p_Time, Date())
ExpiresTime = DateAdd("d", p_Time, Date())
End If
' 如果是客人，则强制将Cookies有效期设置为一周
If UserID = 0 Or (p_Time = 0 And p_Type = 2) Then
ExpiresTime = DateAdd("d", 7, Date())
ExpiresTime = DateAdd("d", 7, Date())
End If
Response.Cookies(SystemSN).Domain = Replace(Replace(ReSearch("http://.+?/", BaseUrl, 1, ""), "http://", ""), "/", "") ' Cookies作用域
Response.Cookies(SystemSN).Path = ReFilter("/[^/]*$", Request.ServerVariables("SCRIPT_NAME"), 1, "/") ' Cookies路径 注意路径是区分大小写的
Response.Cookies(SystemSN).Expires = ExpiresTime
Response.Cookies(SystemSN)("ExpiresTime") = ExpiresTime
End Sub
' ============================================
' 清空站点Cookies
' ============================================
Public Sub ClearCookies()
Dim Item
For Each Item In Request.Cookies(SystemSN)
Response.Cookies(SystemSN)(Item) = Empty
Next
Call UpdateCookies(0, 2) ' 更新Cookies
End Sub
' ============================================
' 更新用户资料缓存(缓存用户名, 是否需要添加)[0=不添加,只作清理,1=需要添加]
' ============================================
Public Sub NeedUpdateList(UserName, Action)
Dim TempStr, TempUserName
Name = "iXsTemp_NeedToUpdate"
If ObjIsEmpty() Then Value = ""
TempStr = Value
TempUserName = "," & UserName & ","
TempStr = Replace(TempStr, TempUserName, ",")
TempStr = Replace(TempStr, ",,", ",")
IF Action = 1 Then
If IsONline(UserName, 0) Then
If TempStr = "" Then
TempStr = TempUserName
Else
TempStr = TempStr & TempUserName
End If
End If
End If
TempStr = Replace(TempStr, ",,", ",")
Value = TempStr
End Sub
' ============================================
' 检测用户缓存是否需要更新
' ============================================
Public Function IsNeedUpdate(UserName)
IsNeedUpdate = False
Name = "iXsTemp_NeedToUpdate"
If Not ObjIsEmpty() Then
If InStr("," & Value & ",", "," & UserName & ",") > 0 Then
IsNeedUpdate = True
Exit Function
End If
End If
End Function
' ============================================
' 根据用户指派并设定缓存
' ============================================
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)
If IsDeBug = 2 Then Response.Write("<strong style=""color:#0000FF;"">SetCahe：</strong><span style=""color:#0000FF;"">" & LocalCacheName & "</span>")
End Property
' ============================================
' 根据用户指派设定指定缓存的数值
' ============================================
Public Property Let Value(ByVal vNewValue)
If IsDeBug = 2 Then Response.Write(" → <strong style=""color:#006600;"">Write</strong>")
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -