---
title: "Länkarna blir lite knasiga"
type: "forum-thread"
url: "https://www.webforum.nu/amne/asp/114624-länkarna-blir-lite-knasiga"
topic: "ASP"
topic_url: "https://www.webforum.nu/amne/asp"
author: "G8"
published: "2004-10-28T16:29:41.000Z"
updated: "2004-10-28T19:53:12.000Z"
replies: 1
views: 230
page: 1
pages: 1
language: "sv-SE"
site: "webForum — webforum.nu"
rights: "Upphovsrätten till varje inlägg tillhör dess författare."
attribution: "Citera som: webForum, https://www.webforum.nu/amne/asp/114624-länkarna-blir-lite-knasiga"
---

# Länkarna blir lite knasiga

## #1 — G8, 2004-10-28T16:29Z

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?

Permalänk: https://www.webforum.nu/p/114624

## #2 — Denkan, 2004-10-28T19:53Z

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))

%>
```

Permalänk: https://www.webforum.nu/p/1472930

---

Tråden på webben: https://www.webforum.nu/amne/asp/114624-länkarna-blir-lite-knasiga
