'
'  This VB Script is scheduled by enterprise manger to run every 5 minutes 
'  It retrieves POP3 emails and stores them to database 
' The ASPPOP3 service must be installed.  See: http://www.serverobjects.com/comp/Asppop3.htm
'ADO Constants
Const adCmdStoredProc = &H0004
Const adUseClient = 3
Const adInteger = 3
Const adVarChar = 200
Const adVarWChar = 202
Const adParamInput = 1
Const adDBTimeStamp = 135
Const adExecuteNoRecords = &H00000080

Function Main()
on error resume next
Dim i , strEmail1, strEmail2

' for ADO
Dim Cnxn
Dim oCmd
Dim strCnxn
Dim ClientID, CourseID

' Open a connection
Set Cnxn = CreateObject("ADODB.Connection")
strCnxn = "Provider='sqloledb';Data Source=sql.wouldyoulike2know.com;Initial Catalog='mydb';User ID=uhhuh; Password=mypassword"

Cnxn.Open strCnxn
If err.number <> 0 Then DTSPackageLog.WriteStringToLog  "Open Err=" & err.description

' for ASPPOP3
Dim Mailer
Dim mailMessageID, mailSubject, mailDate, mailFromName
Dim mailFromAddress, mailTo, mailBodyText


' Loop through all the Email Reader Directives
Set cmdERD = CreateObject("ADODB.Command")
With cmdERD
	.ActiveConnection = Cnxn
	.CommandText = "dbo.EMRX_GetDtsDirectives"
	.CommandType = adCmdStoredProc
	SET rsERD = .Execute 
End With

DO WHILE NOT rsERD.EOF		
	' Retrieve the parameters from this directive recordset
	intClientID = rsERD.Fields("ClientID").Value
	intCourseID = rsERD.Fields("CourseID").Value
	
	' open ASPPOP3 connection for this Email Reader Directive
	Set Mailer = CreateObject ("POP3svg.Mailer")
	Mailer.RemoteHost = rsERD.Fields("RemoteHost").Value
	Mailer.UserName = rsERD.Fields("UID").Value
	Mailer.Password = rsERD.Fields("PWD").Value
	Mailer.OpenPop3

	'Test the POP3 interface
	Itest = Mailer.MessageCount
	If err.number <> 0 Then DTSPackageLog.WriteStringToLog  "Open Err=" & err.description
	' read POP3 mail and insert into database
	For i = 1 To Mailer.MessageCount
		If Mailer.Retrieve(i) = True Then
			mailDate = Mailer.Date
			mailSubject = Mailer.Subject
			mailFromAddress = Mailer.FromAddress
			mailTo = Mailer.Recipients
			mailBodyText = Mailer.BodyText
			'  Use Regular Expressions to find 2 email addresses in the Email Message
			SET objRegExp = NEW RegExp
			WITH objRegExp ' Create a Regular Expression object
				.Pattern = "[\w!#$%'*+\-/=?^`{}|~][\w.!#$%'*+\-/=?^`{}|~]+@[A-Za-z0-9-]+\.[A-Za-z0-9.-]+[A-Za-z]"
				.IgnoreCase = TRUE
				.Global = TRUE ' Find only first ocurrence of the match
			END WITH
			
			SET colMatches = objRegExp.Execute(mailBodyText)
			strEmail1 = ""
			strEmail2 = ""
			For Each Match in colMatches
				IF strEmail1 = "" Then
					strEmail1 = Match.Value
				ElseIf strEmail2 = "" Then
					strEmail2 = Match.Value
				End If
			Next

			SET colMatches = Nothing
			SET objRegExp = Nothing '  Email1 and 2 may be defined at this point

			Set oCmd = CreateObject("ADODB.Command")
			With oCmd
				.ActiveConnection = Cnxn
				.ActiveConnection.CursorLocation = adUseClient
				.CommandText = "dbo.EMRX_ProcessRxEmail"
				.CommandType = adCmdStoredProc

				.Parameters.Append .CreateParameter("@ClientID", adInteger, adParamInput, , intClientID)
				.Parameters.Append .CreateParameter("@CourseID", adInteger, adParamInput, , intCourseID)
				.Parameters.Append .CreateParameter("@xEmailSubject", adVarChar, adParamInput, 255, mailSubject)
				.Parameters.Append .CreateParameter("@xEmailFromAddress", adVarChar, adParamInput, 100, mailFromAddress)
				.Parameters.Append .CreateParameter("@xEmailTo", adVarChar, adParamInput, 100, mailTo)
				.Parameters.Append .CreateParameter("@xEmailBody", adVarChar, adParamInput, 2000, mailBodyText)
				.Parameters.Append .CreateParameter("@Email1", adVarChar, adParamInput, 100, strEmail1)
				.Parameters.Append .CreateParameter("@Email2", adVarChar, adParamInput, 100, strEmail2)
				.Execute ,,adExecuteNoRecords
				If .ActiveConnection.Errors.Count > 0 Then
					' DTSPackageLog.WriteStringToLog  "StorePOP3Email  Err=" & err.description
				End If
			End With
			Set oCmd = Nothing
		Mailer.Delete(i) ' Delete this email message from the POP3 server
		End If
	Next

	' close ASP POP3 connection - this isn't reusable for other POPs
	Mailer.ClosePop3
	Set Mailer = Nothing

rsERD.Movenext
Loop ' (While)
' Clean up and Exit
rsERD.Close
SET rsERD = Nothing
SET cmdERD = Nothing
' close ADO connection
Cnxn.Close
Set Cnxn = Nothing
Main = DTSTaskExecResult_Success
End Function