Deep copy a CUSTOM treenode - vb.net

I am researching for some days now how to shallow copy and deep copy a custom TreeNode object that was dragged from treeview1 and Dropped to Treeview2. I need both behaviors in my application. I can create the custom TreeNode and have the custom properties populated from SQL Database.
The main idea is to have all product options in the Treeview1 and build my product in the Treeview2.
What I can do...
1)Populate Treeview1 from SQL Database
2)Create the CUSTOM TreeNode with my properties
3)DragItem, DragEnter, DragOver and DragDrop my Custom TreeNode
What is my problem?
When I DragDrop the CUSTOM TreeNode from TreeView1 and I Add the TreeNode in the TreeView2 I need to remove the TreeNode from TreeView1 But I Would like to have the CUSTOM TreeNode on Both places TreeView1 and TreeView2.
I did a lot of research but I believe I need some guidance from you colleagues to accomplish my gol. I tried a lot of things also without success...This is the code I have that supposed to do a DeepCopy from my CUSTOM TreeNode. The concept for the DeepCopy function I took from Microsoft documentation regarding CLONE (Shallow and DeepCopy).
Here is my code.
Imports System.ComponentModel
Imports System.IO
Imports System.Runtime.Serialization.Formatters.Binary
Public Class Frm_USER_HDAS
Private Sub Frm_USER_HDAS_Load(sender As Object, e As EventArgs) Handles MyBase.Load
TreeView1.Nodes.Clear()
TreeView1.Nodes.Add("Nodes_Collection")
TreeView1.Nodes(0).Text = "Nodes_Collection"
Try
Call DBOpenConnection()
Dim CurrentTableName As String = "Customers"
Dim NewNode As HDAS_TreeNode
Dim DTProperties As New DataTable
Dim returnProperties As String = DB.SQLQuery("SELECT * FROM [" + CurrentTableName + "]", DTProperties)
For j As Integer = 0 To DTProperties.Rows.Count - 1
For k As Integer = 0 To DTProperties.Columns.Count - 1
If DTProperties.Columns(k).ColumnName = "Name" Then
Dim DT_ItemProperties As New DataTable
Dim retorn_DT_ItemProperties As String = DB.SQLQuery("SELECT *
FROM [" + CurrentTableName + "]
WHERE Name = '" + DTProperties.Rows(j).Item(k) + "';",
DT_ItemProperties)
Dim DTLinks As New DataTable
Dim ReturnLinks As String = DB.SQLQuery("SELECT
c.CONSTRAINT_NAME,
cu.TABLE_NAME AS ReferencingTable,
cu.COLUMN_NAME AS ReferencingColumn,
ku.TABLE_NAME AS ReferencedTable,
ku.COLUMN_NAME AS ReferencedColumn
FROM INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS c
INNER JOIN INFORMATION_SCHEMA.CONSTRAINT_COLUMN_USAGE cu
ON cu.CONSTRAINT_NAME = c.CONSTRAINT_NAME
INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE ku
ON ku.CONSTRAINT_NAME = c.UNIQUE_CONSTRAINT_NAME
WHERE ku.TABLE_NAME = '" + CurrentTableName + "'", DTLinks)
NewNode = New HDAS_TreeNode(DTLinks, DT_ItemProperties)
TreeView1.Nodes(0).Nodes.Add(NewNode)
Exit For
End If
Next
Next
TreeView1.ExpandAll()
DB.Close()
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
#Region "Drag and Drop Process"
#Region "Started Step 1"
Private Sub TreeView1_ItemDrag(sender As Object, e As ItemDragEventArgs) Handles TreeView1.ItemDrag, TreeView2.ItemDrag
sender.DoDragDrop(e.Item, DragDropEffects.Copy)
End Sub
#End Region
#Region "Started Step 2"
Private Sub TreeView1_DragEnter(sender As Object, e As DragEventArgs) Handles TreeView1.DragEnter, TreeView2.DragEnter
e.Effect = e.AllowedEffect
End Sub
#End Region
#Region "Started Step 3"
Private Sub TreeView_DragOver(sender As Object, e As DragEventArgs) Handles TreeView1.DragOver, TreeView2.DragOver
' Retrieve the client coordinates of the mouse position.
Dim targetPoint As Point = sender.PointToClient(New Point(e.X, e.Y))
' Select the node at the mouse position.
sender.SelectedNode = sender.GetNodeAt(targetPoint)
End Sub
#End Region
#Region "Started Step 4"
Private Sub TreeView_DragDrop(sender As Object, e As DragEventArgs) Handles TreeView1.DragDrop, TreeView2.DragDrop
Dim selectedTreeview As TreeView
selectedTreeview = CType(sender, TreeView)
' Retrieve the client coordinates of the drop location.
Dim targetPoint As Point = sender.PointToClient(New Point(e.X, e.Y))
' Retrieve the node at the drop location.
Dim targetNode As HDAS_TreeNode = sender.GetNodeAt(targetPoint)
' Retrieve the node that was dragged.
Dim draggedNode As HDAS_TreeNode = CType(e.Data.GetData(GetType(HDAS_TreeNode)), HDAS_TreeNode)
Dim DroppedNode As HDAS_TreeNode = draggedNode
If Not draggedNode.Equals(targetNode) AndAlso Not ContainsNode(draggedNode, targetNode) Then
If targetNode Is Nothing Then
draggedNode.Remove() 'The Problem is here....If I remove this line I can not Keep Both Nodes
selectedTreeview.Nodes.Add(DroppedNode.DeepCopy())
Else
draggedNode.Remove() 'The Problem is here....If I remove this line I can not Keep Both Nodes
targetNode.Nodes.Add(DroppedNode.DeepCopy())
End If
draggedNode.EnsureVisible()
selectedTreeview.SelectedNode = draggedNode
sender.ExpandAll()
End If
End Sub
Private Function ContainsNode(ByVal node1 As HDAS_TreeNode, ByVal node2 As HDAS_TreeNode) As Boolean
Try
' Check the parent node of the second node.
If node2.Parent Is Nothing Then
Return False
End If
If node2.Parent.Equals(node1) Then
Return True
End If
' If the parent node is not null or equal to the first node,
' call the ContainsNode method recursively using the parent of
' the second node.
Return ContainsNode(node1, node2.Parent)
Catch ex As Exception
End Try
End Function 'ContainsNode
#End region
#Region"Here is my CUSTOM TreeNode Class"
Imports System.IO
Imports System.Runtime.Serialization
Imports System.Runtime.Serialization.Formatters.Binary
<Serializable> Public Class HDAS_TreeNode
Inherits TreeNode
Private NodeName As String
Private NodeText As String
Private CurrentTableName As String
Private CurrentTablePrimaryKeys As List(Of String)
Private LinkedTableNames As List(Of String)
Private LinkedTableForeignerKeys As List(Of String)
Private PropertiesFromDB As DataTable
Private M_DTLinks As New DataTable
Private M_DTProperties As New DataTable
#Region "Constructor"
Public Sub New()
End Sub
Sub New(DTLinks As DataTable, DTProperties As DataTable)
M_DTLinks = DTLinks
M_DTProperties = DTProperties
Me.Name = HDAS_NodeName
Me.Text = HDAS_NodeText
Me.CurrentTableName = HDAS_CurrentTable
Me.CurrentTablePrimaryKeys = HDAS_PrimaryKeys
Me.LinkedTableNames = HDAS_LinkedTables
Me.LinkedTableForeignerKeys = HDAS_ForeignerKeys
Me.PropertiesFromDB = HDAS_PropertiesFromDB
End Sub
#End Region
#Region "Properties"
Public Property HDAS_NodeName As String
Get
Return MyNodeName(M_DTProperties)
End Get
Set(value As String)
NodeName = value
End Set
End Property
Public Property HDAS_NodeText As String
Get
Return MyNodeText(M_DTProperties)
End Get
Set(value As String)
NodeText = value
End Set
End Property
Public Property HDAS_CurrentTable As String
Get
Return MyNodeCurrentTable(M_DTLinks)
End Get
Set(value As String)
CurrentTableName = value
End Set
End Property
Public Property HDAS_PrimaryKeys As List(Of String)
Get
Return MyNodePrimaryKeys(M_DTLinks)
End Get
Set(value As List(Of String))
CurrentTablePrimaryKeys = value
End Set
End Property
Public Property HDAS_LinkedTables As List(Of String)
Get
Return MyNodeLinkedTableName(M_DTLinks)
End Get
Set(value As List(Of String))
LinkedTableNames = value
End Set
End Property
Public Property HDAS_ForeignerKeys As List(Of String)
Get
Return MyNodeForeignerKeys(M_DTLinks)
End Get
Set(value As List(Of String))
LinkedTableForeignerKeys = value
End Set
End Property
Public Property HDAS_PropertiesFromDB As DataTable
Get
Return M_DTProperties
End Get
Set(value As DataTable)
PropertiesFromDB = value
End Set
End Property
#End Region
#Region "Methods"
Private Function MyNodeName(DTProperties As DataTable) As String
Try
For i As Integer = 0 To DTProperties.Columns.Count
If DTProperties.Columns(i).ColumnName = "Name" Then
MyNodeName = DTProperties.Rows(0).Item(i)
Return MyNodeName
End If
Next
Catch ex As Exception
MsgBox("Class Name: HDAS_TreeNode" + vbNewLine + "Method_Name: MyNodeName" + vbNewLine + "Error_Name: " + ex.Message)
End Try
End Function
Private Function MyNodeText(DTProperties As DataTable) As String
Try
For i As Integer = 0 To DTProperties.Columns.Count
If DTProperties.Columns(i).ColumnName = "Name" Then
MyNodeText = DTProperties.Rows(0).Item(i)
Return MyNodeText
End If
Next
Catch ex As Exception
MsgBox("Class Name: HDAS_TreeNode" + vbNewLine + "Method_Name: MyNodeText" + vbNewLine + "Error_Name: " + ex.Message)
End Try
End Function
Private Function MyNodeCurrentTable(M_DTLinks As DataTable) As String
Try
MyNodeCurrentTable = M_DTLinks.Rows(0).Item(3)
Return MyNodeCurrentTable
Catch ex As Exception
MsgBox("Class Name: HDAS_TreeNode" + vbNewLine + "Method_Name: MyNodeCurrentTable" + vbNewLine + "Error_Name: " + ex.Message)
End Try
End Function
Private Function MyNodePrimaryKeys(M_DTLinks As DataTable) As List(Of String)
Try
Dim LinkedTableList As List(Of String) = Nothing
MyNodePrimaryKeys = Nothing
If M_DTLinks.Rows.Count > 1 Then
LinkedTableList = New List(Of String)
For i As Integer = 0 To M_DTLinks.Rows.Count - 1
Dim LinkedTableName As String = M_DTLinks.Rows(i).Item(4)
LinkedTableList.Add(LinkedTableName)
Next
MyNodePrimaryKeys = LinkedTableList
Return MyNodePrimaryKeys
Else
MyNodePrimaryKeys = M_DTLinks.Rows(0).Item(4)
Return MyNodePrimaryKeys
End If
Catch ex As Exception
MsgBox("Class Name: HDAS_TreeNode" + vbNewLine + "Method_Name: MyNodePrimaryKeys" + vbNewLine + "Error_Name: " + ex.Message)
End Try
End Function
Private Function MyNodeLinkedTableName(M_DTLinks As DataTable) As List(Of String)
Try
Dim LinkedTableList As List(Of String) = Nothing
MyNodeLinkedTableName = Nothing
If M_DTLinks.Rows.Count > 1 Then
LinkedTableList = New List(Of String)
For i As Integer = 0 To M_DTLinks.Rows.Count - 1
Dim LinkedTableName As String = M_DTLinks.Rows(i).Item(1)
LinkedTableList.Add(LinkedTableName)
Next
MyNodeLinkedTableName = LinkedTableList
Return MyNodeLinkedTableName
Else
MyNodeLinkedTableName = M_DTLinks.Rows(0).Item(1)
Return MyNodeLinkedTableName
End If
Catch ex As Exception
MsgBox("Class Name: HDAS_TreeNode" + vbNewLine + "Method_Name: MyNodeLinkedTableName" + vbNewLine + "Error_Name: " + ex.Message)
End Try
End Function
Private Function MyNodeForeignerKeys(M_DTLinks As DataTable) As List(Of String)
Try
Dim LinkedTableList As List(Of String) = Nothing
MyNodeForeignerKeys = Nothing
If M_DTLinks.Rows.Count > 1 Then
LinkedTableList = New List(Of String)
For i As Integer = 0 To M_DTLinks.Rows.Count - 1
Dim LinkedTableName As String = M_DTLinks.Rows(i).Item(2)
LinkedTableList.Add(LinkedTableName)
Next
MyNodeForeignerKeys = LinkedTableList
Return MyNodeForeignerKeys
Else
MyNodeForeignerKeys = M_DTLinks.Rows(0).Item(2)
Return MyNodeForeignerKeys
End If
Catch ex As Exception
MsgBox("Class Name: HDAS_TreeNode" + vbNewLine + "Method_Name: MyNodeForeignerKeys" + vbNewLine + "Error_Name: " + ex.Message)
End Try
End Function
Public Function DeepCopy() As HDAS_TreeNode
Dim theClone As HDAS_TreeNode = DirectCast(Me.MemberwiseClone(), HDAS_TreeNode)
theClone.HDAS_NodeName = String.Copy(HDAS_NodeName)
theClone.HDAS_NodeText = String.Copy(HDAS_NodeText)
theClone.HDAS_CurrentTable = String.Copy(HDAS_CurrentTable)
theClone.HDAS_PrimaryKeys = New List(Of String)(HDAS_PrimaryKeys)
theClone.HDAS_LinkedTables = New List(Of String)(HDAS_LinkedTables)
theClone.HDAS_ForeignerKeys = New List(Of String)(HDAS_ForeignerKeys)
theClone.HDAS_PropertiesFromDB = PropertiesFromDB.Copy
Return theClone
End Function
#End Region
End Class
What I expect is to have the Custom TreeNode in both TreeViews after the Drag and Drop process and methods to use Shallow and DeepCopy from my CUSTOM TreeNode.
Please colleagues, I really need this...I am almost without sleep because of this. Any hint will be really appreciated. I am new doing all those things and sorry if I didn't made myself clear, English is not my native language. If you need additional explanation, feel free to ask, I am here to learn from you.

Do not inherit HDAS_TreeNode from TreeNode. Use the standard TreeNode, but store in its TreeNode.Tag property, instances of HDAS_TreeNode. So when you copy nodes between TreeView's, you will end up with different TreeNode instances pointing to the same HDAS_TreeNode instance via their Tag property.
In other words, instead of inheritance, use composition.

Related

Crystal Report Won't Use Updated Parameter Value/Data Source When Created In Loop

I've created a library in an attempt to handle all of the "quirks" of using Crystal Reports in a Visual Studio (VB.NET) project. I've pulled together all the elements that have presented challenges to me in the past - setting/updating parameter and formula values, printing (including page ranges), and setting logon credentials - and put them into reusable methods that all seem to work well when I generate the reports individually.
However, I've run into a scenario where I want to reuse the same report object in a loop to print multiple variations with different data sets/parameter(s) so that I can "easily" reuse the same printer settings and other options without re-prompting the user for each iteration. In this case, I'm working with an internally built DataSet object (built by someone other than me) and my Crystal Report file's Data Source is pointing to the .xsd file for structure.
EDIT: Forgot to mention that the report was created in CR Developer v11.5.12.1838 and the VB.NET library project is targetting the 4.7.2 .NET framework and using the v13.0.3500.0 (runtime v2.0.50727) of the Crystal libraries.
My intent is/was to instantiate a new report object outside the loop, then just re-set and refresh the report's data source and parameter values on each iteration of the loop. Unfortunately, it seems that if I do it this way, the report won't correctly pick up either the parameter values, the updated data source, or both. I've been trying several variations of code placement (because I know that the order in which things are done is very important to the Crystal Reports engine), but none of it seems to work the way I believe it should.
If I instantiate a new report object inside the loop, it will correctly generate the reports for each iteration with the correct data source and parameter values. Of course, it resets all of the internal properties of my class to "default", which kinda defeats the purpose. (Yes, I know I could pass additional/other parameters to a constructor to achieve the effect, but that seems an extremely "brute-force" solution, and I'd much rather get it to work the way I have in mind).
AND NOW FOR SOME CODE
Here is a pared-down/obfuscated version of the most recent iteration of the calling method (currently a part of a button click event handler). Every attempt I've made to instantiate a reusable object seems to result in some sort of failure. In this version, it loads the report and correctly passes along the parameter value, but the data source is completely empty resulting in a blank report. In other variations (I've discarded that code now), when I actually try to print/export/show the report, it fails with a COM exception: Missing parameter values.
I've tried using the .Refresh and .ReportClientDocument.VerifyDatabase methods separately, but those don't make a difference. When I check the parameters at runtime, it appears that the CR parameter/value and query results have been populated, but any method that makes any changes after the initialization just seems to "break" the report.
Dim ReportName As String = "\\SERVERNAME\Applications\Reports\ClientActiveCustomerSummary.rpt"
Dim Report As Common.CRReport = Nothing
Try
ReportData = ClientDataSet.Tables("ActiveSummary").Copy
ReportData = GetClientActiveSummaryData
Catch ex As Exception
MessageBox.Show(ex.Message & vbCrLf & vbCrLf &
"Error while retrieving client customer summary report data.",
"ERROR", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
If ReportData.Rows.Count > 0 Then
Report = New Common.CRReport(Common.CRReport.ReportSourceType.ADODataSet, New IO.FileInfo(ReportName), ClientDataSet)
For Each LVItem As ListViewItem In checkItemsMP
Dim ClientQuery = From ap In ReportData.AsEnumerable
Where ap.Field(Of Object)("mp") = LVItem.SubItems("mp").Text
Order By ap.Field(Of Object)("customername")
Select ap
ClientDataSet.Tables("ActiveSummary").Merge(ClientQuery.CopyToDataTable)
Report.ReportParameters.Clear()
Report.AddReportParameter("ClientName", LVItem.SubItems("clientname").Text)
Report.GenerateReport()
ClientDataSet.Tables("ActiveSummary").Clear()
ClientQuery = Nothing
Next LVItem
For Each LVItem As ListViewItem In checkItemsBN
Dim BranchName As String = LVItem.SubItems("clientname").Text & " " & LVItem.SubItems("branchname").Text
Dim BranchQuery = From ap In ReportData.AsEnumerable
Where (ap.Field(Of Object)("clientname") & " " & ap.Field(Of Object)("branchname")) = BranchName
Order By ap.Field(Of Object)("customername")
Select ap
ClientDataSet.Tables("ActiveSummary").Merge(BranchQuery.CopyToDataTable)
Report.ReportParameters.Clear()
Report.AddReportParameter("ClientName", BranchName)
Report.GenerateReport()
ClientDataSet.Tables("ActiveSummary").Clear()
BranchQuery = Nothing
Next LVItem
Else
MessageBox.Show("NO RECORDS FOUND", "Information", MessageBoxButtons.OK, MessageBoxIcon.Information)
ReportData.Dispose()
ReportData = Nothing
End If
Obviously, in this case, I'm passing in an ADO.NET DataSet object and using a value retrieved from a ListView on the form itself for the value of the report's single parameter. Again, if I instantiate a new CRReport object on each iteration of the loop, the report will create normally with the correct data and parameter value, but it prompts the user each time for the report creation options (print/show/export, then - if "print" is selected - again for which printer to use).
And here is the reporting class. (Please understand that this is a work in progress and is far from "production quality" code):
REPORT OBJECT (CRReport)
Imports System.IO
Imports CrystalDecisions.Shared
Imports CrystalDecisions.CrystalReports.Engine
Imports CrystalDecisions.ReportAppServer.DataDefModel
Imports System.Drawing
Imports System.Windows.Forms
Public Class CRReport
Inherits ReportDocument
Public Enum ReportSourceType
PostgreSQL = 1
MySQL = 2
ADODataSet = 3
XML = 4
CSV = 5
Access = 6
End Enum
Public Enum GenerateReportOption
None = 0
DisplayOnScreen = 1
SendToPrinter = 2
ExportToFile = 3
MailToRecipient = 4
End Enum
Public Property ReportFile As FileInfo
Public Property ExportPath As String
Public Property ReportParameters As List(Of CRParameter)
Public Property ReportFormulas As List(Of CRFormula)
Public Property SourceType As ReportSourceType
Private Property XMLDataSource As FileInfo
Private Property ADODataSet As System.Data.DataSet
Private Property ReportOption As GenerateReportOption
Private WithEvents DocumentToPrint As Printing.PrintDocument
#Region "PUBLIC METHODS"
#Region "CONSTRUCTORS"
Public Sub New(ByVal SourceType As ReportSourceType, ByVal CurrentReportFile As FileInfo)
Me.Initialize()
Me.SourceType = SourceType
Me.ReportFile = CurrentReportFile
PrepareReport()
End Sub
Public Sub New(ByVal SourceType As ReportSourceType, ByVal CurrentReportFile As FileInfo, ByVal XMLFile As FileInfo)
Me.Initialize()
Me.SourceType = SourceType
Me.ReportFile = CurrentReportFile
Me.XMLDataSource = XMLFile
PrepareReport()
End Sub
Public Sub New(ByVal SourceType As ReportSourceType, ByVal CurrentReportFile As FileInfo, ByVal ADODataSource As System.Data.DataSet)
Me.Initialize()
Me.SourceType = SourceType
Me.ReportFile = CurrentReportFile
Me.ADODataSet = ADODataSource
PrepareReport()
End Sub
Public Sub New(ByVal SourceType As ReportSourceType, ByVal CurrentReportFile As FileInfo, ByVal CurrentExportPath As String)
Me.Initialize()
Me.SourceType = SourceType
Me.ReportFile = CurrentReportFile
Me.ExportPath = CurrentExportPath
If Not Me.ExportPath Is Nothing AndAlso Not String.IsNullOrEmpty(Me.ExportPath) Then
Dim ExportFile As New IO.FileInfo(Me.ExportPath)
If Not IO.Directory.Exists(ExportFile.DirectoryName) Then
IO.Directory.CreateDirectory(ExportFile.DirectoryName)
End If
End If
PrepareReport()
End Sub
#End Region
Public Sub AddReportParameter(ByVal CurrentParameterName As String, ByVal CurrentParameterValue As Object)
If Not String.IsNullOrEmpty(CurrentParameterName) Then
Dim NewParameter As New CRParameter(Me, CurrentParameterName, CurrentParameterValue)
Me.ReportParameters.Add(NewParameter)
End If
End Sub
Public Sub AddReportFormula(ByVal CurrentFormulaName As String, ByVal CurrentFormulaValue As Object)
If Not String.IsNullOrEmpty(CurrentFormulaName) Then
Dim NewFormula As New CRFormula(Me, CurrentFormulaName, CurrentFormulaValue)
Me.ReportFormulas.Add(NewFormula)
End If
End Sub
Public Sub GenerateReport(ByVal ReportOption As GenerateReportOption)
If Me.ReportOption = GenerateReportOption.None Then
' THIS DIALOG IS SOLELY FOR PROMPTING THE USER FOR HOW TO GENERATE THE REPORT
Dim ReportDialog As New dlgGenerateReport
Me.ReportOption = ReportDialog.GetReportGenerationOption()
End If
If Not Me.ReportOption = GenerateReportOption.None Then
Select Case ReportOption
Case GenerateReportOption.DisplayOnScreen
Me.ShowReport()
Case GenerateReportOption.SendToPrinter
Me.PrintReport()
Case GenerateReportOption.ExportToFile
Me.ExportReport()
End Select
End If
End Sub
#End Region
#Region "PRIVATE METHODS"
Private Sub Initialize()
Me.ReportFile = Nothing
Me.ExportPath = String.Empty
Me.ADODataSet = Nothing
Me.XMLDataSource = Nothing
Me.ReportParameters = New List(Of CRParameter)
Me.ReportFormulas = New List(Of CRFormula)
Me.SourceType = ReportSourceType.XML
Me.ReportOption = GenerateReportOption.None
End Sub
Private Sub PrepareReport()
If Not Me.ReportFile Is Nothing Then
Me.Load(Me.ReportFile.FullName)
Me.DataSourceConnections.Clear()
SetReportConnectionInfo()
If Me.ReportFormulas.Count > 0 Then
For Each Formula As CRFormula In Me.ReportFormulas
Formula.UpdateFormulaField()
Next Formula
End If
If Me.ReportParameters.Count > 0 Then
For Each Parameter As CRParameter In Me.ReportParameters
Parameter.UpdateReportParameter()
Next Parameter
End If
Me.Refresh()
Me.ReportClientDocument.VerifyDatabase()
End If
End Sub
Private Sub SetReportConnectionInfo()
If Me.SourceType = ReportSourceType.PostgreSQL Then
Dim CRDatabase As CrystalDecisions.CrystalReports.Engine.Database = Me.Database
Dim CRTables As CrystalDecisions.CrystalReports.Engine.Tables = CRDatabase.Tables
Dim CRConnectionInfo As New CrystalDecisions.Shared.ConnectionInfo
Dim DBUsername As String = Utility.GetUsername
Dim DBPassword As String = Utility.GetPassword
With CRConnectionInfo
.DatabaseName = <DATABASENAME>
.ServerName = <HOSTNAME>
.UserID = DBUsername
.Password = DBPassword
End With
For Each CRTable As CrystalDecisions.CrystalReports.Engine.Table In CRTables
Dim CRTableLogonInfo As CrystalDecisions.Shared.TableLogOnInfo = CRTable.LogOnInfo
CRTableLogonInfo.ConnectionInfo = CRConnectionInfo
CRTable.ApplyLogOnInfo(CRTableLogonInfo)
Next CRTable
ElseIf Me.SourceType = ReportSourceType.ADODataSet Then
Dim CRDatabase As CrystalDecisions.CrystalReports.Engine.Database = Me.Database
Dim CRTables As CrystalDecisions.CrystalReports.Engine.Tables = CRDatabase.Tables
For Each CRTable As CrystalDecisions.CrystalReports.Engine.Table In CRTables
For Each ADOTable As DataTable In ADODataSet.Tables
If CRTable.Name.ToUpper.Trim = ADOTable.TableName.ToUpper.Trim Then
CRTable.SetDataSource(ADOTable)
Exit For
End If
Next ADOTable
Next CRTable
Me.ReportClientDocument.VerifyDatabase()
ElseIf Me.SourceType = ReportSourceType.XML Then
If Not Me.XMLDataSource Is Nothing AndAlso Me.XMLDataSource.Exists Then
Dim CRDatabaseAttributes As New CrystalDecisions.ReportAppServer.DataDefModel.PropertyBag
Dim CRLogonProperties As New CrystalDecisions.ReportAppServer.DataDefModel.PropertyBag
Dim CRConnectionDetails As New CrystalDecisions.ReportAppServer.DataDefModel.ConnectionInfo
Dim CRTable As CrystalDecisions.ReportAppServer.DataDefModel.Table
Dim CRTables As CrystalDecisions.ReportAppServer.DataDefModel.Tables = Me.ReportClientDocument.DatabaseController.Database.Tables
Dim XMLData As New System.Data.DataSet
XMLData.ReadXml(Me.XMLDataSource.FullName)
With CRLogonProperties
.Add("File Path ", Me.XMLDataSource.FullName)
.Add("Internal Connection ID", "{be7cdac3-6a64-4923-8177-898ab55d0fa0}")
End With
With CRDatabaseAttributes
.Add("Database DLL", "crdb_adoplus.dll")
.Add("QE_DatabaseName", "")
.Add("QE_DatabaseType", "")
.Add("QE_LogonProperties", CRLogonProperties)
.Add("QE_ServerDescription", Me.XMLDataSource.Name.Substring(0, Me.XMLDataSource.Name.Length - Me.XMLDataSource.Extension.Length))
.Add("QE_SQLDB", "False")
.Add("SSO Enabled", "False")
End With
With CRConnectionDetails
.Attributes = CRDatabaseAttributes
.Kind = CrystalDecisions.ReportAppServer.DataDefModel.CrConnectionInfoKindEnum.crConnectionInfoKindCRQE
.UserName = ""
.Password = ""
End With
For I As Integer = 0 To XMLData.Tables.Count - 1
CRTable = New CrystalDecisions.ReportAppServer.DataDefModel.Table
With CRTable
.ConnectionInfo = CRConnectionDetails
.Name = XMLData.Tables(I).TableName
.QualifiedName = XMLData.Tables(I).TableName
.[Alias] = XMLData.Tables(I).TableName
End With
Me.ReportClientDocument.DatabaseController.SetTableLocation(CRTables(I), CRTable)
Next I
Me.ReportClientDocument.VerifyDatabase()
End If
End If
End Sub
Private Sub PrintReport()
If Me.DocumentToPrint Is Nothing Then
' THIS IS WHY I WANT TO REUSE THE REPORTING OBJECT
' IF I CAN SET/SAVE THE PRINT DOCUMENT/SETTINGS WITHIN THE OBJECT,
' THE USER SHOULD ONLY HAVE TO RESPOND ONCE FOR ANY ITERATIONS
' USING THE SAME REPORT OBJECT
Dim SelectPrinter As New PrintDialog
Dim PrinterSelected As DialogResult = DialogResult.Cancel
Me.DocumentToPrint = New Printing.PrintDocument
With SelectPrinter
.Document = DocumentToPrint
.AllowPrintToFile = False
.AllowSelection = False
.AllowCurrentPage = False
.AllowSomePages = False
.PrintToFile = False
.UseEXDialog = True
End With
PrinterSelected = SelectPrinter.ShowDialog()
If PrinterSelected = DialogResult.OK Then
SendToPrinter()
End If
Else
SendToPrinter()
End If
End Sub
Private Sub SendToPrinter()
Dim Copies As Integer = DocumentToPrint.PrinterSettings.Copies
Dim PrinterName As String = DocumentToPrint.PrinterSettings.PrinterName
Dim LastPageNumber As Integer = 1
' IF THE PARAMETER VALUE DOESN'T GET PASSED/UPDATED PROPERLY
' THIS LINE WILL THROW A COM EXCEPTION 'MISSING PARAMETER VALUE'
LastPageNumber = Me.FormatEngine.GetLastPageNumber(New CrystalDecisions.Shared.ReportPageRequestContext())
Me.PrintOptions.CopyTo(DocumentToPrint.PrinterSettings, DocumentToPrint.DefaultPageSettings)
If DocumentToPrint.PrinterSettings.SupportsColor Then
DocumentToPrint.DefaultPageSettings.Color = True
End If
Me.PrintOptions.CopyFrom(DocumentToPrint.PrinterSettings, DocumentToPrint.DefaultPageSettings)
Me.PrintOptions.PrinterName = PrinterName
Me.PrintOptions.PrinterDuplex = CType(DocumentToPrint.PrinterSettings.Duplex, PrinterDuplex)
Me.PrintToPrinter(Copies, True, 1, LastPageNumber)
End Sub
Private Function ExportReport() As IO.FileInfo
Dim ExportFile As IO.FileInfo = Nothing
If Not Me.ExportPath Is Nothing AndAlso Not String.IsNullOrEmpty(Me.ExportPath) Then
ExportFile = New IO.FileInfo(Me.ExportPath)
If Not ExportFile.Exists Then
Me.ExportToDisk(ExportFormatType.PortableDocFormat, ExportFile.FullName)
Else
Dim Response As DialogResult = DialogResult.Cancel
Response = MessageBox.Show(ExportFile.Name & " already exists in this location." & vbCrLf & vbCrLf &
"Do you want to overwrite the existing file?" & vbCrLf & vbCrLf &
"Click [Y]ES to overwrite the existing file" & vbCrLf &
"Click [N]O to create a new file" & vbCrLf &
"Click [C]ANCEL to cancel the export process",
"PDF ALREADY EXISTS",
MessageBoxButtons.YesNoCancel, MessageBoxIcon.Exclamation, MessageBoxDefaultButton.Button2)
If Response = DialogResult.Yes Then
ExportFile.Delete()
ElseIf Response = DialogResult.No Then
ExportFile = New IO.FileInfo(Common.Utility.IncrementExistingFileName(Me.ExportPath))
Else
ExportFile = Nothing
End If
If Not ExportFile Is Nothing Then
Me.ExportToDisk(ExportFormatType.PortableDocFormat, ExportFile.FullName)
End If
End If
End If
Return ExportFile
End Function
Private Sub ShowReport()
Dim ReportViewer As New frmReportPreview
With ReportViewer
.rptViewer.ReportSource = Nothing
.rptViewer.ReportSource = Me
.WindowState = FormWindowState.Maximized
.rptViewer.RefreshReport()
' Set zoom level: 1 = Page Width, 2 = Whole Page, 25-100 = zoom %
.rptViewer.Zoom(1)
.rptViewer.Show()
.Show()
End With
End Sub
Private Sub EmailReport(ByRef ReportMail As System.Net.Mail.MailMessage)
Dim ReportAttachment As IO.FileInfo = ExportReport()
If Not ReportAttachment Is Nothing AndAlso ReportAttachment.Exists Then
ReportMail.Attachments.Add(New System.Net.Mail.Attachment(ReportAttachment.FullName))
If Utility.SendEmailMessage(ReportMail) Then
End If
End If
End Sub
#End Region
I've tried adding calls to the PrepareReport method (again) in the GenerateReport method of CRReport class so that it would reset the data source and parameter values, but it seems that it still doesn't get everything properly set up in the actual Crystal Report object for report generation. My experience so far has been that I have to set all of this on instantiation for some reason or it just fails completely.
For reference purposes, the parameters and formulae for Crystal are encapsulated in their own classes:
PARAMETER OBJECT (CRParameter)
#Region "CRYSTAL REPORTS PARAMETER CLASS"
Public Class CRParameter
Public Property CurrentReport As CRReport
Public Property ParameterName As String
Public Property ParameterValue As Object
Public Sub New(ByVal Report As CRReport)
Me.CurrentReport = Report
Me.ParameterName = String.Empty
Me.ParameterValue = Nothing
End Sub
Public Sub New(ByVal Report As CRReport, ByVal CurrentParameterName As String, ByVal CurrentParameterValue As Object)
Me.CurrentReport = Report
Me.ParameterName = CurrentParameterName
Me.ParameterValue = CurrentParameterValue
UpdateReportParameter()
End Sub
Friend Sub UpdateReportParameter()
If Not Me.CurrentReport Is Nothing Then
If Not String.IsNullOrEmpty(Me.ParameterName) Then
Dim CRFieldDefinitions As ParameterFieldDefinitions = Nothing
Dim CRFieldDefinition As ParameterFieldDefinition = Nothing
Dim CRValues As ParameterValues = Nothing
Dim CRDiscreteValue As ParameterDiscreteValue = Nothing
Try
CRFieldDefinitions = Me.CurrentReport.DataDefinition.ParameterFields
CRFieldDefinition = CRFieldDefinitions.Item(Me.ParameterName)
CRValues = CRFieldDefinition.CurrentValues
CRValues.Clear()
CRDiscreteValue = New ParameterDiscreteValue
CRDiscreteValue.Description = Me.ParameterName
CRDiscreteValue.Value = Me.ParameterValue
CRValues.Add(CRDiscreteValue)
CRFieldDefinition.ApplyCurrentValues(CRValues)
CRFieldDefinition.ApplyDefaultValues(CRValues)
Catch ex As Exception
Throw
Finally
If Not CRFieldDefinitions Is Nothing Then
CRFieldDefinitions.Dispose()
End If
If Not CRFieldDefinition Is Nothing Then
CRFieldDefinition.Dispose()
End If
If Not CRValues Is Nothing Then
CRValues = Nothing
End If
If Not CRDiscreteValue Is Nothing Then
CRDiscreteValue = Nothing
End If
End Try
End If
End If
End Sub
End Class
#End Region
FORMULA OBJECT (CRFormula)
I realize this falls outside the scope of the original question, but for the sake of completeness, I wanted to include it in case someone else might be looking for code to use.
#Region "CRYSTAL REPORTS FORMULA VALUE CLASS"
Public Class CRFormula
Public Property CurrentReport As CRReport
Public Property FormulaName As String
Public Property FormulaValue As Object
Public Sub New(ByVal Report As CRReport)
Me.CurrentReport = Report
Me.FormulaName = String.Empty
Me.FormulaValue = Nothing
End Sub
Public Sub New(ByVal Report As CRReport, ByVal NewFormulaName As String, ByVal NewFormulaValue As Object)
Me.CurrentReport = Report
Me.FormulaName = NewFormulaName
Me.FormulaValue = NewFormulaValue
'UpdateFormulaField()
End Sub
Friend Sub UpdateFormulaField()
If Not Me.CurrentReport Is Nothing Then
If Not String.IsNullOrEmpty(Me.FormulaName) Then
Try
If Me.FormulaValue Is Nothing Then
Me.FormulaValue = ""
Me.CurrentReport.DataDefinition.FormulaFields(Me.FormulaName).Text = Me.FormulaValue.ToString
ElseIf TypeOf Me.FormulaValue Is String AndAlso String.IsNullOrEmpty(Convert.ToString(Me.FormulaValue)) Then
Me.FormulaValue = ""
Me.CurrentReport.DataDefinition.FormulaFields(Me.FormulaName).Text = Me.FormulaValue.ToString
ElseIf TypeOf Me.FormulaValue Is String AndAlso Not String.IsNullOrEmpty(Convert.ToString(Me.FormulaValue)) Then
Me.FormulaValue = "'" & Me.FormulaValue.ToString & "'"
Me.CurrentReport.DataDefinition.FormulaFields(Me.FormulaName).Text = Me.FormulaValue.ToString
ElseIf TypeOf Me.FormulaValue Is Date Then
Me.FormulaValue = "'" & Convert.ToDateTime(Me.FormulaValue).ToString("yyyy-MM-dd") & "'"
Me.CurrentReport.DataDefinition.FormulaFields(Me.FormulaName).Text = Me.FormulaValue.ToString
Else
Me.CurrentReport.DataDefinition.FormulaFields(Me.FormulaName).Text = Me.FormulaValue.ToString
End If
Catch ex As Exception
End Try
End If
End If
End Sub
End Class
#End Region
I've tried to include as much detail and information about the challenge I'm facing as possible, but please feel free to ask any questions about any of it if you require clarification.
Okay, I believe I've found the cause of the problem, and it's one of those "quirks" I mentioned at the top of my question. The Crystal Reports engine is very particular about the order of certain events, and this is one of those cases. In my original PrepareReport() method, I had the calls to the .Refresh() and .VerifyDatabase() methods executing last. This (apparently) effectively "resets" the parameters/data source, so everything I had above it was basically nullified.
So, I went back through some older code to look at how I've worked with individual Crystal Reports in the past and found that calling the .Refresh() and .VerifyDatabase() methods prior to attempting to set parameter and/or formula values seems to work as expected, so I moved those two lines up in the PrepareReport() code and tried again. It all seemed to work correctly. Several tests later, and the order of execution appears to be the culprit here. Now my PrepareReport() method looks like this:
Private Sub PrepareReport()
If Not Me.CRReportFile Is Nothing Then
Me.CrystalReport = New CrystalDecisions.CrystalReports.Engine.ReportDocument
Me.CrystalReport.Load(Me.CRReportFile.FullName)
Me.CrystalReport.DataSourceConnections.Clear()
SetReportConnectionInfo()
'MOVED THIS UP IN THE EXECUTION ORDER
Me.CrystalReport.Refresh()
Me.CrystalReport.ReportClientDocument.VerifyDatabase()
If Me.ReportFormulas.Count > 0 Then
For Each Formula As CRFormula In Me.ReportFormulas
Formula.UpdateFormulaField(Me.CrystalReport)
Next Formula
End If
If Me.ReportParameters.Count > 0 Then
For Each Parameter As CRParameter In Me.ReportParameters
Parameter.UpdateReportParameter(Me.CrystalReport)
Next Parameter
End If
' THE REFRESH() & VERIFYDATABASE() METHOD CALLS USED TO BE DOWN HERE
End If
End Sub
TL;DR VERSION FOR THOSE INTERESTED IN ADDITIONAL INFO
A couple of other things I tried while troubleshooting, none of which resulted in complete success, although some produced varying degrees:
I tried disposing of the base object with MyBase.Dispose() (Obviously this was a bad idea). Of course, I couldn't instantiate a new base object without entirely recreating the CRReport object, which was what I was trying to avoid in the first place.
I removed the inheritance from the class and created a private variable for a CrystalDecisions.CrystalReports.Engine.ReportDocument object that could be instantiated independently of my class. Even though it may seem unnecessary, this actually wasn't a horrible idea as I'll explain later.
I tried several other variations of code placement that failed in one way or another.
Since everything seems to be working now with the revised PrepareReport() code, I've done a bit of refactoring. Instead of calling this method multiple times (once at instantiation and once at report generation), I removed the calls from the constructors and put a single call to it in the GenerateReport() method.
A SLIGHT "HICCUP"
I did some additional testing using the ShowReport() method (display it on the screen instead of printing it on paper), and there was some "weirdness", so I had to make adjustments. In my calling method (the button click event), I tried to dispose of the CRReport object after generating all of the reports, but that caused me not to be able to switch pages after the reports were generated/displayed (I got a NullReferenceException - Object reference not set to an instance of an object). A minor tweak later, and I could get the reports to stay instantiated but, due to the data set being overridden by later iterations, it wasn't always showing the correct data in each window.
This is where my removing of the inheritance comes into play. I created a private CrystalDecisions.CrystalReports.Engine.ReportDocument object for the class that could be reinstantiated and passed around a bit that would retain only the data associated with that particular instance of the report. I refactored the code for the CRReport, CRParameter, and CRFormula objects to use that new private variable instead, and everything looks like it's behaving exactly as expected.
HERE'S THE FULL REVISED CODE
Please remember, not all of this has been fully tested. I've yet to test the ExportReport() method b/c I need to clean up a couple of things there, and the EmailReport() method has a long way to go. I've only tested it with the ADO.NET DataSet during this run, although the code used for XML and PostgreSQL has worked in the past.
REPORT OBJECT (CRReport)
Public Class CRReport
Public Property CRReportFile As FileInfo
Public Property ReportParameters As List(Of CRParameter)
Public Property ReportFormulas As List(Of CRFormula)
Public Property SourceType As ReportSourceType
Public Property ExportPath As String
Get
Return ExportReportToPath
End Get
Set(value As String)
If Not value Is Nothing AndAlso Not String.IsNullOrEmpty(value) Then
Dim ExportFile As New IO.FileInfo(value)
If Not IO.Directory.Exists(ExportFile.DirectoryName) Then
IO.Directory.CreateDirectory(ExportFile.DirectoryName)
End If
ExportReportToPath = ExportFile.FullName
End If
End Set
End Property
Private Property XMLDataSource As FileInfo
Private Property ADODataSet As System.Data.DataSet
Private Property ReportOption As GenerateReportOption
Private CrystalReport As CrystalDecisions.CrystalReports.Engine.ReportDocument
Private ExportReportToPath As String
Public Enum ReportSourceType
PostgreSQL = 1
MySQL = 2
ADODataSet = 3
XML = 4
CSV = 5
Access = 6
End Enum
Public Enum GenerateReportOption
None = 0
DisplayOnScreen = 1
SendToPrinter = 2
ExportToFile = 3
MailToRecipient = 4
End Enum
Private WithEvents DocumentToPrint As Printing.PrintDocument
#Region "PUBLIC METHODS"
Public Sub New(ByVal CurrentReportFile As FileInfo, ByVal XMLFile As FileInfo)
Me.Initialize()
Me.SourceType = ReportSourceType.XML
Me.CRReportFile = CurrentReportFile
Me.XMLDataSource = XMLFile
End Sub
Public Sub New(ByVal CurrentReportFile As FileInfo, ByVal ADODataSource As System.Data.DataSet)
Me.Initialize()
Me.SourceType = ReportSourceType.ADODataSet
Me.CRReportFile = CurrentReportFile
Me.ADODataSet = ADODataSource
End Sub
Public Sub AddReportParameter(ByVal CurrentParameterName As String, ByVal CurrentParameterValue As Object)
If Not String.IsNullOrEmpty(CurrentParameterName) Then
Dim NewParameter As New CRParameter(CurrentParameterName, CurrentParameterValue)
Me.ReportParameters.Add(NewParameter)
End If
End Sub
Public Sub AddReportFormula(ByVal CurrentFormulaName As String, ByVal CurrentFormulaValue As Object)
If Not String.IsNullOrEmpty(CurrentFormulaName) Then
Dim NewFormula As New CRFormula(CurrentFormulaName, CurrentFormulaValue)
Me.ReportFormulas.Add(NewFormula)
End If
End Sub
Public Sub GenerateReport()
If Me.ReportOption = GenerateReportOption.None Then
Dim ReportDialog As New dlgGenerateReport
Me.ReportOption = ReportDialog.GetReportGenerationOption()
End If
If Not Me.ReportOption = GenerateReportOption.None Then
GenerateReport(Me.ReportOption)
End If
End Sub
Public Sub GenerateReport(ByVal ReportOption As GenerateReportOption)
If Me.ReportOption = GenerateReportOption.None Then
Dim ReportDialog As New dlgGenerateReport
Me.ReportOption = ReportDialog.GetReportGenerationOption()
End If
If Not Me.ReportOption = GenerateReportOption.None Then
PrepareReport()
Select Case ReportOption
Case GenerateReportOption.DisplayOnScreen
Me.ShowReport()
Case GenerateReportOption.SendToPrinter
Me.PrintReport()
Case GenerateReportOption.ExportToFile
Me.ExportReport()
End Select
End If
End Sub
Private Sub PrintReport()
If Me.DocumentToPrint Is Nothing Then
Dim SelectPrinter As New PrintDialog
Dim PrinterSelected As DialogResult = DialogResult.Cancel
Me.DocumentToPrint = New Printing.PrintDocument
Me.CrystalReport.PrintOptions.CopyTo(Me.DocumentToPrint.PrinterSettings, Me.DocumentToPrint.DefaultPageSettings)
With SelectPrinter
.Document = DocumentToPrint
.AllowPrintToFile = False
.AllowSelection = False
.AllowCurrentPage = False
.AllowSomePages = False
.PrintToFile = False
.UseEXDialog = True
End With
PrinterSelected = SelectPrinter.ShowDialog()
If PrinterSelected = DialogResult.OK Then
SendToPrinter()
End If
Else
SendToPrinter()
End If
End Sub
Private Sub SendToPrinter()
If Not Me.DocumentToPrint Is Nothing Then
Dim Copies As Integer = Me.DocumentToPrint.PrinterSettings.Copies
Dim PrinterName As String = Me.DocumentToPrint.PrinterSettings.PrinterName
Dim LastPageNumber As Integer = 1
LastPageNumber = Me.CrystalReport.FormatEngine.GetLastPageNumber(New CrystalDecisions.Shared.ReportPageRequestContext())
Me.CrystalReport.PrintOptions.CopyFrom(Me.DocumentToPrint.PrinterSettings, Me.DocumentToPrint.DefaultPageSettings)
Me.CrystalReport.PrintOptions.PrinterName = PrinterName
Me.CrystalReport.PrintOptions.PrinterDuplex = CType(Me.DocumentToPrint.PrinterSettings.Duplex, PrinterDuplex)
Me.CrystalReport.PrintToPrinter(Copies, True, 1, LastPageNumber)
End If
End Sub
Private Function ExportReport() As IO.FileInfo
Dim ExportFile As IO.FileInfo = Nothing
If Not Me.ExportPath Is Nothing AndAlso Not String.IsNullOrEmpty(Me.ExportPath) Then
ExportFile = New IO.FileInfo(Me.ExportPath)
If Not ExportFile.Exists Then
Me.CrystalReport.ExportToDisk(ExportFormatType.PortableDocFormat, ExportFile.FullName)
Else
Dim Response As DialogResult = DialogResult.Cancel
Response = MessageBox.Show(ExportFile.Name & " already exists in this location." & vbCrLf & vbCrLf &
"Do you want to overwrite the existing file?" & vbCrLf & vbCrLf &
"Click [Y]ES to overwrite the existing file" & vbCrLf &
"Click [N]O to create a new file" & vbCrLf &
"Click [C]ANCEL to cancel the export process",
"PDF ALREADY EXISTS",
MessageBoxButtons.YesNoCancel, MessageBoxIcon.Exclamation, MessageBoxDefaultButton.Button2)
If Response = DialogResult.Yes Then
ExportFile.Delete()
ElseIf Response = DialogResult.No Then
ExportFile = New IO.FileInfo(Common.Utility.IncrementExistingFileName(Me.ExportPath))
Else
ExportFile = Nothing
End If
If Not ExportFile Is Nothing Then
Me.CrystalReport.ExportToDisk(ExportFormatType.PortableDocFormat, ExportFile.FullName)
End If
End If
End If
Return ExportFile
End Function
Private Sub ShowReport()
Dim ReportViewer As New frmReportPreview
With ReportViewer
.rptViewer.ReportSource = Nothing
.rptViewer.ReportSource = Me.CrystalReport
.WindowState = FormWindowState.Maximized
.rptViewer.RefreshReport()
' Set zoom level: 1 = Page Width, 2 = Whole Page, 25-100 = zoom %
.rptViewer.Zoom(1)
.rptViewer.Show()
.Show()
End With
End Sub
Private Sub EmailReport(ByRef ReportMail As System.Net.Mail.MailMessage)
Dim ReportAttachment As IO.FileInfo = ExportReport()
If Not ReportAttachment Is Nothing AndAlso ReportAttachment.Exists Then
ReportMail.Attachments.Add(New System.Net.Mail.Attachment(ReportAttachment.FullName))
If Utility.SendEmailMessage(ReportMail) Then
End If
End If
End Sub
Public Overloads Sub Dispose()
Me.CrystalReport.Dispose()
If Not Me.DocumentToPrint Is Nothing Then
Me.DocumentToPrint.Dispose()
End If
End Sub
#End Region
#Region "PRIVATE METHODS"
Private Sub Initialize()
Me.CrystalReport = Nothing
Me.CRReportFile = Nothing
Me.ExportPath = String.Empty
Me.ADODataSet = Nothing
Me.XMLDataSource = Nothing
Me.ReportParameters = New List(Of CRParameter)
Me.ReportFormulas = New List(Of CRFormula)
Me.SourceType = ReportSourceType.XML
Me.ReportOption = GenerateReportOption.None
End Sub
Private Sub PrepareReport()
If Not Me.CRReportFile Is Nothing Then
Me.CrystalReport = New CrystalDecisions.CrystalReports.Engine.ReportDocument
Me.CrystalReport.Load(Me.CRReportFile.FullName)
Me.CrystalReport.DataSourceConnections.Clear()
SetReportConnectionInfo()
Me.CrystalReport.Refresh()
Me.CrystalReport.ReportClientDocument.VerifyDatabase()
If Me.ReportFormulas.Count > 0 Then
For Each Formula As CRFormula In Me.ReportFormulas
Formula.UpdateFormulaField(Me.CrystalReport)
Next Formula
End If
If Me.ReportParameters.Count > 0 Then
For Each Parameter As CRParameter In Me.ReportParameters
Parameter.UpdateReportParameter(Me.CrystalReport)
Next Parameter
End If
End If
End Sub
Private Sub SetReportConnectionInfo()
If Me.SourceType = ReportSourceType.PostgreSQL Then
Dim CRDatabase As CrystalDecisions.CrystalReports.Engine.Database = Me.CrystalReport.Database
Dim CRTables As CrystalDecisions.CrystalReports.Engine.Tables = CRDatabase.Tables
Dim CRConnectionInfo As New CrystalDecisions.Shared.ConnectionInfo
With CRConnectionInfo
.DatabaseName = <DBNAME>
.ServerName = <HOSTNAME>
.UserID = Utility.GetDBUsername
.Password = Utility.GetDBPassword
End With
For Each CRTable As CrystalDecisions.CrystalReports.Engine.Table In CRTables
Dim CRTableLogonInfo As CrystalDecisions.Shared.TableLogOnInfo = CRTable.LogOnInfo
CRTableLogonInfo.ConnectionInfo = CRConnectionInfo
CRTable.ApplyLogOnInfo(CRTableLogonInfo)
Next CRTable
ElseIf Me.SourceType = ReportSourceType.ADODataSet Then
Dim CRDatabase As CrystalDecisions.CrystalReports.Engine.Database = Me.CrystalReport.Database
Dim CRTables As CrystalDecisions.CrystalReports.Engine.Tables = CRDatabase.Tables
For Each CRTable As CrystalDecisions.CrystalReports.Engine.Table In CRTables
For Each ADOTable As DataTable In ADODataSet.Tables
If CRTable.Name.ToUpper.Trim = ADOTable.TableName.ToUpper.Trim Then
CRTable.SetDataSource(ADOTable)
Exit For
End If
Next ADOTable
Next CRTable
ElseIf Me.SourceType = ReportSourceType.XML Then
If Not Me.XMLDataSource Is Nothing AndAlso Me.XMLDataSource.Exists Then
Dim CRDatabaseAttributes As New CrystalDecisions.ReportAppServer.DataDefModel.PropertyBag
Dim CRLogonProperties As New CrystalDecisions.ReportAppServer.DataDefModel.PropertyBag
Dim CRConnectionDetails As New CrystalDecisions.ReportAppServer.DataDefModel.ConnectionInfo
Dim CRTable As CrystalDecisions.ReportAppServer.DataDefModel.Table
Dim CRTables As CrystalDecisions.ReportAppServer.DataDefModel.Tables = Me.CrystalReport.ReportClientDocument.DatabaseController.Database.Tables
Dim XMLData As New System.Data.DataSet
XMLData.ReadXml(Me.XMLDataSource.FullName)
With CRLogonProperties
.Add("File Path ", Me.XMLDataSource.FullName)
.Add("Internal Connection ID", "{be7cdac3-6a64-4923-8177-898ab55d0fa0}")
End With
With CRDatabaseAttributes
.Add("Database DLL", "crdb_adoplus.dll")
.Add("QE_DatabaseName", "")
.Add("QE_DatabaseType", "")
.Add("QE_LogonProperties", CRLogonProperties)
.Add("QE_ServerDescription", Me.XMLDataSource.Name.Substring(0, Me.XMLDataSource.Name.Length - Me.XMLDataSource.Extension.Length))
.Add("QE_SQLDB", "False")
.Add("SSO Enabled", "False")
End With
With CRConnectionDetails
.Attributes = CRDatabaseAttributes
.Kind = CrystalDecisions.ReportAppServer.DataDefModel.CrConnectionInfoKindEnum.crConnectionInfoKindCRQE
.UserName = ""
.Password = ""
End With
For I As Integer = 0 To XMLData.Tables.Count - 1
CRTable = New CrystalDecisions.ReportAppServer.DataDefModel.Table
With CRTable
.ConnectionInfo = CRConnectionDetails
.Name = XMLData.Tables(I).TableName
.QualifiedName = XMLData.Tables(I).TableName
.[Alias] = XMLData.Tables(I).TableName
End With
Me.CrystalReport.ReportClientDocument.DatabaseController.SetTableLocation(CRTables(I), CRTable)
Next I
End If
End If
End Sub
#End Region
End Class
PARAMETER OBJECT (CRParameter)
#Region "CRYSTAL REPORTS PARAMETER CLASS"
Public Class CRParameter
Public Property ParameterName As String
Public Property ParameterValue As Object
Public Sub New(ByVal CurrentParameterName As String, ByVal CurrentParameterValue As Object)
Me.ParameterName = CurrentParameterName
Me.ParameterValue = CurrentParameterValue
End Sub
Friend Sub UpdateReportParameter(ByRef CurrentReport As CrystalDecisions.CrystalReports.Engine.ReportDocument)
If Not CurrentReport Is Nothing Then
If Not String.IsNullOrEmpty(Me.ParameterName) Then
Using ReportFieldDefinitions As ParameterFieldDefinitions = CurrentReport.DataDefinition.ParameterFields
Using ReportParameter As ParameterFieldDefinition = ReportFieldDefinitions.Item(Me.ParameterName)
Dim ReportValues As ParameterValues = ReportParameter.CurrentValues
Dim NewValue As New ParameterDiscreteValue
ReportValues.Clear()
NewValue.Description = Me.ParameterName
NewValue.Value = Me.ParameterValue
ReportValues.Add(NewValue)
ReportParameter.ApplyCurrentValues(ReportValues)
ReportParameter.ApplyDefaultValues(ReportValues)
End Using
End Using
End If
End If
End Sub
End Class
#End Region
FORMULA OBJECT (CRFormula)
#Region "CRYSTAL REPORTS FORMULA VALUE CLASS"
Public Class CRFormula
Public Property FormulaName As String
Public Property FormulaValue As Object
Public Sub New(ByVal NewFormulaName As String, ByVal NewFormulaValue As Object)
Me.FormulaName = NewFormulaName
Me.FormulaValue = NewFormulaValue
End Sub
Friend Sub UpdateFormulaField(ByRef CurrentReport As CrystalDecisions.CrystalReports.Engine.ReportDocument)
If Not CurrentReport Is Nothing Then
If Not String.IsNullOrEmpty(Me.FormulaName) Then
Try
If Me.FormulaValue Is Nothing Then
Me.FormulaValue = ""
CurrentReport.DataDefinition.FormulaFields(Me.FormulaName).Text = Me.FormulaValue.ToString
ElseIf TypeOf Me.FormulaValue Is String AndAlso String.IsNullOrEmpty(Convert.ToString(Me.FormulaValue)) Then
Me.FormulaValue = ""
CurrentReport.DataDefinition.FormulaFields(Me.FormulaName).Text = Me.FormulaValue.ToString
ElseIf TypeOf Me.FormulaValue Is String AndAlso Not String.IsNullOrEmpty(Convert.ToString(Me.FormulaValue)) Then
Me.FormulaValue = "'" & Me.FormulaValue.ToString & "'"
CurrentReport.DataDefinition.FormulaFields(Me.FormulaName).Text = Me.FormulaValue.ToString
ElseIf TypeOf Me.FormulaValue Is Date Then
Me.FormulaValue = "'" & Convert.ToDateTime(Me.FormulaValue).ToString("yyyy-MM-dd") & "'"
CurrentReport.DataDefinition.FormulaFields(Me.FormulaName).Text = Me.FormulaValue.ToString
Else
CurrentReport.DataDefinition.FormulaFields(Me.FormulaName).Text = Me.FormulaValue.ToString
End If
Catch ex As Exception
End Try
End If
End If
End Sub
End Class
#End Region

Why does the combobox throws error when button associated with its event is clicked

Basic rundown of program: connected to a database. Combo box is populated with a terms list, after you select a term a get term button is pressed which populates a listview and then returns total balance due in a text box at the bottom of the form.
The Combobox populates, but when the btn is pressed catch ex throws an error along the lines of string cannot be converted to integer(occurs on the form design code). I'm not quite sure where I've gone wrong. It doesn't seem to catch anything else anywhere.
I'll include the code below
Imports Payables
Public Class Form1
Dim invoiceList As List(Of Invoices)
Dim termList As List(Of Terms)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
LoadComboBoxes()
End Sub
Private Sub LoadComboBoxes()
termList = TermsDB.GetTermsList
cboTerms.DataSource = termList
cboTerms.ValueMember = "TermsID"
cboTerms.DisplayMember = "Description"
End Sub
Private Sub btnGetInvoice_Click(sender As Object, e As EventArgs) Handles btnGetInvoice.Click
Dim invoiceList As List(Of Invoices)
Dim TermsID = CInt(cboTerms.SelectedValue)
Try
invoiceList = InvoicesDB.FindInvoiceByID(TermsID)
txtTotalBalanceDue.Text = FormatCurrency(InvoicesDB.GetBalanceDue())
If invoiceList.Count > 0 Then
Dim invoice As Invoices
For i = 0 To invoiceList.Count - 1
invoice = invoiceList(i)
lvInvoices.Items.Add(invoice.InvoiceID)
lvInvoices.Items(i).SubItems.Add(invoice.VendorID)
lvInvoices.Items(i).SubItems.Add(invoice.InvoiceNumber)
lvInvoices.Items(i).SubItems.Add(invoice.InvoiceDate)
lvInvoices.Items(i).SubItems.Add(invoice.InvoiceTotal)
lvInvoices.Items(i).SubItems.Add(invoice.PaymentTotal)
lvInvoices.Items(i).SubItems.Add(invoice.CreditTotal)
lvInvoices.Items(i).SubItems.Add(invoice.TermsID)
lvInvoices.Items(i).SubItems.Add(invoice.DueDate)
lvInvoices.Items(i).SubItems.Add(invoice.PaymentDate)
Next
Else
MessageBox.Show("There is no info on this account")
Me.Close()
End If
Catch ex As Exception
Throw ex
Me.Close()
End Try
End Sub
Private Sub btnExit_Click(sender As Object, e As EventArgs) Handles btnExit.Click
Me.Close()
End Sub
End Class
Public Class Invoices
Dim m_InvoiceID As Integer
Dim m_VendorID As Integer
Dim m_InvoiceNumber As String
Dim m_InvoiceDate As Date
Dim m_InvoiceTotal As Decimal
Dim m_PaymentTotal As Decimal
Dim m_CreditTotal As Decimal
Dim m_TermsID As Integer
Dim m_DueDate As Date
Dim m_PaymentDate As Date
Public Sub New()
End Sub
Public Property InvoiceID() As Integer
Get
Return m_InvoiceID
End Get
Set(value As Integer)
m_InvoiceID = value
End Set
End Property
Public Property VendorID() As Integer
Get
Return m_VendorID
End Get
Set(value As Integer)
m_VendorID = value
End Set
End Property
Public Property InvoiceNumber() As String
Get
Return m_InvoiceNumber
End Get
Set(value As String)
m_InvoiceNumber = value
End Set
End Property
Public Property InvoiceDate() As Date
Get
Return m_InvoiceDate
End Get
Set(value As Date)
m_InvoiceDate = value
End Set
End Property
Public Property InvoiceTotal() As Decimal
Get
Return m_InvoiceTotal
End Get
Set(value As Decimal)
m_InvoiceTotal = value
End Set
End Property
Public Property PaymentTotal() As Integer
Get
Return m_PaymentTotal
End Get
Set(value As Integer)
m_PaymentTotal = value
End Set
End Property
Public Property CreditTotal() As Integer
Get
Return m_CreditTotal
End Get
Set(value As Integer)
m_CreditTotal = value
End Set
End Property
Public Property TermsID() As Integer
Get
Return m_TermsID
End Get
Set(value As Integer)
m_TermsID = value
End Set
End Property
Public Property DueDate() As Date
Get
Return m_DueDate
End Get
Set(value As Date)
m_DueDate = value
End Set
End Property
Public Property PaymentDate() As Date
Get
Return m_PaymentDate
End Get
Set(value As Date)
m_PaymentDate = value
End Set
End Property
'Create a function BalanceDue to return the BalanceDue
Public Function GetBalanceDue() As Decimal
Return m_InvoiceTotal - m_PaymentTotal - m_CreditTotal
End Function
End Class
Imports System.Data.SqlClient
Public Class InvoicesDB
Public Shared Function FindInvoiceByID(ByVal TermsID) As List(Of Invoices)
Dim invoice As New Invoices
Dim connection As SqlConnection = PayablesDB.GetConnection
Dim invoiceList As New List(Of Invoices)
Dim selectStatement As String = "SELECT InvoiceID, VendorID, InvoiceNumber, InvoiceDate, InvoiceTotal,PaymentTotal,CreditTotal,TermsID,DueDate,PaymentDate FROM Invoices WHERE TermsID=#TermsID"
Dim selectCommand As New SqlCommand(selectStatement, connection)
'add the parameter to the parameter collection of the command object
selectCommand.Parameters.AddWithValue("#TermsID", TermsID)
Try
connection.Open()
Dim reader As SqlDataReader = selectCommand.ExecuteReader
If reader.Read Then
invoice.InvoiceID = CInt(reader("InvoiceID"))
invoice.VendorID = CInt(reader("VendorID"))
invoice.InvoiceNumber = CInt(reader("InvoiceNumber"))
invoice.InvoiceDate = CDate(reader("InvoiceDate"))
invoice.InvoiceTotal = CDec(reader("InvoiceTotal"))
invoice.PaymentTotal = CDec(reader("PaymentTotal"))
invoice.CreditTotal = CDec(reader("CreditTotal"))
invoice.TermsID = CInt(reader("TermsID"))
invoice.DueDate = CDate(reader("DueDate"))
invoice.PaymentDate = CDate(reader("PaymentDate"))
Else
'that means the invoice is not found
invoice = Nothing 'this means the vendor object no longer exists
End If
reader.Close()
connection.Close()
Catch ex As Exception
Throw ex
End Try
Return invoiceList
End Function
Public Shared Function GetBalanceDue() As Decimal 'aggregate
Dim connection As SqlConnection = PayablesDB.GetConnection
Dim selectCommand As New SqlCommand()
selectCommand.Connection = connection
selectCommand.CommandText =
"SELECT SUM(InvoiceTotal - PaymentTotal - CreditTotal) " &
"AS BalanceDue FROM Invoices" &
"WHERE TermsID=#TermsID"
connection.Open()
Dim balanceDue As Decimal = CDec(selectCommand.ExecuteScalar)
connection.Close()
Return balanceDue
End Function
End Class
Public Class Terms
Dim m_TermsID As Integer
Dim m_Description As String
Dim m_DueDays As Integer
Public Sub New()
End Sub
Public Property TermsID() As Integer
Get
Return m_TermsID
End Get
Set(ByVal value As Integer)
m_TermsID = value
End Set
End Property
Public Property Description() As String
Get
Return m_Description
End Get
Set(ByVal value As String)
m_Description = value
End Set
End Property
Public Property DueDays() As Integer
Get
Return m_DueDays
End Get
Set(ByVal value As Integer)
m_DueDays = value
End Set
End Property
End Class
Imports System.Data.SqlClient
Public Class TermsDB
Public Shared Function GetTermsList() As List(Of Terms)
Dim termList As New List(Of Terms)
Dim connection As SqlConnection = PayablesDB.GetConnection
Dim selectStatement As String =
"SELECT TermsID,Description,DueDays " &
"FROM Terms " &
"ORDER BY Description"
Dim selectCommand As New SqlCommand(selectStatement, connection)
Try
connection.Open()
Dim reader As SqlDataReader = selectCommand.ExecuteReader()
Dim term As Terms
Do While reader.Read
term = New Terms
term.TermsID = CInt(reader("TermsID"))
term.Description = reader("Description").ToString
term.DueDays = CInt(reader("DueDays"))
termList.Add(term)
Loop
reader.Close()
Catch ex As SqlException
Throw ex
Finally
connection.Close()
End Try
Return termList
End Function
End Class
I think your button is triggering the page load event, and you are losing the selected combobox value.
Do you have a text value as the first option in the combobox? That would cause the conversion error you're seeing.
Avoid binding the combobox on postback with something like
If ispostback = false Then
LoadComboBoxes()
End If

Reporting Progress for a CopyToAsync Operation

Is there a way to report progress on a CopyToAsync operation on a FileStream? As far as I can tell there are no Events listed for a FileStream object so I can't add a handler to it. The best examples I've found deal with DownloadProgressChanged/DownloadFileComplete for WebClient objects.
For i As Int32 = 0 To strFileList.Count - 1
Try
Using srmSource As FileStream = File.Open(dirSource + strFileList(i), FileMode.Open)
Using srmDestination As FileStream = File.Create(dirDestination + strFileList(i))
Me.lblStatus.Text = "Copying file - " & strFileList(i) & "..."
Await srmSource.CopyToAsync(srmDestination)
End Using
End Using
Me.lblStatus.Text = "Copying complete!"
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
Next
Here's what I came up with using these links as references:
http://blogs.msdn.com/b/dotnet/archive/2012/06/06/async-in-4-5-enabling-progress-and-cancellation-in-async-apis.aspx (converted from C# to VB.NET)
http://social.msdn.microsoft.com/Forums/en-US/8c121fef-ebc7-42ab-a2f8-3b5e9a6e9854/delegates-with-parameter?forum=vbide
Imports System.IO
Imports System.Net
Imports System.Threading.Tasks
Public Class frmStartup
Private Async Sub frmStartup_Load(sender As Object, e As EventArgs) Handles Me.Load
Dim FileList As List(Of String) = GetFilesToTransfer()
If FileList.Count > 0 Then
UpdateLabel("Found files to transfer...")
Me.prgTransfer.Visible = True
Try
Dim ProgressIndicator As Object = New Progress(Of Int32)(AddressOf ReportProgress)
Await TransferFiles(FileList, ProgressIndicator)
UpdateLabel("File transfer complete!")
Catch ex As Exception
UpdateLabel("Error transferring files!")
Finally
Me.prgTransfer.Visible = False
End Try
End If
End Sub
Private Function GetFilesToTransfer() As List(Of String)
Dim strFilesToTransfer As List(Of String) = New List(Of String)
strFilesToTransfer.Add("aud1.mp3")
strFilesToTransfer.Add("aud2.mp3")
Return strFilesToTransfer
End Function
Public Async Function TransferFiles(ByVal FileList As List(Of String), ByVal Progress As IProgress(Of Int32)) As Task
Dim intTotal As Int32 = FileList.Count
Dim dirSource As String = "\\source\"
Dim dirDestination As String = "c:\destination\"
Await Task.Run(Async Function()
Dim intTemp As Int32 = 0
For i As Int32 = 0 To FileList.Count - 1
UpdateLabel("Copying " & FileList(i) & "...")
Using srmSource As FileStream = File.Open(dirSource + FileList(i), FileMode.Open)
Using srmDestination As FileStream = File.Create(dirDestination + FileList(i))
Await srmSource.CopyToAsync(srmDestination)
End Using
End Using
intTemp += 1
If Progress IsNot Nothing Then
Progress.Report((intTemp * 100 / intTotal))
End If
Next
End Function)
End Function
Private Delegate Sub UpdateLabelInvoker(ByVal LabelText As String)
Private Sub UpdateLabel(ByVal LabelText As String)
If Me.lblStatus.InvokeRequired Then
Me.lblStatus.Invoke(New UpdateLabelInvoker(AddressOf UpdateLabel), LabelText)
Else
Me.lblStatus.Text = LabelText
End If
End Sub
Private Sub ReportProgress(ByVal Value As Int32)
Me.prgTransfer.Value = Value
End Sub
End Class

ICSharpCode.TextEditor.TextEditorControl to VB.net UserControl Porting Problems

I am trying to create a vb.net usercontrol based on SharpDevelop TextEditor. I want syntax highlighting and code completion. In order to do that I decided to port CSharpCodeCompletion example from SharpDevelop's source code (version 3.2.1.6466). It is in folder "samples\CSharpCodeCompletion"
The control seems to run, syntax highlighting is OK and the code completion window is shown when the '.' (period) key is pressed. All the members are listed OK in completion window.
Right now I am facing three problems:
1. When the code completion window is shown any keystrokes are going to the editor and thus the search function in the listbox is not working.
2. When I select an entry from the listbox the word goes back to the editor but it deletes the period. For example I am typing "String." --> Listbox shows up --> Select the word "Empty" and I am getting "StringEmpty" in the editor.
3. In this command Return GetMemberText(ambience, CType(c, ICSharpCode.SharpDevelop.Dom.IMember)) I am getting a cast exception.
Please note that when I compile and run the original C# code from the example the editor and the completion window works as expected. My guess is focusing in two things, first there is a problem because I place the editor inside a usercontrol instead of a form as it is in the example, however I cannot see any obvious problem in my code pointing to this direction. Second there is a problem because of the porting of C# code to VB. C# isn't my thing at all but I tried my best (I know some Java) to rewrite the entire thing to VB.
I know that my code is big but I am posting the entire control code in case someone wants to load it to VS2010 and give it a try. In this case you are going to need ICSharpCode.NRefactory, ICSharpCode.SharpDevelop.Dom, ICSharpCode.TextEditor, log4net and Mono.Cecil assemblies from the example's bin folder.
Thank you and please forgive my English. Here is my Code
Public Class ctlVBCodeEditor
Private Class HostCallbackImplementation
Private Shared Sub ShowMessageWithException(msg As String, ex As Exception)
DevExpress.XtraEditors.XtraMessageBox.Show(msg & vbCrLf & ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Stop)
End Sub
Private Shared Sub ShowMessage(msg As String)
DevExpress.XtraEditors.XtraMessageBox.Show(msg, "Error", MessageBoxButtons.OK, MessageBoxIcon.Stop)
End Sub
Private Shared Sub ShowAssemblyLoadError(fileName As String, include As String, msg As String)
DevExpress.XtraEditors.XtraMessageBox.Show(msg & vbCrLf & "File: " & fileName & vbCrLf & "Include: " & include, "Error", MessageBoxButtons.OK, MessageBoxIcon.Stop)
End Sub
Public Shared Sub Register(ctlCode As ctlVBCodeEditor)
ICSharpCode.SharpDevelop.Dom.HostCallback.GetCurrentProjectContent = New Func(Of ICSharpCode.SharpDevelop.Dom.IProjectContent)(Function() ctlCode.myContent)
ICSharpCode.SharpDevelop.Dom.HostCallback.ShowError = New Action(Of String, System.Exception)(AddressOf ShowMessageWithException)
ICSharpCode.SharpDevelop.Dom.HostCallback.ShowMessage = New Action(Of String)(AddressOf ShowMessage)
ICSharpCode.SharpDevelop.Dom.HostCallback.ShowAssemblyLoadError = New Action(Of String, String, String)(AddressOf ShowAssemblyLoadError)
End Sub
End Class
Private Class CodeCompletionData
Inherits ICSharpCode.TextEditor.Gui.CompletionWindow.DefaultCompletionData
Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionData
Private Shared vbAmbience As ICSharpCode.SharpDevelop.Dom.VBNet.VBNetAmbience = New ICSharpCode.SharpDevelop.Dom.VBNet.VBNetAmbience
Private Shared Function GetMemberImageIndex(m As ICSharpCode.SharpDevelop.Dom.IMember) As Integer
Dim Result As Integer = 0
If TypeOf m Is ICSharpCode.SharpDevelop.Dom.IMethod Then
Result = 1
ElseIf TypeOf m Is ICSharpCode.SharpDevelop.Dom.IProperty Then
Result = 2
ElseIf TypeOf m Is ICSharpCode.SharpDevelop.Dom.IField Then
Result = 3
ElseIf TypeOf m Is ICSharpCode.SharpDevelop.Dom.IEvent Then
Result = 6
Else
Result = 3
End If
Return Result
End Function
Private Shared Function GetClassImageIndex(cl As ICSharpCode.SharpDevelop.Dom.IClass) As Integer
Dim Result As Integer = 0
If cl.ClassType = ICSharpCode.SharpDevelop.Dom.ClassType.Enum Then
Result = 4
End If
Return Result
End Function
Private Shared Function GetEntityText(e As ICSharpCode.SharpDevelop.Dom.IEntity) As String
Dim Result As String = String.Empty
Dim amb As ICSharpCode.SharpDevelop.Dom.IAmbience = vbAmbience
If TypeOf e Is ICSharpCode.SharpDevelop.Dom.IMethod Then
Result = amb.Convert(CType(e, ICSharpCode.SharpDevelop.Dom.IMethod))
ElseIf TypeOf e Is ICSharpCode.SharpDevelop.Dom.IProperty Then
Result = amb.Convert(CType(e, ICSharpCode.SharpDevelop.Dom.IProperty))
ElseIf TypeOf e Is ICSharpCode.SharpDevelop.Dom.IEvent Then
Result = amb.Convert(CType(e, ICSharpCode.SharpDevelop.Dom.IEvent))
ElseIf TypeOf e Is ICSharpCode.SharpDevelop.Dom.IField Then
Result = amb.Convert(CType(e, ICSharpCode.SharpDevelop.Dom.IField))
ElseIf TypeOf e Is ICSharpCode.SharpDevelop.Dom.IClass Then
Result = amb.Convert(CType(e, ICSharpCode.SharpDevelop.Dom.IClass))
Else
Result = e.ToString
End If
Return Result
End Function
Public Shared Function XmlDocumentationToText(xmlDoc As String) As String
Dim sb As New System.Text.StringBuilder
Try
Using reader As New Xml.XmlTextReader(New IO.StringReader("<root>" & xmlDoc & "</root>"))
reader.XmlResolver = Nothing
While reader.Read
Select Case reader.NodeType
Case Xml.XmlNodeType.Text
sb.Append(reader.Value)
Case Xml.XmlNodeType.Element
Select Case reader.Name
Case "filterpriority"
reader.Skip()
Case "returns"
sb.AppendLine()
sb.Append("Returns: ")
Case "param"
sb.AppendLine()
sb.Append(reader.GetAttribute("name") + ": ")
Case "remarks"
sb.AppendLine()
sb.Append("Remarks: ")
Case "see"
If reader.IsEmptyElement Then
sb.Append(reader.GetAttribute("cref"))
Else
reader.MoveToContent()
If reader.HasValue Then
sb.Append(reader.Value)
Else
sb.Append(reader.GetAttribute("cref"))
End If
End If
End Select
End Select
End While
End Using
Return sb.ToString
Catch ex As Exception
Return xmlDoc
End Try
End Function
Private member As ICSharpCode.SharpDevelop.Dom.IMember
Private c As ICSharpCode.SharpDevelop.Dom.IClass
Private mOverloads As Integer = 0
Private _Description As String
Public Overrides ReadOnly Property Description As String
Get
If String.IsNullOrEmpty(_Description) Then
Dim entity As ICSharpCode.SharpDevelop.Dom.IEntity
If member IsNot Nothing Then
entity = CType(member, ICSharpCode.SharpDevelop.Dom.IEntity)
Else
entity = CType(c, ICSharpCode.SharpDevelop.Dom.IEntity)
End If
_Description = GetEntityText(entity)
If mOverloads > 1 Then _Description &= " (+" & mOverloads.ToString & " overloads"
_Description &= vbCrLf & XmlDocumentationToText(entity.Documentation)
End If
Return _Description
End Get
End Property
Public Sub AddOverload()
mOverloads += 1
End Sub
Public Sub New(theMember As ICSharpCode.SharpDevelop.Dom.IMember)
MyBase.New(theMember.Name, String.Empty, GetMemberImageIndex(theMember))
Me.member = theMember
End Sub
Public Sub New(theClass As ICSharpCode.SharpDevelop.Dom.IClass)
MyBase.New(theClass.Name, String.Empty, GetClassImageIndex(theClass))
Me.c = theClass
End Sub
End Class
Private Class CodeCompletionProvider
Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider
Private ctlCode As ctlVBCodeEditor
Private Function FindExpression(txtArea As ICSharpCode.TextEditor.TextArea) As ICSharpCode.SharpDevelop.Dom.ExpressionResult
Dim finder As ICSharpCode.SharpDevelop.Dom.IExpressionFinder = New ICSharpCode.SharpDevelop.Dom.VBNet.VBExpressionFinder
Dim Result As ICSharpCode.SharpDevelop.Dom.ExpressionResult = finder.FindExpression(txtArea.Document.TextContent, txtArea.Caret.Offset)
If Result.Region.IsEmpty Then Result.Region = New ICSharpCode.SharpDevelop.Dom.DomRegion(txtArea.Caret.Line + 1, txtArea.Caret.Column + 1)
Return Result
End Function
Private Sub AddCompletionData(resultList As List(Of ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionData), completionData As ArrayList)
Dim nameDictionary As Dictionary(Of String, CodeCompletionData) = New Dictionary(Of String, CodeCompletionData)
'Add the completion data as returned by SharpDevelop.Dom to the
'list for the text editor
For Each obj As Object In completionData
If TypeOf obj Is String Then
'namespace names are returned as string
resultList.Add(New ICSharpCode.TextEditor.Gui.CompletionWindow.DefaultCompletionData(Convert.ToString(obj), "namespace " & obj.ToString, 5))
ElseIf TypeOf obj Is ICSharpCode.SharpDevelop.Dom.IClass Then
Dim cl As ICSharpCode.SharpDevelop.Dom.IClass = CType(obj, ICSharpCode.SharpDevelop.Dom.IClass)
resultList.Add(New CodeCompletionData(cl))
ElseIf TypeOf obj Is ICSharpCode.SharpDevelop.Dom.IMember Then
Dim mm As ICSharpCode.SharpDevelop.Dom.IMember = CType(obj, ICSharpCode.SharpDevelop.Dom.IMember)
If (TypeOf mm Is ICSharpCode.SharpDevelop.Dom.IMethod) AndAlso (CType(mm, ICSharpCode.SharpDevelop.Dom.IMethod).IsConstructor) Then
Continue For
End If
'Group results by name and add "(x Overloads)" to the
'description if there are multiple results with the same name.
Dim data As CodeCompletionData = Nothing
If nameDictionary.TryGetValue(mm.Name, data) Then
data.AddOverload()
Else
data = New CodeCompletionData(mm)
nameDictionary(mm.Name) = data
resultList.Add(data)
End If
Else
'Current ICSharpCode.SharpDevelop.Dom should never return anything else
Throw New NotSupportedException
End If
Next
End Sub
Public ReadOnly Property ImageList As System.Windows.Forms.ImageList Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider.ImageList
Get
Return ctlCode.imageList1
End Get
End Property
Public ReadOnly Property PreSelection As String Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider.PreSelection
Get
Return String.Empty
End Get
End Property
Public ReadOnly Property DefaultIndex As Integer Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider.DefaultIndex
Get
Return -1
End Get
End Property
Public Function ProcessKey(key As Char) As ICSharpCode.TextEditor.Gui.CompletionWindow.CompletionDataProviderKeyResult Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider.ProcessKey
If (Char.IsLetterOrDigit(key) Or key = " ") Then
Return ICSharpCode.TextEditor.Gui.CompletionWindow.CompletionDataProviderKeyResult.NormalKey
Else
Return ICSharpCode.TextEditor.Gui.CompletionWindow.CompletionDataProviderKeyResult.InsertionKey
End If
End Function
Public Function InsertAction(data As ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionData, textArea As ICSharpCode.TextEditor.TextArea, insertionOffset As Integer, key As Char) As Boolean Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider.InsertAction
textArea.Caret.Position = textArea.Document.OffsetToPosition(insertionOffset)
Return data.InsertAction(textArea, key)
End Function
Public Function GenerateCompletionData(fileName As String, textArea As ICSharpCode.TextEditor.TextArea, charTyped As Char) As ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionData() Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider.GenerateCompletionData
Dim resolver As New ICSharpCode.SharpDevelop.Dom.NRefactoryResolver.NRefactoryResolver(ctlCode.myContent.Language)
Dim rr As ICSharpCode.SharpDevelop.Dom.ResolveResult = resolver.Resolve(FindExpression(textArea), _
ctlCode.parseInfo, _
textArea.MotherTextEditorControl.Text)
Dim resultList As New List(Of ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionData)
If rr IsNot Nothing Then
Dim completionData As ArrayList = rr.GetCompletionData(ctlCode.myContent)
If completionData IsNot Nothing Then
AddCompletionData(resultList, completionData)
End If
End If
Return resultList.ToArray()
End Function
Public Sub New(myControl As ctlVBCodeEditor)
Me.ctlCode = myControl
End Sub
End Class
Private Class CodeCompletionKeyHandler
Private ctlCode As ctlVBCodeEditor
Private txtCode As ICSharpCode.TextEditor.TextEditorControl
Private codeCompletionWin As ICSharpCode.TextEditor.Gui.CompletionWindow.CodeCompletionWindow
Private Sub CloseCodeCompletionWindow(sender As Object, e As EventArgs)
If codeCompletionWin IsNot Nothing Then
RemoveHandler codeCompletionWin.FormClosed, AddressOf CloseCodeCompletionWindow
codeCompletionWin.Dispose()
codeCompletionWin = Nothing
End If
End Sub
Public Function TextAreaKeyEventHandler(key As Char) As Boolean
If codeCompletionWin IsNot Nothing Then
If codeCompletionWin.ProcessKeyEvent(key) Then
Return True
End If
End If
If key = "." Then
Dim completionDataProvider As ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider = New CodeCompletionProvider(Me.ctlCode)
Dim theForm As System.Windows.Forms.Form = Me.ctlCode.FindForm
codeCompletionWin = ICSharpCode.TextEditor.Gui.CompletionWindow.CodeCompletionWindow.ShowCompletionWindow(theForm, Me.txtCode, ctlVBCodeEditor.DummyFileName, completionDataProvider, key)
If codeCompletionWin IsNot Nothing Then
AddHandler codeCompletionWin.FormClosed, AddressOf CloseCodeCompletionWindow
End If
End If
Return False
End Function
Public Sub New(myControl As ctlVBCodeEditor, myCodeText As ICSharpCode.TextEditor.TextEditorControl)
Me.ctlCode = myControl
Me.txtCode = myCodeText
End Sub
Public Shared Function Attach(theControl As ctlVBCodeEditor, theEditor As ICSharpCode.TextEditor.TextEditorControl) As CodeCompletionKeyHandler
Dim Result As New CodeCompletionKeyHandler(theControl, theEditor)
AddHandler theEditor.ActiveTextAreaControl.TextArea.KeyEventHandler, AddressOf Result.TextAreaKeyEventHandler
AddHandler theEditor.Disposed, AddressOf Result.CloseCodeCompletionWindow
Return Result
End Function
End Class
Private Class ToolTipProvider
Private ctlCode As ctlVBCodeEditor
Private txtCode As ICSharpCode.TextEditor.TextEditorControl
Private Function GetText(result As ICSharpCode.SharpDevelop.Dom.ResolveResult) As String
If result Is Nothing Then
Return String.Empty
End If
If TypeOf result Is ICSharpCode.SharpDevelop.Dom.MixedResolveResult Then
Return GetText(CType(result, ICSharpCode.SharpDevelop.Dom.MixedResolveResult).PrimaryResult)
End If
Dim ambience As ICSharpCode.SharpDevelop.Dom.IAmbience = New ICSharpCode.SharpDevelop.Dom.VBNet.VBNetAmbience
ambience.ConversionFlags = ICSharpCode.SharpDevelop.Dom.ConversionFlags.StandardConversionFlags Or ICSharpCode.SharpDevelop.Dom.ConversionFlags.ShowAccessibility
If TypeOf result Is ICSharpCode.SharpDevelop.Dom.MemberResolveResult Then
Return GetMemberText(ambience, CType(result, ICSharpCode.SharpDevelop.Dom.MemberResolveResult).ResolvedMember)
ElseIf TypeOf result Is ICSharpCode.SharpDevelop.Dom.LocalResolveResult Then
Dim lrr As ICSharpCode.SharpDevelop.Dom.LocalResolveResult = CType(result, ICSharpCode.SharpDevelop.Dom.LocalResolveResult)
ambience.ConversionFlags = ICSharpCode.SharpDevelop.Dom.ConversionFlags.UseFullyQualifiedTypeNames Or ICSharpCode.SharpDevelop.Dom.ConversionFlags.ShowReturnType
Dim sb As New System.Text.StringBuilder
If lrr.IsParameter Then
sb.Append("parameter ")
Else
sb.Append("local variable ")
End If
sb.Append(ambience.Convert(lrr.Field))
Return sb.ToString
ElseIf TypeOf result Is ICSharpCode.SharpDevelop.Dom.NamespaceResolveResult Then
Return "namespace " & CType(result, ICSharpCode.SharpDevelop.Dom.NamespaceResolveResult).Name
ElseIf TypeOf result Is ICSharpCode.SharpDevelop.Dom.TypeResolveResult Then
Dim c As ICSharpCode.SharpDevelop.Dom.IClass = CType(result, ICSharpCode.SharpDevelop.Dom.TypeResolveResult).ResolvedClass
If c IsNot Nothing Then
'Return ambience.Convert(result.ResolvedType)
Return GetMemberText(ambience, CType(c, ICSharpCode.SharpDevelop.Dom.IMember))
Else
Return ambience.Convert(result.ResolvedType)
End If
ElseIf TypeOf result Is ICSharpCode.SharpDevelop.Dom.MethodGroupResolveResult Then
Dim mrr As ICSharpCode.SharpDevelop.Dom.MethodGroupResolveResult = CType(result, ICSharpCode.SharpDevelop.Dom.MethodGroupResolveResult)
Dim m As ICSharpCode.SharpDevelop.Dom.IMethod = mrr.GetMethodIfSingleOverload
If m IsNot Nothing Then
Return GetMemberText(ambience, m)
Else
Return "Overload of " & ambience.Convert(mrr.ContainingType) & "." & mrr.Name
End If
Else
Return String.Empty
End If
End Function
Private Shared Function GetMemberText(ambience As ICSharpCode.SharpDevelop.Dom.IAmbience, member As ICSharpCode.SharpDevelop.Dom.IMember) As String
Dim sb As New System.Text.StringBuilder
If TypeOf member Is ICSharpCode.SharpDevelop.Dom.IField Then
sb.Append(ambience.Convert(CType(member, ICSharpCode.SharpDevelop.Dom.IField)))
ElseIf TypeOf member Is ICSharpCode.SharpDevelop.Dom.IProperty Then
sb.Append(ambience.Convert(CType(member, ICSharpCode.SharpDevelop.Dom.IProperty)))
ElseIf TypeOf member Is ICSharpCode.SharpDevelop.Dom.IEvent Then
sb.Append(ambience.Convert(CType(member, ICSharpCode.SharpDevelop.Dom.IEvent)))
ElseIf TypeOf member Is ICSharpCode.SharpDevelop.Dom.IMethod Then
sb.Append(ambience.Convert(CType(member, ICSharpCode.SharpDevelop.Dom.IMethod)))
ElseIf TypeOf member Is ICSharpCode.SharpDevelop.Dom.IClass Then
sb.Append(ambience.Convert(CType(member, ICSharpCode.SharpDevelop.Dom.IClass)))
Else
sb.Append("unknown member ")
sb.Append(member.ToString())
End If
Dim documentation As String = member.Documentation
If (documentation IsNot Nothing) AndAlso (documentation.Length > 0) Then
sb.Append(vbCrLf)
sb.Append(CodeCompletionData.XmlDocumentationToText(documentation))
End If
Return sb.ToString
End Function
Private Sub OnToolTipRequest(sender As Object, e As ICSharpCode.TextEditor.ToolTipRequestEventArgs)
If e.InDocument And (Not e.ToolTipShown) Then
Dim expFinder As ICSharpCode.SharpDevelop.Dom.IExpressionFinder = New ICSharpCode.SharpDevelop.Dom.VBNet.VBExpressionFinder
Dim expResult As ICSharpCode.SharpDevelop.Dom.ExpressionResult = expFinder.FindFullExpression(txtCode.Text, txtCode.Document.PositionToOffset(e.LogicalPosition))
If expResult.Region.IsEmpty Then
expResult.Region = New ICSharpCode.SharpDevelop.Dom.DomRegion(e.LogicalPosition.Line + 1, e.LogicalPosition.Column + 1)
End If
Dim txtArea As ICSharpCode.TextEditor.TextArea = txtCode.ActiveTextAreaControl.TextArea
Dim resolver As New ICSharpCode.SharpDevelop.Dom.NRefactoryResolver.NRefactoryResolver(ctlCode.myContent.Language)
Dim rr As ICSharpCode.SharpDevelop.Dom.ResolveResult = resolver.Resolve(expResult, ctlCode.parseInfo, txtArea.MotherTextEditorControl.Text)
Dim toolTipText As String = GetText(rr)
If Not String.IsNullOrEmpty(toolTipText) Then
e.ShowToolTip(toolTipText)
End If
End If
End Sub
Public Sub New(myControl As ctlVBCodeEditor, myCodeText As ICSharpCode.TextEditor.TextEditorControl)
Me.ctlCode = myControl
Me.txtCode = myCodeText
End Sub
Public Shared Sub Attach(theControl As ctlVBCodeEditor, theEditor As ICSharpCode.TextEditor.TextEditorControl)
Dim tp As New ToolTipProvider(theControl, theEditor)
AddHandler theEditor.ActiveTextAreaControl.TextArea.ToolTipRequest, AddressOf tp.OnToolTipRequest
End Sub
End Class
Private Const DummyFileName As String = "dummy.vb"
Private pcREG As ICSharpCode.SharpDevelop.Dom.ProjectContentRegistry
Private myContent As ICSharpCode.SharpDevelop.Dom.DefaultProjectContent
Private parseInfo As ICSharpCode.SharpDevelop.Dom.ParseInformation
Private lastCompUnit As ICSharpCode.SharpDevelop.Dom.ICompilationUnit
Private parserThread As Threading.Thread
Private CurrentLanguageProperties As ICSharpCode.SharpDevelop.Dom.LanguageProperties
Private Sub InitializeControl()
parseInfo = New ICSharpCode.SharpDevelop.Dom.ParseInformation
CurrentLanguageProperties = ICSharpCode.SharpDevelop.Dom.LanguageProperties.VBNet
txtCode.SetHighlighting("VBNET")
HostCallbackImplementation.Register(Me)
CodeCompletionKeyHandler.Attach(Me, txtCode)
ToolTipProvider.Attach(Me, txtCode)
pcREG = New ICSharpCode.SharpDevelop.Dom.ProjectContentRegistry
'pcREG.ActivatePersistence(IO.Path.Combine(My.Computer.FileSystem.SpecialDirectories.Temp, "test"))
myContent = New ICSharpCode.SharpDevelop.Dom.DefaultProjectContent()
myContent.Language = CurrentLanguageProperties
End Sub
Private Function ConvertCompilationUnit(cu As ICSharpCode.NRefactory.Ast.CompilationUnit) As ICSharpCode.SharpDevelop.Dom.ICompilationUnit
Dim converter As New ICSharpCode.SharpDevelop.Dom.NRefactoryResolver.NRefactoryASTConvertVisitor(myContent)
cu.AcceptVisitor(converter, Nothing)
Return converter.Cu
End Function
Private Sub ParseStep()
Dim code As String = String.Empty
Invoke(New MethodInvoker(Sub() code = txtCode.Text))
Dim txtReader As IO.TextReader = New IO.StringReader(code)
Dim newCompUnit As ICSharpCode.SharpDevelop.Dom.ICompilationUnit
Dim supportedLanguage As ICSharpCode.NRefactory.SupportedLanguage = ICSharpCode.NRefactory.SupportedLanguage.VBNet
Using p As ICSharpCode.NRefactory.IParser = ICSharpCode.NRefactory.ParserFactory.CreateParser(supportedLanguage, txtReader)
'we only need to parse types and method definitions, no method bodies
p.ParseMethodBodies = False
p.Parse()
newCompUnit = ConvertCompilationUnit(p.CompilationUnit)
End Using
'Remove information from lastCompilationUnit and add from newCompilationUnit.
myContent.UpdateCompilationUnit(lastCompUnit, newCompUnit, DummyFileName)
lastCompUnit = newCompUnit
parseInfo.SetCompilationUnit(newCompUnit)
End Sub
Private Sub BackgroundParser()
BeginInvoke(New MethodInvoker(Sub() lblInfo.Text = "Loading Visual Basic..."))
myContent.AddReferencedContent(pcREG.Mscorlib)
'do one initial parser step to enable code-completion while other references are loading
ParseStep()
Dim refAssemblies As String() = {"System", _
"System.Data", _
"System.Drawing", _
"System.Xml", _
"System.Windows.Forms", _
"Microsoft.VisualBasic"}
For Each asmName As String In refAssemblies
Dim asmNameCopy As String = asmName
BeginInvoke(New MethodInvoker(Sub() lblInfo.Text = "Loading " & asmNameCopy & "..."))
Dim refContent As ICSharpCode.SharpDevelop.Dom.IProjectContent = pcREG.GetProjectContentForReference(asmName, asmName)
myContent.AddReferencedContent(refContent)
If TypeOf refContent Is ICSharpCode.SharpDevelop.Dom.ReflectionProjectContent Then
CType(refContent, ICSharpCode.SharpDevelop.Dom.ReflectionProjectContent).InitializeReferences()
End If
Next
myContent.DefaultImports = New ICSharpCode.SharpDevelop.Dom.DefaultUsing(myContent)
myContent.DefaultImports.Usings.Add("System")
myContent.DefaultImports.Usings.Add("System.Text")
myContent.DefaultImports.Usings.Add("Microsoft.VisualBasic")
BeginInvoke(New MethodInvoker(Sub() lblInfo.Text = "Ready..."))
'Parse the current file every 2 seconds
While Not IsDisposed
ParseStep()
Threading.Thread.Sleep(2000)
End While
End Sub
Protected Overrides Sub OnLoad(e As System.EventArgs)
MyBase.OnLoad(e)
If Not DesignMode Then
parserThread = New Threading.Thread(AddressOf BackgroundParser)
parserThread.IsBackground = True
parserThread.Start()
End If
End Sub
Public Sub New()
' This call is required by the designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
If Not DesignMode Then
InitializeControl()
End If
End Sub
End Class

The best way to extract data from a CSV file into a searchable datastructure?

I have a csv file with 48 columns of data.
I need to open this file, place it into a data structure and then search that data and present it in a DataRepeater.
So far I have successfully used CSVReader to extract the data and bind it to myDataRepeater. However I am now struggling to place the data in a table so that I can filter the results. I do not want to use SQL or any other database.
Does anyone have a suggestion on the best way to do this?
So far, this is working in returning all records:
Private Sub BindCsv()
' open the file "data.csv" which is a CSV file with headers"
Dim dirInfo As New DirectoryInfo(Server.MapPath("~/ftp/"))
Dim fileLocation As String = dirInfo.ToString & "data.txt"
Using csv As New CsvReader(New StreamReader(fileLocation), True)
myDataRepeater.DataSource = csv
myDataRepeater.DataBind()
End Using
End Sub
Protected Sub myDataRepeater_ItemDataBound(ByVal sender As Object, ByVal e As RepeaterItemEventArgs) Handles myDataRepeater.ItemDataBound
Dim dataItem As String() = DirectCast(e.Item.DataItem, String())
DirectCast(e.Item.FindControl("lblPropertyName"), ITextControl).Text = dataItem(2).ToString
DirectCast(e.Item.FindControl("lblPrice"), ITextControl).Text = dataItem(7).ToString
DirectCast(e.Item.FindControl("lblPricePrefix"), ITextControl).Text = dataItem(6)
DirectCast(e.Item.FindControl("lblPropertyID"), ITextControl).Text = dataItem(1)
DirectCast(e.Item.FindControl("lblTYPE"), ITextControl).Text = dataItem(18)
DirectCast(e.Item.FindControl("lblBedrooms"), ITextControl).Text = dataItem(8)
DirectCast(e.Item.FindControl("lblShortDescription"), ITextControl).Text = dataItem(37)
Dim dirInfo As New DirectoryInfo(Server.MapPath("~/ftp/images/"))
DirectCast(e.Item.FindControl("imgMain"), Image).ImageUrl = dirInfo.ToString & "pBRANCH_" & dataItem(1) & ".jpg"
DirectCast(e.Item.FindControl("linkMap"), HyperLink).NavigateUrl = "http://www.multimap.com/map/browse.cgi?client=public&db=pc&cidr_client=none&lang=&pc=" & dataItem(5) & "&advanced=&client=public&addr2=&quicksearch=" & dataItem(5) & "&addr3=&addr1="
End Sub
Code add to filter results:
Try
Dim csv As New CSVFile(fileLocation)
Dim ds As DataSet = csv.ToDataSet("MyTable")
If Not ds Is Nothing Then
Dim strExpr As String = "Bedrooms >= '3'"
Dim strSort As String = "PropertyID ASC"
'Use the Select method to find all rows matching the filter.
Dim myRows() As DataRow
'myRows = Dt.Select(strExpr, strSort)
myRows = csv.ToDataSet("MyTable").Tables("MyTable").Select(strExpr, strSort)
myDataRepeater.DataSource = myRows
myDataRepeater.DataBind()
End If
Catch ex As Exception
End Try
Which does return the two rows I am expecting but then when it binds to the datarepeater I get the following error:
DataBinding: 'System.Data.DataRow' does not contain a property with the name 'PropertyName'.
Corrected code, filter not being applied:
Public Sub PageLoad(ByVal Sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
If Not Page.IsPostBack Then
ReadCsv()
lblSearch.Text = "Lettings Search"
End If
End Sub
Private Sub ReadCsv()
Dim dirInfo As New DirectoryInfo(Server.MapPath("~/ftp/"))
Dim fileLocation As String = dirInfo.ToString & "data.txt"
Try
Dim csv As New CSVFile(fileLocation)
Dim ds As DataSet = csv.ToDataSet("MyTable")
If Not ds Is Nothing Then
myDataRepeater.DataSource = ds
myDataRepeater.DataMember = ds.Tables.Item(0).TableName
myDataRepeater.DataBind()
End If
ds = Nothing
csv = Nothing
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Protected Sub btnSubmit_Click(ByVal sender As Object, ByVal e As System.Web.UI.ImageClickEventArgs) Handles btnSubmit.Click
Dim rowCount As Integer
rowCount = QueryCsv()
pnlSearch.Visible = False
lblResults.Visible = True
lblSearch.Text = "Search Results"
lblResults.Text = "Your search returned " & rowCount.ToString & " results"
If rowCount > 0 Then
myDataRepeater.Visible = True
pnlResults.Visible = True
btnBack.Visible = True
End If
End Sub
Protected Function QueryCsv() As Integer
Dim dirInfo As New DirectoryInfo(Server.MapPath("~/ftp/"))
Dim fileLocation As String = dirInfo.ToString & "data.txt"
Dim numberofRows As Integer
Try
Dim csv As New CSVFile(fileLocation)
Dim ds As DataSet = csv.ToDataSet("MyTable")
If Not ds Is Nothing Then
Dim strExpr As String = "PropertyID = 'P1005'"
Dim strSort As String = "PropertyID DESC"
Try
ds.Tables.Item(0).DefaultView.RowFilter = strExpr
ds.Tables.Item(0).DefaultView.Sort = strSort
myDataRepeater.DataSource = ds.Tables.Item(0).DefaultView
Catch ex As Exception
End Try
End If
numberofRows = ds.Tables("MyTable").Rows.Count
Catch ex As Exception
End Try
Return numberofRows
End Function
Why not use the built-in TextFileParser to get the data into a DataTable? Something like Paul Clement's answer in this thread
One of the ways I've done this is by using a structure array and reflection.
First, set up your structure in a module: CSVFileFields.vb
Imports System.Reflection
Public Module CSVFileFields
#Region " CSV Fields "
Public Structure CSVFileItem
Dim NAME As String
Dim ADDR1 As String
Dim ADDR2 As String
Dim CITY As String
Dim ST As String
Dim ZIP As String
Dim PHONE As String
Public Function FieldNames() As String()
Dim rtn() As String = Nothing
Dim flds() As FieldInfo = Me.GetType.GetFields(BindingFlags.Instance Or BindingFlags.Public)
If Not flds Is Nothing Then
ReDim rtn(flds.Length - 1)
Dim idx As Integer = -1
For Each fld As FieldInfo In flds
idx += 1
rtn(idx) = fld.Name
Next
End If
Return rtn
End Function
Public Function ToStringArray() As String()
Dim rtn() As String = Nothing
Dim flds() As FieldInfo = Me.GetType.GetFields(BindingFlags.Instance Or BindingFlags.Public)
If Not flds Is Nothing Then
ReDim rtn(flds.Length - 1)
Dim idx As Integer = -1
For Each fld As FieldInfo In flds
idx += 1
rtn(idx) = fld.GetValue(Me)
Next
End If
Return rtn
End Function
Public Shadows Function ToString(ByVal Delimiter As String) As String
Dim rtn As String = ""
Dim flds() As FieldInfo = Me.GetType.GetFields(BindingFlags.Instance Or BindingFlags.Public)
If Not flds Is Nothing Then
For Each fld As FieldInfo In flds
rtn &= fld.GetValue(Me) & Delimiter
Next
rtn = rtn.Substring(0, rtn.Length - 1)
End If
Return rtn
End Function
End Structure
#End Region
End Module
Next we will make our own collection out of the structure we just made. This will make it easy to use .Add() .Remove() etc for our structure. We can also remove individual items with .RemoveAt(Index). File: CSVFileItemCollection.vb
#Region " CSVFileItem Collection "
Public Class CSVFileItemCollection
Inherits System.Collections.CollectionBase
Public Sub Add(ByVal NewCSVFileItem As CSVFileItem)
Me.List.Add(NewCSVFileItem)
End Sub
Public Sub Remove(ByVal RemoveCSVFileItem As CSVFileItem)
Me.List.Remove(RemoveCSVFileItem)
End Sub
Default Public Property Item(ByVal index As Integer) As CSVFileItem
Get
Return Me.List.Item(index)
End Get
Set(ByVal value As CSVFileItem)
Me.List.Item(index) = value
End Set
End Property
Public Shadows Sub Clear()
MyBase.Clear()
End Sub
Public Shadows Sub RemoveAt(ByVal index As Integer)
Remove(Item(index))
End Sub
End Class
#End Region
Next you need your class to handle the reflection import: CSVFile.vb
Imports System.Reflection
Imports System.IO
Imports Microsoft.VisualBasic.PowerPacks
Public Class CSVFile
#Region " Private Variables "
Private _CSVFile As CSVFileItem, _Delimiter As String, _Items As New CSVFileItemCollection
#End Region
#Region " Private Methods "
Private Sub FromString(ByVal Line As String, ByVal Delimiter As String)
Dim CSVFileElements() As String = Line.Split(Delimiter)
If Not CSVFileElements Is Nothing Then
Dim fldInfo() As FieldInfo = _CSVFile.GetType.GetFields(BindingFlags.Instance Or BindingFlags.Public)
If Not fldInfo Is Nothing Then
Dim itm As System.ValueType = CType(_CSVFile, System.ValueType)
For fldIdx As Integer = 0 To CSVFileElements.Length - 1
fldInfo(fldIdx).SetValue(itm, CSVFileElements(fldIdx).Replace(Chr(34), ""))
Next
_CSVFile = itm
Else
Dim itms As Integer = 0
If Not fldInfo Is Nothing Then
itms = fldInfo.Length
End If
Throw New Exception("Invalid line definition.")
End If
Else
Dim itms As Integer = 0
If Not CSVFileElements Is Nothing Then
itms = CSVFileElements.Length
End If
Throw New Exception("Invalid line definition.")
End If
End Sub
#End Region
#Region " Public Methods "
Public Sub New()
_CSVFile = New CSVFileItem
End Sub
Public Sub New(ByVal Line As String, ByVal Delimiter As String)
_CSVFile = New CSVFileItem
_Delimiter = Delimiter
FromString(Line, Delimiter)
End Sub
Public Sub New(ByVal Filename As String)
LoadFile(Filename)
End Sub
Public Sub LoadFile(ByVal Filename As String)
Dim inFile As StreamReader = File.OpenText(Filename)
Do While inFile.Peek > 0
FromString(inFile.ReadLine, ",")
_Items.Add(_CSVFile)
_CSVFile = Nothing
Loop
inFile.Close()
End Sub
#End Region
#Region " Public Functions "
Public Function ToDataSet(ByVal TableName As String) As DataSet
Dim dsCSV As DataSet = Nothing
If Not _Items Is Nothing AndAlso _Items.Count > 0 Then
Dim flds() As FieldInfo = _Items.Item(0).GetType.GetFields(BindingFlags.Instance Or BindingFlags.Public)
If Not flds Is Nothing Then
dsCSV = New DataSet
dsCSV.Tables.Add(TableName)
For Each fld As FieldInfo In flds
'Add Column Names
With dsCSV.Tables.Item(TableName)
.Columns.Add(fld.Name, fld.FieldType)
End With
Next
'Populate Table with Data
For Each itm As CSVFileItem In _Items
dsCSV.Tables.Item(TableName).Rows.Add(itm.ToStringArray)
Next
End If
End If
Return dsCSV
End Function
#End Region
#Region " Public Properties "
Public ReadOnly Property Item() As CSVFileItem
Get
Return _CSVFile
End Get
End Property
Public ReadOnly Property Items() As CSVFileItemCollection
Get
Return _Items
End Get
End Property
#End Region
End Class
Okay a little explanation. What this class is doing is first getting the line of delimited (",") text and splitting it into a string array. Then it iterates through every field you have in your structure CSVFileItem and based on the index populates that structure variable. It doesn't matter how many items you have. You could have 1 or 1,000 so long as the order in which your structure is declared is the same as the contents you are loading. For example, your input CSV should match CSVFileItem as "Name,Address1,Address2,City,State,Zip,Phone". That is done with this loop here from the above code:
Dim fldInfo() As FieldInfo = _CSVFile.GetType.GetFields(BindingFlags.Instance Or BindingFlags.Public)
If Not fldInfo Is Nothing Then
Dim itm As System.ValueType = CType(_CSVFile, System.ValueType)
For fldIdx As Integer = 0 To CSVFileElements.Length - 1
fldInfo(fldIdx).SetValue(itm, CSVFileElements(fldIdx).Replace(Chr(34), ""))
Next
_CSVFile = itm
Else
Dim itms As Integer = 0
If Not fldInfo Is Nothing Then
itms = fldInfo.Length
End If
Throw New Exception("Invalid line definition.")
End If
To make things easy, instead of having to load the file from our main class, we can simply pass it the file path and this class will do all of the work and return a collection of our structure. I know this seems like a lot of setup, but it's worth it and you can come back and change your original structure to anything and the rest of the code will still work flawlessly!
Now to get everything going. Now you get to see how easy this is to implement with only a few lines of code. File: frmMain.vb
Public Class Form1
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Try
Dim csv As New CSVFile("C:\myfile.csv")
Dim ds As DataSet = csv.ToDataSet("MyTable")
If Not ds Is Nothing Then
'Add Labels
Dim lblSize As New Size(60, 22), lblY As Integer = 10, lblX As Integer = 10, lblSpacing As Integer = 10
For Each fldName As String In csv.Items.Item(0).FieldNames
Dim lbl As New Label
lbl.AutoSize = True
lbl.Size = lblSize
lbl.Location = New Point(lblX, lblY)
lbl.Name = "lbl" & fldName
lblX += lbl.Width + lblSpacing
lbl.DataBindings.Add(New Binding("Text", ds.Tables.Item(0), fldName, True))
drMain.ItemTemplate.Controls.Add(lbl)
Next
drMain.DataSource = ds
drMain.DataMember = ds.Tables.Item(0).TableName
End If
ds = Nothing
csv = Nothing
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
End Class
This really makes for some dynamic programming. You can wrap these in generic classes and call the functions for any structure. You then have some reusable code that will make your programs efficient and cut down on programming time!
Edit:
Added the ability to dump structure collection to a dataset and then dynamically fill a datarepeater.
Hope this helps. (I know this was a lot of information and seems like a lot of work, but I guarantee you that once you get this in place, it will really cut down on future projects coding time!)