Trocando palavras, semelhante a replace


Autor/fonte: Jonathan Rangel Cardozo
E-mail/Url: http://forum.imasters.com.br/index.php?showtopic=228921
Tags: [ replace ]



Digg del.icio.us

Este script serve para substituir várias palavras de um texto por outra.

A pedido de um grande amigo, fiz esse script para ajudá-lo.

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:

<%
'FUNÇÃO PARA SUBSTITUIR PALAVRAS E CARACTERES'
'                  '
'  Nome         : Substitui palavras e caracters       '
'  Autor        : Jonathan Rangel Cardozo        '
'  Data Criação : 17/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
%>

Exemplos comparativos:

Response.Write(substChar("Meu email de contato é jonathan.cardozo@mail.com","@","[...]"))

Utilizando o tipo 0 de substituição ficará:

Meu email de contato é [...]

Utilizando o tipo 1 de substituição ficará:

Meu email de contato é [...]mail.com

Utilizando apanas replace:

Response.Write(replace("Meu email de contato é jonathan.cardozo@mail.com","@","[...]"))

Resultado:

Meu email de contato é jonathan.cardozo[...]mail.com




Enviado por xKuRt em 20/05/2007 às 09:02


Avaliação

Esta publicação ainda não foi avaliada!


Avaliar:


A avaliação de publicações é restrita a membros cadastrados e logados no nosso site.



Comentários

AvatarEnviado por jonathandj em 02/07/2007 às 12:36

Legal ver um dos meus códigos rolando na net, mas gostaria de avisar que essa função passou por uma pequena modificação para melhoria de desempenho e opções, no link da fonte do código está atualizado
Obrigado e bom uso


Envio de comentário:




  

Quarta, 22 de Outubro de 2014




Top 5 membros

Últimos membros online

Últimos membros cadastrados



Capa do livro
Infra-Estrutura Elétrica para Rede de Computadores


Capa do livro
Linux - Controles de Redes


Capa do livro
Java com Orientação a Objeto





Hostnet

IMD