Using Microsoft.AspNet.Identity i have almost all I need to manage the users problems, but I ( a vb.net beginner) can't update this code to automatically sign in the user when he confirm the email address.
I think I need a method to get ApplicationUser just based on UsedId
This is the code I try to change:
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim code As String = IdentityHelper.GetCodeFromRequest(Request)
Dim userId As String = IdentityHelper.GetUserIdFromRequest(Request)
If code IsNot Nothing AndAlso userId IsNot Nothing Then
Dim manager = Context.GetOwinContext().GetUserManager(Of ApplicationUserManager)()
Dim result = manager.ConfirmEmail(userId, code)
If result.Succeeded Then
'>>>>>>>>login the user
successPanel.Visible = True
Return
End If
End If
successPanel.Visible = False
errorPanel.Visible = True
End Sub
In case someone else have this issue, this is the code i used
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim code As String = IdentityHelper.GetCodeFromRequest(Request)
Dim userId As String = IdentityHelper.GetUserIdFromRequest(Request)
If code IsNot Nothing AndAlso userId IsNot Nothing Then
Dim manager = Context.GetOwinContext().GetUserManager(Of ApplicationUserManager)()
Dim result = manager.ConfirmEmail(userId, code)
If result.Succeeded Then
Try
Dim task = New UserStore(Of Sue.ApplicationUser)(Context.GetOwinContext().[Get](Of ApplicationDbContext)()).FindByIdAsync(userId)
Dim user = task.Result()
Dim signInManager = Context.GetOwinContext().Get(Of ApplicationSignInManager)()
signInManager.SignIn(user, isPersistent:=False, rememberBrowser:=False)
Context.Response.Redirect("/Account/UserData", False)
Catch ex As Exception
successPanel.Visible = False
errorPanel.Visible = True
Return
End Try
End If
End If
successPanel.Visible = False
errorPanel.Visible = True
End Sub
Related
A co-worker needs to search our network and her File Explorer search does not work well. I threw this app together quickly to allow her to search and it works well. The results are written to a datagridview, but the results are not shown until the search is complete.
I would like the datagridview to show records as they are added and allow her to cancel the search if she wants.
Using a backgroundworker, I tried to refresh the grid, but as soon as it finds a match, the code stops running. There are no errors, it just stops running.
So how can I get the grid to update as it continues to search?
Public dtResults As DataTable
Dim myDataSet As New DataSet
Dim myDataRow As DataRow
Dim colType As DataColumn
Dim colResult As DataColumn
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
dtResults = New DataTable()
colType = New DataColumn("Type", Type.GetType("System.String"))
colResult = New DataColumn("Search Result", Type.GetType("System.String"))
dtResults.Columns.Add(colType)
dtResults.Columns.Add(colResult)
DataGridView1.DataSource = dtResults
DataGridView1.Columns(1).AutoSizeMode = DataGridViewAutoSizeColumnMode.Fill
End Sub
Private Sub btnSearch_Click(sender As Object, e As EventArgs) Handles btnSearch.Click
btnSearch.Enabled = False
sbStatusBar.Text = "Searching..."
dtResults.Clear()
BackgroundWorker1.RunWorkerAsync()
End Sub
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
LoopSubFolders(txtSearchLocation.Text)
End Sub
Public Sub LoopSubFolders(sLocation As String)
Dim di = New DirectoryInfo(sLocation)
Dim mySearchterm As String = LCase(txtSearchTerm.Text)
Dim fiArr As FileInfo() = di.GetFiles()
Dim sSearchTarget As String
sbStatusBar.Text = "Searching " & sLocation
'Search File names in
If cbFileNames.Checked = True Then
For Each myFile In fiArr
sSearchTarget = LCase(myFile.Name)
If sSearchTarget.Contains(mySearchterm) Then
myDataRow = dtResults.NewRow()
myDataRow(dtResults.Columns(0)) = "File"
myDataRow(dtResults.Columns(1)) = Path.Combine(sLocation, myFile.Name)
dtResults.Rows.Add(myDataRow)
End If
Next
End If
For Each d In Directory.GetDirectories(sLocation)
If cbFolderNames.Checked = True Then
sSearchTarget = LCase(d)
If sSearchTarget.Contains(mySearchterm) Then
myDataRow = dtResults.NewRow()
myDataRow(dtResults.Columns(0)) = "Folder"
myDataRow(dtResults.Columns(1)) = d
dtResults.Rows.Add(myDataRow)
End If
End If
LoopSubFolders(d)
Next
End Sub
Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
btnSearch.Enabled = True
sbStatusBar.Text = "Complete"
DataGridView1.DataSource = Nothing
DataGridView1.DataSource = dtResults
DataGridView1.Columns(1).AutoSizeMode = DataGridViewAutoSizeColumnMode.Fill
End Sub
Here's an example of how you might do it using the suggested ReportProgress method and ProgressChanged event:
Private table As New DataTable
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'Configure table here.
DataGridView1.DataSource = table
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
'Setup UI here.
'Note that you MUST pass in the TextBox data as you MUST NOT touch the UI directly on the secondary thread.
BackgroundWorker1.RunWorkerAsync({TextBox1.Text, TextBox2.Text})
End Sub
Private Sub BackgroundWorker1_DoWork(sender As Object, e As DoWorkEventArgs) Handles BackgroundWorker1.DoWork
'Get the data passed in and separate it.
Dim arguments = DirectCast(e.Argument, String())
Dim folderPath = arguments(0)
Dim searchTerm = arguments(1)
SearchFileSystem(folderPath, searchTerm)
End Sub
Private Sub SearchFileSystem(folderPath As String, searchTerm As String)
For Each filePath In Directory.GetFiles(folderPath)
If filePath.IndexOf(searchTerm, StringComparison.InvariantCultureIgnoreCase) <> -1 Then
'Update the UI on the UI thread.
BackgroundWorker1.ReportProgress(0, {"File", filePath})
End If
Next
For Each subfolderPath In Directory.GetDirectories(folderPath)
If subfolderPath.IndexOf(searchTerm, StringComparison.InvariantCultureIgnoreCase) <> -1 Then
'Update the UI on the UI thread.
BackgroundWorker1.ReportProgress(0, {"Folder", subfolderPath})
End If
SearchFileSystem(subfolderPath, searchTerm)
Next
End Sub
Private Sub BackgroundWorker1_ProgressChanged(sender As Object, e As ProgressChangedEventArgs) Handles BackgroundWorker1.ProgressChanged
'Get the data passed out and separate it.
Dim data = DirectCast(e.UserState, String())
'Update the UI.
table.Rows.Add(data)
End Sub
Note that you should NEVER touch the UI directly in the DoWork event handler or a method called from it. ONLY touch the UI on the UI thread. That means that the text in your TextBoxes must be extracted BEFORE calling RunWorkerAsync. You can eithewr pass the Strings in as arguments or you can assign them to fields and access them from there on any thread. Don't EVER access a member of a control on other than the UI thread. Some times it will work, sometimes it will appear to work but not do as intended and sometimes it will crash your app. So that you don't have to remember which specific scenarios cause which result, avoid such scenario altogether.
I haven't tested this code so I'm not sure but you may have to call Refresh on the grid or the form after adding the new row to the DataTable.
Variables
Well, let's start from the top with some class level variables:
'Notice the enabled properties.
Private WithEvents BackgroundWorker1 As New BackgroundWorker With {.WorkerReportsProgress = True, .WorkerSupportsCancellation = True}
'To monitor the cancellation, set by the Cancel Button.
Private bgwCancel As Boolean = False
'The DGV source.
Private dtResults As New DataTable
'The start directory.
Private startDir As String
'The search keyword.
Private searchWord As String
'Whether to search the sub directories, from a check box for example.
Private includeSubDirectories As Boolean = True
'Whether to search the files, from another check box.
Private includeFiles As Boolean = True
The Constructor
Prepare your DGV and whatever else you need here.
Sub New()
dtResults.Columns.Add(New DataColumn("Type", Type.GetType("System.String")))
dtResults.Columns.Add(New DataColumn("Search Result", Type.GetType("System.String")))
DataGridView1.DataSource = dtResults
DataGridView1.Columns(1).AutoSizeMode = DataGridViewAutoSizeColumnMode.Fill
'Make sure you add the image column after binding the data source.
Dim imgCol As New DataGridViewImageColumn(False)
With imgCol
.Image = Nothing
.Name = "imgCol"
.HeaderText = ""
.Width = 50
.DefaultCellStyle.NullValue = Nothing
End With
DataGridView1.Columns.Insert(0, imgCol)
End Sub
Iterator
Now, let's write the search routine. I'd do that through an Iterator function:
Private Iterator Function IterateFolders(startDir As String, includeFiles As Boolean, includeSubDir As Boolean) As IEnumerable(Of String)
For Each dirName In IO.Directory.EnumerateDirectories(startDir)
Yield dirName
If includeFiles Then
For Each fileName In IO.Directory.EnumerateFiles(startDir)
Yield fileName
Next
End If
If includeSubDir Then
For Each subDir In IterateFolders(dirName, includeFiles, includeSubDir)
Yield subDir
Next
End If
Next
End Function
The Main Thread Updater
A routine called by the worker's thread to update the DataTable and any control that belongs to the main thread:
Private Sub AddSearchResult(path As String)
If InvokeRequired Then
Invoke(Sub() AddSearchResult(path))
Else
dtResults.Rows.Add(If(IO.File.Exists(path), "File", "Folder"), path)
sbStatusBar.Text = $"Searching {path}"
End If
End Sub
Start
In the click event of the start button, do the necessary validations, assign the values to their variables, and start the back ground worker:
If String.IsNullOrEmpty(txtSearchKeyword.Text) Then Return
If String.IsNullOrEmpty(txtSearchLocation.Text) Then Return
bgwCancel = False
dtResults.Rows.Clear()
startDir = txtSearchLocation.Text
searchWord = txtSearchKeyword.Text.ToLower
includeSubDirectories = chkIncludeSubDirs.Checked
includeFiles = chkFiles.Checked
btnSearch.Enabled = False
sbStatusBar.Text = "Searching..."
BackgroundWorker1.RunWorkerAsync()
Cancel
To cancel the search, in the click event of the cancel button I presume, True the bgwCancel variable:
bgwCancel = True
The BackgroundWorker - DoWork
Private Sub BackgroundWorker1_DoWork(sender As Object, e As DoWorkEventArgs) Handles BackgroundWorker1.DoWork
For Each item As String In IterateFolders(startDir, includeFiles, includeSubDirectories)
If bgwCancel Then
BackgroundWorker1.CancelAsync()
Return
End If
If item.ToLower.Contains(searchWord) Then
AddSearchResult(item)
End If
Threading.Thread.Sleep(100)
Next
End Sub
Note that, Its good practice to give a lengthy routine a BREATH through the Sleep(ms) method of that thread.
The BackgroundWorker - ProgressChanged
I don't think you need it here.
The BackgroundWorker - RunWorkerCompleted
Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
If bgwCancel Then
sbStatusBar.Text = "Canceled!"
MessageBox.Show("Canceled by you!")
ElseIf e.Error IsNot Nothing Then
sbStatusBar.Text = "Error!"
MessageBox.Show(e.Error.Message)
Else
sbStatusBar.Text = "Complete"
'YOU DO NOT NEED TO DO THIS. Remove the following
'DataGridView1.DataSource = Nothing
'DataGridView1.DataSource = dtResults
'DataGridView1.Columns(1).AutoSizeMode = DataGridViewAutoSizeColumnMode.Fill
End If
btnSearch.Enabled = True
End Sub
The Image Column
Handle the RowsAdded event of the DGV as follow:
Private Sub DataGridView1_RowsAdded(sender As Object, e As DataGridViewRowsAddedEventArgs) Handles DataGridView1.RowsAdded
If DataGridView1.Columns.Count < 3 Then Return
'if you want to get rid of the default x image.
If e.RowIndex = 0 Then
DataGridView1.Rows(e.RowIndex).Cells("imgCol").Value = Nothing
End If
Dim path As String = DataGridView1.Rows(e.RowIndex).Cells(2).Value?.ToString
If Not String.IsNullOrEmpty(path) Then
If IO.File.Exists(path) Then
DataGridView1.Rows(e.RowIndex).Cells("imgCol").Value = Icon.ExtractAssociatedIcon(path).ToBitmap
Else
DataGridView1.Rows(e.RowIndex).Cells("imgCol").Value = My.Resources.Folder
End If
End If
End Sub
Where the My.Resources.Folder is an icon file of your choice for the folder entries.
Good luck.
So I did something similar a while ago, but this is essentially a username checker for a (specific) website, they can load in usernames via text file and it will put it into a list box, now I have the start button and it's meant to check each username. Before, however, it froze the program when they checked, but it worked. I tried making it "threaded" so it didn't freeze.
The problem now is that it doesn't check them all, and finishes instantly.
CODE:
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
Button6.Enabled = False
Dim goodUsers As New SaveFileDialog()
goodUsers.Filter = "TXT file (*.txt)|*.txt"
Dim flag As Boolean
Dim Incomplete As Integer = 0
Dim Taken As Integer = 0
Dim sb As New StringBuilder
If goodUsers.ShowDialog() = DialogResult.OK Then
Dim checkerMT As New Thread(
Sub()
For Each i As String In UsernameList.Items
WebRequest.Create("http://yatobooter.cf/other/checkusr.php?username=" + i.ToString)
Dim cResult As String = New System.Net.WebClient().DownloadString("http://yatobooter.cf/other/checkusr.php?username=" + i.ToString).ToString
If cResult = "taken" Then
flag = False
ElseIf cResult = "nottaken" Then
flag = True
End If
If flag = True Then
sb.Append(i & vbNewLine)
Else
Incomplete = Incomplete + 1
Taken = UsernameList.Items.Count - Incomplete
End If
Next
End Sub
)
checkerMT.Start()
Try
File.WriteAllText(goodUsers.FileName, sb.ToString)
Catch ex As Exception
Exit Sub
End Try
End If
MessageBox.Show("Checking available usernames, complete!", "NameSniper Pro")
Button6.Enabled = True
End Sub
You cannot access UI elements (UsernameList.Items) from a thread other than the UI. Instead add a background worker to your form to handle the basic threading stuff (progress reporting, finish reporting, exception handling). Pass into this an object that contains the settings your job needs to do its work without interacting with the ui.
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
Button6.Enabled = False
Dim goodUsers As New SaveFileDialog()
goodUsers.Filter = "TXT file (*.txt)|*.txt"
If goodUsers.ShowDialog() = DialogResult.OK Then
'Note: You'll need to add the filenames
BackgroundWorker1.RunWorkerAsync(New State() With {.Names = {}, .FileName = goodUsers.FileName})
End If
End Sub
Class State
Public Names As List(Of String)
Public StringBuilder As New System.Text.StringBuilder
Public Incomplete As Integer
Public Taken As Integer
Public FileName As String
End Class
Private Sub BackgroundWorker1_DoWork(sender As System.Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Dim state = CType(e.Argument, State)
For Each i As String In state.Names
Using cli = New System.Net.WebClient()
Dim cResult = cli.DownloadString("http://yatobooter.cf/other/checkusr.php?username=" + i.ToString).ToString
If cResult = "nottaken" Then
state.StringBuilder.Append(i & vbNewLine)
Else
state.Incomplete = state.Incomplete + 1
state.Taken = state.Names.Count - state.Incomplete
End If
End Using
Next
IO.File.WriteAllText(state.FileName, state.StringBuilder.ToString)
End Sub
Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
If e.Error IsNot Nothing Then
MessageBox.Show(e.Error.ToString(), "Error")
Else
MessageBox.Show("Checking available usernames, complete!", "NameSniper Pro")
End If
Button6.Enabled = True
End Sub
The SaveFileDialog can be used as "Using directive"
Why do you create a webrequest on the one hand, and on the other hand use a webclient? That does not make sense at all.
Instead of your strange if condition, write:
flag = (cResult.Equals("nottaken"))
All code you want to run after the actions you are currently running in your thread have to be in your thread as well, because it is async.
You have to invoke if you use user controls within a thread
and so on..
Please turn Option Strict On and Option Infer Off
There are lots of other things you could do better.
Please remove the webrequest and webclient combination yourself, that does not make sense at all.
Take a look at this, I cleared it a little bit:
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
Dim Incomplete As Integer = 0
Dim Taken As Integer = 0
Dim sb As New StringBuilder
Using goodUsers As SaveFileDialog = new SaveFileDialog()
goodUsers.Filter = "TXT file (*.txt)|*.txt"
If not goodUsers.ShowDialog() = DialogResult.OK Then Exit Sub
Dim checkerMT As New Thread(
Sub()
Me.invoke(sub()
Button6.Enabled = False
For Each i As String In UsernameList.Items
WebRequest.Create("http://yatobooter.cf/other/checkusr.php?username=" + i.ToString)
Dim cResult As String = New System.Net.WebClient().DownloadString("http://yatobooter.cf/other/checkusr.php?username=" + i.ToString).ToString
If (cResult.toLower().Equals("nottaken")) Then
sb.Append(String.Concat(i , Environment.NewLine)
Else
Incomplete += 1
Taken = UsernameList.Items.Count - Incomplete
End If
Next
File.WriteAllText(goodUsers.FileName, sb.ToString)
Button6.Enabled = True
MessageBox.Show("Checking available usernames, complete!", "NameSniper Pro")
End Sub)
End Sub
)
checkerMT.IsBackground = True;
checkerMT.Start()
End Sub
I am new to visual basic so hopefully this is a simple question. I have a menu with buttons to call different forms. The forms are designed and have labels and text fields and buttons and so on. From the main menu I have tried calling the forms two different ways. One way the forms open and look correct and function. The other way the form opens as a small blank square with no fields. Ultimately I want to create a set of List objects when the main menu opens and pass them back and forth to the other forms for input and processing. I'm using parallel Lists as a temporary database for a simple school lab. I just don't see what is wrong with the way I am calling the form. I haven't even bothered worrying about passing the List objects properly yet.
Public Class frmMain
Dim arrGames As New List(Of String)
Dim arrDates As New List(Of String)
Dim arrPrices As New List(Of Decimal)
Dim arrSeats As New List(Of Integer)
Private Sub btnEnterGames_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEnterGames.Click
'NewEnter.Visible = True
Dim frmEnter As New NewEnter(arrGames, arrDates, arrPrices, arrSeats)
frmEnter.ShowDialog()
End Sub
Private Sub btnReports_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnReports.Click
'Reports.Visible = True
Dim frmReports As New Reports(arrGames, arrDates, arrPrices, arrSeats)
frmReports.Visible = True
End Sub
Private Sub btnSellTickets_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSellTickets.Click
'SellTickets.Visible = True
Dim frmSell As New SellTickets(arrGames, arrDates, arrPrices, arrSeats)
frmSell.Visible = True
End Sub
Private Sub btnExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExit.Click
Close()
End Sub
End Class
This is the code for the form NewEnter. I have the New routine which accepts the 4 Lists and basically does nothing else. Doing the "'NewEnter.Visible = True" in the main menu will load the form correctly but I have to comment out the New sub routine in the forms or there is an error.
Public Class NewEnter
Private _arrGames As List(Of String)
Private _arrDates As List(Of String)
Private _arrPrices As List(Of Decimal)
Private _arrSeats As List(Of Integer)
Sub New(ByVal arrGames As List(Of String), ByVal arrDates As List(Of String), ByVal arrPrices As List(Of Decimal), ByVal arrSeats As List(Of Integer))
' TODO: Complete member initialization
' _arrGames = arrGames
' _arrDates = arrDates
' _arrPrices = arrPrices
' _arrSeats = arrSeats
End Sub
Private Sub btnSaveGame_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSaveGame.Click
Dim arrGames As New List(Of String)
Dim arrDates As New List(Of String)
Dim arrPrices As New List(Of Decimal)
Dim arrSeats As New List(Of Integer)
Dim strGame As String
Dim strPrice As String
Dim strSeats As String
Dim intSeats As Integer
Dim decPrice As Decimal
Dim bolGameErr As Boolean
Dim bolDateErr As Boolean
Dim bolPriceErr As Boolean
Dim bolSeatErr As Boolean
strGame = txtGame.Text
strPrice = txtPrice.Text
strSeats = txtSeats.Text
'~~~~~~~~~~~~verify a game is entered
If String.IsNullOrEmpty(strGame) Or String.IsNullOrWhiteSpace(strGame) Then
bolGameErr = True
Else
'~~~~~~~~~~~~verify price is numeric
If IsNumeric(strPrice) Then
decPrice = strPrice
'~~~~~~~~~~~~~~~verify seats are numeric
If IsNumeric(strSeats) Then
intSeats = Convert.ToInt32(strSeats)
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ add elements to array lists
arrGames.Add(New String(strGame))
arrDates.Add(dtpDate.Text)
arrPrices.Add(New Decimal(decPrice))
arrSeats.Add(intSeats)
lblSaveSuccessful.Visible = True
ClearInput()
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ add elements to array lists
Else
bolSeatErr = True
End If
Else
bolPriceErr = True
End If
End If
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Check flags for input errors
If bolDateErr = True Then
lblErr.Text = "Invalid date"
lblErr.Visible = True
End If
If bolGameErr = True Then
lblErr.Text = "Must enter a game name"
lblErr.Visible = True
txtGame.Focus()
End If
If bolDateErr = True And bolGameErr = True Then
lblErr.Text = "Must enter a game name and valid date"
lblErr.Visible = True
txtGame.Focus()
End If
If bolPriceErr = True Then
lblPriceErr.Visible = True
txtPrice.Text = ""
txtPrice.Focus()
End If
If bolSeatErr = True Then
lblSeatErr.Visible = True
txtSeats.Text = ""
txtSeats.Focus()
End If
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Check flags for input error
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Display output
Dim i As Integer
i = 0
lblData.Text = arrGames.Count.ToString
Do While i < arrGames.Count
lblData.Text = Convert.ToString(arrGames(i)) & " on " & Convert.ToString(arrDates(i)) & " Price: " & _
Convert.ToString(arrPrices(i)) & " Available Seats: " & Convert.ToString(arrSeats(i))
i += 1
Loop
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Display output
lblData.Visible = True
End Sub
Private Sub ClearInput()
'lblErr.Visible = False
'lblPriceErr.Visible = False
'lblSeatErr.Visible = False
txtGame.Text = ""
txtPrice.Text = ""
txtSeats.Text = ""
txtGame.Focus()
End Sub
Public Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'Me.Visible = True
'Me.BackColor = Color.BurlyWood
'Me.ResumeLayout()
'Me.Activate()
'Me.Focus()
'Me.Show()
'Me.lblGameHdr.Visible = True
End Sub
Private Sub btnExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExit.Click
Close()
End Sub
End Class
Add InitializeComponent() to your constructor class.
This is added by default to the New (constructor) function of all Visual Basic forms. It requires it to set-up the UI components on the form.
I have the following code in my UC_Menu_Scout class:
Private Sub cmbScoutName_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmbScoutName.SelectedIndexChanged
If loaded = True Then
cmbReportDate.DataSource = Nothing
cmbReportDate.DataSource = frmPlayerInfo.filterReports()
cmbReportDate.DisplayMember = "ReportDate"
cmbReportDate.ValueMember = "ReportID"
End If
End Sub
Private Sub cmbReportDate_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmbReportDate.SelectedIndexChanged
If loaded = True Then
If cmbReportDate.Items.Count > 0 Then
'frmPlayerInfo.myDataTable = Nothing
frmPlayerInfo.myDataTable = frmPlayerInfo.retrieveDT()
dgPlayers.DataSource = frmPlayerInfo.myDataTable
frmPlayerInfo.setReport()
End If
End If
End Sub
And the following code in my frmPlayerInfo class (just the relevant code):
Public myDataTable As DataTable = Nothing
Private Sub frmPlayerInfo_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
UC_Menu_Scout1.cmbScoutName.DataSource = retrieveScouts()
UC_Menu_Scout1.cmbScoutName.DisplayMember = "ScoutName"
UC_Menu_Scout1.cmbScoutName.ValueMember = "ScoutID"
UC_Menu_Scout1.cmbReportDate.DataSource = filterReports()
UC_Menu_Scout1.cmbReportDate.DisplayMember = "ReportDate"
UC_Menu_Scout1.cmbReportDate.ValueMember = "ReportID"
myDataTable = retrieveDT()
UC_Menu_Scout1.dgPlayers.DataSource = myDataTable
setReport()
loaded = True
End Sub
Public Function retrieveDT() As DataTable
Dim Str As String = _
<String> SELECT
Player.PlayerID,
PlayerFirstName,
PlayerLastName,
DOB,
Age,
PlaceOfBirth,
PlayerImage
FROM
Player
INNER JOIN
Report ON Report.PlayerID = Player.PlayerID
/*WHERE
ReportID = #ReportID*/
ORDER BY
PlayerFirstName
</String>
Dim dt As New DataTable
Using conn As New SqlClient.SqlConnection(DBConnection)
conn.Open()
Using cmdQuery As New SqlClient.SqlCommand(Str, conn)
cmdQuery.Parameters.Add("#ReportID", SqlDbType.Int).Value = UC_Menu_Scout1.cmbReportDate.SelectedItem.ReportID
cmdQuery.CommandTimeout = 600
Try
Using daResults As New SqlClient.SqlDataAdapter(cmdQuery)
daResults.Fill(dt)
End Using
Catch ex As Exception
MsgBox("An Exception has happened: " & ex.Message & vbNewLine)
End Try
End Using 'Automatically closes connection
End Using
Return dt
End Function
Everything worked fine before I created a login form. Since then (upon a successful login) I've been receiving the "Object variable or with block variable not set" error on my comboboxes- saying they were now empty at the time of the form load event. Since setting the "loaded" boolean, this got rid of the error for frmPlayerInfo.filterReports(), however I still receive the same message for frmPlayerInfo.retrieveDT- on this line cmdQuery.Parameters.Add("#ReportID", SqlDbType.Int).Value = UC_Menu_Scout1.cmbReportDate.SelectedItem.ReportID. Again, saying the combobox (cmbReportDate) is empty.
The intial load event works, but the crash occurs on the cmbReportDate_SelectedIndexChanged event, on this line: frmPlayerInfo.myDataTable = frmPlayerInfo.retrieveDT() in the retrieveDT function.
If I remove the login form I have no such problems- any answers specific to my program would be appreciated.
Here's an example of how to get a reference to the main Form from within your UserControl:
Dim frm As Form = Me.FindForm
If TypeOf frm Is frmPlayerInfo Then
Dim player As frmPlayerInfo = DirectCast(frm, frmPlayerInfo)
' ... now do something with "player" ...
End If
No, this is not a good design because now your UserControl can only ever be used with the frmPlayerInfo Form. If you're okay with that, then here's an example using your specific code:
Private Sub cmbReportDate_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmbReportDate.SelectedIndexChanged
If loaded = True Then
If cmbReportDate.Items.Count > 0 Then
Dim frm As Form = Me.FindForm
If TypeOf frm Is frmPlayerInfo Then
Dim player As frmPlayerInfo = DirectCast(frm, frmPlayerInfo)
' ... now do something with "player" ...
player.myDataTable = player.retrieveDT()
dgPlayers.DataSource = player.myDataTable
player.setReport()
End If
End If
End If
End Sub
Man I've been killing myself trying to figure this out for the past 2 days. Just when i thought i had it figured out, nope, lol. So here's my dilemna, I have a form that when a user puts in a user ID, 2 text boxes are to be filled with their Given Name / SurName. I have my code so that it will connect to the LDAP and verify whether or not the UserID is correct. Where i'm having problems is adding the names to the text boxes.
This is the boolean that connects to AD:
Public Shared Function UserExists(ByVal username As String) As Boolean
Dim answer As Boolean = False
Dim dirEntry As DirectoryEntry = Nothing
Dim ldapPath As String = "LDAP://(Insert LDAP nonsense here)"
Dim dirSearcher As DirectorySearcher = Nothing
Dim result As SearchResult = Nothing
Try
dirEntry = New DirectoryEntry(ldapPath)
dirSearcher = New DirectorySearcher(dirEntry)
With dirSearcher
.Filter = "(CN=" & username & ")"
.PropertyNamesOnly = True
.PropertiesToLoad.Add("Name")
.PropertiesToLoad.Add("GN")
.PropertiesToLoad.Add("SN")
result = .FindOne()
End With
If Not result Is Nothing Then
answer = True
End If
Catch ex As Exception
Throw New Exception(ex.Message)
Finally
dirEntry = Nothing
dirSearcher = Nothing
End Try
Return answer
End Function
Here's the code for the button when the user hits verify:
Private Sub Button16_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button16.Click
Dim userID As String = TextBox18.Text
If UserExists(userID) Then
MsgBox("WooHoo")
Else
MsgBox("Fail")
End If
Textbox16.text = SN
Textbox17.text = GN
Any help would be GREATLY appreciated. Cheers
You should change .PropertiesToLoad.Add("GN") by .PropertiesToLoad.Add("givenName") The right attribute name must be use in ADSI.
Then you shoul return resul by reference something like (I do not use VB for years now, so I hope somebody will comment the syntax):
Public Shared Function UserExists(ByVal username As String, ByRef result As SearchResult) As Boolean
Dim answer As Boolean = False
Dim dirEntry As DirectoryEntry = Nothing
Dim ldapPath As String = "LDAP://(Insert LDAP nonsense here)"
Dim dirSearcher As DirectorySearcher = Nothing
Try
dirEntry = New DirectoryEntry(ldapPath)
dirSearcher = New DirectorySearcher(dirEntry)
With dirSearcher
.Filter = "(CN=" & username & ")"
.PropertyNamesOnly = True
.PropertiesToLoad.Add("Name")
.PropertiesToLoad.Add("givenName")
.PropertiesToLoad.Add("SN")
result = .FindOne()
End With
If Not result Is Nothing Then
answer = True
End If
Catch ex As Exception
Throw New Exception(ex.Message)
Finally
dirEntry = Nothing
dirSearcher = Nothing
End Try
Return answer
End Function
Then you should call it with :
Private Sub Button16_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button16.Click
Dim userID As String = TextBox18.Text
Dim result As SearchResult = Nothing
If UserExists(userID, result) Then
MsgBox("WooHoo")
Else
MsgBox("Fail")
End If
Textbox16.text = result.sn
Textbox17.text = result.givenName
Figured it out in case anyone ever have the same question:
What this essentially does is after I put in the User ID, and click away, it populates the next 2 fields with the first name last name. essentially you can add the same thing to the Button
Private Sub TextBox3_LostFocus(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox3.LostFocus
Dim deSystem As New DirectoryEntry("LDAP:")
Dim dsSystem As New DirectorySearcher(deSystem)
Dim srsystem As SearchResult
If TextBox3.Text = Nothing Then
Exit Sub
Else
Try
dsSystem.Filter = "sAMAccountName=" & TextBox3.Text
dsSystem.PropertiesToLoad.Add("mail") 'email address
dsSystem.PropertiesToLoad.Add("department") 'dept
dsSystem.PropertiesToLoad.Add("physicalDeliveryOfficeName") 'office
dsSystem.PropertiesToLoad.Add("title") 'title, eg programmer1
dsSystem.PropertiesToLoad.Add("telephoneNumber") 'phone
dsSystem.PropertiesToLoad.Add("streetAddress") 'street address
dsSystem.PropertiesToLoad.Add("l") 'city
dsSystem.PropertiesToLoad.Add("st") 'state
dsSystem.PropertiesToLoad.Add("postalCode") 'zip code
dsSystem.PropertiesToLoad.Add("EmployeeId") 'empid
dsSystem.PropertiesToLoad.Add("givenName") '//first name from active directory
dsSystem.PropertiesToLoad.Add("sn") '//lastname from active directory
srsystem = dsSystem.FindOne()
TextBox1.Text = srsystem.Properties("givenName").Item(0).ToString
TextBox2.Text = srsystem.Properties("sn").Item(0).ToString
Catch ex As Exception
MsgBox("Invalid UserID")
End Try
End If
End Sub