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

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

Related

If statement not moving to the next item

I am working on a side project in VB, it is a network monitoring tool to pings a number of devices which should come back as successful or failed. I have extreme limits in programming so forgive me.
I am using buttons, a total of 34 for each device that I want to ping that returns a success or fail which will color code green(success) and red(failed) but I am sure there is a better way? Right now, my code is stuck on one button, I cant figure out how to step to the next one on the list. In my code, I have it commented out of the results I want produced which is where I am stuck on.
The text file contains all my IP addresses I want to ping separated by a comma.
Basically, when the form is running, it will display each button as green or red, depending on if the device is online or not. I want the code to loop every 2 minutes as well to keep the devices up to date. Literally a device monitoring tool. I was able to get it to work using 34 different End If statements but that is messy and a lot of work to maintain. Any assistance would be helpful.
Using MyReader As New Microsoft.VisualBasic.FileIO.TextFieldParser("\\txt file location\device.txt")
MyReader.TextFieldType = FileIO.FieldType.Delimited
MyReader.SetDelimiters(",")
Dim currentRow As String()
Dim MyLen() As String = {"Button1", "Button2", "Button3", "Button4", "Button5", "Button6", "Button7", "Button8", "Button9", "Button10", "Button11", "Button12", "Button13", "Button14", "Button15", "Button16", "Button17", "Button18", "Button19", "Button20", "Button21", "Button22", "Button23", "Button24", "Button25", "Button26", "Button27", "Button28", "Button29", "Button30", "Button31", "Button32", "Button33", "Button34"}
While Not MyReader.EndOfData
Try
currentRow = MyReader.ReadFields()
Dim currentField As String
For Each currentField In currentRow
If My.Computer.Network.Ping(currentField) Then
MsgBox(MyLen)
'MyLen = Color.LimeGreen
Else
MsgBox(MyLen)
'MyLen.Text = "Failed"
'MyLen.BackColor = Color.Red
End If
Next
Catch ex As Microsoft.VisualBasic.FileIO.MalformedLineException
MsgBox("Line " & ex.Message & "is not valid and will be skipped.")
End Try
End While
End Using
enter image description here
Here is some code that takes a different approach. To try it create a new Form app with only a FlowLayoutPanel and Timer on it. Use the default names. It might be above your skill level but using the debugger you might learn something. Or not.
Public Class Form1
Private MyButtons As New List(Of Button)
Private Sub Form1_Shown(sender As Object, e As EventArgs) Handles Me.Shown
Timer1.Enabled = False 'started later
Timer1.Interval = CInt(TimeSpan.FromMinutes(2).TotalMilliseconds) '<<<< Change >>>>
Dim path As String = "\\txt file location\device.txt"
Dim text As String = IO.File.ReadAllText(path) 'use this
''for testing >>>>>
'Dim text As String = "10.88.0.70, 10.88.0.122,192.168.0.15, 10.88.0.254, 1.2.3.4" ''for testing
''for testing <<<<<
Dim spltCHs() As Char = {","c, " "c, ControlChars.Tab, ControlChars.Cr, ControlChars.Lf}
Dim IPs() As String = text.Split(spltCHs, StringSplitOptions.RemoveEmptyEntries)
For Each addr As String In IPs
Dim b As New Button
Dim p As New MyPinger(addr)
p.MyButton = b
b.Tag = p 'set tag to the MyPinger for this address
b.AutoSize = True
b.Font = New Font("Lucida Console", 10, FontStyle.Bold)
b.BackColor = Drawing.Color.LightSkyBlue
'center text in button
Dim lAddr As String = p.Address
Dim t As String = New String(" "c, (16 - lAddr.Length) \ 2)
Dim txt As String = t & lAddr & t
b.Text = txt.PadRight(16, " "c)
b.Name = "btn" & lAddr.Replace("."c, "_"c)
AddHandler b.Click, AddressOf SomeButton_Click 'handler for button
MyButtons.Add(b) 'add button to list
Next
'sort by IP
MyButtons = (From b In MyButtons
Select b Order By DirectCast(b.Tag, MyPinger).Address(True)).ToList
For Each b As Button In MyButtons
FlowLayoutPanel1.Controls.Add(b) 'add button to panel
Next
FlowLayoutPanel1.Anchor = AnchorStyles.Bottom Or AnchorStyles.Left Or AnchorStyles.Right Or AnchorStyles.Top
Timer1.Enabled = True 'start the timer
End Sub
Private Sub SomeButton_Click(sender As Object, e As EventArgs)
'if button clicked ping it
Dim b As Button = DirectCast(sender, Button) 'which button
b.BackColor = MyPinger.UnknownColor
Dim myP As MyPinger = DirectCast(b.Tag, MyPinger) ''get the MyPinger for this
myP.DoPing() 'do the ping
End Sub
Private Async Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Timer1.Enabled = False
Dim myPs As New List(Of MyPinger)
For Each b As Button In MyButtons
b.BackColor = MyPinger.UnknownColor
Dim myP As MyPinger = DirectCast(b.Tag, MyPinger)
myPs.Add(myP)
Next
Dim t As Task
t = Task.Run(Sub()
Threading.Thread.Sleep(25)
For Each myP As MyPinger In myPs
myP.DoPing()
Next
End Sub)
Await t
Timer1.Enabled = True
End Sub
End Class
Public Class MyPinger
Public Shared ReadOnly UpColor As Drawing.Color = Drawing.Color.LightGreen
Public Shared ReadOnly DownColor As Drawing.Color = Drawing.Color.Red
Public Shared ReadOnly UnknownColor As Drawing.Color = Drawing.Color.Yellow
Private _ip As Net.IPAddress
Private _ping As Net.NetworkInformation.Ping
Public LastReply As Net.NetworkInformation.PingReply
Private Shared ReadOnly PingTMO As Integer = 2500
Private _waiter As New Threading.AutoResetEvent(True)
Public MyButton As Button
Public Sub New(IPAddr As String)
Me._ip = Net.IPAddress.Parse(IPAddr) 'will throw exception if IP invalid <<<<<
Me._ping = New Net.NetworkInformation.Ping 'create the ping
'do initial ping
Dim t As Task = Task.Run(Sub()
Threading.Thread.Sleep(25) 'so init has time
Me.DoPingAsync()
End Sub)
End Sub
Private Async Sub DoPingAsync()
If Me._waiter.WaitOne(0) Then 'only one at a time for this IP
Me.LastReply = Await Me._ping.SendPingAsync(Me._ip, PingTMO)
Dim c As Drawing.Color
Select Case Me.LastReply.Status
Case Net.NetworkInformation.IPStatus.Success
c = UpColor
Case Else
c = DownColor
End Select
Me.SetButColor(c)
Me._waiter.Set()
End If
End Sub
Public Sub DoPing()
Me.DoPingAsync()
End Sub
Private Sub SetButColor(c As Drawing.Color)
If Me.MyButton IsNot Nothing Then
If Me.MyButton.InvokeRequired Then
Me.MyButton.BeginInvoke(Sub()
Me.SetButColor(c)
End Sub)
Else
Me.MyButton.BackColor = c
End If
End If
End Sub
Public Function TheIP() As Net.IPAddress
Return Me._ip
End Function
Public Function Address(Optional LeadingZeros As Boolean = False) As String
Dim rv As String = ""
If LeadingZeros Then
Dim byts() As Byte = Me._ip.GetAddressBytes
For Each b As Byte In byts
rv &= b.ToString.PadLeft(3, "0"c)
rv &= "."
Next
Else
rv = Me._ip.ToString
End If
Return rv.Trim("."c)
End Function
End Class

Binding a Long/Int64 field to NumericUpdown leads to OleDbException "Too few parameters" on update

I am stuck with this problem the whole day, so maybe someone has a tip for me.
The environment: MS Access DB, VB.NET, OleDb-Driver, MS Access Database Engine 2016.
I am trying to bind a Long/Int64 field to a NumericUpDown control, but on update I get always the OleDbException "Too few parameters". I am pretty sure that the long field is the problem, because when I delete it from the table (and comment out the code for it) everything works fine. I am not sure that a NumericUpDown is suitable for this task, but it's underlying datatype is decimal and decimal has way more space as a long needs. So here is some code:
In the DataLayer:
Private Sub InitializeDataSet()
Dim LocFields = String.Join("], [", Fields)
Dim SQL As String = "SELECT [" & LocFields & "] FROM [" & Table & "]"
DAMain = New OleDbDataAdapter(SQL, Connection)
Using Builder As New OleDbCommandBuilder(DAMain) With {
.ConflictOption = ConflictOption.OverwriteChanges
}
Builder.GetInsertCommand()
Builder.GetUpdateCommand()
Builder.GetDeleteCommand()
End Using
DS = New DataSet
DAMain.Fill(DS, Table)
End Sub
Public Sub Update()
DAMain.Update(DS, Table) ' <-- Here the exception happens
End Sub
Public ReadOnly Property DataSource As Object
Get
Return DS
End Get
End Property
Public ReadOnly Property DataMember As String
Get
Return Table
End Get
End Property
We are here in a class, so the variables are:
Table = the name of the table
Fields = the list of the fields in the table
Connection = the OleDbConnection
DAMain = the OleDbDataAdapter
DS = the DataSet
In the Form:
Private DL As OleDbDataLayer
Private WithEvents BSource As New BindingSource
Public Sub New(DataLayer As OleDbDataLayer)
InitializeComponent()
DL = DataLayer
BSource.DataSource = DL.DataSource
BSource.DataMember = DL.DataMember
BSource.AllowNew = True
BSource.Sort = DL.OrderBy
BSource.Position = 0
InitializeFields()
End Sub
Private Sub DataUpdate()
BSource.EndEdit()
DL.Update()
End Sub
Private Sub InitializeFields()
NUD.Minimum = Long.MinValue
NUD.Maximum = Long.MaxValue
Dim Binding As New Binding("Value", BSource, "F_Long")
AddHandler Binding.Format, AddressOf FormatDBNull
AddHandler Binding.Parse, AddressOf ParseNumericUpDown
NUD.DataBindings.Add(Binding)
End Sub
Private Sub FormatDBNull(sender As Object, e As ConvertEventArgs)
If Convert.IsDBNull(e.Value) Then
Select Case e.DesiredType
Case = GetType(Decimal) : e.Value = 0
Case = GetType(Date) : e.Value = Today
Case = GetType(Boolean) : e.Value = False
Case Else
End Select
End If
End Sub
Private Sub ParseNumericUpDown(sender As Object, e As ConvertEventArgs)
Select Case e.DesiredType
Case = GetType(Byte)
e.Value = Convert.ToByte(e.Value)
Case = GetType(Short)
e.Value = Convert.ToInt16(e.Value)
Case = GetType(Integer)
e.Value = Convert.ToInt32(e.Value)
Case = GetType(Long)
e.Value = Convert.ToInt64(e.Value)
Case Else
' Do Nothing
End Select
End Sub
Here NUD is the NumericUpDown control which should be obvious.
Maybe I should use another control type? TextBox? MaskedTextBox?

Search dgv column by Column("TagIndex = 5")

I'm trying to get data from a DGV grid onto specific tags, and so far it has been working great. But an update moved the tags positions in the DGV so Rows(x) does not equal the tags I'm moving data into anymore.
Is it possible to do a search like the one I'm doing in Cells("Val") but in the Rows("") instead?
Actually I want it to be something like this Rows("TagIndex = 5") etc.
A full line of code would then be:
HopperStatus = dgvDataFlt.Rows("TagIndex = 5").Cells("Val").Value
but is this possible.
Row 12 & 13 are switched when logging
dgvDataFLT = dgvDataFloating
If dgvDataFlt.Rows(0).Cells("TagIndex").Value = 12 Then
'DGVDataFlt.AutoResizeColumns()
'--------------------------------------Floating TAGS fra database------------------------------------------
ProdRecCnt = dgvDataFlt.Rows(10).Cells("Val").Value
ProdTotCnt = dgvDataFlt.Rows(9).Cells("Val").Value
FrontFree = dgvDataFlt.Rows(8).Cells("Val").Value
CurrAutoMode = dgvDataFlt.Rows(7).Cells("Val").Value
PalletStatus = dgvDataFlt.Rows(6).Cells("Val").Value
HopperStatus = dgvDataFlt.Rows(5).Cells("Val").Value
PowerStatus = dgvDataFlt.Rows(4).Cells("Val").Value
CurrRecNo = dgvDataFlt.Rows(3).Cells("Val").Value
NomCycTime = dgvDataFlt.Rows(2).Cells("Val").Value
AutoStart = dgvDataFlt.Rows(1).Cells("Val").Value
MachineNo = dgvDataFlt.Rows(0).Cells("Val").Value
LOGTimeStamp = dgvDataFlt.Rows(0).Cells("DateAndTime").Value 'for aktuelle lognings tidstempel
LOGDateStamp = Microsoft.VisualBasic.Left(LOGTimeStamp, 10)
LOGClockStamp = Microsoft.VisualBasic.Mid(LOGTimeStamp, 12, 5)
End If
I want the code to look/work something like this:
If dgvDataFlt.Rows(0).Cells("TagIndex").Value = 12 Then
'DGVDataFlt.AutoResizeColumns()
'--------------------------------------Floating TAGS fra database------------------------------------------
ProdRecCnt = dgvDataFlt.Rows("TagIndex = 10").Cells("Val").Value
ProdTotCnt = dgvDataFlt.Rows("TagIndex = 9").Cells("Val").Value
FrontFree = dgvDataFlt.Rows("TagIndex = 8").Cells("Val").Value
CurrAutoMode = dgvDataFlt.Rows("TagIndex = 7").Cells("Val").Value
PalletStatus = dgvDataFlt.Rows("TagIndex = 6").Cells("Val").Value
HopperStatus = dgvDataFlt.Rows("TagIndex = 5").Cells("Val").Value
PowerStatus = dgvDataFlt.Rows("TagIndex = 4").Cells("Val").Value
CurrRecNo = dgvDataFlt.Rows("TagIndex = 3").Cells("Val").Value
NomCycTime = dgvDataFlt.Rows("TagIndex = 2").Cells("Val").Value
AutoStart = dgvDataFlt.Rows("TagIndex = 1").Cells("Val").Value
MachineNo = dgvDataFlt.Rows("TagIndex = 0").Cells("Val").Value
LOGTimeStamp = dgvDataFlt.Rows(0).Cells("DateAndTime").Value 'for aktuelle lognings tidstempel
LOGDateStamp = Microsoft.VisualBasic.Left(LOGTimeStamp, 10)
LOGClockStamp = Microsoft.VisualBasic.Mid(LOGTimeStamp, 12, 5)
End If
I would suggest adding a class and then inheriting the DataGridView control into that class. I have made a quick little example of this and the code works, but to get it to work you will have to perform a few steps:
(1) If you don't already have a windows forms application to test this then,
make a new one.
(2) Create class named KeyedDataGridView
(3) Copy and Paste the following Code into KeyedDataGridView class
(4) Rebuild your Project
(5) Drag and Drop new component onto your windows Form.
NOTE: This class is limited, but should still be able to do what you require of it.
Finally, if you need any help then, please leave a comment and will try to get to it when I can.
Option Explicit On
Public Class KeyedDataGridView
Inherits Windows.Forms.DataGridView
Dim _Rows As KeyedDataRows
Public Shadows Property Rows As KeyedDataRows
Get
Return _Rows
End Get
Set(value As KeyedDataRows)
_Rows = value
End Set
End Property
Public Sub New()
Dim strName As String
strName = Me.Name
strName = MyBase.Name
_Rows = New KeyedDataRows(Me)
_Rows.Rows = MyBase.Rows
End Sub
Protected Overrides Sub Finalize()
_Rows = Nothing
MyBase.Finalize()
End Sub
End Class
Public Class KeyedDataRows
Inherits Windows.Forms.DataGridViewRowCollection
Dim _TagNames As Dictionary(Of String, Integer)
Dim _Rows As DataGridViewRowCollection
Dim _Cells As Dictionary(Of String, DataGridViewCellCollection)
Dim dgv As DataGridView
Default Public Overloads ReadOnly Property Item(strTagName As String) As DataGridViewRow
Get
Return _Rows.Item(Me.IndexFromName(strTagName))
End Get
End Property
Protected Friend Property Rows As DataGridViewRowCollection
Get
Return _Rows
End Get
Set(value As DataGridViewRowCollection)
_Rows = value
End Set
End Property
Public Property TagName(index As Integer) As String
Get
Return CStr(_TagNames.Item(index))
End Get
Set(value As String)
_TagNames.Item(index) = value
End Set
End Property
Public Sub New(tmp As DataGridView)
MyBase.New(tmp)
dgv = tmp
_TagNames = New Dictionary(Of String, Integer)
_Cells = New Dictionary(Of String, DataGridViewCellCollection)
End Sub
Public Shadows Sub Add(strTagName As String)
Dim intCurRow As Integer
If dgv.AllowUserToAddRows Then
intCurRow = _Rows.Count - 1
Else
intCurRow = _Rows.Count
End If
_TagNames.Add(strTagName, intCurRow)
_Rows.Add()
End Sub
Public Shadows Sub Add(strTagName As String, dataGridViewRow As DataGridViewRow)
Dim intCurRow As Integer
If dgv.AllowUserToAddRows Then
intCurRow = _Rows.Count - 1
Else
intCurRow = _Rows.Count
End If
_TagNames.Add(strTagName, intCurRow)
_Rows.Add(dataGridViewRow)
End Sub
Public Shadows Sub Add(count As Integer, strTagNames() As String)
Dim intI As Integer
Dim intCurRow As Integer
If dgv.AllowUserToAddRows Then
intCurRow = _Rows.Count - 1
Else
intCurRow = _Rows.Count
End If
For intI = 0 To (count - 1)
_TagNames.Add(strTagNames(intI), intCurRow)
_Rows.Add()
intCurRow = _Rows.Count - 1
Next intI
End Sub
Public Property IndexFromName(strTagName As String) As Integer
Get
If _TagNames.Count > 0 Then
If _TagNames.ContainsKey(strTagName) Then
Return _TagNames.Item(strTagName)
Else
Return -1
End If
Else
Return -1
End If
End Get
Set(value As Integer)
_TagNames.Add(strTagName, value)
End Set
End Property
Public Overloads Sub RemoveAt(strTagName As String)
_Cells.Remove(strTagName)
_Rows.RemoveAt(IndexFromName(strTagName))
_TagNames.Remove(strTagName)
End Sub
Protected Overrides Sub Finalize()
_TagNames.Clear()
_TagNames = Nothing
_Cells.Clear()
_Rows.Clear()
_Cells = Nothing
_Rows = Nothing
MyBase.Finalize()
End Sub
End Class
I also, added the following buttons to a windows form to test the code:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
With KeyedDataGridView1
.Rows.Add("Tag Test 1")
.Rows.Add("Tag Test 2")
.Rows.Add("Tag Test 3")
.Rows.Add("Tag Test 4")
End With
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
MsgBox(KeyedDataGridView1.Rows("Tag Test 3").Cells(0).Value & vbCrLf &
KeyedDataGridView1.Rows("Tag Test 3").Cells(1).Value & vbCrLf &
KeyedDataGridView1.Rows("Tag Test 3").Cells(2).Value)
MsgBox(KeyedDataGridView1.Rows("Tag Test 2").Cells(0).Value & vbCrLf &
KeyedDataGridView1.Rows("Tag Test 2").Cells(1).Value & vbCrLf &
KeyedDataGridView1.Rows("Tag Test 2").Cells(2).Value)
MsgBox(KeyedDataGridView1.Rows("Tag Test 1").Cells(0).Value & vbCrLf &
KeyedDataGridView1.Rows("Tag Test 1").Cells(1).Value & vbCrLf &
KeyedDataGridView1.Rows("Tag Test 1").Cells(2).Value)
End Sub

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!)