|
”，您所跟踪的用户 "&Dvbbs.Membername&" 于 "&Now()&" 登录了论坛，请您及时和该用户取得联系，感谢您采用我们的服务。'''',"&SqlNowString&",0,1)")
Set Rs=Execute("Select top 1 id,sender From Dv_Message Where incept =''''"& ToolsFollowUserID(i) &"''''")
Tools_inceptid=Rs(0) &"||"& Rs(1)
Set Rs=Execute("Select Count(id) From Dv_Message Where Flag=0 and issend=1 and delR=0 And incept=''''"& ToolsFollowUserID(i) &"''''")
Tools_newincept = Rs(0)
Set Rs=Nothing
If IsNull(Tools_newincept) Then Tools_newincept=0
Tools_msginfo=Tools_newincept & "||" & Tools_inceptid
Execute("update [dv_user] set UserMsg=''''"&CheckStr(Tools_msginfo)&"'''' where username=''''"&ToolsFollowUserID(i)&"''''")
End If
Next
MyUserInfo(39) = ""
Execute("UpDate Dv_User Set FollowMsgID='''''''' Where UserID="&UserID)
End If
FoundUser=True
MyUserInfo(15)=Lastlogin
''''用户头像处理
Dim iUserMagicFace
iUserMagicFace = Split(MyUserInfo(11),"|")
If Ubound(iUserMagicFace) = 1 Then MyUserInfo(11) = iUserMagicFace(1)
Session(CacheName & "UserID")=MyUserInfo
End Sub
Public Sub EmptyCookies()
Response.Cookies(Forum_sn)("usercookies") = 0
Response.Cookies(Forum_sn).path=cookiepath
Response.Cookies(Forum_sn)("username") = ""
Response.Cookies(Forum_sn)("UserID") = 0
Response.Cookies(Forum_sn)("userclass") = ""
Response.Cookies(Forum_sn)("userhidden") = 2
Response.Cookies(Forum_sn)("password") = ""
End Sub
Private Sub GetGroupSetting()
Dim tGroupSetting
Name = "GroupSetting_" & UserGroupID
tGroupSetting = Split(value,"§§§")
GroupSetting = Split(tGroupSetting(0),",")
UserGroupParent = Cint(tGroupSetting(1))
UserGroupParentID = Split(tGroupSetting(2),"|")
IsUserPermissionAll = MyUserInfo(Ubound(MyUserInfo)-3)
If Cint(GroupSetting(0))=0 And Not Page_Admin Then AddErrCode "8":Showerr()
If BoardID > 0 And Not ScriptName="showerr.asp" Then BoardInfoData=CheckBoardInfo()
If UserID > 0 And BoardID=0 Then
If IsUserPermissionAll="1" Then LoadUserPermission_All()
End If
End Sub
''''输出缓存用户组GroupSetting(58)设置 （用户名在帖子内容中显示标记） 组ID,姓名代码|||
Public Function GroupSetting_UserName()
Name="GroupSetting_UserName"
GroupSetting_UserName = value
End Function
''''用户是否存在论坛全局自定义权限
Public Function FoundUserPermission_All()
Dim PerRs
FoundUserPermission_All = 0
Set PerRs=Execute("Select Uc_Setting From Dv_UserAccess Where Uc_Boardid=0 And uc_UserID="&UserID)
If Not (PerRs.Eof And PerRs.Bof) Then FoundUserPermission_All = 1
PerRs.Close:Set PerRs=Nothing
End Function
Public Sub LoadUserPermission_All()
Dim Rs
Set Rs=Dvbbs.execute("Select Uc_Setting From Dv_UserAccess Where Uc_Boardid=0 And uc_UserID="&UserID)
If Not(Rs.Eof And Rs.Bof) Then
UserPermission=Split(Rs(0),",")
GroupSetting = Split(Rs(0),",")
FoundUserPer=True
End If
Set Rs=Nothing
End Sub Public Sub ActiveOnline()
Dim ReflashPageLastTime,LastVisiBoardID
ReflashPageLastTime = Session(CacheName & "UserID")(1)
LastVisiBoardID = Clng(Session(CacheName & "UserID")(3))
If Not IsDate(ReflashPageLastTime) Then ReflashPageLastTime = Now()
''''当在120秒内刷新同一个页面则不更新online数据
If DateDiff("s",ReflashPageLastTime,Now()) < 120 And LastVisiBoardID = BoardID And Not InStr(ScriptName,"showerr")>0 Then Exit Sub
''''更新数组
ReflashPageLastTime = Session(CacheName & "UserID")
ReflashPageLastTime(1) = Now()
ReflashPageLastTime(3) = Dvbbs.BoardID
Session(CacheName & "UserID") = ReflashPageLastTime
UserActiveOnline
End Sub
Private Sub UserActiveOnline()
Dim Actcome,SQl,Rs
Dim uip,StatsStr
uip = UserTrueIP
StatsStr = Stats
StatsStr = Replace(StatsStr, "''''", "")
StatsStr = Replace(StatsStr, Chr(0), "")
StatsStr = Replace(StatsStr, "--", "——")
StatsStr = Left(StatsStr, 250)
If UserID = 0 Then
Dim StatUserID
StatUserID = Session(CacheName & "UserID")(0)
SQL = "Select ID,Boardid From [Dv_Online] Where ID = " & Ccur(StatUserID)
Set Rs = Execute(SQL)
If Rs.Eof And Rs.Bof Then
If CInt(Forum_Setting(36)) = 0 Then
Actcome = ""
Else
Actcome = address(uip)
End If
GetBrowser()
''''不记录搜索引擎的客人 2004-8-30 Dv.Yz
If IsSearch Or (Browser="unknown" And Version="unknown" And Platform="unknown") Then
Exit Sub
End If
SQL = "Insert Into [Dv_Online](ID,Username,Userclass,Ip,Startime,Lastimebk,Boardid,Browser,Stats,Usergroupid,Actcome,Userhidden) Values (" & StatUserID & ",''''客人'''',''''客人'''',''''" & UserTrueIP & "''''," & SqlNowString & "," & SqlNowString & "," & Boardid & ",''''" & platform&"|"&Browser&version & "'''',''''" & StatsStr & "'''',7,''''" & Actcome & "''''," & Userhidden & ")"
''''更新缓存总在线数据
MyBoardOnline.Forum_Online=MyBoardOnline.Forum_Online+1
Name="Forum_Online"
value=MyBoardOnline.Forum_Online
Else
SQL = "Update [Dv_Online] Set Lastimebk = " & SqlNowString & ",Boardid = " & Boardid & ",Stats = ''''" & StatsStr & "'''' Where ID = " & Ccur(StatUserID)
End If
Rs.Close
Set Rs = Nothing
Execute(SQL)
Else
SQL = "Select ID,Boardid From [DV_Online] Where UserID = " & UserID
Set Rs = Execute(SQL)
If Rs.Eof And Rs.Bof Then
If CInt(forum_setting(36)) = 0 Then
Actcome = ""
Else
Actcome = address(uip)
End If
GetBrowser
SQL = "Insert Into [Dv_Online](ID,Username,Userclass,Ip,Startime,Lastimebk,Boardid,Browser,Stats,Usergroupid,Actcome,Userhidden,UserID) Values (" & Session.SessionID & ",''''" & Membername & "'''',''''" & Memberclass & "'''',''''" & UserTrueIP & "''''," & SqlNowString & "," & SqlNowString & "," & Boardid & ",''''" & platform&"|"&Browser&version & "'''',''''" & StatsStr & "''''," & UserGroupID & ",''''" & Actcome & "''''," & Userhidden & "," & UserID & ")"
''''更新缓存总在线数据
MyBoardOnline.Forum_Online=MyBoardOnline.Forum_Online+1
Name="Forum_Online"
Dvbbs.value=MyBoardOnline.Forum_Online
''''更新缓存总用户在线数据
MyBoardOnline.Forum_UserOnline=MyBoardOnline.Forum_UserOnline+1
Name="Forum_UserOnline"
value=MyBoardOnline.Forum_UserOn 上一页 [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] ... 下一页 >>
[Web开发]指定资源下载失败msxml3.dll 错误 800c0008的解决… [Web开发]"ActiveX部件不能创建对象"错误如何解决？
[办公软件]Office程序常见错误及解决方案 [办公软件]Excel如何避免出现错误信息的提示
[办公软件]Excel常见错误信息以及解决方法 [Sql Server]Win2003中安装Sql2000出现日志错误的解决办法
[Web开发]asp.net自定义错误处理及错误显示页！ [Web开发]分析器错误信息:无法识别的配置节“connectionStr…
[Web开发](“/”应用程序中的服务器错误)ASP.NET程序上传到… [Web开发]authentication mode=Windows/之“/”应用程序中的…
|
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
