Tekst til url?

2 sek

<%
function makeLink(str)
    \'*** Make the reqular expr object
    Set objRegExp = New RegExp
    objRegExp.IgnoreCase = True
    objRegExp.Global = True

    \'***Make html links
    objRegExp.Pattern = \"(\\bhttp\\:\\/\\/)?(\\bw{3}\\.\\S+\\.[a-z][a-z]+\\b)(\\/\\S+\\b)?(\\?\\S+\\b)?\"
    str = objRegExp.Replace(str, \"<a href=\"&chr(34)&\"http://$2$3$4\"&chr(34)&\" target=\"&chr(34)&\"_blank\"&chr(34)&\">$1$2$3$4</a>\")

    \'***Make html mailto
    objRegExp.Pattern = \"(\\S+@{1}\\S+\\.[a-z][a-z]+\\b)\"
    str = objRegExp.Replace(str, \"<a href=\"&chr(34)&\"mailto:$1\"&chr(34)&\" target=\"&chr(34)&\"_blank\"&chr(34)&\">$1</a>\")
    Set objRegExp = Nothing
    makelink = str
end function
%>

tekst = makelink(DIN TEKST)

Den laver så også email@adresser.om, og hvis du kun skriver www.food4u.dk så virker det også, lige som her på eksperten.dk

http://www.netcoders.dk/sources.asp?mode=ref&id=1041&type=0

Prøv at sætte det ind her jeg syntes nemlig ikke det virker!


<!--#include file=\"includes/services.asp\"-->
<!--#include file=\"includes/db_link.asp\"-->
<!--#include file=\"includes/config.asp\"-->

<%
\' -------------------------------------------------
\'                  CD-Board v1.0
\'    (C) Copyright 2001, Clandestine Development 
\' -------------------------------------------------
\'  Se filen \"readme.htm\" for licensbetingelser. 
\'
\'  Mere info, updates og andre programmer på:
\'  http://www.clandestine.dk           
\' -------------------------------------------------

Dim Conn, RS, Text, Topic

  Set Conn = Server.CreateObject(\"ADODB.Connection\")
  Conn.Open UsrConnect()

  Session.LCID = 2057
 
  Set RS = Server.CreateObject(\"ADODB.RecordSet\")
  RS.Open \"SELECT * FROM News WHERE TID = \"& Request(\"TID\"), Conn, 1, 3
  If not RS.EOF Then
  Text = Replace(RS(\"Text\"), VbCrLf, \"<br>\")
  Topic = RS(\"Topic\")
%>
<html>
<head>
<title><%= Page_Title %></title>
<link rel=\"stylesheet\" type=\"text/css\" href=\"includes/styles.asp\">
</head>

<body>
<div align=\"center\">
  <center>
  <table border=\"0\" cellpadding=\"0\" width=\"<%= Table_Width %>\" cellspacing=\"0\">
    <tr>
      <td colspan=\"2\"><b><%= Topic %></b></td>
    </tr>
    <tr>
<% If Not RS(\"Email\") = \"\" Then %>
            <td valign=\"top\"><font size=\"1\"><i>af <a href=\"mailto:<%= RS(\"Email\") %>?subject=<%= Mail_Subject &\" \"& Topic %>\"><%= RS(\"Name\") %></a></i></font></td>
<% Else %>
            <td valign=\"top\"><font size=\"1\"><i>af <%= RS(\"Name\") %></i></font></td>
<% End If %>           
           
    </center>
    <td valign=\"top\">
      <p align=\"right\"><font size=\"1\">Oprettet d. <%= Timestamp(RS(\"Date\")) %><br>&nbsp;</font></td>
  </tr>
  <tr>
    <td colspan=\"2\"><%= Text %></td>
  </tr>
  </table>
</div>
<hr width=\"<%= Line_Width %>\" noshade color=\"#<%= Line_Color %>\">
<%
  End If
  RS.Close
  RS.Open \"SELECT * FROM Comments WHERE TID = \"& Request(\"TID\") &\" ORDER BY Date ASC, CID ASC\", Conn, 1, 3
  While Not RS.EOF
  Text = Replace(RS(\"Text\"), VbCrLf, \"<br>\")
%>
<div align=\"center\">
  <center>
  <table border=\"0\" cellpadding=\"0\" cellspacing=\"0\" width=\"<%= Table_Width %>\">
    <tr>
      <td colspan=\"2\"><%= Text %></td>
    </tr>
    <tr>
<% If Not RS(\"Email\") = \"\" Then %>
            <td><font size=\"1\"><br><i>af <a href=\"mailto:<%= RS(\"Email\") %>?subject=<%= Mail_Note &\" \"& Topic %>\"><%= RS(\"Name\") %></a></i></font></td>
<% Else %>
            <td><font size=\"1\"><br><i>af <%= RS(\"Name\") %></i></font></td>
<% End If %>
      <td><p align=\"right\"><font size=\"1\">Oprettet d. <%= Timestamp(RS(\"Date\")) %></font></td>
    </tr>
  </table>
  </center>
</div>
<hr width=\"<%= Line_Width %>\" noshade color=\"#<%= Line_Color %>\">
<%
  RS.MoveNext
  Wend
  RS.Close
  Set RS = Nothing
  Conn.Close
  Set Conn = Nothing
%> 
<p align=\"center\"><font face=\"Verdana\" size=\"1\"><a href=\"new_comment.asp?TID=<%= Request(\"TID\") %>\">Opret kommentar</a></font></p>
<p align=\"center\"><font face=\"Verdana\" size=\"1\"><a href=\"default.asp\">Tilbage til oversigten</a></font></p>
</body>
</html>

Hvilke felt skal der laves link i?

<!--#include file=\"includes/services.asp\"-->
<!--#include file=\"includes/db_link.asp\"-->
<!--#include file=\"includes/config.asp\"-->
<%
function makeLink(str)
    \'*** Make the reqular expr object
    Set objRegExp = New RegExp
    objRegExp.IgnoreCase = True
    objRegExp.Global = True

    \'***Make html links
    objRegExp.Pattern = \"(\\bhttp\\:\\/\\/)?(\\bw{3}\\.\\S+\\.[a-z][a-z]+\\b)(\\/\\S+\\b)?(\\?\\S+\\b)?\"
    str = objRegExp.Replace(str, \"<a href=\"&chr(34)&\"http://$2$3$4\"&chr(34)&\" target=\"&chr(34)&\"_blank\"&chr(34)&\">$1$2$3$4</a>\")

    \'***Make html mailto
    objRegExp.Pattern = \"(\\S+@{1}\\S+\\.[a-z][a-z]+\\b)\"
    str = objRegExp.Replace(str, \"<a href=\"&chr(34)&\"mailto:$1\"&chr(34)&\" target=\"&chr(34)&\"_blank\"&chr(34)&\">$1</a>\")
    Set objRegExp = Nothing
    makelink = str
end function
%>

<%
\' -------------------------------------------------
\'                  CD-Board v1.0
\'    (C) Copyright 2001, Clandestine Development 
\' -------------------------------------------------
\'  Se filen \"readme.htm\" for licensbetingelser. 
\'
\'  Mere info, updates og andre programmer på:
\'  http://www.clandestine.dk           
\' -------------------------------------------------

Dim Conn, RS, Text, Topic

  Set Conn = Server.CreateObject(\"ADODB.Connection\")
  Conn.Open UsrConnect()

  Session.LCID = 2057
 
  Set RS = Server.CreateObject(\"ADODB.RecordSet\")
  RS.Open \"SELECT * FROM News WHERE TID = \"& Request(\"TID\"), Conn, 1, 3
  If not RS.EOF Then
  Text = Replace(RS(\"Text\"), VbCrLf, \"<br>\")
  Text = makelink(Text)
  Topic = RS(\"Topic\")
%>
<html>
<head>
<title><%= Page_Title %></title>
<link rel=\"stylesheet\" type=\"text/css\" href=\"includes/styles.asp\">
</head>

<body>
<div align=\"center\">
  <center>
  <table border=\"0\" cellpadding=\"0\" width=\"<%= Table_Width %>\" cellspacing=\"0\">
    <tr>
      <td colspan=\"2\"><b><%= Topic %></b></td>
    </tr>
    <tr>
<% If Not RS(\"Email\") = \"\" Then %>
            <td valign=\"top\"><font size=\"1\"><i>af <a href=\"mailto:<%= RS(\"Email\") %>?subject=<%= Mail_Subject &\" \"& Topic %>\"><%= RS(\"Name\") %></a></i></font></td>
<% Else %>
            <td valign=\"top\"><font size=\"1\"><i>af <%= RS(\"Name\") %></i></font></td>
<% End If %>           
           
    </center>
    <td valign=\"top\">
      <p align=\"right\"><font size=\"1\">Oprettet d. <%= Timestamp(RS(\"Date\")) %><br>&nbsp;</font></td>
  </tr>
  <tr>
    <td colspan=\"2\"><%= Text %></td>
  </tr>
  </table>
</div>
<hr width=\"<%= Line_Width %>\" noshade color=\"#<%= Line_Color %>\">
<%
  End If
  RS.Close
  RS.Open \"SELECT * FROM Comments WHERE TID = \"& Request(\"TID\") &\" ORDER BY Date ASC, CID ASC\", Conn, 1, 3
  While Not RS.EOF
  Text = Replace(RS(\"Text\"), VbCrLf, \"<br>\")
%>
<div align=\"center\">
  <center>
  <table border=\"0\" cellpadding=\"0\" cellspacing=\"0\" width=\"<%= Table_Width %>\">
    <tr>
      <td colspan=\"2\"><%= Text %></td>
    </tr>
    <tr>
<% If Not RS(\"Email\") = \"\" Then %>
            <td><font size=\"1\"><br><i>af <a href=\"mailto:<%= RS(\"Email\") %>?subject=<%= Mail_Note &\" \"& Topic %>\"><%= RS(\"Name\") %></a></i></font></td>
<% Else %>
            <td><font size=\"1\"><br><i>af <%= RS(\"Name\") %></i></font></td>
<% End If %>
      <td><p align=\"right\"><font size=\"1\">Oprettet d. <%= Timestamp(RS(\"Date\")) %></font></td>
    </tr>
  </table>
  </center>
</div>
<hr width=\"<%= Line_Width %>\" noshade color=\"#<%= Line_Color %>\">
<%
  RS.MoveNext
  Wend
  RS.Close
  Set RS = Nothing
  Conn.Close
  Set Conn = Nothing
%> 
<p align=\"center\"><font face=\"Verdana\" size=\"1\"><a href=\"new_comment.asp?TID=<%= Request(\"TID\") %>\">Opret kommentar</a></font></p>
<p align=\"center\"><font face=\"Verdana\" size=\"1\"><a href=\"default.asp\">Tilbage til oversigten</a></font></p>
</body>
</html>

Så skulle den være der

så kommerd er en fejl besked du kan se den på http://www.intercore.dk/gismos/chr-forum/view.asp?TID=5

prøv makeLink i stedet for makelink

DEt hjælper nul og en skid! HJÆLP MIG!!!!!!!!!

hmm, så har du noget i dine include, som laver en konflikt med \"mit\" script

<%
    intPage = Request(\"page\")
    If isNumeric(intPage) = False Or intPage < 1 Then
        intPage = 1
    End If
   
    If intPage = \"\" then
        intPage = 1
    end if
   
    Function LinkTekst(Tekst)
    LinkTekst = \"\"
    A_Start = 1

    if InStr(Tekst, \"http://\") then
        intType = 1
    end if
    if InStr(Tekst, \"http://www.\") then
        intType = 2
    end if
    if InStr(Tekst, \"www\") then
        If not InStr(Tekst, \"http://\")>0 then
            intType = 3
        else
            intType = 2
        end if
    end if
      If intType >0 then
      do until A_Start >= len(Tekst)
          If intType = 1 then
          LinkChr = InStr(A_Start, Tekst, \"http://\")
      end if
      If intType = 2 then
          LinkChr = InStr(A_Start, Tekst, \"http://www.\")
      end if
      If intType = 3 then
          LinkChr = InStr(A_Start, Tekst, \"www\")
      end if
      NextSpace = InStr(LinkChr, Tekst, \" \")
   
      if NextSpace = 0 then NextSpace = Len(Tekst) + 1
   
      URL = Mid(Tekst, LinkChr, NextSpace - LinkChr)
   
      LinkTekst = LinkTekst & Mid(Tekst, A_Start, LinkChr - A_Start)
      If intType <3 then
          LinkTekst = LinkTekst & \"<A TARGET=\'_blank\' Href=\" & Chr(34) & URL & Chr(34) & \">\" & URL & \"</A>\"
        end if
      If intType = 3 then
            LinkTekst = LinkTekst & \"<A TARGET=\'_blank\' Href=\'http://\" & URL & \"\'>\" & URL & \"</A>\"
      end if
      if Int(LinkChr) = Int(InStrRev(Tekst, \"http://\")) then
        LinkTekst = LinkTekst & Mid(Tekst, NextSpace, Len(Tekst) - A_Start)
        A_Start = Len(Tekst)
      else
        A_Start = NextSpace
      end if
      loop
    else
      LinkTekst = Tekst
    end if
    End Function
%>

*********************************************************************************

Dette skal du så skrive der hvor du gerne vil hive teksten der skal laves link i ud.

LinkTekst(\"her skal dette: http://www.eksperten.dk laves til link\")

Det samme sker igen!

Nogen der har en løsning?

Nå der er ingen på eksperten der er kloge nok;-)
Har selv løst problemet!