replace link

[eddieFM]

Ciao a tutti..ho già fatto una ricerca a riguardo ma non ho trovato nulla di soddisfacente..
Vorrei riuscire a fare in modo che quando inserisco del testo da un form sul database, nel momento in cui raccolgo i dati del form mi aggiunga i tag di link <a href...></a> ove riconosce all'interno del testo una parola come http://www.sito.it

Avete suggerimenti a riguardo?

[daviweb]

http://www.oscarjsweb.com/topic.asp?topid=48

[maximum]

Usa questa funzione, anche se vale solo in visualizzazione e non in fase di memorizzazione sul DB, ma lo scopo è (penso) quello che vuoi te.

Dim intInizio, strProt' variabili globali

' routine trovaInizio
' determina l'inizio dell'url
' riceve da formatUrl stringa (stringa input) e inizio (inizio della ricerca)
' restituisce intInizio (inizio url) e strProt (prefisso da anteporre per costruire l'url se mancante)
Sub trovaInizio(stringa, inizio)
   Dim intHttp, intWww, intMail, intSpazio, intEnter, intFtp, intNews
   strProt = ""	' azzera la stringa del protocollo  
   intHttp = inStr(inizio, stringa, "http://")		' determina posizione http://
   intWww = inStr(inizio, stringa, "www.")			' determina posizione www.
   intMail = inStr(inizio, stringa, "@")			' determina posizione chiocciola
   If intMail > 0 Then	   ' se c'è una chiocciola
      intSpazio = inStrRev(stringa, " ", intMail) + 1 ' determina posizione spazio prima della chiocciola
      intEnter = inStrRev(stringa, Chr(13), intMail) + 1		  'determina posizione ritorno a capo prima della chiocciola
      If intSpazio > intEnter Then ' determina inizio effettivo dell'indirizzo email 
	 intMail = intSpazio
      Else
	 intMail = intEnter
      End If
   End If
   intFtp = inStr(inizio, stringa, "ftp://")   ' determina posizione ftp://
   intNews = inStr(inizio, stringa, "news://")   ' determina posizione news://     
   If intHttp = 0 Or (intWww > 0 And intHttp > intWww) Then			 ' determina inizio indirizzo http: se non c'è http è la posizione di www.
      intInizio = intWww
      strProt = "http://"	 ' e allora aggiunge il protocollo per costruire il link
   Else		  ' altrimenti e' quella di http
      intInizio = intHttp
   End If
   If intMail > 0 And (intInizio = 0 Or intInizio > intMail) Then	  ' determina inizio del primo indirizzo nella stringa
      intInizio = intMail		' mail
      strProt = "mailto:"		' aggiunge protocollo
   End If
   If intFtp > 0 And (intInizio = 0 Or intInizio > intFtp) Then 
      intInizio = intFtp	   ' ftp
      strProt = ""			   ' azzera protocollo
   End If
   If intNews > 0 And (intInizio = 0 Or intInizio >= intNews) Then 
      intInizio = intNews	   ' news
      strProt = ""			   ' azzera protocollo
   End If         
End Sub

' funzione formatUrl
' riceve input (stringa di input)
' restituisce strOutput (stringa con url convertiti)
Function formatUrl(input)
   Dim arrCar, strOutput, intFine, cntConta, strUrl
   arrCar = Array(Chr(13), ",", ". ", ": ", ";", "!", "? ", "..") ' matrice con i caratteri possibili di fine url, escluso lo spazio di default
   strOutput = input	   ' stringa di output. Inizialmente è uguale a quella di input.
   input = input & " "	   ' aggiunge alla stringa di input uno spazio per gestire il caso in cui non vi siano altri caratteri dopo l'ultimo url
   trovaInizio input, 1	   ' trova inizio primo indirizzo
   Do While intInizio > 0  ' ciclo di controllo stringa input. Prosegue fino a che non ci sono più possibili url 
      intFine = inStr(intInizio, input, " ")	' determina posizione spazio dopo l'url
      For cntConta = 0 to Ubound(arrCar)  ' determina fine url effettiva controllando la presenza dei caratteri di fine url possibili
         If inStr(intInizio, input, arrCar(cntConta)) > 0 And intFine > inStr(intInizio, input, arrCar(cntConta)) Then intFine = inStr(intInizio, input, arrCar(cntConta))
      Next
      strUrl = Mid(input, intInizio, intFine - intInizio) ' estrae l'url
      strOutput = Replace(strOutput, strUrl, "" & strUrl & "")			  
	  
	  'inserisce il tag <a> nella stringa di output
      trovaInizio input, intFine	 ' trova inizio indirizzi successivi
   Loop
   formatUrl = strOutput
End Function

e la richiami semplicemente:

response.write(formatUrl(objrs("Contenuto_del_tuo_testo")))

Ok?

[dops]

azz.. scusate se lo riprendo dopo tanto tempo.. ma ne vale la pena.. penso
Massiccissima funzione..
grazie
ho solo riscontrato un piccolo problema..
praticamente se passo alla funzione il replace del testo del campo.. tipo:
<%=formatUrl(replace(rsentire("testo"),VbCrLf,"
"))%>
mi il testo che ha un link www.ciccio.com poi l'accapo ed altro testo, mi deventa link anche il testo dopo l'accapo

[willybit]

Ciao a tutti,

a me piacciono di molto le regular expressions.... per queste cose sono l'ideale

prova = "questa è una prova. www.google.it" & vbCrLf & " e http://www.altavista.it sono motori di ricerca"
Function LinkUrl(stringa)
	temp=""
	Set re = new RegExp
	re.Pattern = "((http://[^ \n\r]+)|(www\.[^ \n\r]+))"
	re.Multiline = true
	re.Global = true
	re.IgnoreCase = true
	temp = re.Replace(stringa,"$1")
	temp = Replace(temp,"href=""www","href=""http://www")
	LinkUrl = temp
End Function
Response.Write prova & "
"
Response.Write LinkUrl(prova)

questo individua solo url del tipo
http://qualunquecosa.dominio.com
e
www.dominio.com
e controlla anche gli "a capo"

[dops]

Originariamente inviato da willybit
Ciao a tutti,

a me piacciono di molto le regular expressions.... per queste cose sono l'ideale

prova = "questa è una prova. www.google.it" & vbCrLf & " e http://www.altavista.it sono motori di ricerca"
Function LinkUrl(stringa)
	temp=""
	Set re = new RegExp
	re.Pattern = "((http://[^ \n\r]+)|(www\.[^ \n\r]+))"
	re.Multiline = true
	re.Global = true
	re.IgnoreCase = true
	temp = re.Replace(stringa,"$1")
	temp = Replace(temp,"href=""www","href=""http://www")
	LinkUrl = temp
End Function
Response.Write prova & "
"
Response.Write LinkUrl(prova)

questo individua solo url del tipo
http://qualunquecosa.dominio.com
e
www.dominio.com
e controlla anche gli "a capo"

mhh..
e url di tipo http://www.ciccio.com ?
credo di si vero?

[willybit]

Originariamente inviato da dops
mhh..
e url di tipo http://www.ciccio.com ?
credo di si vero?

sì www è come qualunquecosa
comunque correggo il Pattern

re.Pattern = "((http://[^ \s<]+)|(www\.[^ \s<]+))"

almeno se c'è un tag alla fine dell'indirizzo non lo calcola (tipo il caso del
)

[dops]

Originariamente inviato da willybit
sì www è come qualunquecosa
comunque correggo il Pattern

re.Pattern = "((http://[^ \s<]+)|(www\.[^ \s<]+))"

almeno se c'è un tag alla fine dell'indirizzo non lo calcola (tipo il caso del
)

ehm.. ma continua a darmi come link quello dopo il vbCrLf
cioè nel campo del db io non vedo l'accapo, ma c'è.. quindi controllo che ci sia e lo sostituisco
perchè continua a linkarmi anche quello dopo il vbCrLf ?

[dops]

guarda come mi esce l'url

http://www.ciccio.it
prova

[dops]

ah ecco il perchè..
non c'erano spazi quando facevo il replace..
quindi ho sostituito questo:
<%=LinkUrl(replace(rsentire("testo"),VbCrLf,"
"))%>

con questo

<%=LinkUrl(replace(rsentire("testo"),VbCrLf,"
"))%>
e funziona