CheckURL / CheckEmail

[FiEnD]

Hej.

 

Sitter sen tidigare med ett problem med min bildformatering så nu tänkte jag påbörja något annat i takt med att jag ger upp min förra ide.

 

Det vore bra om man hade en funktion som man kunde kolla igenom en sträng med och som automatiskt gjorde URLs och Emails klickbara..

 

Tex om någon lagt in länken http://www.microsoft.com eller pelle@microsoft.com på ett forum så skall den automatiskt koda om så det blir <a href="http://www.microsoft.com">http://www.microsoft.com</a> osv..

 

Någon som har nåt tips om hur gå tillväga?

Nånstans kanske som nån brottats med samma problem och funnit en bra lösning/funktion?

 

Tack på förhand.

 

Mvh Fredrik

 

[Henke]

Testa denna funktion.

 

'----------------------------------------------------

' * ConvertLinks *

' Fixa så att länkar blir länkade i HTML-koden.

' Nedanstånde kod kommer från www.ojmnet.com

'----------------------------------------------------

Function ConvertLinks(svalue)

 

svalue = ConvertLinksHREF(svalue, "http://")

svalue = ConvertLinksHREF(svalue, "ftp://")

svalue = ConvertLinksHREF(svalue, "news://")

svalue = ConvertLinksHREF(svalue, "mailto:")

 

ConvertLinks = svalue

End Function

 

Function ConvertLinksHREF(svalue, sHREF)

 

Dim iPos1, iPos2, sTemp, sTemp1, sTemp2

 

iPos2 = 1

iPos1 = InStr(1, svalue, sHREF, 1)

Do While iPos1 > 0

iPos2 = FindLinkEnd(svalue, iPos1 + Len(sHREF))

If iPos2 > 0 Then

sTemp1 = Mid(svalue, iPos1, iPos2 - iPos1)

sTemp2 = "<A HREF=" & Chr(34) & sTemp1 & Chr(34) & ">" & sTemp1 & "</A>"

svalue = Left(svalue, iPos1 - 1) & sTemp2 & Mid(svalue, iPos2)

iPos2 = iPos1 & Len(sTemp2) + 1

Else

iPos2 = iPos1 + Len(sHREF)

End If

iPos1 = InStr(iPos2, svalue, sHREF, 1)

Loop

 

ConvertLinksHREF = svalue

End Function

Function FindLinkEnd(svalue, iPos1)

Dim iPos2, i, iLen, iTempPos

Dim sValidChars

 

sValidChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890-.@/"

iLen = iPos1 + Len(Mid(svalue, iPos1)) - 1

iPos2 = -1

For i = iPos1 To iLen

iTempPos = InStr(1, sValidChars, Mid(svalue, i, 1), 1)

If iTempPos = 0 Then

If i < iPos1 + 4 Then

iPos2 = -1

Else

iPos2 = i

End If

Exit For

End If

Next

If iPos2 = 0 Then

iPos2 = Len(svalue) + 1

End If

 

FindLinkEnd = iPos2

 

End Function

 

[Magnus Ahlkvist]

Funktionen är långt ifrån färdig.

 

En URL är en domän och en sökväg.

Domänen får innehålla de tecken du angav. Däremot får sökvägen innehålla betydligt mer.

Samma sak med username i e-postadresser.

Men varför ägna sig åt en miljard olika if-satser för att man tvunget måste syssla med stränghantering? Det finns stöd för reguljära uttryck i ASP (objektet RegExp). Använd dessa, eller ännu lättare, förvänta dig att:

* Om ett "ord" (dvs något som börjar med blanksteg och avslutas med blanksteg eller en punkt följt av blanksteg (förutsatt naturligtvis att interpunktionen i texten är någorlunda korrekt)) är en URL om den börjar med HTTP://, NEWS:// eller FTP://

* Om ett "ord" (enligt samma definition som ovan) innehåller "någonting", följt av ett @, följt av "någonting annat", där "någonting annat" innehåller minst en punkt är det en E-postaddress.

 

Men om man vill göra det någorlunda korrekt är det alltså reguljära uttryck man ska använda. Hur dessa fungerar behövs betydligt mer än ett eforum-inlägg för att förklara, men det är ingen magi över det hela, utan ganska enkla regler, som lätt förstås om man har läst automatateori eller abstrakt algebra, men som också kan förstås utan dessa förkunskaper.

 

--

--

En röst talade till mig och sade:

”Le och var glad, ty det kunde vara värre”.

Så jag log, och jag var glad.

Och det blev värre.

 

[FiEnD]

Hej Magnus.

 

Jag har kikat lite på regexp (regular expressions). Det verkar helt klart intressant faktiskt. Var tvungen dock att installera ScriptEngine 5.5 förrän det skulle funka

 

Saken är den att problemet jag har.. är att jag vill kunna anropa en funktion och skicka med ett värde i en textmassa som jag har i en tabell.

 

Tex om jag har en artikel och vill lägga in en bild så har jag en funktion som hämtar in bilden och kommentar mm såhär: HamtaBild(122) där 122 är ID på bilden (som ligger i en tabell).

 

Men detta var svårare än jag tänkt. Kikade och kom en bit med RegExp.

http://www.4guysfromrolla.com/demos/customHTMLTags.asp

Utgick från det där.

 

Men jag strandade då jag inte riktigt fick till det med $1.

 

Mvh Fredrik

 

[dotgif]

Hej!

 

Satt lite och knåpade lite ASP kod nu på kvällen. Håll till godo.

 

Function CheckForMail(ByVal str)
Dim regEx
Dim Matches, Match
Dim strMatch
Set regEx = New RegExp
regEx.Pattern = "\w+([-+.])*\w+([-+.])*@\w+([-.]\w+)*\.\w+([-.]\w+)*"
regEx.IgnoreCase = True 
regEx.Global = True
Set Matches = regEx.Execute(str)   ' Execute search.
For Each Match in Matches   ' Iterate Matches collection.
	strMatch = Match.Value
	str = Replace(str, strMatch, "<a href=""mailto:" & strMatch & """>" & strMatch & "</a>")
Next
CheckForMail = Trim(str)
End Function

Function CheckForLinks(ByVal str)
Dim regEx
Dim Matches, Match
Dim strMatch
Set regEx = New RegExp
regEx.Pattern = "http://([\w-]+\.)+[\w-]+(/[\w- ./?%&=]*)?"
regEx.IgnoreCase = True 
regEx.Global = True
Set Matches = regEx.Execute(str)   ' Execute search.
For Each Match in Matches   ' Iterate Matches collection.
	strMatch = Match.Value
	str = Replace(str, strMatch, "<a target=""_blank"" href=""" & strMatch & """>" & strMatch & "</a>")
Next
CheckForLinks = Trim(str)
End Function


'http url sökning
Response.Write CheckForLinks("hej hopp http://www.microsoft.com.") & "<br>"

'e-mail sökning
Response.Write CheckForMail("hej hopp test@testar.com") & "<br>"

 

Mvh

 

Jimmy

 

 

[FiEnD]

kanon!! =)

Helt perfekt

 

Poäng delas ut.

Har inte hunnit testa det, men det jag lyckats klura ut av det så verkar det stämma finfint!

 

Tack!

 

Det enda som fattas nu är en funktion för att kolla om det finns nån bild-infogning i texten.. tex

[bild]789[/bild]. Måste (eller rättare sagt vill) hämta ut bilden från en databas med kommentar och allt med en funktion. Men jag har inte lyckats klura ut hur jag ska ersätta just 789 med GetPicture(789) tex /=

 

 

Mvh Fredrik

 

[inlägget ändrat 2003-01-14 23:22:13 av FiEnD]