URLs2Anchors

All links found inside a string into anchor (< a href=...)
BUG!: Currently converts all links, even those that are already inside < a > and , this should be fixed in newer version

Function URLs2Anchors(inTextBlock)
 ' All links found inside a string into ancher (< a href=...)
 ' Needs CreateAncher, RemoveHTML (or RemoveHTMLTags)
' BUG!: Currently converts all links, even those that are within < a > and </a>
 ' inText     = RemoveHTML(inTextBlock)
 inText     = RemoveHTMLTags(inTextBlock)
 Dim objRegExp, strBuf
 Dim objMatches, objMatch
 Dim Value, ReplaceValue, iStart, iEnd
 strBuf      = ""
 iStart      = 1
 iEnd       = 1
 Set objRegExp    = New RegExp
 objRegExp.Pattern  = "\b(www|http|\S+@)\S+\b" ' Match URLs and emails
 objRegExp.IgnoreCase = True ' Set case insensitivity.
 objRegExp.Global   = True  ' Set global applicability.
 Set objMatches   = objRegExp.Execute(inText)
 For Each objMatch In objMatches
  iEnd      = objMatch.FirstIndex
  strBuf     = strBuf & Mid(inText, iStart, iEnd - iStart + 1)
  If InStr(1, objMatch.Value, "@") Then
   strBuf    = strBuf & CreateAncher(objMatch.Value, "EMAIL", "_BLANK", "")
  Else
   strBuf    = strBuf & CreateAncher(objMatch.Value, "WEB", "_BLANK", "")
  End If
  iStart     = iEnd + objMatch.Length + 1
 Next
 strBuf      = strBuf & Mid(inText, iStart)
 URLs2Anchors    = strBuf
End Function

inTextBlock

Views 934 Downloads 329

'CreateAnchor', 'RemoveHTML (or RemoveHTMLTags)', 'a', 'anchor', 'link', 'url', 'tag', 'href', 'skype', 'email', 'phone', 'www', 'convert', 'create', 'replace', 'change', 'substitute'

ANmarAmdeen
333
Layout+Design Classic ASP
Revisions

v1.0