Länkarna blir lite knasiga

1 svar · 224 visningar · startad av G8 28 okt. 2004

G8Medlem sedan jan. 20011 213 inlägg

Frågan28 okt. 2004 16:29#1

Kör med denna kod för att få till länkarna, samt kapa av ord som är längre än 35 bokstäver:

   Function FixChar(Str)
    Str = Replace(Str,VbCrLf,VbCrLf&" <br> ")
	Str = Replace(Str,"'", "''")
	Str = Replace(Str,"|", "")

    HyperArray = Split(Str)
    For Each Link in HyperArray
     If Len(Link) > 7 Then
      If Lcase(Left(Link,7)) = "http://" Then
	  If Len(Link) > 35 Then
    	Link2 = Left(Link, 22) & "..." & Right(Link, 10)
		else
		link2 = link
		End If
       Str2 = Str2 & "<a href="""&Link&""">"&Link2&"</a> "
      ElseIf InStr(Link,"@") > 1 Then
       Str2 = Str2 & "<a href=""mailto:"&Link&""">"&Link&"</a> "
      Else
       Str2 = Str2 & Link &" "
      End If
     Else
      Str2 = Str2 & Link &" "
     End If
    Next
    FixChar = Str2
    Str2 = ""
    End Function

'##Radbrytning efter 35 bokstäver i rad, utan mellanrum
Function Strang(ByVal OriginalString)
OriginalString = "" & OriginalString
intMaxLength = 35
arrString = Split(OriginalString, " ")
For intIndex = 0 To UBound(arrString)
If Len(arrString(intIndex)) > intMaxLength Then
intSIndex = 0
While intSIndex < (Len(arrString(intIndex)) / intMaxLength)
splittOrd = splittOrd & Mid(arrString(intIndex), (1 + intSIndex * intMaxLength), intMaxLength) & "<br>"
intSIndex = intSIndex + 1
Wend
arrString(intIndex) = splittOrd
End If
strNewString = strNewString & arrString(intIndex) & " "
Next
Strang = strNewString
End Function

Skriver sedan ut från databasen med:

<%=Smileyreplace(fixChar(strang(rs("svar"))))%>

Problemet uppstår då man lägger in en läng länk, då denna också kapas av, och blir allmänt knasig.

Om jag skriver in t.ex. http://www.webforum.nu/newthread.php?s=&action=newthread&forumid=22 så skapar den en länk som är korrekt (http://www.webforum.nu...>id=22) men själva URL:en ser ut så här: http://www.webforum.nu/newthread.ph<br>p?s=&action=newthread&forum<br>id=22<br>

Jag vill att den ska exkludera ord som börjar på http:// och ord som innehåller @, men kolla all annan text... hur göra?

DenkanMedlem sedan juni 2002256 inlägg

28 okt. 2004 19:53#2

Skrev ihop följande av gamla funktioner.

<%

' ---------------------------------------------------
' ### SKAPAR LÄNKARNA OCH DELAR ORD

Private Function fixString(str,int)
Dim sStr, part, i, pos, myStr
str = Replace(str, vbCrLf, " " &vbCrLf)
sStr = Split(str, " ")
	
For i=0 To Ubound(sStr)
part = sStr(i)
Dim isURL
isURL = False
	
	' # HTTP
	If Len(part) > 12 Then
		If Left(LCase(part),7) = "http://" AND InStr(Right(part,Len(part)),".") > 0 Then
		part = "<a href=""" &part& """ target=""_blank"">" &max_l(part,int)& "</a>"
		isURL = True
		End If
	End If

	' # WWW
	If Len(part) > 8 Then
   	If Left(LCase(part),4) = "www." AND InStr(Right(part,Len(part)-5),".") > 0 Then
   	part = "<a href=""http://" &part& """ target=""_blank"">" &max_l(part,int)& "</a>"
		isURL = True
		End If
	End If

	' # FTP
	If Len(part) > 11 Then
   	If Left(LCase(part),6) = "ftp://" AND InStr(Right(part,Len(part)-8),".") > 0 Then
   	part = "<a href=""" &part& """ target=""_blank"">" &max_l(part,int)& "</a>"
		isURL = True
		End If
	End If

	' # IRC
	If Len(part) > 11 Then
   	If Left(LCase(part),6) = "irc://" AND InStr(Right(part,Len(part)-8),".") > 0 Then
   	part = "<a href=""" &part& """ target=""_blank"">" &max_l(part,int)& "</a>"
		isURL = True
		End If
	End If

	' # E-MAIL
	If Len(part) > 5 Then
		If InStr(part,"@") > 1 AND InStr(Right(part,Len(part)-InStr(part,"@")),".") > 2 Then
		part = "<a href=""mailto:" &part& """>" &max_l(part,int)& "</a>"
		isURL = True
		End If
	End If
	

	If isURL = False Then
		If Len(part) > int Then
		part = Left(part,int)& "<br />" &Mid(part,int)
		End If
	End If

myStr = myStr& " " &part
Next

fixString = myStr
End Function

' ---------------------------------------------------
' ### FIXAR LÄNKENS INNEHÅLL

Private Function max_l(str,l)
	If Len(str) > l then
	max_l = Left(Server.HTMLEncode(str), l)& "... "
	Else
	max_l = str
	End If
End Function

' ---------------------------------------------------
Dim str
str = ""		' Din text

Response.Write(fixString(str,35))

%>