Background Worker Not Clearing Resources - vb.net

I'm currently working on an application that fetches some information from a database using a BW. It uses a stores number, referred to as IDP and searches the correct database. It works perfectly for my needs. However, each time it runs it's adding anywhere between 10-300 KBs to RAM, it is not releasing this memory once it completes. Since this code can be ran hundreds of times a day by numerous different people on a virtual machine with limited resources I really need it to release any memory it uses. Can anyone see where I'm going wrong?
Note: I'm self-taught and I'm doing this as more of a hobby that helps me out at work and not actually employed to do this, as I'm sure some of you will be happy to know once seeing my newbie code.
Public Sub KickoffStoreBrief() 'Called when txtIDP (text box) text changes
Dim args As BW_GetStoreBriefVariables = New BW_GetStoreBriefVariables()
args.Current_IDP = txtIDP.Text.Trim
If BW_GetStoreBrief.IsBusy Then
MsgBox("Worker busy!")
Else
BW_GetStoreBrief.RunWorkerAsync(args)
End If
End Sub
Private Sub BW_GetStoreBrief_DoWork(sender As Object, e As DoWorkEventArgs) Handles BW_GetStoreBrief.DoWork
Dim args As BW_GetStoreBriefVariables = DirectCast(e.Argument, BW_GetStoreBriefVariables) 'Convert the generic Object back into a MyParameters object
Using DatabaseConnection As New SqlConnection(args.ConnectionString)
Dim command As New SqlCommand(SQL CODE IS HERE, DatabaseConnection)
command.CommandTimeout = 20
'Attempt to open the connection
command.Connection.Open()
Dim reader As SqlDataReader = command.ExecuteReader()
Dim dt As New DataTable()
dt.Load(reader)
reader = Nothing
'Check if returned anything
If dt.Rows.Item(0).Item(0) = Nothing Or dt.Rows.Item(0).Item(0).ToString = "False" Or dt.Rows.Item(0).Item(0).ToString = "" Then
'Branch not found.
GoTo Ender
End If
'Prefix 0's infront of the IDP as required
Dim CompleteIDPNumber As String = ""
If dt.Rows.Item(0).Item(0).ToString.Length < 4 Then
If dt.Rows.Item(0).Item(0).ToString.Length = 2 Then
CompleteIDPNumber = "00" & dt.Rows.Item(0).Item(0).ToString
ElseIf dt.Rows.Item(0).Item(0).ToString.Length = 3 Then
CompleteIDPNumber = "0" & dt.Rows.Item(0).Item(0).ToString
Else
CompleteIDPNumber = dt.Rows.Item(0).Item(0).ToString
End If
Else
CompleteIDPNumber = dt.Rows.Item(0).Item(0).ToString
End If
'Populate strings
Dim StoreName As String = CompleteIDPNumber & " - " & dt.Rows.Item(0).Item(1).ToString.Trim
Dim UISupports As Integer = 20 'This is the amount of characters that will fit in label space
If StoreName.Length > UISupports Then
StoreName = StoreName.Substring(0, UISupports).ToString.Trim & "..." & " (" & dt.Rows.Item(0).Item(3).ToString.Trim & ")"
Else
StoreName = StoreName & " (" & dt.Rows.Item(0).Item(3).ToString.Trim & ")"
End If
args.Brief_StoreName = StoreName
StoreName = Nothing 'We no longer need this, release it from memory
UISupports = Nothing 'We no longer need this, release it from memory
CompleteIDPNumber = Nothing 'We no longer need this, release it from memory
If dt.Rows.Item(0).Item(2) = 0 Or dt.Rows.Item(0).Item(2).ToString.Trim = "0" Then
args.Brief_POSNumber = "IS"
Else
args.Brief_POSNumber = dt.Rows.Item(0).Item(2).ToString.Trim
End If
args.Brief_Category = dt.Rows.Item(0).Item(3).ToString 'CAT
args.Brief_STCamera = dt.Rows.Item(0).Item(4).ToString 'Counter
args.Brief_Franch = dt.Rows.Item(0).Item(5).ToString
Ender:
e.Result = args
'Close connection
dt.Dispose()
command.Connection.Close()
command.Dispose()
End Using
End Sub
Private Sub BW_GetStoreBrief_RunWorkerCompleted(sender As Object, e As RunWorkerCompletedEventArgs) Handles BW_GetStoreBrief.RunWorkerCompleted
If e.Error IsNot Nothing Then
ListBox1.Items.Insert(0, Now.ToString("HH:mm:ss") & " | Error | Unable to connect to store DB.")
lblNotFound.Text = "Unable to connect to database."
Panel_NotFound.Visible = True
Panel_NotFound.BringToFront()
ErrorLogger.LogError(System.Reflection.MethodBase.GetCurrentMethod().Name, e.Error.Message, 0)
ElseIf e.Cancelled Then
Else
' Access variables through args
Dim args As BW_GetStoreBriefVariables = DirectCast(e.Result, BW_GetStoreBriefVariables) 'Convert the generic Object back into a MyParameters object
If args.Brief_StoreName = "" Then
ListBox1.Items.Insert(0, Now.ToString("hh:mm:ss") & " | Notice | IDP " & args.Current_IDP & " not found in database.")
'show warning panel
lblNotFound.Text = "Store not found in database."
Panel_NotFound.Visible = True
Panel_NotFound.BringToFront()
GoTo Ender
Else
'Store found update UI
lblBranchInfo_StoreName.Text = args.Brief_StoreName
lblBranchInfo_POSNumber.Text = args.Brief_POSNumber
lblBranchInfo_CameraType.Text = args.Brief_STCamera
Panel_NotFound.Visible = False
Panel_NotFound.SendToBack()
End If
args = Nothing
End If
Ender:
btnStoreDetails.Enabled = True
End Sub
As you can see i've tried to make sure I'm not leaving anything behind, but the memory keeps jumping up and doesn't go down. Overall we're talking about 35MBs being used when this codes been ran only a few times and nothing else is happening with the program/form. Because this is on a remote virtual machine the program can be open for days without being closed, and with the memory usage increasing each time it will become a very big issue. Any help would be appreciated.

Related

Checks The Informations In Text File. VB.NET

I work on a project "SignInLogeIn" using Visual Basic.NET.
I save the user informations in text file.
the name of the file is "data.txt".
to create a new account in my program. you must enter the name,email,password and the program write the informations in textfile.
i use "Streamwritter" to write the informations.
when user create a new account The program checks if the email entered by the user is already in the text file that contains the users' information.
and the program checks from informations by "StreamReader". it reads the information in text file and checks.
I have the problem.
when I CREATE A new account. problem appears.
and the problem is
"
An unhandled exception of type 'System.IO.IOException' occurred in mscorlib.dll
Additional information: The process cannot access the file 'D:\1- Anas Files\Projects\VisualBasic.NET\SignInLogIn\SignInLogIn\SignInLogIn\bin\Debug\Data.txt' because it is being used by another process.
"
I think the problem is that I used the file twice
Once to write and once to read.
The error occurs in this line "Dim sw As New StreamWriter("Data.txt")".
how can i solve this problem ?
this is the code of "SignIn" button
Private Sub btnSignIn_Click(sender As Object, e As EventArgs) Handles btnSignIn.Click
Dim strEmail As String = txtEmail.Text
Dim Reg As New Regex("^\w+([-_.]\w+)*#\w+([-.]\w+)*\.\w+([-.]\w+)*$")
If txtUserName.Text.Trim() = "" Or txtEmail.Text.Trim() = "" Or txtPassword.Text.Trim() = "" Then
MsgBox("Please Enter All Input")
If Not Reg.IsMatch(strEmail) Then
MsgBox("Please Enter Email")
End If
Else
Dim sr As New StreamReader("Data.txt")
Dim sw As New StreamWriter("Data.txt")
Dim strPerson As String = txtUserName.Text & ";" & txtEmail.Text & ";" & txtPassword.Text
Dim line As String = ""
Do
line = sr.ReadLine()
Dim arrData As String() = line.Split(";")
If arrData(1) = strEmail Then
MsgBox("Please Change Email")
Else
sw.WriteLine(strPerson)
sw.Close()
End If
Loop While line <> Nothing
sr.Close()
End If
End Sub
You open twice the same file. First, to read and second to write, this is why you cannot write.
Dim sr As New StreamReader("Data.txt")
Dim lines As String = sr.ReadToEnd().Split(Environment.NewLine)
sr.Close()
Dim strPerson As String = txtUserName.Text & ";" & txtEmail.Text & ";" & txtPassword.Text
Dim sw As New StreamWriter("Data.txt")
For Each line As String In lines
Dim arrData As String() = line.Split(";")
If arrData(1) = strEmail Then
MsgBox("Please Change Email")
Exit For
Else
sw.WriteLine(strPerson)
Exit For
End If
Next
sw.Close()
Streams need to be closed and disposed. They are usually put in Using blocks.
I wasn't quite sure of the program flow you wanted. It seemed, since you created a writer and a reader you intended to add to user to the file if they were not listed.
I broke out some of the code into separate methods. I used System.IO since we have a simple text file.
Private Sub btnSignIn_Click(sender As Object, e As EventArgs) Handles btnSignIn.Click
If ValidInput() Then
Dim strPerson As String = $"{txtUserName.Text};{txtEmail.Text};{txtPassword.Text}"
If Not IsUserInFile(strPerson) Then
File.AppendAllText("Data.txt", strPerson & Environment.NewLine)
End If
End If
End Sub
Private Function ValidInput() As Boolean
Dim strEmail As String = txtEmail.Text
Dim Reg As New Regex("^\w+([-_.]\w+)*#\w+([-.]\w+)*\.\w+([-.]\w+)*$")
If txtUserName.Text.Trim() = "" OrElse txtEmail.Text.Trim() = "" OrElse txtPassword.Text.Trim() = "" Then
MsgBox("Please Enter All Input")
Return False
If Not Reg.IsMatch(strEmail) Then
MsgBox("Please Enter Email")
Return False
End If
End If
Return True
End Function
Private Function IsUserInFile(Person As String) As Boolean
Dim p = Person.Split(";"c)
Dim lines = File.ReadAllLines("Data.txt")
For Each line In lines
If Person = line Then
Return True
End If
Dim fields = line.Split(";"c)
If fields(0) = p(0) AndAlso fields(2) = p(2) AndAlso fields(1) <> p(1) Then
MessageBox.Show("Please Change Email")
Return False
End If
Next
Return False
End Function
This is going to get messy and slow if there are too many users. This info should really be in a database. The worst thing is the passwords should always be salted and hashed; never stored as plain text even is a database.

vb.net DataGridView prevent user clicking on column

I have a DataGridView (DGV) that I am adding items to from a SQLite DB MANUALLY
My setting for the Selection Mode have been CellSelect and FullRowSelect may have tried others
The Errors and Issues are varied depending on where the user clicks on the DGV
The code as it is now the Errors only occur when an empty Column under Header PID is selected
And when the Column Header PID is selected See Posted Image
I have included the ERRORS as comments in the code
One of the issues I would like to FIX is to disable all sorting on all Columns
The Data added to the DGV is a primary key which is a Integer PID
And some text which is a NVARCHAR(2048) this text is from a RichTextBox
The two biggest issue to fix is preventing the ERRORS YES those are the Questions
Private Sub PopulateDGV()
For Each header As DataGridViewHeaderCell In dgvOne.Rows
'header.SortMode = DataGridViewColumnHeaderCell.NotSortable
Next
'The code Above NOT Working
'ERRORS
'System.InvalidOperationException 'Column's SortMode cannot be set to Automatic
'While the DataGridView control's SelectionMode is set to ColumnHeaderSelect.'
'Your app has entered a break state, but there is no code to show because all
'threads were executing external code (typically system Or framework code).
'dgvOne = DataGridViewColumnSortMode.NotSortable
Dim str2 As String
Dim s1 As Integer
Dim dbName As String = "Word.db"
Dim conn As New SQLiteConnection("Data Source =" & dbName & ";Version=3;")
Dim valuesList As ArrayList = New ArrayList()
'Read from the database
Dim cmd As SQLiteCommand = New SQLiteCommand("Select * FROM ParentTable", conn)
conn.Open()
Dim rdr As SQLite.SQLiteDataReader = cmd.ExecuteReader
'Set Design of the DataGridView
dgvOne.DefaultCellStyle.Font = New Font("Tahoma", 10)
dgvOne.ColumnCount = 2
dgvOne.Columns(0).Width = 60
dgvOne.Columns(1).Width = 420
'Set Col Header Size Mode = Enabled
'Set Col Header Default Cell Styles DO in Properties
dgvOne.ColumnHeadersHeight = 34
'DGV Header Names
dgvOne.Columns(0).Name = "PID"
dgvOne.Columns(1).Name = "Entry Data"
'Read from DB Table add to DGV row
While rdr.Read()
valuesList.Add(rdr(1)).ToString()
lbOne.Items.Add(rdr(1)).ToString()
s1 = rdr(0).ToString
str2 = rdr(1)
dgvOne.Rows.Add(s1, str2)
End While
'Add Blank rows to DGV
For iA = 1 To 4
dgvOne.Rows.Add(" ")
Next
rdr.Close()
conn.Close()
End Sub
Private Sub dgvTwo_CellMouseClick(sender As System.Object, e As System.Windows.Forms.DataGridViewCellMouseEventArgs) Handles dgvOne.CellMouseClick
If (e.RowIndex = -1) Then
MessageBox.Show("No Clicking Here")
Return
End If
If dgvOne.CurrentCell.Value Is Nothing Then
tbMessage.Text = "NO Data Here"
Return
ElseIf e.RowIndex >= 0 Then
tbMessage.Text = e.RowIndex
Dim str2 As String
Dim s2 As String
Dim row As DataGridViewRow = dgvOne.Rows(e.RowIndex)
s2 = row.Cells(0).Value.ToString
str2 = row.Cells(1).Value.ToString
strB = str2
rtbEnter.Text = strB
'ERRORS
'System.NullReferenceException
'HResult = 0x80004003
'Message = Object reference Not Set To an instance Of an Object.
'Source = TestSQL
'StackTrace:
'at TestSQL.frmThree.dgvTwo_CellMouseClick(Object sender, DataGridViewCellMouseEventArgs e) in C:\Users\Dwight\source\repos\TestSQL\TestSQL\frmThree.vb:line 117
End If
End Sub
To prevent sorting on columns, which appears to be your main question, do the following:
dgvOne.Columns(0).SortMode = DataGridViewColumnSortMode.NotSortable
dgvOne.Columns(1).SortMode = DataGridViewColumnSortMode.NotSortable
You also need to guard against null values in cells. So in the "CellMouseClick" event, add something like this:
If row.Cells(1).Value IsNot Nothing Then
str2 = row.Cells(1).Value.ToString
End If
#Brian M Stafford
Thanks for getting us headed in the correct direction Vector this is easy to figure out if someone would have shared a little information GREAT Questions's guess your were saving bytes
Because you only have three (3) Columns here are their names and positions in the DGV
Col -1 Col 0 Col 1 and YES they go Left to Right
Just So No One Gets Confused Rows go Top to Bottom
Row 0
Row 1
So all you really needed was one more test that delt with ColumnIndex
This code only permits clicking on Column 1 provided it has text in that CELL
Just manipulate the tests and you can provide the user additional selections
Public Sub dgvTwo_CellMouseClick(sender As System.Object, e As System.Windows.Forms.DataGridViewCellMouseEventArgs) Handles dgvOne.CellMouseClick
If e.RowIndex = -1 Or e.ColumnIndex = -1 Then
'tbMessage.Text = "Col " & e.ColumnIndex & " ROW " & e.RowIndex
tbMessage.Text = "No Clicking Here"
Return
End If
If dgvOne.CurrentCell.Value Is Nothing Then
tbMessage.Text = "NO Data Here"
Return
End If
Dim s3 As Integer
s3 = e.ColumnIndex
If s3 = 0 Then
'tbMessage.Text = "S3 " & e.ColumnIndex
tbMessage.Text = "No Clicking Here"
Return
End If
Dim row As DataGridViewRow = dgvOne.Rows(e.RowIndex)
Dim col As DataGridViewColumn = dgvOne.Columns(e.ColumnIndex)
If e.RowIndex >= 0 And e.ColumnIndex <> -1 Then
tbMessage.Text = "Data Sent to RTB"
Dim str2 As String
str2 = row.Cells(1).Value.ToString
rtbEnter.Text = str2
End If
End Sub
After reading all the nice answers and looking for a way to accomplish my multitude of issues and a lot of trial and error here is one way to deal with preventing the user from clicking on various location on the DataGridView
Public Sub dgvTwo_CellMouseClick(sender As System.Object, e As System.Windows.Forms.DataGridViewCellMouseEventArgs) Handles dgvOne.CellMouseClick
If e.RowIndex = -1 Or e.ColumnIndex = -1 Then
'tbMessage.Text = "Col " & e.ColumnIndex & " ROW " & e.RowIndex
tbMessage.Text = "No Clicking Here"
rtbEnter.Clear()
Return
End If
Dim str1 As String
Dim str2 As String
Dim s1 As Integer
Dim row As DataGridViewRow = dgvOne.Rows(e.RowIndex)
str1 = dgvOne.CurrentRow.Cells(0).Value.ToString
If str1 IsNot " " Then
If str1 Is " " Then
Return
End If
tbMessage.Text = "Text Sent to RTB"
s1 = row.Cells(0).Value
'Dim strInt As String
gv_passInt = s1.ToString
str2 = row.Cells(1).Value.ToString
rtbEnter.Text = str2
gv_passStr = str2
Return
End If
rtbEnter.Clear()
tbMessage.Text = "No Data Here"
End Sub

Process.Start() with "manage-bde.exe" crashing in VB.NET

I'm trying to start manage-bde.exe as a new process in VB.net but when it tries to start the proc, Bitlocker crashes. Could anyone please tell me what I'm doing wrong here? This code was converted from C# where it works all day long....
Code:
Private Sub btnLock_Click(sender As Object, e As EventArgs) Handles btnLock.Click
Dim drvSelected As String = cmbDriveSelect.SelectedValue.ToString()
Dim sysDirWithBDE As String = Environment.SystemDirectory + "\manage-bde.exe"
Dim lockStatus As String = String.Empty
' This is the code for the base process
Dim myProcess As New Process()
' Start a new instance of this program
Dim myProcessStartInfo As New ProcessStartInfo(sysDirWithBDE, " -lock " + drvSelected.Remove(2))
'Set Use Shell to false so as to redirect process run info to application
myProcessStartInfo.UseShellExecute = False
myProcessStartInfo.RedirectStandardOutput = True
myProcess.StartInfo = myProcessStartInfo
Try
myProcess.Start()
lblDriveLockMsg.Show()
Catch err As Exception
lblDriveLockMsg.Text = err.Message
End Try
'Read the standard output of the process.
lockStatus = myProcess.StandardOutput.ReadToEnd()
If lockStatus.Contains("code 0x80070057") Then
lblDriveLockMsg.Text = "Drive selected is not Bit Locker encrypted"
ElseIf lockStatus.Contains("code 0x80070005") Then
lblDriveLockMsg.Text = "Drive selected is in use by an application on your machine, force dismounting might result in data loss, please check and close any applications using the drive"
Else
lblDriveLockMsg.Text = lockStatus
End If
myProcess.WaitForExit()
myProcess.Close()
End Sub

Wait until media element has naturalDuration information

I need to make a loop to look at a lot of mp3 files and getting their naturalDuration property using a mediaElement. The problem is that mediaElement need some time to load every single file and .source property works like async process (I think) because I have to click two times on below code if I want to obtain naturalDuration property. First click I have just 00:00:00 value, second clik give me real value.
Private Sub button_Click(sender As Object, e As RoutedEventArgs) Handles button.Click
mediaElement.Source = New Uri("\\Mac\Home\Desktop\NOVEDADES01\AbrahamMateo-OldSchool.mp3")
textBlock.Text = mediaElement.NaturalDuration.ToString
End Sub
If I try to wait after .Source instruction, the application keeps on loop.
Private Sub button_Click(sender As Object, e As RoutedEventArgs) Handles button.Click
mediaElement.Source = New Uri("\\Mac\Home\Desktop\NOVEDADES01\AbrahamMateo-OldSchool.mp3")
Do
Loop Until mediaElement.NaturalDuration.TimeSpan.TotalSeconds > 0
textBlock.Text = mediaElement.NaturalDuration.ToString
End Sub
I also have try set .source through an async process and wait for mediaOpenend event, but it look like mediaElemento can not end until the first click was ending
How could I get real value of naturalDuration inside one single process or function just after set .source property and without playing the file?
Thanks a lot!!
Ok, late and may be not so elegant but this was my solution for getting duration of a mp3 file. I used MusicProperties Class.
Public Function infoMP3(elfichero As String) As String
Dim salida As String = ""
Dim miTask = Task.Run(Async Function() As Task(Of String)
Dim musicFile As StorageFile = Await StorageFile.GetFileFromPathAsync(elfichero)
Dim FileProperties As StorageItemContentProperties = musicFile.Properties
Dim musicFileProperties As MusicProperties = Await FileProperties.GetMusicPropertiesAsync()
Dim tiempo = musicFileProperties.Duration
Dim horas As String
If tiempo.Hours < 10 Then
horas = "0" & tiempo.Hours.ToString
Else
horas = tiempo.Hours.ToString
End If
Dim minutos As String
If tiempo.Minutes < 10 Then
minutos = "0" & tiempo.Minutes.ToString
Else
minutos = tiempo.Minutes.ToString
End If
Dim segundos As String
If tiempo.Seconds < 10 Then
segundos = "0" & tiempo.Seconds.ToString
Else
segundos = tiempo.Seconds.ToString
End If
Dim autor = musicFileProperties.Artist
Dim titulo = musicFileProperties.Title
Dim presalida As String = "[" & horas & ":" & minutos & ":" & segundos & "];[" & titulo & "];[" & autor & "] " & elfichero
Return presalida
End Function)
miTask.Wait()
salida = miTask.Result
Return salida
End Function
To get access to the files later on Windows 10, you have to save permission for the files and/or folders. Do this when you select them.
...
Dim listToken = Windows.Storage.AccessCache.StorageApplicationPermissions.FutureAccessList.Add(rutaS)
...
where rutaS is an SotorageFolder object.

VB.Net Global DataSets inside a public function

I am having some problem with a function that I hope you can help.
My Application is a simple one, it uses an Access database to load employee information and creates letters and financial breakdown sheet from word templates that users can then print and save back to the database.
I started by creating a dataset containing several datatables for each form subroutine but it resulted in literally hundreds of lines of repeated code. But it worked.
What I want to do, is have one dataset containing all the information needed about an employee and be able to reference it over several forms at the same time. So i created a public module that looks like this:
Public Module Datasets
Public update As String
Dim pCn As OleDb.OleDbConnection
Public Function CSofwareDataSet() As DataSet
'open new connection to database
pCn = New OleDb.OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=G:\CGI Project\CorrespondenceSoftware\Database1.accdb; Persist Security Info=False;")
Try
Call pCn.Open() 'opens the connection
Catch ex As Exception
MessageBox.Show("Could not open a database connection! 1")
MessageBox.Show(ex.ToString)
End Try
CSofwareDataSet = New DataSet
Dim daOPG As New OleDb.OleDbDataAdapter("SELECT * FROM Overpayment WHERE PayNumber='" & Main.tbPayNumber.Text & "' AND Gross=1", pCn) 'get all data from Overpayment Details table
Dim daOPN As New OleDb.OleDbDataAdapter("SELECT * FROM Overpayment WHERE PayNumber='" & Main.tbPayNumber.Text & "' AND Net=1", pCn) 'get all data from Overpayment Details table
Dim daOPR As New OleDb.OleDbDataAdapter("SELECT * FROM OvpReasons", pCn) 'get overpayment reasons
Dim daREC As New OleDb.OleDbDataAdapter("SELECT * FROM TaxYear", pCn) 'get recovery date options
Dim daEMP As New OleDb.OleDbDataAdapter("SELECT * FROM EmployeeDetails WHERE PayNumber='" & Main.tbPayNumber.Text & "' AND Active=1 ", pCn) 'get all data from Employee Details table
Dim daCON As New OleDb.OleDbDataAdapter("SELECT * FROM Consultant", pCn) 'get all data from Consultant Details table
Dim daSET As New OleDb.OleDbDataAdapter("SELECT * FROM Settings", pCn) 'get all data from Consultant Details table
'Find the primary key (if missing)
daOPG.MissingSchemaAction = MissingSchemaAction.AddWithKey
daOPN.MissingSchemaAction = MissingSchemaAction.AddWithKey
daOPR.MissingSchemaAction = MissingSchemaAction.AddWithKey
daREC.MissingSchemaAction = MissingSchemaAction.AddWithKey
daEMP.MissingSchemaAction = MissingSchemaAction.AddWithKey
daCON.MissingSchemaAction = MissingSchemaAction.AddWithKey
daSET.MissingSchemaAction = MissingSchemaAction.AddWithKey
'setup prefixes
Dim cbOPG As New OleDb.OleDbCommandBuilder(daOPG)
cbOPG.QuotePrefix = "["
cbOPG.QuoteSuffix = "]"
Dim cbOPN As New OleDb.OleDbCommandBuilder(daOPN)
cbOPG.QuotePrefix = "["
cbOPG.QuoteSuffix = "]"
Dim cbOPR As New OleDb.OleDbCommandBuilder(daOPR)
cbOPG.QuotePrefix = "["
cbOPG.QuoteSuffix = "]"
Dim cbREC As New OleDb.OleDbCommandBuilder(daREC)
cbOPG.QuotePrefix = "["
cbOPG.QuoteSuffix = "]"
Dim cbEMP As New OleDb.OleDbCommandBuilder(daEMP)
cbEMP.QuotePrefix = "["
cbEMP.QuoteSuffix = "]"
Dim cbCON As New OleDb.OleDbCommandBuilder(daCON)
cbEMP.QuotePrefix = "["
cbEMP.QuoteSuffix = "]"
Dim cbSET As New OleDb.OleDbCommandBuilder(daSET)
cbEMP.QuotePrefix = "["
cbEMP.QuoteSuffix = "]"
If CSofwareDataSet.HasChanges Then
Try
daEMP.Update(CSofwareDataSet, "EmployeeDetails")
daOPG.Update(CSofwareDataSet, "OverPaymentGross")
daOPN.Update(CSofwareDataSet, "OverPaymentNet")
daSET.Update(CSofwareDataSet, "Settings")
MessageBox.Show("Success! Records updated.")
update = "0"
Catch ex As Exception
MessageBox.Show("Oops - something went wrong and it didn't update")
update = "0"
End Try
ElseIf CSofwareDataSet.Tables.Count = 0 Then
daOPG.Fill(CSofwareDataSet, "OverPaymentGross")
daOPN.Fill(CSofwareDataSet, "OverPaymentNet")
daOPR.Fill(CSofwareDataSet, "OverPaymentReasons")
daREC.Fill(CSofwareDataSet, "RecoveryDates")
daEMP.Fill(CSofwareDataSet, "EmployeeDetails")
daCON.Fill(CSofwareDataSet, "ConsultantDetails")
daSET.Fill(CSofwareDataSet, "Settings")
End If
'If update = "1" Then
' Try
' daEMP.Update(CSofwareDataSet, "EmployeeDetails")
' daOPG.Update(CSofwareDataSet, "OverPaymentGross")
' daOPN.Update(CSofwareDataSet, "OverPaymentNet")
' daSET.Update(CSofwareDataSet, "Settings")
'
' MessageBox.Show("Success! Records updated.")
' update = "0"
' Catch ex As Exception
' MessageBox.Show("Oops - something went wrong and it didn't update")
' update = "0"
' End Try
' End If
pCn.Close()
End Function
End Module
On each form, it gets referenced like this (as an example):
Imports WeifenLuo.WinFormsUI.Docking
Imports Word = Microsoft.Office.Interop.Word
Imports CorrespondenceSoftware.Datasets
Public Class GrossInput
Dim loading = "1"
Dim NewEmployee = "0" 'sets the default new employee flag to 0
Private pCn As OleDb.OleDbConnection
Private Sub GrossInput_Load(ByVal Sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Try
Try
If CSofwareDataSet.Tables("EmployeeDetails").Rows.Count > 0 Then
For i As Integer = 0 To CSofwareDataSet.Tables("EmployeeDetails").Rows.Count - 1
cbTitle.Text = CSofwareDataSet.Tables("EmployeeDetails").Rows(i)(2)
tbFName.Text = CSofwareDataSet.Tables("EmployeeDetails").Rows(i)(3)
tbLName.Text = CSofwareDataSet.Tables("EmployeeDetails").Rows(i)(4)
tbAddress1.Text = CSofwareDataSet.Tables("EmployeeDetails").Rows(i)(5)
tbAddress2.Text = CSofwareDataSet.Tables("EmployeeDetails").Rows(i)(6)
tbAddress3.Text = CSofwareDataSet.Tables("EmployeeDetails").Rows(i)(7)
tbAddress4.Text = CSofwareDataSet.Tables("EmployeeDetails").Rows(i)(8)
tbPostcode.Text = CSofwareDataSet.Tables("EmployeeDetails").Rows(i)(9)
tbWorkLocation.Text = CSofwareDataSet.Tables("EmployeeDetails").Rows(i)(10)
tbWorkLocation.Enabled = False
tbPostcode.Enabled = False
tbAddress4.Enabled = False
tbAddress3.Enabled = False
tbAddress2.Enabled = False
tbAddress1.Enabled = False
tbLName.Enabled = False
tbFName.Enabled = False
cbTitle.Enabled = False
chkMSC.Enabled = False
chkOfficer.Enabled = False
chkStaff.Enabled = False
bnSaveEmp.Enabled = False
bnEditEmp.Enabled = True
Next
End If
If CSofwareDataSet.Tables("EmployeeDetails").Rows(0)(11) = "1" Then
chkOfficer.Checked = True
Else
chkOfficer.Checked = False
End If
If CSofwareDataSet.Tables("EmployeeDetails").Rows(0)(12) = "1" Then
chkStaff.Checked = True
Else
chkStaff.Checked = False
End If
If CSofwareDataSet.Tables("EmployeeDetails").Rows(0)(13) = "1" Then
chkMSC.Checked = True
Else
chkMSC.Checked = False
End If
Catch ex As Exception
MessageBox.Show(ex.ToString)
MessageBox.Show("Employee not found. Ensure pay number is correct and create a new record")
NewEmployee = "1" ' tells the program to create a new record if saved
cbReference.Enabled = False
cbReference.Text = ""
bnEditEmp.Enabled = False
End Try
'display the overpayment references to the user
If CSofwareDataSet.Tables("OverPaymentGross").Rows.Count > 0 Then
For i As Integer = 0 To CSofwareDataSet.Tables("OverPaymentGross").Rows.Count - 1
cbReference.Items.Add(CSofwareDataSet.Tables("OverPaymentGross").Rows(i)(2))
Next
End If
'display the available consultants to the user
If CSofwareDataSet.Tables("ConsultantDetails").Rows.Count > 0 Then
For i As Integer = 0 To CSofwareDataSet.Tables("ConsultantDetails").Rows.Count - 1
cbConsultant.Items.Add(CSofwareDataSet.Tables("ConsultantDetails").Rows(i)(1) & " " & CSofwareDataSet.Tables("ConsultantDetails").Rows(i)(2))
Next
End If
'display the available Overpayment reasons to the user
If CSofwareDataSet.Tables("OverPaymentReasons").Rows.Count > 0 Then
For i As Integer = 0 To CSofwareDataSet.Tables("OverPaymentReasons").Rows.Count - 1
cbReason.Items.Add(CSofwareDataSet.Tables("OverPaymentReasons").Rows(i)(1))
Next
End If
'Load other recovery date options
If CSofwareDataSet.Tables("RecoveryDates").Rows.Count > 0 Then
For i As Integer = 0 To CSofwareDataSet.Tables("RecoveryDates").Rows.Count - 1
cbStartRecovery.Items.Add(CSofwareDataSet.Tables("RecoveryDates").Rows(i)(1))
Next
End If
Catch ex As Exception
MessageBox.Show(ex.ToString) 'Show any errors to the user
End Try
loading = "0"
End Sub
Now! the problem that I'm having is that, this does work and run without any errors BUT every time the CSSoftwareDataSet function runs it populates the tables correctly and returns the expected results but it then deletes the datatable data so every time the function is referenced from a winform it needs to haul all the data from the access database from scratch, severely impacting on the performance of the program. The tables wont update properly because its not storing the datatable information and as soon as its inserted its forgotten but again, produces no errors. An example of my update script looks like this:
Else 'create a new record
'create a new reference
Dim REFRowCount = CSofwareDataSet.Tables("OverPaymentGross").Rows.Count + 1 'count the number of rows in table and add 1
Dim NewREF = "OVPG" & Main.tbPayNumber.Text & "-" & REFRowCount
'Find todays date and reply dates
Dim TodayDatedate = Format(Now.Date(), "dd/MM/yyyy")
Dim ReplyDatedate = Format(Now.Date.AddDays(21), "dd/MM/yyyy")
'Create a new row
Dim OPNew As DataRow = CSofwareDataSet.Tables("OverPaymentGross").NewRow() 'create a variable to contain the new row
OPNew.Item(1) = Main.tbPayNumber.Text
OPNew.Item(2) = NewREF
OPNew.Item(3) = tbOverpaymentAmount.Text.ToString
OPNew.Item(4) = tbMonRec.Text
OPNew.Item(5) = tbTaxP.Text
OPNew.Item(6) = TodayDatedate
OPNew.Item(7) = ReplyDatedate
OPNew.Item(8) = tbMoRep.Text
OPNew.Item(9) = cbStartRecovery.Text
OPNew.Item(10) = "1" 'Set as gross
OPNew.Item(11) = "0" 'do not set as net
OPNew.Item(12) = cbReason.Text
OPNew.Item(13) = tbAI.Text
OPNew.Item(14) = dtpStart.Value.Date
OPNew.Item(15) = dtpFinish.Value.Date
OPNew.Item(16) = cbConsultant.Text
OPNew.Item(17) = tbPosition.Text
Call CSofwareDataSet.Tables("OverPaymentGross").Rows.Add(OPNew) 'fill the new row and insert the data
There must be a solution to this. To create a dataset that holds its data in session while you open other winforms until it is reset. I'm out of ideas because i really don't want to go back to repeating all this code for practically every subroutine in my program.
I hope I've explained it OK .. Any help here will be greatly appreciated.
Many thanks,
Shane
You can declare the DataSet globally, populate it in a function (sub), which is called just at the start, and retrieve the information by accessing the variable rather than by calling the function over and over. Your code uses a somehow ambiguous approach (same name for function and for variable) which, together with the VB rules (functions might not include a Return statement but a variable with the function's name) does not play to your favor.
Sample code converting the DataSet into a public variable and renaming the function (and converting it into a sub: what is the point of a function now?):
Public CSofwareDataSet As DataSet
Public Sub populateDS()
'open new connection to database
pCn = New OleDb.OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=G:\CGI Project\CorrespondenceSoftware\Database1.accdb; Persist Security Info=False;")
Try
Call pCn.Open() 'opens the connection
Catch ex As Exception
MessageBox.Show("Could not open a database connection! 1")
MessageBox.Show(ex.ToString)
End Try
CSofwareDataSet = New DataSet
'Remaining code
End Sub
Call this sub just once (right at the start of your application; or every time new data has to be retrieved from the DB) and continue using CSofwareDataSet as so far (although as a variable, by removing the Call bits; which, on the other hand, are not required in VB.NET at all).