📄 inc_func_common.asp
字号:
ImgTags(3,1,1) = "[img=right]"
ImgTags(3,2,1) = "[/img=right]"
ImgTags(3,1,2) = "<img align=""right"" src="""
ImgTags(3,2,2) = """ id=""right"" border=""0"">"
ImgTags(4,1,1) = "[image=right]"
ImgTags(4,2,1) = "[/image=right]"
ImgTags(4,1,2) = ImgTags(3,1,2)
ImgTags(4,2,2) = ImgTags(3,2,2)
ImgTags(5,1,1) = "[img=left]"
ImgTags(5,2,1) = "[/img=left]"
ImgTags(5,1,2) = "<img align=""left"" src="""
ImgTags(5,2,2) = """ id=""left"" border=""0"">"
ImgTags(6,1,1) = "[image=left]"
ImgTags(6,2,1) = "[/image=left]"
ImgTags(6,1,2) = ImgTags(5,1,2)
ImgTags(6,2,2) = ImgTags(5,2,2)
strResultString = ""
strTempString = fString
for counter1 = 1 to TagCount
oTag = ImgTags(counter1,1,1)
roTag = ImgTags(counter1,1,2)
cTag = ImgTags(counter1,2,1)
rcTag = ImgTags(counter1,2,2)
oTagPos = InStr(1, strTempString, oTag, 1)
cTagPos = InStr(1, strTempString, cTag, 1)
if (oTagPos > 0) and (cTagPos > oTagPos) then
strArray = Split(strTempString, oTag, -1, 1)
for counter2 = 0 to Ubound(strArray)
if (Instr(1, strArray(counter2), cTag, 1) > 0) then
strArray2 = split(strArray(counter2), cTag, -1, 1)
strUrlText = trim(strArray2(0))
strUrlText = replace(strUrlText, """", " ") ' ## filter out "
'## Added to exclude Javascript and other potentially hazardous characters
strUrlText = replace(strUrlText, "&", " ", 1, -1, 1) ' ## filter out &
strUrlText = replace(strUrlText, "#", " ", 1, -1, 1) ' ## filter out #
strUrlText = replace(strUrlText, ";", " ", 1, -1, 1) ' ## filter out ;
strUrlText = replace(strUrlText, "+", " ", 1, -1, 1) ' ## filter out +
strUrlText = replace(strUrlText, "(", " ", 1, -1, 1) ' ## filter out (
strUrlText = replace(strUrlText, ")", " ", 1, -1, 1) ' ## filter out )
strUrlText = replace(strUrlText, "[", " ", 1, -1, 1) ' ## filter out [
strUrlText = replace(strUrlText, "]", " ", 1, -1, 1) ' ## filter out ]
strUrlText = replace(strUrlText, "=", " ", 1, -1, 1) ' ## filter out =
strUrlText = replace(strUrlText, "*", " ", 1, -1, 1) ' ## filter out *
strUrlText = replace(strUrlText, "'", " ", 1, -1, 1) ' ## filter out '
strUrlText = replace(strUrlText, vbTab, " ", 1, -1, 1) ' ## filter out Tabs
strUrlText = replace(strUrlText, "view-source", " ", 1, -1, 1) ' ## filter out view-source
strUrlText = replace(strUrlText, "javascript", " ", 1, -1, 1) ' ## filter out javascript
strUrlText = replace(strUrlText, "jscript", " ", 1, -1, 1) ' ## filter out jscript
strUrlText = replace(strUrlText, "vbscript", " ", 1, -1, 1) ' ## filter out vbscript
strUrlText = replace(strUrlText, "mailto", " ", 1, -1, 1) ' ## filter out mailto
'## End Added
strUrlText = replace(strUrlText, "<", " ") ' ## filter out <
strUrlText = replace(strUrlText, ">", " ") ' ## filter out >
strResultString = strResultString & roTag & strUrlText & rcTag & strArray2(1)
for counter3 = 2 to UBound(strArray2)
strResultString = strResultString & strArray2(counter3)
next
else
strResultString = strResultString & strArray(counter2)
end if
next
strTempString = strResultString
strResultString = ""
end if
next
ReplaceImageTags = strTempString
end function
Function ReplaceCodeTags(fString)
Dim oTag, cTag
Dim roTag, rcTag
Dim oTagPos, cTagPos
Dim nTagPos
Dim counter1, counter2
Dim strCodeText
Dim Tagcount
Dim strTempString, strResultString
TagCount = 1
Dim CodeTags(1,2,2)
Dim strArray, strArray2
CodeTags(1,1,1) = "[code]"
CodeTags(1,2,1) = "[/code]"
CodeTags(1,1,2) = "<pre id=""code""><font face=""courier"" size=""" & strDefaultFontSize & """ id=""code"">"
CodeTags(1,2,2) = "</font id=""code""></pre id=""code"">"
strResultString = ""
strTempString = fString
for counter1 = 1 to TagCount
oTag = CodeTags(counter1,1,1)
roTag = CodeTags(counter1,1,2)
cTag = CodeTags(counter1,2,1)
rcTag = CodeTags(counter1,2,2)
oTagPos = InStr(1, strTempString, oTag, 1)
cTagPos = InStr(1, strTempString, cTag, 1)
if (oTagpos > 0) and (cTagPos > 0) then
strArray = Split(strTempString, oTag, -1, 1)
for counter2 = 0 to Ubound(strArray)
if (Instr(1, strArray(counter2), cTag) > 0) then
strArray2 = split(strArray(counter2), cTag, -1, 1)
strCodeText = trim(strArray2(0))
strCodeText = replace(strCodeText, "<br />", vbNewLine)
strResultString = strResultString & roTag & strCodeText & rcTag & strArray2(1)
else
strResultString = strResultString & strArray(counter2)
end if
next
strTempString = strResultString
strResultString = ""
end if
next
ReplaceCodeTags = strTempString
end function
'##############################################
'## Page Title ##
'##############################################
Function GetNewTitle(strTempScriptName)
Dim StrTempScript
Dim strNewTitle
arrTempScript = Split(strTempScriptName, "/")
strTempScript = arrTempScript(Ubound(arrTempScript))
strTempScript = lcase(strTempScript)
Select Case strTempScript
Case "topic.asp"
strTempTopic = cLng(request.querystring("TOPIC_ID"))
if strTempTopic <> 0 then
strsql = "SELECT FORUM_ID, T_SUBJECT FROM " & strActivePrefix & "TOPICS WHERE TOPIC_ID=" & strTempTopic
set ttopics = my_conn.execute(strsql)
if ttopics.bof or ttopics.eof then
GetNewTitle = strForumTitle
set ttopics = nothing
else
if mLev = 4 then
ForumChkSkipAllowed = 1
elseif mLev = 3 then
if chkForumModerator(ttopics("FORUM_ID"), ChkString(strDBNTUserName, "decode")) = "1" then
ForumChkSkipAllowed = 1
else
ForumChkSkipAllowed = 0
end if
else
ForumChkSkipAllowed = 0
end if
intShowTopicTitle = 1
if strPrivateForums = "1" and ForumChkSkipAllowed = 0 then
if not(chkForumAccess(ttopics("FORUM_ID"),MemberID,false)) then
intShowTopicTitle = 0
end if
end if
if intShowTopicTitle = 1 then strTempTopicTitle = " - " & chkString(ttopics("T_SUBJECT"),"display")
set ttopics = nothing
strNewTitle = strForumTitle & strTempTopicTitle
end if
else
GetNewTitle = strForumTitle
end if
Case "forum.asp"
strTempForum = cLng(request.querystring("FORUM_ID"))
if strTempForum <> 0 then
strsql = "SELECT F_SUBJECT FROM " & strTablePrefix & "FORUM WHERE FORUM_ID=" & strTempForum
set tforums = my_conn.execute(strsql)
if tforums.bof or tforums.eof then
strNewTitle = strForumTitle
set tforums = nothing
else
strTempForumTitle = chkString(tforums("F_SUBJECT"),"display")
set tforums = nothing
strNewTitle = strForumTitle & " - " & strTempForumTitle
end if
else
strNewTitle = strForumTitle
end if
Case "members.asp"
strNewTitle = strForumTitle & " - Members"
Case "active.asp"
strNewTitle = strForumTitle & " - Active Topics"
Case "faq.asp"
strNewTitle = strForumTitle & " - Frequently Asked Questions"
Case "search.asp"
strNewTitle = strForumTitle & " - Search"
Case "pop_profile.asp"
if request.querystring("mode") = "display" then
strNewTitle = strForumTitle & " - View Profile"
elseif request.querystring("mode") = "edit" then
strNewTitle = strForumTitle & " - Edit Profile"
else
strNewTitle = strForumTitle & " - Profile"
end if
Case "policy.asp"
strNewTitle = strForumTitle & " - User Agreement"
Case "register.asp"
strNewTitle = strForumTitle & " - Register"
Case "down.asp"
strNewTitle = strForumTitle & " is currently closed."
Case "default.asp"
strNewTitle = strForumTitle
Case else
strNewTitle = strForumTitle
End Select
GetNewTitle = strNewTitle
End Function
'## Function to limit the amount of records to retrieve from the database
Function TopSQL(strSQL, lngRecords)
if ucase(left(strSQL,7)) = "SELECT " then
select case strDBType
case "sqlserver"
TopSQL = "SET ROWCOUNT " & lngRecords & vbNewLine & strSQL & vbNewLine & "SET ROWCOUNT 0"
case "access"
TopSQL = "SELECT TOP " & lngRecords & mid(strSQL,7)
case "mysql"
if instr(strSQL,";") > 0 then
strSQL1 = Mid(strSQL, 1, Instr(strSQL, ";")-1)
strSQL2 = Mid(strSQL, InstrRev(strSQL, ";"))
TopSQL = strSQL1 & " LIMIT " & lngRecords & strSQL2
else
TopSQL = strSQL & " LIMIT " & lngRecords
end if
end select
else
TopSQL = strSQL
end if
End Function
Function sGetColspan(lIN, lOUT)
if (strShowModerators = "1") then lOut = lOut + 1
if (mlev = "4" or mlev = "3") and (strShowModerators = "1") then lOut = lOut + 1
if (mlev = "4" or mlev = "3") and (strShowModerators <> "1") then lOut = lOut + 2
if lOut > lIn then
sGetColspan = lIN
else
sGetColspan = lOUT
end if
End Function
function dWStatus(strMsg)
dWStatus = " onMouseOver=""(window.status='" & Replace(strMsg, "'", "\'") & "'); return true"" onMouseOut=""(window.status=''); return true"""
end function
function profileLink(fName, fID)
if instr(fName,"img src=") > 0 then
strExtraStuff = ""
else
strExtraStuff = " title=""View " & fName & "'s Profile""" & dWStatus("View " & fName & "'s Profile")
end if
if strUseExtendedProfile then
strReturn = "<a href=""pop_profile.asp?mode=display&id=" & fID & """" & strExtraStuff & ">"
else
strReturn = "<a href=""JavaScript:openWindow3('pop_profile.asp?mode=display&id=" & fID & "')""" & strExtraStuff & ">"
end if
profileLink = strReturn & fName & "</a>"
end function
function chkSelect(actualValue, thisValue)
if isNumeric(actualValue) then actualValue = cLng(actualValue)
if actualValue = thisValue then
chkSelect = " selected"
else
chkSelect = ""
end if
end function
function chkExist(actualValue)
if trim(actualValue) <> "" then
chkExist = actualValue
else
chkExist = ""
end if
end function
function chkExistElse(actualValue, elseValue)
if trim(actualValue) <> "" then
chkExistElse = actualValue
else
chkExistElse = elseValue
end if
end function
function chkRadio(actualValue, thisValue, boltf)
if isNumeric(actualValue) then actualValue = cLng(actualValue)
if actualValue = thisValue EQV boltf then
chkRadio = " checked"
else
chkRadio = ""
end if
end function
function chkCheckbox(actualValue, thisValue, boltf)
if isNumeric(actualValue) then actualValue = cLng(actualValue)
if actualValue = thisValue EQV boltf then
chkCheckbox = " checked"
else
chkCheckbox = ""
end if
end function
function InArray(strArray,strValue)
if strArray <> "" and strArray <> "0" then
if (instr("," & strArray & "," ,"," & strValue & ",") > 0) then
InArray = True
exit function
end if
end if
InArray = False
end function
function oldInArray(strArray,strValue)
if IsArray(strArray) then
Dim Ix
for Ix = 0 To UBound(strArray)
if cLng(strArray(Ix)) = cLng(strValue) then
oldInArray = True
exit function
end if
next
end if
oldInArray = False
end function
Sub WriteFooter() %>
<!--#INCLUDE FILE="inc_footer.asp"-->
<% end sub
Sub WriteFooterShort() %>
<!--#INCLUDE FILE="inc_footer_short.asp"-->
<% end sub
%>
<script language="javascript1.2" runat="server">
function edit_hrefs(sURL, iType) {
sOutput = new String(sURL);
if (iType == 1) {
sOutput = sOutput.replace(/\b(http\:\/\/[\w+\.]+[\w+\.\:\/\@\_\?\=\&\-\'\#\%\~\;\,\$\!\+\*]+)/gi,
"<a href=\"$1\" target=\"_blank\">$1<\/a>");
} else if (iType == 2) {
sOutput = sOutput.replace(/\b(https\:\/\/[\w+\.]+[\w+\.\:\/\@\_\?\=\&\-\'\#\%\~\;\,\$\!\+\*]+)/gi,
"<a href=\"$1\" target=\"_blank\">$1<\/a>");
} else if (iType == 3) {
sOutput = sOutput.replace(/\b(www\.[\w+\.\:\/\@\_\?\=\&\-\'\#\%\~\;\,\$\!\+\*]+)/gi,
"<a href=\"http://$1\" target=\"_blank\">$1<\/a>");
} else if (iType == 4) {
sOutput = sOutput.replace(/\b([\w+\-\'\#\%\.\_\,\$\!\+\*]+@[\w+\.?\-\'\#\%\~\_\.\;\,\$\!\+\*]+\.[\w+\.?\-\'\#\%\~\_\.\;\,\$\!\+\*]+)/gi,
"<a href=\"mailto\:$1\">$1<\/a>");
} else if (iType == 5) {
sOutput = sOutput.replace(/\b(ftp\:\/\/[\w+\.]+[\w+\.\:\/\@\_\?\=\&\-\'\#\%\~\;\,\$\!\+\*]+)/gi,
"<a href=\"$1\" target=\"_blank\">$1<\/a>");
} else if (iType == 6) {
sOutput = sOutput.replace(/\b(file\:\/\/\/[\w+\:\/\\]+[\w+\/\w+\.\:\/\\\@\_\?\=\&\-\'\#\%\~\;\,\$\!\+\*]+)/gi,
"<a href=\"$1\" target=\"_blank\">$1<\/a>");
}
return sOutput;
}
</script>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -