📄 class_sys.asp
字号:
'sType:1-邀请码
Public Function CheckOBCode(sCode, sType)
Dim i, iAsc, rst,Sql
sCode = UCase(Trim(sCode))
CheckOBCode = False
If Len(sCode)<>32 Then Exit FUnction
For i = 1 To Len(sCode)
iAsc = Asc(Mid(sCode, i, 1))
'48~57,65~90
If iAsc < 48 Or (iAsc > 57 And iAsc < 65) Or iAsc > 90 Then Exit Function
Next
If sType<>"" Then sType = CInt(sType)
Sql="select iState From oblog_obcodes Where iState=0 And obcode='" & LCase(sCode) & "' "
Sql =Sql & " "
Set rst = Execute("select iState From oblog_obcodes Where iState=0 And obcode='" & LCase(sCode) & "' And iType=" & sType)
If Not rst.EOF Then
CheckOBCode = True
End If
rst.Close
Set rst = Nothing
End Function
'检测用户发贴的许可
Public Function CheckPostAccess()
Dim rst,sql
CheckPostAccess=""
'首先进行新用户注册检验
If CacheConfig(19)>0 Then
If Int(datediff("n",l_uAddtime,Now))<Int(CacheConfig(19)) Then
CheckPostAccess="系统设定您在注册后 " & CacheConfig(19) & " 分钟后才可以发布日志或者相册"
Exit Function
End If
End If
'检查每天最大的发帖数目
If l_Group(10,0)<=0 Or l_Group(10,0)="" Then
CheckPostAccess=""
Else
'此处也可加一个字段标记，本日该用户发布了多少篇日志
sql = "select Count(logid) From oblog_log Where userid=" & l_uid & " And "
If Is_Sqldata = 0 Then
sql = sql & " Datediff('h',truetime,Now())<=24"
Else
sql = sql & " truetime BETWEEN DATEADD(Hour,-24,GETDATE()) AND GETDATE()"
End if
Set rst=Execute(sql)
If rst(0)<l_Group(10,0) Then
CheckPostAccess=""
Else
CheckPostAccess="您目前所属的组限制您24小时内只允许发布 " & l_Group(10,0) & " 篇日志<br/>您目前已经达到了该限额"
End If
Set rst=Nothing
End If
End Function
'积分检查
Public Function CheckScore(iScore)
Dim rst
CheckScore = False
If iScore >= 0 Then CheckScore = True: Exit Function
Set rst = Execute("select scores From oblog_user Where userid=" & l_uId)
If rst.EOF Then
Set rst = Nothing
Exit Function
Else
If rst(0) + iScore > 0 Then
CheckScore = True
End If
End If
Set rst = Nothing
End Function
'给分,删分
Public Function GiveScore(blogid, Score ,userid)
Dim uid
If userid<>"" Then
uid = CLng(userid)
Else
uid = l_uId
End if
Score=Int(Score)
Execute ("Update oblog_user Set scores=scores+" & Score & " Where userid=" & uid)
If Score<0 Then Execute ("Update oblog_user Set scores=0 Where userid=" & uid & " And scores<0")
If blogid <> "" Then
Execute ("Update oblog_log Set scores=scores+" & Score & " Where logid=" & Int(blogid) & "' And userid=" & uid)
End If
End Function
'-------------------------------------------------------
'内容保护模块!
'-------------------------------------------------------
'接管所有安全防护/内容过滤
'内容类过滤,整合安全性过滤
'关键字已经被分割成数组
'此处的Content为返回参数
Function CheckContent(byval Content, byval sType)
Dim i,iCount,iLen,sKeep
iCount=0
Content=LCase(Content)
'顶级过滤,直接封杀,系统对该用户进行计数,达到一定数目后,将该用户封禁
For i=0 to Ubound(oblog.Keywords1)
If Instr(Content,LCase(oblog.Keywords1(i)))>0 Then
' CheckContent=1 & "," & oblog.Keywords1(i)
CheckContent=1
Exit Function
End If
Next
'次级过滤,提示审核
For i=0 to Ubound(oblog.Keywords2)
If Instr(Content,LCase(oblog.Keywords2(i)))>0 Then
iCount=iCount+1
sKeep= sKeep & "," & oblog.Keywords2(i)
'If iCount>oblog.Setup(21) Then
' '此处借用了一个,
' CheckContent="2"& sKeep
CheckContent=2
Exit Function
'End If
End If
Next
'如果通过了第二次审核，则进入下一环节
'一般过滤,全局字符替换
For i=0 to Ubound(oblog.Keywords3)
'如果是注册时存在，则直接跳出
If sType="1" Then
If Instr(Content,LCase(oblog.Keywords3(i)))>0 Then
CheckContent=3
Exit Function
End If
Else
'如果是内容检测，则直接替换，不必执行查找过程
Content=Replace(Content,oblog.Keywords3(i),"xxxx")
CheckContent=3
End If
Next
If CheckContent<>3 Then CheckContent=0
End Function
'注册时重复的用户名
'注册禁止使用的用户名
Function chk_regname(sUserName)
Dim i
chk_regname=0
sUserName=Lcase(sUserName)
'用户名不能为非英文字符
If CacheConfig(6) <> "1" Then
If chkDomain(sUserName)=false Then
chk_regname=1
Exit Function
End If
End if
'用户名不能为系统禁止的关键字/审核字/过滤字
If CheckContent(sUserName,1)<>0 Then
chk_regname=2
Exit Function
End If
'处理单独的注册关键字
For i=0 to Ubound(oblog.Keywords4)
If Trim (oblog.Keywords4(i))<>"" Then
If Instr(sUserName,LCase(oblog.Keywords4(i)))>0 Then
chk_regname=3
Exit Function
End If
End if
Next
'如果不允许数字ID
If en_nameisnum=0 Then
If IsNumeric(sUserName) Then
chk_regname=4
Exit Function
End if
End if
chk_regname=0
End Function
'进行IP控制
Public Function ChkIpLock()
If oblog.CheckAdmin(0) Then ChkIpLock = False :Exit Function
Dim IPlock,i, sUserIP, sIP,BalckList,WhiteList,iCheck
IPlock = False
WhiteList = Application(Cache_Name & "_WhiteIp")
BalckList = Application(Cache_Name & "_BlackIp")
'如果无黑名单,则直接跳出
If UBound(BalckList) < 0 Then
ChkIpLock=False
Exit Function
End if
'获取用户IP
sUserIP = oblog.UserIp
If sUserIP = "" Then Exit Function
sUserIP = Split(UserIp, ".")
If UBound(sUserIP) <> 3 Then Exit Function
'检测白名单,白名单支持XXX.*.*.*,如果位于白名单内直接跳出检测流程
For i = 0 To UBound(WhiteList)
If WhiteList(i) <> "" Then
sIP = Split(WhiteList(i), ".")
If UBound(sIP) <> 3 Then Exit For
IPlock = false
If sUserIP(0) = sIP(0) Then
If sUserIP(1) = sIP(1) Or sIP(1)= "*" Then
If sUserIP(2) = sIP(2) Or sIP(2)= "*" Then
If sUserIP(3) = sIP(3) Or sIP(3)="*" Then
ChkIpLock=false
Exit Function
End If
End If
End If
End If
End If
Next
'检测黑名单
For i = 0 To UBound(BalckList)
If BalckList(i) <> "" Then
sIP = Split(BalckList(i), ".")
If UBound(sIP) = 3 Then
IPlock = True
If (sUserIP(0) <> sIP(0)) And InStr(sIP(0), "*") = 0 Then IPlock = False
If (sUserIP(1) <> sIP(1)) And InStr(sIP(1), "*") = 0 Then IPlock = False
If (sUserIP(2) <> sIP(2)) And InStr(sIP(2), "*") = 0 Then IPlock = False
If (sUserIP(3) <> sIP(3)) And InStr(sIP(3), "*") = 0 Then IPlock = False
If IPlock Then Exit For
End If
End If
Next
ChkIpLock = IPlock
End Function
'进行白名单控制
Public Function ChkWhiteIP(ByVal sUserIP)
If oblog.CheckAdmin(0) Then ChkWhiteIP = True :Exit Function
Dim IPlock,i, sIP,BalckList,WhiteList,iCheck
ChkWhiteIP = False
WhiteList = Application(Cache_Name & "_WhiteIp")
'如果无黑名单,则直接跳出
If UBound(WhiteList) < 0 Then
Exit Function
End if
'获取用户IP
sUserIP = oblog.UserIp
If sUserIP = "" Then Exit Function
sUserIP = Split(UserIp, ".")
If UBound(sUserIP) <> 3 Then Exit Function
'检测白名单,白名单支持XXX.*.*.*,如果位于白名单内直接跳出检测流程
For i = 0 To UBound(WhiteList)
If WhiteList(i) <> "" Then
sIP = Split(WhiteList(i), ".")
If UBound(sIP) <> 3 Then Exit For
IPlock = false
If sUserIP(0) = sIP(0) Then
If sUserIP(1) = sIP(1) Or sIP(1)= "*" Then
If sUserIP(2) = sIP(2) Or sIP(2)= "*" Then
If sUserIP(3) = sIP(3) Or sIP(3)="*" Then
ChkWhiteIP=True
Exit Function
End If
End If
End If
End If
End If
Next
End Function
'进行脚本过滤
Function CheckScript(Content)
Dim oRegExp,oMatch,spamCount
Set oRegExp = New Regexp
oRegExp.IgnoreCase = True
oRegExp.Global = True
oRegExp.pattern ="<script.+?/script>"
Content=oRegExp.replace(Content,"")
Set oRegExp=Nothing
End Function
'进行多媒体对象检测
'提取媒体文件,清理播放器
Function CheckMedia(Content)
Dim oRegExp,oRegExp1,oMatch,Matches,oMatch1,Matches1
Dim sFiles1,sFiles2,sFile
sFiles="swf,mp3,rm,ram,rmvb,mp4,wma,wav,avi"
Set oRegExp = New Regexp
oRegExp.IgnoreCase = True
oRegExp.Global = True
Set oRegExp1 = New Regexp
oRegExp1.IgnoreCase = True
oRegExp1.Global = True
'媒体文件
oRegExp.pattern ="<object.+?>"
Set Matches=oRegExp.Execute(Content)
For Each oMatch In Matches
oRegExp1.pattern="http://([\w-]+\.)+[\w-]+(/[\w- ./?%&=]*)?"
Set Matches1=oRegExp.Execute(oMatch.Value)
For Each oMathch1 In Matches1
'只取媒体文件
sFile=Split(oMathch1.value,".")
If InStr(sFiles1,sFile(UBound(sFile)))>0 Then
strFiles2="<a href=""" & oMathch1.value & """ target=""_blank"">" & oMathch1.value & "</a><br>"
End If
Next
Next
'清空
oRegExp.pattern ="<object.+?/object>"
Content=oRegExp1.replace(Content,"")
oRegExp.pattern ="<em.+?>"
Set Matches=oRegExp.Execute(Content)
For Each oMatch In Matches
oRegExp1.pattern="http://([\w-]+\.)+[\w-]+(/[\w- ./?%&=]*)?"
Set Matches1=oRegExp.Execute(oMatch.Value)
For Each oMathch1 In Matches1
'只取媒体文件
sFile=Split(oMathch1.value,".")
If InStr(sFiles1,sFile(UBound(sFile)))>0 Then
strFiles2="<a href=""" & oMathch1.value & """ target=""_blank"">" & oMathch1.value & "</a><br>"
End If
Next
Next
oRegExp.pattern ="<em.+?/em>"
Content=oRegExp1.replace(Content,"")
Set oRegExp1=othing
Set oRegExp2=othing
End Function
Function ubb_comment(strContent)
Dim re
If IsNull(strContent) THen
ubb_comment=""
Exit Function
End If
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
'以下过滤html代码
strContent = Replace(strContent, "<br />", "[br]")
strContent = Replace(strContent, ">", ">")
strContent = Replace(strContent, "<", "<")
strContent = Replace(strContent, Chr(32), " ")
strContent = Replace(strContent, Chr(9), " ")
strContent = Replace(strContent, Chr(34), """)
'strContent = Replace(strContent, CHR(39), "'")
strContent = Replace(strContent, Chr(13), "")
strContent = Replace(strContent, Chr(10), "<br /> ")
strContent = Replace(strContent, "[br]", "<br />")
'以下过滤ubb标签
re.Pattern="(\[EMOT\])(.[^\[]*)(\[\/EMOT\])"
strContent= re.replace(strContent,"<img src="""&blogurl&"editor/images/emot/face"&"$2"&".gif"&""" />")
re.Pattern="\[i\](.[^\[]*)(\[\/i\])"
strContent=re.replace(strContent,"<em>$1</em>")
re.Pattern="\[u\](.[^\[]*)(\[\/u\])"
strContent=re.replace(strContent,"<u>$1</u>")
re.Pattern="\[b\](.[^\[]*)(\[\/b\])"
strContent=re.replace(strContent,"<strong>$1</strong>")
' re.Pattern="\[QUOTE\](.[^\[]*)(\[\/QUOTE\])"
' strContent=re.replace(strContent,"<div class=""quote"">$1</div><br>")
re.Pattern="\[QUOTE\]"
strContent=re.replace(strContent,"<div class=""quote"">")
re.Pattern="\[\/QUOTE\]"
strContent=re.replace(strContent,"</div>")
Set re=Nothing
ubb_comment=strContent
End Function
'载入编辑器，stype值为1可上传,0不可上传
Sub MakeEditorText(sInput,stype,width,height)
If l_isUbb > 0 Then C_Editor_Type = l_isUbb
If C_Editor_Type = 2 Then Exit Sub
If sInput = "" Then sInput = "edit"
Select Case C_Editor_Type
Case 1
%>
<script language=JavaScript src="<%=C_Editor%>/scripts/language/schi/editor_lang.js"></script>
<script language=JavaScript src="<%=C_Editor%>/scripts/innovaeditor.js"></script>
<script language="JavaScript">
var oEdit1 = new InnovaEditor("oEdit1");
//STEP 2: Asset Manager Localization: Add querystring lang=en⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -