📄 cls.user.asp
字号:
uStr = WRMPS.GetReplace(uStr,"{$UserClassNum}",uRs(22))
uStr = WRMPS.GetReplace(uStr,"{$UserArticleNum}",uRs(23))
uStr = WRMPS.GetReplace(uStr,"{$UserCompanyNum}",uRs(28))
uStr = WRMPS.GetReplace(uStr,"{$GroupName}",uRs(29))
uStr = WRMPS.GetReplace(uStr,"{$UserCompanyReNum}",uRs(17))
uStr = WRMPS.GetReplace(uStr,"{$UserCouponNum}",uRs(30))
uFaith = uRs(24)
uStr = WRMPS.GetReplace(uStr,"{$UserFaith}",uFaith)
If uRs(25) > 0 Then
uStr = WRMPS.GetReplace(uStr,"{$UserCoUrl}",WRMPS.GetCompanyUrl(uRs(25)))
uStr = WRMPS.GetReplace(uStr,"{$UserIsCompany}","<a href="&WRMPS.GetCompanyUrl(uRs(25))&" target=_blank title='此会员已注册店铺'><img src='"&WR_Setting(3)&"Skins/"&WR_Setting(5)&"/Company.gif' border=0 align=absmiddle></a>")
Else
uStr = WRMPS.GetReplace(uStr,"{$UserCoUrl}","")
uStr = WRMPS.GetReplace(uStr,"{$UserIsCompany}","")
End If
uStr = WRMPS.GetReplace(uStr,"{$UserEmailRz}",replace(Replace(uRs(26),0,""),1,"<img src='"&WR_Setting(3)&"Skins/"&WR_Setting(5)&"/Email.gif' border=0 align=absmiddle alt='此会员已通过邮箱认证'>"))
uStr = WRMPS.GetReplace(uStr,"{$UserIDRz}",replace(Replace(uRs(27),0,""),1,"<img src='"&WR_Setting(3)&"Skins/"&WR_Setting(5)&"/ID.gif' border=0 align=absmiddle alt='此会员已通过实名认证'>"))
uStr = WRMPS.GetReplace(uStr,"{$UserSpaceUrl}",WRMPS.GetSpaceUrl(0,uUser))
uStr = WRMPS.GetReplace(uStr,"{$U_SpaceUrl}",WRMPS.GetSpaceUrl(1,uUser))
uUserFaith = Split(W_UserFaith,"§")
For ui = 0 To Ubound(uUserFaith)
If uUserFaith(ui) <> "" Then
If uFaith < 0 Then
uFaithPic = Split(uUserFaith(0),"|")(2)
Else
If uFaith >= Int(Split(uUserFaith(ui),"|")(1)) Then uFaithPic = Split(uUserFaith(ui),"|")(2)
End If
End If
Next
uStr = WRMPS.GetReplace(uStr,"{$UserFaithPic}","<Img Src='"&WR_Setting(3)&"Images/Star/"&uFaithPic&"' alt='信用值："&uFaith&"' border=0 align=absmiddle>")
uGroupID = uRs(16)
Else
Exit Function
End If
uRs.Close
uStr = WRMPS.GetReplace(uStr,"{$User}",uUser)
uStr = WRMPS.GetReplace(uStr,"{$PassWord}","********")
Set uRs = Nothing
TempUser = uStr
uStr = Empty
End Function
'用户登出
Sub Logout()
If Int(WR_Area(2)) > 0 Then Response.Cookies(CacheName&"Member").Domain = WR_Setting(1)
Response.Cookies(CacheName&"Member")("UserName") = Empty
Response.Cookies(CacheName&"Member")("ID") = Empty
Response.Cookies(CacheName&"Member")("GroupID") = Empty
Response.Cookies(CacheName&"Member")("Flag") = Empty
Response.Cookies(CacheName&"Member")("FlagTime") = Empty
Response.Cookies(CacheName&"Member")("PassWord") = Empty
Response.Cookies(CacheName&"Member")("Cookie") = Empty
Response.Cookies(CacheName&"Member")("Agent") = Empty
WRMPS.DelCookies "UserAtt"
WRMPS.DelCookies "QianFeiMsg"
End Sub
'用户登录
Sub Login(uCookie,uUserName,uID,uGroupID,uFlag,uFlagTime,uPassWord)
If Int(WR_Area(2)) > 0 Then Response.Cookies(CacheName&"Member").Domain = WR_Setting(1)
If IsNull(uCookie) or IsNumeric(uCookie) = False Then uCookie = 0
Select Case Int(uCookie)
Case 1
Response.Cookies(CacheName&"Member").Expires=Date+7
Case 2
Response.Cookies(CacheName&"Member").Expires=Date+30
Case 3
Response.Cookies(CacheName&"Member").Expires=Date+365
End Select
Response.Cookies(CacheName&"Member")("UserName") = uUserName
Response.Cookies(CacheName&"Member")("ID") = uID
Response.Cookies(CacheName&"Member")("GroupID") = uGroupID
Response.Cookies(CacheName&"Member")("Flag") = uFlag
Response.Cookies(CacheName&"Member")("FlagTime") = uFlagTime
Response.Cookies(CacheName&"Member")("PassWord") = uPassWord
Response.Cookies(CacheName&"Member")("Cookie") = uCookie
Response.Cookies(CacheName&"Member")("Agent") = Agent()
WRMPS.SCookies "MemberCache",uUserName,365
End Sub
'用户IP注册时间限制
Function RegIPTime()
If Int(WR_User(5)) > 0 Then
Set uRs = server.createobject("adodb.recordset")
uRs.Open"Select WM_RegTime From WM_Member Where WM_RegIP='"&Request.ServerVariables("Remote_Addr")&"' Order By WM_ID Desc",Conn,1,1
If Not uRs.Eof Then
If DateDiff("n",CDate(uRs(0)),Now()) < Int(WR_User(5)) Then RegIPTime = True
Else
RegIPTime = False
End If
uRs.Close
Set uRs = Nothing
Else
RegIPTime = False
End If
End Function
'判断用户名是否禁用
Function RegUserName(uUserName)
Dim NoReg
NoReg=Split(WR_User(8),vbCrLf)
RegUserName = False
For ui=0 To Ubound(NoReg)
If NoReg(ui) <> "" Then If uUserName = Trim(NoReg(ui)) Then RegUserName = True
Next
End Function
'会员注册写入数据库
Function RegSave(u_UserName,u_PassWord,u_Email,u_Question,u_Answer,u_Status,u_TrueName,u_Sex,u_QQ,u_AddRess,u_Web)
'获取默认会员组的默认信息
Dim uIntegral,uCountOut,uGroupFlag
RegSave = ""
Set uRs = server.createobject("adodb.recordset")
uRs.Open"Select WM_GroupFlag From WM_UserGroup where WM_ID=2",Conn,1,1
If Not uRs.EOF Then
uGroupFlag = uRs(0)
End If
uRs.CLose
If u_Answer <> "" And IsNUll(u_Answer) = False Then u_Answer = MD5(2,u_Answer)
uRs.Open "Select WM_UserName,WM_PassWord,WM_Email,WM_RegTime,WM_RegIP,WM_LastLoginTime,WM_LastIP,WM_LoginNum,WM_Integral,WM_CountOut,WM_Key,WM_Question,WM_Answer,WM_Money,WM_GroupID,WM_Flag,WM_NowLoginTime,WM_NowIP,WM_Face,WM_AreaID,WM_ComID,WM_ClassNum,WM_ArticleNum,WM_RZEmail,WM_RZID,WM_Faith,WM_TrueName,WM_Sex,WM_QQ,WM_AddRess,WM_Web,WM_CompanyNum,WM_CompanyReNum,WM_Message,WM_LastConsumeTime,WM_Agent,WM_CouponNum From WM_Member Where WM_UserName = '"&u_UserName&"' Or WM_Email = '"&u_Email&"'",Conn,1,3
If Not uRs.Eof Then
RegSave = "·此用户名或邮箱已经存在，请重新注册":uRs.CLose:Set uRs = Nothing:Exit Function
Else
uRs.AddNew
uRs(0) = u_UserName
uRs(1) = MD5(2,u_PassWord)
uRs(2) = u_Email
uRs(3) = Now()
uRs(4) = Request.ServerVariables("Remote_Addr")
uRs(5) = Now()
uRs(6) = Request.ServerVariables("Remote_Addr")
uRs(7) = 1
uRs(8) = 0
uRs(9) = 0
uRs(10) = u_Status
uRs(11) = u_Question
uRs(12) = u_Answer
uRs(13) = 0
uRs(14) = 2
uRs(15) = uGroupFlag
uRs(16) = Now()
uRs(17) = Request.ServerVariables("Remote_Addr")
uRs(18) = "Images/Face/Image0.gif"
uRs(19) = 0
uRs(20) = 0
uRs(21) = 0
uRs(22) = 0
uRs(23) = 0
uRs(24) = 0
uRs(25) = 0
uRs(26) = u_TrueName
uRs(27) = u_Sex
uRs(28) = u_QQ
uRs(29) = u_AddRess
uRs(30) = u_Web
uRs(31) = 0
uRs(32) = 0
uRs(33) = "0|0"
uRs(34) = Now()
uRs(35) = 0
uRs(36) = 0
uRs.Update
End If
uRs.Close
Set uRs = Nothing
uIntegral = Int(Split(Split(uGroupFlag,"§")(0),"|")(0))
uCountOut = Int(Split(Split(uGroupFlag,"§")(0),"|")(1))
Call WRDB.SaveConsume(1,u_UserName,0,uCountOut,uIntegral,0,"注册新会员")
If u_Status > 0 Then
Conn.Execute("Update WM_Config Set WM_UserNum = WM_UserNum + 1,WM_NewUser='"&u_UserName&"'")
Call WRMPS.SCache("UserNum",WRMPS.GetCache("UserNum") + 1)
Call WRMPS.SCache("NewUser",u_UserName)
End If
If (WR_Mail(5) <> "NO" And Int(WR_User(1)) > 0) Or Int(WR_Mail(17)) > 0 Then
MailBody = WR_Mail(6)
MailBody = Replace(MailBody,"{$User}",u_UserName)
MailBody = Replace(MailBody,"{$Pass}",u_PassWord)
Subject = "恭喜您注册成为"&WR_Setting(0)&"的会员！"
If WR_Mail(5) <> "NO" And Int(WR_User(1)) > 0 Then Call WRMPS.SendMail(WRTemp.SiteLabel(MailBody&vbCrLf&vbCrLf&WR_Mail(4)),WRTemp.SiteLabel(WR_Setting(0)),WRTemp.SiteLabel(Subject),u_Email)
If Int(WR_Mail(17)) > 0 Then
Call WRDB.SendMessage(u_UserName,Null,Subject,WRTemp.SiteLabel(MailBody))
End If
End If
End Function
'检测会员邮箱、身份证是否认证
'True 表是已通过认证
Function ChkRZEdit(u_UserName,u_Str)
If u_UserName = "" Then Exit Function
ChkRZEdit = False
Set uRs = Conn.Execute("Select Top 1 WM_RZEmail,WM_RZID From WM_Member Where WM_UserName='"&u_UserName&"'")
If Not uRs.Eof Then
Select Case UCase(u_Str)
Case "EMAIL"
If uRs(0) = 1 Then ChkRZEdit = True
Case "TRUENAME"
If uRs(1) = 1 Then ChkRZEdit = True
End Select
End If
uRs.Close
Set uRs = Nothing
End Function
End Class
Set WRUser = New Cls_User
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -