Linkmaker

Man anvender når man danner html-koden således:

<body>
<%=makeLink(RS("Linktext"))%>
</body>

Men den er lavet i JScript så du kan ikke anvende den hvis du koder ASP i VBScript

findes der en der er i VBscript og i så fald, hvordan virker den??

<%
Function makeLinks(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"
  objRegExp.IgnoreCase = True
  objRegExp.Global = True
  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)
  makeLinks = 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 & """>" & 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
%>


Bruges sådan her:

<body>
<%=makeLinks("Tekst hvor adresser skal gøres klikbare")%>
</body>

<%
Function makeLinks(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"
  objRegExp.IgnoreCase = True
  objRegExp.Global = True
  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)
  makeLinks = 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 & """>" & 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
%>
<%
Response.Buffer = True

Set Con = Server.CreateObject("ADODB.Connection")
DBPath = "DBQ=" & server.mappath("news.mdb")
Con.Open "DRIVER={Microsoft Access Driver (*.mdb)}; " & DBPath
    Sql = "SELECT * FROM News ORDER BY date1 DESC"
    Set Record =  Con.Execute(Sql)
%>
<title> [ designforlife ] | graphic design </title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<meta name="keywords" content="kristian, kruse, lehn, web, internet, design, grafisk, logo, banner, adobe, photoshop, it">
<meta name="description" content=" [ designforlife ] is a site about graphic design.">
<meta name="author" content=" [ designforlife ] ">
<meta name="robots" content="all">
<link rel="shortcut icon" href="http://www.designforlife.dk/favicon.ico">
<link rel="stylesheet" href="../../files/dfl.css" type="text/css">
<script language="JavaScript1.2" type="text/javascript" src="../../files/dfl.js"></script>
</head>
<body leftmargin="0" topmargin="0" marginwidth="0" marginheight="0">
<table border="0" cellspacing="0" width="650">
  <tr>
    <td align="center" colspan="2">
      <h1>News</h1>
    </td>
  </tr>
  <% Do While Not Record.EOF %>
  <tr>
    <td height="20" width="400">
      <div align="left">
        <% Response.Write Record("News") %>
      </div>
    </td>
    <td height="20" width="250">
      <div align="right">
        <% Response.Write Record("Date1") %>
        |<i>
        <% Response.Write Record("Writer") %>
        </i>
        <br><b>
        <% Response.Write Record("Mail") %>
        </b>
        </div>
    </td>
  </tr>
  <tr>
    <td height="10" colspan="2"><img src="../../img/hr.gif" border="0"></td>
  </tr>
<%
Record.MoveNext
Loop
%>
</table>
<br>
<input type="button" name="Submit" value="Add news" class="submit" onclick="location.href='../news.asp'">
</body>
</html>
<%
Con.Close
Set Con = Nothing
%>


Hvor skal jeg sætte <%=makeLinks("Tekst hvor adresser skal gøres klikbare")%> ind, når jeg vil hive links ud af mail og news....?

<%=makeLinks(Record("feltnavn"))%>

eller, som du bruger det:

<% Response.Write makeLinks(Record("feltnavn")) %>

:)

er kan du se hvad jeg mener:
www.designforlife.dk/pages/news/shownews.asp
den skal hive links ud ad teksten og den mail man indtaster...

nu virker mailen men news laver fejl vha. <% Response.Write makeLinks(Record("feltnavn")) %>
hvorfor??

Du skal jo erstatte "feltnavn" med det feltnavn du bruger i databasen - altså hhv. News, Mail, Writer osv.

ja det har jeg også gjort, men den fjerner al teksten i news, pga. det ikke er links..
jeg har skrevet <% Response.Write makeLinks(Record("News")) %> og
<% Response.Write makeLinks(Record("Mail")) %>
!!

Okay. Det har jeg aldrig været ude for før, så jeg ved ikke helt hvad der er galt.

www.designforlife.dk/pages/news/shownews.asp
den viser kun linksne ikke andet????
hvad dælen gør jeg?

Du kunne prøve at bruge en anden funktion:

http://activedeveloper.dk/download/default.asp?mode=showdownload&id=43
http://activedeveloper.dk/download/default.asp?mode=showdownload&id=218
http://activedeveloper.dk/download/default.asp?mode=showdownload&id=15
http://activedeveloper.dk/download/default.asp?mode=showdownload&id=240

Desuden skal du være opmærksom på at magik's funktion og også nogle af de ovenstående kræver at VBScript5.0+ er installeret for at fungure fordi de bruger RegExp som først er med fra version 5.0.

Jeg vil nu bruge denne. Men kan nogle forklarer mig hvad Linktext ="blabla" skal bruges til... og igen fordi er jeg dum, skal man sætte noget andet ind på siden, eller skal man flytte rundt på noget!!!

<%
'--- Denne funktion er omskrevet til VBScript af Dennis Knappe (dennis@activeserverpages.dk) ---
'--- Funktioner er skrevet i JScript af Jesper Jensen (http://activeserverpages.dk/community/profil.asp?id=517) ---

linkText = "Tekst bliver lavet til links, når man skriver f.eks. dennis@activeserverpages.dk, http://activeserverpages.dk, eller www.activeserverpages.dk eller http://www.activeserverpages.dk/et/eller/andet/side.asp?user=i&name=Et%20Eller%20Andet."

Function makeLinks(strText)
    Dim objReg
   
    Set objReg = New RegExp
    objReg.Global = True
    objReg.IgnoreCase = True
     
    '--- test for ordinary hyperlinks ---
    objReg.Pattern = "(\bhttp\:\/\/)?(\bw{3}\.\S+\.[a-z][a-z]+\b)(\/\S+\b)?(\?\S+\b)?"
    strText = objReg.Replace(strText, "<a href=""http://$2$3$4"">$1$2$3$4</a>")
   
    '--- test for e-mail occurences ---
    objReg.Pattern = "(\S+@{1}\S+\.[a-z][a-z]+\b)"
    strText = objReg.Replace(strText, "<a href=""mailto:$1"">$1</a>")
   
    Set objReg = Nothing
   
    makeLinks = strText
End Function

Response.Write(makeLinks(linkText))
%>

linkText = "Tekst b..." er den tekst der bliver udskrevet på skærmen i dette eksempel ...

Response.Write(makeLinks(linkText)) skal du bare ændre så variablen linkText fra før peger på feltet i databasen ... nøjagtig som før ...

jamen hvad er meningen med linktext.. har den nogen funktion.. jeg forstår nemlig ikke?!

Sorry fik det til at virker tusinde tak begge to...

Hvordan får jeg lige det til at virke, når min sætning som viser teksten ser sådan her ud:

<%=Replace(Query("tekst"),vbcrlf,"<br>" & " ")%>