Plocka ut länk och ta bort kod!?

[ravenjaur]

Använder dena function för att plocka ut länkar.

 

Function Webadress(sText_Lank)

'G–r om radbrytningar till taggar
	sText_Lank = Replace(sText_Lank, vbCrLf, "<br>")

'Startposition f–r s–kning
	iAktuellPosition = 1

'Loopar igenom tils alla l”nkar hittats
   		Do While InStr(iAktuellPosition, sText_Lank, "http://", 1) <> 0 

       'Antal tecken till l”nkens start
       	iAdressStart = InStr(iAktuellPosition, sText_Lank, "http://", 1)

       'Kollar om slutet av l”nken ”r ett mellanrum
       	iAdressSlut = InStr(iAdressStart, sText_Lank, " ", 1)

       'Om slutet inte ”r ett mellanrum, kollas radbrytning
      	 If iAdressSlut = 0 Then

		'Antal tecken
		iAdressSlut = InStr(iAdressStart, sText_Lank, "<", 1)		

	else

		'Kollar om str”ngen innehÂller radbrytning
		If instr(1, Mid(sText_Lank, iAdressStart, (iAdressSlut - iAdressStart)), "<br>") <> 0 Then

			'H”mtar ut r”tt position
			iAdressSlut = InStr(1, Mid(sText_Lank, iAdressStart, (iAdressSlut - iAdressStart)), "<", 1) + iAdressStart - 1

		End if

	End if

	'Om inget slut hittades ”r det slut p str”ngen
	If iAdressSlut = 0 Then

		'L”nkd till slutet
		iAdressSlut = Len(sText_Lank) + 1

	end if

	'Flaggar
	bKoll = False 

	'Loopar tills str”ngen ”r ok
	Do until bKoll = True

		'Hittas ett felaktigt tecken tas det bort
		Select Case Mid(sText_Lank, iAdressSlut - 1, 1)

		    Case ".", ",", "!", "?", ")", "(", "]", "[", "@", "#", "£", "§", "$", "\", "'", "*"  

		    	'Minskar med 1
		    	iAdressSlut = iAdressSlut - 1     

			Case else

				'Flaggar f–r stopp
				bKoll = True

		End Select

	Loop 

'Bygger p text 

       sText = sText & Mid(sText_Lank, iAktuellPosition, iAdressStart - iAktuellPosition)

       'H”mtar ut l”nken
       sAdress = Mid(sText_Lank, iAdressStart, iAdressSlut - iAdressStart)


       'S”tter ihop allt

sText = sText & "<a href=""" & sAdress & """ target=""new"" title=""" & sAdress & """ class=""ny""><b>» Link</b></a>"

       '÷verf–r position

iAdressSlut = Server.HTMLEncode(iAdressSlut)

       iAktuellPosition = iAdressSlut

   Loop


'Byter tillbaks radbrytningar
'sText = Replace(sText, "<br>", vbCrLf)

'sText = Server.HTMLEncode(sText)

'L”gger p slutet
sText = sText & Mid(sText_Lank, iAktuellPosition)

'Byter tillbaks radbrytningar
'sText = Replace(sText, "<br>", vbCrLf)

'÷verf–r
Webadress = sText

'sText = Server.HTMLEncode(sText)

End Function 

 

Har stängt av några rader med ' så nu plockar den ut länken och gör radbryningar.

 

Försöker att få den att plocka ut länk, köra HTMLEncode, och ändå ha kvar radbrytningarna. någon som har någon ide eller en liknade Funktion. eller ska jag först köra ett funktion för att kolla html och sen länk och radbryt!?

 

 

[inlägget ändrat 2008-09-28 19:04:39 av ravenjaur]

[Jonas__B]

Hur ser datan ut? Är radbrytningarna i HTML (<br>) eller som ett vbcrlf ?

Det skall alltså vara tillåtet med radbryt mitt i en länk?

 

Fast jag hade hellre sett att du använd regexp för att identifiera url-er och göra länkar av dem. Den funktion du använder ser lite för omständig ut.

 

Kolla in denna sida: http://www.4guysfromrolla.com/webtech/043001-1.shtml

[inlägget ändrat 2008-09-29 11:49:33 av Jonas_Bo]