HttpToAnchors

Convert http found inside text into anchers < a >, aka URLlinker, aka urls2anchers, inserthyperlinks
Not the first time we did this, but another function will not hurt.
Also check http://boldcodes.com/Dev/Browse/?ID=EQDYA4JK69 and http://boldcodes.com/Dev/Browse/?ID=456E1QPK57


Public

Tested

My Own Work
<%
'*******************************************************
'* ASP 101 Sample Code - http://www.asp101.com *
'* *
'* This code is made available as a service to our *
'* visitors and is provided strictly for the *
'* purpose of illustration. *
'* *
'* Please direct all inquiries to webmaster@asp101.com *
'*******************************************************

' This function takes a string as input and links any http's it finds so that they are then clickable in a browser. If only looks for http:// so www.asp101.com alone wouldn't link, but http://www.asp101.com would.


' Get the input string from wherever...
' It probably makes the most sense when this is read in from a DB or text file. For illustration I'm setting it to this as a little plug for our partners!
strUnlinked = "http://www.asp101.com is the best ASP site! <br />" & vbCrLf
strUnlinked = strUnlinked & "You can get good XML content from http://www.xml101.com. <br />" & vbCrLf
strUnlinked = strUnlinked & "Microsoft http://www.microsoft.com/ always has lots of good info too. <br />" & vbCrLf
' Show title for modified string
Response.Write "<B>Original Text:</B> " & vbCrLf
Response.Write strUnlinked
Response.Write vbCrLf & "<BR>" & vbCrLf & vbCrLf
' Show title for modified string
Response.Write "<B>Text After Linking:</B>" & vbCrLf
' Call our function and write out the results:
Response.Write HttpToAnchors(strUnlinked)


Function HttpToAnchors(strInput)
 Dim iCurrentLocation ' Our current position in the input string
 Dim iLinkStart ' Beginning position of the current link
 Dim iLinkEnd ' Ending position of the current link
 Dim strLinkText ' Text we're converting to a link
 Dim strOutput ' Return string with links in it
 ' Start at the first character in the string
 iCurrentLocation  = 1
 ' Look for http:// in the text from the current position to the end of the string.
 ' If we find it then we start the linking process otherwise we're done because there are no more http://'s in the string.
 Do While InStr(iCurrentLocation, strInput, "http://", 1) <> 0 or InStr(iCurrentLocation, strInput, "https://", 1) <> 0
  iLinkStart   = InStr(iCurrentLocation, strInput, "http://", 1) ' Set the position of the beginning of the link
  If iLinkStart = 0 Then iLinkStart = InStr(iCurrentLocation, strInput, "https://", 1)
  iLinkEnd    = InStr(iLinkStart, strInput, " ", 1) ' Set the position of the end of the link. I use the first space as the determining factor.
  If iLinkEnd = 0 Then iLinkEnd = Len(strInput) + 1 ' If we didn't find a space then we link to the end of the string
  Select Case Mid(strInput, iLinkEnd - 1, 1) ' Take care of any punctuation we picked up
  Case ".", "!", "?"
   iLinkEnd   = iLinkEnd - 1
  End Select
  strOutput   = strOutput & Mid(strInput, iCurrentLocation, iLinkStart - iCurrentLocation) ' This adds to the output string all the non linked stuff up to the link we're curently processing.
  strLinkText   = Mid(strInput, iLinkStart, iLinkEnd - iLinkStart) ' Get the text we're linking and store it in a variable
  strOutput   = strOutput & "<a href=""" & strLinkText & """>" & strLinkText & "</a>" ' Build our link and append it to the output string
  'Response.Write iLinkStart & "," & iLinkEnd & "<BR>" & vbCrLf ' Some good old debugging
  iCurrentLocation = iLinkEnd ' Reset our current location to the end of that link
 Loop
 strOutput    = strOutput & Mid(strInput, iCurrentLocation) ' Tack on the end of the string. I need to do this so we don't miss any trailing non-linked text
 HttpToAnchors   = strOutput ' Set the return value
End Function

%>

strInput

it to this as a little plug for our partners!
strUnlinked = "http://www.asp101.com is the best ASP site!
" & vbCrLf & "You can get good XML content from http://www.xml101.com.
" & vbCrLf & "Microsoft http://www.microsoft.com/ always has lots of good info too.
" & vbCrLf
Response.Write "Original Text: " & vbCrLf
Response.Write strUnlinked
Response.Write "Text After Linking:" & vbCrLf
Response.Write HttpToAnchors(strUnlinked)

Views 1432 Downloads 533

Classic ASP Texts + Strings
ANmarAmdeen
660
Attachments
Revisions

v1.0