Replace via Trend

[Sastraxi]

I have to search for a string inside another string, and replace it. However, I must base this on a trend. This trend is (with the quotes!)

"*.php*"

I would like to change that to

"http://www.mysite.com/*.php*"

Basically, I'd like to find any instances of double-quoted strings containing php and add http://www.mysite.com/ into the start of the inside. Is there any good way to do this?

[Sastraxi]

Hmm. This is probably a bad way to do this... anyway, my main goal is to replace relative links in a page with absolute ones (so I can download a page from a website but all of the links and pictures will still work).

[Bruce Fox]

A simplistic approch:

Option Explicit
 
Private Const wType As String = "*.php* *.jpg* *.ico*"
 
Private Sub Form_Load()
   Call mySearch("*.php*")
End Sub
 
Private Sub mySearch(ByVal myFind As String)
   If InStr(wType, myFind) <> 0 Then MsgBox "http://www.mysite.com/" & myFind
End Sub

[Sastraxi]

Unfortunately, it will be a _massive_ string, and thus I don't think that will work.

[Bruce Fox]

Well, you could write a Select Case statement, with all possible
*.???*.

However, how many extention types can there be on a Web page. Surly not hundreds?

[Bruce Fox]

Ok, I have an idea... I'll just knock up a demo.

[Sastraxi]

Hey, thanks I was writing my own replace function for this, but I can't think anymore (I need to relax and unwind, I think). If you want me to post it, I can.

[Bruce Fox]

Nearly there

[Bruce Fox]

Like:

Option Explicit
 
Private Const myRep As String = "http://www.mysite.com/"
 
Private Sub Form_Load()
Dim myTestString As String: myTestString = "java bla bla *.php* bla endofline"
 
Dim fPos As Integer
 
   If InStr(myTestString, "*.") <> 0 Then
      ' The prefix of an Extension exists in a Line
      fPos = InStr(myTestString, "*.")
         ' Second line of defence, does that match end with an "*"
         If Mid$(myTestString, fPos + 5, 1) = "*" Then
            MsgBox Left$(myTestString, fPos - 1) & myRep & Mid$(myTestString, fPos)
         End If
   End If
 
End Sub

[Bruce Fox]

Ooops,

You just wanted the returned URL appended with the extension right.

If so:

Option Explicit
 
Private Const myRep As String = "http://www.mysite.com/"
 
Private Sub Form_Load()
Dim myTestString As String: myTestString = "java bla bla *.jpg* bla endofline"
 
Dim fPos As Integer
 
   If InStr(myTestString, "*.") <> 0 Then
      ' The prefix of an Extension exists in a Line
      fPos = InStr(myTestString, "*.")
         ' Second line of defence, does that match end with an "*"
         If Mid$(myTestString, fPos + 5, 1) = "*" Then
            ' Return the URL appended with the extension
            MsgBox myRep & Mid$(myTestString, fPos, 6)
         End If
   End If
 
End Sub

[Bruce Fox]

And... as a Function;

Option Explicit
 
Private Const myRep As String = "http://www.mysite.com/"
 
Private Sub Form_Load()
   MsgBox myInsert("java bla bla *.php* bla endofline")
End Sub
 
Private Function myInsert(ByVal sLine As String) As String
   Dim fPos As Integer
 
   If InStr(sLine, "*.") <> 0 Then
      ' The prefix of an Extension exists in a Line
      fPos = InStr(sLine, "*.")
         ' Second line of defence, does that match end with an "*"
         If Mid$(sLine, fPos + 5, 1) = "*" Then
            ' Return the URL appended with the extension
            myInsert = myRep & Mid$(sLine, fPos, 6)
         End If
   End If
 
End Function

[seaweed]

I think he's looking to replace all relative links in the text of an html page with absolute links.

For example, I just copied this bit from Google's site, which puts their logo at the top of the page:

<img src="images/logo.gif" width=276 height=110 alt="Google">

When I do a "View Source" on their page and save it to my local drive, then try to look at the page locally, the picture doesn't appear because it is a relative link.

To fix this, I would have to insert "http://www.google.com/" at the beginning of the src attribute, like so:

<img src="http://www.google.com/images/logo.gif" width=276 height=110 alt="Google">

What i don't understand is why the *.php* stuff? Wouldn't it be good enough to replace src=" with src="http://www.mysite.com/ (and also replace href=" with href="http://www.mysite.com/)?

Or am I way off here?

[Bruce Fox]

Hey Seaweed,

I think he's looking to replace all relative links in the text of an html page with absolute links.

I agree.


And that's what the Function will do (in theory )

I don't think using Replace was an option due to the amount
of extensions he was dealing with (see my original posts and suggestions).


Well see where it goes


Bruce.

[seaweed]

I tried your function, passing in the string" "<img src=""images/logo.*.php*"" width=276 height=110 alt=""Google"">" (I put the *.php* in there so it would get recognized as a place to insert text), but all it returned was:

http://www.mysite.com/*.php*

It cut off the beginning and ending attibutes for the tag (img, width, height)

The way I see it, something like this might work better: You pass in the string that represents the page, and all src= and href= tags that aren't absolute (don't start with http://) have "http://www.mysite.com/" inserted after the first quote.

Here's a working example (I used some constants at the top, which can be changed without having to rewrite any of the function code):

Option Explicit
 
Private Const cSRC As String = "src="""
Private Const cHREF As String = "href="""
Private Const cHTTP As String = "http://"
Private Const cWEBSITE As String = "http://www.mysite.com/"
 
Private Sub Form_Load()
   MsgBox FixRelativeLinks("<img src=""images/logo.gif"" width=276 height=110 alt=""Google"">")
End Sub
 
Private Function FixRelativeLinks(sOriginalHTML As String) As String
    Dim nSrcPos As Integer
    Dim nHrefPos As Integer
    Dim sBeg As String
    Dim sEnd As String
    Dim sRetVal As String
    
    sRetVal = sOriginalHTML
    
    ' Replace all non-absolute src tags
    nSrcPos = InStr(1, sRetVal, cSRC)
    Do While nSrcPos > 0
        ' Verify that it's a relative attribute
        If Not Mid(sRetVal, nSrcPos + Len(cSRC), Len(cHTTP)) = cHTTP Then
            ' Insert the website in the appropriate place
            sBeg = Left(sRetVal, nSrcPos + Len(cSRC) - 1)
            sEnd = Right(sRetVal, Len(sRetVal) - Len(sBeg))
            sRetVal = sBeg & cWEBSITE & sEnd
        End If
        
        ' Look for the next src tag
        nSrcPos = InStr(nSrcPos + Len(cSRC), sRetVal, cSRC)
    Loop
    
    ' Replace all non-absolute href tags
    nHrefPos = InStr(1, sRetVal, cHREF)
    Do While nHrefPos > 0
        ' Verify that it's a relative attribute
        If Not Mid(sRetVal, nHrefPos + Len(cHREF), Len(cHTTP)) = cHTTP Then
            ' Insert the website in the appropriate place
            sBeg = Left(sRetVal, nHrefPos + Len(cHREF) - 1)
            sEnd = Right(sRetVal, Len(sRetVal) - Len(sBeg))
            sRetVal = sBeg & cWEBSITE & sEnd
        End If
        
        ' Look for the next href tag
        nHrefPos = InStr(nHrefPos + Len(cHREF), sRetVal, cHREF)
    Loop
    
    FixRelativeLinks = sRetVal
End Function

[Bruce Fox]

Originally posted by seaweed
I tried your function, passing in the string" "<img src=""images/logo.*.php*"" width=276 height=110 alt=""Google"">" (I put the *.php* in there so it would get recognized as a place to insert text), but all it returned was:

http://www.mysite.com/*.php*

It cut off the beginning and ending attibutes for the tag (img, width, height)

My first Sub didn't do that ....

I modified it cause I reread his original post.

Anyhoo;

myInsert = Left$(sLine, fPos - 1) & myRep & Mid$(sLine, fPos)

would do the trick.


Cheers 'n' Beers
Bruce.

[Sastraxi]

Bruce Fox and seaweed, you gods you. Thank you, thank you, thank you both! Is there any way to fix it so that you can have multiple things (like href=, src=, action=, etc.)?

I've tune you into what I'm doing. Creating an IE-based browser that strips off the VBWire and ADs.

[Sastraxi]

Never mind Looked through your code again. Thanks

[Sastraxi]

I'm posting this through VBFBrowser

[Sastraxi]

On top of the world one day, crushed underneath its weight the next It appears that it won't be possible seeing as IE handles the links internally. However, I still have a couple of ideas.... oh well Thanks for your help though guys.