T O P I C R E V I E W |
Webbo |
Posted - 21 October 2011 : 03:18:15 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 |
12 L A T E S T R E P L I E S (Newest First) |
bobby131313 |
Posted - 25 October 2011 : 20:10:09
|
Webbo |
Posted - 25 October 2011 : 18:05:55 Got it Bobby:
in inc_header.asp ...
And needed to add the id=""keywords"" in to the links as such
|
bobby131313 |
Posted - 25 October 2011 : 13:01:39 In the LoadKeyWordApps sub it needs to be id=""keywords"" not class=""keywords""
I made that mistake for a minute. |
Webbo |
Posted - 25 October 2011 : 02:35:23 Not sure what you mean Bobby |
bobby131313 |
Posted - 24 October 2011 : 18:45:21 You are adding it as an ID and not a class right? |
Webbo |
Posted - 24 October 2011 : 17:44:28 Nope, it just doesn't seem to want to overide the links definitions
Tried it in IE9 and Firefox 7.01 |
Carefree |
Posted - 23 October 2011 : 20:34:59 Provided you have them after the links definitions, these should work:
|
Webbo |
Posted - 23 October 2011 : 05:00:06 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
"#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 ? |
bobby131313 |
Posted - 22 October 2011 : 20:46:57
|
Webbo |
Posted - 22 October 2011 : 18:12:07 Thanks Bobby, just what I was looking for and now integrated within our site
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
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
|
Webbo |
Posted - 21 October 2011 : 16:14:24 Thanks Bobby, it's been a long hard day so I'll take a good look tomorrow |
bobby131313 |
Posted - 21 October 2011 : 09:40:12 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. |
|
|