|
I have created a change in the "InsertHyperlinks" function so that when there is an image, the function creates links in the urls and does not modify the source of the image:
Function InsertHyperlinks(ByVal strMessage)
Dim objRegExp
Dim objMatches, objMatch
Dim lngStartPos, lngEndPos
Dim strURL
Dim strTempMessage
Dim strRuteImg1
Dim strRuteImg2
'Initilise variables
strTempMessage = ""
lngStartPos = 1
lngEndPos = 1
strRuteImg1 = "<img src="" http://www." rel="nofollow - http://www."
strRuteImg2 = "<img src="" https://www." rel="nofollow - https://www."
'Renombramos la ruta de la imagen
strMessage = Replace(strMessage, strRuteImg1, "[RuteImg1]")
strMessage = Replace(strMessage, strRuteImg2, "[RuteImg2]")
'Create object
Set objRegExp = New RegExp
'Match URL's
objRegExp.Pattern = "((www\.|(http|https|ftp|news|file)+\:\/\/)[_.a-z0-9-]+\.[a-z0-9\/_:@=.+?_,##%&~-]*[^.|\'|\# |!|\(|?|,| |>|<|;|\)])"
objRegExp.IgnoreCase = True
objRegExp.Global = True
'Excure regular expression
Set objMatches = objRegExp.Execute(strMessage)
'loop through each text link found
For Each objMatch in objMatches
'Get end postion
lngEndPos = objMatch.FirstIndex
'Place in to temp message string
strTempMessage = strTempMessage & Mid(strMessage, lngStartPos, lngEndPos - lngStartPos + 1)
'Call Href function to build hyperlink
strTempMessage = strTempMessage & GetHref(objMatch.Value)
'Get the start position
lngStartPos = lngEndPos + objMatch.Length + 1
Next
'Replace the text URL in the string with the hyperlink
strMessage = strTempMessage & Mid(strMessage, lngStartPos)
'Renombramos la ruta de la imagen al estado original
strMessage = Replace(strMessage, "[RuteImg1]", strRuteImg1)
strMessage = Replace(strMessage, "[RuteImg2]", strRuteImg2)
'Retun function
InsertHyperlinks = strMessage
End Function
On the page that saves the text I have changed it to:
'If there are no hyperlinks already look to convert text links to hyperlinks
If InStr(1, strEmailBody, "<a", 1) = 0 AND (InStr(1, strEmailBody, "<img", 1) = 0 OR (InStr(1, strEmailBody, "<img src="" http://www." rel="nofollow - http://www." , 1) > 0 OR InStr(1, strEmailBody, "<img src="" https://www." rel="nofollow - https://www." , 1) > 0)) Then
strEmailBody = InsertHyperlinks(strEmailBody)
End If
I add this code to verify that there are no typos in the image url or changes of place or double spaces, etc. If the src of the image is not the same as in the function it does not do it.
This is for the forum programmers in case they are interested and want to adapt them for a new version. If the moderator likes what I've done and wants to delete this post from the forum, I don't care. Because I write it for the forum programmers.
I hope it is understood because I am Spanish and I translate with the Google translator.
-------------
https://www.lanocion.es - https://www.lanocion.games - https://www.lanocion.chat
|