Gracias, la he puesto bonita y todo:
<%
function cortar(texto,maximo_numero)
' Sintaxis: cortar (texto,maximo_numero)
' texto = cadena de texto
' maximo_numero = número de caracteres a mostrar
' al final se añaden 3 puntos "..."
' Función para vuestro disfrute por u_goldman y sanfermin
'
www.portalurbano.com
' no quites estas lineas :)
Dim ArrPalabra 'Array con las palabras
Dim contar_caracter 'Posición con la q se recorre el array
Dim texto_nuevo 'Guardamos el texto reformateado y cortado
'Convierto los retornos de carro y las tabulaciones en espacios
texto = Replace (texto, VbCr, " ")
texto = Replace (texto, VbLf, " ")
texto = Replace (texto, VbCrLf, " ")
texto = Replace (texto, VbTab, " ")
'Elimino el espacio en blanco de antes y después
texto = Trim(texto)
'Recorro la cadena y voy reduciendo los múltiples espacios a uno solo
while InStr(1, texto, " ", 1)
texto = Replace(texto, " ", " ")
wend
arrPalabra= split(texto, " ")
contar_caracter=0
texto= ""
For i=0 to uBound(arrPalabra)
contar_caracter= contar_caracter + len(arrPalabra(i))
If not contar_caracter > maximo_numero Then
texto_nuevo = texto_nuevo & " " & arrPalabra(i)
Else
Exit For
End If
Next
cortar = texto_nuevo & "..."
end function
texto= "En un lugar cuyo nombre no quiero acordarme"
response.write(cortar(texto,30))
%>