Okay so for an internship project i'm making a Journal with streamwriters and streamreaders.
I have to to where you can create an account with a name, Username, and Password. I also have it to where it creates a txt file in that persons name when you create the account. Now, they login and it brings them to the journal page. The Journal Page for the most part has a Date for your journal Entry, the title of the journal and the journal entry text itself.
The problem that I am having is that when you click the button to create/edit a journal entry, it goes through a sub routine that checks if that journal exists (Meaning that there is already one for that date) or not. If it doesn't exist, then it should create a new one at the bottom of the text file. If it does exist then it should edit the lines in which that journal are stationed in the text file.
Code:
Private Sub CreateBtn_Click(sender As System.Object, e As System.EventArgs) Handles CreateBtn.Click
Errors = ""
Dim TempCounter As Integer = 0
If TitleTxt.Text = "" Then
Errors = "You must enter a title." & vbCrLf
End If
If JournalTextRtxt.Text = "" Then
Errors &= "You must enter an entry for the journal."
End If
If Errors <> "" Then
MessageBox.Show("There's an error in creating/editing your journal." & vbCrLf & "Error(s):" & vbCrLf & Errors, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
JournalDate = DateTimePicker1.Value
JournalTitle = TitleTxt.Text
JournalText = JournalTextRtxt.Text
arrJournalEntries(TempCounter).TheDate = JournalDate
arrJournalEntries(TempCounter).Title = JournalTitle
arrJournalEntries(TempCounter).JournalEntry = JournalText
CheckAndWrite()
End If
End Sub
Private Sub CheckAndWrite()
Dim Reader As New StreamReader(MyName & ".txt", False)
Dim Sline As String = Reader.ReadLine
Counter = 0
Do Until (Sline Is Nothing) 'Perform the code until the line in the text file is blank
If Not Sline Is Nothing Then 'If the line in the text file is NOT blank then
For i As Integer = 1 To 3
Select Case i
Case 1
arrJournalEntries(Counter).TheDate = Sline
Sline = Reader.ReadLine
Case 2
arrJournalEntries(Counter).Title = Sline
Sline = Reader.ReadLine
Case 3
arrJournalEntries(Counter).JournalEntry = Sline
Sline = Reader.ReadLine
End Select
Next
End If
JournalDate = arrJournalEntries(Counter).TheDate
Time = DateTimePicker1.Value
MsgBox("Journal Date = " & JournalDate & vbCrLf & "Today's Date = " & Time)
If Time = JournalDate Then
JournalFound = True
Else
Counter += 1
JournalFound = False
End If
Loop
Reader.Close()
Try
If Sline Is Nothing Or JournalFound = False Then
MsgBox("Your journal is now going to be created.")
JournalDate = DateTimePicker1.Value
JournalTitle = TitleTxt.Text
JournalText = JournalTextRtxt.Text
arrJournalEntries(Counter).TheDate = JournalDate
arrJournalEntries(Counter).Title = JournalTitle
arrJournalEntries(Counter).JournalEntry = JournalText
Dim Writer As New StreamWriter(MyName & ".txt", True)
Do Until (arrJournalEntries(Counter).TheDate = Nothing)
Writer.WriteLine(arrJournalEntries(Counter).TheDate)
Writer.WriteLine(arrJournalEntries(Counter).Title)
Writer.WriteLine(arrJournalEntries(Counter).JournalEntry)
Counter += 1
Loop
Writer.Close()
End If
If JournalFound = True Then
MsgBox("Your journal is now going to be edited.")
JournalDate = DateTimePicker1.Value
JournalTitle = TitleTxt.Text
JournalText = JournalTextRtxt.Text
arrJournalEntries(Counter).TheDate = JournalDate
arrJournalEntries(Counter).Title = JournalTitle
arrJournalEntries(Counter).JournalEntry = JournalText
Dim Writer As New StreamWriter(MyName & ".txt", True)
Do Until (arrJournalEntries(Counter).TheDate = Nothing)
Writer.WriteLine(arrJournalEntries(Counter).TheDate)
Writer.WriteLine(arrJournalEntries(Counter).Title)
Writer.WriteLine(arrJournalEntries(Counter).JournalEntry)
Counter += 1
Loop
Writer.Close()
End If
Catch ex As Exception
MessageBox.Show("An error has occured" & vbCrLf & vbCrLf & "Original Error:" & vbCrLf & ex.ToString)
End Try
End Sub`
The problem that's occuring is that it's not only writing in the first time wrong. When it's supposed to say it's going to edit, it doesn't, it just says creating. But it just adds on to the file. After pressing the button 3 times with the current date. and the Title being "Test title", and the journal entry text being "Test text". This is what occured.
It should just be
7/10/2012 3:52:08 PM
Test title
Test text
7/10/2012 3:52:08 PM
Test title
Test text
the whole way through. but of course if it's the same date then it just overwrites it. So can anybody please help me?
You are only filtering your array by the date, so it looks like you have an object with a date but no title or text:
Do Until (arrJournalEntries(Counter).TheDate = Nothing)
The "quick" fix:
Do Until (arrJournalEntries(Counter).TheDate = Nothing)
If arrJournalEntries(Counter).Title <> String.Empty Then
Writer.WriteLine(arrJournalEntries(Counter).TheDate)
Writer.WriteLine(arrJournalEntries(Counter).Title)
Writer.WriteLine(arrJournalEntries(Counter).JournalEntry)
End If
Counter += 1
Loop
Do consider getting rid of the array and using a List(of JournalEntry) instead. Your code looks difficult to maintain in its current state.
Related
I am trying to search the information from the sql server then show at the listview. Everytime I click search it won't clear the existing records based on the past time searching. I've tried item.clear, it will only show me the new search but it won't clear all the existing records. Can someone help please?
Private Sub btnSearch_Click(sender As Object, e As EventArgs) Handles btnSearch.Click
Dim strNameSource As String
Dim strPhoneSource As String
Dim strBothSource As String
If OpenConnect() = True Then
Try
If ChkCustName.Checked = True Then
strNameSource = "SELECT TCI.strLastName + ', ' + TCI.strFirstName AS strName,TCI.strPhoneNumber,CONVERT(VARCHAR,TCI.dtmCheckIn, 101),CONVERT(VARCHAR,TCI.dtmCheckOut,101),TRT.strRoomType,TR.strRoom FROM TCheckInInfo AS TCI,TRoom AS TR,TRoomType AS TRT WHERE TCI.intRoomID = TR.intRoomID AND TR.intRoomTypeID = TRT.intRoomTypeID AND intCheckInStatusID = 1 AND TCI.strLastName ='" & txtLastName.Text & "'"
SearchReservation(strNameSource)
ElseIf ChkPhoneNumber.Checked = True Then
strPhoneSource = "SELECT TCI.strLastName + ', ' + TCI.strFirstName AS strName,TCI.strPhoneNumber,CONVERT(VARCHAR,TCI.dtmCheckIn, 101),CONVERT(VARCHAR,TCI.dtmCheckOut,101),TRT.strRoomType,TR.strRoom FROM TCheckInInfo AS TCI,TRoom AS TR,TRoomType AS TRT WHERE TCI.intRoomID = TR.intRoomID AND TR.intRoomTypeID = TRT.intRoomTypeID AND intCheckInStatusID = 1 AND TCI.strPhoneNumber ='" & txtPhoneNumber.Text & "'"
SearchReservation(strPhoneSource)
ElseIf ChkCustName.Checked = True And ChkPhoneNumber.Checked = True Then
strBothSource = "SELECT TCI.strLastName + ', ' + TCI.strFirstName AS strName,TCI.strPhoneNumber,CONVERT(VARCHAR,TCI.dtmCheckIn, 101),CONVERT(VARCHAR,TCI.dtmCheckOut,101),TRT.strRoomType,TR.strRoom FROM TCheckInInfo AS TCI,TRoom AS TR,TRoomType AS TRT WHERE TCI.intRoomID = TR.intRoomID AND TR.intRoomTypeID = TRT.intRoomTypeID AND intCheckInStatusID = 1 AND TCI.strPhoneNumber ='" & txtPhoneNumber.Text & "' AND TCI.strLastName ='" & txtLastName.Text & "'"
SearchReservation(strBothSource)
End If
txtLastName.Clear()
txtPhoneNumber.Clear()
Catch excError As Exception
WriteLog(excError)
'End program
Application.Exit()
End Try
End If
End Sub
Private Sub SearchReservation(ByVal strSource As String)
Dim itemcollection(100) As String
Dim Row As Integer
Dim Column As Integer
Dim ListViewItem As New ListViewItem
lstReservation.Items.Clear()
Try
cmd = New OleDb.OleDbCommand(strSource, cnn)
Adapter = New OleDb.OleDbDataAdapter(cmd)
Adapter.Fill(Ds, "Table")
'Now adding the Items in Listview
If Ds.Tables(0).Rows.Count = 0 Then
' Something went wrong. warn user
MessageBox.Show(Me, "Could not find the Customer", "Customer finding Error", _
MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Else
lstReservation.BeginUpdate()
For Row = 0 To Ds.Tables(0).Rows.Count - 1
For Column = 0 To Ds.Tables(0).Columns.Count - 1
itemcollection(Column) = Ds.Tables(0).Rows(Row)(Column).ToString()
Next
ListViewItem = New ListViewItem(itemcollection)
lstReservation.Items.Add(ListViewItem)
Next
lstReservation.EndUpdate()
End If
Catch excError As Exception
WriteLog(excError)
'End program
Application.Exit()
End Try
End Sub
Lots of issues with your code, but I'll focus on your immediate issue.
You keep filling the DataSet with new tables, but you keep using the original table that is still in position zero of the DataSet.
I would venture a guess that you need to clear the rows of your DataTable:
If Ds.Tables.Contains("Table") Then
Ds.Tables("Table").Rows.Clear()
End If
lstReservation.Items.Clear()
of just clear any tables there:
Ds.Tables.Clear()
lstReservation.Items.Clear()
So basically I'm making a library book record thing that tracks new books,view title and author.Right now, I'm in the stage of viewing all title and author in alphabetical order and I made them stored in a text file. My teacher suggested me to use bubble sort for sorting in alphabetical but right now I need more indepth explanation. Please help a man out thanks :D
Oh and the text file goes like this(no space in between except the last one using &vbcrlf):
Title
Author
Date published
Pagenum
ISBN
Sub Main()
'Making a book using the attributes and methods
Dim title As String = ""
Dim datepublished As Date = #01/01/0001# ' date is in month/day/year
Dim pagenum As Integer = 0
Dim isbn As String = ""
Dim author As String = ""
Dim amountbooks As Integer = 0
Dim choice As String = ""
'Declaring an object variable 'filename' which shows the file name (bookrecords.txt) and the path given
Dim filename As String = "C:\Users\Local_PC\Desktop\Try_oop_book\bookrecords.txt"
'Making a menu for the client
' A While loop for the menu that checks the user's input
While choice <> "1" AndAlso choice <> "2" AndAlso choice <> "3" AndAlso choice <> "4"
Console.Clear()
Console.WriteLine("----------LIBRARY MENU----------")
Console.WriteLine("[ 1 ]" & "Add New Book(s)")
Console.WriteLine("[ 2 ]" & "View all Book Titles")
Console.WriteLine("[ 3 ]" & "View all Authors")
Console.WriteLine("[ 4 ]" & "Exit")
Console.WriteLine(" ")
Console.Write("Pick a Menu Number: ")
choice = Console.ReadLine()
If choice <> "1" And choice <> "2" And choice <> "3" And choice <> "4" Then
Console.WriteLine("Please type in a valid input next time, press enter to retry again.")
Console.ReadLine()
Else
'Using choice, it goes to check which menu the user typed in.
If choice = "1" Then
'The user has chosen 1 which is to add new book(s) to the menu system.
'Setting the title of the book using mybook.setTitle
Console.WriteLine("How many books do you want to add?")
amountbooks = Console.ReadLine()
Dim bookarr(amountbooks) As Book 'This will initialise after amountbooks has been entered. Prevents from getting invalid index number of 0.
For x = 1 To amountbooks ' This loop will go over how many amount of books the user wants to add in to.
bookarr(x) = New Book()
Console.WriteLine("What is the title of the book?")
title = Console.ReadLine() 'This gives the value to store inside the variable 'title'
bookarr(x).setTitle(title) 'This line will set that 'title' into array bookarr
Console.WriteLine("Who is the author of the book?")
author = Console.ReadLine()
bookarr(x).setAuthor(author)
Console.WriteLine("When is the book published?")
datepublished = Console.ReadLine()
bookarr(x).setDatePublished(datepublished)
Console.WriteLine("How many page numbers are there?")
pagenum = Console.ReadLine()
bookarr(x).setPageNum(pagenum)
Console.WriteLine("What is the ISBN(code) of the book?")
isbn = Console.ReadLine()
bookarr(x).setISBN(isbn)
Console.Clear() 'clears everything after it has been written into a file
If System.IO.File.Exists(filename) = True Then
' Setting up an object variable for the streamwriter (which is the path folder and its name).
Dim objwriter As New System.IO.StreamWriter(filename, True) ' Has been set to true because the file exists and this will append(ADD) for the next str.
' if a file doesn't exists, it should be false which will ensure that a text file is created first.
objwriter.WriteLine(bookarr(x).getTitle & vbCrLf & bookarr(x).getAuthor & vbCrLf & bookarr(x).getDatePublished & vbCrLf & bookarr(x).getPageNum & vbCrLf & bookarr(x).getISBN & vbCrLf)
objwriter.Close() ' Closes the pathway to filename.
MsgBox("TEXT HAS BEEN SUCCESSFULLY REGISTERED")
Else
MsgBox("FILE DOES NOT EXIST")
End If
Next x
Else
If choice = "2" Then 'View all book titles
Dim readall As String = ""
Dim readtitle As String = ""
If System.IO.File.Exists(filename) = True Then
Dim objreader As New System.IO.StreamReader(filename)
readtitle = objreader.ReadLine
objreader.Close() 'Closes the pathway to filename
Console.WriteLine(readtitle) 'Outputs the all book title in alphabetical
Else
MsgBox("FILE DOES NOT EXIST")
End If
Console.ReadLine()
Else
If choice = "3" Then
Dim readauthor As String
Dim amountauthor As Integer = 0
Dim objreader As New System.IO.StreamReader(filename)
Else
Environment.Exit(0) 'idk I found this online :P but it works for exiting the console
End If
Console.ReadLine()
End If
End If
End If
End While
End Sub
I've got a large subroutine (1958 lines) to calculate some prices and figures based on a complex decision tree.
The figures will be in one of multiple tables, so to check if there is an applicable set of data to use, I've got the following If statement
If dDt.Rows.Count = 0 And cDt.Rows.Count = 0 And p1Dt.Rows.Count = 0 And p2Dt.Rows.Count = 0 And p3Dt.Rows.Count = 0 Then
If SysAQ = False Then
Me.Cursor = Cursors.Default
MessageBox.Show("There are no rates in the system for " & cmbSupplier.Text & "/" & ugr.Cells("Product_Code").Value & "/" & cmbCustCode.Text & " for todays " & _
"date. Please add one and try again.", "No Rate Exists", MessageBoxButtons.OK, MessageBoxIcon.Information)
ugr.Cells("DSC_Code").Value = ""
ugr.Cells("DSC_Rate").Value = 0
ugr.Cells("DSC_Value").Value = 0
ugr.Cells("DSC_VAT").Value = 0
Exit Sub
ElseIf suppAQ = False Then
Me.Cursor = Cursors.Default
MessageBox.Show("There are no rates in the system for " & cmbSupplier.Text & "/" & ugr.Cells("Product_Code").Value & "/" & cmbCustCode.Text & " for todays " & _
"date. Please add one and try again.", "No Rate Exists", MessageBoxButtons.OK, MessageBoxIcon.Information)
ugr.Cells("DSC_Code").Value = ""
ugr.Cells("DSC_Rate").Value = 0
ugr.Cells("DSC_Value").Value = 0
ugr.Cells("DSC_VAT").Value = 0
Exit Sub
ElseIf aDt.Rows.Count = 0 Then
Me.Cursor = Cursors.Default
MessageBox.Show("There are no rates in the system for " & cmbSupplier.Text & "/" & ugr.Cells("Product_Code").Value & "/" & cmbCustCode.Text & " for todays " & _
"date. Please add one and try again.", "No Rate Exists", MessageBoxButtons.OK, MessageBoxIcon.Information)
ugr.Cells("DSC_Code").Value = ""
ugr.Cells("DSC_Rate").Value = 0
ugr.Cells("DSC_Value").Value = 0
ugr.Cells("DSC_VAT").Value = 0
Exit Sub
End If
End If
This block of code is within a For Loop, For Each ugr As UltraGridRow in ugLines.Rows
This means it's checking if there is a price for the product on the line, and if not, alerts the user and exits the subroutine.
This subroutine is called on ugLines.AfterRowInsert, (Once a product has been added), as well as before saving the full data.
It works fine for the latter scenario, as whenever it detects a line with no price, it will error and not save. However, if a product has been added with no price, then the user adds another product, it will never add the price in or tell the user the new line is missing a price as the first one always fails.
What I'm wondering, is if there is another way to set this out? Instead of having Exit Sub, can I change it to skip the rest of the code and jump straight to the next iteration? I've looked at using Continue and Continue For, but that seems to be only applicable if checking the opposite, to check where each product does have a price in at least one of the tables, making the If Statement more complex - Is there another way around this?
Essentially, just changing the code in your question to the following:
Dim noRatesInSystem As Boolean = False
If dDt.Rows.Count = 0 And cDt.Rows.Count = 0 And p1Dt.Rows.Count = 0 And p2Dt.Rows.Count = 0 And p3Dt.Rows.Count = 0 Then
If SysAQ = False OrElse suppAQ = False OrElse aDt.Rows.Count = 0 Then
Me.Cursor = Cursors.Default
MessageBox.Show("There are no rates in the system for " & cmbSupplier.Text & "/" & ugr.Cells("Product_Code").Value & "/" & cmbCustCode.Text & " for todays " & _
"date. Please add one and try again.", "No Rate Exists", MessageBoxButtons.OK, MessageBoxIcon.Information)
ugr.Cells("DSC_Code").Value = ""
ugr.Cells("DSC_Rate").Value = 0
ugr.Cells("DSC_Value").Value = 0
ugr.Cells("DSC_VAT").Value = 0
noRatesInSystem = True
End If
End If
If noRatesInSystem = True Then Continue For
This will A) Tidy up the If Statement, B) Continue the loop if a price is found and C) Skip the iteration (Jump to Next) if there are no prices found.
I have a BackGroundWorker with a For Each loop that is inside of a Try Catch and I need to detect the error and continue the For Each loop whit the next item.
Actually I have a list of data to send to a server trough UDP and wait for an ACK, but if the server didn't answer in 5 seconds the timeout error is cachet and the whole process is aborted.
I need to do something like this
Dim MyData_Array As String()
For Each MyData As String In MyData_Array
MyData_Actual = MyData
' Translate the passed message into ASCII and store it as a Byte array.
Dim data As [Byte]() = System.Text.Encoding.ASCII.GetBytes(MyData)
Dim RemoteIpEndPoint As New IPEndPoint(IPAddress.Any, 0)
If data.Length = 67 Then
XMyData += 1
Dim Tx As New UdpClient()
Tx.Connect(Host, Port)
Tx.Client.SendTimeout = 5000
Tx.Client.ReceiveTimeout = 5000
Tx.Send(data, data.Length)
data = Tx.Receive(RemoteIpEndPoint)
Tx.Close()
Else
MyData_ErrorList += MyData & vbCrLf
End If
'Report progress
Porcentaje = (XMyData * 100) / MyData_Array.Count
BackgroundWorker1.ReportProgress(Porcentaje, "Sending MyData " & XMyData.ToString & " de " & MyData_Array.Count.ToString & " : " & MyData)
If BackgroundWorker1.CancellationPending Then
e.Cancel = True
Exit For
End If
Next
End If
Catch ex As TimeoutException
MyData_ErrorList += MyData_Actual & vbCrLf
'**********************************************************
'Here need to delay 100mS and get back to the For Each to process the next item
'**********************************************************
Catch ex As Exception
MyData_List = ex.Message & vbCrLf & "StackTrace: " & ex.StackTrace & vbCrLf & MyData_List
End Try
Put the Try/Catch inside the for loop.
Dim MyData_Array As String()
For Each MyData As String In MyData_Array
Try
MyData_Actual = MyData
' Translate the passed message into ASCII and store it as a Byte array.
Dim data As [Byte]() = System.Text.Encoding.ASCII.GetBytes(MyData)
Dim RemoteIpEndPoint As New IPEndPoint(IPAddress.Any, 0)
If data.Length = 67 Then
XMyData += 1
Dim Tx As New UdpClient()
Tx.Connect(Host, Port)
Tx.Client.SendTimeout = 5000
Tx.Client.ReceiveTimeout = 5000
Tx.Send(data, data.Length)
data = Tx.Receive(RemoteIpEndPoint)
Tx.Close()
Else
MyData_ErrorList += MyData & vbCrLf
End If
'Report progress
Porcentaje = (XMyData * 100) / MyData_Array.Count
BackgroundWorker1.ReportProgress(Porcentaje, "Sending MyData " & XMyData.ToString & " de " & MyData_Array.Count.ToString & " : " & MyData)
If BackgroundWorker1.CancellationPending Then
e.Cancel = True
Exit For
End If
Catch ex As TimeoutException
MyData_ErrorList += MyData_Actual & vbCrLf
Catch ex As Exception
MyData_List = ex.Message & vbCrLf & "StackTrace: " & ex.StackTrace & vbCrLf & MyData_List
'If you want to exit the For loop on generic exceptions, uncomment the following line
'Exit For
End Try
Next
You might consider putting the try catch inside the for loop, if the iterative collection is not modified somehow by the error. Then handle the exception and continue the for loop.
How you have your loop and try/catch setup now will cause the entire loop to be broken out of on the timeout exception since the try/catch is placed outside the loop.
The your code would look more like this:
For Each MyData As String In MyData_Array
Try
'Perform code for each loop iteration
Catch ex As TimeoutException
'Handle Exception Here
End Try
Next
I have this code:
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Dim num As String
Dim message As String
Dim name As String
message = txtMessage.Text
Dim count As Integer = Me.TblContactsBindingSource.Count
If i < TblContactsDataGridView.Rows.Count - 1 Then 'stay within bounds
i = i + 1 ' for all rows except Row0
TblContactsDataGridView.Rows(i - 1).DefaultCellStyle.BackColor = Color.White ' restore previous highlight
TblContactsDataGridView.Rows(i).DefaultCellStyle.BackColor = Color.Bisque 'new highlight
num = Me.TblContactsDataGridView.Rows(i).Cells(1).Value.ToString()
name = Me.TblContactsDataGridView.Rows(i).Cells(0).Value.ToString()
If SerialPort1.IsOpen() Then
SerialPort1.Write("AT" & vbCrLf)
SerialPort1.Write("AT+CMGF=1" & vbCrLf)
SerialPort1.Write("AT+CMGS=" & Chr(34) & num & Chr(34) & vbCrLf)
SerialPort1.Write(message & Chr(26))
MessageBox.Show("Message has been successfully sent to " & vbNewLine & name & " (" & num & ") ", "Message Sent", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
Else 'next row is off the bottom so
'i = 0 'reset index
'TblSmsDataGridView.Rows(TblSmsDataGridView.Rows.Count - 1).DefaultCellStyle.BackColor = Color.White 'restore bottom row
'TblSmsDataGridView.Rows(i).DefaultCellStyle.BackColor = Color.Bisque 'highlight top row
End If
In a command button I have this:
Timer1.Interval = 2000
Timer1.Enabled = True 'no need to enable it and start it; one or t'other
What happen is, the message box appears over and over. How can i trigger message box to automatically close once it is finished? I commented the code in the "else" because the it repeats over and over.
You have to use a custom message box. Normal message box wont do the thing you wanted. It will pop up every 2 second. best choice is to make a new form and show it as a message box. :)
You need to set timer1.enabled = false in the timer1.tick handler.