Convert Http strings into Clickable

This function takes a string as input and links any "http" it finds so that they are then clickable in a browser.

Sample Usage:

response.write LinkURLS("Please visit my web site at http://www.5dm.cn").

This will automatically insert the A HREF tag in the appropriate place.

<%

Function LinkURLs(strInput)

'This function takes a string as input and links any http's it

'finds so that they are then clickable in a browser.

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

' Set the position of the beginning of the link

iLinkStart = InStr(iCurrentLocation, strInput, "http://", 1)

' Set the position of the end of the link. I use the

' first space as the determining factor.

iLinkEnd = InStr(iLinkStart, strInput, " ", 1)

'make sure ther was no line break. If there was a line break before the

' space, set that as the end.

checkBreak=InStr(iLinkStart, strInput, chr(13), 1)

if checkBreak>0 and checkBreak<iLinkEnd then iLinkEnd=checkbreak

' If we didn't find a space then we link to the

' end of the string

If iLinkEnd = 0 Then iLinkEnd = Len(strInput) + 1

' Take care of any punctuation we picked up

Select Case Mid(strInput, iLinkEnd - 1, 1)

Case ",",".", "!", "?"

iLinkEnd = iLinkEnd - 1

End Select

' This adds to the output string all the non linked stuff

' up to the link we're curently processing.

strOutput = strOutput & Mid(strInput, iCurrentLocation, _

iLinkStart - iCurrentLocation)

' Get the text we're linking and store it in a variable

strLinkText = Mid(strInput, iLinkStart, iLinkEnd - iLinkStart)

' Build our link and append it to the output string

strOutput = strOutput & "<A HREF=""" & strLinkText & """ target=""_blank"">" _

& strLinkText & "</A>"

' Some good old debugging

'Response.Write iLinkStart & "," & iLinkEnd & "

' & vbCrLf

' Reset our current location to the end of that link

iCurrentLocation = iLinkEnd

Loop

' Tack on the end of the string. I need to do this so we

' don't miss any trailing non-linked text

strOutput = strOutput & Mid(strInput, iCurrentLocation)

' Set the return value

LinkURLs = strOutput

End Function 'LinkURLs

%>