发信人: iceant()
整理人: qcrsoft(2001-12-13 07:14:42), 站内信件
|
前面看到有人在论讨UBB语法分析，
因为最近我在做这个东东，所以将我写的几个函数列出来供大家参考！
这也是我对SNIZ-UBB论坛最大的改动，基本更正了它对TAG分析的错误
function ChkUrls(fString, fTestTag, fType)
Dim strArray
Dim Counter
Dim strTempString
strTempString = fString
if Instr(1, fString, fTestTag) > 0 then
strArray = Split(fString, fTestTag, -1)
strTempString = strArray(0)
for counter = 1 to UBound(strArray)
if ((strArray(counter-1) = "" or len(strArray(counter-1)) < 5) and s
trArray(counter)<> "") then
strTempString = strTempString & edit_hrefs("" & fTestTag & strArray
(counter), fType)
elseif ((UCase(right(strArray(counter-1),5)) <> "[URL]") and (UCase(
right(strArray(counter-1),11)) <> "[URL="") and (UCase(right(strA
rray(counter-1),7)) <> "FILE:///") and (UCase(right(strArray(counter-1
),7)) <> "HTTP://") and (UCase(right(strArray(counter-1),8)) <> "HTTPS
://") and (UCase(right(strArray(counter-1),5)) <> "SRC=""") and (UCase(right(s
trArray(counter-1),10)) <> "SRC="") and strArray(counter)<> "") t
hen
strTempString = strTempString & edit_hrefs("" & fTestTag & strArray
(counter), fType)
else
strTempString = strTempString & fTestTag & strArray(counter)
end if
next
end if
ChkUrls = strTempString
end function
function ChkMail(fString, fTestTag, fType)
Dim strArray
Dim Counter
Dim strTempString
strTempString = fString
if Instr(1, fString, fTestTag) > 0 then
strArray = Split(fString, fTestTag, -1)
strTempString = strArray(0)
for counter = 1 to UBound(strArray)
if (Instr(strArray(counter), "@") > 0) and not (Instr(UCase(strArray
(counter)), "[URL") > 0) then
strTempString = strTempString & edit_hrefs("" & fTestTag & strArray
(counter), fType)
else
strTempString = strTempString & fTestTag & strArray(counter)
end if
next
end if
ChkMail = strTempString
end function
function FormatStr(fString)
on Error resume next
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "</P><P>")
fString = Replace(fString, CHR(10), "<BR>")
if strBadWordFilter = 1 then
fString = ChkBadWords(fString)
end if
fString = ChkUrls(fString,"http://", 1)
fString = ChkUrls(fString,"https://", 2)
fString = ChkUrls(fString,"file:///", 3)
fString = ChkUrls(fString,"www.", 4)
fString = ChkUrls(fString,"mailto:",5)
fString = ChkMail(fString," ",5)
fString = ChkMail(fString,chr(13),5)
'fString = edit_hrefs(fString, 5)
fString = ReplaceUrls(fString)
FormatStr = fString
end function
Function ReplaceUrls(fString)
Dim oTag, c1Tag, c2Tag
Dim roTag, rc1Tag, rc2Tag
Dim oTagPos, c1TagPos, c2TagPos
Dim nTagPos
Dim counter2
Dim strArray, strArray2, strArray3
oTag = "[url=""
oTag3 = "[url="&chr(34)
oTag2 = "[url]"
roTag = "<a href="""
httpTag ="<a href=""http://"
c1Tag = ""]"
c1Tag3 = chr(34)&"]"
c1Tag2 = "[/url]"
rc1Tag = """ target=""_New"">"
c2Tag = "[/url]"
rc2Tag = ""
oTagPos = InStr(1, fString, oTag, 1)
c1TagPos = InStr(1, fString, c1Tag, 1)
oTagPos_T = InStr(1, fString, oTag3, 1)
c1TagPos_T = InStr(1, fString, c1Tag3, 1)
strTempString = ""
if ((oTagpos > 0) and (c1TagPos > 0)) or ((oTagPos_T>0)and(c1TagPos_T>
0)) then
if ((oTagpos > 0) and (c1TagPos > 0)) then strArray = split(fString,
oTag, -1,1)
if ((oTagPos_T>0)and(c1TagPos_T>0)) then strArray = split(fString, oT
ag3, -1,1)
for counter2 = 0 to UBound(strArray)
if (InStr(1, strArray(counter2), c2Tag, 1) > 0) and ((InStr(1, strAr
ray(counter2), c1Tag, 1) > 0)or(InStr(1, strArray(counter2), c1Tag3, 1
) > 0)) then
if (InStr(1, strArray(counter2), c1Tag, 1) > 0) then
strArray2 = Split(strArray(counter2), c1Tag, -1)
else
strArray2 = Split(strArray(counter2), c1Tag3, -1)
end if
' if Instr(1, strArray2(1), c2Tag) and not( Instr(1, UCase(strArray
2(1)), "[URL]") >0) then
if Instr(1, strArray2(1), c2Tag)>0 then
strFirstPart = Left(strArray2(1), Instr(1, strArray2(1),c2Tag)-1)
strSecondPart = Right(strArray2(1), (Len(strArray2(1)) - Instr(1,
strArray2(1), c2Tag) - len(c2Tag)+1))
if strFirstPart <> "" then
strTempString = strTempString & roTag &"mailto:"& strArray2(0) &
rc1Tag & strFirstPart & rc2Tag & strSecondPart
else
strTempString = strTempString & roTag & strArray2(0) & rc1Tag & s
trArray2(0) & rc2Tag & strSecondPart
end if
else
strTempString = strTempString & roTag & strArray2(0) & rc1Tag & st
rArray2(0) & rc2Tag & strArray2(1)
end if
elseif ((InStr(1, strArray(counter2), c1Tag, 1) > 0)or(InStr(1, strA
rray(counter2), c1Tag3, 1) > 0) ) then
if (pos_t=InStr(1, strArray(counter2), c1Tag, 1) > 0) then
strArray2 = Split(strArray(counter2), c1Tag, -1)
pos_t=InStr(1, strArray2(1), c1Tag2, 1)
mail_to=left(strArray2(1),pos_t-1)
strArray2(1)=right(strArray2(1),(len(strArray2(1))-pos_t-5))
end if
if (InStr(1, strArray(counter2), c1Tag3, 1) > 0) then
strArray2 = Split(strArray(counter2), c1Tag3, -1)
pos_t=InStr(1, strArray2(1), c1Tag2, 1)
mail_to=left(strArray2(1),pos_t-1)
strArray2(1)=right(strArray2(1),(len(strArray2(1))-pos_t-5))
end if
strTempString = strTempString & roTag &"mailto:"& strArray2(0) & rc
1Tag & mail_to & rc2Tag & strArray2(1)
else
strTempString = strTempString & strArray(counter2)
end if
next
else
strTempString = fString
end if
oTagPos2 = InStr(1, strTempString, oTag2, 1)
c1TagPos2 = InStr(1, strTempString, c1Tag2, 1)
if (oTagpos2 > 0) and (c1TagPos2 > 0) then
strTempString2 = ""
strArray = Split(strTempString, oTag2, -1)'用[url]分
for counter3 = 0 to Ubound(strArray)
if (Instr(1, strArray(counter3), c1Tag2) > 0) then 'c1Tag2="[/url]"
strArray2 = split(strArray(counter3), c1Tag2, -1)
strTempString2 = strTempString2 & httpTag & strArray2(0) & rc1Tag
& strArray2(0) & rc2Tag & strArray2(1)
else
strTempString2 = strTempString2 & strArray(counter3)
end if
next
strTempString = strTempString2
end if
ReplaceUrls = strTempString
End Function
%>
<script language="javascript1.2" runat=server>function edit_hrefs(s_ht
ml, type){ s_str = new String(s_html);
if (type == 1) { s_str = s_str.replace(/\b(http\:\/\/[\w+\.]+[\w+
\.\:\/\_\?\=\&\-\'\#\%\~\;\,\$\!\+\*]+)/gi, "<a href=\"$1\" target=
\"_blank\">$1<\/a>"); }
if (type == 2) { s_str = s_str.replace(/\b(https\:\/\/[\w+\.]+[\w+\.\
:\/\_\?\=\&\-\'\#\%\~\;\,\$\!\+\*]+)/gi, "<a href=\"$1\" target=\"_blank\">
$1<\/a>"); }
if (type == 3) { s_str = s_str.replace(/\b(file\:\/\/\/\w\:\\[\w+\/\w
+\.\:\/\_\?\=\&\-\'\#\%\~\;\,\$\!\+\*]+)/gi, "<a href=\"$1\" target
=\"_blank\">$1<\/a>"); }
if (type == 4) { s_str = s_str.replace(/\b(www\.[\w+\.\:\/\_\?\=\&\-\
'\#\%\~\;\,\$\!\+\*]+)/gi, "<a href=\"http://$1\" target=\"_blank\
">$1"); }
if (type == 5) { s_str = s_str.replace(/\b([\w+\-\'\#\%\.\_\,\$\!\+\*
]+@[\w+\.?\-\'\#\%\~\_\.\;\,\$\!\+\*]*)/gi, "<a href=\"mailto\:$1\
">$1"); }
return s_str;}
</script>
--
学习，学习，再学习，
人生如此短暂，
而我又如此无知，
除了学习我还能做什么？
※ 来源:．月光软件站 http://www.moon-soft.com．[FROM: 61.141.81.19]
|
|