Snitz Forums 2000
Snitz Forums 2000
Home | Profile | Register | Active Topics | Members | Search | FAQ
Username:
 Password:
Save Password
Forgot your Password?

 All Forums
 Snitz Forums 2000 MOD-Group
 MOD Add-On Forum (W/O Code)
 Seeding within posts?		  New Topic  Reply to Topic
 Printer Friendly
Author Previous Topic Topic Next Topic  

Webbo
Average Member

United Kingdom
982 Posts
Posted - 21 October 2011 :  03:18:15  Show Profile  Visit Webbo's Homepage  Reply with Quote
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

bobby131313
Senior Member

USA
1163 Posts
Posted - 21 October 2011 :  09:40:12  Show Profile  Visit bobby131313's Homepage  Reply with Quote
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.
Switch the order of your title tags
Go to Top of Page

Webbo
Average Member

United Kingdom
982 Posts
Posted - 21 October 2011 :  16:14:24  Show Profile  Visit Webbo's Homepage  Reply with Quote
Thanks Bobby, it's been a long hard day so I'll take a good look tomorrow
Go to Top of Page

Webbo
Average Member

United Kingdom
982 Posts
Posted - 22 October 2011 :  18:12:07  Show Profile  Visit Webbo's Homepage  Reply with Quote
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
Go to Top of Page

bobby131313
Senior Member

USA
1163 Posts
Posted - 22 October 2011 :  20:46:57  Show Profile  Visit bobby131313's Homepage  Reply with Quote
Switch the order of your title tags
Go to Top of Page

Webbo
Average Member

United Kingdom
982 Posts
Posted - 23 October 2011 :  05:00:06  Show Profile  Visit Webbo's Homepage  Reply with Quote
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 ?
Go to Top of Page

Carefree
Advanced Member

Philippines
4207 Posts
Posted - 23 October 2011 :  20:34:59  Show Profile  Reply with Quote
Provided you have them after the links definitions, these should work:


		"#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 & _
Edited by - Carefree on 23 October 2011 20:51:25
Go to Top of Page

Webbo
Average Member

United Kingdom
982 Posts
Posted - 24 October 2011 :  17:44:28  Show Profile  Visit Webbo's Homepage  Reply with Quote
Nope, it just doesn't seem to want to overide the links definitions

Tried it in IE9 and Firefox 7.01
Go to Top of Page

bobby131313
Senior Member

USA
1163 Posts
Posted - 24 October 2011 :  18:45:21  Show Profile  Visit bobby131313's Homepage  Reply with Quote
You are adding it as an ID and not a class right?
Switch the order of your title tags
Go to Top of Page

Webbo
Average Member

United Kingdom
982 Posts
Posted - 25 October 2011 :  02:35:23  Show Profile  Visit Webbo's Homepage  Reply with Quote
Not sure what you mean Bobby
Go to Top of Page

bobby131313
Senior Member

USA
1163 Posts
Posted - 25 October 2011 :  13:01:39  Show Profile  Visit bobby131313's Homepage  Reply with Quote
In the LoadKeyWordApps sub it needs to be id=""keywords"" not class=""keywords""

I made that mistake for a minute.
Switch the order of your title tags
Go to Top of Page

Webbo
Average Member

United Kingdom
982 Posts
Posted - 25 October 2011 :  18:05:55  Show Profile  Visit Webbo's Homepage  Reply with Quote
Got it Bobby:

in 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 & _



And needed to add the id=""keywords"" in to the links as such 

    for iKey = 0 to cLng(NumOfKeys)
        if strKeys = "" then
            strKeys = xmlKeyList.item(iKey).childNodes(0).text
            strReplace = "<a id=""keywords"" 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 id=""keywords"" href=""" & xmlKeyList.item(iKey).childNodes(1).text & """ target=""blank"">"
            strReplace = strReplace & xmlKeyList.item(iKey).childNodes(0).text & "</a>"
        end if
    next
Go to Top of Page

bobby131313
Senior Member

USA
1163 Posts
Posted - 25 October 2011 :  20:10:09  Show Profile  Visit bobby131313's Homepage  Reply with Quote
Switch the order of your title tags
Go to Top of Page
  Previous Topic Topic Next Topic  
 New Topic  Reply to Topic
 Printer Friendly
Jump To:
Snitz Forums 2000 © 2000-2021 Snitz™ Communications Go To Top Of Page
This page was generated in 0.21 seconds. Powered By: Snitz Forums 2000 Version 3.4.07