I currently have a code shown below for entering a password to have the code start. I am a VBA noob so please go easy on me.
Issue: When the input box prompt appears it works fine if the password is correct. If it is incorrect you are given more opportunities to enter it again but lets say you do not know the password and want to close the window, you cannot. The "x" option and cancel options will just cause the input box prompt to refresh rather than closing the window. How can I set the window up to close?
Here is the code in written form:
Sub Pword()
Dim Ans As Boolean
Const Pword As String = "black2"
Ans = False
Do While Ans = False
If InputBox("Please enter password to continue.", "Enter Password") = Pword Then
Ans = True
End If
Loop
Sheets("Workshop").Range("B15:B20") = ""
Sheets("Workshop").Range("B24:B29") = ""
Sheets("Workshop").Range("B33:B35") = ""
Sheets("Workshop").Range("E5:E11") = ""
Sheets("Workshop").Range("E15:E26") = ""
Sheets("Workshop").Range("H5:H17") = ""
MsgBox "All data has been cleared."
End Sub
If you need to consider an empty string as a valid input value, the only way to check if the InputBox was actually cancelled isn't to compare its result with vbNullString or "" (both will be True).
So you can use the (undocumented) StrPtr function to determine if the InputBox call returned a legit empty string, or if it was actively cancelled with the [X] or [Cancel] button:
Dim result As String
result = InputBox(...)
If StrPtr(result) = 0 Then
' inputbox was cancelled
Exit Sub
Else
' todo: validate result
End If
Combine that with the other answers to get a reliable "retry" mechanism.
Add a check to see if it's an empty string, like this:
Dim sResult As String
Do While Ans = False
sResult = InputBox("Please enter password to continue.", "Enter Password")
If sResult = Pword Then
Ans = True
ElseIf sResult = "" Then
Exit Do ' or Exit Sub depending on what you want to happen afterwards
End If
Loop
#braX suggestion is an excellent solution.
Also, you can limit the attemps to n in this case I limit the attempts to 3
Dim sResult As String
Dim Attmp As Integer
Attmp = 0
Do While Ans = False
sResult = InputBox("Please enter password to continue.", "Enter Password")
If sResult = Pword Then
Ans = True
ElseIf sResult = "" Then
Attmp = Attmp + 1
If Attmp = 3 Then
Msgbox "Maximum attempts reached."
Exit Do
End If
End If
Loop
Related
Module Module1
Dim database As New Dictionary(Of String, String)
Dim ulist As New List(Of String)
Dim plist As New List(Of String)
Dim newname As String
Dim passw As String
Sub main()
menu() '
End Sub
Sub menu()
Console.WriteLine("type 1, 2 or 3")
Console.WriteLine("1 : create a new account")
Console.WriteLine("2: log in ")
Console.WriteLine("3 : quit program")
Dim choice As String
choice = Console.ReadLine()
If choice = "1" Then
create()
ElseIf choice = "2" Then
login()
ElseIf choice = "3" Then
Console.WriteLine("quitting...")
Console.Clear()
End If
End Sub
Sub login()
Dim unamever As String
Dim passwvari
Dim veri3 As Boolean = False
While veri3 = False
Console.WriteLine("please enter you username")
unamever = Console.ReadLine()
If ulist.Contains(unamever) Then
Console.WriteLine("please enter your password : ")
passwvari = Console.ReadLine()
If plist.Contains(passwvari) Then
Console.WriteLine("logging you in...")
veri3 = True
Else
Console.WriteLine("password incorrect try again")
veri3 = False
End If
Else
Console.WriteLine("username not registered try again")
veri3 = False
End If
End While
End Sub
Sub create()
Dim veri As Boolean = False
Dim attempts As Integer = 1
Do Until veri = True
Console.WriteLine("enter a new username")
newname = Console.ReadLine()
If ulist.Contains(newname) Then
Console.WriteLine("that username is already taken, try again")
attempts = attempts + 1
veri = False
Else
ulist.Add(newname)
Console.WriteLine("your new username has been stored")
notused()
veri = True
database.Add(newname, passw)
Console.WriteLine("succes you have made an account you username :" & newname & " and password: " & passw)
FileOpen(1, "C:\Users\iivix\OneDrive\Documents\A LEVEL\passws.txt", OpenMode.Output)
PrintLine(1, newname & passw)
End If
If attempts > 4 Then
Console.WriteLine("you have had more than 3 tries, BYE")
Console.Clear()
End If
Loop
End Sub
Sub notused()
Dim veri2 As Boolean = False
While veri2 = False
Console.WriteLine("create a password " & newname)
passw = Console.ReadLine
Dim passwlen = Len(passw)
If passwlen > 12 Then
Console.WriteLine("your password has been stored ")
plist.Add(passw)
veri2 = True
Else
Console.WriteLine("try again password must be greater than 12 characters")
veri2 = False
End If
End While
End Sub
End Module
This code is for a login system, I am a vb beginner and this is my code so far I have come across a problem: why aren't the usernames being stored when I try to log in later, how can I fix this? I want the user to be able to log back into an account when it is created another problem when writing usernames and passwords to a text file the new username overwrites the last, I want the usernames to be consecutively listed along with passwords'
BTW this isn't homework, its a beginners programming challenge
I have updated your code to use .net methods rather than obsolete VB6 methods. I made the LoginPath a Module level variable so it can be seen my all the methods in the Module. I am using a Dictionary rather than your 2 List(Of String)s. This way the username is the key and the password in the value. Dictionary lookup is very fast.
The first thing to do is to read the file and and fill the dictionary. If the file doesn't yet exist the user is informed.
The Create method changes a bit with the use of the Dictionary. I used the .net File class to write to the text file.
File.AppendAllLines(LoginPath, {$"{newname},{passw}"})
This is a very clever method. If the file doesn't exist, it creates it. It opens the file writes to the file and closes it. The first parameter is the path. The second parameter is what to write to the file, a String array. Notice the method names ends with AllLines, plural. The outer braces indicate that this is an array. Our array has only one element. I used an interpolated string indicated by the $ preceding the string. We can then insert variables directly into the string surrounded by braces. The comma is a literal in the string. We use the comma as a delimiter when the string is split into name and password.
Private LoginPath As String = "C:\Users\iivix\OneDrive\Documents\A LEVEL\passws.txt"
Private LoginDict As New Dictionary(Of String, String)
Sub Main()
ReadLoginFileAndFillDictionary()
menu()
Console.ReadKey()
End Sub
Private Sub Menu() 'Names of Subs, Functions etc. should begin with capital letters
Console.WriteLine("type 1, 2 or 3")
Console.WriteLine("1 : create a new account")
Console.WriteLine("2: log in ")
Console.WriteLine("3 : quit program")
Dim choice As String
choice = Console.ReadLine()
If choice = "1" Then
Create()
ElseIf choice = "2" Then
Login()
ElseIf choice = "3" Then
Console.WriteLine("quitting...")
Environment.Exit(0)
End If
End Sub
Private Sub Create()
Dim veri As Boolean 'Default value is False, value types initialize automatically
Dim attempts As Integer
Dim newname As String = ""
Dim passw As String = ""
Do Until veri = True
Console.WriteLine("enter a new username")
newname = Console.ReadLine()
If LoginDict.ContainsKey(newname) Then 'Searches the Keys in the Dictionary and returns True or False
Console.WriteLine("that username is already taken, try again")
attempts += 1 'new syntax for updating the value of a variable, saves a bit of typing
Else
veri = True
End If
If attempts > 4 Then
Console.WriteLine("you have had more than 3 tries, BYE")
Console.Clear()
Environment.Exit(0) 'To end the application
End If
Loop
veri = False 'You can use the same variable just reset its value
While veri = False
Console.WriteLine("create a password " & newname)
passw = Console.ReadLine
Dim passwlen = passw.Length 'Don't use the old VB6 Len
If passwlen > 12 Then
LoginDict.Add(newname, passw) 'Here is where the new user is added to the Dictionary
veri = True
Else
Console.WriteLine("try again, password must be greater than 12 characters")
End If
End While
Console.WriteLine("your new username and password have been stored")
Console.WriteLine("succes, you have made an account your username :" & newname & " and password: " & passw)
File.AppendAllLines(LoginPath, {$"{newname},{passw}"}) 'Adds the new user to the text file
End Sub
Private Sub Login()
Dim unamever As String = ""
Dim passwvari As String = ""
Dim veri As Boolean 'You don't need a different name for a variable in a another method.
While veri = False
Console.WriteLine("please enter you username")
unamever = Console.ReadLine()
If LoginDict.ContainsKey(unamever) Then 'Searches the Keys in the Dictionary and returns True or False
passwvari = LoginDict(unamever) 'Gets the value associated with the username
Console.WriteLine("please enter your password : ")
If passwvari = Console.ReadLine Then 'Compares the value found in the Dictionary to the string entered by the user.
Console.WriteLine("logging you in...")
veri = True
Else
Console.WriteLine("password incorrect, try again")
End If
Else
Console.WriteLine("username not registered, try again")
End If
End While
End Sub
Private Sub ReadLoginFileAndFillDictionary()
If File.Exists(LoginPath) Then
Dim lines = File.ReadAllLines(LoginPath) 'Read the file into an array of lines
For Each line In lines
Dim splits = line.Split(","c) 'Split each line by the comma into an array of 2 strings
LoginDict.Add(splits(0), splits(1)) 'The first element is the username and the second element is the password.
Next
Else
Console.WriteLine("There are currently no registered users. Please begin with Option 1.")
End If
End Sub
In a real application you would NEVER store passwords as plain text.
I have a form in where users need to input integers to save to an xml when they press a button
the issue lies that when the user does not put in valid input, it displays the error but still attempts to declare the variables for my function and then crashes - how do i stop this?
here's my code:
If IsNumeric(txtLevel.Text) And IsNumeric(txtHealth.Text) Then
MsgBox("choose a location to save in")
ElseIf String.IsNullOrWhiteSpace(txtHealth.Text) Or String.IsNullOrWhiteSpace(txtLevel.Text) Then
MsgBox("you have not filled in all fields")
Me.Close()
Else MsgBox("please input number form")
End If
Dim strName As String = txtCharacter.Text
Dim intLevel As Integer = txtLevel.Text
Dim intHealth As Integer = txtHealth.Text
Dim strStat As String = cmbStat.Text
You are using quite a few legacy features and you also have Option Strict turned off.
IsNumeric should be replaced with Integer.TryParse: https://learn.microsoft.com/en-us/dotnet/api/system.int32.tryparse
MsgBox should be replaced with MessageBox: https://learn.microsoft.com/en-us/dotnet/api/system.windows.forms.messagebox
For more information on option strict, I suggest you check out any of these resources:
https://learn.microsoft.com/en-us/dotnet/visual-basic/language-reference/statements/option-strict-statement
https://www.vblessons.com/lessons.html#/1/2
http://vb.net-informations.com/language/vb.net_option_strict.htm
With that being said, your code could look like this:
Dim strName As String = txtCharacter.Text
Dim strStat As String = cmbStat.Text
Dim intLevel, intHealth As Integer
' if either condition is true, close the form prematurely
If (String.IsNullOrWhitespace(txtLevel.Text) OrElse String.IsNullOrWhitespace(txtHealth.Text)) Then
MessageBox.Show("You have not filled in all fields.", "Invalid Form")
Me.Close()
ElseIf (Not Integer.TryParse(txtLevel.Text, intLevel) OrElse Not Integer.TryParse(txtHealth.Text, intHealth)) Then
MessageBox.Show("Please input number form.", "Invalid Form")
Me.Close()
End If
' continue on with the code
Move your variable declaration inside your "If IsNumeric(txtLevel.Text) And IsNumeric(txtHealth.Text) Then" so its only going to try to assign them the value if both txtLevel and txtHealth are integers.
I would suggest you to change the code like so:
'Checks if the textboxes are not empty
If Not String.IsNullOrWhiteSpace(txtHealth.Text) Or String.IsNullOrWhiteSpace(txtLevel.Text) Then
'They are not empty, so the program checks if they are integers
If IsNumeric(txtLevel.Text) And IsNumeric(txtHealth.Text) Then
'The input is integer
Dim strName As String = txtCharacter.Text
Dim intLevel As Integer = txtLevel.Text
Dim intHealth As Integer = txtHealth.Text
Dim strStat As String = cmbStat.Text
MsgBox("choose a location to save in")
Else
'The input is not integer
MsgBox("Value is not an integer")
End If
Else
'A textbox is empty
MsgBox("you have not filled in all fields")
Me.Close()
End If
you can try with TryParse to be sure of integer value without error :
Dim intLevel As Integer
Dim intHealth As Integer
If (Integer.TryParse(txtLevel.Text, intLevel)) And (Integer.TryParse(txtHealth.Text, intHealth)) Then
MsgBox("choose a location to save in")
ElseIf String.IsNullOrWhiteSpace(txtHealth.Text) Or String.IsNullOrWhiteSpace(txtLevel.Text) Then
MsgBox("you have not filled in all fields")
Me.Close()
Else MsgBox("please input number form")
End If
Dim strName As String = txtCharacter.Text
Dim strStat As String = cmbStat.Text
find more about it on : Int32.TryParse Method
I try to run this program but an error always appears:
Conversion from the string "LBLBuku" to type' Double 'is not valid.
If LBLBuku.Text >= 5 Or Val(LBLBuku.Text) + Val(TextBox1.Text) > 5 Then
MsgBox("Peminjaman Melebihi")
Else
If lbljudul.Text = "" Or TextBox1.Text = "" Then
MsgBox("Silahkan isi Kode Buku")
Else
DataGridView1.Rows.Add(New String() {TextBox2.Text, lbljudul.Text, LBLPengarang.Text, LBLTahun.Text, TextBox2.Text})
TextBox1.Text = ""
TextBox2.Text = ""
lbljudul.Text = ""
TextBox2.Text = ""
LBLPengarang.Text = ""
LBLTahun.Text = ""
Call rumustotalbuku()
End If
End If
Notice on your code the line
LBLBuku.Text >= 5
The property Text is of type String, you would have to convert the text to an integer type first before you can use ">=".
First I declare a variable to hold the integer value in the Text Box. Integer.TryParse will return true if it can convert the string in the text box to an integer. It will also fill the variable intTB1 with the number.
I am assuming that LBLBuku is a label so the .Text property has been set from code. We can depend on this being a number so all we need to do is the conversion with CInt(). We can use the variable we got from the .TryParse in the Or CInt(LBLBuku.Text) + intTB1 > 5 instead of referring to the text box again.
We don't need to check if TextBox1 is empty because it wouldn't have passed the .TryParse if it was.
Last and probably least, you don't need the Call keyword in most situations.
You do realize that you have added TextBox2 twice to the new DataRow.
Private Sub OPCode()
Dim intTB1 As Integer
If Not Integer.TryParse(TextBox1.Text, intTB1) Then
MessageBox.Show("Please enter a number in TextBox1.")
Return
End If
If CInt(LBLBuku.Text) >= 5 Or CInt(LBLBuku.Text) + intTB1 > 5 Then
MsgBox("Peminjaman Melebihi Maksimal")
Else
If lbljudul.Text = "" Then
MsgBox("Silahkan isi Kode Buku")
Else
DataGridView1.Rows.Add(New String() {TextBox2.Text, lbljudul.Text, LBLPengarang.Text, LBLTahun.Text, TextBox2.Text})
TextBox1.Text = ""
TextBox2.Text = ""
bljudul.Text = ""
TextBox2.Text = ""
LBLPengarang.Text = ""
LBLTahun.Text = ""
rumustotalbuku()
End If
End If
End Sub
In the code I am posting, I am using a check box called "ACDS Test" and whenever it is checked it creates a sheet, then when it becomes unchecked it calls the upper function and deletes the sheet.
I am trying to add a message box that essentially works like a fail safe to ensure they want to delete the page. If they say they do not want to delete the page then I want the checkbox to stay checked.
For some reason I am getting this error message when I try to pass the value to make sure the checkbox stays checked and I cannot figure out why.
The error comes up on the line:
Sub ACDSTest_Click(CorrectValue As Integer)
And the specific error is: "Compile error: Procedure Declaration does not match description of event or procedure having the same name".
Any help is much appreciated! IF any more clarification is needed please feel free to ask!
Sub DeleteWorksheet(NameSheet As String)
Dim Ans As Long
Dim t As String
Dim CorrectValue As Integer
Dim i As Long, k As Long
k = Sheets.Count
Ans = MsgBox("Would you like to take this test off of the form?", vbYesNo)
Select Case Ans
Case vbYes
'Code reads through each page and finds one with corresponding name to string t
'Once it finds the correct page, it deletes it
For i = k To 1 Step -1
t = Sheets(i).Name
If t = NameSheet Then
Sheets(i).Delete
End If
Next i
CorrectValue = 0
Case vbNo
CorrectValue = 1
End Select
End Sub
Sub ACDSTest_Click(CorrectValue As Integer)
Dim NameSheet As String
Dim NameValue As String
NameSheet = "ACDS"
NameValue = "ACDS Test"
If ACDSTest.Value = True Then
CreateWorksheet (NameSheet), (NameValue)
Worksheets("Sheet1").Activate
Else
DeleteWorksheet (NameSheet)
If CorrectValue = 1 Then
ActiveSheet.Shapes("ACDS Test").ControlFormat.Value = 1
End If
End If
End Sub
The issue here is that the CorrectValue variable as you define it in DeleteWorksheet does not exist in the context of the
variable does not exist in context of the ACDSTest_Click subroutine. This is because variables defined within subroutines or functions are local to those functions. To correct this I would convert DeleteWorksheet to a function such as the below.
Further, the event that fires Private Sub ACDSTest_Click() cannot handle passing a value to that function, so changing it to Sub ACDSTest_Click(CorrectValue As Integer) causes an error.
Function DeleteWorksheet(ByVal SheetName As String) As Boolean
On Error GoTo SheetDNE
SheetName = Sheets(SheetName).Name 'Check if sheet exists w/o other objects
On Error GoTo 0
Select Case MsgBox("Would you like to take this test off of the form?", vbYesNo)
Case vbYes
Application.DisplayAlerts = False
Sheets(SheetName).Delete
Application.DisplayAlerts = True
DeleteWorksheet = True
Case Else: DeleteWorksheet = False
End Select
Exit Function 'Exit The Function w/o error
SheetDNE: 'Sheet Does Not Exist
MsgBox "The indicated sheet, " & SheetName & ", does not exist", vbOKOnly
End Function
And
Private Sub ACDSTest_Click()
Dim NameSheet As String
Dim NameValue As String
NameSheet = "ACDS"
NameValue = "ACDS Test"
If ACDSTest.Value = True Then
CreateWorksheet (NameSheet), (NameValue)
Worksheets("Sheet1").Activate
Else
If Not DeleteWorksheet(NameSheet) Then _
ActiveSheet.Shapes("ACDS Test").ControlFormat.Value = 1
End If
End Sub
I was actually working an Attendance System, using listbox i want to monitor whether "employees" timed in or out.
txtEmpNum.text as my textbox,
rdTin as my radio button for time in,
rdTout as my radio button for time out,
lblName, lblDept, lblinout are just label. I want that if a user already timed in his/her name wont appear on my listbox rather msgbox pop up. But on this code although msgbox poped up, still the name of the employee appears on my listbox.
If txtEmpNum.Text = 8888 Then
If rdTin.Checked = True Then
For i As Integer = 0 To listEmp.Items.Count - 1
If (listEmp.Items(i).ToString.Contains("Bane Lim")) Then
MsgBox("String found at " & (i + 1).ToString)
Exit For
End If
Next
lblName.Text = "Bane"
lblDept.Text = "Admin"
lblinout.Text = "In"
listEmp.Items.Add("Bane Lim")
txtEmpNum.Clear()
ElseIf rdTout.Checked = True Then
lblName.Text = "Bane"
lblDept.Text = "Admin"
lblinout.Text = "Out"
listEmp.Items.Remove("Bane Lim")
txtEmpNum.Clear()
End If
Is the problem that the name is appearing a second time? You'll want to Exit Sub or Exit Function rather than Exit For. Exit For is kicking it from the loop but continuing with the remaining code (to add again).
Otherwise add a flag in there like:
If txtEmpNum.Text = 8888 Then
If rdTin.Checked = True Then
Dim bolFound As Boolean = False
For i As Integer = 0 To listEmp.Items.Count - 1
If (listEmp.Items(i).ToString.Contains("Bane Lim")) Then
MsgBox("String found at " & (i + 1).ToString)
bolFound = True
Exit For
End If
Next
If Not bolFound Then
lblName.Text = "Bane"
lblDept.Text = "Admin"
lblinout.Text = "In"
listEmp.Items.Add("Bane Lim")
txtEmpNum.Clear()
End If
ElseIf rdTout.Checked = True Then
lblName.Text = "Bane"
lblDept.Text = "Admin"
lblinout.Text = "Out"
listEmp.Items.Remove("Bane Lim")
txtEmpNum.Clear()
End If