I am running a vb.net query into LDAP. I pull back the homedirectory. How can i write an IF statement to popup a msgbox if the homedirectory is empty versus the error "Object reference not set to an instance of an object."
code is below:
Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
If TextBox2.Text = "" Then
MsgBox("Please enter a Network ID")
TextBox2.Focus()
Exit Sub
End If
Dim yourUserName As String = TextBox2.Text
Dim ADSearch As New DirectorySearcher()
Dim de As DirectoryEntry = GetDirectoryEntry()
ADSearch.SearchRoot = de
ADSearch.Filter = "(sAMAccountName=" & yourUserName & ")"
'ADSearch.PropertiesToLoad.Add("homedirectory")
Dim ADResult As SearchResult = ADSearch.FindOne()
If ADResult Is Nothing Then
MsgBox("User not found, please try again", MsgBoxStyle.OkOnly, "Not Found")
TextBox2.Text = ""
TextBox2.Focus()
Exit Sub
Else
Dim ADEntry As DirectoryEntry = New DirectoryEntry(ADResult.Path)
TextBox1.Text = (ADEntry.Properties("homeDirectory").Value.ToString)
End If
End Sub
You need to perform very basic null checking!
' if the "homeDirectory" hasn't been set -> then it will not show up in the SearchResult
If ADEntry.Properties("homeDirectory") Is Nothing Then
' do something
Else
If ADEntry.Properties("homeDirectory").Value Is Nothing Then
' do something
Else
' access your property here
TextBox1.Text = (ADEntry.Properties("homeDirectory").Value.ToString)
End If
End If
Related
The code below works as intended in DEBUG with no errors. I input my search parameters, the record returns and populates all textboxes and loads the PDF file into the AxAcroPDF1 viewer.
However, after I compile and install the program I am receiving the error "Access to the path 'C:\Program Files (x86)\NAME OF PROGRAM\temp.file' is denied'
This only occurs when I search for a record and the PDF (in Binary format in the DB) to that record is supposed to load fails with the error message listed above. How can I resolve the permissions level (assuming this is the issue) to allow for the PDF to load? The area of concern presumably and more specifically is the LoadPDF() sub.
My code is as follows:
Imports System.Data.SqlClient
Public Class LoadDocs
Private DV As DataView
Private currentRow As String
Private Sub LoadDocs_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'TODO: This line of code loads data into the 'DocDataset.Documents_Table' table. You can move, or remove it, as needed.
Documents_TableTableAdapter.Fill(DocDataset.Documents_Table)
'Loads last record on to form
DocumentsTableBindingSource.Position = DocDataset.Documents_Table.Rows.Count - 1
DV = New DataView(DocDataset.Documents_Table)
'LoadPDF()
End Sub
Private Sub BtnOpenPDF_Click(sender As Object, e As EventArgs) Handles btnOpenPDF.Click
tbRecNumb.Clear()
tbFileName.Clear()
tbPetsLoadNumber.Clear()
tbBrokerLoadNumber.Clear()
tbFilePath.Clear()
Dim CurYear As String = CType(Now.Year(), String)
On Error Resume Next
OpenFileDialog1.Filter = "PDF Files(*.pdf)|*.pdf"
OpenFileDialog1.ShowDialog()
AxAcroPDF1.src = OpenFileDialog1.FileName
tbFilePath.Text = OpenFileDialog1.FileName
Dim filename As String = tbFilePath.Text.ToString
tbFileName.Text = filename.Substring(Math.Max(0, filename.Length - 18))
Dim loadnumber As String = tbFileName.Text
tbPetsLoadNumber.Text = loadnumber.Substring(7, 7)
End Sub
' Search for PETS Load Number, Broker Load Numberthen load record if found
Private Sub BtnSearchBtn_MouseEnter(sender As Object, e As EventArgs) Handles btnSearch.MouseEnter
Cursor = Cursors.Hand
btnSearch.BackgroundImage = My.Resources.ButtonDwn_Teal_Trans
End Sub
Private Sub BtnSearchBtn_MouseLeave(sender As Object, e As EventArgs) Handles btnSearch.MouseLeave
Cursor = Cursors.Default
btnSearch.BackgroundImage = My.Resources.Button_Teal_Trans
End Sub
Private Sub TbSearchInput_KeyDown(sender As Object, e As KeyEventArgs) Handles tbSearchInput.KeyDown
Cursor = Cursors.Hand
If e.KeyCode = Keys.Enter Then
Search()
End If
End Sub
Private Sub BtnSearch_Click(sender As Object, e As EventArgs) Handles btnSearch.Click
btnSearch.BackgroundImage = My.Resources.ButtonClk_Teal_Trans
Cursor = Cursors.Hand
Search()
End Sub
Private Sub Search()
Cursor = Cursors.WaitCursor
If cbColName.Text = "SEARCH BY:" Then
MeMsgBoxSearchCriteria.ShowDialog()
Else : lblSearchResults.Items.Clear()
Select Case DocDataset.Documents_Table.Columns(cbColName.Text).DataType
Case GetType(Integer)
DV.RowFilter = cbColName.Text & " = " & tbSearchInput.Text.Trim
Case GetType(Date)
DV.RowFilter = cbColName.Text & " = #" & tbSearchInput.Text.Trim & "#"
Case Else
DV.RowFilter = cbColName.Text & " LIKE '*" & tbSearchInput.Text.Trim & "*'"
End Select
If DV.Count > 0 Then
For IX As Integer = 0 To DV.Count - 1
lblSearchResults.Items.Add(DV.Item(IX)("PETS_LOAD_NUMBER"))
Next
If DV.Count = 1 Then
lblSearchResults.SelectedIndex = 0
Dim ix As Integer = DocumentsTableBindingSource.Find("PETS_LOAD_NUMBER", CInt(lblSearchResults.SelectedItem.ToString))
DocumentsTableBindingSource.Position = ix
LoadPDF()
Else
lblSearchResults.Visible = True
lblSearchResults.BringToFront()
End If
Else
' Display a message box notifying users the record cannot be found.
MeMsgBoxNoSearch.ShowDialog()
End If
End If
Cursor = Cursors.Default
End Sub
Private Sub LblSearchResults_SelectedIndexChanged(sender As Object, e As EventArgs) Handles lblSearchResults.SelectedIndexChanged
Dim ix As Integer = DocumentsTableBindingSource.Find("PETS_LOAD_NUMBER", CInt(lblSearchResults.SelectedItem.ToString))
DocumentsTableBindingSource.Position = ix
lblSearchResults.Visible = False
End Sub
Private Sub LoadPDF()
Dim temp = Environment.GetEnvironmentVariable("TEMP", EnvironmentVariableTarget.User)
If File.Exists(Application.StartupPath() & "\temp.file") = True Then
AxAcroPDF1.src = "blank.pdf"
My.Computer.FileSystem.DeleteFile(Application.StartupPath() & "\temp.file")
End If
Dim cmd As New SqlCommand
cmd.CommandText = "SELECT DOCUMENTS FROM Documents_Table WHERE PETS_LOAD_NUMBER = #pl"
cmd.Parameters.AddWithValue("#pl", tbPetsLoadNumber.Text)
cmd.CommandType = CommandType.Text
cmd.Connection = New SqlConnection With {
.ConnectionString = My.MySettings.Default.PETS_DatabaseConnectionString
}
Dim Buffer As Byte()
cmd.Connection.Open()
Buffer = cmd.ExecuteScalar
cmd.Connection.Close()
File.WriteAllBytes(Application.StartupPath() & "\temp.file", Buffer)
'DATA READER
AxAcroPDF1.src = Application.StartupPath() & "\temp.file"
End Sub
Private Sub DocumentsTableBindingSource_PositionChanged(sender As Object, e As EventArgs) Handles DocumentsTableBindingSource.PositionChanged
Try
currentRow = DocDataset.Documents_Table.Item(DocumentsTableBindingSource.Position).ToString
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub
Private Sub BtnSavePDF_Click(sender As Object, e As EventArgs) Handles btnSavePDF.Click
If tbPetsLoadNumber.Text.Length = 0 Then
MessageBox.Show("Please enter a PETS Load Number", "Missing Load Number", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
ElseIf tbBrokerLoadNumber.Text.Length = 0 Then
MessageBox.Show("Please enter a Broker Load Number", "Missing Load Number", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
ElseIf tbFileName.Text.Length = 0 Then
MessageBox.Show("Please enter a Filename", "Missing Filename", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
End If
Try
Using OpenFileDialog As OpenFileDialog = OpenFileDialog1()
If (OpenFileDialog.ShowDialog(Me) = DialogResult.OK) Then
tbFilePath.Text = OpenFileDialog.FileName
Else 'Cancel
Exit Sub
End If
End Using
'Call Upload Images Or File
Dim sFileToUpload As String = ""
sFileToUpload = LTrim(RTrim(tbFilePath.Text))
'Initialize byte array with a null value initially.
Dim data As Byte() = Nothing
'Use FileInfo object to get file size.
Dim fInfo As New FileInfo(tbFilePath.Text)
Dim numBytes As Long = fInfo.Length
'Open FileStream to read file
Dim fStream As New FileStream(tbFilePath.Text, FileMode.Open, FileAccess.Read)
'Use BinaryReader to read file stream into byte array.
Dim br As New BinaryReader(fStream)
'Supply number of bytes to read from file.
'In this case we want to read entire file. So supplying total number of bytes.
data = br.ReadBytes(CInt(numBytes))
'Insert the details into the database
Dim cmd As New SqlCommand
cmd.CommandText = "INSERT INTO Documents_Table (BROKER_LOAD_NUMBER, PDF_FILENAME, PETS_LOAD_NUMBER, DOCUMENTS)
VALUES (#bl, #fn, #pl, #pdf)"
cmd.Parameters.Add("#fn", SqlDbType.NVarChar, 50).Value = tbFileName.Text
cmd.Parameters.Add("#pl", SqlDbType.Int).Value = tbPetsLoadNumber.Text
cmd.Parameters.Add("#bl", SqlDbType.NVarChar, 20).Value = tbBrokerLoadNumber.Text
cmd.Parameters.Add("#pdf", SqlDbType.VarBinary, -1).Value = data
cmd.CommandType = CommandType.Text
cmd.Connection = New SqlConnection With {
.ConnectionString = My.MySettings.Default.PETS_DatabaseConnectionString
}
cmd.Connection.Open()
cmd.ExecuteNonQuery()
cmd.Connection.Close()
MsgBox("File Successfully Imported to Database")
Catch ex As Exception
MessageBox.Show(ex.ToString())
End Try
End Sub
End Class
In your function LoadPDF you create a reference to tempdir and then don't use it. Instead, you use Application.StartupPath() which will point to C:\Programs(x86) and is usually not writeable without admin rights.
But why don't you use your temp dir:
Dim temp = SpecialDirectories.Temp 'more robust approach to get tempdir
If File.Exists(temp & "\temp.file") = True Then
AxAcroPDF1.src = "blank.pdf"
My.Computer.FileSystem.DeleteFile(temp & "\temp.file")
End If
...
File.WriteAllBytes(temp & "\temp.file", Buffer)
'DATA READER
AxAcroPDF1.src = temp & "\temp.file"
Trying to autologin to a web site using a vb.net form application. I do not receive any exceptions or errors. I Navigate to my page, set the email and password attributes and then click the 'cmd' button on the webpage. Using Debug statements I have verified the attributes are set.
After I click the 'cmd' button on the webpage I get back the same page I started with and cannot find anything that tells me there was an exception or error.
I am able to login to the webpage using chrome or IE using the same email/password combination.
Here is my code.
Private mPageReady As Boolean = False
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
AddHandler Me.WebBrowser1.DocumentCompleted, New WebBrowserDocumentCompletedEventHandler(AddressOf PageWaiter)
End Sub
Public Function LoginUser(pEmailAddress As String, pPassword As String) As Boolean
Dim IsOkay As Boolean = False
Dim myURL As String = "https://login.wlpc.com/index.php/"
Me.WebBrowser1.Navigate(myURL)
WaitForPageLoad()
Debug.WriteLine("After Navigate: " & Me.WebBrowser1.DocumentText)
Try
Me.WebBrowser1.Document.GetElementById("email").SetAttribute("value", pEmailAddress)
Debug.WriteLine("After assignment of email: " & Me.WebBrowser1.Document.GetElementById("email").GetAttribute("value"))
Me.WebBrowser1.Document.GetElementById("password").SetAttribute("value", pPassword)
Debug.WriteLine("After assignment of password: " & Me.WebBrowser1.Document.GetElementById("password").GetAttribute("value"))
Dim myDoc As HtmlDocument = Me.WebBrowser1.Document
Dim myCmd As HtmlElement = myDoc.All("cmd")
myCmd.InvokeMember("click")
WaitForPageLoad()
Debug.WriteLine("After click: " & Me.WebBrowser1.DocumentText)
IsOkay = True
Catch ex As Exception
IsOkay = False
End Try
Return IsOkay
End Function
Public Function GetPage(URL As String) As String
Debug.WriteLine(String.Format("Accessing {0}", URL))
Me.WebBrowser1.Navigate(URL)
WaitForPageLoad()
Dim pagedata As String = Me.WebBrowser1.DocumentText
Return pagedata
End Function
Public Sub WaitForPageLoad()
While Not mPageReady
Application.DoEvents()
End While
mPageReady = False
End Sub
Private Sub PageWaiter(ByVal sender As Object, ByVal e As WebBrowserDocumentCompletedEventArgs)
If Me.WebBrowser1.ReadyState = WebBrowserReadyState.Complete Then
mPageReady = True
End If
End Sub
Private Sub BtnSignin_Click(sender As Object, e As EventArgs) Handles BtnSignin.Click
LoginUser(mEmailAddress, mPassword)
End Sub
After further testing and a correction to my new code, I was able to complete the login process. Here is the code with a bunch of 'debug.writeline' statements.
Private Sub BtnSignIn_Click(sender As Object, e As EventArgs) Handles BtnSignIn.Click
Dim myURL As String = "https://login.wlpc.com/index.php/"
AddHandler Me.WebBrowser1.DocumentCompleted, New WebBrowserDocumentCompletedEventHandler(AddressOf WebBrowserDocumentCompleted)
Me.WebBrowser1.Navigate(myURL)
End Sub
Private Sub WebBrowserDocumentCompleted(ByVal sender As Object, ByVal e As WebBrowserDocumentCompletedEventArgs)
If Me.WebBrowser1.ReadyState <> WebBrowserReadyState.Complete Then
Debug.WriteLine(Me.WebBrowser1.ReadyState.ToString)
Return
End If
Try
Const lEmailAddress As String = "TestEmail#somewhere.com"
Const lThisPassword As String = "SimplePassword"
' get the form: <form action="/index.php" method="POST" name="login">
Dim lFormHtmlElement As HtmlElement = Nothing ' the form element
Dim lFormFound As Boolean ' can we find the form?
For Each lFormHtmlElement In WebBrowser1.Document.Forms()
If lFormHtmlElement.Name = "login" Then
lFormFound = True
Exit For
End If
Next
If Not lFormFound Then
Debug.WriteLine("Can't find form")
Exit Sub
End If
'<input type="email" name="email" value="" tabindex="1" placeholder="name#example.com">
Dim lEmail As HtmlElement = lFormHtmlElement.Document.GetElementById("email")
If IsNothing(lEmail) Then
Debug.WriteLine("lEmail element is nothing")
Exit Sub
Else
Debug.WriteLine("lEmail element was found")
End If
If IsNothing(lEmail.GetAttribute("value")) Then
Debug.WriteLine("lEmail attribute value is nothing before set")
Else
Debug.WriteLine("lEmail attribute value is contains '" & lEmail.GetAttribute("value") & "' before set")
End If
lEmail.SetAttribute("value", lEmailAddress)
If IsNothing(lEmail.GetAttribute("value")) Then
Debug.WriteLine("lEmail value is nothing after set")
ElseIf lEmail.GetAttribute("value") = lEmailAddress Then
Debug.WriteLine("lEmail set to: '" & lEmail.GetAttribute("value") & "'")
End If
'<input type="password" name="password" id="password1" size="25" tabindex="2">
Dim lPassword As HtmlElement = lFormHtmlElement.Document.GetElementById("password")
Dim lPassword1 As HtmlElement = lFormHtmlElement.Document.GetElementById("password1")
If IsNothing(lPassword) Then
Debug.WriteLine("lPassword element is nothing")
Exit Sub
Else
Debug.WriteLine("lPassword element was found")
End If
If IsNothing(lPassword1) Then
Debug.WriteLine("lPassword1 element is nothing")
Exit Sub
Else
Debug.WriteLine("lPassword1 element was found")
End If
If lPassword.Document.Body.InnerText = lPassword1.Document.Body.InnerText Then
Debug.WriteLine("lPassword and lPassword1 same body innertext")
Else
Debug.WriteLine("lPassword and lPassword1 have different body innertext")
End If
If IsNothing(lPassword.GetAttribute("value")) Then
Debug.WriteLine("lPassword attribute value is nothing before set")
Else
Debug.WriteLine("lPassword attribute value is contains '" & lPassword.GetAttribute("value") & "' before set")
End If
If IsNothing(lPassword1.GetAttribute("value")) Then
Debug.WriteLine("lPassword1 attribute value is nothing before set")
Else
Debug.WriteLine("lPassword1 attribute value is contains '" & lPassword1.GetAttribute("value") & "' before set")
End If
lPassword.SetAttribute("value", lThisPassword)
If IsNothing(lPassword.GetAttribute("value")) Then
Debug.WriteLine("lPassword attribute value is nothing after set")
Exit Sub
ElseIf lPassword.GetAttribute("value") = lThisPassword Then
Debug.WriteLine("lPassword set to: '" & lPassword.GetAttribute("value") & "'")
End If
If IsNothing(lPassword1.GetAttribute("value")) Then
Debug.WriteLine("lPassword1 is nothing")
ElseIf lPassword1.GetAttribute("value") = lThisPassword Then
Debug.WriteLine("lPassword1 attribute value is same password value as lPassword attribute value")
End If
'<button type="submit" name="cmd" value="cred_set" tabindex="3">
Dim lCmdButton As HtmlElement = lFormHtmlElement.Document.GetElementById("cmd")
If IsNothing(lCmdButton) Then
Debug.WriteLine("lCmdButton element is nothing")
Else
Debug.WriteLine("lCmdButton element was found")
' found the 'cmd' button so click it
lCmdButton.InvokeMember("click")
End If
Catch ex As Exception
Debug.WriteLine("exception: " & ex.Message)
Finally
RemoveHandler Me.WebBrowser1.DocumentCompleted, AddressOf WebBrowserDocumentCompleted
End Try
End Sub
Hi, I'm creating a downloader by halving it in steps so that each part works logically.
The code is divided into:
public class Form1
Public Shared link As String 'I'm sharing data with another form
I insert a url to download in the textchanged event of textbox:
If (My.Settings.Cartellasalvataggio = "") Then
Label2.Text = "Download folder is missing"
' MsgBox("manca destinazione")
Else
If Clipboard.GetText.Contains("youtube") = False Then
Label2.Text = "not a valid youtube link"
Else
If TextBox1.Text = Clipboard.GetText Then
Label2.Text = "you already use it"
Else
TextBox1.Text = Clipboard.GetText
WebBrowser1.Navigate("https://www.320youtube.com/v8/watch?v=" +
_TextBox1.Text.Replace("https://www.youtube.com/watch?v=", ""))
End If
End If
End If
Then, in the document completed event I extract the download link:
Private Sub WebBrowser1_DocumentCompleted(sender As Object, e As WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted
Dim collection As HtmlElementCollection = WebBrowser1.Document.All
Dim a As String
For Each element As HtmlElement In collection
If element.TagName = "A" Then
a = element.GetAttribute("HREF")
If a.Length > 70 Then
a.ToString.Replace(" - YouTube", "")
link = a
If link IsNot Nothing Then
Title()
End If
End If
End If
Next
End Sub
If the link variable is not empty then I activate the sub title:
Private Sub Title()
Dim wctitolo As New WebClient()
wctitolo.Encoding = Encoding.UTF8
Dim source As String = wctitolo.DownloadString(TextBox1.Text.Replace(" - YouTube", ""))
Dim title As String = Regex.Match(source, "\<title\b[^>]*\>\s*(?<Title>[\s\S]*?)\</title\>", RegexOptions.IgnoreCase).Groups("Title").Value
Dim a As String = title.Replace(" - YouTube", "")
Dim webdecode As String = WebUtility.HtmlDecode(a)
My.Settings.Titolo = String.Join("-", webdecode.Split(IO.Path.GetInvalidFileNameChars))
Label2.Text = "Getting title..- Step 3/4"
Label1.Text = My.Settings.Titolo
RichTextBox1.AppendText(vbLf + My.Settings.Titolo + Environment.NewLine)
formcs.BetterListBox1.Items.Add(My.Settings.Titolo)
My.Settings.Save()
If Fileexist() Then
Else
If My.Settings.Titolo IsNot Nothing Then
Download()
End If
End If
and sub FileExists () which returns true if the file exists and false if it does not exist. If it does not exist then, as dictated in private sub Title (), I activate the private sub Download ().
Public Function Fileexist() As Boolean
Label3.Text = Label3.Text + "Fileesiste+ "
Dim result As Boolean
Dim cartella = My.Settings.Cartellasalvataggio
Dim filedidestinazione = Directory.GetFiles(cartella,
My.Settings.Titolo + ".mp3",
SearchOption.AllDirectories).FirstOrDefault()
If filedidestinazione IsNot Nothing Then
Dim answer As String
answer = CType(MsgBox("File exist in" + vbLf + My.Settings.Cartellasalvataggio + "\" + My.Settings.Titolo + ".mp3" + vbLf + "Would you like to open the folder?", vbYesNo), String)
If CType(answer, Global.Microsoft.VisualBasic.MsgBoxResult) = vbYes Then
Process.Start("explorer.exe", "/select," & filedidestinazione)
result = True
Else
result = False
answer = CType(vbNo, String)
Label2.Text = "File exist"
End If
End If
Return result
End Function
and at the end, the Download sub:
Public WithEvents mclient As New WebClient
Private Sub mClient_DownloadProgressChanged(sender As Object, e As DownloadProgressChangedEventArgs) Handles mclient.DownloadProgressChanged
Try
Label4.Text = (Val(e.BytesReceived) / 1048576).ToString("0.00") & "MB Scaricati"
Label2.Text = "Download di " + My.Settings.Titolo + " in corso.."
Catch ex As Exception
End Try
End Sub
Private Sub Download()
Label3.Text = Label3.Text + "Download+ "
Dim filepath As String = (My.Settings.Cartellasalvataggio + "\" + Label1.Text + ".mp3")
mclient.Encoding = Encoding.UTF8
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
mclient.Headers.Add(HttpRequestHeader.UserAgent, "")
mclient.DownloadFileAsync(New Uri(link), filepath)
End Sub
I thought everything was fine, but at runtime I get an error for stackoverflow ..
The "Settings.Designer.vb" tab opens with the error
System.StackOverflowException in
<Global.System.Configuration.UserScopedSettingAttribute(), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Configuration.DefaultSettingValueAttribute("")> _
Public Property Titolo() As String
Get
Return CType(Me("Titolo"),String)
End Get
Set
Me("Titolo") = value
End Set
End Property
is there an easy way I can concatenate these pieces of code in such a way that they work in a logical step by step without modifying to much the code?
Thank you
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim FILE_NAME As String = Cashierpath
System.IO.File.Exists(FILE_NAME) ' current
Dim objReader As StreamReader
Dim user As String = TextBox1.Text
Dim password As String = TextBox2.Text
Dim check As String
'Global Variable
'Dim DirPath7 As String = System.IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments), "Scrap Data\Cashier Info\Cashiers\")
For Each filename As String In IO.Directory.EnumerateFiles(DirPath7, "*.txt")
Dim fName As String = IO.Path.GetFileName(filename)
If user = fName & ".txt" Then
objReader = New StreamReader(fName)
check = objReader.ReadToEnd()
If password = check Then
MessageBox.Show("Welcome " & user & "!")
Close()
My.Forms.Home.Show()
Else
MessageBox.Show("Username or Password is incorrect")
End If
End If
Next
End Sub
When the user enters their "username" and "password" into the textbox's, and clicks on this button, i want this button to check if there is a textfile with the name of the username entered, and if theres a file with that username it must then read it and check if the password matches the string inside the file. if it doesnt match it, it must then display a messagebox saying that "Username or password is incorrect", but nothing happens when i click on this button. No error message appears either.
Can someone take a look at my code and tell me what im doing wrong?
What you have there is an awful way to handle user credentials!
Read this for more information: Salted Password Hashing - Doing it Right
Regardless, you're way over-coding it.
Elsewhere in your app (correct use of Combine):
' Global Variable
Friend Shared DirPath7 As String = IO.Path.Combine(My.Computer.FileSystem.SpecialDirectories.MyDocuments, "Scrap Data", "Cashier Info", "Cashiers")
Button Handler:
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim User As String = TextBox1.Text.Trim
Dim Pass As String = TextBox2.Text.Trim
' Assemble the full expected file path, even if it might be malformed.
' The first case check protects against malformed path.
Dim FilePath As String = IO.Path.Combine(DirPath7, String.Format("{0}.txt", User))
Select Case True
Case User.Length = 0
MsgBox("Username is empty", vbExclamation, "Error")
Case Pass.Length = 0
MsgBox("Password is empty", vbExclamation, "Error")
Case Not IO.File.Exists(FilePath)
MsgBox("No file for User", vbExclamation, "Error")
Case Not IO.File.ReadAllText(FilePath) = Pass
MsgBox("Wrong Password", vbExclamation, "Error")
Case Else
MsgBox(String.Format("Welcome {0}!", User), vbOKOnly, "Success")
My.Forms.Home.Show()
End Select
End Sub
Dim objReader As StreamReader
Dim user As String = TextBox1.Text
Dim password As String = TextBox2.Text
Dim check As String
Dim fname = Path.Combine(DirPath7, String.Format("{0}.txt", user))
If File.Exists(fname) Then
Using objreader As New StreamReader(fname)
'objReader = StreamReader(fname)
check = objreader.ReadToEnd()
password = check
MessageBox.Show("Welcome " & user & "!")
Close()
My.Forms.Home.Show()
End Using
Else : MessageBox.Show("file not found, no user exists")
End If
removed the extra ".txt"
Added "Do Using" . . ."End Using"
Alright, here is my issue.
Working on a Inventory Control program, and got it mostly done, when a wild bug appears.
The system will check out a item, but will not check it back in, even though it throws all the proper messages that it does check the item in.
What's worse, is that the SQL statement is encapsulated in a try-catch class and acts as if nothing is wrong, and does not throw an exception.
And this is just a functional build, not a streamlined one, so it looks a little rough.
The statement in question is:
Dim OleCheckIn As New OleDbCommand("UPDATE Assets SET [Checked Out]='Checked In' WHERE [ID Number]=" + sBarcode + "", OleDbConn)
I am sure it is something very very obvious, but I have been rebuilding and staring at it for so long, I am likely glossing over a glaring hole in it.
Option Strict On
Imports System.Data
Imports System.Data.OleDb
Public Class Form1
Public EmpIDFlag As Boolean
Public ItemBCode As Boolean
Public CheckFlag As Boolean
Public dEmpID As Double
Public sEmpID As String
Public dbEmpID As Double
Public dBarcode As Double
Public sBarcode As String
Public sFirstName As String
Public sLastName As String
Public sFullName As String
Public sItem As String
Public sCheckedOut As String
Public sCheckedOutBy As String
Public OleDbConn As OleDb.OleDbConnection = New OleDb.OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0; Data Source = C:\Users\rcassel\Documents\Visual Studio 2012\Projects\Inventory Control\Inventory Control\Inventory Control2.accdb;")
Private Sub TextBox1_LostFocus(sender As Object, e As EventArgs) Handles TextBox1.LostFocus
dEmpID = (Val(TextBox1.Text))
'Checks to see if someone entered a Badge
If dEmpID = Nothing Then
MsgBox("You must scan your Badge!", MsgBoxStyle.OkOnly)
TextBox1.Focus()
Else
sEmpID = dEmpID.ToString
'Fire Query into Database
Try
OleDbConn.Open()
Dim OleEmp As New OleDbCommand("SELECT [First Name],[Last Name],[Employee ID] FROM Contacts WHERE [Employee ID]=" + sEmpID + "", OleDbConn)
Dim r1 As OleDbDataReader = OleEmp.ExecuteReader()
While r1.Read()
sFirstName = CStr(r1("First Name"))
sLastName = CStr(r1("Last Name"))
dbEmpID = CInt(r1("Employee ID"))
End While
r1.Close()
Catch ex As Exception
'MsgBox("Cannot Pull Data." & vbCrLf & ex.Message)
End Try
If dbEmpID = Nothing Then
MsgBox("You are not Authorised to use this device. This activity has been logged.", MsgBoxStyle.OkOnly)
Else
Me.ListBox1.Items.Add(sFirstName)
Me.ListBox1.Items.Add(sLastName)
Me.ListBox1.Items.Add(sEmpID)
TextBox2.Focus()
End If
OleDbConn.Close()
End If
End Sub
'Item Barcode
'Private Sub TextBox2_LostFocus(sender As Object, e As EventArgs) Handles TextBox2.LostFocus
Private Sub Textbox2_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles TextBox2.KeyPress
dBarcode = (Val(TextBox2.Text))
If e.KeyChar = Microsoft.VisualBasic.ChrW(Keys.Enter) Then
sBarcode = dBarcode.ToString()
OleDbConn.Open()
Try
Dim OleItem As New OleDbCommand("SELECT [Item],[Checked Out],[Checked out Last by] FROM Assets WHERE [ID Number]=" + sBarcode + "", OleDbConn)
Dim r2 As OleDbDataReader = OleItem.ExecuteReader()
While r2.Read()
sItem = CStr(r2("Item"))
sCheckedOut = CStr(r2("Checked Out"))
sCheckedOutBy = CStr(r2("Checked out Last by"))
End While
ItemBCode = True
'Set Checkout Flag, this will be called later by the Check In/Check Out button
If sCheckedOut = "Checked Out" Then
CheckFlag = True
End If
r2.Close()
Catch ex As Exception
MsgBox("Barcode Invalid." & vbCrLf & ex.Message)
ItemBCode = False
End Try
If ItemBCode = True Then
Me.ListBox2.Items.Add(sItem)
Me.ListBox2.Items.Add(sCheckedOut)
Me.ListBox2.Items.Add(sCheckedOutBy)
End If
OleDbConn.Close()
End If
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
TextBox1.Focus()
End Sub
'This is the "Check In" button
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
If ItemBCode = False Then
MsgBox("You must have a Valid Item Barcode!", MsgBoxStyle.OkOnly)
TextBox2.Focus()
Else
If CheckFlag Then
Try
OleDbConn.Open()
Dim OleCheckIn As New OleDbCommand("UPDATE Assets SET [Checked Out]='Checked In' WHERE [ID Number]=" + sBarcode + "", OleDbConn)
MsgBox("This Item has been Checked in!", MsgBoxStyle.OkOnly)
Catch ex As Exception
MsgBox("Barcode Invalid." & vbCrLf & ex.Message)
ItemBCode = False
End Try
Else
MsgBox("This Item is already Checked in!", MsgBoxStyle.OkOnly)
TextBox2.Focus()
End If
End If
OleDbConn.Close()
End Sub
'This is the "Check Out" button
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
If ItemBCode = False Then
MsgBox("You must have a Valid Item Barcode!", MsgBoxStyle.OkOnly)
TextBox2.Focus()
Else
If CheckFlag = False Then
Try
sFullName = String.Format("{0} {1}", sFirstName, sLastName)
OleDbConn.Open()
Dim OleCheckOut As New OleDbCommand("UPDATE Assets SET [Checked Out]='Checked Out',[Checked out Last by] ='" + sFullName + "' WHERE [ID Number]=" + sBarcode + "", OleDbConn)
MsgBox("This Item has been Checked Out!", MsgBoxStyle.OkOnly)
Catch ex As Exception
MsgBox("Barcode Invalid." & vbCrLf & ex.Message)
ItemBCode = False
End Try
Else
MsgBox("This Item is already Checked Out!", MsgBoxStyle.OkOnly)
TextBox2.Focus()
End If
End If
OleDbConn.Close()
End Sub
End Class
You never execute your update commands:
OleCheckIn.ExecuteNonQuery()
OleCheckOut.ExecuteNonQuery()
Also, use parameters. You are exposing your system to SQL injection.