Otomatik Link Oluşturma
Forumlardaki otomatik link oluşturma işlemini gerçekleştirir.
[HTML]
'// Copyright (c) 2000, Lewis Moten (modified by Ferruh Mavituna). All rights reserved.
Function LinkURLs(ByVal asContent)
Dim loRegExp' Regular Expression Object (Requires vbScript 5.0 and above)
' If no content was received, exit the function
If asContent = "" Then Exit Function
'asContent=asContent&" "
Set loRegExp = New RegExp
loRegExp.Global = True
loRegExp.IgnoreCase = True
'//-- by Ferruh Mavituna {http://ferruh.mavituna.com}
'1/29/2004
'"www" added
'"www." fixed
'"www" fixed etc.
loRegExp.Pattern = "((((ht|f)tps?://)|www\.)\S+[^\.*](\s)?)"
'loRegExp.Pattern = "((((ht|f)tps?://)|www\.)\S+[^\.*]\s)"
'loRegExp.Pattern = "((((ht|f)tps?://)|(www\.))\S+[/]?[^\.*]\s)"
' Link URLs
LinkURLs = loRegExp.Replace(asContent, "<a href=""$1"">$1</a>")
' // --
' Look for email addresses
loRegExp.Pattern = "(\S+@\S+.\.\S\S\S?)"
' Link email addresses
LinkURLs = loRegExp.Replace(LinkURLs, "<a href=""mailto:$1"">$1</a>")
' Release regular expression object
Set loRegExp = Nothing
End Function
[/HTML]