Trocando palavras, semelhante a replace

[jrcardozo 4]

A pedido de um grande amigo, fiz essa parada pra ver se ajuda ele.

No caso em especifico é para trocar o e-mail que o usuário tenta cadastrou por uma palavra, assim ao exibir no site não aparecerá o endereço completo. Exemplo....só podem ver o e-mail usuários cadastrados no site, os não cadastrados não tem acesso a ver o endereço de e-mail. Você pode usar para "N" ocasiões, esse foi só um exemplo

ASP

<%

 '???????????????????????????????????????????????????????????????????????'

 '?????????? FUNÇÃO PARA SUBSTITUIR PALAVRAS E CARACTERES ???????????????'

 '???????????????????????????????????????????????????????????????????????'

 '                                '

 '  Nome                 : Substitui palavras e caracters          '

 '  Autor            : Jonathan Rangel Cardozo            '

 '  Data Criação : 18/05/2007           '

 '  Contato       : cardozo81@gmail.com        '

 '                                '

 '???????????????????????????????????????????????????????????????????????'

 '???????????????????????????????????????????????????????????????????????'

 '???????????????????????????????????????????????????????????????????????'

 

'======================= INICIO ======================'

'Forçando a declaração de variaveis

Option Explicit

'Setando o tipo de caracteres a serem usados'

Response.Charset = "utf-8"

Function substChar(byVal strTexto,byVal strPalavras,byVal strMsg, byVal strChr)

 'strTexto recebe o texto onde vamos localizar as palavras

 'strPalavras recebe um array das palavras para procurar

 'strMsg recebe a mensagem ou caracter que substituirá a palavra localizada

 'strChr recebe o caracter que servirá de separador do array da entrada strPalavras

 

 'Declaração de variaveis'

 Dim arrTexto, arrPalavras

 Dim i, j

 Dim strAux, strSaida, strChave

 Dim intTipo

 'Tipo                  '

 '0 = Substitui toda a palavra    '

 '1 = Substitui do caracter até o final da palavra '

 '2 = Substitui do inicio da palavraaté o caracter '

 intTipo = 1

 

 intTipo = cInt(intTipo)

 If cInt(inStr("012",intTipo)) = 0 Then

  Exit Function

 End If

  'Conjunto chave de caracteres que serão parâmentros no proximo array'

  strChave      = "*9%|/#<5>#|%9*" '(Preferencialmente não altere)'

  'Monta o array das palavras a serem localizadas'

  arrPalavras = split(strPalavras,strChr)

  'Procura no texto as palavras do conjunto do array'

  For j=0 To uBound(arrPalavras)

   'Se encontrar substitui pelo conjunto chave de caracteres'

   strTexto = Replace(strTexto, uCase(Trim(arrPalavras(j))), strChave)

   strTexto = Replace(strTexto, lCase(Trim(arrPalavras(j))), strChave)  

  Next

  'Novo array separando o texto a partir dos espaços'

  arrTexto = split(strTexto," ")

  'Procura em cada palavra do texto o conjunto chave de caracteres'

  For i = 0 To uBound(arrTexto)

   'Armazena na variavel a palavra atual de pesquisa'

   strAux = arrTexto(i)

   'Procura pelo conjunto chave na palavra atual e substitui de acordo com o tipo'

   If cInt(inStr(uCase(strAux),uCase(strChave))) <> 0 Then

        If intTipo = 0 Then

         strAux = strMsg

        ElseIf intTipo = 1 Then

         strAux = Mid(strAux,1,(cInt(inStr(uCase(strAux),uCase(strChave))))-1) & strMsg

        ElseIf intTipo = 2 Then

         strAux = strMsg & Replace(Mid(strAux,cInt(inStr(uCase(strAux),uCase(strChave))),Len(strAux)),strChave,"")

        End If

   End If

   strSaida = strSaida &" "& strAux  

  Next

 'Retorno da função'

 substChar = strSaida

End Function

'======================= FIM ======================'

 

'=================================================='

 

' ========  Exemplo de chamada da função =========='

'Declarando variaveis auxiliares

Dim procuraEm, asPalavras, troquePor, separadorArray

 

'Texto onde queremos procurar as palavras

procuraEm       = "teste jonathan@site.com ou meuemailarrobaemail.com e também novoEmail[A]teste.br"

 

'Palavras que desejamos localzar, separadas por vírgula

asPalavras   = "[a],@,arroba,a r r o b a, .com,.com.br,.net,.org"

 

'Mensagem amigavel a ser colocada no lugar da palavra localizada

troquePor       = "@<b>[</b><a href=""#"" title=""Para ver o endereço de e-mail você precisa fazer o login"" style=""color:#000;text-decoration:none;"">...</a><b>]</b>"

 

'Caracter ou conjunto de caracteres que servirá(ão) para montar o array

separadorArray = ","

 

'Escrevendo no browser'

Response.Write(substChar(procuraEm,asPalavras,troquePor,separadorArray))

'ATENÇÃO

'Cuidado ao usar o texto de procura em códigos Html

'pois a função pode quebrar alguma Tag de forma indesejada

%>

Espero que seja útil para alguem

 

Abraços e podem elogiar e criticar a vontade, sempre bom saber se as paradas criadas estão agradando ou não

[kaplan 0]

ao amigao, ainda nao testei mais hj sem falta eu vou dar uma analisada nisto, e depois post aqui

 

brigadao man http://forum.imasters.com.br/public/style_emoticons/default/thumbsup.gif

[jrcardozo 4]

beleza....vou aperfeiçoa-la também heheheabraço

[Salgado 4]

Tiu Jonathan eu só trocaria uma coisa, acrescentaria nas variáveis de entrada da sua function qual seria o separador para o array.

[jrcardozo 4]

Boa Salgado, na verdade tem algo semelhante já no código e deixei comentado, mas vou fazer isso pra ficar mais configuravel e transforma-la em classe pra facilitarJá adaptei pra fazer o resultado assim, porém não postei aindatexto "normal" jonathan@email.comcom a função jonathan[...]Se der tempo final de semana tento melhorar e posto atualizado segundaObrigado pelos comentários...isto incentiva a continuar a fazer esse tipo de contribuiçãoAbraços

[jrcardozo 4]

tá na mão galera....agora a função foi atualizada....a troca pode ser feita na palavra completa, do inicio até o caracter chave ou do caracter chave até o final da palavra. Agora não é mais case sensitive, ou seja...o cara pode escrever maiuscula ou minuscula que a função vai identificar e substituirBom proveito e por favor.....quem gostou comenta, quem não gostou....comenta também.

[Ted k' 126]

Que código bom cara, isso vai me ajudar muito no projeto que estou desenvolvendo!!!!

[jrcardozo 4]

Beleza Ted, se tiver sugestões e criticas posta ae pra deixar o registro