asked on

Bad Words Filter

Hi Guys

The following function takes a string of characters (words) and filters through them looking for "bad words" - the bad words are contained in an array - what I would like to do is use a text file which has one bad word per line - so I need to load the text file, line by line into an array - how would I do that? I know I can do that by using a table, but if I use a textfile, several programs can use it with less overhead.

Function ReplaceBadWords(InputComments)
Dim badChars, newChars, sLength, sAttachtoEnd, x, i
'create an array of bad words that should be filtered
badChars = array("rubbish", "crap", "shit", "cunt", "bastard", "prick", "fuck")
newChars = InputComments
'loop through our array of bad words
    For i = 0 to uBound(badChars)
        'get the length of the bad word
        sLength=Len(badChars(i))
        'we are going to keep the first letter of the bad word and replace all the other 
        'letters with *, so we need to find out how many * to use
        For x=1 to sLength-1
            sAttachtoEnd=sAttachtoEnd & "*"
        Next
        'replace any occurences of the bad word with the first letter of it and the 
        'rest of the letters replace with *
        newChars = Replace(newChars, badChars(i), Left(badChars(i),1) & sAttachtoEnd)
        sAttachtoEnd=""
    Next
ReplaceBadWords = newChars
End function

Open in new window

MTIA

DWE

ASKER CERTIFIED SOLUTION

Big Monty

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

dwe0608

ASKER

Thanks greatly for the function

dwe0608

ASKER

This is how I implemented the function ... and I've attached the bad words file I have used as well.

Function ReplaceBadWords(InputComments)
Dim badChars, newChars, sLength, sAttachtoEnd, x, i
'create an array of bad words that should be filtered
'badChars = array("rubbish", "crap", "shit", "cunt", "bastard", "prick", "fuck")
dim fn
fn = server.mappath("badwords.txt")
badchars = BadWordsFile(fn)
newChars = InputComments
'loop through our array of bad words
    For i = 0 to uBound(badChars)
        'get the length of the bad word
        sLength=Len(badChars(i))
        'we are going to keep the first letter of the bad word and replace all the other 
        'letters with *, so we need to find out how many * to use
        For x=1 to sLength-1
            sAttachtoEnd=sAttachtoEnd & "*"
        Next
        'replace any occurences of the bad word with the first letter of it and the 
        'rest of the letters replace with *
        newChars = Replace(newChars, badChars(i), Left(badChars(i),1) & sAttachtoEnd)
        sAttachtoEnd=""
    Next
ReplaceBadWords = newChars
End function
' note there is no error checking
' if we pass a file with nothing in it, it may throw an error
Function BadWordsFile(filename)	
    Dim fso,ts, myarray
    Const ForReading = 1
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.OpenTextFile(filename, ForReading)
    reDim myarray(0)	
    i=-1
    While not ts.AtEndOfStream
      i=i+1
      Redim Preserve myarray(i)
      myarray(i)=ts.ReadLine
    Wend
    ts.Close
    set ts = nothing
    set fso = nothing
    BadWordsFile=myarray
End Function

Open in new window

badwords.txt