---

Hejsa,

Jeg har nu snart prøvet at hav af frit tilgængelige funktioner der kan lave
links i en tekst streng om til HTML links, men de er alle samme lige
elendige. Er der ikke nogen der kender til en der virker ordentlig?

- Morten

---

MacMan wrote:
>
> Jeg har nu snart prøvet at hav af frit tilgængelige funktioner der
> kan lave links i en tekst streng om til HTML links, men de er alle
> samme lige elendige. Er der ikke nogen der kender til en der virker
> ordentlig?

Hvad med at give nogle eksempler på hvorfor de andre funktioner, du har
prøvet, har været elendige. Ellers giver vi dig jo nok nogle funktioner
med de samme fejl.

--
Anders

---

I brevet "3B8FC0E9.2CBDBF6D@serveren.dk" skrev Anders Holbøll
(dev-null-20010827@serveren.dk) den 31/08/01 18:52:

> MacMan wrote:
>>
>> Jeg har nu snart prøvet at hav af frit tilgængelige funktioner der
>> kan lave links i en tekst streng om til HTML links, men de er alle
>> samme lige elendige. Er der ikke nogen der kender til en der virker
>> ordentlig?
>
> Hvad med at give nogle eksempler på hvorfor de andre funktioner, du har
> prøvet, har været elendige. Ellers giver vi dig jo nok nogle funktioner
> med de samme fejl.

Der hvor de fleste fejler er ved linjeskift, altså hvis man har en tekst
hvor linket er det allersidste på linjen, så tager de fleste noget af næste
linje med.

Jeg har bl.a. prøvet med vinder scriptet fra den konkurrence Netcoders
afholdt, men det kan ikke engang klare det - i øvrigt totalt lamt at de ikke
havde linjeskift med som et af vinder kriterierne.

- Morten

---

MacMan wrote:
> Anders Holbøll skrev:
> > MacMan wrote:
> > >
> > > Jeg har nu snart prøvet at hav af frit tilgængelige funktioner
> > > der kan lave links i en tekst streng om til HTML links, men de
> > > er alle samme lige elendige. Er der ikke nogen der kender til
> > > en der virker ordentlig?
>
> Der hvor de fleste fejler er ved linjeskift, altså hvis man har en
> tekst hvor linket er det allersidste på linjen, så tager de fleste
> noget af næste linje med.

Kan vi så ikke lave et sammen? Hvis jeg nu lægger ud og "skyder fra
hoften", med noget fuldstændigt utestet kode (Ikke fordi, jeg har noget
imod RegExps (Jeg elsker RegExps), men det er ikke alle, der har skiftet
til win2k eller opgraderet deres vbscript-fortolker):

(Comments is left as an exercise to the reader)

Function TextToHtml(ByVal Value)
Dim StartPos, TempPos, EndPos, SafeEndPos, Length, Ch, UrlLength
Dim Buffer(100), BufferPos
BufferPos = 0
Const UrlChar = "_.:,?/#&=-"
Length = Len(Value)
StartPos = 1
Do
StartPos = InStr(LCase(Value), "http://")
TempPos = InStr(LCase(Value), "www.")
If Not (TempPos = 0) And (TempPos < StartPos + 7) Then
StartPos = TempPos
End If
If (StartPos = 0) Then Exit Do
EndPos = Startpos
Do Until (EndPos > Length)
Ch = Mid(Value, EndPos, 1)
If (Ch < "a" Or Ch > "z") And _
(Ch < "A" Or Ch > "Z") And _
(Ch < "0" Or Ch > "9") Then
If InStr(UrlChar, Ch) = 0 Then
Exit Do
End If
Else
SafeEndPos = EndPos
End If
If (EndPos = Length) Then Exit Do
EndPos = EndPos + 1
Loop
If (BufferPos > UBound(Buffer)) Then
Buffer(0) = Join(Buffer, "")
BufferPos = 1
End If
UrlLength = EndPos - StartPos + 1
Buffer(BufferPos) = _
Server.HtmlEncode(Left(Value, StartPos - 1)) & _
"<a href=""" & _
Server.HtmlEncode(Mid(Value, StartPos, UrlLength)) & _
""" target=""_new"">" & _
Server.HtmlEncode(Mid(Value, StartPos, UrlLength)) & _
"</a>"
Value = Mid(Value, EndPos + 1)
BufferPos = BufferPos + 1
Loop
TextToHtml = Join(Buffer, "") & Server.HtmlEncode(Value)
End Function

(Det blev sku' ikke skide smukt, men ideen er vist god nok)

> Jeg har bl.a. prøvet med vinder scriptet fra den konkurrence Netcoders
> afholdt, men det kan ikke engang klare det - i øvrigt totalt lamt at de ikke
> havde linjeskift med som et af vinder kriterierne.

De jeg har set fra De Danske Asp Hjælpe Sites (I kender nok alle
url'erne), har generelt været (og nu prøver jeg at være diplomatisk)
noget lort. Jeg tror, dem der sender sine scripts der til generelt er
nye folk, der lige har lært noget nyt og vil "vise sig". Det resulterer
i at scriptsne er dårligt performene, fuld af sikkerhedshuller og har en
grim kode stil.
(Ja, jeg er mavesur idag og der er fordi, jeg har ondt i håret)

--
Anders

---

I brevet "3B90B3A4.1D93E12B@serveren.dk" skrev Anders Holbøll
(dev-null-20010827@serveren.dk) den 01/09/01 12:08:

> MacMan wrote:
>> Anders Holbøll skrev:
>>> MacMan wrote:
>>>>
>>>> Jeg har nu snart prøvet at hav af frit tilgængelige funktioner
>>>> der kan lave links i en tekst streng om til HTML links, men de
>>>> er alle samme lige elendige. Er der ikke nogen der kender til
>>>> en der virker ordentlig?
>>
>> Der hvor de fleste fejler er ved linjeskift, altså hvis man har en
>> tekst hvor linket er det allersidste på linjen, så tager de fleste
>> noget af næste linje med.
>
> Kan vi så ikke lave et sammen? Hvis jeg nu lægger ud og "skyder fra
> hoften", med noget fuldstændigt utestet kode (Ikke fordi, jeg har noget
> imod RegExps (Jeg elsker RegExps), men det er ikke alle, der har skiftet
> til win2k eller opgraderet deres vbscript-fortolker):

Jeg har denne som nok er den jeg har haft de bedste resultater med:
(ser lidt kikset ud her, koden kan også ses her:
http://arto.dk/includes/linktekst.txt )


<%
Function autoHighlight(ByVal sInput, ByVal sTarget)

Dim sPunct, sNew, bStop, sVal1, sVal2, sVal3, sVal4

' Define punctuation characters
sPunct = "_-+=!?.,;:`~'""*^$%()[]{}<>|"

' Assign input string to local variable so we don't change the
' original string.
sNew = sInput

' Split the string by whitespace: spaces, carriage returns, line feeds,
' and tabs. Then, for each "word" in the string...
For Each sVal1 in Split(sNew, " ")

For Each sVal2 in Split(sVal1, vbcr)

For Each sVal3 in Split(sVal2, vblf)

For Each sVal4 in Split(sVal3, Chr(9))

' Remove beginning and ending punctuation

bStop = FALSE

Do While (Not bStop)
If (Instr(sPunct, Left(sVal4, 1)) <> 0 And
Len(sVal4) > 2) Then
sVal4 = Mid(sVal4, 2)
Else
bStop = TRUE
End If
Loop

bStop = FALSE

Do While (Not bStop)
If (Instr(sPunct, Right(sVal4, 1)) <> 0 And
Len(sVal4) > 2) Then
sVal4 = Left(sVal4, Len(sVal4) - 1)
Else
bStop = TRUE
End If
Loop

' If the word begins with http:// then convert all
occurrences
' of this word to a hyperlink.

If (LCase(Left(sVal4, 7) = "http://") Or
LCase(Left(sVal4, 4) = "www.")) Then

If (LCase(Left(sVal4, 4) = "www.")) Then

If (sTarget = "") then
sNew = Replace(sNew, sVal4, "<A
HREF=""http://" & sVal4 & """>" & sVal4 & "</A>")
Else
sNew = Replace(sNew, sVal4, "<A
HREF=""http://" & sVal4 & """ TARGET=""" & sTarget & """>" & sVal4 & "</A>")
End If

Else

If (sTarget = "") then
sNew = Replace(sNew, sVal4, "<A HREF=""" &
sVal4 & """>" & sVal4 & "</A>")
Else
sNew = Replace(sNew, sVal4, "<A HREF=""" &
sVal4 & """ TARGET=""" & sTarget & """>" & sVal4 & "</A>")
End If

End If

End If

' If this word looks like an e-mail address then convert
all
' occurrences into a mailto: link.

If (Instr(sVal4, "@") >= 2 And Instr(sVal4, ".") <> 0
And Len(sVal4) >= 5) Then
sNew = Replace(sNew, sVal4, "<A HREF=""mailto:" &
sVal4 & """>" & sVal4 & "</A>")
End If

Next
Next
Next
Next

' Return converted string
autoHighlight = sNew

End Function
%>

- men i visse tilfælde kikser den totalt umotiveret, se f.eks. denne side
nede i bunden:
http://arto.dk/dagens/default.asp?id=324&visAnnonce=True&visFooter=True

- Morten

---

MacMan wrote:
> Anders Holbøll skrev:
> > MacMan wrote:
> > >[Skal bruge en funktion til at gøre url'er i tekst til links]
>
> Jeg har denne som nok er den jeg har haft de bedste resultater med:
> (ser lidt kikset ud her, koden kan også ses her:
> http://arto.dk/includes/linktekst.txt )
>
> - men i visse tilfælde kikser den totalt umotiveret, se f.eks.
> denne side nede i bunden:
> http://arto.dk/dagens/default.asp?id=324&visAnnonce=True&visFooter=True

Den fejler jo når samme link indgår flere gange i teksten. Lav evt et
dictionary med links, der allerede er blevet udskiftet, og check så
hvert link imod dette og lad være at røre linket hvis det allerede er
udskiftet. (Funktionen ser iøvrigt ikke videre hurtig ud)

--
Anders