VBScript form spam blocker

July 2, 2007 — osblues

I don’t do a great deal of classic ASP any more, but today I had to knock up a quick function to try and filter out those annoying form spammers. You know the ones, feedback forms submitted with just URLs pointing to pr0n and viagra sites!

Anyway, I came up with a function that counts URLs in a block of text –

Function UrlCount(text)
dim strRegex
strRegex = "(https?://)?(([0-9a-z_!~*'().&=+$%-]+: )?
[0-9a-z_!~*'().& =+$%-]+@)?(([0-9]{1,3}.){3}[0-9]{1,3}|
([0-9a-z_!~*'()-]+.)*([0-9a-z] [0-9a-z-]{0,61})?[0-9a-z].[a-z]
{2,6}) (:[0-9]{1,4})?((/?)|(/[0-9a-z_!~*'().;?:@&=+$,%#-]+)+/?)"

'Prepare a regular expression object
Set myRegExp = New RegExp
myRegExp.IgnoreCase = True
myRegExp.Global = True
myRegExp.Pattern = strRegex

Set myMatches = myRegExp.Execute(text)
UrlCount = myMatches.count
Set myMatches = nothing
Set myRegExp = nothing
End Function

Thanks to this url regex I had it sorted in no time 🙂

Usage –

If UrlCount(variablecontainingfieldvaluetocheck) > 1 then
' you could use 2+ above if you don't want to be so strict
' do something nasty like drop a 404
End If

Anyway, let me know if you find it useful or have any suggestions for improvement.

Posted in Technology, VBScript. Leave a Comment »

VBScript Sleep

April 28, 2005 — osblues

I’ve just had a requirement for a sleep command in ASP, apparently there isn’t one (not that I can find). There is a Wscript.Sleep for command line VBS’s but nothing in ASP.

So, I’ve written a really quick simple one that some might find useful –

Sub Sleep(intSecs)
Dim dtStart, boolDone
dtStart = now()
boolDone = False
While Not boolDone
If DateDiff("s",dtStart,now()) >= cint(intSecs) Then
boolDone = True
End If
Wend
End Sub

Update: As noted in the comments, this really *shouldn’t* be used as it pins your CPU. If you must use it, please be aware of what it’s doing.

Posted in VBScript. 5 Comments »

SPF compliant CDO message

February 22, 2005 — osblues

I wrote this a while back as I couldn’t find a nice example anywhere for sending SPF compliant CDO.message emails. It also copes with setting message importance which is another awkward thing. Let me know if you have any problems or have any suggestions to improve it.

Sub sendemail(strFrom, strTo, strSender, strBcc, _
   strSubject, strBody, intType, intImportance)
Dim objMessage ' As CDO.Message
objMessage = Server.CreateObject("CDO.Message")
With objMessage
   .Fields("urn:schemas:httpmail:importance").Value = intImportance
   .Fields("urn:schemas:httpmail:priority").Value = intImportance - 1
   Select Case intImportance
      Case 0
         .Fields("urn:schemas:mailheader:X-Priority").Value = 5
      Case 1
         .Fields("urn:schemas:mailheader:X-Priority").Value = 3
      Case 2
         .Fields("urn:schemas:mailheader:X-Priority").Value = 1
      Case Else
         .Fields("urn:schemas:mailheader:X-Priority").Value = 0
   End Select
   .Fields("urn:schemas:mailheader:X-MSMail-Priority").Value = intImportance
   If Not isNull(strSender) and strSender  strFrom then
      .Fields("urn:schemas:mailheader:return-path").Value = strSender
      .Fields("urn:schemas:mailheader:reply-to").Value = strFrom
   End If
   .Fields.Update()
   .To = strTo
   If Not isNull(strSender) and strSender  strFrom then
      .Sender = strSender
   End If
   If Not isNull(strBcc) Then
      .BCC = strBcc
   End If
   .From = strFrom
   .Subject = strSubject
   If CInt(intType) = 1 Then
      .TextBody = strBody
   Else
      .HTMLBody = strBody
   End If
   .Send()
End With
objMessage = Nothing
End Sub

This is generally useful for web generated emails (like send a friend forms etc.), simply specify the users address as strFrom and a generic local address (noreply@mydomain.com) as strSender.

More generally, here are some good CDO examples.

Posted in Spam, VBScript. Tags: , , , , . Leave a Comment »