Criar links dinamicamente

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](http://conteudo.imasters.com.br/1269/logo.png) e aqui o link do meu site: [http://www.allmarketweb.com/jonathandj
Uma](http://www.allmarketweb.com/jonathandj) nova linha e outro link: [https://webp.caixa.gov.br/cidadao/Crf/FgeCfSCriteriosPesquisa.asp](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))
%>