Newsgroup: it.comp.www.asp
Titolo: Funzione Hyperlink

Salve, ho questa funzione che rende cliccabili i dati presi da un db,
pero' funziona solo nel caso siano presenti "www" e "@", vorrei
funzionasse anche nel caso l'url fosse "
http://web.
..."!!
Qualcuno mi puo' aiutare? Grazie
<%
Function MakeHyperlink(strSource)       
 
        if (strSource <> "") or Not IsNull(strSource) then
                splitSource = Split(strSource," ")
                linkResult = Filter(splitSource, "www", True)
                emailResult = Filter(splitSource, "@", True)
 
                For i = 0 to Ubound (splitSource)
                        MakeHyperLink = MakeHyperlink & splitSource(i) &
" "
                Next
 
                For i = 0 to Ubound (linkResult)
                        'Trim off any punctuation
                        If Right(linkResult(i),1) = "," OR
Right(linkResult(i),1) = "." then
linkResult(i)=left(linkResult(i),len(linkResult(i))-1)
                        End If
                        If Left(linkResult(i),7) = "http://" OR
Left(linkResult(i),7) = "HTTP://" then
                                linkWrapTag = "<a href=" & linkResult(i)
& ">" & linkResult(i) & "</a>"
                        Else
                                linkWrapTag = "<a href=http://" &
linkResult(i) & ">" & linkResult(i) & "</a>"
                        End If
                        MakeHyperLink = Replace(MakeHyperLink,
linkResult(i), linkWrapTag)
                Next
 
                For i = 0 to Ubound (emailResult)
                        'Trim off any punctuation
                        If Right(emailResult(i),1) = "," OR
Right(emailResult(i),1) = "." then
emailResult(i)=left(emailResult(i),len(emailResult(i))-1)
                        End If
                        emailWrapTag = "<a href=mailto:" &
emailResult(i) & ">" & emailResult(i) & "</a>"
                        MakeHyperLink = Replace(MakeHyperLink,
emailResult(i), emailWrapTag)
                Next
 
                MakeHyperLink = Replace(MakeHyperLink,Chr(13),"<br>")
 
        Else
                MakeHyperlink = strSource
        End If
 
End Function
%>
-- 
Marcello

Qualcuno mi puo' aiutare? Grazie
be', vedi come funziona per www, fai un copiaincolla e modificalo
leggermente.
-- 
non studio non lavoro non guardo la tv
non vado al cinema non faccio sport

 ha scritto:
} Salve, ho questa funzione che rende cliccabili i dati presi da un db,
} pero' funziona solo nel caso siano presenti "www" e "@", vorrei
} funzionasse anche nel caso l'url fosse "
http://web.
..."!!
} Qualcuno mi puo' aiutare? Grazie
Io avevo trovato questo che funziona molto bene (l'ho un po' modificato...)
<%
Function InsertHyperlinks(inText)
  Dim objRegExp
  Set objRegExp = New RegExp
  objRegExp.IgnoreCase = True
  objRegExp.Global = True
  objRegExp.Pattern = "(\w+(\.\w+)*@[\w\.-]+\w)"
  intext = objRegExp.replace(inText, "<a href='mailto:$1'>$1</a>")
  objRegExp.Pattern = "((www\.|http://)[\w\.\+\?/=&%;-]+\w)"
  intext = objRegExp.replace(inText, "<a href='http://$1'" & _
           "target='_blank'>$1</a>")
  intext = Replace(intext, "http://http://", "http://")
  InsertHyperlinks = intext
End Function
%>
Saluti. Carlo.
--
Per rispondere via e-mail
togliere TOGLIMI dall'indirizzo.
E-mail: 
carl...@tiscalinet.it
Foglio Excel sulle tariffe telefoniche
Web I : 
http://web.tiscalinet.it/carlonike
    II: 
http://dadacasa.supereva.it/carlo_nike/
Scrivi il senso dei tuoi messaggi già nell'oggetto,
sarà più facile ottenere le risposte che cerchi.