En Replace der kan replace http://, www. og mail adresser i en streng til links.

Og lige en sidebemærkning .. eksperten\'s problem med & og andre special tegn der tit bliver brugt i adresser med server-side scripting det vil jeg gerne undgå.

f.eks. http://www.tdaugaard.dk/404_findes_ikke/noget.asp?param=value&andet=tredie

det fucker eksperten up ..

Værsågod - benytter regular expressions:


response.write InsertHyperlinks(\"Skriv til mig på frederik@pentamind.com eller besøg www.pentamind.com\")


Function InsertHyperlinks(inText)
Dim objRegExp, strBuf
Dim objMatches, objMatch
Dim Value, ReplaceValue, iStart, iEnd

  strBuf = \"\"
  iStart = 1
  iEnd = 1
  Set objRegExp = New RegExp

  objRegExp.Pattern = \"\\b(www|http|\\S+@)\\S+\\b\"  \' Match URLs and emails
  objRegExp.IgnoreCase = True                  \' Set case insensitivity.
  objRegExp.Global = True                      \' Set global applicability.
  Set objMatches = objRegExp.Execute(inText)
  For Each objMatch in objMatches
    iEnd = objMatch.FirstIndex
    strBuf = strBuf & Mid(inText, iStart, iEnd-iStart+1)
    If InStr(1, objMatch.Value, \"@\") Then
      strBuf = strBuf & GetHref(objMatch.Value, \"EMAIL\", \"_BLANK\")
    Else
      strBuf = strBuf & GetHref(objMatch.Value, \"WEB\", \"_BLANK\")
    End If
    iStart = iEnd+objMatch.Length+1
  Next
  strBuf = strBuf & Mid(inText, iStart)
  InsertHyperlinks = strBuf
End Function


Function GetHref(url, urlType, Target)
Dim strBuf

  strBuf = \"<href=\"\"\"
  If UCase(urlType) = \"WEB\" Then
    If LCase(Left(url, 3)) = \"www\" Then
      strBuf = \"<a href=\"\"http://\" & url & \"\"\" Target=\"\"\" & _
              Target & \"\"\">\" & url & \"</a>\"
    Else
      strBuf = \"<a href=\"\"\" & url & \"\"\" Target=\"\"\" & _
              Target & \"\"\">\" & url & \"</a>\"
    End If
  ElseIf UCase(urlType) = \"EMAIL\" Then
    strBuf = \"<a href=\"\"mailto:\" & url & \"\"\" Target=\"\"\" & _
            Target & \"\"\">\" & url & \"</a>\"
  End If
 
  GetHref = strBuf

End Function



/ortrak

afprøver lige ..

Virker ikke efter hensigten.
Jeg har brugt det direkte uden at ændre i noget og dette er resultatet:

http://www.tdaugaard.dk/tvdk/default.asp?page=guestb

det var meningen at der skulle stå tekst ved ALLE kommentar \"felter\"..

må jeg se den streng du passer sammen med InsertHyperlinks()...

/ortrak

hvad mener du med kommentar \"felter\"?? querystrings?


/ortrak

Sorry .. det må være min kode, da jeg prøvede med

strMsg = InsertHyperlinks(\"besøg www.tdaugaard.dk eller skriv til mig på t@tdaugaard.dk\")

virkede det fint men

strMsg = InsertHyperlinks(CmdRecord(\"msg\"))

virkede ikke en meter... jeg prøver mig frem, så tak for den!!

felter ... nogle felter på siden ... tekst der skulle have stået i nogle celler ..

welcome

/ortrak

har ellers en, der er meget simplere...

<%
Function parseURL(strInput)
dim reURL1, reURL2, reEmail, strOutput
Set reURL1 = New RegExp
reURL1.Pattern = \"(http|ftp)(:\\/\\/[\\w\\._-]+\\.[\\w\\._-]+\\S*)\"
reURL1.Global = True
reURL1.IgnoreCase = True
Set reURL2 = New RegExp
reURL2.Pattern = \"(^|[^\\/])(www[^\\.\\s]?\\.[\\w\\._-]+\\.[A-Za-z]{2,3}\\S*)\"
reURL2.Global = True
reURL2.IgnoreCase = True
Set reEmail = New RegExp
reEmail.Pattern = \"([\\w\\._-]+@[\\w\\._-]+\\.[A-Za-z]{2,3}\\S*)\"
reEmail.Global = True
reEmail.IgnoreCase = True
strOutput = reEmail.Replace(strInput,\"<a href=mailto:$1>$1</a> \")
strOutput = reURL1.Replace(strOutput,\"<a href=$1$2>$1$2</a> \")
strOutput = reURL2.Replace(strOutput,\"<a href=http://$2>$2</a> \")
parseURL = strOutput
End Function
%>
<%= parseURL(\"haj@zhat.dk http://zhat.dk ftp://sunsite.dk www.wolla.dk bla@bla.bla.dk http://www.noget.andet.com www.noget.dk\") %>

VBScript sucks... det er fandema grimt at se på

Ja, den så godt nok mere simpel ud, dog lidt mere rodet (jeg er meget picky med mit ASP ..) men det er lidt for sent, eller tak ..

*lol* ja .. JavaScript er sku godt nok ikke kønnere ..

Utroligt at Jakob- eller Andreas admin ikke har fixet problemet her på eksperten endnu med URL\'s når det er så nemt ..

Hvad mener du med \"rodet\"?
Kan du måske lave simplere RegExpressions, der finder RIGTIGE (altså gyldige) URL´er og mailadresser?
faktisk tror jeg at de burde være mere komplicerede hvis den skulle finde samtlige gyldige adresser, f.eks. hvis man skal tillade æø og å i emailadresser

JavaScript ER kønnere *LOL*

stringbuffer:>

rodet som i ... øhh .. som jeg sagde, jeg er picky .. jeg synes den ser rodet ud .. sorry, men det ka\' godt være jeg bruger den anyway, nu ser jeg hvad for en jeg synes bedst om :-)

*hopper op og ned*

Shaky, eh ? *g*

Det jeg mente med at at det var rodet er, at jeg synes at nedenstående er bedre:

Function LinkString(strInput)
    Set objRegExpHTTP1 = New RegExp
    Set objRegExpHTTP2 = New RegExp   
    Set objRegExpEMail = New RegExp

    objRegExpHTTP1.Pattern = \"(http|ftp)(:\\/\\/[\\w\\._-]+\\.[\\w\\._-]+\\S*)\"
    objRegExpHTTP2.Pattern = \"(^|[^\\/])(www[^\\.\\s]?\\.[\\w\\._-]+\\.[A-Za-z]{2,3}\\S*)\"
    objRegExpEMail.Pattern = \"([\\w\\._-]+@[\\w\\._-]+\\.[A-Za-z]{2,3}\\S*)\"

    objRegExpHTTP1.Global = True
    objRegExpHTTP2.Global = True
    objRegExpEMail.Global = True

    objRegExpHTTP1.IgnoreCase = True
    objRegExpHTTP2.IgnoreCase = True
    objRegExpEMail.IgnoreCase = True

    strOutput = objRegExpEMail.Replace(strInput, \" <a href=\'mailto:$1\'>$1</a> \")
    strOutput = objRegExpHTTP1.Replace(strOutput, \" <a href=\'$1$2\'>$1$2</a> \")
    strOutput = objRegExpHTTP2.Replace(strOutput, \" <a href=\'http://$2\'>$2</a> \")

    LinkString = strOutput
End Function

som du kan se er jeg MEGET picky ..

stringbuffer:> du kan godt begynde at ærgre (mangler jeg et auto-spellcheck keyboard eller er det korrekt?) dig .. jeg bruger din funktion .. den er meget kortere og virker helt fint :)

stringbuffer:> Der er et lille problem med din (og et større med ortraks, men anyway)

hvis man skriver:

visit www.tdaugaard.dk, or mail me @ thomas@tdaugaard.dk\"

(alt incl.) så tager den kommaet og \" med, respektivt.

Er det noget der kan rettes eller er det bare sådan at RegExp\'eren virker ?

stringbuffer:> 50 point til dig hvis du kan fixe den ..

ortrak >> Er du fra Pentamind ??? Så må du lige hilse Sebastian fra hans gamle kolleger...

/Geeeet