webForumDet fria alternativet

html funktion

ASP

13 svar · 653 visningar · startad av MHZ

Medlem sedan apr. 200555 inlägg
Frågan#1

Jag får inte länkar att skrivas ut men vet inte felet?

funktion

Function Lankar(s)

On error resume next
Set objRE = new RegExp 
objRE.IgnoreCase = True : objRE.Global = True 
objRE.Pattern = "(http:\/\/|www\.)(\w|\&|\:|\;|\.|\/|\?|\~|\=|-)+"
Set m = objRE.Execute(s) 
For Each o In m 
If Right(o.Value, 1)="." Or Right(o.Value, 1)="!" Or Right(o.Value, 1)="?" Or Right(o.Value, 1)="," Then 
If Left(o.Value, 3) = "www" Then s = Replace(s, o.Value, "<A HREF=""http://" & Left(o.Value, Len(o.Value)-1) & """ target=""_blank"">" & Left(o.Value, Len(o.Value)-1) & "</A>" & Right(o.Value, 1)) Else s = Replace(s, o.Value, "<A HREF=""" & Left(o.Value, Len(o.Value)-1) & """>" & Left(o.Value, Len(o.Value)-1) & "</A>" & Right(o.Value, 1)) 
Else 
If Left(o.Value, 3) = "www" Then s = Replace(s, o.Value, "<A HREF=""http://" & o.Value & """ target=""_blank"">" & o.Value & "</A>") Else s = Replace(s, o.Value, "<A HREF=""" & o.Value & """ target=""_blank"">" & o.Value & "</A>") 
End If 
Next 
Set objRE = Nothing 

	' Tillåten HTML kod
s    = Replace(s,"[f]","<b>")
s    = Replace(s,"[/f]","</b>")
s    = Replace(s,"[k]","<i>")
s    = Replace(s,"[/k]","</i>")
s    = Replace(s,"[farg]","<font color=#800000>")
s    = Replace(s,"[/farg]","</font>")
s    = Replace(s, vbCrLf, "<br>") 
s    = Replace(s,"","")

Lankar = s 

End Function

Skriver ut med:

str_objRs_post_text = Lankar(objRs.Fields(8).Value)

Sen:

<%=str_objRs_post_text%>

:q :q :q

Medlem sedan juni 20019 519 inlägg
#2

1. Vad försöker du slänga in i funktionen (objRs.Fields(8).Value)
2. får du ut någon data alls?

red.

Jag har testat din funktion med följande texter:

och samtliga fungera för mig.

Medlem sedan apr. 200555 inlägg
#3

Det är ett forum jag hämtat (eforum) där jag skulle villa ha funktionen att det blir klickbarart om man skriver in en länk.

Som jag försöker verkar det inte fungera alls.

Medlem sedan juni 20019 519 inlägg
#4

vad är det för URL du försöker använd som inte fungera för dig då? [f] delarna fungera för mig med (om man inte skriver [F]).

Medlem sedan apr. 200555 inlägg
#5

Det sker ingenting alls. Den skriver bara in txt som vanligt i mdb så det verkar som att nått sätter stopp för funktionen

Medlem sedan juni 20019 519 inlägg
#6

Vad försöker du rendera för data då? Ditt skript fungera för mig utan några problem, den gör om länkarna jag har testat, gjort texten fet...

Medlem sedan apr. 200555 inlägg
#7

Det är ett inlägg i forumet som inte vill funka med detta.

Smileys gick bra???? Fattar bara inte för det funkar för mig i gästboken utan problem.

Med detta går smileys men inte länkarna

str_objRs_post_text			= FixaLankar(Smileys(objRs.Fields(8).Value))
Medlem sedan juni 20019 519 inlägg
#8

Det är... Fortfarande inte något fel med din funktion den fungera på enklare länkar... vad är det för länk som inte fungera.. förmodligen matchar inte ditt RegExp uttryck för den länken... Men enklare länkar (de 3 exemplen jag har skrivit i tidigare inlägg) fungera. Att bara skriva "det fungera inte" hjälper ju inte oss att veta vad som inte fungera, jag har gjort tester och dom fungera... så utan mer hjälp från dig på vad som inte fungera: Tydligt exempel så kommer man inte vidare i din fråga.

Jag kan bara gissa just nu, men länkar med # kommer inte att fungera bland annat.
och för övrigt så kan du gruppera istället för att använda |:

([\w&:;\.\/?~=\-#])+

(nu är det med #)

Medlem sedan apr. 200555 inlägg
#9

Jag har provat på samma sätt som dig. Det finns en funktion som jag inte förstår helt och det är "pattern"

Den finns redan i koden förr. Kan det krocka där? Här ser du hur hur det ser ut om det är nått som blir fel där.

Jag vet inte riktigt hur jag ska visa det på bästa sätt. Den andra funktionen är ju till forum svar så det är nog fel tänkt ändå. :r

function NewText( ByVal Text )

		'// Kör HTMLEncode och sätt ut radbrytningar
		Text	= Server.HTMLEncode( Text )
		Text	= Replace( Text , vbCrLf , "<br>" )

		With new RegExp

			.IgnoreCase	= True
			.Global		= True

			'// RegExp för citera
			.Pattern	= "\&lt; *quote(?:( *name *= *(?:&quot;)*(.*?)(?:&quot;)*)){0,1} *&gt;(?:\<br\>)*(.*?)(?:\<br\>)*\&lt;/quote *&gt;"
  			Text		= .Replace( Text ,""&_
						  "<div style = ""margin-left:20px; margin-right:20px; border: 1px solid #cccccc; borderpadding-bottom:5px;"">"&_
						  "<div style = ""background-color: #ffffea; font-weight: bold; color: #666666;"">"&_
						  "Citerar $2:"&_
						  "</div>"&_
						  "<em style = ""background-color: #ffffea;color: #666666; height: 0px; width: 100%;"">$3</em></div>")
			
			.Pattern	= "\&lt; *quote(?:( *name *= *(?:&quot;)*(.*?)(?:&quot;)*)){0,1} *&gt;(?:\<br\>)*(.*?)(?:\<br\>)*(?:\&lt;/quote *&gt;)*"
  			Text		= .Replace( Text ,"<br>"&_
						  "<div style = ""margin-left:20px; padding-bottom:5px;"">"&_
						  "<div style = ""padding-left:5px; background-color: #ffffea; font-weight: bold; color: #666666;"">"&_
						  "Citerar $2:"&_
						  "</div>"&_
						  "<em style = ""color: #666666; height: 0px; width: 100%;"">$3")
  			
  			.Pattern	= "(:?\(?:&lt; *quote(?:( *name *= *(?:&quot;)*(.*?)(?:&quot;)*)){0,1} *&gt;(?:\<br\>)*(.*?)(?:\<br\>)*)*\&lt;/quote *&gt;"
  			Text		= .Replace( Text ,"</em></div>")
			
			'// Max 2 radbrytningar efter varandra
			.Pattern	= "(?:\<br\>){3,}"
  			Text		= .Replace( Text ,"<br>")
			
		End With
		
		NewText	= Text

	end function
	
'''''''''''''''''''''''''''''''''''''''''''''
Function FixaLankar(s)
On error resume next
Set objRE = new RegExp 
objRE.IgnoreCase = True : objRE.Global = True 
objRE.Pattern = "(http:\/\/|www\.)(\w|\&|\:|\;|\.|\/|\?|\~|\=|-)+"
Set m = objRE.Execute(s) 
For Each o In m 
If Right(o.Value, 1)="." Or Right(o.Value, 1)="!" Or Right(o.Value, 1)="?" Or Right(o.Value, 1)="," Then 
If Left(o.Value, 3) = "www" Then s = Replace(s, o.Value, "<A HREF=""http://" & Left(o.Value, Len(o.Value)-1) & """ target=""_blank"">" & Left(o.Value, Len(o.Value)-1) & "</A>" & Right(o.Value, 1)) Else s = Replace(s, o.Value, "<A HREF=""" & Left(o.Value, Len(o.Value)-1) & """>" & Left(o.Value, Len(o.Value)-1) & "</A>" & Right(o.Value, 1)) 
Else 
If Left(o.Value, 3) = "www" Then s = Replace(s, o.Value, "<A HREF=""http://" & o.Value & """ target=""_blank"">" & o.Value & "</A>") Else s = Replace(s, o.Value, "<A HREF=""" & o.Value & """ target=""_blank"">" & o.Value & "</A>") 
End If 
Next 
Set objRE = Nothing 

	' Tillåten HTML kod
s    = Replace(s,"[f]","<b>")
s    = Replace(s,"[/f]","</b>")
s    = Replace(s,"[k]","<i>")
s    = Replace(s,"[/k]","</i>")
s    = Replace(s,"[farg]","<font color=#800000>")
s    = Replace(s,"[/farg]","</font>")
s    = Replace(s, vbCrLf, "<br>") 
s    = Replace(s,"","")

FixaLankar = s 

End Function
Medlem sedan juni 20019 519 inlägg
#10

Om du aldrig anropar NewText funktionen så spelar det ingen roll om du har den koden "innan" eller inte... Hur ser det ut innan du försöker anropar din funktion FixaLankar? Vad har du för in-värden i funktionen? Gör du något med 'str_objRs_post_text' Efter du har kört funktionen (dvs gör du något mer än bara skriva ut den?)

Medlem sedan apr. 200555 inlägg
#11

Jag har variabeln så här:

str_objRs_post_text= FixaLankar(Smileys(objRs.Fields(8).Value))

Så skriver jag ut det med för huvudämnet

str_objRs_post_text

För svaren

<%=FixaLankar(Smileys(NewText(objRs.Fields(8).Value)))%>

Funktionen smileys ligger på samma ställe och den fungerar.

Medlem sedan juni 20019 519 inlägg
#12

"På samma ställe"? du menar i samma fil? en funktion spelar ju inte någon roll om den ligger i samma fil eller inte. NewText gör ju vissa delar som även FixaLankar också gör, känns lite onödigt:

Skapar en ny sida
inkludera dina funktioner i den
ta samma inlägg som du har problem med ifrån din databas (eftersom du inte ge oss mycket att jobba med här).

Kör in den texten i en variabel

och kör din funktion. och se vilken av dina funktioner som ställer till det. Du skall kanske få igång en av dina funktioner innan du lägger in ännu fler.

Medlem sedan apr. 200555 inlägg
#13

Hittade en annan länk funktion som verkar fungera bättre. Ända problemet som jag inte får till är att länken - tex https://www.svt.se. Den ger inte rätt länk.

Resultatet blir: http://localhost/forum/www.svt.se

Nån som vet vad i den som styr det?

<%
Function lankkod(lank)
    Dim objRE

    Set objRE = New regexp
    objRE.Global = true
    objRE.IgnoreCase = true
    
    objRE.Pattern = "(www.[^ ]*[a-z])|(http://[^ ]*[a-z])"
    lank = objRE.Replace(lank,"<a href=""$1$2"" target=""_blank"">$1$2</a>")
    lank = Replace(lank,"""www""","""http://www&quote""")
    lank = Replace(lank,"""http://www""","""www""")
    lank = Replace(lank, vbcrlf, "<br>" & vbcrlf)
    lankkod = lank
End Function
%>
Medlem sedan juni 20019 519 inlägg
#14

Hela den funktionen känns helt fel. Den är verkligen "fel". Botten delen med replace kommer ju aldrig att köras med dina &quote; och "" i slutet av en www
vbcrlf replacen tycker jag du INTE skall placera in i en sådan funktion som skall omvandla länkar till klickbara länkar, flytta denna kod till dina andra funktioner du kör

<%
Function lankkod(lank)
	Dim objRE
	
	Set objRE = New regexp
	objRE.Global = true
	objRE.IgnoreCase = true
	
	objRE.Pattern = "\b((?:www\.|https?:\/\/)[^\s]+)\b"
	lank = objRE.Replace(lank,"<a href=""$1"" target=""_blank"">$1</a>")
	lank = replace(lank, """www", """http://www")
	lankkod = lank
End Function
%>

bör fungera har inte testat den dock.

272 ms totalt · 4 externa anrop · v20260731065814-full.e96017d9
121 ms — deklarationer (db)
0 ms — hämta statistik (cache)
141 ms — hämta tråd, inlägg och bilagor (db)
127 ms — ändringar (db)