📄 savepost.asp
字号:
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")
'更新最后发贴时间
cUserInfo(2) = Now
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='"&Clng(Dvbbs.UserToday(0))+1&"|"&Clng(Dvbbs.UserToday(1))&"|"&Clng(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='"&Clng(Dvbbs.UserToday(0))+1&"|"&Clng(Dvbbs.UserToday(1))&"|"&Clng(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
If Not Reuser Then
cUserInfo(8)=UserPost+1
cUserInfo(36)=Clng(Dvbbs.UserToday(0))+1 & "|" & Clng(Dvbbs.UserToday(1)) & "|" & Clng(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 + -