Programs | links | string Function Tolink (STR)
Dim RE ' Regular Expression object
Dim strcontent
If IsNull (Str) Then str= ""
Set RE = New RegExp ' Create regular Expression object
With RE
. Global = True ' search applies to entire string
. IgnoreCase = True ' searches for case-insensitive
Strcontent=str
'***************************************************************
' Email address link set up automatically
'***************************************************************
. Pattern= "([\w]*) @ ([\w\.] *)"
Strcontent=. Replace (strcontent, "<a href= ' mailto:$1@$2 ' >$1@$2</A>")
'***************************************************************
' Link Auto Set
'***************************************************************
' = = = = = = = = = = = = Add protocol name =======
Dim D (3), I
D (0) = "http"
D (1) = "ftp"
D (2) = "News"
D (3) = "MMS"
'===================================
For i=0 to UBound (D)
. Pattern=d (I) + ": \/\/([\w\.] *)"
Strcontent=. Replace (strcontent, "<a href=" "+ D (i) +"://$1 ' target=_blank> "+ D (I) +"://$1</a> ")
Next
'***************************************************************
End With
Set re=nothing
Tolink=strcontent
End Function
