asp.net vb website loop through database rows - vb.net

I am working on my first website and need help with a loop. I have a database table containing food items named Menu with 8 categories (such as Burgers, Appetizers). I also have a menu page on website with 8 different pics to display items from each category. I need to loop through rows of database. What is happening is it's only looping through columns and repeating first line over and over. I'm aware I need a loop but for some reason cannot get that right.
This is code behind:
Partial Class Burger
Inherits System.Web.UI.Page
'String Used to build the necessary markup and product information
Dim str As String = ""
'Var used to interact with SQL database
Dim db As New Interaction
'Adds the necessary markup for each menu item, using its productName
Protected Sub printMenuBlock(ByVal productName As String)
'Set up variable storing the product
Dim product As Product
'Pull the product in from our database using the productName
product = db.ReadProduct(productName)
'Add necessary markup to str variable, with products information within
str += "<div class='storeItem'>"
' str += " <img alt='Item Picture' class='itemPicture' src='" + product.ImagePath.Substring(3).Replace("\", "/") + "' />"
' str += " <div class='itemInfo'>"
str += " <h1 class='itemName'>"
str += " " + product.Name + "</h1>"
str += " <h3 class='itemDescription'>"
str += " " + product.Description + "</h3>"
str += " <p class='itemPrice'>"
str += " " + product.Price.ToString("c") + "</p>"
str += " "
str += " </div>"
str += " </div>"
End Sub
'Uses
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim productNames As New List(Of String)
'Pull the product names using the database
productNames = db.getProductNames
'Loop through all product names
For Each name As String In productNames
'Add necessary markup and product info to str variable
printMenuBlock(name)
Next
'Print the str variable in our menuPlace div
menuPlace.InnerHtml = str
End Sub
End Class
This is functions from interaction class:
Private Sub GetProduct(ByVal CatIn As String)
' SQL String
Dim strSelect As String
strSelect = "SELECT * "
strSelect &= " FROM Menu "
' strSelect &= " WHERE (ProductCat = 'Burgers')"
' Set up the connection to the datebase
cmdSelect.Connection = conIn.Connect
' Add the SQL string to the connection
cmdSelect.CommandText = strSelect
' Add the parameters to the connection
cmdSelect.Parameters.Add("#CatIn", SqlDbType.NVarChar).Value = CatIn
End Sub
'Executes the SQL statement to find a Product by ProductId
Public Function ReadProduct(ByVal CatIn As String) As Product
' Product object initalized to nothing
Dim prod As Product = Nothing
Try
Call GetProduct(CatIn)
Dim dbr As SqlDataReader
Dim strCat As String
Dim strName As String
Dim strDesc As String
Dim decPrice As Decimal
Dim strPath As String
' Execute the created SQL command from GetProduct and set to the SqlDataReader object
dbr = cmdSelect.ExecuteReader
dbr.Read()
' Check if there are any returned values
If dbr.HasRows Then
' Assign the value in column two to strName
strCat = dbr.GetString(1)
' Assign the value in column two to strName
strName = dbr.GetString(2)
' Assign the value in column three to strDesc
strDesc = dbr.GetString(3)
' Assing the value in column four to intPrice
decPrice = ToDecimal(dbr.GetValue(4))
'Assign the value in column five to strPath
'strPath = dbr.GetString(3)
' Create the new Product object from the returned values
prod = New Product(strName, strDesc, decPrice, strCat, strPath)
End If
' Clear the SQL parameters and close the connection
cmdSelect.Parameters.Clear()
dbr.Close()
Catch ex As SqlException
Dim strOut As String
strOut = ex.Message
Console.WriteLine(strOut)
End Try
' Return the Product object
Return prod
End Function
'Returns a list of Product Names
Public Function getProductNames() As List(Of String)
Dim list As New List(Of String)
Dim sql As String = "SELECT ProductName FROM Menu " +
"WHERE (ProductCat) = 'Burgers'"
'"DISTINCT 'ProductName'"
cmdSelect.CommandText = sql
cmdSelect.Connection = conIn.Connect
Dim dbr As SqlDataReader
dbr = cmdSelect.ExecuteReader
If dbr.HasRows Then
Do While dbr.Read()
list.Add(dbr.GetString(0))
Loop
End If
dbr.Close()
Return list
End Function
There is obviously a Product Class but don't think that is necessary to show on here.
Also, ignore the string path, that will be for images later. Thanks for any help. I'm pretty sure instead of do while I need a for each somewhere but just can't get her done. Thanks in advance.
Products Class:
Public Class Product
Private pName As String
Private pDescription As String
Private pPrice As Integer
Private pPath As String
Private pCat As String
'Constructor, uses database to populate properties based on productName
Public Sub New(ByVal productName As String)
Dim data As New Interaction
Dim work As Product
work = data.ReadProduct(productName)
pCat = work.Cat
pName = work.Name
pDescription = work.Description
pPrice = work.Price
End Sub
'Constructor, populates properties from passed in values
Public Sub New(ByVal NameIn As String,
ByVal DescriptionIn As String, ByVal PriceIn As Integer, ByVal CatIn As String, ByVal ImagePathIn As String)
pName = NameIn
pDescription = DescriptionIn
pPrice = PriceIn
pPath = ImagePathIn
pCat = CatIn
End Sub
'Stores name of product
Public ReadOnly Property Name() As String
Get
Return pName
End Get
End Property
'Stores a description of the product
Public ReadOnly Property Description() As String
Get
Return pDescription
End Get
End Property
'Stores the price of the product
Public ReadOnly Property Price() As Integer
Get
Return pPrice
End Get
End Property
'Stores the path to the image associated with this product
Public ReadOnly Property ImagePath() As String
Get
Return pPath
End Get
End Property
'Stores name of product
Public ReadOnly Property Cat() As String
Get
Return pCat
End Get
End Property
End Class

Use this instead
Public Function ReadProduct(ByVal CatIn As String) As List(Of Dictionary(String, Of String))
Dim ReturnProducts As New List(Of Dictionary(String, Of String))
Try
Call GetProduct(CatIn)
Dim dbr As SqlDataReader
' Execute the created SQL command from GetProduct and set to the SqlDataReader object
dbr = cmdSelect.ExecuteReader
Dim FieldCount = dbr.FieldCount()
Dim ColumnList as New List(Of String)
For i as Integer = 0 to FieldCount - 1
ColumnList.Add(dbr.GetName(i))
Next
While dbr.Read()
Dim ReturnProduct As New Dictionary(String, Of String)
For i as Integer = 0 to FieldCount - 1
ReturnProduct.Add(ColumnList(i), dbr.GetValue(i).toString())
Next
ReturnProducts.Add(ReturnProduct)
End While
cmdSelect.Parameters.Clear()
dbr.Close()
Catch ex As SqlException
Dim strOut As String
strOut = ex.Message
Console.WriteLine(strOut)
End Try
' Return the Product object
Return ReturnProducts
End Function
then, inside printMenuBlock, you declare product with
Dim product = db.ReadProduct(productName)
and later, you access it like so
For i as Integer = 0 to product.Count - 1
'do everything normally for building str except, for example, if you want
'to acccess product.Name as before, access it with product(i).Item("Name"),
'assuming that your column name/alias for "Name" is in fact "Name"
'i personally like to align column names to variable names for laziness's sake
'bad obfuscation practice tho if you don't use aliases
Next

Related

Issues on loop for retrieve the dynamic sql parameter values from dynamic textboxes

all. I am a new VB.NET beginner. I am facing the issue of how to pass the dynamic SQL parameter values from the dynamic textboxes to search the data. I had added control of dynamic textboxes and labels and would like to search the data on the database table based on the dynamic textboxes value inputted from the user. Currently, I can only able to search the data from 1 dynamic textbox value only.
I want all the values from the dynamic textboxes that the user had been entered can be retrieved, and search the data based on the SQL parameter variable name and value entered by the user.
Can someone give me some solutions on how to solve this problem? I had stuck on this problem for a few days. Thank you for all the help!
What I had tried:
Private Sub FilterData()
Dim count As Integer = 0
'filterdata for radiobutton
Try
For Each TextBox As TextBox In grp2.Controls.OfType(Of TextBox)()
For Each Label As Label In grp2.Controls.OfType(Of Label)()
Using connection As New SqlConnection("connectionString")
'user key in the SQL statement
sql = TextBox1.Text
Dim sql2 As String
sql2 = sql
Dim sp1 As String() = sql.Split(New String() {"where"}, StringSplitOptions.None)
sql = sp1(0) & " where " & Label.Text & " = #parameter or " & Label.Text & " =#parameter"
If (TextBox.Text <> "") Then
count += 1
For j As Integer = 0 To count - 1
Using cmd As New SqlCommand(sql, connection)
cmd.Parameters.AddWithValue("#parameter", TextBox.Text)
'cmd.Parameters.Add("#parameter", SqlDbType.NVarChar, 20).Value = TextBox.Text
connection.Open()
Dim dt As New DataTable()
Dim reader As SqlDataReader
reader = cmd.ExecuteReader()
dt.Load(reader)
DataGridView1.DataSource = dt
End Using
Next
Else
GetData()
End If
'cmd.Dispose()
connection.Close()
End Using
Next
Next
Catch ex As Exception
'MsgBox(ex.Message)
End Try
End Sub
Firstly, if you have a 1:1 correspondence between Labels and TextBoxes then you should not be using two nested For Each loops, because that is going to pair up each and every Label with each and every TextBox. What you should be doing is creating arrays and then using a single For loop to access the pairs of controls:
Dim labels = grp2.Controls.OfType(Of Label)().ToArray()
Dim textBoxes = grp2.Controls.OfType(Of TextBox)().ToArray()
For i = 0 To labels.getUpperBound(0)
Dim label = labels(i)
Dim textBox = textBoxes(i)
'...
Next
As for build the SQL and adding the parameters, I would tend to do it something like this:
Dim labels = grp2.Controls.OfType(Of Label)().ToArray()
Dim textBoxes = grp2.Controls.OfType(Of TextBox)().ToArray()
Dim criteria As New List(Of String)
Dim command As New SqlCommand
For i = 0 To labels.getUpperBound(0)
Dim label = labels(i)
Dim textBox = textBoxes(i)
Dim parameterName = "#" & label.Text.Replace(" ", "_")
criteria.Add($"[{label.Text}] = {parameterName}")
command.Parameters.AddWithValue(parameterName, textBox.Text)
Next
Dim sql = "SELECT * FROM MyTable"
If criteria.Any() Then
sql &= " WHERE " & String.Join(" OR ", criteria)
End If
command.CommandText = sql
I think that you should begin to separate UI and data logic here is an example of implementation:
First you have a table in database:
CREATE TABLE Customer (
Id INT IDENTITY (1, 1) PRIMARY KEY,
FirstName VARCHAR (255) NOT NULL,
LastName VARCHAR (255) NOT NULL,
Phone VARCHAR (25),
Email VARCHAR (255) NOT NULL,
Street VARCHAR (255),
City VARCHAR (50),
State VARCHAR (25),
ZipCode VARCHAR (5)
);
Then you create the underlying entity in VB. Net:
Public Class Customer
Public Property Id As Integer
Public Property FirstName As String
Public Property LastName As String
Public Property Phone As String
Public Property Email As String
Public Property Street As String
Public Property City As String
Public Property State As String
Public Property ZipCode As String
End Class
Data loader
Now you need a data access component that loads records to a list of this above entity here a nice implementation:
Imports System.Data.SqlClient
Public Class CustomerDataAccess
Public Property ConStr As String
Public Sub New(ByVal constr As String)
constr = constr
End Sub
Public Function GetCustomersByCriterias(constraints As Object) As List(Of Customer)
Dim query As String = "SELECT Id, FirstName, LastName, Phone, Email, Street, City, State, ZipCode
FROM [dbo].[Customer] "
Dim result = New List(Of Customer)()
Using con = New SqlConnection(ConStr)
Using cmd = con.CreateCommand()
cmd.CommandType = CommandType.Text
cmd.CommandText = query
'' here the magic to add dynamic criteria coming from constraints
cmd.ApplyConstraints(Of Customer)(constraints)
con.Open()
LoadCustomerData(cmd, result)
End Using
End Using
Return result
End Function
Private Sub LoadCustomerData(ByVal cmd As SqlCommand, ByVal result As List(Of Customer))
Using rdr = cmd.ExecuteReader()
Dim idIdx As Integer = rdr.GetOrdinal("Id")
Dim firstNameIdx As Integer = rdr.GetOrdinal("FirstName")
Dim lastNameIdx As Integer = rdr.GetOrdinal("LastName")
Dim phoneIdx As Integer = rdr.GetOrdinal("Phone")
Dim emailIdx As Integer = rdr.GetOrdinal("Email")
Dim streetIdx As Integer = rdr.GetOrdinal("Street")
Dim cityIdx As Integer = rdr.GetOrdinal("City")
Dim stateIdx As Integer = rdr.GetOrdinal("State")
Dim zipCodeIdx As Integer = rdr.GetOrdinal("ZipCode")
While rdr.Read()
Dim item = New Customer()
item.Id = rdr.GetValueOrDefault(Of Integer)(idIdx)
item.FirstName = rdr.GetValueOrDefault(Of String)(firstNameIdx)
item.LastName = rdr.GetValueOrDefault(Of String)(lastNameIdx)
item.Phone = rdr.GetValueOrDefault(Of String)(phoneIdx)
item.Email = rdr.GetValueOrDefault(Of String)(emailIdx)
item.Street = rdr.GetValueOrDefault(Of String)(streetIdx)
item.City = rdr.GetValueOrDefault(Of String)(cityIdx)
item.State = rdr.GetValueOrDefault(Of String)(stateIdx)
item.ZipCode = rdr.GetValueOrDefault(Of String)(zipCodeIdx)
result.Add(item)
End While
End Using
End Sub
End Class
Extensions methods
Below are extensions methods referenced above that do the magic you are looking for:
DataReader extensions to make it easy to read values from SalDataReader with Dbnull exfeptional case and casting
Module DataReaderExtenions
<Extension()>
Function GetValueOrDefault(Of T)(row As IDataRecord, fieldName As String) As T
Dim ordinal = row.GetOrdinal(fieldName)
Return row.GetValueOrDefault(Of T)(ordinal)
End Function
<Extension()>
Function GetValueOrDefault(Of T)(row As IDataRecord, ordinal As Integer) As T
Return (If(row.IsDBNull(ordinal), Nothing, row.GetValue(ordinal)))
End Function
<Extension()>
Function GetValueOrDefaultSqlite(Of T)(row As IDataRecord, fieldName As String) As T
Dim ordinal = row.GetOrdinal(fieldName)
Return row.GetValueOrDefault(Of T)(ordinal)
End Function
<Extension()>
Function GetValueOrDefaultSqlite(Of T)(row As IDataRecord, ordinal As Integer) As T
Return (If(row.IsDBNull(ordinal), Nothing, Convert.ChangeType(row.GetValue(ordinal), GetType(T))))
End Function
End Module
Command extensions that lets you extract criteria from an anonymous object values:
Imports System.Reflection
Imports System.Runtime.CompilerServices
Module CommandExtensions
<Extension()>
Function AddParameter(command As IDbCommand, name As String, value As Object) As IDataParameter
If command Is Nothing Then Throw New ArgumentNullException("command")
If name Is Nothing Then Throw New ArgumentNullException("name")
Dim p = command.CreateParameter()
p.ParameterName = name
p.Value = If(value, DBNull.Value)
command.Parameters.Add(p)
Return p
End Function
<Extension()>
Function ToDictionary(data As Object) As Dictionary(Of String, Object)
If TypeOf data Is String OrElse data.[GetType]().IsPrimitive Then Return New Dictionary(Of String, Object)()
Return (From [property] In data.[GetType]().GetProperties(BindingFlags.[Public] Or BindingFlags.Instance)
Where [property].CanRead
Select [property]).ToDictionary(Function([property]) [property].Name, Function([property]) [property].GetValue(data, Nothing))
End Function
<Extension()>
Sub ApplyConstraints(Of TEntity)(cmd As IDbCommand, constraints As Object)
If constraints Is Nothing Then Return
Dim dictionary = constraints.ToDictionary()
Dim whereClause = " WHERE "
For Each kvp In dictionary
Dim columnName = kvp.Key
Dim propertyName = kvp.Key
Dim prefix = "#"c
Dim value = kvp.Value
whereClause += $"{columnName} **like** {prefix}{propertyName} AND "
cmd.AddParameter(propertyName, value)
Next
If String.IsNullOrEmpty(whereClause) Then Return
cmd.CommandText += whereClause.Remove(whereClause.Length - 5, 5)
End Sub
End Module
Example:
After coded all these stuff now you can do the following:
Dim DataGridView1 As DataGridView = New DataGridView()
Dim ConStr As String = ConfigurationManager.ConnectionStrings("MyApp").ConnectionString
Dim dal As CustomerDataAccess = New CustomerDataAccess(ConStr)
Dim criterias = New With {.FirstName = "%James%", .LastName = "%Nadin%"}
DataGridView1.DataSource = dal.GetCustomersByCriterias(criterias)
Despite all this code you are still need to bind your textbox (after naming them correctly) to a SearchEntity and use this entity to provide criterias
I hope this material can help you tackle your issue and incite you to improve your architecture & dev skills

Query in VB.net sometimes doesn't work

I have a functionality which saves the information from a webform to the database, which is working fine.
This is my code for save functionality in Onspec.aspx.vb page
Public Sub SaveClick(ByVal sender As Object, ByVal e As System.EventArgs)
If Not Page.IsValid Then
litMessage.Text = ""
Exit Sub
End If
Try
Dim sName As String = ""
With EmployerCandidate
.employerid = Master.Employer.ID
.employeruserid = 0
Try
.CVID = DocId
Catch
End Try
.Name = uxName.Text
.SurName = uxSurname.Text
Try
.PostCode = uxPostcode.Text
Catch ex As Exception
End Try
.Email = uxEmail.Text
Try
.MobileNo = uxMobileNo.Text
Catch ex As Exception
End Try
.OnSpec = True
.OnSpecType = uxOnSpecCategory.SelectedItem.Text
.Source = uxSourceID.SelectedItem.Text
.LastEmployer = uxEmployer.Text
.LastJobTitle = uxJobtitle.Text
.Profile = uxProfile.Text.Trim
End With
' email()
ResetForm()
panForm.Visible = False
panUpload.Visible = True
uxSubmit.Visible = False
uxUpload.Visible = True
litMessage.Text = "Thank you for submitting your details! We'll be in touch when appropriate vacancy arises. <a href='#' onclick='parent.$.colorbox.close()'>Close</a>"
UploadPanel.Visible = False
Response.Redirect("onspec-complete.aspx?e=" & Master.Employer.ID)
Catch ex As Exception
litMessage.Text = Core.Helper.FancyMessage("Error as occurred - " & ex.Message.ToString, "ERROR")
End Try
End Sub
Now, I want to send emails along with saving the data in the database so I added the following lines of code before ResetForm().
Dim specmatch As DataRow = DB.GetRow("SELECT TOP 1 name,email,password FROM [user] usr JOIN employeruser empUsr ON usr.id = empUsr.userid WHERE empUsr.empusertype = 1 AND empUsr.employerid = #eid ", DB.SIP("eid", LocalHelper.UserEmployerID))
If my query returns a value then I want to send email by calling the email function.
If specmatch IsNot Nothing Then
email()
End If
But in this line of code the employerid value is sometimes empty. It can't pick the id therefore it is returning an empty row. And therefore it's not calling the email function.
This id is the same as
.employerid = Master.Employer.ID
But if I replace the LocalHelper.UserEmployerID with Master.Employer.ID the form gives an error:
Object reference not set to an instance of an object.
employerid is an integer value.
I have also tried to add the following lines of code in this page(Onspec.aspx.vb)
Public ReadOnly Property EmployerId() As Integer
Get
Return Master.Employer.ID
End Get
End Property
But I get the same error:
Object reference not set to an instance of an object.
The above lines of code does not make any difference.
So I replaced Master.Employer.ID with LocalHelper.UserEmployerID
Where in localhelper.vb file (under appcode folder) it is determining employerid from the website with following lines of code.
Public Shared Function UserEmployerID() As Integer
If HttpContext.Current.Items("lh_useremployerid") Is Nothing Then
If LocalHelper.UserTypeCode = "e" Then
HttpContext.Current.Items("lh_useremployerid") = Core.DB.GetInteger("SELECT employerid FROM employeruser WHERE userid = " & LocalHelper.UserID)
Else
HttpContext.Current.Items("lh_useremployerid") = 0
End If
End If
Return HttpContext.Current.Items("lh_useremployerid")
End Function
These lines of code has been used in many places and works perfectly fine. In this case as well, it was working fine last Friday and now it's not. There was no changes made.
This is my email function
Private Sub email()
Dim strCandidateName As String = uxName.Text.Trim & " " & uxSurname.Text.Trim
Dim strCandidateSurname As String = uxSurname.Text
Dim strCandidateEmail As String = uxEmail.Text.Trim
Dim strCandidatePhone As String = uxMobileNo.Text.Trim
Dim strCPass As String = "mpb123"
Dim strContactType As String = "Speculative Application has been submited on the category of " & uxOnSpecCategory.SelectedItem.Text
Dim strContactMessage As String = uxProfile.Text.Trim
'''''''''''''''''''variable
Dim qq As String = String.Format("Select top 1 name, email, password FROM [user] WHERE id in (Select userid FROM employeruser WHERE empusertype=1 and employerid= " & LocalHelper.UserEmployerID & ")")
Dim drow As DataRow = Core.DB.GetRow(qq)
Dim semail As String = drow.Item("email").ToString
Dim sname As String = drow.Item("name").ToString
Dim spass As String = drow.Item("password").ToString
'''''''''''''''''''variable
Dim Email As Core.Email
'New Onspec Candidate Email sent to EmployerUser who is assigned to receive onspec email
Email = New Core.Email
With Email
.ContentID = 99
.Replacement("ContactName", strCandidateName)
.Replacement("ContactEmail", strCandidateEmail)
.Replacement("ContactTelephone", strCandidatePhone)
.Replacement("ContactType", strContactType)
.Replacement("ContactMessage", strContactMessage)
.Replacement("AdminContactName", sname)
.Replacement("AdminContactEmail", semail)
.Replacement("SiteName", LocalHelper.AppSetting("sitename"))
Dim attachments As New Generic.List(Of String)
If EmployerCandidate.CVID > 0 Then
Dim doc As New Document(EmployerCandidate.CVID)
attachments.Add(doc.PathOnDisc)
End If
.Attachments = Join(attachments.ToArray(), ";")
.Send()
End With
End Sub
GetRow function is defined in my database.vb page like following which is also used in many other places.
Shared Function GetRow(ByVal selectQueryText As String, ByVal ParamArray params As SqlParameter()) As DataRow
Return GetRowFromDB(selectQueryText, CommandType.Text, params)
End Function
And
Shared Function GetRowFromDB(ByVal selectCommandText As String, ByVal selectCommandType As CommandType, ByVal ParamArray params As SqlParameter()) As DataRow
Dim conn As SqlConnection = Nothing
Try
conn = GetOpenSqlConnection()
Return GetRowFromDB(conn, selectCommandText, selectCommandType, params)
Finally
If conn IsNot Nothing Then conn.Dispose()
End Try
End Function
Please suggest ways on how I can organize my code so that it works all the time.

I want to retrieve a person phone number using Active directory

When I try to get the phone number of a person from Active Directory, all the properties are loaded but except mail nothing is returned. Can someone please help out in how to retrieve the phone number with some changes in the below code? In myrelustpropcollection.propertynames only 2 is the count ADSPATH and mail. No other property is loaded.
Public Function GetPhoneByName(ByVal Name As String) As String
Dim srch As DirectorySearcher
Dim results As SearchResultCollection = Nothing
Dim phone As Integer
srch = New DirectorySearcher(New DirectoryEntry())
srch.Filter = "(mailnickname=" + Name + ")"
srch.PropertiesToLoad.Add("homephone")
srch.PropertiesToLoad.Add("mail")
srch.PropertiesToLoad.Add("mobile")
srch.PropertiesToLoad.Add("telephoneNumber")
Try
results = srch.FindAll()
Catch ex As Exception
End Try
For Each result In results
Dim myKey As String
Dim myResultPropCollection As ResultPropertyCollection
myResultPropCollection = result.Properties
For Each myKey In myResultPropCollection.PropertyNames
Dim tab1 As String = " "
Dim myCollection As Object
Select Case myKey
Case "mobile" ' Telephone Number
For Each myCollection In myResultPropCollection(myKey)
phone = myCollection.toint
Next myCollection
End Select
Next myKey
Next
Return phone
End Function
This works fine for me and the code is more concise:
Imports System.DirectoryServices.AccountManagement
Imports System.DirectoryServices
Imports System.Collections
Public Function GetPhoneByName(Name As String) As String
Dim ctx As New PrincipalContext(ContextType.Domain, "DomainName")
Dim q As New UserPrincipal(ctx)
q.DisplayName = Name
Dim s As PrincipalSearcher = New PrincipalSearcher(q)
Dim ds As DirectorySearcher = s.GetUnderlyingSearcher
ds.PropertiesToLoad.Clear()
ds.PropertiesToLoad.Add("homephone")
ds.PropertiesToLoad.Add("mail")
ds.PropertiesToLoad.Add("mobile")
ds.PropertiesToLoad.Add("telephoneNumber")
For Each dsResult As SearchResult In ds.FindAll()
For Each itm As DictionaryEntry In dsResult.Properties
Select Case itm.Key
Case "mobile"
Return itm.Value(0)
End Select
Next
Next
Return "Not found"
End Function
The following code will return all values available for the user from the active directory:
Imports System.DirectoryServices
Module AdTest
Sub Main()
GetPhoneByName("Persons Display Name")
Console.ReadLine()
End Sub
Public Sub GetPhoneByName(ByVal Name As String)
Dim srch As New DirectorySearcher(New DirectoryEntry())
srch.Filter = "(displayname=" + Name + ")"
For Each result As SearchResult In srch.FindAll()
For Each key As DictionaryEntry In result.Properties
For Each keyVal In result.Properties(key.Key)
Try
Console.WriteLine(key.Key + ": " + keyVal)
Catch ex As Exception
'value of keyVal could not convert to string (probably byte array)
End Try
Next
Next
Next
End Sub
End Module

How to Group and Sort details by date-bubble sort?

First off thanks for reading this, I've spent the last four hours trying to work this out.
Essentially I'm building a application in where the user inputs: date, Name, Phone number and instructor name to a simple csv .txt database file. I've got all that working.
Now all I need to do is somehow group the details together, and separate from other entries.
I now want to sort these grouped details by date through a bubble sort and then save it to another file. WHen I say sort, I want the other details to go along with the date.
The date when inputted to the application has to be: (yyMMddhhmm)
Eg: 1308290930 = 9:30 on 29/08/13
I can post what I've done thus far.
Public Class Form2
Dim currentRow As String()
Dim count As Integer
Dim one As Integer
Dim two As Integer
Dim three As Integer
Dim four As Integer
Dim catchit(100) As String
Dim count2 As Integer
Dim arrayone(50) As Integer
Dim arraytwo(50) As String
Dim arraythree(50) As Integer
Dim arrayfour(50) As String
Dim bigstring As String
Dim builder As Integer
Dim twodata As Integer
Private Sub Form2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'Me.RichTextBox1.LoadFile("D:\completerecord.txt", RichTextBoxStreamType.PlainText)
Using MyReader As New Microsoft.VisualBasic.FileIO.TextFieldParser("D:\completerecord.txt")
MyReader.TextFieldType = FileIO.FieldType.Delimited
MyReader.SetDelimiters(",")
Dim currentRow As String()
Dim count As Integer
count = 0
While Not MyReader.EndOfData
Try
currentRow = MyReader.ReadFields()
Dim currentField As String
For Each currentField In currentRow
' makes one array to contain a record for each peice of text in the file
'MsgBox(currentField) '- test of Field Data
' builds a big string with new line-breaks for each line in the file
bigstring = bigstring & currentField + Environment.NewLine
'build two arrays for the two columns of data
If (count Mod 2 = 1) Then
arraytwo(two) = currentField
two = two + 1
'MsgBox(currentField)
ElseIf (count Mod 2 = 0) Then
arrayone(one) = currentField
one = one + 1
End If
count = count + 1
'MsgBox(count)
Next
Catch ex As Microsoft.VisualBasic.FileIO.MalformedLineException
MsgBox("Error Occured, Please contact Admin.")
End Try
End While
End Using
RichTextBox1.Text = bigstring
' MsgBox("test")
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim NoMoreSwaps As Boolean
Dim counter As Integer
Dim Temp As Integer
Dim Temp2 As String
Dim listcount As Integer
Dim builder As Integer
Dim bigString2 As String = ""
listcount = UBound(arraytwo)
'MsgBox(listcount)
builder = 0
'bigString2 = ""
counter = 0
Try
'this should sort the arrays using a Bubble Sort
Do Until NoMoreSwaps = True
NoMoreSwaps = True
For counter = 0 To (listcount - 1)
If arraytwo(counter) > arraytwo(counter + 1) Then
NoMoreSwaps = False
If arraytwo(counter + 1) > 0 Then
Temp = arraytwo(counter)
Temp2 = arrayone(counter)
arraytwo(counter) = arraytwo(counter + 1)
arrayone(counter) = arrayone(counter + 1)
arraytwo(counter + 1) = Temp
arrayone(counter + 1) = Temp2
End If
End If
Next
If listcount > -1 Then
listcount = listcount - 1
End If
Loop
'now we need to output arrays to the richtextbox first we will build a new string
'and we can save it to a new sorted file
Dim FILE_NAME As String = "D:\sorted.txt"
If System.IO.File.Exists(FILE_NAME) = True Then
Dim objWriter As New System.IO.StreamWriter(FILE_NAME, True)
While builder < listcount
bigString2 = bigString2 & arraytwo(builder) & "," & arrayone(builder) + Environment.NewLine
objWriter.Write(arraytwo(builder) & "," & arrayone(builder) + Environment.NewLine)
builder = builder + 1
End While
RichTextBox2.Text = bigString2
objWriter.Close()
MsgBox("Text written to log file")
Else
MsgBox("File Does Not Exist")
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
End Class
Create a class to hold the information for each entry, like this:
Public Class MyEntry
Public Property TheDate() As DateTime
Get
Return m_Date
End Get
Set
m_Date = Value
End Set
End Property
Private m_Date As DateTime
Public Property Name() As String
Get
Return m_Name
End Get
Set
m_Name = Value
End Set
End Property
Private m_Name As String
Public Property PhoneNumber() As String
Get
Return m_PhoneNumber
End Get
Set
m_PhoneNumber = Value
End Set
End Property
Private m_PhoneNumber As String
Public Property Instructor() As String
Get
Return m_Instructor
End Get
Set
m_Instructor = Value
End Set
End Property
Private m_Instructor As String
Public Sub New(date As DateTime, name As String, phoneNumber As String, instructor As String)
TheDate = date
Name = name
PhoneNumber = phoneNumber
Instructor = instructor
End Sub
End Class
Now you can create a list of the above class, like this:
Private entries As var = New List(Of MyEntry) From { _
New MyEntry(DateTime.Now.AddDays(-1), "Dummy 1", "555-123-4567", "Instructor A"), _
New MyEntry(DateTime.Now.AddDays(-1), "Dummy 2", "555-124-4567", "Instructor B"), _
New MyEntry(DateTime.Now.AddDays(-1), "Dummy 3", "555-125-4567", "Instructor C"), _
New MyEntry(DateTime.Now.AddDays(-2), "Dummy 4", "555-126-4567", "Instructor A"), _
New MyEntry(DateTime.Now.AddDays(-2), "Dummy 5", "555-127-4567", "Instructor B") _
}
Note: You will need to substitute your real values here and would use some type of looping structure to do that.
Now you can apply the LINQ GroupBy function to the list of entries, like this:
Private entriesByDate As var = entries.GroupBy(Function(x) x.TheDate).ToList()
This results in a list of two entries for the dummy data I created above, your amount of groupings will vary based upon your actual data.
Now you could loop through the list of groups, like this:
For Each entry In entriesByDate
' Put logic here to save each group to file
Next
My suggestion is to add a marker at the end of reach recoord (date, time, etc.). I use "|". Then, when you read the data back, split the records into an array, and read them out using that.
So it would be:
130829|0930|<name>|<phone number>|etc
Do you understand?

Sort list alphabetically

How can I get the resulting generated list of links sorted out alphabetically according to "sTitle"? My sort function on line 272 is not giving me the results I need. Please help.
<script language="VB" runat="server">
Function sectionTitle(ByRef f As String)
'Open a file for reading
'Dim FILENAME As String = Server.MapPath("index.asp")
Dim FILENAME As String = f
'Get a StreamReader class that can be used to read the file
Dim objStreamReader As StreamReader
objStreamReader = File.OpenText(FILENAME)
'Now, read the entire file into a string
Dim contents As String = objStreamReader.ReadToEnd()
'search string for <title>some words</title>
Dim resultText As Match = Regex.Match(contents, "(<title>(?<t>.*?)</title>)")
'put result into new string
Dim HtmlTitle As String = resultText.Groups("t").Value
Return HtmlTitle
' If HtmlTitle <> "" Then
'Response.Write(HtmlTitle)
' Else
'Response.Write("<ul><li>b: " & contents & "</a></li></ul>")
' End If
End Function
Public Class linkItem
Public myName As String
Public myValue As String
Public Sub New(ByVal myName As String, ByVal myValue As String)
Me.myName = myName
Me.myValue = myValue
End Sub 'New
End Class 'linkItem
Sub DirSearch(ByVal sDir As String)
Dim d As String
Dim f As String
Dim mylist As New List(Of linkItem)
Try
For Each d In Directory.GetDirectories(sDir)
'Response.Write("test c")
For Each f In Directory.GetFiles("" & d & "", "index.asp")
'Response.Write("test a")
Dim sTitle As String = sectionTitle(f)
'remove wilbur wright college - from sTitle string
sTitle = Regex.Replace(sTitle, "My College - ", "")
'print section title - must come before search n replace string
f = Regex.Replace(f, "C:\\inetpub\\wwwroot\\mypath\\", "")
'add to list
mylist.Add(New linkItem(f, sTitle))
'print links as list
'Response.Write("<ul><li><a href='" & f & "'>" & sTitle & "</a></li></ul>")
Next
DirSearch(d)
Next
Catch excpt As System.Exception
'Response.Write("test b")
Response.Write(excpt.Message)
End Try
mylist.Sort(Function(p1, p2) p1.myValue.CompareTo(p2.myValue))
mylist.ForEach(AddressOf ProcessLink)
End Sub
Sub ProcessLink(ByVal P As linkItem)
If (True) Then
Response.Write("<ul><li><a href='" & P.myName & "'>" & P.myValue & "</a></li></ul>")
End If
End Sub
</script>
<%
'Dim sDir As New DirectoryInfo(Server.MapPath(""))
Call DirSearch((Server.MapPath("")))
%>
Check out the IComparable interface to help with this.
Basically, you need to teach your program what to use as a comparison point of reference for your class.
IComparable will allow you to make use of the CompareTo() method.
Here's the sample code if you're interested:
Public Class Temperature
Implements IComparable
Public Overloads Function CompareTo(ByVal obj As Object) As Integer _
Implements IComparable.CompareTo
If TypeOf obj Is Temperature Then
Dim temp As Temperature = CType(obj, Temperature)
Return m_value.CompareTo(temp.m_value)
End If
Throw New ArgumentException("object is not a Temperature")
End Function
' The value holder
Protected m_value As Integer
Public Property Value() As Integer
Get
Return m_value
End Get
Set(ByVal Value As Integer)
m_value = Value
End Set
End Property
Public Property Celsius() As Integer
Get
Return (m_value - 32) / 2
End Get
Set(ByVal Value As Integer)
m_value = Value * 2 + 32
End Set
End Property
End Class