📄 savepost.asp
字号:
Public Sub UpDate_BoardInfoAndCache()
Dim UpdateBoardID
If Dvbbs.Board_Data(3,0)<> "" Then
UpdateBoardID=Dvbbs.Board_Data(3,0) & "," & Dvbbs.BoardID
Else
UpdateBoardID=Dvbbs.BoardID
End If
Dim updateboard,i
updateboard=Split(UpdateBoardID,",")
If Action = 6 Then
SQL="update Dv_board set PostNum=PostNum+1,todaynum=todaynum+1,LastPost='"&SimEncodeJS(LastPost_1)&"' where boardid in ("&UpdateBoardID&")"
ElseIf Action = 5 Or Action = 7 Then
SQL="update Dv_board set PostNum=PostNum+1,TopicNum=TopicNum+1,todaynum=todaynum+1,LastPost='"&SimEncodeJS(LastPost_1)&"' where boardid in ("&UpdateBoardID&")"
End If
Dvbbs.Execute(sql)
For i= 0 to UBound(updateboard)
Dvbbs.ReloadBoardCache updateboard(i),1,9,1'版面ID，发贴数，最后一个参数是1 表示相加
If Not Action = 6 Then Dvbbs.ReloadBoardCache updateboard(i),1,10,1'主题数
Dvbbs.ReloadBoardCache updateboard(i),1,12,1'今日贴
Dvbbs.ReloadBoardCache updateboard(i),LastPost_1,14,0
Next
End Sub
Public Sub UpDate_ForumInfoAndCache()
Dim updateinfo,LastPostTime
Dim Forum_LastPost,Forum_TodayNum,Forum_MaxPostNum
Forum_LastPost=Dvbbs.CacheData(15,0)
Forum_TodayNum=Dvbbs.CacheData(9,0)
Forum_MaxPostNum=Dvbbs.CacheData(12,0)
LastPostTimes=split(Forum_LastPost,"$")
LastPostTime=LastPostTimes(2)
If Not IsDate(LastPostTime) Then LastPostTime=Now()
If datediff("d",LastPostTime,Now())=0 Then
If CLng(Forum_TodayNum)+1 > CLng(Forum_MaxPostNum) Then
updateinfo=",Forum_MaxPostNum=Forum_TodayNum+1,Forum_MaxPostDate="&SqlNowString&""
Dvbbs.ReloadSetupCache Now(),13
Dvbbs.ReloadSetupCache CLng(Forum_TodayNum)+1,12
End If
Dvbbs.ReloadSetupCache CLng(Forum_TodayNum)+1,9
If Action = 6 Then
SQL="update Dv_setup set Forum_PostNum=Forum_PostNum+1,Forum_TodayNum=Forum_TodayNum+1,Forum_LastPost='"&LastPost&"' "&updateinfo&" "
Else
SQL="update Dv_setup set Forum_TopicNum=Forum_TopicNum+1,Forum_PostNum=Forum_PostNum+1,Forum_TodayNum=Forum_TodayNum+1,Forum_LastPost='"&LastPost&"' "&updateinfo&" "
End If
Else
If Action = 6 Then
SQL="update Dv_setup set Forum_PostNum=Forum_PostNum+1,forum_YesTerdayNum="&CLng(Forum_TodayNum)&",Forum_TodayNum=1,Forum_LastPost='"&LastPost&"' "
Else
SQL="update Dv_setup set Forum_TopicNum=Forum_TopicNum+1,Forum_PostNum=Forum_PostNum+1,forum_YesTerdayNum="&CLng(Forum_TodayNum)&",Forum_TodayNum=1,Forum_LastPost='"&LastPost&"' "
End If
Dvbbs.ReloadSetupCache 1,9
End If
'更新总固顶部分数据和缓存
If Not Action = 6 Then
If Myistop=2 Then
Dim tmpstr
If Dvbbs.CacheData(28,0)="" Then
tmpstr=", Forum_alltopnum='"&RootID&"'"
Dvbbs.ReloadSetupCache RootID,28
Else
tmpstr=", Forum_alltopnum='"&Dvbbs.CacheData(28,0)&","&RootID&"'"
Dvbbs.ReloadSetupCache Dvbbs.CacheData(28,0)&","&RootID,28
End If
SQL=SQl&tmpstr
End If
Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(7,0))+1,7'主题数
End If
Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(8,0))+1,8'文章数
Dvbbs.ReloadSetupCache LastPost,15
Dvbbs.Execute(SQL)
End Sub
Public Sub succeed()
Dim TempStr,PostRetrunName,tourl,returnurl
If IsAudit=1 And Action <> 8 Then Dvbbs.BoardID=LockTopic
Dvbbs.Stats = Dvbbs.Stats & template.Strings(20)
TempStr = template.html(8)
Select case Dvbbs.Board_Setting(17)
case "1"
tourl = "index.asp"
PostRetrunName=template.Strings(13)
case "2"
tourl="list.asp?boardid="&Dvbbs.boardid
PostRetrunName=template.Strings(14)
case "3"
If IsAudit=1 And Action <> 8 Then
tourl="list.asp?boardid="&Dvbbs.boardid
If IsAuditcheck=1 Then
PostRetrunName="由于您发表的贴子含敏感内容，您的贴子需要管理员审核过才可以见到。"
Else
PostRetrunName=template.Strings(19)
End If
Else
Select Case Action
Case 5
tourl="dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID
PostRetrunName=template.Strings(15)
Case 6
tourl="dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&"&star="&Star&"#"&Announceid
PostRetrunName=template.Strings(16)
Case 7
tourl="dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID
PostRetrunName=template.Strings(17)
Case 8
tourl="dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&"&star="&Star&"#"&RootID
PostRetrunName=template.Strings(18)
End Select
End If
End Select
returnurl="dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID
TempStr = Replace(TempStr,"{$tourl}",tourl)
TempStr = Replace(TempStr,"{$returnurl}",returnurl)
TempStr = Replace(TempStr,"{$stats}",Dvbbs.Stats)
TempStr = Replace(TempStr,"{$boardname}",Dvbbs.BoardType)
TempStr = Replace(TempStr,"{$boardid}",Dvbbs.BoardID)
TempStr = Replace(TempStr,"{$page}",page)
TempStr = Replace(TempStr,"{$PostRetrunName}",PostRetrunName)
Response.Write TempStr
End Sub
Private Function checktable(Table)
Table=Right(Trim(Table),2)
If Not IsNumeric(table) Then Table=Right(Trim(Table),1)
If Not IsNumeric(table) Then Dvbbs.AddErrCode(30)
checktable="Dv_bbs"&table
End Function
'检查提交来源
Public Sub CheckfromScript()
If Not Dvbbs.ChkPost() Or Not(IsArray(Session(Dvbbs.CacheName & "UserID"))) Then Dvbbs.AddErrCode(42):Dvbbs.Showerr()
If CStr(Request.Cookies("Dvbbs"))=CStr(Dvbbs.Boardid) Then Dvbbs.AddErrCode(30):Dvbbs.Showerr()
If (Not ChkUserLogin) And (Action = 5 Or Action = 6 Or Action = 7) Then Dvbbs.AddErrCode(12):Dvbbs.Showerr()
End Sub
'判断发贴时间间隔
Private Sub CheckpostTime()
If Dvbbs.Board_Setting(30)="1" Then
Dim mypostinfo
mypostinfo=Session(Dvbbs.CacheName & "UserID")
If DateDiff("s",mypostinfo(2),Now())<CLng(Dvbbs.Board_Setting(31)) Then
Response.redirect "showerr.asp?ErrCodes=<Br>"+"<li>本论坛限制发贴距离时间为"&Dvbbs.Board_Setting(31)&"秒，请稍后再发。&action=OtherErr"
End If
End If
End Sub
'检查用户身份
Public Function ChkUserLogin()
ChkUserLogin=False
'取得发贴用户名和密码
UserName=Dvbbs.Checkstr(Trim(Request.Form("username")))
'校验用户名和密码是否合法
'If UserName="" Or Dvbbs.strLength(userName)>Cint(Dvbbs.Forum_setting(41)) Or Dvbbs.strLength(userName) < Cint(Dvbbs.Forum_setting(40)) Then Dvbbs.AddErrCode(17)
If UserName="" Then Dvbbs.AddErrCode(17)
If Not IstrueName(UserName) Then Dvbbs.AddErrCode(18)
Dvbbs.ShowErr()
'检查用户是否当前用户
If Action = 8 Then
UserPassWord=Dvbbs.checkStr(Trim(Request.Cookies(Dvbbs.Forum_sn)("password")))
SQL = "Select JoinDate,UserID,UserPost,UserGroupID,userclass,lockuser,TruePassWord From [Dv_User] Where UserID="&Dvbbs.UserID
Else
If UserName<>Dvbbs.MemberName Then
Reuser=True
UserPassWord=Dvbbs.Checkstr(Trim(Request.Form("passwd")))
UserPassWord=md5(UserPassWord,16)
SQL = "Select JoinDate,UserID,UserPost,UserGroupID,userclass,lockuser,userpassword From [Dv_User] Where UserName='"&UserName&"' "
Else
UserPassWord=Dvbbs.checkStr(Trim(Request.Cookies(Dvbbs.Forum_sn)("password")))
SQL = "Select JoinDate,UserID,UserPost,UserGroupID,userclass,lockuser,TruePassWord From [Dv_User] Where UserID="&Dvbbs.UserID
End If
End If
If Len(UserPassWord)<>16 AND Len(UserPassWord)<>32 Then Dvbbs.AddErrCode(18)
Set Rs=Dvbbs.Execute(SQL)
If Not Rs.EOF Then
If Not (UserPassWord<>rs(6) Or rs(5)=1 or rs(3)=5) Then
ChkUserLogin=True
Dvbbs.UserID=Rs(1)
UserPost=Rs(2)
GroupID=Rs(3)
userclass=Rs(4)
Response.cookies("upNum")=0
Else
Dvbbs.EmptyCookies
Dvbbs.LetGuestSession()
End If
End If
Set Rs = Nothing
End Function
'更新用户积分，所需外部变量,UserPost,userid,（外加发贴回贴的积分设置数据）
Public Sub updatepostuser()
'投票，发贴，更新积分
Dim cUserInfo
cUserInfo = Session(Dvbbs.CacheName & "UserID")
If Action = 5 Or Action = 7 Then
Dvbbs.Execute("update [Dv_user] set UserLastIP='"&Dvbbs.usertrueip&"',UserPost=UserPost+1,UserTopic=UserTopic+1,userWealth=userWealth+"&Clng(Dvbbs.Forum_user(1))&",userEP=userEP+"&Clng(Dvbbs.Forum_user(6))&",userCP=userCP+"&Clng(Dvbbs.Forum_user(11))&",UserToday='"&Dvbbs.UserToday(0)+1&"|"&Dvbbs.UserToday(1)&"|"&Dvbbs.UserToday(2)&"' Where UserID="&Dvbbs.userID&"")
If Not Reuser Then
UserPost=UserPost+1
cUserInfo(21)=cUserInfo(21)+Clng(Dvbbs.Forum_user(1))
cUserInfo(22)=cUserInfo(22)+Clng(Dvbbs.Forum_user(6))
cUserInfo(23)=cUserInfo(23)+Clng(Dvbbs.Forum_user(11))
End If
ElseIf Action = 6 Then '回贴更新积分。
If Not Reuser Then
Dvbbs.Execute("update [Dv_user] set UserLastIP='"&Dvbbs.usertrueip&"',UserPost=UserPost+1,userWealth=userWealth+"&Clng(Dvbbs.Forum_user(2))&",userEP=userEP+"&Clng(Dvbbs.Forum_user(7))&",userCP=userCP+"&Clng(Dvbbs.Forum_user(12))&",UserToday='"&Dvbbs.UserToday(0)+1&"|"&Dvbbs.UserToday(1)&"|"&Dvbbs.UserToday(2)&"' Where UserID="&Dvbbs.userID&"")
UserPost=UserPost+1
cUserInfo(21)=cUserInfo(21)+Clng(Dvbbs.Forum_user(2))
cUserInfo(22)=cUserInfo(22)+Clng(Dvbbs.Forum_user(7))
cUserInfo(23)=cUserInfo(23)+Clng(Dvbbs.Forum_user(12))
Else
Dvbbs.Execute("update [Dv_user] set UserLastIP='"&Dvbbs.usertrueip&"',UserPost=UserPost+1,userWealth=userWealth+"&Clng(Dvbbs.Forum_user(2))&",userEP=userEP+"&Clng(Dvbbs.Forum_user(7))&",userCP=userCP+"&Clng(Dvbbs.Forum_user(12))&" Where UserID="&Dvbbs.userID&"")
End If
End If
'更新最后发贴时间
cUserInfo(2)=Now()
If Not Reuser Then
cUserInfo(8)=UserPost+1
cUserInfo(36)=Dvbbs.UserToday(0)+1 & "|" & Dvbbs.UserToday(1) & "|" & Dvbbs.UserToday(2)
End If
Session(Dvbbs.CacheName & "UserID") = cUserInfo
'发贴数字能整除十则更新用户等级。(Updategrade())
If UserPost mod 10 < 1 Then Updategrade()
End Sub
'更新用户等级，所需外部变量,UserPost,GroupID,userid
Public Sub Updategrade()
Dim titlepic
Dim cUserInfo,GroupID_Q
If Not Reuser Then cUserInfo = Session(Dvbbs.CacheName & "UserID")
'检查用户等级数据表中是否有匹配行
Set Rs=Dvbbs.Execute("select MinArticle,IsSetting,ParentGID from Dv_UserGroups where usertitle='"&userclass&"'")
If Rs.Eof Or Rs.BOF Then
Set Rs=Nothing:Set Rs=Dvbbs.Execute("select top 1 usertitle,GroupPic,UserGroupID,IsSetting,ParentGID from Dv_UserGroups where (ParentGID="&GroupID&" Or UserGroupID="&GroupID&") and Minarticle<="&UserPost&" and not Minarticle=-1 order by MinArticle desc")
If Not(Rs.EOF And Rs.BOF) Then
userclass=Rs(0)
titlepic=Rs(1)
If Rs(3)=1 Then
GroupID=Rs(2)
Else
GroupID=Rs(4)
End If
Set RS=Nothing
Else
Set Rs=Dvbbs.Execute("select top 1 usertitle,GroupPic,UserGroupID,IsSetting,ParentGID from Dv_UserGroups where UserGroupID="&GroupID&" and Minarticle=-1 order by UserGroupID")
If Not(Rs.EOF And Rs.BOF) Then
userclass=Rs(0)
titlepic=Rs(1)
If Rs(3)=1 Then
GroupID=Rs(2)
Else
GroupID=Rs(4)
End If
Set RS=Nothing
Else
Set RS=Nothing:Set Rs=Dvbbs.Execute("select top 1 GroupPic from Dv_UserGroups where ParentGID>0 And not Minarticle=-1 order by MinArticle")
titlepic=Rs(0)
Set RS=Dvbbs.Execute("select usertitle from Dv_UserGroups where UserGroupID="&GroupID)
userclass=Rs(0)
End If
End If
Else
If Rs(0)>-1 Then
'如果为自定义等级，则取其父类GroupID做升级依据
GroupID_Q=GroupID
If Rs(1)=1 And Rs(2)>0 Then GroupID_Q=Rs(2)
Set Rs=Nothing:Set Rs=Dvbbs.Execute("select top 1 usertitle,GroupPic,UserGroupID,IsSetting,ParentGID from Dv_UserGroups where ParentGID="&GroupID_Q&" and Minarticle<="&UserPost&" and not MinArticle=-1 order by MinArticle desc,UserGroupID")
If Not (Rs.EOF And Rs.BOF) Then
userclass=Rs(0)
titlepic=Rs(1)
If Rs(3)=1 Then
GroupID=Rs(2)
Else
GroupID=Rs(4)
End If
Set Rs=Nothing
Else
Set Rs=Nothing
Set Rs=Dvbbs.Execute("select top 1 GroupPic from Dv_UserGroups where ParentGID>0 And not Minarticle=-1 order by MinArticle")
titlepic=Rs(0)
Set Rs=Nothing
Set Rs=Dvbbs.Execute("select usertitle from Dv_UserGroups where UserGroupID="&GroupID)
userclass=Rs(0)
Set Rs=Nothing
End If
Else
Set Rs=Dvbbs.Execute("select usertitle,GroupPic,UserGroupID,IsSetting,ParentGID from Dv_UserGroups where usertitle='"&userclass&"'")
If Not (Rs.EOF And Rs.BOF) Then
userclass=Rs(0)
titlepic=Rs(1)
If Rs(3)=1 Then
GroupID=Rs(2)
Else
GroupID=Rs(4)
End If
End If
Set Rs=Nothing
End If
End If
Dvbbs.Execute("update [Dv_User] set userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&" where userid="&dvbbs.UserID)
If Not Reuser Then
cUserInfo(18)=userclass
cUserInfo(19)=GroupID
Session(Dvbbs.CacheName & "UserID") = cUserInfo
End If
End Sub
End Class
'截取指定字符
Function cutStr(str,strlen)
'去掉所有HTML标记
Dim re
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="<(.[^>]*)>"
str=re.Replace(str,"")
set re=Nothing
Dim l,t,c,i
l=Len(str)
t=0
For i=1 to l
c=Abs(Asc(Mid(str,i,1)))
If c>255 Then
t=t+2
Else
t=t+1
End If
If t>=strlen Then
cutStr=left(str,i)&"..."
Exit For
Else
cutStr=str
End If
Next
cutStr=Replace(cutStr,chr(10),"")
cutStr=Replace(cutStr,chr(13),"")
End Function
'过滤不必要UBB
Function reUBBCode(strContent)
Dim re
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
strContent=Replace(strContent," "," ")
re.Pattern="(\[QUOTE\])(.|\n)*(\[\/QUOTE\])"
strContent=re.Replace(strContent,"")
re.Pattern="(\[point=*([0-9]*)\])(.|\n)*(\[\/point\])"
strContent=re.Replace(strContent," ")
re.Pattern="(\[post=*([0-9]*)\])(.|\n)*(\[\/post\])"
strContent=re.Replace(strContent," ")
re.Pattern="(\[power=*([0-9]*)\])(.|\n)*(\[\/power\])"
strContent=re.Replace(strContent," ")
re.Pattern="(\[usercp=*([0-9]*)\])(.|\n)*(\[\/usercp\])"
strContent=re.Replace(strContent," ")
re.Pattern="(\[money=*([0-9]*)\])(.|\n)*(\[\/money\])"
strContent=re.Replace(strContent," ")
re.Pattern="(\[replyview\])(.|\n)*(\[\/replyview\])"
strContent=re.Replace(strContent," ")
re.Pattern="(\[usemoney=*([0-9]*)\])(.|\n)*(\[\/usemoney\])"
strContent=re.Replace(strContent," ")
strContent=Replace(strContent,"<I></I>","")
set re=Nothing
reUBBCode=strContent
End Function
'通用函数
Function IstrueName(uName)
IstrueName=False
If InStr(uName,"=")>0 Then Exit Function
If InStr(uName,"%")>0 Then Exit Function
If InStr(uName,Chr(32))>0 Then Exit Function
If InStr(uName,"?")>0 Then Exit Function
If InStr(uName,"&")>0 Then Exit Function
If InStr(uName,";")>0 Then Exit Function
If InStr(uName,",")>0 Then Exit Function
If InStr(uName,"'")>0 Then Exit Function
If InStr(uName,Chr(34))>0 Then Exit Function
If InStr(uName,chr(9))>0 Then Exit Function
If InStr(uName,"⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -