Ver Mensaje Individual
  #75 (permalink)  
Antiguo 11/07/2005, 12:47
Avatar de Saruman
Saruman
 
Fecha de Ingreso: mayo-2003
Ubicación: Panama city, Panama, Panama
Mensajes: 1.154
Antigüedad: 21 años, 6 meses
Puntos: 5
Proósito: Convertir los los links e emails en links de html.

Utilización:

Código:
 
texto = "www.forosdelweb.com"
texto = InsertHyperlinks(texto) 
response.write(texto)

Funciones:

Código:
 
'Convierte los E-Mail's y los Links en enlaces
Function InsertHyperlinks(strInText, strEstilo)
Dim objRegExp, strBuf
Dim objMatches, objMatch
Dim Value, ReplaceValue, iStart, iEnd
 
strBuf = ""
iStart = 1
iEnd = 1
 
Set objRegExp = New RegExp
 
objRegExp.Pattern = "\b(www|http|\S+@)\S+\b"
objRegExp.IgnoreCase = True
objRegExp.Global = True
Set objMatches = objRegExp.Execute(strInText)
 
For Each objMatch in objMatches
iEnd = objMatch.FirstIndex
strBuf = strBuf & Mid(strInText, iStart, iEnd-iStart+1)
 
If InStr(1, objMatch.Value, "@") Then
	strBuf = strBuf & GetHref(objMatch.Value, "email", "_blank", strEstilo)
Else
	strBuf = strBuf & GetHref(objMatch.Value, "web", "_blank", strEstilo)
End If
 
iStart = iEnd+objMatch.Length+1
Next
 
strBuf = strBuf & Mid(strInText, iStart)
InsertHyperlinks = strBuf
End Function
 
 
Function GetHref(url, urlType, Target, strEstilo)
Dim strBuf
 
if strEstilo <> "" then strEstilo = "class=""" & strEstilo & """"
 
strBuf = "<a href="""
 
If urlType = "web" Then
If LCase(Left(url, 3)) = "www" Then
	strBuf = "<a href=""http://" & url & """ target=""" & Target & """ " & strEstilo & ">" & url & "</a>"
Else
	strBuf = "<a href=""" & url & """ target=""" & Target & """ " & strEstilo & ">" & url & "</a>"
End If
 
ElseIf UCase(urlType) = "email" Then
strBuf = "<a href=""mailto:" & url & """ target=""" & Target & """ " & strEstilo & ">" & url & "</a>"
End If
 
GetHref = strBuf
End Function
__________________
Saruman

One Ring to rule them all, One Ring to find them, One Ring to bring them all and in the darkness bind them.