Hämta ut webbadressen2
Förord
När man börjar använda gästböcker, forum, nyhetsskript m.m på sin hemsida och antalet besökare ökar ställer det större krav på roliga funktioner. En rolig och bra funktion är att låta besökarna ange webbadresser. Så här skall jag visa hur man kan använda en funktion för detta.Innehåll
»»
Kodning
<%
'En testlänk
sLank = "Besök Pellesoft: http://www.pellesoft.se."
'Formaterar länk [Länk, target]
sLank = Webadress(sLank, "_blank")
'Skriver ut länken
Response.Write(sLank)
%>
<%
'Här börjar funktionen
Function Webadress(sText_Lank, sTarget)
'Gör om radbrytningar till taggar
sText_Lank = Replace(sText_Lank, vbCrLf, "
")
'Startposition för sökning
iAktuellPosition = 1
'Loopar igenom tils alla länkar hittats
Do While InStr(iAktuellPosition, sText_Lank, "http://", 1) <> 0
'Antal tecken till länkens start
iAdressStart = InStr(iAktuellPosition, sText_Lank, "http://", 1)
'Kollar om slutet av länken är ett mellanrum
iAdressSlut = InStr(iAdressStart, sText_Lank, " ", 1)
'Om slutet inte är ett mellanrum, kollas radbrytning
If iAdressSlut = 0 Then
'Antal tecken
iAdressSlut = InStr(iAdressStart, sText_Lank, "<", 1)
else
'Kollar om strängen innehåller radbrytning
If instr(1, Mid(sText_Lank, iAdressStart, (iAdressSlut - iAdressStart)), "
") <> 0 Then
'Hämtar ut rätt position
iAdressSlut = InStr(1, Mid(sText_Lank, iAdressStart, (iAdressSlut - iAdressStart)), "<", 1) + iAdressStart - 1
End if
End if
'Om inget slut hittades är det slut på strängen
If iAdressSlut = 0 Then
'Länk till slutet
iAdressSlut = Len(sText_Lank) + 1
end if
'Flaggar
bKoll = False
'Loopar tills strängen är ok
Do until bKoll = True
'Hittas ett felaktigt tecken tas det bort
Select Case Mid(sText_Lank, iAdressSlut - 1, 1)
Case ".", ",", "!", "?", ")", "(", "]", "[", "@", "#", "£", "¤", "$", "\", "'", "*"
'Minskar med 1
iAdressSlut = iAdressSlut - 1
Case else
'Flaggar för stopp
bKoll = True
End Select
Loop
'Bygger på text
sText = sText & Mid(sText_Lank, iAktuellPosition, iAdressStart - iAktuellPosition)
'Hämtar ut länken
sAdress = Mid(sText_Lank, iAdressStart, iAdressSlut - iAdressStart)
'Sätter ihop allt
sText = sText & "" & sAdress & ""
'Överför position
iAktuellPosition = iAdressSlut
Loop
'Lägger på slutet
sText = sText & Mid(sText_Lank, iAktuellPosition)
'Byter tillbaks radbrytningar
sText = Replace(sText, "
", vbCrLf)
'Överför
Webadress = sText
End Function
%>
Var denna artikeln användbar?
Om du gör någon intressant (eller kanske något konstigt fel) på grund av detta material så skicka gärna det med ett mail eller bifoga en länk till mig så presenterar jag detta som ytterligare exempelfiler för kursen. Om detta innehållet är felaktigt eller du lärt dig fler finesser så skriv gärna en rad eller varför inte en egen kurs baserat på dina erfarenheter. Sänd gärna in dina tips till denna kurs./Kjell Larsson
0 Kommentarer