By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,663 Members | 2,157 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,663 IT Pros & Developers. It's quick & easy.

How to have multiple worker threads submit to one final processing queue? - HELP

P: n/a
Hello,

I have a multithreaded windows NT service application (vb.net 2003) that I
am working on (my first one), which reads a message queue and creates
multiple threads to perform the processing for long running reports. When
the processing is complete it uses crystal reports to load a template file,
populate it, and then export it to a PDF.

It works fine so far....

Now, since few reports are run - but multiple could be submitted at the same
time, I would like to keep the longer processing multithreaded (i.e.
function ReloadReportData() in the processing module below), but then single
thread the crystal report creation/pdf export and e-mailing of the PDF, so
that additional crystal report licenses will not be required (these are very
quick once the processing has been completed). Can someone help me figure
out the best way to do this? From what I can gather in reading various
posts I believe that I would create a QUEUE (note, I don't think is the same
thing as a message queue) and then have a separate thread that is just
pulling messages off of this, and then processing. Once the processing is
done, check for another entry in the QUEUE... Is this correct? But I
haven't seen any good examples of how to do that, and how to wait for the
message.

Below you will find my current source code.

I wouldn't mind additional comments on the techniques that I finally chose
for the threading. Is this all ok? Are there better ways to do this?

Thanks in advance for any assistance!

Jim

================================================== ==========================
============================
the following is in the start up of the windows service
================================================== ==========================
============================
Private myThreadPool As ThreadPool()
Private oThread(1) As Thread

Protected Overrides Sub OnStart(ByVal args() As String)
' Write a message to the log
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService", "Serv
ice started at : " & FormatDateTime(Now(), DateFormat.LongTime),
Diagnostics.EventLogEntryType.Information, 1)

Dim i As Integer 'Thread count
Dim objMQListen As MQListen

' Declare a worker thread
Dim objThreadStart As ThreadStart

'declare the Class that will run our threads
objMQListen = New MQListen

' Create a ThreadStart object, passing the address of
objMQListener.Listen
' then set the reference and start the main MQListener thread
objThreadStart = New ThreadStart(AddressOf objMQListen.Listen)
oThread(0) = New Thread(objThreadStart)
oThread(0).Start()
End Sub

================================================== ==========================
============================
the following is the Message Queue Listener Class
================================================== ==========================
============================

Imports System.Messaging
Imports System.Threading

Public Class MQListen
Private configurationAppSettings As _
System.Configuration.AppSettingsReader = New _
System.Configuration.AppSettingsReader

'constructor accepts the necessary queue information
Sub MQListen(ByVal MachineName As String, ByVal QueueName As String)
End Sub

'One and only method that each thread uses to
Sub Listen()
Dim oThread As Thread
Dim objThreadStart As ThreadStart

'Create a MessageQueue object
Dim objMQ As System.Messaging.MessageQueue
Try
objMQ = New
System.Messaging.MessageQueue(CType(configurationA ppSettings.GetValue("Sella
rs.MessageQueue", GetType(System.String)), String))
Catch
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error connecting to MessageQueue: " & Err.Description,
Diagnostics.EventLogEntryType.Error)
Debug.WriteLine(Err.Description)
End Try
Dim myMessageBody As New MQPassedData
Dim TargetTypes(0) As System.Type
TargetTypes(0) = myMessageBody.GetType
objMQ.Formatter = New XmlMessageFormatter(TargetTypes)
myMessageBody = Nothing

'Create a Message object
Dim objMsg As Message

Try
'repeat until Interrupt received
While True
Try
'sleep in order to catch the interrupt if it has been
thrown
'Interrupt will only be processed by a thread that is in
a
'wait, sleep or join state
Thread.CurrentThread.Sleep(100)

'Set the Message object equal to the result from the
receive function
'there are 2 implementations of Receive. The one I use
requires a
'TimeSpan object which specifies the timeout period.
There is also an
'implementation of Receive which requires nothing and
will wait indefinitely
'for a message to arrive on a queue
'Timespan(?, hours, minutes, seconds)
Dim newMessageBody As New MQPassedData
objMsg = objMQ.Receive(New TimeSpan(0, 0, 0, 1))
Try
newMessageBody = objMsg.Body
Catch emsg As Exception

System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService", "Msg received
error: " & emsg.Message, Diagnostics.EventLogEntryType.Information)
' Create a ThreadStart object, passing the address of objMQListener.Listen
End Try

' Set the passed data in, and place it in a new
ThreadPool element
' The treadpool takes care of managing all the thread
issues in a very
' simple way.
Dim processingutilities As New SDRAProcessing
Dim passData As New MQPassedData
passData = newMessageBody
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf
processingutilities.ProcessMessage), passData)

' Free up memory held during processing
newMessageBody = Nothing
Catch e As ThreadInterruptedException
'catch the ThreadInterrupt from the main thread and exit
' Console.WriteLine("Exiting Thread")
Exit While
Catch excp As Exception
'Catch any exceptions thrown in receive
'MsgBox("No message received in 10 seconds")
'Console.WriteLine(excp.Message)
End Try

End While

Catch e As ThreadInterruptedException
'catch the ThreadInterrupt from the main thread and exit
'Console.WriteLine("Exiting Thread")

End Try

'exit thread

End Sub

End Class

================================================== ==========================
============================
the following is my main processing class
================================================== ==========================
============================

Imports System.Configuration
Imports System.Data
Imports System.IO
Imports System.Messaging
Imports System.Threading
Imports System.Web.Mail
Imports CrystalDecisions.CrystalReports.Engine
Imports CrystalDecisions.Shared

' This class handles the processing for each Sales Date Range Analysis
request
' that is received from the queue
Public Class SDRAProcessing
Private configurationAppSettings As _
System.Configuration.AppSettingsReader = New _
System.Configuration.AppSettingsReader

' Declare local variables to store login information for the SQL Server
' this information is read in from the configuration file which resides
in
' the same directory as the service's executable module.
Private mvarDatabaseName As String
Private mvarServerName As String
Private mvaruserName As String
Private mvarPassword As String

' Local variables to store various parameters read in from the
configuration file
' this information is read in from the configuration file which resides
in
' the same directory as the service's executable module.
Private mvarReport As String
Private mvarCrystalName As String
Private mvarTempFileDir As String
Private mvarMailTo As String
Private mvarMailFrom As String
Private mvarMailServer As String
Private mvarWebSite As String
Private mvarStyleSheet As String
Private mvarPDFViewLocation As String

' Instantiate an object containing the data passed from the web page via
the message queue
Public passData As New MQPassedData

' Local ENUMERATIONS for the EVENT ID used when writing to the Windows
Event Log
Private Enum SDRAEvent As Integer
ServiceStart = 1
ServiceStop = 2
ProcessStart = 3
ProcessStop = 4
ReloadData = 100
DeleteData = 101
ReadConfig = 200
OpenConnection = 201
CloseConnection = 202
CrystalFile = 300
CrystalLoad = 301
CrystalExport = 302
MailParamters = 400
SendMail = 401
End Enum

' This routine is ONLY called when a valid sales date range analysis
request has
' been received. Then
' 1) The requested data is loaded into a temporary database (via the
' ReloadReportData routine) off of which we can perform various
reporting tasks
' 2) A PDF file containing the report is produced using interaction
with Crystal Reports.
' 3) The PDF is e-mail to the user that submitted the report
request.
'
Public Sub ProcessMessage(ByVal passedinData As Object)

' Reference the state object passed in via the ThreadPool call to
the procedure.
' this contains the data as it was passed from the web page via the
MSMQ
passData = passedinData

' Write an event log message to show that we have received a valid
report request
Dim StartTime As Date = Now()
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Processing Started at : " & FormatDateTime(StartTime, DateFormat.LongTime)
& " on request submitted by " & passData.UserName & " for sales analysis
from " & Format(passData.StartDate, "MM/dd/yyyy") & " thru " &
Format(passData.EndDate, "MM/dd/yyyy") & ".",
Diagnostics.EventLogEntryType.Information, SDRAEvent.ProcessStart)

' Get all the configuration data items and set them to local
variables.
' If there is an error, then write an event log record, and exit the
subroutine.
Try
Report = CType(configurationAppSettings.GetValue("SDRA.Repo rt",
GetType(System.String)), String)
ServerName =
CType(configurationAppSettings.GetValue("Database. Server",
GetType(System.String)), String)
DatabaseName =
CType(configurationAppSettings.GetValue("Database. Database",
GetType(System.String)), String)
UserName =
CType(configurationAppSettings.GetValue("Database. UserName",
GetType(System.String)), String)
Password =
CType(configurationAppSettings.GetValue("Database. Password",
GetType(System.String)), String)
CrystalName =
CType(configurationAppSettings.GetValue("Report.Lo cation",
GetType(System.String)), String) & Report & ".rpt"
TempFileDir =
CType(configurationAppSettings.GetValue("Sellars.T empFileDirectory",
GetType(System.String)), String)
MailFrom = CType(configurationAppSettings.GetValue("EMail.Fro m",
GetType(System.String)), String)
WebSite =
CType(configurationAppSettings.GetValue("Sellars.W ebSite",
GetType(System.String)), String)
StyleSheet =
CType(configurationAppSettings.GetValue("Sellars.S tyleSheet",
GetType(System.String)), String)
PDFViewLocation =
CType(configurationAppSettings.GetValue("PDFViewRe port.Location",
GetType(System.String)), String)
MailServer =
CType(configurationAppSettings.GetValue("Email.SMT PServer",
GetType(System.String)), String)
Catch ex As Exception
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error reading configuration app settings: " & ex.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.ReadConfig)
Exit Sub
End Try

' Call a routine to extract all the requred data from the Invoice
Master, Invoice Detail
' place it in the CustomerDateRangeMargins table, and perform all
necessary calculations
' for the report.
ReloadReportData()

' Populate the pre-defined Crystal Report, and export it to a PDF
stored with a unique
' file name.
CreatePDF()

' Capture the time when the report creation processing completed
Dim EndTime As Date = Now

' Mail the crystal reports PDF to the user
EMailReport(StartTime, EndTime)

' Delete the temporary database tables that were used to hold the
data
DeleteReportData()

' Delete the PDF File that was created to keep the system clean
If File.Exists(PDFFileName()) Then
File.Delete(PDFFileName())
End If

' Write an event log message signifying that the valid message was
completely processed
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Processing completed at : " & FormatDateTime(EndTime, DateFormat.LongTime)
& " on request submitted by " & passData.UserName & " for sales analysis
from " & Format(passData.StartDate, "MM/dd/yyyy") & " thru " &
Format(passData.EndDate, "MM/dd/yyyy") & ".",
Diagnostics.EventLogEntryType.Information)
End Sub
' This routine loads in a pre-defined Crystal Report .rpt file that has
been set up.
' After loading the report with the correct data chosen by the user, a
PDF is created
' from the populated report and saved to disk.
Private Function CreatePDF() As Boolean
'Initialize the return value to true
Dim retvalue As Boolean = True

' Declare necessary local variables to open a Crystal Report
' and access the report parameters.
Dim crReportDocument As New ReportDocument
Dim crDatabase As Database
Dim crTables As Tables
Dim crTable As Table
Dim crTableLogOnInfo As TableLogOnInfo
Dim crConnectionInfo As ConnectionInfo

Dim crParameterFieldDefinitions As ParameterFieldDefinitions
Dim crParameterValues1 As ParameterValues
Dim crParameterDiscreteValue1 As ParameterDiscreteValue
Dim crParameterValues2 As ParameterValues
Dim crParameterDiscreteValue2 As ParameterDiscreteValue
Dim crParameterValues3 As ParameterValues
Dim crParameterDiscreteValue3 As ParameterDiscreteValue
Dim crParameterValues4 As ParameterValues
Dim crParameterDiscreteValue4 As ParameterDiscreteValue

' Create an instance of the strongly-typed report object and load
the
' correct .rpt file
Dim strReport As String
strReport = CrystalName
Try
crReportDocument.Load(strReport)
Catch e As Exception
retvalue = False
' Write an event log message
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error loading .rpt template: " & e.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.CrystalLoad)
End Try

' Create a new instance of the connectioninfo object and
' set its properties to reference the database listed in the
configuration settings.
crConnectionInfo = New ConnectionInfo
With crConnectionInfo
.ServerName = ServerName
.DatabaseName = DatabaseName
.UserID = UserName
.Password = Password
End With

'Get the tables collection from the report object
crDatabase = crReportDocument.Database
crTables = crDatabase.Tables

'Apply the logon information to each table in the collection
For Each crTable In crTables
crTableLogOnInfo = crTable.LogOnInfo
crTableLogOnInfo.ConnectionInfo = crConnectionInfo
crTable.ApplyLogOnInfo(crTableLogOnInfo)
Next

' Set the Start Date parameter value
crParameterDiscreteValue1 = New ParameterDiscreteValue
crParameterValues1 = New ParameterValues
crParameterDiscreteValue1.Value = passData.StartDate
crParameterValues1.Add(crParameterDiscreteValue1)

crReportDocument.DataDefinition.ParameterFields("S tartDate").ApplyCurrentVal
ues(crParameterValues1)

' Set the End Date parameter value
crParameterDiscreteValue2 = New ParameterDiscreteValue
crParameterValues2 = New ParameterValues
crParameterDiscreteValue2.Value = passData.EndDate
crParameterValues2.Add(crParameterDiscreteValue2)

crReportDocument.DataDefinition.ParameterFields("E ndDate").ApplyCurrentValue
s(crParameterValues2)

' Set the Request Date parameter value
crParameterDiscreteValue3 = New ParameterDiscreteValue
crParameterValues3 = New ParameterValues
crParameterDiscreteValue3.Value = passData.ReportDate
crParameterValues3.Add(crParameterDiscreteValue3)

crReportDocument.DataDefinition.ParameterFields("R equestDate").ApplyCurrentV
alues(crParameterValues3)

' Set the UserID parameter value
crParameterDiscreteValue4 = New ParameterDiscreteValue
crParameterValues4 = New ParameterValues
crParameterDiscreteValue4.Value = passData.UserID
crParameterValues4.Add(crParameterDiscreteValue4)

crReportDocument.DataDefinition.ParameterFields("U serID").ApplyCurrentValues
(crParameterValues4)

' Define and set the options necessary to save the pdf file to a
disk location
Dim crDiskFileDestinationOptions As New DiskFileDestinationOptions
crDiskFileDestinationOptions.DiskFileName = PDFFileName()
Dim crExportOption As ExportOptions = crReportDocument.ExportOptions
With crExportOption
.DestinationOptions = crDiskFileDestinationOptions
.ExportDestinationType = ExportDestinationType.DiskFile
.ExportFormatType = ExportFormatType.PortableDocFormat
End With

' Export the refreshed report using the appropriate selection
criteria
' If there is an error with this process, write an appropriate
Windows Event
' Log record.
Try
crReportDocument.Export()
Catch e As Exception
retvalue = False
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error exporting report: " & e.Message, Diagnostics.EventLogEntryType.Error,
SDRAEvent.CrystalExport)
End Try
End Function

' This function returns the physical direct file path and name of the
temporary file
' top be created and sent via e-mail
Public Function PDFFileName() As String
Return TempFileDir + PDFViewName()
End Function

' This is a unique name for a file so multiple users can access this
routine without any issues.
' A file name will be comprised of three parts:
' 1) The UserID used when the individual logged into the system.
' 2) The time that the request was submitted at the web page making
the request
' (this is necessary so the user can run multiple reports without
any problems)
' 3) The Name defined fo the report which is read in from the
configuration file.
' (this will be the same name as the crystal report .rpt file
except we use a PDF extention)
Public Function PDFViewName() As String
Return passData.UserID + Format(passData.ReportDate, "MMddyyhhmmss")
+ "_" & Report & ".pdf"
End Function

' This routine is used to run a stored procedure against the
CustomerDateRangeMargins file
' and delete all records that match the UserID and Request Date. This
is typically run
' after all processing has been completed and the e-mail sent as part of
the clean up process.
Private Function DeleteReportData() As Boolean
Dim m_objConn As New System.Data.SqlClient.SqlConnection

'try to open the connection
If Not OpenConnection(m_objConn) Then
Exit Function
End If

Dim returnvalue As Boolean = True
Dim myCommand As New
SqlClient.SqlCommand("DeleteCustomerDateRangeMargi ns", m_objConn)

' Mark the Command as a SPROC
' The timeout value of zero lets all transactions run without timing
out.
myCommand.CommandType = CommandType.StoredProcedure
myCommand.CommandTimeout = 0

' Add Parameters to SPROC
Dim parameterRequestDate As New
SqlClient.SqlParameter("@RequestDate", SqlDbType.DateTime)
parameterRequestDate.Value = passData.ReportDate
myCommand.Parameters.Add(parameterRequestDate)

Dim parameterUserID As New SqlClient.SqlParameter("@UserID",
SqlDbType.NVarChar, 15)
parameterUserID.Value = passData.UserID
myCommand.Parameters.Add(parameterUserID)

' Execute the command to perform the query request on the server
' if there is a problem, then write an appropriate Windows Event Log
record.
Try
myCommand.ExecuteNonQuery()
Catch e As Exception
returnvalue = False
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error deleting CustomerDateRangeMargins: " & e.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.DeleteData)
End Try

' Free up memory
myCommand = Nothing

' close the database connection and free up memory
CloseConnection(m_objConn)
m_objConn = Nothing

' return a flag indicating if any errors occures while this was
running
Return returnvalue
End Function

' This function calls an SQL Stored procedure. This procedure:
' 1) First deletes any old records that may match the username abd
request date
' 2) Gets all the appropriate records from the Invoice Master,
Invoice Detail and
' Customer master files.
' 3) Applies additional processing to ensure all the necessary
calculations are correct.
Private Function ReloadReportData() As Boolean
Dim m_objConn As New System.Data.SqlClient.SqlConnection

'try to open the connection
If Not OpenConnection(m_objConn) Then
Exit Function
End If

Dim returnvalue As Boolean = True
Dim myCommand As New
SqlClient.SqlCommand("ReloadCustomerDateRangeMargi ns", m_objConn)

' Mark the Command as a SPROC
myCommand.CommandType = CommandType.StoredProcedure
myCommand.CommandTimeout = 0

' Add Parameters to SPROC
Dim parameterRequestDate As New
SqlClient.SqlParameter("@RequestDate", SqlDbType.DateTime)
parameterRequestDate.Value = passData.ReportDate
myCommand.Parameters.Add(parameterRequestDate)

Dim parameterUserID As New SqlClient.SqlParameter("@UserID",
SqlDbType.NVarChar, 15)
parameterUserID.Value = passData.UserID
myCommand.Parameters.Add(parameterUserID)

Dim parameterStartDate As New SqlClient.SqlParameter("@StartDate",
SqlDbType.DateTime)
parameterStartDate.Value = passData.StartDate
myCommand.Parameters.Add(parameterStartDate)

Dim parameterEndDate As New SqlClient.SqlParameter("@EndDate",
SqlDbType.DateTime)
parameterEndDate.Value = passData.EndDate
myCommand.Parameters.Add(parameterEndDate)

' Execute the stored procedure, and if there is an error, write an
appropriate Event Log record.
Try
myCommand.ExecuteNonQuery()
Catch e As Exception
returnvalue = False
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error running ReloadCustomerDateRangeMargins: " & e.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.ReloadData)
End Try

' Free up memory
myCommand = Nothing

' close the database connection and free up memory
CloseConnection(m_objConn)
m_objConn = Nothing

' return a flag showing whether the report data was retrieved,
loaded and calculated appropriately.
Return returnvalue
End Function

' This routine e-mails the PDF file created above to the user that
submitted the request.
Private Function EMailReport(ByVal StartTime As Date, ByVal EndTime As
Date) As Integer
' Set all the necessary message routing and descriptive information.
Dim myMessage As New System.Web.Mail.MailMessage
Dim strMessage As String
Try
myMessage.To = passData.EMailAddress
myMessage.From = MailFrom
myMessage.Subject = "Sales Analysis from " &
Format(passData.StartDate, "MM/dd/yyyy") & " thru " &
Format(passData.EndDate, "MM/dd/yyyy")
myMessage.BodyFormat = MailFormat.Html
myMessage.Priority = MailPriority.High
Catch e As Exception
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error assigning email data: " & e.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.MailParamters)
Exit Function
End Try

' Set up the message body text.
strMessage = "<html><head><link href='" + WebSite + StyleSheet + "'
type='text/css' rel='stylesheet'></head><body>"
strMessage = strMessage + "<Table cellspacing=0 cellpadding=0
style='border-collapse: collapse' bordercolor='#111111' width='100%'>"

' Insert a blank line
strMessage = strMessage + "<TR class='Text'><TD>&nbsp;</TD></TR>"

' Display a header line
strMessage = strMessage + "<TR class='Text'><TD>Sales Analysis
processing was performed for data from " & Format(passData.StartDate,
"MM/dd/yyyy") & " thru " & Format(passData.EndDate, "MM/dd/yyyy") & "
</TD></TR>"

' Insert two blank lines
strMessage = strMessage + "<TR class='Text'><TD>&nbsp;</TD></TR>"

' Display the start and end times for the processing
strMessage = strMessage + "<TR class='Text'><TD>Processing was
started at: " + FormatDateTime(StartTime, DateFormat.LongTime) +
"</TD></TR>"
strMessage = strMessage + "<TR class='Text'><TD>Processing was
completed at: " + FormatDateTime(EndTime, DateFormat.LongTime) +
"</TD></TR>"

' Insert two blank lines
strMessage = strMessage + "<TR class='Text'><TD>&nbsp;</TD></TR>"

' Display a header line
strMessage = strMessage + "<TR class='Text'><TD>The completed report
is attached to this e-mail in a PDF format .</TD></TR>"

' End the table
strMessage = strMessage + "</table></body></html>"

' Set the body of the message to the text
myMessage.Body = strMessage

' Add the PDF File as an attachment
Dim objAttach As New MailAttachment(PDFFileName)

' try adding the attachment, and sending the message
Try
myMessage.Attachments.Add(objAttach)
SmtpMail.SmtpServer = MailServer
SmtpMail.Send(myMessage)
Catch ex As Exception
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error sending email: " & ex.Message, Diagnostics.EventLogEntryType.Error,
SDRAEvent.SendMail)
Exit Function
End Try

End Function

' Routine that closes the SQL connection object used to access the SQL
server.
Public Sub CloseConnection(ByVal objConnection As
System.Data.SqlClient.SqlConnection)
Try
objConnection.Close()
Catch e As Exception
' Write an event log message
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error closing connection: " & e.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.CloseConnection)
End Try
End Sub

' Routine that opens the SQL connection object used to access the SQL
server.
Public Function OpenConnection(ByVal objConnection As
System.Data.SqlClient.SqlConnection) As Boolean
Dim retvalue As Boolean = True

Try
objConnection.ConnectionString = "Server=" & ServerName &
";User=" & UserName & ";Password=" & Password & "; " _
& "Database=" & DatabaseName
objConnection.Open()
Catch e As Exception
retvalue = False
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error opening connection: " & e.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.OpenConnection)
End Try

Return retvalue
End Function

' Declare properties for all configuration data file items.
Private Property DatabaseName() As String
Get
DatabaseName = mvarDatabaseName
End Get
Set(ByVal Value As String)
mvarDatabaseName = Value
End Set
End Property

Private Property Password() As String
Get
Password = mvarPassword
End Get
Set(ByVal Value As String)
mvarPassword = Value
End Set
End Property

Private Property ServerName() As String
Get
ServerName = mvarServerName
End Get
Set(ByVal Value As String)
mvarServerName = Value
End Set
End Property

Private Property UserName() As String
Get
UserName = mvaruserName
End Get
Set(ByVal Value As String)
mvaruserName = Value
End Set
End Property

Private Property MailTo() As String
Get
MailTo = mvarMailTo
End Get
Set(ByVal Value As String)
mvarMailTo = Value
End Set
End Property

Private Property MailFrom() As String
Get
MailFrom = mvarMailFrom
End Get
Set(ByVal Value As String)
mvarMailFrom = Value
End Set
End Property

Private Property MailServer() As String
Get
MailServer = mvarMailServer
End Get
Set(ByVal Value As String)
mvarMailServer = Value
End Set
End Property

Private Property PDFViewLocation() As String
Get
PDFViewLocation = mvarPDFViewLocation
End Get
Set(ByVal Value As String)
mvarPDFViewLocation = Value
End Set
End Property

Private Property Report() As String
Get
Report = mvarReport
End Get
Set(ByVal Value As String)
mvarReport = Value
End Set
End Property

Private Property CrystalName() As String
Get
CrystalName = mvarCrystalName
End Get
Set(ByVal Value As String)
mvarCrystalName = Value
End Set
End Property

Private Property StyleSheet() As String
Get
StyleSheet = mvarStyleSheet
End Get
Set(ByVal Value As String)
mvarStyleSheet = Value
End Set
End Property

Private Property TempFileDir() As String
Get
TempFileDir = mvarTempFileDir
End Get
Set(ByVal Value As String)
mvarTempFileDir = Value
End Set
End Property

Private Property WebSite() As String
Get
WebSite = mvarWebSite
End Get
Set(ByVal Value As String)
mvarWebSite = Value
End Set
End Property

End Class
Nov 20 '05 #1
Share this Question
Share on Google+
6 Replies


P: n/a
Hi James,

|| Below you will find my current source code.

All of it. Reams of it. Enough to frighten everyone away!!

It's a shame James, but very general questions like "what do you think?"
that arrive with masses of code are usually quietly left for someone else to
answer - except that "someone else" is doing the same!!
Some ideas :-
Resubmit your query with questions that are more specific.

Cut down the code drastically to the minimum required to understand
the issue.

Do a search not just for queue but pipeline, circular buffer,
consumer/producer.

Read up on Monitors and Threads (yes, I know you have, read it again
and go deeper :-)).
The answer to your question: "QUEUE ... Is this correct?" is Yes. But I
can't get you any further than that I'm afraid. :-(

The languages.csharp newsgroup contains a lot of people who devour such
things as threading. You might like to post your query there as well - if you
can specify your query without reference to code, or if you are comfortable
translating snippets to C#. Or you can do it anyway, with your VB code (not
too much), but give them a big apology along with it.

Best of luck,
Fergus
Nov 20 '05 #2

P: n/a
Cor
Hi Fergus,
Nice mail, I was thinking the same when reading the post from James except
the part of C#.
MultiThreading was some weeks ago a very hot item in this newsgroup with big
discussions.
I think that are waves like it is now in my opinion inherriting and so.
What do you think is the part that cannot be done with VB.net?
Cor
Nov 20 '05 #3

P: n/a
Hi James,

You may take a look at the link below.
http://msdn.microsoft.com/library/de...us/csref/html/
vcwlkthreadingtutorial.asp

Regards,
Peter Huang
Microsoft Online Partner Support
Get Secure! www.microsoft.com/security
This posting is provided "as is" with no warranties and confers no rights.
--------------------
Reply-To: "James Radke" <jr*****@wi.rr.com>
From: "James Radke" <jr*****@wi.rr.com>
Subject: How to have multiple worker threads submit to one final processing queue? - HELPDate: Wed, 3 Sep 2003 14:04:42 -0500
Lines: 872
X-Priority: 3
X-MSMail-Priority: Normal
X-Newsreader: Microsoft Outlook Express 6.00.2800.1158
X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2800.1165
Message-ID: <OR**************@TK2MSFTNGP10.phx.gbl>
Newsgroups: microsoft.public.dotnet.languages.vb
NNTP-Posting-Host: cpe-24-167-241-101.wi.rr.com 24.167.241.101
Path: cpmsftngxa06.phx.gbl!TK2MSFTNGP08.phx.gbl!TK2MSFTN GP10.phx.gbl
Xref: cpmsftngxa06.phx.gbl microsoft.public.dotnet.languages.vb:133967
X-Tomcat-NG: microsoft.public.dotnet.languages.vb

Hello,

I have a multithreaded windows NT service application (vb.net 2003) that I
am working on (my first one), which reads a message queue and creates
multiple threads to perform the processing for long running reports. When
the processing is complete it uses crystal reports to load a template file,
populate it, and then export it to a PDF.

It works fine so far....

Now, since few reports are run - but multiple could be submitted at the sametime, I would like to keep the longer processing multithreaded (i.e.
function ReloadReportData() in the processing module below), but then singlethread the crystal report creation/pdf export and e-mailing of the PDF, so
that additional crystal report licenses will not be required (these are veryquick once the processing has been completed). Can someone help me figure
out the best way to do this? From what I can gather in reading various
posts I believe that I would create a QUEUE (note, I don't think is the samething as a message queue) and then have a separate thread that is just
pulling messages off of this, and then processing. Once the processing is
done, check for another entry in the QUEUE... Is this correct? But I
haven't seen any good examples of how to do that, and how to wait for the
message.

Below you will find my current source code.

I wouldn't mind additional comments on the techniques that I finally chose
for the threading. Is this all ok? Are there better ways to do this?

Thanks in advance for any assistance!

Jim

================================================= ========================== =============================
the following is in the start up of the windows service
================================================= ========================== =============================
Private myThreadPool As ThreadPool()
Private oThread(1) As Thread

Protected Overrides Sub OnStart(ByVal args() As String)
' Write a message to the log
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService", "Service started at : " & FormatDateTime(Now(), DateFormat.LongTime),
Diagnostics.EventLogEntryType.Information, 1)

Dim i As Integer 'Thread count
Dim objMQListen As MQListen

' Declare a worker thread
Dim objThreadStart As ThreadStart

'declare the Class that will run our threads
objMQListen = New MQListen

' Create a ThreadStart object, passing the address of
objMQListener.Listen
' then set the reference and start the main MQListener thread
objThreadStart = New ThreadStart(AddressOf objMQListen.Listen)
oThread(0) = New Thread(objThreadStart)
oThread(0).Start()
End Sub

================================================= ========================== =============================
the following is the Message Queue Listener Class
================================================= ========================== =============================

Imports System.Messaging
Imports System.Threading

Public Class MQListen
Private configurationAppSettings As _
System.Configuration.AppSettingsReader = New _
System.Configuration.AppSettingsReader

'constructor accepts the necessary queue information
Sub MQListen(ByVal MachineName As String, ByVal QueueName As String)
End Sub

'One and only method that each thread uses to
Sub Listen()
Dim oThread As Thread
Dim objThreadStart As ThreadStart

'Create a MessageQueue object
Dim objMQ As System.Messaging.MessageQueue
Try
objMQ = New
System.Messaging.MessageQueue(CType(configuration AppSettings.GetValue("Sell ars.MessageQueue", GetType(System.String)), String))
Catch
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error connecting to MessageQueue: " & Err.Description,
Diagnostics.EventLogEntryType.Error)
Debug.WriteLine(Err.Description)
End Try
Dim myMessageBody As New MQPassedData
Dim TargetTypes(0) As System.Type
TargetTypes(0) = myMessageBody.GetType
objMQ.Formatter = New XmlMessageFormatter(TargetTypes)
myMessageBody = Nothing

'Create a Message object
Dim objMsg As Message

Try
'repeat until Interrupt received
While True
Try
'sleep in order to catch the interrupt if it has been
thrown
'Interrupt will only be processed by a thread that is ina
'wait, sleep or join state
Thread.CurrentThread.Sleep(100)

'Set the Message object equal to the result from the
receive function
'there are 2 implementations of Receive. The one I use
requires a
'TimeSpan object which specifies the timeout period.
There is also an
'implementation of Receive which requires nothing and
will wait indefinitely
'for a message to arrive on a queue
'Timespan(?, hours, minutes, seconds)
Dim newMessageBody As New MQPassedData
objMsg = objMQ.Receive(New TimeSpan(0, 0, 0, 1))
Try
newMessageBody = objMsg.Body
Catch emsg As Exception

System.Diagnostics.EventLog.WriteEntry("SellarsRe portService", "Msg receivederror: " & emsg.Message, Diagnostics.EventLogEntryType.Information)
' Create a ThreadStart object, passing the address of objMQListener.Listen
End Try

' Set the passed data in, and place it in a new
ThreadPool element
' The treadpool takes care of managing all the thread
issues in a very
' simple way.
Dim processingutilities As New SDRAProcessing
Dim passData As New MQPassedData
passData = newMessageBody
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf
processingutilities.ProcessMessage), passData)

' Free up memory held during processing
newMessageBody = Nothing
Catch e As ThreadInterruptedException
'catch the ThreadInterrupt from the main thread and exit ' Console.WriteLine("Exiting Thread")
Exit While
Catch excp As Exception
'Catch any exceptions thrown in receive
'MsgBox("No message received in 10 seconds")
'Console.WriteLine(excp.Message)
End Try

End While

Catch e As ThreadInterruptedException
'catch the ThreadInterrupt from the main thread and exit
'Console.WriteLine("Exiting Thread")

End Try

'exit thread

End Sub

End Class

================================================= ========================== =============================
the following is my main processing class
================================================= ========================== =============================

Imports System.Configuration
Imports System.Data
Imports System.IO
Imports System.Messaging
Imports System.Threading
Imports System.Web.Mail
Imports CrystalDecisions.CrystalReports.Engine
Imports CrystalDecisions.Shared

' This class handles the processing for each Sales Date Range Analysis
request
' that is received from the queue
Public Class SDRAProcessing
Private configurationAppSettings As _
System.Configuration.AppSettingsReader = New _
System.Configuration.AppSettingsReader

' Declare local variables to store login information for the SQL Server
' this information is read in from the configuration file which resides
in
' the same directory as the service's executable module.
Private mvarDatabaseName As String
Private mvarServerName As String
Private mvaruserName As String
Private mvarPassword As String

' Local variables to store various parameters read in from the
configuration file
' this information is read in from the configuration file which resides
in
' the same directory as the service's executable module.
Private mvarReport As String
Private mvarCrystalName As String
Private mvarTempFileDir As String
Private mvarMailTo As String
Private mvarMailFrom As String
Private mvarMailServer As String
Private mvarWebSite As String
Private mvarStyleSheet As String
Private mvarPDFViewLocation As String

' Instantiate an object containing the data passed from the web page viathe message queue
Public passData As New MQPassedData

' Local ENUMERATIONS for the EVENT ID used when writing to the Windows
Event Log
Private Enum SDRAEvent As Integer
ServiceStart = 1
ServiceStop = 2
ProcessStart = 3
ProcessStop = 4
ReloadData = 100
DeleteData = 101
ReadConfig = 200
OpenConnection = 201
CloseConnection = 202
CrystalFile = 300
CrystalLoad = 301
CrystalExport = 302
MailParamters = 400
SendMail = 401
End Enum

' This routine is ONLY called when a valid sales date range analysis
request has
' been received. Then
' 1) The requested data is loaded into a temporary database (via the ' ReloadReportData routine) off of which we can perform various
reporting tasks
' 2) A PDF file containing the report is produced using interaction
with Crystal Reports.
' 3) The PDF is e-mail to the user that submitted the report
request.
'
Public Sub ProcessMessage(ByVal passedinData As Object)

' Reference the state object passed in via the ThreadPool call to
the procedure.
' this contains the data as it was passed from the web page via the
MSMQ
passData = passedinData

' Write an event log message to show that we have received a valid
report request
Dim StartTime As Date = Now()
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Processing Started at : " & FormatDateTime(StartTime, DateFormat.LongTime)
& " on request submitted by " & passData.UserName & " for sales analysis
from " & Format(passData.StartDate, "MM/dd/yyyy") & " thru " &
Format(passData.EndDate, "MM/dd/yyyy") & ".",
Diagnostics.EventLogEntryType.Information, SDRAEvent.ProcessStart)

' Get all the configuration data items and set them to local
variables.
' If there is an error, then write an event log record, and exit thesubroutine.
Try
Report = CType(configurationAppSettings.GetValue("SDRA.Repo rt",
GetType(System.String)), String)
ServerName =
CType(configurationAppSettings.GetValue("Database .Server",
GetType(System.String)), String)
DatabaseName =
CType(configurationAppSettings.GetValue("Database .Database",
GetType(System.String)), String)
UserName =
CType(configurationAppSettings.GetValue("Database .UserName",
GetType(System.String)), String)
Password =
CType(configurationAppSettings.GetValue("Database .Password",
GetType(System.String)), String)
CrystalName =
CType(configurationAppSettings.GetValue("Report.L ocation",
GetType(System.String)), String) & Report & ".rpt"
TempFileDir =
CType(configurationAppSettings.GetValue("Sellars. TempFileDirectory",
GetType(System.String)), String)
MailFrom = CType(configurationAppSettings.GetValue("EMail.Fro m",GetType(System.String)), String)
WebSite =
CType(configurationAppSettings.GetValue("Sellars. WebSite",
GetType(System.String)), String)
StyleSheet =
CType(configurationAppSettings.GetValue("Sellars. StyleSheet",
GetType(System.String)), String)
PDFViewLocation =
CType(configurationAppSettings.GetValue("PDFViewR eport.Location",
GetType(System.String)), String)
MailServer =
CType(configurationAppSettings.GetValue("Email.SM TPServer",
GetType(System.String)), String)
Catch ex As Exception
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error reading configuration app settings: " & ex.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.ReadConfig)
Exit Sub
End Try

' Call a routine to extract all the requred data from the Invoice
Master, Invoice Detail
' place it in the CustomerDateRangeMargins table, and perform all
necessary calculations
' for the report.
ReloadReportData()

' Populate the pre-defined Crystal Report, and export it to a PDF
stored with a unique
' file name.
CreatePDF()

' Capture the time when the report creation processing completed
Dim EndTime As Date = Now

' Mail the crystal reports PDF to the user
EMailReport(StartTime, EndTime)

' Delete the temporary database tables that were used to hold the
data
DeleteReportData()

' Delete the PDF File that was created to keep the system clean
If File.Exists(PDFFileName()) Then
File.Delete(PDFFileName())
End If

' Write an event log message signifying that the valid message was
completely processed
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Processing completed at : " & FormatDateTime(EndTime, DateFormat.LongTime)
& " on request submitted by " & passData.UserName & " for sales analysis
from " & Format(passData.StartDate, "MM/dd/yyyy") & " thru " &
Format(passData.EndDate, "MM/dd/yyyy") & ".",
Diagnostics.EventLogEntryType.Information)
End Sub
' This routine loads in a pre-defined Crystal Report .rpt file that has
been set up.
' After loading the report with the correct data chosen by the user, a
PDF is created
' from the populated report and saved to disk.
Private Function CreatePDF() As Boolean
'Initialize the return value to true
Dim retvalue As Boolean = True

' Declare necessary local variables to open a Crystal Report
' and access the report parameters.
Dim crReportDocument As New ReportDocument
Dim crDatabase As Database
Dim crTables As Tables
Dim crTable As Table
Dim crTableLogOnInfo As TableLogOnInfo
Dim crConnectionInfo As ConnectionInfo

Dim crParameterFieldDefinitions As ParameterFieldDefinitions
Dim crParameterValues1 As ParameterValues
Dim crParameterDiscreteValue1 As ParameterDiscreteValue
Dim crParameterValues2 As ParameterValues
Dim crParameterDiscreteValue2 As ParameterDiscreteValue
Dim crParameterValues3 As ParameterValues
Dim crParameterDiscreteValue3 As ParameterDiscreteValue
Dim crParameterValues4 As ParameterValues
Dim crParameterDiscreteValue4 As ParameterDiscreteValue

' Create an instance of the strongly-typed report object and load
the
' correct .rpt file
Dim strReport As String
strReport = CrystalName
Try
crReportDocument.Load(strReport)
Catch e As Exception
retvalue = False
' Write an event log message
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error loading .rpt template: " & e.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.CrystalLoad)
End Try

' Create a new instance of the connectioninfo object and
' set its properties to reference the database listed in the
configuration settings.
crConnectionInfo = New ConnectionInfo
With crConnectionInfo
.ServerName = ServerName
.DatabaseName = DatabaseName
.UserID = UserName
.Password = Password
End With

'Get the tables collection from the report object
crDatabase = crReportDocument.Database
crTables = crDatabase.Tables

'Apply the logon information to each table in the collection
For Each crTable In crTables
crTableLogOnInfo = crTable.LogOnInfo
crTableLogOnInfo.ConnectionInfo = crConnectionInfo
crTable.ApplyLogOnInfo(crTableLogOnInfo)
Next

' Set the Start Date parameter value
crParameterDiscreteValue1 = New ParameterDiscreteValue
crParameterValues1 = New ParameterValues
crParameterDiscreteValue1.Value = passData.StartDate
crParameterValues1.Add(crParameterDiscreteValue1)

crReportDocument.DataDefinition.ParameterFields(" StartDate").ApplyCurrentVa lues(crParameterValues1)

' Set the End Date parameter value
crParameterDiscreteValue2 = New ParameterDiscreteValue
crParameterValues2 = New ParameterValues
crParameterDiscreteValue2.Value = passData.EndDate
crParameterValues2.Add(crParameterDiscreteValue2)

crReportDocument.DataDefinition.ParameterFields(" EndDate").ApplyCurrentValu es(crParameterValues2)

' Set the Request Date parameter value
crParameterDiscreteValue3 = New ParameterDiscreteValue
crParameterValues3 = New ParameterValues
crParameterDiscreteValue3.Value = passData.ReportDate
crParameterValues3.Add(crParameterDiscreteValue3)

crReportDocument.DataDefinition.ParameterFields(" RequestDate").ApplyCurrent Values(crParameterValues3)

' Set the UserID parameter value
crParameterDiscreteValue4 = New ParameterDiscreteValue
crParameterValues4 = New ParameterValues
crParameterDiscreteValue4.Value = passData.UserID
crParameterValues4.Add(crParameterDiscreteValue4)

crReportDocument.DataDefinition.ParameterFields(" UserID").ApplyCurrentValue s(crParameterValues4)

' Define and set the options necessary to save the pdf file to a
disk location
Dim crDiskFileDestinationOptions As New DiskFileDestinationOptions
crDiskFileDestinationOptions.DiskFileName = PDFFileName()
Dim crExportOption As ExportOptions = crReportDocument.ExportOptions With crExportOption
.DestinationOptions = crDiskFileDestinationOptions
.ExportDestinationType = ExportDestinationType.DiskFile
.ExportFormatType = ExportFormatType.PortableDocFormat
End With

' Export the refreshed report using the appropriate selection
criteria
' If there is an error with this process, write an appropriate
Windows Event
' Log record.
Try
crReportDocument.Export()
Catch e As Exception
retvalue = False
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error exporting report: " & e.Message, Diagnostics.EventLogEntryType.Error,SDRAEvent.CrystalExport)
End Try
End Function

' This function returns the physical direct file path and name of the
temporary file
' top be created and sent via e-mail
Public Function PDFFileName() As String
Return TempFileDir + PDFViewName()
End Function

' This is a unique name for a file so multiple users can access this
routine without any issues.
' A file name will be comprised of three parts:
' 1) The UserID used when the individual logged into the system.
' 2) The time that the request was submitted at the web page making
the request
' (this is necessary so the user can run multiple reports without
any problems)
' 3) The Name defined fo the report which is read in from the
configuration file.
' (this will be the same name as the crystal report .rpt file
except we use a PDF extention)
Public Function PDFViewName() As String
Return passData.UserID + Format(passData.ReportDate, "MMddyyhhmmss")+ "_" & Report & ".pdf"
End Function

' This routine is used to run a stored procedure against the
CustomerDateRangeMargins file
' and delete all records that match the UserID and Request Date. This
is typically run
' after all processing has been completed and the e-mail sent as part ofthe clean up process.
Private Function DeleteReportData() As Boolean
Dim m_objConn As New System.Data.SqlClient.SqlConnection

'try to open the connection
If Not OpenConnection(m_objConn) Then
Exit Function
End If

Dim returnvalue As Boolean = True
Dim myCommand As New
SqlClient.SqlCommand("DeleteCustomerDateRangeMarg ins", m_objConn)

' Mark the Command as a SPROC
' The timeout value of zero lets all transactions run without timingout.
myCommand.CommandType = CommandType.StoredProcedure
myCommand.CommandTimeout = 0

' Add Parameters to SPROC
Dim parameterRequestDate As New
SqlClient.SqlParameter("@RequestDate", SqlDbType.DateTime)
parameterRequestDate.Value = passData.ReportDate
myCommand.Parameters.Add(parameterRequestDate)

Dim parameterUserID As New SqlClient.SqlParameter("@UserID",
SqlDbType.NVarChar, 15)
parameterUserID.Value = passData.UserID
myCommand.Parameters.Add(parameterUserID)

' Execute the command to perform the query request on the server
' if there is a problem, then write an appropriate Windows Event Logrecord.
Try
myCommand.ExecuteNonQuery()
Catch e As Exception
returnvalue = False
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error deleting CustomerDateRangeMargins: " & e.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.DeleteData)
End Try

' Free up memory
myCommand = Nothing

' close the database connection and free up memory
CloseConnection(m_objConn)
m_objConn = Nothing

' return a flag indicating if any errors occures while this was
running
Return returnvalue
End Function

' This function calls an SQL Stored procedure. This procedure:
' 1) First deletes any old records that may match the username abd
request date
' 2) Gets all the appropriate records from the Invoice Master,
Invoice Detail and
' Customer master files.
' 3) Applies additional processing to ensure all the necessary
calculations are correct.
Private Function ReloadReportData() As Boolean
Dim m_objConn As New System.Data.SqlClient.SqlConnection

'try to open the connection
If Not OpenConnection(m_objConn) Then
Exit Function
End If

Dim returnvalue As Boolean = True
Dim myCommand As New
SqlClient.SqlCommand("ReloadCustomerDateRangeMarg ins", m_objConn)

' Mark the Command as a SPROC
myCommand.CommandType = CommandType.StoredProcedure
myCommand.CommandTimeout = 0

' Add Parameters to SPROC
Dim parameterRequestDate As New
SqlClient.SqlParameter("@RequestDate", SqlDbType.DateTime)
parameterRequestDate.Value = passData.ReportDate
myCommand.Parameters.Add(parameterRequestDate)

Dim parameterUserID As New SqlClient.SqlParameter("@UserID",
SqlDbType.NVarChar, 15)
parameterUserID.Value = passData.UserID
myCommand.Parameters.Add(parameterUserID)

Dim parameterStartDate As New SqlClient.SqlParameter("@StartDate",
SqlDbType.DateTime)
parameterStartDate.Value = passData.StartDate
myCommand.Parameters.Add(parameterStartDate)

Dim parameterEndDate As New SqlClient.SqlParameter("@EndDate",
SqlDbType.DateTime)
parameterEndDate.Value = passData.EndDate
myCommand.Parameters.Add(parameterEndDate)

' Execute the stored procedure, and if there is an error, write an
appropriate Event Log record.
Try
myCommand.ExecuteNonQuery()
Catch e As Exception
returnvalue = False
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error running ReloadCustomerDateRangeMargins: " & e.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.ReloadData)
End Try

' Free up memory
myCommand = Nothing

' close the database connection and free up memory
CloseConnection(m_objConn)
m_objConn = Nothing

' return a flag showing whether the report data was retrieved,
loaded and calculated appropriately.
Return returnvalue
End Function

' This routine e-mails the PDF file created above to the user that
submitted the request.
Private Function EMailReport(ByVal StartTime As Date, ByVal EndTime As
Date) As Integer
' Set all the necessary message routing and descriptive information. Dim myMessage As New System.Web.Mail.MailMessage
Dim strMessage As String
Try
myMessage.To = passData.EMailAddress
myMessage.From = MailFrom
myMessage.Subject = "Sales Analysis from " &
Format(passData.StartDate, "MM/dd/yyyy") & " thru " &
Format(passData.EndDate, "MM/dd/yyyy")
myMessage.BodyFormat = MailFormat.Html
myMessage.Priority = MailPriority.High
Catch e As Exception
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error assigning email data: " & e.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.MailParamters)
Exit Function
End Try

' Set up the message body text.
strMessage = "<html><head><link href='" + WebSite + StyleSheet + "'
type='text/css' rel='stylesheet'></head><body>"
strMessage = strMessage + "<Table cellspacing=0 cellpadding=0
style='border-collapse: collapse' bordercolor='#111111' width='100%'>"

' Insert a blank line
strMessage = strMessage + "<TR class='Text'><TD>&nbsp;</TD></TR>"

' Display a header line
strMessage = strMessage + "<TR class='Text'><TD>Sales Analysis
processing was performed for data from " & Format(passData.StartDate,
"MM/dd/yyyy") & " thru " & Format(passData.EndDate, "MM/dd/yyyy") & "
</TD></TR>"

' Insert two blank lines
strMessage = strMessage + "<TR class='Text'><TD>&nbsp;</TD></TR>"

' Display the start and end times for the processing
strMessage = strMessage + "<TR class='Text'><TD>Processing was
started at: " + FormatDateTime(StartTime, DateFormat.LongTime) +
"</TD></TR>"
strMessage = strMessage + "<TR class='Text'><TD>Processing was
completed at: " + FormatDateTime(EndTime, DateFormat.LongTime) +
"</TD></TR>"

' Insert two blank lines
strMessage = strMessage + "<TR class='Text'><TD>&nbsp;</TD></TR>"

' Display a header line
strMessage = strMessage + "<TR class='Text'><TD>The completed reportis attached to this e-mail in a PDF format .</TD></TR>"

' End the table
strMessage = strMessage + "</table></body></html>"

' Set the body of the message to the text
myMessage.Body = strMessage

' Add the PDF File as an attachment
Dim objAttach As New MailAttachment(PDFFileName)

' try adding the attachment, and sending the message
Try
myMessage.Attachments.Add(objAttach)
SmtpMail.SmtpServer = MailServer
SmtpMail.Send(myMessage)
Catch ex As Exception
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error sending email: " & ex.Message, Diagnostics.EventLogEntryType.Error,
SDRAEvent.SendMail)
Exit Function
End Try

End Function

' Routine that closes the SQL connection object used to access the SQL
server.
Public Sub CloseConnection(ByVal objConnection As
System.Data.SqlClient.SqlConnection)
Try
objConnection.Close()
Catch e As Exception
' Write an event log message
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error closing connection: " & e.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.CloseConnection)
End Try
End Sub

' Routine that opens the SQL connection object used to access the SQL
server.
Public Function OpenConnection(ByVal objConnection As
System.Data.SqlClient.SqlConnection) As Boolean
Dim retvalue As Boolean = True

Try
objConnection.ConnectionString = "Server=" & ServerName &
";User=" & UserName & ";Password=" & Password & "; " _
& "Database=" & DatabaseName
objConnection.Open()
Catch e As Exception
retvalue = False
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error opening connection: " & e.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.OpenConnection)
End Try

Return retvalue
End Function

' Declare properties for all configuration data file items.
Private Property DatabaseName() As String
Get
DatabaseName = mvarDatabaseName
End Get
Set(ByVal Value As String)
mvarDatabaseName = Value
End Set
End Property

Private Property Password() As String
Get
Password = mvarPassword
End Get
Set(ByVal Value As String)
mvarPassword = Value
End Set
End Property

Private Property ServerName() As String
Get
ServerName = mvarServerName
End Get
Set(ByVal Value As String)
mvarServerName = Value
End Set
End Property

Private Property UserName() As String
Get
UserName = mvaruserName
End Get
Set(ByVal Value As String)
mvaruserName = Value
End Set
End Property

Private Property MailTo() As String
Get
MailTo = mvarMailTo
End Get
Set(ByVal Value As String)
mvarMailTo = Value
End Set
End Property

Private Property MailFrom() As String
Get
MailFrom = mvarMailFrom
End Get
Set(ByVal Value As String)
mvarMailFrom = Value
End Set
End Property

Private Property MailServer() As String
Get
MailServer = mvarMailServer
End Get
Set(ByVal Value As String)
mvarMailServer = Value
End Set
End Property

Private Property PDFViewLocation() As String
Get
PDFViewLocation = mvarPDFViewLocation
End Get
Set(ByVal Value As String)
mvarPDFViewLocation = Value
End Set
End Property

Private Property Report() As String
Get
Report = mvarReport
End Get
Set(ByVal Value As String)
mvarReport = Value
End Set
End Property

Private Property CrystalName() As String
Get
CrystalName = mvarCrystalName
End Get
Set(ByVal Value As String)
mvarCrystalName = Value
End Set
End Property

Private Property StyleSheet() As String
Get
StyleSheet = mvarStyleSheet
End Get
Set(ByVal Value As String)
mvarStyleSheet = Value
End Set
End Property

Private Property TempFileDir() As String
Get
TempFileDir = mvarTempFileDir
End Get
Set(ByVal Value As String)
mvarTempFileDir = Value
End Set
End Property

Private Property WebSite() As String
Get
WebSite = mvarWebSite
End Get
Set(ByVal Value As String)
mvarWebSite = Value
End Set
End Property

End Class


Nov 20 '05 #4

P: n/a
Hi James,

In addition, you may take a quick look at the link below.
http://www.codeproject.com/useritems/threadingvbnet.asp

Regards,
Peter Huang
Microsoft Online Partner Support
Get Secure! www.microsoft.com/security
This posting is provided "as is" with no warranties and confers no rights.
--------------------
Newsgroups: microsoft.public.dotnet.languages.vb
From: v-******@online.microsoft.com (Peter Huang [MSFT])
Organization: Microsoft
Date: Thu, 04 Sep 2003 08:57:07 GMT
Subject: RE: How to have multiple worker threads submit to one final processing queue? - HELPX-Tomcat-NG: microsoft.public.dotnet.languages.vb
MIME-Version: 1.0
Content-Type: text/plain
Content-Transfer-Encoding: 7bit

Hi James,

You may take a look at the link below.
http://msdn.microsoft.com/library/de...-us/csref/html /vcwlkthreadingtutorial.asp

Regards,
Peter Huang
Microsoft Online Partner Support
Get Secure! www.microsoft.com/security
This posting is provided "as is" with no warranties and confers no rights.
--------------------
Reply-To: "James Radke" <jr*****@wi.rr.com>
From: "James Radke" <jr*****@wi.rr.com>
Subject: How to have multiple worker threads submit to one finalprocessing queue? - HELP
Date: Wed, 3 Sep 2003 14:04:42 -0500
Lines: 872
X-Priority: 3
X-MSMail-Priority: Normal
X-Newsreader: Microsoft Outlook Express 6.00.2800.1158
X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2800.1165
Message-ID: <OR**************@TK2MSFTNGP10.phx.gbl>
Newsgroups: microsoft.public.dotnet.languages.vb
NNTP-Posting-Host: cpe-24-167-241-101.wi.rr.com 24.167.241.101
Path: cpmsftngxa06.phx.gbl!TK2MSFTNGP08.phx.gbl!TK2MSFTN GP10.phx.gbl
Xref: cpmsftngxa06.phx.gbl microsoft.public.dotnet.languages.vb:133967
X-Tomcat-NG: microsoft.public.dotnet.languages.vb

Hello,

I have a multithreaded windows NT service application (vb.net 2003) that I
am working on (my first one), which reads a message queue and creates
multiple threads to perform the processing for long running reports. When
the processing is complete it uses crystal reports to load a template file,populate it, and then export it to a PDF.

It works fine so far....

Now, since few reports are run - but multiple could be submitted at the

same
time, I would like to keep the longer processing multithreaded (i.e.
function ReloadReportData() in the processing module below), but then

single
thread the crystal report creation/pdf export and e-mailing of the PDF, so
that additional crystal report licenses will not be required (these are

very
quick once the processing has been completed). Can someone help me figure
out the best way to do this? From what I can gather in reading various
posts I believe that I would create a QUEUE (note, I don't think is the

same
thing as a message queue) and then have a separate thread that is just
pulling messages off of this, and then processing. Once the processing is
done, check for another entry in the QUEUE... Is this correct? But I
haven't seen any good examples of how to do that, and how to wait for the
message.

Below you will find my current source code.

I wouldn't mind additional comments on the techniques that I finally chose
for the threading. Is this all ok? Are there better ways to do this?

Thanks in advance for any assistance!

Jim

================================================ ========================== ==
============================
the following is in the start up of the windows service
================================================ ==========================
==
============================
Private myThreadPool As ThreadPool()
Private oThread(1) As Thread

Protected Overrides Sub OnStart(ByVal args() As String)
' Write a message to the log
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService","Serv
ice started at : " & FormatDateTime(Now(), DateFormat.LongTime),
Diagnostics.EventLogEntryType.Information, 1)

Dim i As Integer 'Thread count
Dim objMQListen As MQListen

' Declare a worker thread
Dim objThreadStart As ThreadStart

'declare the Class that will run our threads
objMQListen = New MQListen

' Create a ThreadStart object, passing the address of
objMQListener.Listen
' then set the reference and start the main MQListener thread
objThreadStart = New ThreadStart(AddressOf objMQListen.Listen)
oThread(0) = New Thread(objThreadStart)
oThread(0).Start()
End Sub

================================================ ==========================

==
============================
the following is the Message Queue Listener Class
================================================ ==========================
==
============================

Imports System.Messaging
Imports System.Threading

Public Class MQListen
Private configurationAppSettings As _
System.Configuration.AppSettingsReader = New _
System.Configuration.AppSettingsReader

'constructor accepts the necessary queue information
Sub MQListen(ByVal MachineName As String, ByVal QueueName As String)
End Sub

'One and only method that each thread uses to
Sub Listen()
Dim oThread As Thread
Dim objThreadStart As ThreadStart

'Create a MessageQueue object
Dim objMQ As System.Messaging.MessageQueue
Try
objMQ = New
System.Messaging.MessageQueue(CType(configuratio nAppSettings.GetValue("Sel
la
rs.MessageQueue", GetType(System.String)), String))
Catch
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error connecting to MessageQueue: " & Err.Description,
Diagnostics.EventLogEntryType.Error)
Debug.WriteLine(Err.Description)
End Try
Dim myMessageBody As New MQPassedData
Dim TargetTypes(0) As System.Type
TargetTypes(0) = myMessageBody.GetType
objMQ.Formatter = New XmlMessageFormatter(TargetTypes)
myMessageBody = Nothing

'Create a Message object
Dim objMsg As Message

Try
'repeat until Interrupt received
While True
Try
'sleep in order to catch the interrupt if it has been
thrown
'Interrupt will only be processed by a thread that isin
a
'wait, sleep or join state
Thread.CurrentThread.Sleep(100)

'Set the Message object equal to the result from the
receive function
'there are 2 implementations of Receive. The one I

userequires a
'TimeSpan object which specifies the timeout period.
There is also an
'implementation of Receive which requires nothing and
will wait indefinitely
'for a message to arrive on a queue
'Timespan(?, hours, minutes, seconds)
Dim newMessageBody As New MQPassedData
objMsg = objMQ.Receive(New TimeSpan(0, 0, 0, 1))
Try
newMessageBody = objMsg.Body
Catch emsg As Exception

System.Diagnostics.EventLog.WriteEntry("SellarsR eportService", "Msg

received
error: " & emsg.Message, Diagnostics.EventLogEntryType.Information)
' Create a ThreadStart object, passing the address of objMQListener.Listen
End Try

' Set the passed data in, and place it in a new
ThreadPool element
' The treadpool takes care of managing all the thread
issues in a very
' simple way.
Dim processingutilities As New SDRAProcessing
Dim passData As New MQPassedData
passData = newMessageBody
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOfprocessingutilities.ProcessMessage), passData)

' Free up memory held during processing
newMessageBody = Nothing
Catch e As ThreadInterruptedException
'catch the ThreadInterrupt from the main thread and

exit
' Console.WriteLine("Exiting Thread")
Exit While
Catch excp As Exception
'Catch any exceptions thrown in receive
'MsgBox("No message received in 10 seconds")
'Console.WriteLine(excp.Message)
End Try

End While

Catch e As ThreadInterruptedException
'catch the ThreadInterrupt from the main thread and exit
'Console.WriteLine("Exiting Thread")

End Try

'exit thread

End Sub

End Class

================================================ ========================== ==
============================
the following is my main processing class
================================================ ==========================
==
============================

Imports System.Configuration
Imports System.Data
Imports System.IO
Imports System.Messaging
Imports System.Threading
Imports System.Web.Mail
Imports CrystalDecisions.CrystalReports.Engine
Imports CrystalDecisions.Shared

' This class handles the processing for each Sales Date Range Analysis
request
' that is received from the queue
Public Class SDRAProcessing
Private configurationAppSettings As _
System.Configuration.AppSettingsReader = New _
System.Configuration.AppSettingsReader

' Declare local variables to store login information for the SQL
Server ' this information is read in from the configuration file which residesin
' the same directory as the service's executable module.
Private mvarDatabaseName As String
Private mvarServerName As String
Private mvaruserName As String
Private mvarPassword As String

' Local variables to store various parameters read in from the
configuration file
' this information is read in from the configuration file which residesin
' the same directory as the service's executable module.
Private mvarReport As String
Private mvarCrystalName As String
Private mvarTempFileDir As String
Private mvarMailTo As String
Private mvarMailFrom As String
Private mvarMailServer As String
Private mvarWebSite As String
Private mvarStyleSheet As String
Private mvarPDFViewLocation As String

' Instantiate an object containing the data passed from the web page

via
the message queue
Public passData As New MQPassedData

' Local ENUMERATIONS for the EVENT ID used when writing to the Windows
Event Log
Private Enum SDRAEvent As Integer
ServiceStart = 1
ServiceStop = 2
ProcessStart = 3
ProcessStop = 4
ReloadData = 100
DeleteData = 101
ReadConfig = 200
OpenConnection = 201
CloseConnection = 202
CrystalFile = 300
CrystalLoad = 301
CrystalExport = 302
MailParamters = 400
SendMail = 401
End Enum

' This routine is ONLY called when a valid sales date range analysis
request has
' been received. Then
' 1) The requested data is loaded into a temporary database (via

the
' ReloadReportData routine) off of which we can perform various
reporting tasks
' 2) A PDF file containing the report is produced using interactionwith Crystal Reports.
' 3) The PDF is e-mail to the user that submitted the report
request.
'
Public Sub ProcessMessage(ByVal passedinData As Object)

' Reference the state object passed in via the ThreadPool call to
the procedure.
' this contains the data as it was passed from the web page via theMSMQ
passData = passedinData

' Write an event log message to show that we have received a valid
report request
Dim StartTime As Date = Now()
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Processing Started at : " & FormatDateTime(StartTime, DateFormat.LongTime)& " on request submitted by " & passData.UserName & " for sales analysis
from " & Format(passData.StartDate, "MM/dd/yyyy") & " thru " &
Format(passData.EndDate, "MM/dd/yyyy") & ".",
Diagnostics.EventLogEntryType.Information, SDRAEvent.ProcessStart)

' Get all the configuration data items and set them to local
variables.
' If there is an error, then write an event log record, and exit

the
subroutine.
Try
Report = CType(configurationAppSettings.GetValue("SDRA.Repo rt",GetType(System.String)), String)
ServerName =
CType(configurationAppSettings.GetValue("Databas e.Server",
GetType(System.String)), String)
DatabaseName =
CType(configurationAppSettings.GetValue("Databas e.Database",
GetType(System.String)), String)
UserName =
CType(configurationAppSettings.GetValue("Databas e.UserName",
GetType(System.String)), String)
Password =
CType(configurationAppSettings.GetValue("Databas e.Password",
GetType(System.String)), String)
CrystalName =
CType(configurationAppSettings.GetValue("Report. Location",
GetType(System.String)), String) & Report & ".rpt"
TempFileDir =
CType(configurationAppSettings.GetValue("Sellars .TempFileDirectory",
GetType(System.String)), String)
MailFrom =

CType(configurationAppSettings.GetValue("EMail.Fr om",
GetType(System.String)), String)
WebSite =
CType(configurationAppSettings.GetValue("Sellars .WebSite",
GetType(System.String)), String)
StyleSheet =
CType(configurationAppSettings.GetValue("Sellars .StyleSheet",
GetType(System.String)), String)
PDFViewLocation =
CType(configurationAppSettings.GetValue("PDFView Report.Location",
GetType(System.String)), String)
MailServer =
CType(configurationAppSettings.GetValue("Email.S MTPServer",
GetType(System.String)), String)
Catch ex As Exception
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error reading configuration app settings: " & ex.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.ReadConfig)
Exit Sub
End Try

' Call a routine to extract all the requred data from the Invoice
Master, Invoice Detail
' place it in the CustomerDateRangeMargins table, and perform all
necessary calculations
' for the report.
ReloadReportData()

' Populate the pre-defined Crystal Report, and export it to a PDF
stored with a unique
' file name.
CreatePDF()

' Capture the time when the report creation processing completed
Dim EndTime As Date = Now

' Mail the crystal reports PDF to the user
EMailReport(StartTime, EndTime)

' Delete the temporary database tables that were used to hold the
data
DeleteReportData()

' Delete the PDF File that was created to keep the system clean
If File.Exists(PDFFileName()) Then
File.Delete(PDFFileName())
End If

' Write an event log message signifying that the valid message was
completely processed
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Processing completed at : " & FormatDateTime(EndTime, DateFormat.LongTime)& " on request submitted by " & passData.UserName & " for sales analysis
from " & Format(passData.StartDate, "MM/dd/yyyy") & " thru " &
Format(passData.EndDate, "MM/dd/yyyy") & ".",
Diagnostics.EventLogEntryType.Information)
End Sub
' This routine loads in a pre-defined Crystal Report .rpt file that hasbeen set up.
' After loading the report with the correct data chosen by the user, a
PDF is created
' from the populated report and saved to disk.
Private Function CreatePDF() As Boolean
'Initialize the return value to true
Dim retvalue As Boolean = True

' Declare necessary local variables to open a Crystal Report
' and access the report parameters.
Dim crReportDocument As New ReportDocument
Dim crDatabase As Database
Dim crTables As Tables
Dim crTable As Table
Dim crTableLogOnInfo As TableLogOnInfo
Dim crConnectionInfo As ConnectionInfo

Dim crParameterFieldDefinitions As ParameterFieldDefinitions
Dim crParameterValues1 As ParameterValues
Dim crParameterDiscreteValue1 As ParameterDiscreteValue
Dim crParameterValues2 As ParameterValues
Dim crParameterDiscreteValue2 As ParameterDiscreteValue
Dim crParameterValues3 As ParameterValues
Dim crParameterDiscreteValue3 As ParameterDiscreteValue
Dim crParameterValues4 As ParameterValues
Dim crParameterDiscreteValue4 As ParameterDiscreteValue

' Create an instance of the strongly-typed report object and load
the
' correct .rpt file
Dim strReport As String
strReport = CrystalName
Try
crReportDocument.Load(strReport)
Catch e As Exception
retvalue = False
' Write an event log message
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error loading .rpt template: " & e.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.CrystalLoad)
End Try

' Create a new instance of the connectioninfo object and
' set its properties to reference the database listed in the
configuration settings.
crConnectionInfo = New ConnectionInfo
With crConnectionInfo
.ServerName = ServerName
.DatabaseName = DatabaseName
.UserID = UserName
.Password = Password
End With

'Get the tables collection from the report object
crDatabase = crReportDocument.Database
crTables = crDatabase.Tables

'Apply the logon information to each table in the collection
For Each crTable In crTables
crTableLogOnInfo = crTable.LogOnInfo
crTableLogOnInfo.ConnectionInfo = crConnectionInfo
crTable.ApplyLogOnInfo(crTableLogOnInfo)
Next

' Set the Start Date parameter value
crParameterDiscreteValue1 = New ParameterDiscreteValue
crParameterValues1 = New ParameterValues
crParameterDiscreteValue1.Value = passData.StartDate
crParameterValues1.Add(crParameterDiscreteValue1)

crReportDocument.DataDefinition.ParameterFields( "StartDate").ApplyCurrentV al
ues(crParameterValues1)

' Set the End Date parameter value
crParameterDiscreteValue2 = New ParameterDiscreteValue
crParameterValues2 = New ParameterValues
crParameterDiscreteValue2.Value = passData.EndDate
crParameterValues2.Add(crParameterDiscreteValue2)

crReportDocument.DataDefinition.ParameterFields( "EndDate").ApplyCurrentVal
ue
s(crParameterValues2)

' Set the Request Date parameter value
crParameterDiscreteValue3 = New ParameterDiscreteValue
crParameterValues3 = New ParameterValues
crParameterDiscreteValue3.Value = passData.ReportDate
crParameterValues3.Add(crParameterDiscreteValue3)

crReportDocument.DataDefinition.ParameterFields( "RequestDate").ApplyCurren
tV
alues(crParameterValues3)

' Set the UserID parameter value
crParameterDiscreteValue4 = New ParameterDiscreteValue
crParameterValues4 = New ParameterValues
crParameterDiscreteValue4.Value = passData.UserID
crParameterValues4.Add(crParameterDiscreteValue4)

crReportDocument.DataDefinition.ParameterFields( "UserID").ApplyCurrentValu
es
(crParameterValues4)

' Define and set the options necessary to save the pdf file to a
disk location
Dim crDiskFileDestinationOptions As New DiskFileDestinationOptions
crDiskFileDestinationOptions.DiskFileName = PDFFileName()
Dim crExportOption As ExportOptions =

crReportDocument.ExportOptions
With crExportOption
.DestinationOptions = crDiskFileDestinationOptions
.ExportDestinationType = ExportDestinationType.DiskFile
.ExportFormatType = ExportFormatType.PortableDocFormat
End With

' Export the refreshed report using the appropriate selection
criteria
' If there is an error with this process, write an appropriate
Windows Event
' Log record.
Try
crReportDocument.Export()
Catch e As Exception
retvalue = False
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error exporting report: " & e.Message,

Diagnostics.EventLogEntryType.Error,
SDRAEvent.CrystalExport)
End Try
End Function

' This function returns the physical direct file path and name of the
temporary file
' top be created and sent via e-mail
Public Function PDFFileName() As String
Return TempFileDir + PDFViewName()
End Function

' This is a unique name for a file so multiple users can access this
routine without any issues.
' A file name will be comprised of three parts:
' 1) The UserID used when the individual logged into the system.
' 2) The time that the request was submitted at the web page making
the request
' (this is necessary so the user can run multiple reports without
any problems)
' 3) The Name defined fo the report which is read in from the
configuration file.
' (this will be the same name as the crystal report .rpt file
except we use a PDF extention)
Public Function PDFViewName() As String
Return passData.UserID + Format(passData.ReportDate,

"MMddyyhhmmss")
+ "_" & Report & ".pdf"
End Function

' This routine is used to run a stored procedure against the
CustomerDateRangeMargins file
' and delete all records that match the UserID and Request Date. This
is typically run
' after all processing has been completed and the e-mail sent as part

of
the clean up process.
Private Function DeleteReportData() As Boolean
Dim m_objConn As New System.Data.SqlClient.SqlConnection

'try to open the connection
If Not OpenConnection(m_objConn) Then
Exit Function
End If

Dim returnvalue As Boolean = True
Dim myCommand As New
SqlClient.SqlCommand("DeleteCustomerDateRangeMar gins", m_objConn)

' Mark the Command as a SPROC
' The timeout value of zero lets all transactions run without

timing
out.
myCommand.CommandType = CommandType.StoredProcedure
myCommand.CommandTimeout = 0

' Add Parameters to SPROC
Dim parameterRequestDate As New
SqlClient.SqlParameter("@RequestDate", SqlDbType.DateTime)
parameterRequestDate.Value = passData.ReportDate
myCommand.Parameters.Add(parameterRequestDate)

Dim parameterUserID As New SqlClient.SqlParameter("@UserID",
SqlDbType.NVarChar, 15)
parameterUserID.Value = passData.UserID
myCommand.Parameters.Add(parameterUserID)

' Execute the command to perform the query request on the server
' if there is a problem, then write an appropriate Windows Event

Log
record.
Try
myCommand.ExecuteNonQuery()
Catch e As Exception
returnvalue = False
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error deleting CustomerDateRangeMargins: " & e.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.DeleteData)
End Try

' Free up memory
myCommand = Nothing

' close the database connection and free up memory
CloseConnection(m_objConn)
m_objConn = Nothing

' return a flag indicating if any errors occures while this was
running
Return returnvalue
End Function

' This function calls an SQL Stored procedure. This procedure:
' 1) First deletes any old records that may match the username abd
request date
' 2) Gets all the appropriate records from the Invoice Master,
Invoice Detail and
' Customer master files.
' 3) Applies additional processing to ensure all the necessary
calculations are correct.
Private Function ReloadReportData() As Boolean
Dim m_objConn As New System.Data.SqlClient.SqlConnection

'try to open the connection
If Not OpenConnection(m_objConn) Then
Exit Function
End If

Dim returnvalue As Boolean = True
Dim myCommand As New
SqlClient.SqlCommand("ReloadCustomerDateRangeMar gins", m_objConn)

' Mark the Command as a SPROC
myCommand.CommandType = CommandType.StoredProcedure
myCommand.CommandTimeout = 0

' Add Parameters to SPROC
Dim parameterRequestDate As New
SqlClient.SqlParameter("@RequestDate", SqlDbType.DateTime)
parameterRequestDate.Value = passData.ReportDate
myCommand.Parameters.Add(parameterRequestDate)

Dim parameterUserID As New SqlClient.SqlParameter("@UserID",
SqlDbType.NVarChar, 15)
parameterUserID.Value = passData.UserID
myCommand.Parameters.Add(parameterUserID)

Dim parameterStartDate As New SqlClient.SqlParameter("@StartDate",
SqlDbType.DateTime)
parameterStartDate.Value = passData.StartDate
myCommand.Parameters.Add(parameterStartDate)

Dim parameterEndDate As New SqlClient.SqlParameter("@EndDate",
SqlDbType.DateTime)
parameterEndDate.Value = passData.EndDate
myCommand.Parameters.Add(parameterEndDate)

' Execute the stored procedure, and if there is an error, write an
appropriate Event Log record.
Try
myCommand.ExecuteNonQuery()
Catch e As Exception
returnvalue = False
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error running ReloadCustomerDateRangeMargins: " & e.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.ReloadData)
End Try

' Free up memory
myCommand = Nothing

' close the database connection and free up memory
CloseConnection(m_objConn)
m_objConn = Nothing

' return a flag showing whether the report data was retrieved,
loaded and calculated appropriately.
Return returnvalue
End Function

' This routine e-mails the PDF file created above to the user that
submitted the request.
Private Function EMailReport(ByVal StartTime As Date, ByVal EndTime As
Date) As Integer
' Set all the necessary message routing and descriptive

information.
Dim myMessage As New System.Web.Mail.MailMessage
Dim strMessage As String
Try
myMessage.To = passData.EMailAddress
myMessage.From = MailFrom
myMessage.Subject = "Sales Analysis from " &
Format(passData.StartDate, "MM/dd/yyyy") & " thru " &
Format(passData.EndDate, "MM/dd/yyyy")
myMessage.BodyFormat = MailFormat.Html
myMessage.Priority = MailPriority.High
Catch e As Exception
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error assigning email data: " & e.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.MailParamters)
Exit Function
End Try

' Set up the message body text.
strMessage = "<html><head><link href='" + WebSite + StyleSheet +

"'type='text/css' rel='stylesheet'></head><body>"
strMessage = strMessage + "<Table cellspacing=0 cellpadding=0
style='border-collapse: collapse' bordercolor='#111111' width='100%'>"

' Insert a blank line
strMessage = strMessage + "<TR class='Text'><TD>&nbsp;</TD></TR>"

' Display a header line
strMessage = strMessage + "<TR class='Text'><TD>Sales Analysis
processing was performed for data from " & Format(passData.StartDate,
"MM/dd/yyyy") & " thru " & Format(passData.EndDate, "MM/dd/yyyy") & "
</TD></TR>"

' Insert two blank lines
strMessage = strMessage + "<TR class='Text'><TD>&nbsp;</TD></TR>"

' Display the start and end times for the processing
strMessage = strMessage + "<TR class='Text'><TD>Processing was
started at: " + FormatDateTime(StartTime, DateFormat.LongTime) +
"</TD></TR>"
strMessage = strMessage + "<TR class='Text'><TD>Processing was
completed at: " + FormatDateTime(EndTime, DateFormat.LongTime) +
"</TD></TR>"

' Insert two blank lines
strMessage = strMessage + "<TR class='Text'><TD>&nbsp;</TD></TR>"

' Display a header line
strMessage = strMessage + "<TR class='Text'><TD>The completed

report
is attached to this e-mail in a PDF format .</TD></TR>"

' End the table
strMessage = strMessage + "</table></body></html>"

' Set the body of the message to the text
myMessage.Body = strMessage

' Add the PDF File as an attachment
Dim objAttach As New MailAttachment(PDFFileName)

' try adding the attachment, and sending the message
Try
myMessage.Attachments.Add(objAttach)
SmtpMail.SmtpServer = MailServer
SmtpMail.Send(myMessage)
Catch ex As Exception
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error sending email: " & ex.Message, Diagnostics.EventLogEntryType.Error,
SDRAEvent.SendMail)
Exit Function
End Try

End Function

' Routine that closes the SQL connection object used to access the SQL
server.
Public Sub CloseConnection(ByVal objConnection As
System.Data.SqlClient.SqlConnection)
Try
objConnection.Close()
Catch e As Exception
' Write an event log message
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error closing connection: " & e.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.CloseConnection)
End Try
End Sub

' Routine that opens the SQL connection object used to access the SQL
server.
Public Function OpenConnection(ByVal objConnection As
System.Data.SqlClient.SqlConnection) As Boolean
Dim retvalue As Boolean = True

Try
objConnection.ConnectionString = "Server=" & ServerName &
";User=" & UserName & ";Password=" & Password & "; " _
& "Database=" & DatabaseName
objConnection.Open()
Catch e As Exception
retvalue = False
System.Diagnostics.EventLog.WriteEntry("SellarsRep ortService",
"Error opening connection: " & e.Message,
Diagnostics.EventLogEntryType.Error, SDRAEvent.OpenConnection)
End Try

Return retvalue
End Function

' Declare properties for all configuration data file items.
Private Property DatabaseName() As String
Get
DatabaseName = mvarDatabaseName
End Get
Set(ByVal Value As String)
mvarDatabaseName = Value
End Set
End Property

Private Property Password() As String
Get
Password = mvarPassword
End Get
Set(ByVal Value As String)
mvarPassword = Value
End Set
End Property

Private Property ServerName() As String
Get
ServerName = mvarServerName
End Get
Set(ByVal Value As String)
mvarServerName = Value
End Set
End Property

Private Property UserName() As String
Get
UserName = mvaruserName
End Get
Set(ByVal Value As String)
mvaruserName = Value
End Set
End Property

Private Property MailTo() As String
Get
MailTo = mvarMailTo
End Get
Set(ByVal Value As String)
mvarMailTo = Value
End Set
End Property

Private Property MailFrom() As String
Get
MailFrom = mvarMailFrom
End Get
Set(ByVal Value As String)
mvarMailFrom = Value
End Set
End Property

Private Property MailServer() As String
Get
MailServer = mvarMailServer
End Get
Set(ByVal Value As String)
mvarMailServer = Value
End Set
End Property

Private Property PDFViewLocation() As String
Get
PDFViewLocation = mvarPDFViewLocation
End Get
Set(ByVal Value As String)
mvarPDFViewLocation = Value
End Set
End Property

Private Property Report() As String
Get
Report = mvarReport
End Get
Set(ByVal Value As String)
mvarReport = Value
End Set
End Property

Private Property CrystalName() As String
Get
CrystalName = mvarCrystalName
End Get
Set(ByVal Value As String)
mvarCrystalName = Value
End Set
End Property

Private Property StyleSheet() As String
Get
StyleSheet = mvarStyleSheet
End Get
Set(ByVal Value As String)
mvarStyleSheet = Value
End Set
End Property

Private Property TempFileDir() As String
Get
TempFileDir = mvarTempFileDir
End Get
Set(ByVal Value As String)
mvarTempFileDir = Value
End Set
End Property

Private Property WebSite() As String
Get
WebSite = mvarWebSite
End Get
Set(ByVal Value As String)
mvarWebSite = Value
End Set
End Property

End Class


Nov 20 '05 #5

P: n/a
Howdy Cor,

I think the only part that can't be done in VB is getting someone in this
newsgroup to give a detailed response to the query as it currently stands! :-)
The C# lot seem more into heavy debating.

Regards,
Fergus
Nov 20 '05 #6

P: n/a
Hi Cor,

|| But by the way, I did not tell you there is a long
|| thread about multithreading in this newsgroup.

ROFL.

Thanks, I must have missed that thread somehow. :-))

Regards,
Fergus
Nov 20 '05 #7

This discussion thread is closed

Replies have been disabled for this discussion.