How would I write formatted data to a file and then read it? VB.NET (2012 edition) - vb.net

I'm practicing VB.NET and I've got a problem with Reading and writing to a .dat file. I have made a structure to store data temporarily (below).
Structure CustomerType
Dim AccountNum As String
Dim Surname As String
Dim Forename As String
Dim Balance As Decimal
End Structure
I then Dim everything.
Dim Customers(9) As CustomerType
Dim Filename As String = "Accounts.dat"
Dim NumberOfRecords As Short = 0
Dim myFormat As String = "{0,-15}|{1,-15}|{2,-10}|{3,-10}"
I have a button that creates a new account and this is where I get the problem.
FileOpen(1, Filename, OpenMode.Random, , , )
For i = 1 To Customers.Length() - 1
With Customers(i)
.Forename = InputBox("First name", "Forename")
Do Until .Forename <> "" And TypeOf .Forename Is String
.Forename = InputBox("First name", "Forename")
Loop
.Surname = InputBox("Surname", "Surname")
Do Until .Surname <> "" And TypeOf .Surname Is String
.Surname = InputBox("Surname", "Surname")
Loop
.AccountNum = InputBox("Account Number of " & Customers(i).Forename & " " & Customers(i).Surname & ".", "Account Number")
Do Until .AccountNum.Length = 8 And TypeOf .AccountNum Is String
.AccountNum = InputBox("Account Number of " & Customers(i).Forename & " " & Customers(i).Surname & ".", "Account Number")
Loop
.Balance = InputBox("Balance of " & Customers(i).Forename & " " & Customers(i).Surname & ".", "Balance")
Do Until .Balance > -1
.Balance = InputBox("Balance of " & Customers(i).Forename & " " & Customers(i).Surname & ".", "Balance")
Loop
FilePut(1, Customers, NumberOfRecords + 1)
NumberOfRecords += 1
lblNumberOfRecords.Text = NumberOfRecords
End With
Next
FileClose(1)
I have another button that displays the data in a listbox. I can only get one item to display before I get a bad length error.
Dim Index As Integer
ListBox1.Items.Clear()
ListBox1.Items.Add(String.Format(myFormat, "Forename", "Surname", "Acc. Num.", "Balance"))
ListBox1.Items.Add("_____________________________________________________")
FileOpen(1, Filename, OpenMode.Random, , , )
For Index = 1 To NumberOfRecords
FileGet(1, Customers)
ListBox1.Items.Add(String.Format(myFormat, Customers(Index).Forename, Customers(Index).Surname, Customers(Index).AccountNum, Format(Customers(Index).Balance, "currency")))
Next Index
FileClose(1)
The main question that I have is What am I doing wrong, and how can I fix it?
Many Thanks in advance,
Jordan

First you'll need to import these namespaces:
Imports System.Runtime.Serialization
Imports System.Runtime.Serialization.Formatters.Binary
Imports System.IO
Model
Change your customertype model to this:
<Serializable()> _
Public Class CustomerType
Implements ISerializable
Public Sub New()
End Sub
Protected Sub New(info As SerializationInfo, context As StreamingContext)
Me.AccountNum = info.GetString("AccountNum")
Me.Surname = info.GetString("Surname")
Me.Forename = info.GetString("Forename")
Me.Balance = info.GetDecimal("Balance")
End Sub
Public AccountNum As String
Public Surname As String
Public Forename As String
Public Balance As Decimal
Public Sub GetObjectData(info As System.Runtime.Serialization.SerializationInfo, context As System.Runtime.Serialization.StreamingContext) Implements System.Runtime.Serialization.ISerializable.GetObjectData
info.AddValue("AccountNum", Me.AccountNum)
info.AddValue("Surname", Me.Surname)
info.AddValue("Forename", Me.Forename)
info.AddValue("Balance", Me.Balance)
End Sub
End Class
Your model do now support serialization. Next step is to create functions to read/write a model collection to/from a file.
Write
Friend Shared Sub Write(filePathAndName As String, list As List(Of CustomerType))
Dim formatter As IFormatter = New BinaryFormatter()
Using stream As New FileStream(filePathAndName, FileMode.Create, FileAccess.Write, FileShare.None)
formatter.Serialize(stream, list)
End Using
End Sub
Read
Friend Shared Function Read(filePathAndName As String) As List(Of CustomerType)
Dim formatter As IFormatter = New BinaryFormatter()
Dim list As List(Of CustomerType) = Nothing
Using stream As New FileStream(filePathAndName, FileMode.Open, FileAccess.Read, FileShare.None)
list = DirectCast(formatter.Deserialize(stream), List(Of CustomerType))
End Using
Return list
End Function
Usage
Drop a button named Button1 onto a form named Form1 and add this code:
Public Class Form1
Public Sub New()
Me.InitializeComponent()
End Sub
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
Dim path As String = "C:\test.dat" '<- Change to desired path
Dim list As New List(Of CustomerType)
'Create test item1 and add to list.
Dim item1 As New CustomerType()
With item1
.AccountNum = "1"
.Balance = 1000D
.Forename = "Forename 1"
.Surname = "Surname 1"
End With
list.Add(item1)
'Create test item2 and add to list.
Dim item2 As New CustomerType()
With item2
.AccountNum = "2"
.Balance = 2000D
.Forename = "Forename 2"
.Surname = "Surname 2"
End With
list.Add(item2)
'Write to file:
Write(path, list)
'Read from file into new list:
Dim list2 As List(Of CustomerType) = Read(path)
MsgBox(String.Format("Count={0}", list2.Count))
End Sub
Friend Shared Sub Write(filePathAndName As String, list As List(Of CustomerType))
Dim formatter As IFormatter = New BinaryFormatter()
Using stream As New FileStream(filePathAndName, FileMode.Create, FileAccess.Write, FileShare.None)
formatter.Serialize(stream, list)
End Using
End Sub
Friend Shared Function Read(filePathAndName As String) As List(Of CustomerType)
Dim formatter As IFormatter = New BinaryFormatter()
Dim list As List(Of CustomerType) = Nothing
Using stream As New FileStream(filePathAndName, FileMode.Open, FileAccess.Read, FileShare.None)
list = DirectCast(formatter.Deserialize(stream), List(Of CustomerType))
End Using
Return list
End Function
End Class

Related

Drag and drop multiple files by filter into listview

I'm currently have this code to store data to listview
I have to store first the info to textbox lines and then store them to listview.
Is there easy way without storing first textbox and directly put the files into listview?
What I want is to drag and drop or browse the multiple video ts file in the first column and then the srt in the sub column.
hope that you know what I mean. I'm rally new in listview
Sub AddToListView()
LV.Items.Clear()
Dim vn = vName.Lines
Dim sn = sName.Lines
Dim vp = vPath.Lines
Dim sp = sPath.Lines
Dim items As New List(Of ListViewItem)
Dim upper = {vn.GetUpperBound(0), sn.GetUpperBound(0), vp.GetUpperBound(0), sp.GetUpperBound(0)}
For I = 0 To upper.Min
items.Add(New ListViewItem({vn(I), sn(I), vp(I), sp(I)}))
Next
LV.BeginUpdate()
LV.Items.AddRange(items.ToArray())
SortItems()
LV.EndUpdate()
AddToParam()
End Sub
Sub readFiles()
Dim folder As String = txtinputFolder.Text
Dim sb1 As New StringBuilder
Dim sb2 As New StringBuilder
Dim sb3 As New StringBuilder
Dim sb4 As New StringBuilder
For Each item In My.Computer.FileSystem.GetFiles(folder, FileIO.SearchOption.SearchTopLevelOnly, "*.ts")
sb1.Append(item & vbNewLine)
Next
vPath.Text = ""
vPath.Text = sb1.ToString.Trim
For Each file As String In My.Computer.FileSystem.GetFiles(folder, FileIO.SearchOption.SearchTopLevelOnly, "*.ts")
sb2.Append(Path.GetFileName(file) & vbNewLine)
Next
vName.Text = ""
vName.Text = sb2.ToString.Trim
For Each file As String In My.Computer.FileSystem.GetFiles(folder, FileIO.SearchOption.SearchTopLevelOnly, "*.srt")
sb3.Append(Path.GetFileName(file) & vbNewLine)
Next
sName.Text = ""
sName.Text = sb3.ToString.Trim
For Each item3 In My.Computer.FileSystem.GetFiles(folder, FileIO.SearchOption.SearchTopLevelOnly, "*.srt")
sb4.Append(item3 & vbNewLine)
Next
sPath.Text = ""
sPath.Text = sb4.ToString.Trim
End Sub
If i'm not wrong subtitle name should be the same as the movie
Sub readFiles(ByVal searchdirectory As String)
For Each FullPath In My.Computer.FileSystem.GetFiles(searchdirectory, FileIO.SearchOption.SearchTopLevelOnly, "*.ts")
Dim parentPath As String = Path.GetDirectoryName(FullPath)
Dim movieName As String = Path.GetFileNameWithoutExtension(FullPath)
Dim srtPath As String = parentPath & "\" & movieName & ".srt"
If File.Exists(srtPath) Then
Lv.Items.Add(FullPath).SubItems.AddRange(New String() {movieName & ".ts", srtPath, movieName & ".srt"})
Else
Lv.Items.Add(FullPath).SubItems.AddRange(New String() {movieName & ".ts", "Not Exist", "No subtitle"})
End If
Next
Lv.Sorting = SortOrder.Ascending
Lv.Sort()
End Sub
usage
readFiles("you path")
You could try something like this:
Sub AddToListView(vNames As String(), sNames As String(), vPaths As String(), sPaths As String())
LV.Items.Clear()
Dim items As New List(Of ListViewItem)
Dim upperBounds = {vNames.GetUpperBound(0), sNames.GetUpperBound(0), vPaths.GetUpperBound(0), sPaths.GetUpperBound(0)}
For i = 0 To upperBounds.Min
items.Add(New ListViewItem({vNames(i), sNames(i), vPaths(i), sPaths(i)}))
Next
LV.BeginUpdate()
LV.Items.AddRange(items.ToArray())
SortItems()
LV.EndUpdate()
AddToParam()
End Sub
Sub readFiles()
Dim folder As String = txtinputFolder.Text
Dim vPaths As New List(Of String)
Dim vNames As New List(Of String)
Dim sPaths As New List(Of String)
Dim sNames As New List(Of String)
For Each filePath In Directory.EnumerateFiles(folder, "*.ts")
vPaths.Add(filePath)
vNames.Add(Path.GetFileName(filePath))
Next
For Each filePath In Directory.EnumerateFiles(folder, "*.srt")
sPaths.Add(filePath)
sNames.Add(Path.GetFileName(filePath))
Next
AddToListView(vNames.ToArray(), sNames.ToArray(), vPaths.ToArray(), sPaths.ToArray())
End Sub
If you don't want readFiles calling AddToListView, you could use fields to store the data rather than local variables, or you could have readFields return the data in a Tuple or some dedicated object.
This seems like a reasonable answer based on the code provided and the actual question asked but it has nothing to do with drag and drop, so I'm not sure whether I'm missing something or you are.
Thank you here's my updated code:
since I want to show first the filename I tried to re-edit the code.
Sub readFiles(ByVal searchdirectory As String)
For Each FullPath In My.Computer.FileSystem.GetFiles(searchdirectory, FileIO.SearchOption.SearchTopLevelOnly, "*.ts")
Dim parentPath As String = Path.GetDirectoryName(FullPath)
Dim movieName As String = Path.GetFileNameWithoutExtension(FullPath)
Dim srtPath As String = parentPath & "\" & movieName & ".srt"
Dim allPath As String = parentPath & "\" & movieName
If File.Exists(srtPath) Then
LV.BeginUpdate()
Dim lvi As New ListViewItem
With lvi
.Text = movieName & ".ts" 'video filename
.SubItems.Add(movieName & ".srt") 'subtitle filename
.SubItems.Add(movieName & ".mkv") 'output filename
.SubItems.Add(allPath & ".ts") 'video path
.SubItems.Add(allPath & ".srt") 'subtitle path
End With
LV.Items.Add(lvi)
LV.EndUpdate()
Else
MsgBox("srt file not found in the folder", vbInformation, "")
End If
Next
LV.Sorting = SortOrder.Ascending
LV.Sort()
End Sub

How to return from ienumerable function in vb.net

Public Shared Function GetDataSet() As IEnumerable(Of SerialData)
Dim sCon As New SQLConnect
Dim strsql As String
Dim p As New Control
sCon.sqlAdp = New SqlDataAdapter
strsql = "select serialid," & _
" serialno," & _
" serialdesc," & _
" b.materialname," & _
" b.drawing," & _
" a.workorder," & _
" isnull((select top 1 patno from patternmaster where patid = a.patid),'Not Defined') as patno," & _
" case when a.activeflag = 1 then 'True' else 'False' end as activeflag" & _
" from serialmaster a," & _
" materialmaster b" & _
" where 1 = 1" & _
" and a.materialid = b.materialid" & _
" and b.activeflag = 1"
sCon.sqlCmd.CommandText = strsql
sCon.sqlAdp.SelectCommand = sCon.sqlCmd
sCon.sqlAdp.Fill(sCon.DS, "Listing")
Dim dtTable As DataTable
dtTable = sCon.DS.Tables("Listing")
' For Each row As DataRow In dtTable.Rows
' Return dtTable.AsEnumerable().[Select](Function(row) New With { _
' Key .serialid = row("serialid"), _
' Key .serialno = row("serialno"), _
' Key .serialdesc = row("serialdesc"), _
' Key .materialname = row("materialname"), _
' Key .drawing = row("drawing"), _
' Key .workorder = row("workorder"), _
' Key .patno = row("patno") _
'})
' Next
For Each row As DataRow In dtTable.Rows
p.serialid.Add(row("serialid"))
p.serialno.Add(row("serialno"))
p.serialdesc.Add(row("serialdesc"))
p.materialname.Add(row("materialname"))
p.drawing.Add(row("drawing"))
p.workorder.Add(row("workorder"))
p.patno.Add(row("patno"))
Next
Return p
End Function
Control class:
Public Class Control
Public serialid As New Generic.List(Of String)
Public serialno As New Generic.List(Of String)
Public serialdesc As New Generic.List(Of String)
Public materialname As New Generic.List(Of String)
Public drawing As New Generic.List(Of String)
Public workorder As New Generic.List(Of String)
Public patno As New Generic.List(Of String)
Public result As New Generic.List(Of String)
End Class
ServerSidePro class:
Public Class ServerSidePro
Implements System.Web.IHttpHandler
Sub ProcessRequest(ByVal context As HttpContext) Implements IHttpHandler.ProcessRequest
Dim d As New Control
' Those parameters are sent by the plugin
Dim iDisplayLength = Integer.Parse(context.Request("iDisplayLength"))
Dim iDisplayStart = Integer.Parse(context.Request("iDisplayStart"))
Dim iSortCol = Integer.Parse(context.Request("iSortCol_0"))
Dim iSortDir = context.Request("sSortDir_0")
'Fetch the data from a repository (in my case in-memory)
'Dim p = SerialData.GetDataSet()
Dim p = DirectCast(SerialData.GetDataSet(), IEnumerable(Of SerialData))
' prepare an anonymous object for JSON serialization
Dim aaData2 = p.select(Function(h) New With {h.serialid, h.serialno, h.serialdesc, _
h.materialname, h.drawing, h.workorder, h.patno}).Skip(iDisplayStart).Take(iDisplayLength)
Dim str As New List(Of String())
For Each item In aaData2
Dim arr As String() = New String(6) {item.serialid, item.serialno, item.serialdesc, _
item.materialname, item.drawing, item.workorder, item.patno}
str.Add(arr)
Next
Dim result = New With { _
Key .iTotalRecords = p.Count(), _
Key .iTotalDisplayRecords = p.Count(), _
Key .aaData = str
}
Dim serializer As New JavaScriptSerializer()
Dim json = serializer.Serialize(result)
context.Response.ContentType = "application/json"
context.Response.ClearHeaders()
context.Response.Write(json)
context.Response.End()
'Return d
End Sub
ReadOnly Property IsReusable() As Boolean Implements IHttpHandler.IsReusable
Get
Return False
End Get
End Property
End Class
How to return dataset from this function it is giving error Unable to cast object of type 'Control' to type 'System.Collections.Generic.IEnumerable'.
Easiest way is to use a List() object. I would restructure your class
Public Class Control
Public LControl As New List(Of Control)
Public serialid As String
Public serialno As String
Public serialdesc As String
Public materialname As String
Public drawing As String
Public workorder As String
Public patno As String
Public result As String
End Class
​

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?

Sharepoont 2010 webpart vb.net Listbox SelectIndexChanged and errors

So let start I am new to coding widgets and in general. I had originally coded this in vb for asp pages and it work fine. Now converting over to a SharePoint 2010 webpart (not visual webpart).
The project is List box 1 has the user groups that they manage, List box 2 has the users in said group, List box 3 has all user not in List box 2
I am sure there lots of this that should be fix. Like not putting in admin login to get the data.
But the problem I have is: if select a group it will display the appropriate data but select a second group or select a user to add; same error.
Error:
"Failed to load viewstate. The control tree into which viewstate is being loaded must match the control tree that was used to save viewstate during the previous request."
Also still trying to figure out how to do the button to add a user.
Need some serious help please. I know part of the post back just having a hard time finding resources.
Below is the code:
Imports System
Imports System.ComponentModel
Imports System.Web
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Web.UI.WebControls.WebParts
Imports Microsoft.SharePoint
Imports Microsoft.SharePoint.WebControls
Imports ActiveDs
Imports System.DirectoryServices
Imports System.Data
Imports ADODB
Imports System.Runtime.InteropServices
<ToolboxItemAttribute(False)> _
Public Class Groups
Inherits System.Web.UI.WebControls.WebParts.WebPart
Private LBgrp As ListBox
Private LBgrpmem As ListBox
Private LBaddgrp As ListBox
Private btnadd As Button
Protected Overrides Sub CreateChildControls()
Me.LBgrpmem = New ListBox
Me.LBgrpmem.AutoPostBack = True
Me.LBgrpmem.DataValueField = "sAMAccountName"
Me.LBgrpmem.DataTextField = "displayName"
Me.LBgrpmem.DataBind()
Me.LBgrpmem.Rows = 8
Me.LBgrpmem.Width = 170
Me.LBgrpmem.Height = 350
Me.LBgrpmem.Items.Insert(0, New ListItem("-- Current Members --"))
Me.Controls.Add(LBgrpmem)
Me.LBaddgrp = New ListBox
Me.LBaddgrp.AutoPostBack = True
Me.LBaddgrp.DataTextField = "displayName"
Me.LBaddgrp.DataValueField = "sAMAccountName"
Me.LBaddgrp.DataBind()
Me.LBaddgrp.Items.Insert(0, New ListItem("-- Add Users --"))
Me.LBaddgrp.Width = 170
Me.LBaddgrp.Height = 350
AddHandler LBaddgrp.SelectedIndexChanged, New EventHandler(AddressOf DLAdd_SelectedIndexChanged)
Me.Controls.Add(LBaddgrp)
Me.btnadd = New Button()
' AddHandler Me.btnadd.Click, New EventHandler(AddressOf Click_btnadd)
Me.btnadd.Text = "Add User"
Me.Controls.Add(btnadd)
End Sub
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim oRootDSE = GetObject("LDAP://RootDSE")
Dim sDomainADsPath = "LDAP://" & oRootDSE.Get("defaultNamingContext")
Dim oCon As New ADODB.Connection
Dim oRecordSet As New ADODB.Recordset
Dim oCmd As New ADODB.Command
Dim sFullUser As String = Environment.UserName
Dim sProperties = "name,ADsPath,description,member,memberof,managedObjects"
Dim sGroup = "*"
Dim aMember
Dim iCount
oCon.ToString()
oCmd.ToString()
sFullUser.ToString()
sProperties.ToString()
sDomainADsPath.ToString()
oCon.Provider = "ADsDSOObject"
oCon.Open("ADProvider", "ADMINUSER#Domain.com", "ADMINPASSWORD")
oCmd.ActiveConnection = oCon
oCmd.CommandText = "<" & sDomainADsPath & ">;(&(objectCategory=person)(objectClass=user)(sAMAccountName=" & sFullUser & "));" & sProperties & ";subtree"
oRecordSet = oCmd.Execute
Dim de As DirectoryServices.DirectoryEntry = New DirectoryServices.DirectoryEntry(sDomainADsPath, "ADMINUSER#Domain.com", "ADMINPASSWORD", DirectoryServices.AuthenticationTypes.Secure)
Dim i As Integer = 0
Dim sl As SortedList = New SortedList(New CaseInsensitiveComparer)
de.ToString()
While Not oRecordSet.EOF
aMember = oRecordSet.Fields("managedObjects").Value
If Not IsDBNull(aMember) Then
For iCount = 0 To UBound(aMember)
Dim groupDN As String = ("distinguishedName=" & aMember(iCount))
Dim src As DirectoryServices.DirectorySearcher = New DirectoryServices.DirectorySearcher("(&(objectCategory=Group)(" & groupDN & "))")
src.SearchRoot = de
src.SearchScope = DirectoryServices.SearchScope.Subtree
For Each res As DirectoryServices.SearchResult In src.FindAll
sl.Add(res.Properties("name")(0).ToString, i)
i += 1
Next
Next
End If
oRecordSet.MoveNext()
End While
Me.LBgrp = New ListBox
Me.LBgrp.AutoPostBack = True
Me.LBgrp.DataSource = sl
Me.LBgrp.DataTextField = "key"
Me.LBgrp.DataValueField = "value"
Me.LBgrp.DataBind()
Me.LBgrp.Items.Insert(0, New ListItem("-- Groups --"))
Me.Controls.Add(LBgrp)
Me.LBgrp.SelectedIndex = 0
AddHandler LBgrp.SelectedIndexChanged, New EventHandler(AddressOf LBgrp_SelectedIndexChanged)
LBgrp.SelectedItem.ToString()
End Sub
Protected Sub LBgrp_SelectedIndexChanged(ByVal sender As Object, ByVal e As System.EventArgs) 'Handles LBgrp.SelectedIndexChanged
Dim strQuery As String = "" & LBgrp.SelectedItem.Text.ToString() & "'"
'LBgrpmem.Items.Clear()
Dim oRootDSE2 = GetObject("LDAP://RootDSE")
Dim sDomainADsPath2 = "LDAP://" & oRootDSE2.Get("defaultNamingContext")
Dim oCon2 As New ADODB.Connection
Dim oRecordSet2 As New ADODB.Recordset
Dim sFullUser2 As String = Environment.UserName
Dim oCmd2 As New ADODB.Command
Dim sProperties2 = "name,ADsPath,description,member,memberof,managedObjects"
Dim grpADsPath2
Dim grpdsplynm2
oRootDSE2 = Nothing
oCon2.Provider = "ADsDSOObject"
oCon2.Open("ADProvider", "ADMINUSER#Domain.com", "ADMINPASSWORD")
oCmd2.ActiveConnection = oCon2
oCmd2.CommandText = "<" & sDomainADsPath2 & ">;(&(objectCategory=group)(objectClass=group)(CN=" & LBgrp.SelectedItem.Text & "));" & sProperties2 & ";subtree"
oRecordSet2 = oCmd2.Execute
While oRecordSet2.EOF
grpADsPath2 = oRecordSet2.Fields("ADsPath").Value
grpADsPath2.ToString()
grpdsplynm2 = grpADsPath2.remove(0, 7)
grpdsplynm2.ToString()
oRecordSet2.MoveNext()
End While
While Not oRecordSet2.EOF
grpADsPath2 = oRecordSet2.Fields("ADsPath").Value
grpADsPath2.ToString()
grpdsplynm2 = grpADsPath2.remove(0, 7)
grpdsplynm2.ToString()
oRecordSet2.MoveNext()
End While
Dim groupDN2 As String = "" & grpdsplynm2 & ""
Dim filter As String = [String].Format("(&(objectClass=user)(objectCategory=person)(memberOf={0}))", groupDN2)
Me.LBgrpmem.AutoPostBack = True
Me.LBgrpmem.DataSource = FindUsers(filter, New String() {"sAMAccountName", "displayName"}, sDomainADsPath2, True)
Me.LBgrpmem.DataValueField = "sAMAccountName"
Me.LBgrpmem.DataTextField = "displayName"
Me.LBgrpmem.DataBind()
Me.LBgrpmem.Items.Insert(0, New ListItem("-- Current Members --"))
Me.Controls.Add(LBgrpmem)
Dim usrDN As String = "" & grpdsplynm2 & ""
usrDN.ToString()
Dim usrfilter As String = [String].Format("(&(objectClass=user)(objectCategory=person)(!memberOf={0}))", groupDN2)
Me.LBaddgrp.AutoPostBack = True
Me.LBaddgrp.DataSource = FindUsers(usrfilter, New String() {"sAMAccountName", "displayName"}, sDomainADsPath2, True)
Me.LBaddgrp.DataTextField = "displayName"
Me.LBaddgrp.DataValueField = "sAMAccountName"
Me.LBaddgrp.DataBind()
Me.LBaddgrp.Items.Insert(0, New ListItem("-- Add Users --"))
'AddHandler LBaddgrp.SelectedIndexChanged, New EventHandler(AddressOf DLAdd_SelectedIndexChanged)
Me.Controls.Add(LBaddgrp)
End Sub
Public Function FindUsers(ByVal sFilter As String, ByVal columns() As String, ByVal path As String, ByVal useCached As Boolean) As Data.DataSet
Dim oRootDSE = GetObject("LDAP://RootDSE")
Dim sDomainADsPath = "LDAP://" & oRootDSE.Get("defaultNamingContext")
'try to retrieve from cache first
Dim context As HttpContext = HttpContext.Current
Dim userDS As Data.DataSet = CType(context.Cache(sFilter), Data.DataSet)
If userDS Is Nothing Or Not useCached Then
'setup the searching entries
Dim deParent As New DirectoryServices.DirectoryEntry(sDomainADsPath, "ADMINUSER#Domain.com", "ADMINPASSWORD", DirectoryServices.AuthenticationTypes.Secure)
Dim ds As New DirectoryServices.DirectorySearcher(deParent, sFilter, columns, DirectoryServices.SearchScope.Subtree)
ds.PageSize = 1000
ds.Sort.PropertyName = "displayName" 'sort option
Using (deParent)
userDS = New Data.DataSet("userDS")
Dim dt As Data.DataTable = userDS.Tables.Add("users")
Dim dr As Data.DataRow
'add each parameter as a column
Dim prop As String
For Each prop In columns
dt.Columns.Add(prop, GetType(String))
Next prop
Dim src As DirectoryServices.SearchResultCollection = ds.FindAll
Try
Dim sr As DirectoryServices.SearchResult
For Each sr In src
dr = dt.NewRow()
For Each prop In columns
If sr.Properties.Contains(prop) Then
dr(prop) = sr.Properties(prop)(0)
End If
Next prop
dt.Rows.Add(dr)
Next sr
Finally
src.Dispose()
End Try
End Using
'cache it for later, with sliding window
context.Cache.Insert(sFilter, userDS, Nothing, DateTime.MaxValue, TimeSpan.FromSeconds(10))
End If
Return userDS
End Function 'FindUsers
Protected Sub DLAdd_SelectedIndexChanged(ByVal sender As Object, ByVal e As System.EventArgs) 'Handles Click_btnadd
Dim oRootDSE = GetObject("LDAP://RootDSE")
Dim sDomainADsPath = "LDAP://" & oRootDSE.Get("defaultNamingContext")
Dim oCon As New ADODB.Connection
Dim oRecordSet As New ADODB.Recordset
Dim oRcrdSet As New ADODB.Recordset
Dim oCmd As New ADODB.Command
Dim oCmd1 As New ADODB.Command
Dim sGroup = "*"
Dim sProperties = "name,ADsPath,description,member,memberof,proxyAddresses"
Dim grpADsPath
Dim grpdsplynm
Dim addusrADsPath
Dim addusrname
oRootDSE = Nothing
oCon.Provider = "ADsDSOObject"
oCon.Open("ADProvider", "ADMINUSER#Domain.com", "ADMINPASSWORD")
oCmd.ActiveConnection = oCon
oCmd1.ActiveConnection = oCon
oCmd.CommandText = "<" & sDomainADsPath & ">;(&(objectClass=group)(cn=" & LBgrp.SelectedItem.Text & "));" & sProperties & ";subtree"
oRecordSet = oCmd.Execute
'Group Query
While Not oRecordSet.EOF
grpADsPath = oRecordSet.Fields("ADsPath").Value
grpdsplynm = oRecordSet.Fields("name").Value
oRecordSet.MoveNext()
End While
oCmd1.CommandText = "<" & sDomainADsPath & ">;(&(objectCategory=person)(objectClass=user)(cn=" & LBaddgrp.SelectedItem.Text & "));" & sProperties & ";subtree"
oRcrdSet = oCmd1.Execute
'User query
While Not oRcrdSet.EOF
addusrADsPath = oRcrdSet.Fields("ADsPath").Value
addusrname = oRcrdSet.Fields("name").Value
oRcrdSet.MoveNext()
End While
' Bind directly to the group
'
Dim oRootDSE2 = GetObject("LDAP://RootDSE")
Dim sDomainADsPath2 = "LDAP://" & oRootDSE2.Get("defaultNamingContext")
Dim oCon2 As New ADODB.Connection
Dim oRecordSet2 As New ADODB.Recordset
Dim sFullUser2 As String = Environment.UserName
'Dim sFullUser2 = Request.ServerVariables("LOGON_USER")
'Dim sUser2 = Split(sFullUser2, "\", -1)
Dim oCmd2 As New ADODB.Command
Dim sProperties2 = "name,ADsPath,description,member,memberof,managedObjects"
Dim grpADsPath2
oRootDSE2 = Nothing
oCon2.Provider = "ADsDSOObject"
oCon2.Open("ADProvider", "ADMINUSER#Domain.com", "ADMINPASSWORD")
oCmd2.ActiveConnection = oCon2
oCmd2.CommandText = "<" & sDomainADsPath2 & ">;(&(objectCategory=group)(objectClass=group)(CN=" & LBgrp.SelectedItem.Text & "));" & sProperties2 & ";subtree"
oRecordSet2 = oCmd2.Execute
While Not oRecordSet2.EOF
grpADsPath2 = oRecordSet2.Fields("ADsPath").Value
oRecordSet2.MoveNext()
End While
Dim group As New DirectoryServices.DirectoryEntry("" & grpADsPath2 & "", "ADMINUSER#Domain.com", "ADMINPASSWORD", DirectoryServices.AuthenticationTypes.Secure)
Dim user As New DirectoryServices.DirectoryEntry(addusrADsPath, "ADMINUSER#Domain.com", "ADMINPASSWORD", DirectoryServices.AuthenticationTypes.Secure)
Dim isMember As Boolean = Convert.ToBoolean(group.Invoke("IsMember", New Object() {user.Path}))
If isMember Then
'
' TO CREATE ERROR MESSAGE
Else
' Add the user to the group by invoking the Add method
'
group.Invoke("Add", New Object() {user.Path})
End If
If Not IsNothing(user) Then
user.Dispose()
End If
If Not IsNothing(group) Then
group.Dispose()
End If
Console.ReadLine()
If (Err.Number <> 0) Then
' TO CREATE ERROR MESSAGE
Else
' TO CREATE SUCCESS MESSAGE
End If
End Sub
Protected Overrides Sub Render(writer As System.Web.UI.HtmlTextWriter)
LBgrp.RenderControl(writer)
LBgrpmem.RenderControl(writer)
LBaddgrp.RenderControl(writer)
btnadd.RenderControl(writer)
End Sub
End Class
if memory serves me correctly, Page_Load event is firing on a postback too, where you are trying to create another instance of your drop down. So the system is trying to recreate the state of ListBox from ViewState but it is not the same ListBox, because you have just recreated it. So it barks.
To avoid it, in the page_load only create "parent" drop down if it's not postback. i.e.
Begin Page_Load()
If !Page.IsPostBack() Then
'load code here
End If
End Page_Load
Also there's no need to write
Me.LBgrpmem = New ListBox
as it is already created. Changing the datasource is usually enuff.

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