J
James Radke
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("SellarsReportService", "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(configurationAppSettings.GetValue("Sella
rs.MessageQueue", GetType(System.String)), String))
Catch
System.Diagnostics.EventLog.WriteEntry("SellarsReportService",
"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("SellarsReportService", "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("SellarsReportService",
"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.Report",
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.Location",
GetType(System.String)), String) & Report & ".rpt"
TempFileDir =
CType(configurationAppSettings.GetValue("Sellars.TempFileDirectory",
GetType(System.String)), String)
MailFrom = CType(configurationAppSettings.GetValue("EMail.From",
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("PDFViewReport.Location",
GetType(System.String)), String)
MailServer =
CType(configurationAppSettings.GetValue("Email.SMTPServer",
GetType(System.String)), String)
Catch ex As Exception
System.Diagnostics.EventLog.WriteEntry("SellarsReportService",
"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("SellarsReportService",
"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("SellarsReportService",
"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").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("EndDate").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("RequestDate").ApplyCurrentV
alues(crParameterValues3)
' Set the UserID parameter value
crParameterDiscreteValue4 = New ParameterDiscreteValue
crParameterValues4 = New ParameterValues
crParameterDiscreteValue4.Value = passData.UserID
crParameterValues4.Add(crParameterDiscreteValue4)
crReportDocument.DataDefinition.ParameterFields("UserID").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("SellarsReportService",
"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("DeleteCustomerDateRangeMargins", 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("SellarsReportService",
"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("ReloadCustomerDateRangeMargins", 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("SellarsReportService",
"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("SellarsReportService",
"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> </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> </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> </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("SellarsReportService",
"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("SellarsReportService",
"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("SellarsReportService",
"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
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("SellarsReportService", "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(configurationAppSettings.GetValue("Sella
rs.MessageQueue", GetType(System.String)), String))
Catch
System.Diagnostics.EventLog.WriteEntry("SellarsReportService",
"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("SellarsReportService", "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("SellarsReportService",
"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.Report",
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.Location",
GetType(System.String)), String) & Report & ".rpt"
TempFileDir =
CType(configurationAppSettings.GetValue("Sellars.TempFileDirectory",
GetType(System.String)), String)
MailFrom = CType(configurationAppSettings.GetValue("EMail.From",
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("PDFViewReport.Location",
GetType(System.String)), String)
MailServer =
CType(configurationAppSettings.GetValue("Email.SMTPServer",
GetType(System.String)), String)
Catch ex As Exception
System.Diagnostics.EventLog.WriteEntry("SellarsReportService",
"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("SellarsReportService",
"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("SellarsReportService",
"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").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("EndDate").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("RequestDate").ApplyCurrentV
alues(crParameterValues3)
' Set the UserID parameter value
crParameterDiscreteValue4 = New ParameterDiscreteValue
crParameterValues4 = New ParameterValues
crParameterDiscreteValue4.Value = passData.UserID
crParameterValues4.Add(crParameterDiscreteValue4)
crReportDocument.DataDefinition.ParameterFields("UserID").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("SellarsReportService",
"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("DeleteCustomerDateRangeMargins", 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("SellarsReportService",
"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("ReloadCustomerDateRangeMargins", 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("SellarsReportService",
"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("SellarsReportService",
"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> </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> </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> </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("SellarsReportService",
"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("SellarsReportService",
"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("SellarsReportService",
"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
).