Dim args, mo, x, re, re2, Matches, cErrorCreator, cListOwner, iErrorCount, cUpdated_date
iErrorCount = 1
Set args = WScript.Arguments
Set re = new regexp  'Create the RegExp object to extract 1st email address from message body
With re
	'find an email address
	.Pattern = "\b[A-Z0-9._%-]+@[A-Z0-9._%-]+\.[A-Z]{2,4}\b"
	.IgnoreCase = True
	.Global = True
End With
Set re2 = new regexp  'Create a RegExp object to filter out safe messages to list admin
With re2
	'search for safe messages
	.Pattern = "subscribe"
	.IgnoreCase = True
	.Global = True
End With

'Load the email into a message object using Quiksoft Easymail object
Set mo = CreateObject("EasyMail.Message.6")
mo.LicenseKey="xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
x = mo.loadmessage( args.Item(0), 0, 1, 0)

If re2.Test( mo.subject ) = False Then

	Set Matches = re.Execute(  mo.bodytext )   ' Execute search.
	If Matches.count > 0 Then
	   cErrorCreator = Matches.Item(0)
	End If

	'Create an ADO Connection
	Dim cn, rs, sql
	Set cn = CreateObject("ADODB.Connection")
	cn.Provider = "sqloledb"
	ProvStr = "Server=xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
	cn.Open ProvStr
	Set rs = CreateObject("ADODB.RecordSet")
	sql= "SELECT * from error_messages where error_creator = '" & cErrorCreator & "'"
	rs.Open sql, cn, 3, 3
	If rs.eof = True Then
		rs.AddNew
		rs.fields("error_creator").value = cErrorCreator
	Else
		iErrorCount = (rs.fields("error_count").value + 1)
		rs.fields("error_count").value = iErrorCount
		rs.fields("updated_date").value = Now()
	End If

	rs.fields("message_from").value = mo.FromAddr
	rs.fields("message_to").value = mo.Recipients.item(1).Address
	rs.fields("message_subject").value = mo.subject
	rs.fields("message_body").value = mo.bodytext
	rs.fields("message_date").value = mo.date

	rs.Update
	cListOwner = rs.fields("message_to").value
	cUpdated_date = rs.fields("updated_date").value
	rs.close

	sql = "select * from listserves where list_owner_email = '" & cListOwner & "'"
	rs.Open sql, cn, 3, 3
	If rs.eof = False Then
		'see if its time to purge old errors
		If DateDiff( "d", rs.fields("last_purge").value, now() ) > rs.fields("purge_interval").value Then
			sql = "DELETE FROM error_messages where message_to = '" & cListOwner & "' and updated_date < '" & ( date() - rs.fields("purge_interval").value ) & "'"
			cn.Execute sql
			rs.fields("last_purge").value = Now()
		End If

		rs.fields("last_error").value = Now()
		If iErrorCount > rs.fields("error_threshold").value Then
			If DateDiff( "d", cUpdated_date, now() ) < rs.fields("purge_interval").value Then
				remove_subscriber  cErrorCreator
			End If
		End If
		rs.Update
	End If

	rs.Close
	Set rs = Nothing
	cn.close
	Set cn = Nothing

End If

Set mo = Nothing
Set re = Nothing
Set re2 = Nothing

Function remove_subscriber( cAddress )
	Dim rs, rs1, sql
	Set rs = CreateObject("ADODB.RecordSet")
	Set rs1 = CreateObject("ADODB.RecordSet")
	sql= "SELECT * from error_messages where error_creator = '" & cErrorCreator & "'"
	rs.Open sql, cn, 3, 3
	If rs.eof = False Then

		Dim objFSO, objFTemp, objFTemp2, objTextStream
		Set objFSO = CreateObject("Scripting.FileSystemObject")

		rs1.Open "select top 0 * from addresses_dropped", cn, 3, 3
		rs1.AddNew
		rs1.fields("list_owner").value = rs.fields("message_to").value
		rs1.fields("error_subject").value = rs.fields("message_subject").value
		rs1.fields("message_body").value = rs.fields("message_body").value
		rs1.fields("error_email").value = rs.fields("error_creator").value
		rs1.fields("error_count").value = rs.fields("error_count").value
		rs1.fields("creation_date").value = rs.fields("creation_date").value
		rs1.fields("updated_date").value = rs.fields("updated_date").value
		rs1.fields("dropped_date").value = Now
		rs1.Update
		rs1.Close

		rs1.Open "SELECT * from listserves where list_owner_email = '" & rs.fields("message_to").value & "'"
		Dim cFilePath, Item
		cFilePath = rs1.fields("list_file_path").value
		rs1.close

		If objFSO.FileExists( cFilePath & "new_users.lst" ) = False Then
			Set objTextStream = objFSO.OpenTextFile(cFilePath & "users.lst", 1)
			Set objFTemp = objFSO.CreateTextFile( cFilePath & "new_users.lst", True)
			Set objFTemp2 = objFSO.CreateTextFile( cFilePath & "users.txt", True)

			Do While objTextStream.AtEndOfStream = False
				Item = Trim(Replace(Replace(objTextStream.ReadLine,"<",""),">",""))
				If Not LCase(Item) = cAddress Then
					objFTemp.WriteLine( Item )
					objFTemp2.WriteLine( "<" & Item & "> " & Item )
				End If
			Loop

			objTextStream.Close
			objFtemp.Close
			objFtemp2.Close

			Dim ib
			ib = 0
			Do While True
				If objFSO.FileExists( cFilePath & "users.lst(" & ib & ")" ) = False Then
					objFSO.CopyFile (cFilePath & "users.lst"), (cFilePath & "users.lst(" & ib & ")" ), True
					Exit Do
				Else
					ib = ib+1
				End If
			Loop
			objFSO.CopyFile (cFilePath & "new_users.lst"), (cFilePath & "users.lst"), True
			objFSO.DeleteFile (cFilePath & "new_users.lst"), True
		End If

		Set objTextStream = Nothing
		Set objFTemp = Nothing
		Set objFTemp2 = Nothing
		Set objFSO = Nothing
		rs.delete

	End If

	rs.close
	Set rs = Nothing
	Set rs1 = Nothing

End Function