A primitive url extractor for Jay Allen's MT- Blacklist utility for MovableType

This looks through the messages you have highlighted in your Outlook inbox and builds a list of the URLs that people listed in the URL field of the comment. You then paste these into the text box in MT-Blacklist's "Add" tab. (It also shows a list of the IP addresses, although I don't know why I bothered.)

Here are just some of the caveats you need to take very seriously: I am fumbling around in the dark when it comes to VBA for Outlook. And, there's almost no (= NO) error checking in this little program, so you could end up banning your mother; you must carefully inspect each of the URLs to make sure you really want to delete the comment that contains it. Further, I don't really understand how MT-Blacklist works. And there are probably some bad line wraps in the code below which will totally break it. Finally, this does NOT find any of the URLs in the body of the message because that's too hard. Well, finding the beginning of the urls isn't hard, but figuring out when they end is.

Note that this is HTML so some of the angle brackets have been replaced with the HTML markup for angle brackets. THE COPY AND PASTE VERSION IS HERE

So with that warning (WARNING: read the warning!), here's the script:

Sub FindURLStoBAN() 
' walks through selected 
'files to find bad urls
 Dim objApp As Application
 Dim objSelection As Selection
 Dim objItem As Object
 Dim ipstr As String
 Dim urlstr As String
 Dim ips As String
 Dim  us As String
 
 Set objApp = CreateObject("Outlook.Application")
 ' get the selected msgs
 
 Set objSel = objApp.ActiveExplorer.Selection
 
 x = 0
 For Each objItem In objSel
   If objItem.Class = 43 Then ' 43=mailitem
     msgtxt = objItem.Body ' get msg text
     ' Is this msg from mt-blacklist?
     p = InStr(msgtxt, "MT-Blacklist") 
     If p > 0 Then ' yes it is
      ' get the ip to ban
        p1 = InStr(msgtxt, "IP Address:")
        p1 = p1 + 12
        p2 = InStr(p1, msgtxt, vbCr)
        ips = Mid(msgtxt, p1, p2 - p1)
        ipstr = ipstr & vbCr & vbLf & ips
        ' get the url listed for the name
        p1 = InStr(msgtxt, "URL: ") + 5
        p2 = InStr(p1, msgtxt, vbCr)
        us = Mid(msgtxt, p1, p2 - p1)
        urlstr = urlstr & vbCr & vbLf & ucase(us)
        
        
        ' ----'Get urls in the text
		   udone = False: prevp = 1
		   ' uppercase it because I'm lazy
		   msgtxt = UCase(msgtxt)
		   While Not udone
		    u = ""
		    ' get next a href
		    p1 = InStr(prevp, msgtxt, "<A HREF=")
		    ' get end of href
		    p3 = InStr(p1 + 1, msgtxt, ">")
		    ' find end of href
		    If p1 > 0 And p3 > 0 Then
		      ' get /a
		       p2 = InStr(p1 + 1, msgtxt, "</A>")
		       ' if it has an end /a
		       If p2 > 0 Then
		          ' extract the string
		          u = Mid(msgtxt, p1 + 9, (p3 - (p1 + 11)))
		          ' note where it ended for next loop
		          prevp = p2
		         ' is it already in the string?
		         If InStr(1, urlstr, u) = 0 Then
		           urlstr = urlstr & vbCr & vbLf & u
		          End If
		      End If
		     End If
		     ' are we out of links?
		     if p1 = 0 Then udone = True
		   Wend
                   
        
                      
      End If ' if p > 0 msg from mtblacklist
     x = x + 1
 
     End If
  
 Next

 ' Fill the two textboxes

 mtblacklistfrm.iptxt.Text = ipstr
 mtblacklistfrm.urltxt.Text = urlstr
 mtblacklistfrm.Show
 Set objItem = Nothing
 
 
 End Sub

I make no warranty that this script will work. It may break your computer or have other damaging effects. You use it at your own risk.

David Weinberger...a humanities major.

Back to Blog