Palavras proibidas

[xanburzum 169]

Este script irá filtrar todas as palavras "ruins" (palavrões)de uma string. Ela usa uma base de dados como um dicionário. Ela compara todas as palavras ao do banco de dados. Em seguida, notifica os usuários que foram encontrados as mesmas.

 

 

<%
function palavraruim(strMessage)

	strMessage=lcase(strMessage)
	strDBPath = Server.MapPath("mdb/words.mdb")
	Set objDB = Server.CreateObject("ADODB.Connection")	
	objDB.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & ";"
	
	
	Dim array() 
	'Dim minhamessage()
	
	minhamessage=Split(strMessage," ")
	
	strSQL = "SELECT Distinct palavra FROM palavras;"
	Set objRS = objDB.Execute(strSQL)		
	
	'-------------------------------------
	count=0
	do while not objRS.eof
		redim preserve array(count)
		array(count)=objRS("palavra")
				
		objRS.movenext
		count=count+1
	loop	
	'-------------------------------------
	intCurseCount=0			
	for y=0 to UBound(array)
		for x=0 to ubound(minhamessage)
			if array(y) = minhamessage(x) then
				intCurseCount=intCurseCount+1
	'			Response.Write (intCurseCount&"palavra encontrada <BR>")
			end if						
		next 'x
	next 'y
	
	'if (intCurseCount > 0) then 		
	'	Response.write ("<BR><BR>Encontramos " & intCurseCount & " palavras vulgares em sua mensagem. Por favor, modifique a sua mensagem. Não será enviado até que você altere.")
	'end if
	palavraruim=intCurseCount
end function
%>

[Patrique 0]

* tem um errinho no script

 

array(count)=objRS("word")

na linha 22, substituir por

 

array(count)=objRS("palavra")

Muito boa função!

 

[]'s

[xanburzum 169]

Ok, valeu

ja corrigido.