cscgal
The Queen of DaniWeb
Administrator
19,432 posts since Feb 2002
Reputation Points: 1,474
Solved Threads: 230
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
"http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<title>Untitled Document</title>
</head>
<body>
<%
'***** BEGIN FUNCTIONS *****
' This function takes a string as input and links any www's it
' finds so that they are then clickable in a browser.
Function LinkURLs(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, "www", 1) <> 0
' Set the position of the beginning of the link
iLinkStart = InStr(iCurrentLocation, strInput, "www", 1)
' Set the position of the end of the link. I use the
' first space as the determining factor.
iLinkEnd = InStr(iLinkStart, strInput, " ", 1)
' 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=""http://" & strLinkText & """ target=""_blank"">" & strLinkText & "</A>"
' Some good old debugging
'Response.Write iLinkStart & "," & iLinkEnd & "<BR>" & 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
'***** END FUNCTIONS *****
Dim strUnlinked ' The variable to hold out text to be linked up.
' Get the input string from wherever...
' It probably makes the most sense when this is read in from a
' DB or text file.!
strUnlinked = "http://www.kudosvisions.com is the best Web site! <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><BR>" & vbCrLf
' Show the original string for comparison:
Response.Write strUnlinked
' Spacing!
Response.Write vbCrLf & "<BR>" & vbCrLf & vbCrLf
' Show title for modified string
Response.Write "<B>Text After Linking:</B><BR>" & vbCrLf
' Call our function and write out the results:
Response.Write LinkURLs(strUnlinked)
' That really is all there is to it folks!
%>
</body>
</html>You
© 2012 DaniWeb® LLC
