webForumDet fria alternativet
Logga in / Bli medlem

Länk i forum, justering?

ASP

14 svar · 798 visningar · startad av brorsan

brorsanMedlem sedan nov. 2001402 inlägg
Frågan#1

Hej,

jag fick bra hjälp med kod för som skapar länkar i forum och kortar ned dem om de är för långa, men nu har jag hittat ett par problem som jag skulle behöva fixa, men vet inte hur.

Sak 1:
"Left(varArray( i ), 39)-biten" (egen gammal kod) gör så att om någon barnslig person skriver ett långt ord som riskerar att tabellen "trycks ut på bredden" så kapas detta till 39 tecken. t.ex. "blablablablablablablablablablablablablablablablablablablablablablablablablablablabla" kapas ned.

Problemet är att långa länkar också kapas på 39 tecken pga detta och slutar fungera på grund av det där, så jag vill helst ta bort "Left(varArray( i ), 39)-funktionen" helt. Eller göra så den bara träder in där det är ickelänkar.

Helst vill jag att "blablablablablablablablablablablablablabla" ska brytas precis som länkarna och istället bli "blablablablablabla ... blablablabla", alltså början och slutet visas, men som sagt om arraygrejen bara träder in där det är ickelänkar är det ok.

Sak 2:

Koden för länkar fungerar bra vid en enstaka länk om den är kortare än leftarraytalet, fast om man skriver 2 länkar i en post med några radbrytningar emellan fungerar bara den första länken, men man vill såklart att det ska gå att lägga in hur många som helst.

Se exempel på https://www.skate.nu/forum_topic_t.asp?id=32541 (där har jag höjt "Left(varArray( i ), 39" till 100 för att man ska se hur länkarna fungerar när den andra funktionen inte går in och kapar.

I post 3 visas bara första länken ok, fast båda länkarna är exakt likadana egentligen.

Sak 3:
Koden bör fungera om man både kör "blablablatexter" och länkar i samma. I post 2 på bifogad länk ser ni att en lång "wwwwww" utan länk gör att länken under inte fungerar (den är samma längd som fungerande länken i post 1)

Nån som förstår hur man ska göra?


Function ShortenLinkName(sHTML, lFirstLength, lLastLength)
	Dim objRegExp
	Set objRegExp = New RegExp
	objRegExp.Global = True
	objRegExp.IgnoreCase = True
	
	objRegExp.Pattern = "(<a [^>]+>)([\s\S]{" & lFirstLength & "}?)([\s\S]+?)([\s\S]{" & lLastLength & "}?)(</a>)"
	
	ShortenLinkName = objRegExp.Replace(sHTML, "$1$2&nbsp;...&nbsp;$4$5")
	Set objRegExp = Nothing
End Function

Function LinkURL(str)
	Dim objRegExp, strTemp
	Set objRegExp = New RegExp

	objRegExp.IgnoreCase = True
	objRegExp.Global = True
	objRegExp.Pattern = "(\b(www\.|http\://)\S+\b)"
	strTemp = objRegExp.replace(str, "<a href=""http://$1"" target=""_new"">$1</A>")
	LinkURL = Replace(strTemp, "http://http://","http://")
	Set objRegExp = Nothing
End Function


strNyText = ""
strText = rs("message")

varArray = split (strText, " ")
for i = 0 to ubound(varArray)
    strNyText = strNyText & Left(varArray( i ), 39) & " "
next

strComText = server.HTMLEncode(strNyText)
strComText = Replace(strComText,vbcrlf," <BR>")
strComText = LinkURL(strComText)
strComText = ShortenLinkName(strComText, 27, 12)

Response.Write strComText

response.write "</td>"
response.write "</tr>"
response.write "</table>"
end if

response.write "<img src=""images/grafic/pixel_grey.gif"" width=""462"" height=""1""><br>"

rs.movenext
Count = Count + 1
loop
voigtann1s avatarvoigtann1Medlem sedan juni 20019 519 inlägg
#2
<%
Function ShortenLinkName(sHTML, lFirstLength, lLastLength)
	Dim objRegExp
	Set objRegExp = New RegExp
	objRegExp.Global = True
	objRegExp.IgnoreCase = True
	
	objRegExp.Pattern = "(<a__[^>]+>)([\s\S]{" & lFirstLength & "}?)([\s\S]+?)([\s\S]{" & lLastLength & "}?)(</a>)"
	
	ShortenLinkName = objRegExp.Replace(sHTML, "$1$2&nbsp;...&nbsp;$4$5")
	Set objRegExp = Nothing
End Function

Function LinkURL(str)
	Dim objRegExp, strTemp
	Set objRegExp = New RegExp

	objRegExp.IgnoreCase = True
	objRegExp.Global = True
	objRegExp.Pattern = "(\b(www\.|http\://)\S+\b)"
	' __ kommer att bli mellanslag på länken i nästa funktion: shortenWords
	strTemp = objRegExp.replace(str, "<a__href=""http://$1""__target=""_new"">$1</a>")
	LinkURL = Replace(strTemp, "http://http://","http://")
	Set objRegExp = Nothing
End Function

Function shortenWords(str)
	Dim objRegExp, strTemp, returnString
	Set objRegExp = New RegExp

	objRegExp.IgnoreCase = True
	objRegExp.Global = True
	objRegExp.Pattern = "\s?([^\s]+)\s?"

	Set myMatches = objRegExp.Execute(str)
	For Each myMatch In myMatches
		'Om ordet börja med <a__ så skall vi ersätta alla __ i ordet till mellanslag, annars kontrollera vi längden och om ordet är längre än 39 tecken så korta vi ner den till 39 tecken. 
		If Not Left(LCase(myMatch.SubMatches(0)),4) = "<a__" Then
			If Len(myMatch.SubMatches(0)) >= 40 Then
				returnString = returnString & Left(myMatch.SubMatches(0),31) & "..." & right(myMatch.SubMatches(0),5)
			Else
				returnString = returnString & myMatch.SubMatches(0)
			End If
		Else
			returnString = returnString & Replace(myMatch.SubMatches(0),"__"," ")
		End If
		returnString = returnString & " "
	Next

	shortenWords = returnString
End Function

'Vi gör en test på allt:
str = "Hej på dig [url]http://www.bob.com[/url] adshbdskajfdbnsjkfnsdfjksnffghfghfghfghfghfghfghfgsdjkfnlsfdsjfsdnfjknsdfnlsdlfsldflnsdfnlsdnfsdfjfsdfjnlsdfld"

str = LinkURL(str)
str = ShortenLinkName(str, 27, 12)
str = shortenWords(str)

Response.Write str
%>

red. ShortenLinkName har en liten bugg om du lägger två länkar på raken där ena är lång och den andra en lite kortare url.

voigtann1s avatarvoigtann1Medlem sedan juni 20019 519 inlägg
#3
<%
Function ShortenLinkName(sHTML, lFirstLength, lLastLength)
	Dim objRegExp
	Set objRegExp = New RegExp
	objRegExp.Global = True
	objRegExp.IgnoreCase = True
	
	objRegExp.Pattern = "(<a [^>]+>)([\s\S]{" & lFirstLength & "}?)([\s\S]+?)([\s\S]{" & lLastLength & "}?)(</a>)"

	ShortenLinkName = objRegExp.Replace(sHTML, "$1$2...$4$5")
	Set objRegExp = Nothing
End Function

Function LinkURL(str)
	Dim objRegExp, strTemp
	Set objRegExp = New RegExp

	objRegExp.IgnoreCase = True
	objRegExp.Global = True
	objRegExp.Pattern = "(\b(www\.|http\://)\S+\b)"
	' __ kommer att bli mellanslag på länken i nästa funktion: shortenWords
	strTemp = objRegExp.replace(str, "<a__href=""http://$1""__target=""_new"">$1</a>")
	LinkURL = Replace(strTemp, "http://http://","http://")
	Set objRegExp = Nothing
End Function

Function shortenWords(sHTML, lFirstLength, lLastLength)
	Dim objRegExp, strTemp, returnString
	Set objRegExp = New RegExp

	objRegExp.IgnoreCase = True
	objRegExp.Global = True
	objRegExp.Pattern = "\s?([^\s]+)\s?"
	Set myMatches = objRegExp.Execute(str)
	For Each myMatch In myMatches
		'Om ordet börja med <a__ så skall vi ersätta alla __ i ordet till mellanslag, annars kontrollera vi längden och om ordet är längre än 39 tecken så korta vi ner den till 39 tecken. 
		If Not Left(LCase(myMatch.SubMatches(0)),4) = "<a__" Then
			If Len(myMatch.SubMatches(0)) >= 40 Then
				returnString = returnString & Left(myMatch.SubMatches(0),31) & "..." & right(myMatch.SubMatches(0),5)
			Else
				returnString = returnString & myMatch.SubMatches(0)
			End If
		Else
			'Vi anropar Eriks Funktion här inne istället.
			returnString = returnString & ShortenLinkName(Replace(myMatch.SubMatches(0),"__"," "),lFirstLength,lFirstLength)
		End If
		returnString = returnString & " "
	Next

	shortenWords = returnString
End Function

'Vi gör en test på allt:
str = "http://aaaasdasdasdasdasdsadasdaasdsadasdaasdsadasdaasdsadasdaasdsadasdaasdsadasdaasdsadasdaadddddddd.com [url]http://aaaasdasdasdasdasdsadasdaasdsadasdaasdsadasdaasdsadasdaasdsadasdaasdsadasdaasdsadasdaadddddddd.com[/url]  hej"

'str är rs("message")
str = LinkURL(str)
str = shortenWords(str, 27, 12)

Response.Write str
%>

Nu skall det fungera.

brorsanMedlem sedan nov. 2001402 inlägg
#4

Tack så mycket, det där ser ut att vara mycket och jobbigt, men jag har provat att klistra in det på ett gäng olika ställen och det blir alltid olika fel, för jag är inte säker på hur det ska in och vilket av det gamla som ska bort.

Beroende på hur jag testar blir det alltid längre från att fungera än ursprungliga lösningen (säkert nåt jag själv gör fel).

Skulle du kopiera de två rutor jag klistrat in och själv klistra in två rutor, en ruta med functionsakerna med "tillbehör" och en annan ruta med resten, inklusive for - next -kommandot och rs move-next kommandot på rätt ställen och exklusive det som ska tas bort av det gamla?

voigtann1s avatarvoigtann1Medlem sedan juni 20019 519 inlägg
#5

De gamla funktionerna skall bort och din nya sida skall se ut något liknande:

strText = rs("message")

strText = server.HTMLEncode(strText)
strText = Replace(strText,vbcrlf," <BR>")
strText = LinkURL(strText)
str = shortenWords(strText, 27, 12)

Response.Write strText

response.write "</td>"
response.write "</tr>"
response.write "</table>"
end if

response.write "<img src=""images/grafic/pixel_grey.gif"" width=""462"" height=""1""><br>"

rs.movenext
Count = Count + 1
loop

Och dessa koder ersätter dina andra två funktioner som du har använt:

Function ShortenLinkName(sHTML, lFirstLength, lLastLength)
	Dim objRegExp
	Set objRegExp = New RegExp
	objRegExp.Global = True
	objRegExp.IgnoreCase = True
	
	objRegExp.Pattern = "(<a [^>]+>)([\s\S]{" & lFirstLength & "}?)([\s\S]+?)([\s\S]{" & lLastLength & "}?)(</a>)"

	ShortenLinkName = objRegExp.Replace(sHTML, "$1$2...$4$5")
	Set objRegExp = Nothing
End Function

Function LinkURL(str)
	Dim objRegExp, strTemp
	Set objRegExp = New RegExp

	objRegExp.IgnoreCase = True
	objRegExp.Global = True
	objRegExp.Pattern = "(\b(www\.|http\://)\S+\b)"
	' __ kommer att bli mellanslag på länken i nästa funktion: shortenWords
	strTemp = objRegExp.replace(str, "<a__href=""http://$1""__target=""_new"">$1</a>")
	LinkURL = Replace(strTemp, "http://http://","http://")
	Set objRegExp = Nothing
End Function

Function shortenWords(sHTML, lFirstLength, lLastLength)
	Dim objRegExp, strTemp, returnString
	Set objRegExp = New RegExp

	objRegExp.IgnoreCase = True
	objRegExp.Global = True
	objRegExp.Pattern = "\s?([^\s]+)\s?"
	Set myMatches = objRegExp.Execute(str)
	For Each myMatch In myMatches
		'Om ordet börja med <a__ så skall vi ersätta alla __ i ordet till mellanslag, annars kontrollera vi längden och om ordet är längre än 39 tecken så korta vi ner den till 39 tecken. 
		If Not Left(LCase(myMatch.SubMatches(0)),4) = "<a__" Then
			If Len(myMatch.SubMatches(0)) >= 40 Then
				returnString = returnString & Left(myMatch.SubMatches(0),31) & "..." & right(myMatch.SubMatches(0),5)
			Else
				returnString = returnString & myMatch.SubMatches(0)
			End If
		Else
			'Vi anropar Eriks Funktion här inne istället.
			returnString = returnString & ShortenLinkName(Replace(myMatch.SubMatches(0),"__"," "),lFirstLength,lFirstLength)
		End If
		returnString = returnString & " "
	Next

	shortenWords = returnString
End Function
brorsanMedlem sedan nov. 2001402 inlägg
#6

När jag klistrade in dem exakt så blev resultatet så här.

http://www.skate.nu/forum_topic_t.asp?id=32541

Verkar inte som om den känner av länkarna alls.

voigtann1s avatarvoigtann1Medlem sedan juni 20019 519 inlägg
#7

klart att den inte fungera.

str = shortenWords(strText, 27, 12)

skall vara:

strText = shortenWords(strText, 27, 12)

my bad

Jag har funderat lite och jag _tror_ den nya funktionen är lite "overkill". en Otestad version (ShortenWords):

Function shortenWords(sHTML, lFirstLength, lLastLength)
	vNew = Split(sHTML, " ")
	For i = 0 to UBound(vNew)
		If Left(LCase(vNew(i)) = "<a__" Then
			vNew(i) = ShortenLinkName(Replace(vNew(i),"__"," "),lFirstLength,lFirstLength)
		Else
			If Len(vNew(i)) >= 40 Then
				vNew(i) = Left(vNew(i),31) & "..." & right(vNew(i),5)
			End If
		End If
	Next
	ShortWords = Join(vNew, " ")
End Function

Kan nog fungera lika bra om inte bättre. Slipper skapa ett RegExp objekt.

brorsanMedlem sedan nov. 2001402 inlägg
#8

Tack, men när jag klistrade in stretext istället för str försvann allt så inget visas
http://www.skate.nu/forum_topic_t.asp?id=32541

sen testade jag att byta ut till den nya funktionen här, verkade saknas nån " eller nåt:
http://www.skate.nu/forum_topic_t2.asp?id=32541

voigtann1s avatarvoigtann1Medlem sedan juni 20019 519 inlägg
#9

Det saknas ett ) som den säger:

Function shortenWords(sHTML, lFirstLength, lLastLength)
	vNew = Split(sHTML, " ")
	For i = 0 to UBound(vNew)
		If Left(LCase(vNew(i))[b])[/b] = "<a__" Then
			vNew(i) = ShortenLinkName(Replace(vNew(i),"__"," "),lFirstLength,lFirstLength)
		Else
			If Len(vNew(i)) >= 40 Then
				vNew(i) = Left(vNew(i),31) & "..." & right(vNew(i),5)
			End If
		End If
	Next
	ShortWords = Join(vNew, " ")
End Function

Om inte det fungera så kan du ge mig all kod för att se vad som är fel.

voigtann1s avatarvoigtann1Medlem sedan juni 20019 519 inlägg
#10

Ett fel till dumt av mig:

Function shortenWords(sHTML, lFirstLength, lLastLength)
	vNew = Split(sHTML, " ")
	For i = 0 to UBound(vNew)
		If Left(LCase(vNew(i)),4) = "<a__" Then
			vNew(i) = ShortenLinkName(Replace(vNew(i),"__"," "),lFirstLength,lFirstLength)
		Else
			If Len(vNew(i)) >= 40 Then
				vNew(i) = Left(vNew(i),31) & "..." & right(vNew(i),5)
			End If
		End If
	Next
	ShortWords = Join(vNew, " ")
End Function

glömde ,4 i hur många tecken från vänster.

brorsanMedlem sedan nov. 2001402 inlägg
#11

uppdaterat _t2

nytt felmeddelande. Här är rad 206 den klagar på.

If Left(LCase(vNew(i))) = "<a__" Then

men gör inget för mig om den är overkill, bara den fungerar, så kanske ska fokusera på den ursprungliga, som kanske är nära, bara det att texten försvann?

voigtann1s avatarvoigtann1Medlem sedan juni 20019 519 inlägg
#12

läs mitt svar ovan.

brorsanMedlem sedan nov. 2001402 inlägg
#13

när jag la till 4 försvann felmedddelandet och allt blev tomt som den andra.

hur blir det tomt egentligen? skumt.

voigtann1s avatarvoigtann1Medlem sedan juni 20019 519 inlägg
#14
Function shortenWords(sHTML, lFirstLength, lLastLength)
	vNew = Split(sHTML, " ")
	For i = 0 to UBound(vNew)
		If Left(LCase(vNew(i)),4) = "<a__" Then
			vNew(i) = ShortenLinkName(Replace(vNew(i),"__"," "),lFirstLength,lFirstLength)
		Else
			If Len(vNew(i)) >= 40 Then
				vNew(i) = Left(vNew(i),31) & "..." & right(vNew(i),5)
			End If
		End If
	Next
	[b]shortenWords[/b] = Join(vNew, " ")
End Function

Döpte om funktionen men den retunera inget.

brorsanMedlem sedan nov. 2001402 inlägg
#15

fick lite mer hjälp av voigtann, här kommer det slutgiltiga fungerande om någon hittar tråden i framtiden och behöver det.


Function ShortenLinkName(sHTML, lFirstLength, lLastLength)

	Dim objRegExp

	Set objRegExp = New RegExp

	objRegExp.Global = True

	objRegExp.IgnoreCase = True

	

	objRegExp.Pattern = "(<a [^>]+>)([\s\S]{" & lFirstLength & "}?)([\s\S]+?)([\s\S]{" & lLastLength & "}?)(</a>)"

	ShortenLinkName = objRegExp.Replace(sHTML, "$1$2...$4$5")

	Set objRegExp = Nothing

End Function

Function LinkURL(str)

	Dim objRegExp, strTemp

	Set objRegExp = New RegExp

	objRegExp.IgnoreCase = True

	objRegExp.Global = True

	objRegExp.Pattern = "(\b(www\.|http\://)\S+\b)"

	' __ kommer att bli mellanslag på länken i nästa funktion: shortenWords

	strTemp = objRegExp.replace(str, "<a__href=""http://$1""__target=""_new"">$1</a> ")

	LinkURL = Replace(strTemp, "http://http://","http://")

	Set objRegExp = Nothing

End Function

Function shortenWords(sHTML, lFirstLength, lLastLength)
	sHTML = Trim("" & sHTML)

	vNew = Split(sHTML, " ")

	For i = 0 to UBound(vNew)

		If Left(LCase(vNew(i)),4) = "<a__" Then

			vNew(i) = ShortenLinkName(Replace(vNew(i),"__"," "), lFirstLength, lFirstLength)

		Else

			If Len(vNew(i)) >= 40 Then

' vänstra siffran nedan reglerar antal tecken i spamtext innan ... högra siffran reglerar antal tecken i spamtext efter ... är som 19 och 9 anpassat efter kapital WWWWWW
				vNew(i) = Left(vNew(i),19) & "..." & right(vNew(i),9)

			End If

		End If

	Next

	ShortenWords = Join(vNew, " ")

End Function


			strText = server.HTMLEncode(rs("message"))

			strText = Replace(strText,vbcrlf," <br> ")

			strText = LinkURL(strText)

' vänstra siffran nedan reglerar antal tecken före och efter ... i länkar. 15 är anpassat efter kapital WWWWWW. högra siffran vet ej. 
			strText = shortenWords(strText, 15, 26)
	
' här kommer inlägget

response.write "		" & strText & " " & VbCrlf
265 ms totalt · 4 externa anrop · v20260731065814-full.86ec41c2
125 ms — deklarationer (db)
0 ms — hämta statistik (cache)
137 ms — hämta tråd, inlägg och bilagor (db)
125 ms — ändringar (db)