Funktion um www.xxx.de umzuwandeln...

[Boli]

Hi

Ich suche eine ASP oder vielleicht Javascript Funktion die oder wie auch immer eine http://www.xxx.de oder http://www.xxx.de in einen link mit der angebenen url umwandelt.

kann mir da jemand weiterhelfen ?


greetz b0li


ps.: genauso wie es hier zu sehen ist. ^^

 

[Thimo Grauerholz]

hi,

ich mache das mit einer regular expression. wenn ich zu hause bin, schicke ich dir das script, bzw poste es hier.

 

[Boli]

hast du auch was für [*code] und [*quote] ?

 

[Thimo Grauerholz]

hi,
jo naja das kannst ja mit ner simplen replace function machen.. bzw:

(ich glaube ich stelle meine msgbox mal opensource..)

mein script, was ich auch in der message box verwende:

<%
Function LinkURLs(inText)
Dim objRegExp, strBuf
Dim objMatches, objMatch
Dim Value, ReplaceValue, iStart, iEnd

  strBuf = ""
  iStart = 1
  iEnd = 1
  inText = server.htmlencode(""& inText & "")

  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", "")
    Else
      strBuf = strBuf & GetHref(objMatch.Value, "WEB", "_BLANK")
    End If
    iStart = iEnd+objMatch.Length+1
  Next
  strBuf = strBuf & Mid(inText, iStart)
  
  	strBuf = Replace(strBuf,":)","<img src='images/smile.gif'>")
	strBuf = Replace(strBuf,";)","<img src='images/wink.gif'>")
	strBuf = Replace(strBuf,":(","<img src='images/sad.gif'>")
	strBuf = Replace(strBuf,";(","<img src='images/reallysad.gif'>")
	strBuf = Replace(strBuf,":-","<img src='images/angry.gif'>")
	strBuf = Replace(strBuf,":|","<img src='images/less.gif'>")

  LinkURLs = strBuf
End Function


Function GetHref(url, urlType, Target)
Dim strBuf

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

End Function
%>

anzuwenden mit z.b.
<%=LinkUrls(rs("fummeln")%>



falls du weitere hilfe brauchst, poste einfach. bzw bei der erweiterung oder erläuterung des scripts

 

[Boli]

THX TTrek

es klappt

um die anderen sachen kümmere ich mich selber