Seeding within posts? - Posted (1124 Views)
Average Member
Webbo
Posts: 982
982
Is there a way of seeding certain words within posts?
Ie, a poster puts a brand name within a post and the brand name automatically becomes a text link to the brand's website or page?
I've looked into using the profanity filter to do so but it doesn't convert the code correctly plus causes problems within the topic title by displaying the full code instead of the linked word. Ideally within the title it should remain as just the text word and not a hyperlink'd word

Eg: Replace the word Brand in the profanity filter with a hyperlinked text and the result in a post would be: Brand

..or perhaps the profanity filter function and code could be duplicated to create a seperate seeding function and filter ??
Just thinking out loud smile
 Sort direction, for dates DESC means newest first  
 Page size 
Posted
Senior Member
bobby131313
Posts: 1163
1163
http://forum.snitz.com/forum/topic.asp?TOPIC_ID=67151

Be sure to read it all and be careful to get the correct code. There was lots of tweaking along the ride.
Posted
Average Member
Webbo
Posts: 982
982
Thanks Bobby, it's been a long hard day so I'll take a good look tomorrow[^]
Posted
Average Member
Webbo
Posts: 982
982
Thanks Bobby, just what I was looking for and now integrated within our site smile
If anyone else is to use it though be aware that some forum formatting has somehow leached into the code and requires removing first.
Below is a clean version of the bulk of the code to go into inc_function_common.asp

Code:

Function ChkKeys(fString)
dim strKeys,strReplace,keywords,keyreplace,objRegex

'file check
if ShowKeyWords = False then
ChkKeys = fString
Exit Function
end if

if mLev < 3 then
if trim(Application(strCookieURL & "STRKEYWORDS")) = "" or trim(Application(strCookieURL & "STRKEYREPLACE")) = "" then
LoadKeywordApps
end if
else
LoadKeywordApps
end if


strKeys = Application(strCookieURL & "STRKEYWORDS")
strReplace = Application(strCookieURL & "STRKEYREPLACE")
if fString = "" or IsNull(fString) then fString = " "
keywords = split(strKeys, ",")
keyreplace = split(strReplace, ",")

set objRegex = new RegExp
objRegex.ignorecase = true
objRegex.global = true

for i = 0 to ubound(keywords)

strPattern = "^(" & keywords(i) & ")(\s)"
strReplace = keyreplace(i) & "$2"
objRegex.pattern= strPattern
fString = objRegex.replace(fString,strReplace)

strPattern = "(" & keywords(i) & ")$"
strReplace = keyreplace(i)
objRegex.pattern= strPattern
fString = objRegex.replace(fString,strReplace)


fString = Replace(fString, " " & keywords(i) & " ", " " & keyreplace(i) & " ", 1, -1, 1)
fString = Replace(fString, " " & keywords(i) & ",", " " & keyreplace(i) & ",", 1, -1, 1)
fString = Replace(fString, " " & keywords(i) & ".", " " & keyreplace(i) & ".", 1, -1, 1)
fString = Replace(fString, " " & keywords(i) & ":", " " & keyreplace(i) & ":", 1, -1, 1)
fString = Replace(fString, " " & keywords(i) & ";", " " & keyreplace(i) & ";", 1, -1, 1)
fString = Replace(fString, " " & keywords(i) & "!", " " & keyreplace(i) & "!", 1, -1, 1)
fString = Replace(fString, " " & keywords(i) & "?", " " & keyreplace(i) & "?", 1, -1, 1)

fString = Replace(fString, "-" & keywords(i) & "-", "-" & keyreplace(i) & "-", 1, -1, 1)
fString = Replace(fString, "-" & keywords(i) & " ", "-" & keyreplace(i) & " ", 1, -1, 1)
fString = Replace(fString, " " & keywords(i) & "-", " " & keyreplace(i) & "-", 1, -1, 1)

fString = Replace(fString, "_" & keywords(i) & "_", "_" & keyreplace(i) & "_", 1, -1, 1)
fString = Replace(fString, "_" & keywords(i) & " ", "_" & keyreplace(i) & " ", 1, -1, 1)
fString = Replace(fString, " " & keywords(i) & "_", " " & keyreplace(i) & "_", 1, -1, 1)

fString = Replace(fString, "'" & keywords(i) & "'", "'" & keyreplace(i) & "'", 1, -1, 1)
fString = Replace(fString, "'" & keywords(i) & " ", "'" & keyreplace(i) & " ", 1, -1, 1)
fString = Replace(fString, " " & keywords(i) & "'", " " & keyreplace(i) & "'", 1, -1, 1)

fString = Replace(fString, """" & keywords(i) & """", """" & keyreplace(i) & """", 1, -1, 1)
fString = Replace(fString, """" & keywords(i) & " ", """" & keyreplace(i) & " ", 1, -1, 1)
fString = Replace(fString, " " & keywords(i) & """", " " & keyreplace(i) & """", 1, -1, 1)

fString = Replace(fString, "(" & keywords(i) & ")", "(" & keyreplace(i) & ")", 1, -1, 1)
fString = Replace(fString, "(" & keywords(i) & " ", "(" & keyreplace(i) & " ", 1, -1, 1)
fString = Replace(fString, " " & keywords(i) & ")", " " & keyreplace(i) & ")", 1, -1, 1)

fString = Replace(fString, "[" & keywords(i) & "]", "[" & keyreplace(i) & "]", 1, -1, 1)
fString = Replace(fString, "[" & keywords(i) & " ", "[" & keyreplace(i) & " ", 1, -1, 1)
fString = Replace(fString, " " & keywords(i) & "]", " " & keyreplace(i) & "]", 1, -1, 1)

'This line needs repeated parsing misses every other word when a word is repeated
fString = Replace(fString, " " & keywords(i) & " ", " " & keyreplace(i) & " ", 1, -1, 1)

'scenario - first word in line
fString = Replace(fString, chr(13) & chr(10) & keywords(i) & " ", chr(13) & chr(10) & keyreplace(i) & " ", 1, -1, 1)

'scenario - last word in line
fString = Replace(fString, " " & keywords(i) & chr(13) & chr(10), " " & keyreplace(i) & chr(13) & chr(10), 1, -1, 1)

'scenarion - first and only word in line
fString = Replace(fString, chr(13) & chr(10) & keywords(i) & chr(13) & chr(10), chr(13) & chr(10) & keyreplace(i) & chr(13) & chr(10), 1, -1, 1)

'scenario - first word in line followed by a character
fString = Replace(fString, chr(10) & keywords(i) & ".", chr(10) & keyreplace(i) & ".", 1, -1, 1)
fString = Replace(fString, chr(10) & keywords(i) & ",", chr(10) & keyreplace(i) & ",", 1, -1, 1)
fString = Replace(fString, chr(10) & keywords(i) & "?", chr(10) & keyreplace(i) & "?", 1, -1, 1)
fString = Replace(fString, chr(10) & keywords(i) & "!", chr(10) & keyreplace(i) & "!", 1, -1, 1)
fString = Replace(fString, chr(10) & keywords(i) & ":", chr(10) & keyreplace(i) & ":", 1, -1, 1)
fString = Replace(fString, chr(10) & keywords(i) & ";", chr(10) & keyreplace(i) & ";", 1, -1, 1)
fString = Replace(fString, chr(10) & keywords(i) & """", chr(10) & keyreplace(i) & """", 1, -1, 1)
fString = Replace(fString, chr(10) & keywords(i) & "'", chr(10) & keyreplace(i) & "'", 1, -1, 1)
fString = Replace(fString, chr(10) & keywords(i) & ")", chr(10) & keyreplace(i) & ")", 1, -1, 1)
fString = Replace(fString, chr(10) & keywords(i) & "]", chr(10) & keyreplace(i) & "]", 1, -1, 1)

next
set objRegex = nothing

ChkKeys = fString
End Function

' ####Edit strPath to your xml file location

Sub LoadKeywordApps()
dim strPath,xmlDoc,strErr,NumOfKeys,strKeys,strReplace,iKey

strPath = "http://www.yourdomain.com/forum_folder/filename.xml"
set xmlDoc=CreateObject("Microsoft.XMLDOM")
xmlDoc.async="false"
xmlDOc.setProperty "ServerHTTPRequest", true
xmlDoc.load(strPath)

if xmlDoc.parseError.errorCode <> 0 Then
strErr = "<div><b>" & vbNewLine & _
"<ul>" & vbNewLine & _
"<li>ERROR!</li>" & vbNewLine & _
"<li>XML File " & strFileName & " - Failed to validate.</li>" & vbNewLine & _
"<li>" & xmlDoc.parseError.reason & "</li>" & vbNewLine & _
"<li>Error code: " & xmlDoc.parseError.errorCode & "</li>" & vbNewLine & _
"<li>Line: " & xmlDoc.parseError.line & "</li>" & vbNewLine & _
"<li>Character: " & xmlDoc.parseError.linepos & "</li>" & vbNewLine & _
"<li>Source: " & Chr(34) & xmlDoc.parseError.srcText & Chr(34) & "</li>" & vbNewLine & _
"<li>" & Now & "</li>" & vbNewLine & _
"</ul>" & vbNewLine & _
"</b></div>" & vbNewLine

Response.Write strErr
Response.End
end if

set xmlKeyList = xmlDoc.getElementsByTagName("key")

NumOfKeys = ((xmlKeyList.length) - 1) '0 based

strKeys = ""
strReplace = ""

for iKey = 0 to cLng(NumOfKeys)
if strKeys = "" then
strKeys = xmlKeyList.item(iKey).childNodes(0).text
strReplace = "<a href=""" & xmlKeyList.item(iKey).childNodes(1).text & """ target=""blank"">"
strReplace = strReplace & xmlKeyList.item(iKey).childNodes(0).text & "</a>"
else
strKeys = strKeys & "," & xmlKeyList.item(iKey).childNodes(0).text
strReplace = strReplace & ", <a href=""" & xmlKeyList.item(iKey).childNodes(1).text & """ target=""blank"">"
strReplace = strReplace & xmlKeyList.item(iKey).childNodes(0).text & "</a>"
end if
next

set xmlDoc = nothing

Application.Lock
Application(strCookieURL & "STRKEYWORDS") = strKeys
Application(strCookieURL & "STRKEYREPLACE") = strReplace
Application.UnLock
End Sub


Also
Dim ShowKeyWords : ShowKeyWords = True

needs to be added to topic.asp etc without the forum formatting as shown in the original post

Posted
Senior Member
bobby131313
Posts: 1163
1163
Posted
Average Member
Webbo
Posts: 982
982
One issue I have found is whentrying to add a different style/format to the keywords by adding the following code within inc_header.asp

Code:
      "#keywords {color:" & strLinkColor & "; font-weight:normal; text-decoration:none; border-bottom:1px dashed; line-height:18px;}" & vbNewLine & _
"#keywords:hover {color:" & strHoverFontColor & "; font-weight:normal; text-decoration:none; border-bottom:1px dashed; line-height:18px;}" & vbNewLine & _

I just can't seem to get it to display as it will not overide the forum's a:link and a:hover codes

I'm sure it's to do with the way '#keywords is presented as when putting the different styles into a:link and a:hover they do dispay as expected

Any ideas ?
Posted
Advanced Member
Carefree
Posts: 4224
4224
Provided you have them after the links definitions, these should work:

Code:

		"#keywords {color:" & strLinkColor & "; font-weight:normal; text-decoration:none; border-bottom-style:1px dashed; line-height:18px;}" & vbNewLine & _
"#keywords:hover {color:" & strHoverFontColor & "; font-weight:normal; text-decoration:none; border-bottom-style:1px dashed; line-height:18px;}" & vbNewLine & _
Posted
Average Member
Webbo
Posts: 982
982
Nope, it just doesn't seem to want to overide the links definitions

Tried it in IE9 and Firefox 7.01
Posted
Senior Member
bobby131313
Posts: 1163
1163
You are adding it as an ID and not a class right?
Posted
Average Member
Webbo
Posts: 982
982
Not sure what you mean Bobby
Posted
Senior Member
bobby131313
Posts: 1163
1163
In the LoadKeyWordApps sub it needs to be id=""keywords"" not class=""keywords""

I made that mistake for a minute.
You Must enter a message