Esta função é interessante se você quiser deixar que o usuário crie links e email para determinadas palavras. Não precisando deixar as tags html (própriamente ditas) a merce do usuário.
restringindo funções e trocando por outras de sua preferência:
----------------------------
utilizando as tags [k] e [/k] é possível linkar os texto conforme sua necessidade:
observe:
se digitar [k]guardiao@terra.com.br[/k]
o texto automáticamente se tornará um link para email
se digitar k]Palavra$www.site.com.br[/k]
o texto Palavra se tornará um link para http://www.site.com.br
se digitar [k]Cezinha$seunome@site.com.br[/k]
o texto Palavra se tornará um link para o email seunome@site.com.br
se digitar diretamente http://www.seusite.com.br
E já se tornará um link.
Só não pode ter um nada encostado junto do .br, caso contrário ele imagina que seja parte do endereço também.
Para quem quiser ver funcionando...
No meu site:
http://www.guardiaodaweb.com.br
No texto blog
-------------------
Function Linker(strInput)
Dim iCurrentLocation
Dim iLinkStart
Dim iLinkEnd
Dim strLinkText
Dim strOutput
iCurrentLocation = 1
Do While InStr(iCurrentLocation, strInput, "http://", 1) <> 0
iLinkStart = InStr(iCurrentLocation, strInput, "http://", 1)
iLinkEnd = InStr(iLinkStart, strInput, " ", 1)
If iLinkEnd = 0 Then iLinkEnd = Len(strInput) + 1
Select Case Mid(strInput, iLinkEnd - 1, 1)
Case ".", "!", "?"
iLinkEnd = iLinkEnd - 1
End Select
strOutput = strOutput & Mid(strInput, iCurrentLocation, iLinkStart - iCurrentLocation)
strLinkText = Mid(strInput, iLinkStart, iLinkEnd - iLinkStart)
finalUrl = LCase(right(strLinkText,4))
if finalUrl = ".gif" or finalUrl = ".jpg" then
strOutput = strOutput & "<IMG SRC='"& strLinkText &"' VSPACE='5' HSPACE='5' BORDER='0'>"
else
'strOutput = strOutput & "<A HREF=""" & strLinkText & """>" & strLinkText & "</A>"
strOutput = strOutput & "<A HREF=""" & strLinkText & """ target=""_blank"">" & strLinkText & "</A>"
end if
iCurrentLocation = iLinkEnd
Loop
strOutput = strOutput & Mid(strInput, iCurrentLocation)
Tekst_temp = strOutput
i = 1
WHILE NOT InStr(i,Tekst_temp,"[k]") = 0
start = CInt( InStr(1,Tekst_temp,"[k]") )
i = start
slutt = CInt( InStr(start,Tekst_temp,"[/k]") )
hole = mid(Tekst_temp,(start),(slutt-start+4))
'linkar uma palavra
IF InStr(hole,"$") THEN
skille = CInt( InStr(start,Tekst_temp,"$") )
'se quiser que uma determinada palavra fique linkada coloque
'palavra $ seguido do endereço http://
navn = mid(Tekst_temp,(start+3),(skille-start-3))
link = mid(Tekst_temp,(skille+1),(slutt-skille-1))
IF NOT InStr(link,"@") = 0 THEN 'se for email
link = "mailto:" & link
ELSE
IF Left(link,4) = "www." THEN ' caso tenha www
link = "http://" & link
ELSE 'se não tiver www
link = "http://" & link
END IF
END IF 'fim do @
'out_var = "<A HREF=""" & link & """>" & navn & "</A>"
out_var = "<A HREF=""" & link & """ target=""_blank"">" & navn & "</A>"
Tekst_temp = Replace(Tekst_temp,hole,out_var,1,1)
ELSE
'aqui start+???? significa a quantidade de caracter
link = mid(Tekst_temp,(start+3),(slutt-start-3))
IF Left(link,4) = "www." THEN
link = "http://" & link
END IF 'www
IF NOT InStr(link,"@") = 0 THEN
link = "mailto:" & link
END IF '@
'link = "<A HREF=""" & link & """>"
link = "<A HREF=""" & link & """ target=""_blank"">"
Tekst_temp = Replace(Tekst_temp,"[k]",link,1,1)
Tekst_temp = Replace(Tekst_temp,"[/k]","</A>",1,1)
END IF
WEND
Linker = Tekst_temp
End Function
------------------------------
Função original: carlosjr@imasters.com.br
Adaptação: guardiao@guardiaodaweb.com.br
". Hoje, vai saber...
0 comentários:
Postar um comentário