webForumDet fria alternativet

Användbar funktion!!! för de som vill kunna .......

ASP

0 svar · 210 visningar · startad av PatrikB

Medlem sedan mars 20002 836 inlägg
Frågan#1

...... "stänga" av html-kodning i tex inlägg i en gästbok, fast alla urler som besökaren skriver och börjar med http:// eller www ska bli klickbara länkar.

Håll till godo .... och .... hittar ni några buggar .... säg till!

'=================================================================
' 						© COPYRIGHT INFO
'-----------------------------------------------------------------
' Functions created by Patrik Berggren @ ZWGdesign - May 15, 2000.

' CONTACT INFO:
'--------------

'	HOMEPAGE: 	 [url="http://zwgdesign.webhostme.com"]http://zwgdesign.webhostme.com[/url] 
'	MAIL: 			mrwize@mail.bip.net
'	PHONE: 			+46 224 500 02
'	GSM(Cellular): 	+46 70 403 14 91
'	SNAIL MAIL:		Grusasvagen 5
'					SE-733 97  SALA, SWEDEN
			
'=================================================================

' SOME NOTES!!!!
'***************************************************************

' FUNCTION CODE STARTS HERE ------------------------
'***************************************************

' Check for url, ex: [url="http://www.mysite.com"]http://www.mysite.com[/url]  in string
' and convert to a clickable hyperlink.
'---------------------------------------------------
Function getUrl(gString)

	Dim gmyUrlArr
	Dim i
	Dim gmyNewUrl

	gmyUrlArr = Split(gString," ")

	For i = 0 to UBound(gmyUrlArr)

		gmyNewUrl = gmyUrlArr(i)

		If Left(gmyNewUrl,7) = "http://" or Left(gmyNewUrl,7) = "HTTP://" Then

			gmyNewUrl = "<a href=" & chr(34) & gmyNewUrl & chr(34) & " target= " & chr(34) & "_blank" & chr(34) & ">" & Right(gmyNewUrl,Len(gmyNewUrl) - 7) & "</a>"
			gString = Replace(gString,gmyUrlArr(i),gmyNewUrl)

		ElseIf Left(gmyNewUrl,3) = "www" or Left(gmyNewUrl,3) = "WWW" Then

			gmyNewUrl = "<a href=" & chr(34) & "http://" & gmyNewUrl & chr(34) & " target= " & chr(34) & "_blank" & chr(34) & ">" & gmyNewUrl & "</a>"
			gString = Replace(gString,gmyUrlArr(i),gmyNewUrl)

		Else

			gmyNewUrl = Server.HTMLEncode(gmyUrlArr(i))
			gString = Replace(gString,gmyUrlArr(i),gmyNewUrl)

		End If

	Next

	' Clear the Array
	'----------------
	gmyUrlArr = ""

	getUrl = gString

	' Clear the String
	'-----------------
	'gString = ""
	i = 0

End Function

'*******************************************
' Decode getUrl String, for editing purposes
'-------------------------------------------
Function putUrl(pString)

	'plocka bort delar av länk-html-taggarna
	pString = Replace(pString,"<a","")
	pString = Replace(pString,"href=" & chr(34),"")

	' Dela strängen i mindre delar för att kunna
	' hitta vart länkarna har börjat, dvs, de har en
	pUrlArr = Split(pString," ")

	For i = 0 To UBound(pUrlArr)

		' plocka bort alla dubbel fnuttar
		If Left(pUrlArr(i),7) = "http://" Then

			pUrlArrTmp = Replace(pUrlArr(i),"http://","")
			pUrlArrTmp = Replace(pUrlArr(i),chr(34),"")
			
			pUrlArr(i) = pUrlArrTmp

		End If

		If Left(pUrlArr(i),7) = "target=" Then

			pUrlArrTmp = ""
			pUrlArr(i) = pUrlArrTmp

		End If

		If Left(pUrlArr(i),7) = chr(34) & "_blank" Then

			pUrlArrTmp = ""
			pUrlArr(i) = pUrlArrTmp

		End If

		tmpString = tmpString & " " & pUrlArr(i)

	Next

	putUrl = tmpString

End Function

'********************************************************
' FUNCTION CODE END HERE --------------------------------

%>

Hoppas att ni kommer att ha lite nytta av det,

/PatrikB

PS vill gärna att ni testar det, vet aldrig när "buggen" e framme DS

250 ms totalt · 4 externa anrop · v20260731065814-full.1dc6f849
118 ms — deklarationer (db)
0 ms — hämta statistik (cache)
127 ms — hämta tråd, inlägg och bilagor (db)
120 ms — ändringar (db)