Criar links dinamicamente

[jrcardozo 4]

Procura no texto se existe alguma url e imprime somente o necesário. A função verifica se é uma url de FTP, HTTP, HTTPS e se for uma URL de uma imagem imprime a imagem na tag IMG

<%
Function criaLink(strVar)
 'autor: Jonathan R. Cardozo (jonathandj)
 'data: 27/05/2007
 'data atualização: 15/02/2008
 'finalidade: criar links de forma dinâmica e mostrar imagem quando a url não for um site
 '
 'Tratamos a string caso tenha alguma tag html
 strVar = replace(strVar,"<"," <")
 strVar = replace(strVar,">","> ")
 'quebramos a string e transformamos em um array
 arr = split(strVar," ")
 'varremos o array em busca de links
 for i = 0 to uBound(arr)
  strAux = trim(arr(i))
  pos = 0
  'verificamos se na palavra da posição atual do array contem alguma dessas strings que compõem uma url
  if pos = 0 then pos = inStr(lCase(arr(i)),"https://")
  if pos = 0 then pos = inStr(lCase(arr(i)),"http://")
  if pos = 0 then pos = inStr(lCase(arr(i)),"ftp://")
  if pos = 0 then pos = inStr(lCase(arr(i)),"www")
  'se existe string de url então vamos tratar o texto que será impresso em tela
  if pos <> 0 then
   strTxt = mid(strAux,pos,len(strAux))
   pos = inStr(strTxt,"/")
   'se a url tem http ou https reposicionamos o inicio da impressão e retratamos o final
   if pos > 0 and (inStr(lCase(arr(i)),"https://")<>0 or inStr(lCase(arr(i)),"http://")<>0 or inStr(lCase(arr(i)),"ftp://")<>0) then
	strTxt = mid(strAux,pos+2,len(strAux))
	posHttp = inStr(strTxt,"/")
	strTexto = mid(strTxt,1,posHttp-1)
   elseif pos > 0 and inStr(lCase(arr(i)),"www")<>0 then
	strTexto = mid(strTxt,1,pos-1)
   else
	'se não tem url na palavra na posição atual do array imprimimos sem criar nada
	strTexto = strTxt 
   end if
   'apenas um tratamento para evitar problemas na criação do link
   strAux = replace(strAux,"..","")
   strAux = replace(strAux,"??","")
   strAux = replace(strAux,"!!","")
   strAux = replace(strAux,",,","")
   strAux = replace(strAux,"--","")   
   'tratamos o final da url para redirar caracteres indesejados
   arr2 = split(". , - / \; ? ! @ % #"," ")
   char = right(strAux,1)   
   for j = 0 to uBound(arr2)
	if arr2(j) = char then
	 strAux = left(strAux,len(strAux)-1)
	end if
   next 
   pos = 0
   'verificamos o tipo de link que será criado
   if pos = 0 then pos = inStr(strAux,"https://")
   if pos = 0 then pos = inStr(strAux,"http://") 
   if pos = 0 then pos = inStr(strAux,"ftp://") 
   if pos = 0 then pos = inStr(strAux,"www") 
   strAux = mid(strAux,pos,len(strAux))  
   'procuramos se o link se é será imagem
   'pegamos o nome da ultima string depois da última barra /
   posImagem = instrrev(strTxt,"/")
   strImagem = mid(strTxt,posImagem+1)
   'procura pelo caracter ponto na ultima paralavra da url
   posImagem = instr(strImagem,".")
   strImagem = ucase(mid(strImagem,posImagem+1))   
   'se encontrou o ponto verificamos se pertence a uma extensão de imagem
   if (mid(strImagem,1,3) <> "JPG" and mid(strImagem,1,3) <> "GIF" and mid(strImagem,1,3) <> "PNG" and mid(strImagem,1,3) <> "BMP") or instr(strAux,"ftp://")<>0 then
	'imprime a url se não for imagem
	if instr(strAux,"http://")=0 and instr(strAux,"www")<>0 then strAux = "http://"&strAux
	strTxt = "<a href="""&lCase(strAux)&""" target=""_blank"">"&strTexto&"</a>"
   else
	'se o link não for de ftp, http ou https então imprime a imagem
	if instr(strAux,"ftp://")=0 then
	 if instr(strAux,"http://")=0 then strAux = "http://"&strAux
	 strTxt = "<img src="""&lCase(strAux)&""" height=""60"">"
	end if
   end if	 
  else
   'imprime texto sem link
   strTxt = strAux
  end if
  'concatena a variavel até o final do array
  saida = trim(" "&saida&" "& strTxt)
 next
 'saida da função com o tratamento desejado
 criaLink = saida
End Function
%>

exemplo de utilização

<%
meuTexto = "<br>www.google.com.br<br>acessem esse site<br>Logotipo do imasters: http://conteudo.imasters.com.br/1269/logo.png e aqui o link do meu site: http://www.allmarketweb.com/jonathandj<br>Uma nova linha e outro link: https://webp.caixa.gov.br/cidadao/Crf/FgeCfSCriteriosPesquisa.asp <br>www.conteudo.imasters.com.br/1269/logo.png ftp://conteudo.imasters.com.br/1269/logo.png"
Response.Write(criaLink(meuTexto))
%>

[DSerma 19]

Maraaaaaaaaaaavilha Albertoooooooooooooooooooooooo !!!! http://forum.imasters.com.br/public/style_emoticons/default/clap.gif

 

Execelente..

 

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

[gUiTaR_mAn 0]

lol

mando bem hein velho!

 

parabéns! http://forum.imasters.com.br/public/style_emoticons/default/thumbsup.gif

[Ted k' 126]

Agora sim rapaz!!! Esse Gaúcho não tem o que fazer, inventa (hauhauahuhaua)!!

 

Parabéns mais uma vez!!