How do I find the name of all inactive Windows VPN adapters? I'm working on a VPN app that should list all VPN connections, whether active or inactive. I'm using the NetworkInterface class to list all adapters. It correctly shows the active or inactive Ethernet 2 adapter (used for OpenVPN), and correctly shows the active VPN L2TP connection, but will not list the inactive VPN L2TP adapter name. Are there other (preferably not too obsolete) .Net (or non .Net) classes I could use? I would like to programmaticaly do this, otherwise I could have the option for the user to set the name (I have code to connect, monitor, or disconnect the Windows VPN adapter by name). Any help would be appreciated. Thanks in advance.
Here is the solution I found:
Public Class VPN
Public name As String
Public type As String
Public status As String
Public ip As String
End Class
Public Function GetWindowsVPNs() As List(Of VPN)
Dim vpn_names As String()
Dim vpns As New RAS
Dim strVpn As String
Dim active As Boolean = False
Dim conIPstr As String = ""
Dim vpnCheck As New clsVPN
Dim vpnList As New List(Of VPN)
vpn_names = vpns.GetConnectionsNames()
For Each strVpn In vpn_names
Dim vpn As New VPN
vpn.name = strVpn
vpn.type = "Windows VPN"
active = False
vpnCheck.ConName = vpn.name
active = vpnCheck.CheckConnection()
If active = True Then
vpn.status = "Active"
Try
conIPstr = GetMyIPstr()
Catch e As Exception
MessageBox.Show("Error: Function GetConnectionList: Error returning IP Address" & vbCrLf & vbCrLf & e.Message)
End Try
vpn.ip = conIPstr
Else
vpn.status = "Not Active"
vpn.ip = "No IP Address"
End If
vpnList.Add(vpn)
Next
Return vpnList
End Function
Private Function GetMyIPstr() As String
Dim client As New WebClient
Dim s As String = "No IP Address"
'// Add a user agent header in case the requested URI contains a query.
client.Headers.Add("user-agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; .NET CLR1.0.3705;)")
Dim baseurl As String = "http://checkip.dyndns.org/"
' with proxy server only:
Dim proxy As IWebProxy = WebRequest.GetSystemWebProxy()
proxy.Credentials = CredentialCache.DefaultNetworkCredentials
client.Proxy = proxy
Dim data As Stream
Try
data = client.OpenRead(baseurl)
Catch ex As Exception
MsgBox("open url " & ex.Message)
Exit Function
End Try
Dim reader As StreamReader = New StreamReader(data)
s = reader.ReadToEnd()
data.Close()
reader.Close()
s = s.Replace("<html><head><title>Current IP Check</title></head><body>", "").Replace("</body></html>", "").ToString()
s = s.Replace("Current IP Address: ", "")
s = s.Replace(vbCr, "").Replace(vbLf, "")
Return s
End Function
Imports System.Linq
Imports System.Net.NetworkInformation
Public Class clsVPN
Public Delegate Sub delPing()
Public Delegate Sub delConnect()
Public Delegate Sub delIdle()
Public Delegate Sub delDisconnect()
Public Delegate Sub delStatus(blnConnected As Boolean)
Public Event Ping As delPing
Public Event Con As delConnect
Public Event Discon As delDisconnect
Public Event Idle As delIdle
Public Event StatusChanged As delStatus
Public strRASPhone As String = "C:\WINDOWS\system32\rasphone.exe"
Public strIPAddress As String = ""
Public strVPNCon As String = ""
Public blnConnected As Boolean = False
Dim file As String = "C : \Users\Tom\AppData\Roaming\Microsoft\Network\Connections\Pbk\rasphone.pbk"
Protected Sub OnStatusChanged(blnConnected As Boolean)
RaiseEvent StatusChanged(blnConnected)
End Sub
Protected Sub OnDisconnect()
RaiseEvent Discon()
End Sub
Protected Sub OnPing()
RaiseEvent Ping()
End Sub
Protected Sub OnIdle()
RaiseEvent Idle()
End Sub
Protected Sub OnConnect()
RaiseEvent Con()
End Sub
Public ReadOnly Property Connected() As Boolean
Get
Return blnConnected
End Get
End Property
Public Property ConName() As String
Get
Return strVPNCon
End Get
Set(strValue As String)
strVPNCon = strValue
End Set
End Property
Public Function Test() As Boolean
Dim blnSucceed As Boolean = False
OnPing()
Dim p As New Ping()
If p.Send(strIPAddress).Status = IPStatus.Success Then
blnSucceed = True
Else
blnSucceed = False
End If
p = Nothing
If blnSucceed <> blnConnected Then
blnConnected = blnSucceed
OnStatusChanged(blnConnected)
End If
OnIdle()
Return blnSucceed
End Function
Public Function Connect() As Boolean
Dim blnSucceed As Boolean = False
Dim optionstr As String = "-f " & file & " -d "
OnConnect()
'MessageBox.Show("strVPNCon = " )
'Process.Start(strRASPhone, Convert.ToString(" -f ") & file & Convert.ToString(" -d ") _
' & strVPNCon)
optionstr = ""
Dim wait As Boolean = True
ProcessExec(strRASPhone, optionstr & strVPNCon, wait)
Application.DoEvents()
System.Threading.Thread.Sleep(5000)
Application.DoEvents()
blnSucceed = True
OnIdle()
Return blnSucceed
End Function
Public Function Disconnect() As Boolean
Dim blnSucceed As Boolean = False
Dim optionstr As String = "-h "
OnDisconnect()
optionstr = ""
Dim wait As Boolean = True
ProcessExec(strRASPhone, optionstr & strVPNCon, wait)
Application.DoEvents()
System.Threading.Thread.Sleep(8000)
Application.DoEvents()
blnSucceed = True
OnIdle()
Return blnSucceed
End Function
Public Function CheckConnection() As Boolean
Dim niVPN As NetworkInterface() =
NetworkInterface.GetAllNetworkInterfaces
Dim blnExist As Boolean =
niVPN.AsEnumerable().Any(Function(x) x.Name = ConName)
If blnExist Then
'MessageBox.Show("VPN Exists")
Else
' MessageBox.Show("VPN Does Not Exist")
End If
Return blnExist
End Function
Public Sub ProcessExec(processarg As String, param As String, wait As Boolean)
' Start the child process.
Dim p As New ProcessStartInfo
' Redirect the output stream of the child process.
p.FileName = processarg
p.Arguments = param
p.UseShellExecute = True
p.WindowStyle = ProcessWindowStyle.Normal
Dim proc As Process = Process.Start(p)
' Do Not wait for the child process to exit before
' reading to the end of its redirected stream.
If wait = True Then
proc.WaitForExit()
End If
End Sub
End Class
Imports System.Runtime.InteropServices
Public Class RAS
Private Const MAX_PATH As Integer = 260 + 1
Private Const MAX_RAS_ENTRY_NAMES As Integer = 256 + 1
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)>
Public Structure RASENTRYNAME
Public dwSize As Integer
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=MAX_RAS_ENTRY_NAMES)>
Public szEntryName As String
Public dwFlags As Integer
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=MAX_PATH)>
Public szPhonebook As String
End Structure
Private Declare Auto Function RasEnumEntries Lib "rasapi32.dll" (
ByVal reserved As String,
ByVal phonebook As String,
<[In](), Out()> ByVal RasEntries() As RASENTRYNAME,
ByRef BufferSize As Integer,
ByRef EntryCount As Integer
) As Integer
Public Function GetConnectionsNames() As String()
Dim res As New List(Of String)
Try
Dim bufferSize As Integer = Marshal.SizeOf(GetType(RASENTRYNAME))
Dim entryCount As Integer = 1
Dim entryNames(0) As RASENTRYNAME
Dim rc As Integer
entryNames(0).dwSize = Marshal.SizeOf(GetType(RASENTRYNAME))
rc = RasEnumEntries(Nothing, Nothing, entryNames, bufferSize, entryCount)
If rc = 0 Then
' There was only one entry and it's been filled into the "dummy"
' entry that we made before calling RasEnumEntries.
res.Add(entryNames(0).szEntryName.Trim)
ElseIf rc = 603 Then
' 603 means that there are more entries than we have allocated space for.
' So, expand the entryNames array and make sure we fill in the structure size
' for every entry in the array! This is important!! Without it, you'll get 632 errors!
ReDim entryNames(entryCount - 1)
For i As Integer = 0 To entryCount - 1
entryNames(i).dwSize = Marshal.SizeOf(GetType(RASENTRYNAME))
Next
rc = RasEnumEntries(Nothing, Nothing, entryNames, bufferSize, entryCount)
For i As Integer = 0 To entryCount - 1
res.Add(entryNames(i).szEntryName.Trim)
Next
Else
' So if we get here, the call bombed. It would be a good idea to find out why here!
MsgBox("Error reading RAS connections names, error code:" & rc.ToString(), MsgBoxStyle.SystemModal)
End If
Catch ex As Exception
MsgBox("Error reading RAS connection names: " & ex.Message.ToString(), MsgBoxStyle.SystemModal)
End Try
Return res.ToArray
End Function
End Class
Related
I have an app that connects a Windows VPN (not OpenVPN) using the rasphone.exe interface. I can successfully establish the connection but It prompts for the password each time. Is there a way to get the interface to remember the password so that if the connection is lost the connection can automatically be re-established programatically? As a note when I start the process for rasphone.exe I'm getting exceptions when I try to pass more than 1 parameter to it. The only parameter I can successfully pass is the entry name, I can't add parameters like -d, -h, or -f.
Here is the code I have:
Imports System.Linq
Imports System.Net.NetworkInformation
Public Class clsVPN
Public Delegate Sub delPing()
Public Delegate Sub delConnect()
Public Delegate Sub delIdle()
Public Delegate Sub delDisconnect()
Public Delegate Sub delStatus(blnConnected As Boolean)
Public Event Ping As delPing
Public Event Con As delConnect
Public Event Discon As delDisconnect
Public Event Idle As delIdle
Public Event StatusChanged As delStatus
Public strRASPhone As String = "C:\WINDOWS\system32\rasphone.exe"
Public strIPAddress As String = ""
Public strVPNCon As String = ""
Public blnConnected As Boolean = False
Dim file As String = "C : \Users\Tom\AppData\Roaming\Microsoft\Network\Connections\Pbk\rasphone.pbk"
Protected Sub OnStatusChanged(blnConnected As Boolean)
RaiseEvent StatusChanged(blnConnected)
End Sub
Protected Sub OnDisconnect()
RaiseEvent Discon()
End Sub
Protected Sub OnPing()
RaiseEvent Ping()
End Sub
Protected Sub OnIdle()
RaiseEvent Idle()
End Sub
Protected Sub OnConnect()
RaiseEvent Con()
End Sub
Public ReadOnly Property Connected() As Boolean
Get
Return blnConnected
End Get
End Property
Public Property ConName() As String
Get
Return strVPNCon
End Get
Set(strValue As String)
strVPNCon = strValue
End Set
End Property
Public Function Test() As Boolean
Dim blnSucceed As Boolean = False
OnPing()
Dim p As New Ping()
If p.Send(strIPAddress).Status = IPStatus.Success Then
blnSucceed = True
Else
blnSucceed = False
End If
p = Nothing
If blnSucceed <> blnConnected Then
blnConnected = blnSucceed
OnStatusChanged(blnConnected)
End If
OnIdle()
Return blnSucceed
End Function
Public Function Connect() As Boolean
Dim blnSucceed As Boolean = False
Dim optionstr As String = "-f " & file & " -d "
OnConnect()
'MessageBox.Show("strVPNCon = " )
'Process.Start(strRASPhone, Convert.ToString(" -f ") & file & Convert.ToString(" -d ") _
' & strVPNCon)
optionstr = ""
Dim wait As Boolean = True
ProcessExec(strRASPhone, optionstr & strVPNCon, wait)
Application.DoEvents()
System.Threading.Thread.Sleep(5000)
Application.DoEvents()
blnSucceed = True
OnIdle()
Return blnSucceed
End Function
Public Function Disconnect() As Boolean
Dim blnSucceed As Boolean = False
Dim optionstr As String = "-h "
OnDisconnect()
optionstr = ""
Dim wait As Boolean = True
ProcessExec(strRASPhone, optionstr & strVPNCon, wait)
Application.DoEvents()
System.Threading.Thread.Sleep(8000)
Application.DoEvents()
blnSucceed = True
OnIdle()
Return blnSucceed
End Function
Public Function CheckConnection() As Boolean
Dim niVPN As NetworkInterface() =
NetworkInterface.GetAllNetworkInterfaces
Dim blnExist As Boolean =
niVPN.AsEnumerable().Any(Function(x) x.Name = ConName)
If blnExist Then
'MessageBox.Show("VPN Exists")
Else
' MessageBox.Show("VPN Does Not Exist")
End If
Return blnExist
End Function
Public Sub ProcessExec(processarg As String, param As String, wait As Boolean)
' Start the child process.
Dim p As New ProcessStartInfo
' Redirect the output stream of the child process.
p.FileName = processarg
p.Arguments = param
p.UseShellExecute = True
p.WindowStyle = ProcessWindowStyle.Normal
Dim proc As Process = Process.Start(p)
' Do Not wait for the child process to exit before
' reading to the end of its redirected stream.
If wait = True Then
proc.WaitForExit()
End If
End Sub
End Class
I know this was asked more than one year before.
I suppose that the described problem is not caused of the Visual Basic code. The problem may be caused from the file rasphone.pbk. It is generally contained in
%APPDATA%\Microsoft\Network\Connections\Pbk
This file can be read with a text editor. There exist an option PreviewUserPw after [YOURVPNNAME]. The value 1 generates a prompting before dialing in.
Changing of this line to
PreviewUserPw=0
will help.
I made a program that adds text to the system32 host file and I want a way a button can remove the selected one from the listbox and delete it from the host file here is the code to add it...
If TextBox1.Text = "" Then
MsgBox("Please Enter A Valid Website Url")
Else
path = "C:\Windows\System32\drivers\etc\hosts"
sw = New StreamWriter(path, True)
Dim sitetoblock As String = (Environment.NewLine & "127.0.0.1 " & TextBox1.Text) 'has to be www.google.com | NOT: http://www.google.com/
sw.Write(sitetoblock)
sw.Close()
ListBox1.Items.Add(TextBox1.Text)
MsgBox("Site Blocked")
End If
Thanks for your time
You can use this code to add, read and delete from windows hosts file.
Add this class to your project -
WindowsHost Class:
Public Class WindowsHost
Public ReadOnly Location As String
Private FullMap As List(Of HostMap)
Public Sub New()
Location = Environment.SystemDirectory & "\drivers\etc\hosts"
If Not System.IO.File.Exists(Location) Then
Throw New System.IO.FileNotFoundException("Host File Was Not Found", Location)
End If
FullMap = LoadCurrentMap()
End Sub
Public Function Count() As Integer
Return FullMap.Count
End Function
Public Function Item(ByVal index As Integer) As HostMap
Return New HostMap(FullMap.Item(index))
End Function
Public Sub AddHostMap(ByVal NewMap As HostMap)
FullMap = LoadCurrentMap()
FullMap.Add(NewMap)
SaveData()
End Sub
Public Sub DeleteHostMapByDomain(ByVal dom As String)
FullMap = LoadCurrentMap()
Dim Reall As Integer = 0
For i As Integer = 0 To FullMap.Count - 1 Step 1
If FullMap.Item(Reall).domain = dom Then
FullMap.RemoveAt(Reall)
Else
Reall += 1
End If
Next
SaveData()
End Sub
Public Sub DeleteHostMapByIp(ByVal ip As System.Net.IPAddress)
FullMap = LoadCurrentMap()
Dim Reall As Integer = 0
For i As Integer = 0 To FullMap.Count - 1 Step 1
If FullMap.Item(Reall).Ip.Equals(ip) Then
FullMap.RemoveAt(Reall)
Reall += 1
End If
Next
SaveData()
End Sub
Public Sub UpdateData()
FullMap = LoadCurrentMap()
End Sub
Private Function LoadCurrentMap() As List(Of HostMap)
Dim FileStream As New System.IO.StreamReader(Location)
Dim Lines() As String = FileStream.ReadToEnd.Split(New String() {Environment.NewLine}, StringSplitOptions.None)
FileStream.Close()
Dim Lst As New List(Of HostMap)
For Each line As String In Lines
If Not line.Contains("#") Then
Dim LineData() As String = line.Split({" "c}, StringSplitOptions.RemoveEmptyEntries)
If LineData.Length = 2 Then
Try
Dim temp As New HostMap(LineData(1), System.Net.IPAddress.Parse(LineData(0)))
Lst.Add(temp)
Catch ex As Exception
End Try
End If
End If
Next
Return Lst
End Function
Private Sub SaveData()
Dim Data As String = "# Windows Host Generate" & vbNewLine & "# Time: " & Now.ToString
For Each Map As HostMap In FullMap
Data = Data & vbNewLine & Map.ToString
Next
Dim w As New System.IO.StreamWriter(Location)
w.Write(Data)
w.Close()
End Sub
End Class
Public Class HostMap
Public domain As String
Public Ip As System.Net.IPAddress
Public Sub New(ByVal _dom As String, ByVal _ip As System.Net.IPAddress)
domain = _dom
Ip = _ip
End Sub
Public Sub New(ByRef map As HostMap)
domain = map.domain
Ip = map.Ip
End Sub
Public Overrides Function ToString() As String
Return Ip.ToString & " " & domain
End Function
End Class
Now you can use it like this
Dim WindowsHostSession As New WindowsHost()
WindowsHostSession.AddHostMap(New HostMap("SomeSite.com", System.Net.IPAddress.Parse("127.0.0.1"))) 'Add ip domin map to hosts file
WindowsHostSession.Item(2).domain 'Read the second ip domain map from the hosts file
WindowsHostSession.DeleteHostMapByDomain("SomeSite.com") 'Delete all maps with SomeSite.com domain from the hosts file
Is there a way to report progress on a CopyToAsync operation on a FileStream? As far as I can tell there are no Events listed for a FileStream object so I can't add a handler to it. The best examples I've found deal with DownloadProgressChanged/DownloadFileComplete for WebClient objects.
For i As Int32 = 0 To strFileList.Count - 1
Try
Using srmSource As FileStream = File.Open(dirSource + strFileList(i), FileMode.Open)
Using srmDestination As FileStream = File.Create(dirDestination + strFileList(i))
Me.lblStatus.Text = "Copying file - " & strFileList(i) & "..."
Await srmSource.CopyToAsync(srmDestination)
End Using
End Using
Me.lblStatus.Text = "Copying complete!"
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
Next
Here's what I came up with using these links as references:
http://blogs.msdn.com/b/dotnet/archive/2012/06/06/async-in-4-5-enabling-progress-and-cancellation-in-async-apis.aspx (converted from C# to VB.NET)
http://social.msdn.microsoft.com/Forums/en-US/8c121fef-ebc7-42ab-a2f8-3b5e9a6e9854/delegates-with-parameter?forum=vbide
Imports System.IO
Imports System.Net
Imports System.Threading.Tasks
Public Class frmStartup
Private Async Sub frmStartup_Load(sender As Object, e As EventArgs) Handles Me.Load
Dim FileList As List(Of String) = GetFilesToTransfer()
If FileList.Count > 0 Then
UpdateLabel("Found files to transfer...")
Me.prgTransfer.Visible = True
Try
Dim ProgressIndicator As Object = New Progress(Of Int32)(AddressOf ReportProgress)
Await TransferFiles(FileList, ProgressIndicator)
UpdateLabel("File transfer complete!")
Catch ex As Exception
UpdateLabel("Error transferring files!")
Finally
Me.prgTransfer.Visible = False
End Try
End If
End Sub
Private Function GetFilesToTransfer() As List(Of String)
Dim strFilesToTransfer As List(Of String) = New List(Of String)
strFilesToTransfer.Add("aud1.mp3")
strFilesToTransfer.Add("aud2.mp3")
Return strFilesToTransfer
End Function
Public Async Function TransferFiles(ByVal FileList As List(Of String), ByVal Progress As IProgress(Of Int32)) As Task
Dim intTotal As Int32 = FileList.Count
Dim dirSource As String = "\\source\"
Dim dirDestination As String = "c:\destination\"
Await Task.Run(Async Function()
Dim intTemp As Int32 = 0
For i As Int32 = 0 To FileList.Count - 1
UpdateLabel("Copying " & FileList(i) & "...")
Using srmSource As FileStream = File.Open(dirSource + FileList(i), FileMode.Open)
Using srmDestination As FileStream = File.Create(dirDestination + FileList(i))
Await srmSource.CopyToAsync(srmDestination)
End Using
End Using
intTemp += 1
If Progress IsNot Nothing Then
Progress.Report((intTemp * 100 / intTotal))
End If
Next
End Function)
End Function
Private Delegate Sub UpdateLabelInvoker(ByVal LabelText As String)
Private Sub UpdateLabel(ByVal LabelText As String)
If Me.lblStatus.InvokeRequired Then
Me.lblStatus.Invoke(New UpdateLabelInvoker(AddressOf UpdateLabel), LabelText)
Else
Me.lblStatus.Text = LabelText
End If
End Sub
Private Sub ReportProgress(ByVal Value As Int32)
Me.prgTransfer.Value = Value
End Sub
End Class
I am trying to create a vb.net usercontrol based on SharpDevelop TextEditor. I want syntax highlighting and code completion. In order to do that I decided to port CSharpCodeCompletion example from SharpDevelop's source code (version 3.2.1.6466). It is in folder "samples\CSharpCodeCompletion"
The control seems to run, syntax highlighting is OK and the code completion window is shown when the '.' (period) key is pressed. All the members are listed OK in completion window.
Right now I am facing three problems:
1. When the code completion window is shown any keystrokes are going to the editor and thus the search function in the listbox is not working.
2. When I select an entry from the listbox the word goes back to the editor but it deletes the period. For example I am typing "String." --> Listbox shows up --> Select the word "Empty" and I am getting "StringEmpty" in the editor.
3. In this command Return GetMemberText(ambience, CType(c, ICSharpCode.SharpDevelop.Dom.IMember)) I am getting a cast exception.
Please note that when I compile and run the original C# code from the example the editor and the completion window works as expected. My guess is focusing in two things, first there is a problem because I place the editor inside a usercontrol instead of a form as it is in the example, however I cannot see any obvious problem in my code pointing to this direction. Second there is a problem because of the porting of C# code to VB. C# isn't my thing at all but I tried my best (I know some Java) to rewrite the entire thing to VB.
I know that my code is big but I am posting the entire control code in case someone wants to load it to VS2010 and give it a try. In this case you are going to need ICSharpCode.NRefactory, ICSharpCode.SharpDevelop.Dom, ICSharpCode.TextEditor, log4net and Mono.Cecil assemblies from the example's bin folder.
Thank you and please forgive my English. Here is my Code
Public Class ctlVBCodeEditor
Private Class HostCallbackImplementation
Private Shared Sub ShowMessageWithException(msg As String, ex As Exception)
DevExpress.XtraEditors.XtraMessageBox.Show(msg & vbCrLf & ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Stop)
End Sub
Private Shared Sub ShowMessage(msg As String)
DevExpress.XtraEditors.XtraMessageBox.Show(msg, "Error", MessageBoxButtons.OK, MessageBoxIcon.Stop)
End Sub
Private Shared Sub ShowAssemblyLoadError(fileName As String, include As String, msg As String)
DevExpress.XtraEditors.XtraMessageBox.Show(msg & vbCrLf & "File: " & fileName & vbCrLf & "Include: " & include, "Error", MessageBoxButtons.OK, MessageBoxIcon.Stop)
End Sub
Public Shared Sub Register(ctlCode As ctlVBCodeEditor)
ICSharpCode.SharpDevelop.Dom.HostCallback.GetCurrentProjectContent = New Func(Of ICSharpCode.SharpDevelop.Dom.IProjectContent)(Function() ctlCode.myContent)
ICSharpCode.SharpDevelop.Dom.HostCallback.ShowError = New Action(Of String, System.Exception)(AddressOf ShowMessageWithException)
ICSharpCode.SharpDevelop.Dom.HostCallback.ShowMessage = New Action(Of String)(AddressOf ShowMessage)
ICSharpCode.SharpDevelop.Dom.HostCallback.ShowAssemblyLoadError = New Action(Of String, String, String)(AddressOf ShowAssemblyLoadError)
End Sub
End Class
Private Class CodeCompletionData
Inherits ICSharpCode.TextEditor.Gui.CompletionWindow.DefaultCompletionData
Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionData
Private Shared vbAmbience As ICSharpCode.SharpDevelop.Dom.VBNet.VBNetAmbience = New ICSharpCode.SharpDevelop.Dom.VBNet.VBNetAmbience
Private Shared Function GetMemberImageIndex(m As ICSharpCode.SharpDevelop.Dom.IMember) As Integer
Dim Result As Integer = 0
If TypeOf m Is ICSharpCode.SharpDevelop.Dom.IMethod Then
Result = 1
ElseIf TypeOf m Is ICSharpCode.SharpDevelop.Dom.IProperty Then
Result = 2
ElseIf TypeOf m Is ICSharpCode.SharpDevelop.Dom.IField Then
Result = 3
ElseIf TypeOf m Is ICSharpCode.SharpDevelop.Dom.IEvent Then
Result = 6
Else
Result = 3
End If
Return Result
End Function
Private Shared Function GetClassImageIndex(cl As ICSharpCode.SharpDevelop.Dom.IClass) As Integer
Dim Result As Integer = 0
If cl.ClassType = ICSharpCode.SharpDevelop.Dom.ClassType.Enum Then
Result = 4
End If
Return Result
End Function
Private Shared Function GetEntityText(e As ICSharpCode.SharpDevelop.Dom.IEntity) As String
Dim Result As String = String.Empty
Dim amb As ICSharpCode.SharpDevelop.Dom.IAmbience = vbAmbience
If TypeOf e Is ICSharpCode.SharpDevelop.Dom.IMethod Then
Result = amb.Convert(CType(e, ICSharpCode.SharpDevelop.Dom.IMethod))
ElseIf TypeOf e Is ICSharpCode.SharpDevelop.Dom.IProperty Then
Result = amb.Convert(CType(e, ICSharpCode.SharpDevelop.Dom.IProperty))
ElseIf TypeOf e Is ICSharpCode.SharpDevelop.Dom.IEvent Then
Result = amb.Convert(CType(e, ICSharpCode.SharpDevelop.Dom.IEvent))
ElseIf TypeOf e Is ICSharpCode.SharpDevelop.Dom.IField Then
Result = amb.Convert(CType(e, ICSharpCode.SharpDevelop.Dom.IField))
ElseIf TypeOf e Is ICSharpCode.SharpDevelop.Dom.IClass Then
Result = amb.Convert(CType(e, ICSharpCode.SharpDevelop.Dom.IClass))
Else
Result = e.ToString
End If
Return Result
End Function
Public Shared Function XmlDocumentationToText(xmlDoc As String) As String
Dim sb As New System.Text.StringBuilder
Try
Using reader As New Xml.XmlTextReader(New IO.StringReader("<root>" & xmlDoc & "</root>"))
reader.XmlResolver = Nothing
While reader.Read
Select Case reader.NodeType
Case Xml.XmlNodeType.Text
sb.Append(reader.Value)
Case Xml.XmlNodeType.Element
Select Case reader.Name
Case "filterpriority"
reader.Skip()
Case "returns"
sb.AppendLine()
sb.Append("Returns: ")
Case "param"
sb.AppendLine()
sb.Append(reader.GetAttribute("name") + ": ")
Case "remarks"
sb.AppendLine()
sb.Append("Remarks: ")
Case "see"
If reader.IsEmptyElement Then
sb.Append(reader.GetAttribute("cref"))
Else
reader.MoveToContent()
If reader.HasValue Then
sb.Append(reader.Value)
Else
sb.Append(reader.GetAttribute("cref"))
End If
End If
End Select
End Select
End While
End Using
Return sb.ToString
Catch ex As Exception
Return xmlDoc
End Try
End Function
Private member As ICSharpCode.SharpDevelop.Dom.IMember
Private c As ICSharpCode.SharpDevelop.Dom.IClass
Private mOverloads As Integer = 0
Private _Description As String
Public Overrides ReadOnly Property Description As String
Get
If String.IsNullOrEmpty(_Description) Then
Dim entity As ICSharpCode.SharpDevelop.Dom.IEntity
If member IsNot Nothing Then
entity = CType(member, ICSharpCode.SharpDevelop.Dom.IEntity)
Else
entity = CType(c, ICSharpCode.SharpDevelop.Dom.IEntity)
End If
_Description = GetEntityText(entity)
If mOverloads > 1 Then _Description &= " (+" & mOverloads.ToString & " overloads"
_Description &= vbCrLf & XmlDocumentationToText(entity.Documentation)
End If
Return _Description
End Get
End Property
Public Sub AddOverload()
mOverloads += 1
End Sub
Public Sub New(theMember As ICSharpCode.SharpDevelop.Dom.IMember)
MyBase.New(theMember.Name, String.Empty, GetMemberImageIndex(theMember))
Me.member = theMember
End Sub
Public Sub New(theClass As ICSharpCode.SharpDevelop.Dom.IClass)
MyBase.New(theClass.Name, String.Empty, GetClassImageIndex(theClass))
Me.c = theClass
End Sub
End Class
Private Class CodeCompletionProvider
Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider
Private ctlCode As ctlVBCodeEditor
Private Function FindExpression(txtArea As ICSharpCode.TextEditor.TextArea) As ICSharpCode.SharpDevelop.Dom.ExpressionResult
Dim finder As ICSharpCode.SharpDevelop.Dom.IExpressionFinder = New ICSharpCode.SharpDevelop.Dom.VBNet.VBExpressionFinder
Dim Result As ICSharpCode.SharpDevelop.Dom.ExpressionResult = finder.FindExpression(txtArea.Document.TextContent, txtArea.Caret.Offset)
If Result.Region.IsEmpty Then Result.Region = New ICSharpCode.SharpDevelop.Dom.DomRegion(txtArea.Caret.Line + 1, txtArea.Caret.Column + 1)
Return Result
End Function
Private Sub AddCompletionData(resultList As List(Of ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionData), completionData As ArrayList)
Dim nameDictionary As Dictionary(Of String, CodeCompletionData) = New Dictionary(Of String, CodeCompletionData)
'Add the completion data as returned by SharpDevelop.Dom to the
'list for the text editor
For Each obj As Object In completionData
If TypeOf obj Is String Then
'namespace names are returned as string
resultList.Add(New ICSharpCode.TextEditor.Gui.CompletionWindow.DefaultCompletionData(Convert.ToString(obj), "namespace " & obj.ToString, 5))
ElseIf TypeOf obj Is ICSharpCode.SharpDevelop.Dom.IClass Then
Dim cl As ICSharpCode.SharpDevelop.Dom.IClass = CType(obj, ICSharpCode.SharpDevelop.Dom.IClass)
resultList.Add(New CodeCompletionData(cl))
ElseIf TypeOf obj Is ICSharpCode.SharpDevelop.Dom.IMember Then
Dim mm As ICSharpCode.SharpDevelop.Dom.IMember = CType(obj, ICSharpCode.SharpDevelop.Dom.IMember)
If (TypeOf mm Is ICSharpCode.SharpDevelop.Dom.IMethod) AndAlso (CType(mm, ICSharpCode.SharpDevelop.Dom.IMethod).IsConstructor) Then
Continue For
End If
'Group results by name and add "(x Overloads)" to the
'description if there are multiple results with the same name.
Dim data As CodeCompletionData = Nothing
If nameDictionary.TryGetValue(mm.Name, data) Then
data.AddOverload()
Else
data = New CodeCompletionData(mm)
nameDictionary(mm.Name) = data
resultList.Add(data)
End If
Else
'Current ICSharpCode.SharpDevelop.Dom should never return anything else
Throw New NotSupportedException
End If
Next
End Sub
Public ReadOnly Property ImageList As System.Windows.Forms.ImageList Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider.ImageList
Get
Return ctlCode.imageList1
End Get
End Property
Public ReadOnly Property PreSelection As String Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider.PreSelection
Get
Return String.Empty
End Get
End Property
Public ReadOnly Property DefaultIndex As Integer Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider.DefaultIndex
Get
Return -1
End Get
End Property
Public Function ProcessKey(key As Char) As ICSharpCode.TextEditor.Gui.CompletionWindow.CompletionDataProviderKeyResult Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider.ProcessKey
If (Char.IsLetterOrDigit(key) Or key = " ") Then
Return ICSharpCode.TextEditor.Gui.CompletionWindow.CompletionDataProviderKeyResult.NormalKey
Else
Return ICSharpCode.TextEditor.Gui.CompletionWindow.CompletionDataProviderKeyResult.InsertionKey
End If
End Function
Public Function InsertAction(data As ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionData, textArea As ICSharpCode.TextEditor.TextArea, insertionOffset As Integer, key As Char) As Boolean Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider.InsertAction
textArea.Caret.Position = textArea.Document.OffsetToPosition(insertionOffset)
Return data.InsertAction(textArea, key)
End Function
Public Function GenerateCompletionData(fileName As String, textArea As ICSharpCode.TextEditor.TextArea, charTyped As Char) As ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionData() Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider.GenerateCompletionData
Dim resolver As New ICSharpCode.SharpDevelop.Dom.NRefactoryResolver.NRefactoryResolver(ctlCode.myContent.Language)
Dim rr As ICSharpCode.SharpDevelop.Dom.ResolveResult = resolver.Resolve(FindExpression(textArea), _
ctlCode.parseInfo, _
textArea.MotherTextEditorControl.Text)
Dim resultList As New List(Of ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionData)
If rr IsNot Nothing Then
Dim completionData As ArrayList = rr.GetCompletionData(ctlCode.myContent)
If completionData IsNot Nothing Then
AddCompletionData(resultList, completionData)
End If
End If
Return resultList.ToArray()
End Function
Public Sub New(myControl As ctlVBCodeEditor)
Me.ctlCode = myControl
End Sub
End Class
Private Class CodeCompletionKeyHandler
Private ctlCode As ctlVBCodeEditor
Private txtCode As ICSharpCode.TextEditor.TextEditorControl
Private codeCompletionWin As ICSharpCode.TextEditor.Gui.CompletionWindow.CodeCompletionWindow
Private Sub CloseCodeCompletionWindow(sender As Object, e As EventArgs)
If codeCompletionWin IsNot Nothing Then
RemoveHandler codeCompletionWin.FormClosed, AddressOf CloseCodeCompletionWindow
codeCompletionWin.Dispose()
codeCompletionWin = Nothing
End If
End Sub
Public Function TextAreaKeyEventHandler(key As Char) As Boolean
If codeCompletionWin IsNot Nothing Then
If codeCompletionWin.ProcessKeyEvent(key) Then
Return True
End If
End If
If key = "." Then
Dim completionDataProvider As ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider = New CodeCompletionProvider(Me.ctlCode)
Dim theForm As System.Windows.Forms.Form = Me.ctlCode.FindForm
codeCompletionWin = ICSharpCode.TextEditor.Gui.CompletionWindow.CodeCompletionWindow.ShowCompletionWindow(theForm, Me.txtCode, ctlVBCodeEditor.DummyFileName, completionDataProvider, key)
If codeCompletionWin IsNot Nothing Then
AddHandler codeCompletionWin.FormClosed, AddressOf CloseCodeCompletionWindow
End If
End If
Return False
End Function
Public Sub New(myControl As ctlVBCodeEditor, myCodeText As ICSharpCode.TextEditor.TextEditorControl)
Me.ctlCode = myControl
Me.txtCode = myCodeText
End Sub
Public Shared Function Attach(theControl As ctlVBCodeEditor, theEditor As ICSharpCode.TextEditor.TextEditorControl) As CodeCompletionKeyHandler
Dim Result As New CodeCompletionKeyHandler(theControl, theEditor)
AddHandler theEditor.ActiveTextAreaControl.TextArea.KeyEventHandler, AddressOf Result.TextAreaKeyEventHandler
AddHandler theEditor.Disposed, AddressOf Result.CloseCodeCompletionWindow
Return Result
End Function
End Class
Private Class ToolTipProvider
Private ctlCode As ctlVBCodeEditor
Private txtCode As ICSharpCode.TextEditor.TextEditorControl
Private Function GetText(result As ICSharpCode.SharpDevelop.Dom.ResolveResult) As String
If result Is Nothing Then
Return String.Empty
End If
If TypeOf result Is ICSharpCode.SharpDevelop.Dom.MixedResolveResult Then
Return GetText(CType(result, ICSharpCode.SharpDevelop.Dom.MixedResolveResult).PrimaryResult)
End If
Dim ambience As ICSharpCode.SharpDevelop.Dom.IAmbience = New ICSharpCode.SharpDevelop.Dom.VBNet.VBNetAmbience
ambience.ConversionFlags = ICSharpCode.SharpDevelop.Dom.ConversionFlags.StandardConversionFlags Or ICSharpCode.SharpDevelop.Dom.ConversionFlags.ShowAccessibility
If TypeOf result Is ICSharpCode.SharpDevelop.Dom.MemberResolveResult Then
Return GetMemberText(ambience, CType(result, ICSharpCode.SharpDevelop.Dom.MemberResolveResult).ResolvedMember)
ElseIf TypeOf result Is ICSharpCode.SharpDevelop.Dom.LocalResolveResult Then
Dim lrr As ICSharpCode.SharpDevelop.Dom.LocalResolveResult = CType(result, ICSharpCode.SharpDevelop.Dom.LocalResolveResult)
ambience.ConversionFlags = ICSharpCode.SharpDevelop.Dom.ConversionFlags.UseFullyQualifiedTypeNames Or ICSharpCode.SharpDevelop.Dom.ConversionFlags.ShowReturnType
Dim sb As New System.Text.StringBuilder
If lrr.IsParameter Then
sb.Append("parameter ")
Else
sb.Append("local variable ")
End If
sb.Append(ambience.Convert(lrr.Field))
Return sb.ToString
ElseIf TypeOf result Is ICSharpCode.SharpDevelop.Dom.NamespaceResolveResult Then
Return "namespace " & CType(result, ICSharpCode.SharpDevelop.Dom.NamespaceResolveResult).Name
ElseIf TypeOf result Is ICSharpCode.SharpDevelop.Dom.TypeResolveResult Then
Dim c As ICSharpCode.SharpDevelop.Dom.IClass = CType(result, ICSharpCode.SharpDevelop.Dom.TypeResolveResult).ResolvedClass
If c IsNot Nothing Then
'Return ambience.Convert(result.ResolvedType)
Return GetMemberText(ambience, CType(c, ICSharpCode.SharpDevelop.Dom.IMember))
Else
Return ambience.Convert(result.ResolvedType)
End If
ElseIf TypeOf result Is ICSharpCode.SharpDevelop.Dom.MethodGroupResolveResult Then
Dim mrr As ICSharpCode.SharpDevelop.Dom.MethodGroupResolveResult = CType(result, ICSharpCode.SharpDevelop.Dom.MethodGroupResolveResult)
Dim m As ICSharpCode.SharpDevelop.Dom.IMethod = mrr.GetMethodIfSingleOverload
If m IsNot Nothing Then
Return GetMemberText(ambience, m)
Else
Return "Overload of " & ambience.Convert(mrr.ContainingType) & "." & mrr.Name
End If
Else
Return String.Empty
End If
End Function
Private Shared Function GetMemberText(ambience As ICSharpCode.SharpDevelop.Dom.IAmbience, member As ICSharpCode.SharpDevelop.Dom.IMember) As String
Dim sb As New System.Text.StringBuilder
If TypeOf member Is ICSharpCode.SharpDevelop.Dom.IField Then
sb.Append(ambience.Convert(CType(member, ICSharpCode.SharpDevelop.Dom.IField)))
ElseIf TypeOf member Is ICSharpCode.SharpDevelop.Dom.IProperty Then
sb.Append(ambience.Convert(CType(member, ICSharpCode.SharpDevelop.Dom.IProperty)))
ElseIf TypeOf member Is ICSharpCode.SharpDevelop.Dom.IEvent Then
sb.Append(ambience.Convert(CType(member, ICSharpCode.SharpDevelop.Dom.IEvent)))
ElseIf TypeOf member Is ICSharpCode.SharpDevelop.Dom.IMethod Then
sb.Append(ambience.Convert(CType(member, ICSharpCode.SharpDevelop.Dom.IMethod)))
ElseIf TypeOf member Is ICSharpCode.SharpDevelop.Dom.IClass Then
sb.Append(ambience.Convert(CType(member, ICSharpCode.SharpDevelop.Dom.IClass)))
Else
sb.Append("unknown member ")
sb.Append(member.ToString())
End If
Dim documentation As String = member.Documentation
If (documentation IsNot Nothing) AndAlso (documentation.Length > 0) Then
sb.Append(vbCrLf)
sb.Append(CodeCompletionData.XmlDocumentationToText(documentation))
End If
Return sb.ToString
End Function
Private Sub OnToolTipRequest(sender As Object, e As ICSharpCode.TextEditor.ToolTipRequestEventArgs)
If e.InDocument And (Not e.ToolTipShown) Then
Dim expFinder As ICSharpCode.SharpDevelop.Dom.IExpressionFinder = New ICSharpCode.SharpDevelop.Dom.VBNet.VBExpressionFinder
Dim expResult As ICSharpCode.SharpDevelop.Dom.ExpressionResult = expFinder.FindFullExpression(txtCode.Text, txtCode.Document.PositionToOffset(e.LogicalPosition))
If expResult.Region.IsEmpty Then
expResult.Region = New ICSharpCode.SharpDevelop.Dom.DomRegion(e.LogicalPosition.Line + 1, e.LogicalPosition.Column + 1)
End If
Dim txtArea As ICSharpCode.TextEditor.TextArea = txtCode.ActiveTextAreaControl.TextArea
Dim resolver As New ICSharpCode.SharpDevelop.Dom.NRefactoryResolver.NRefactoryResolver(ctlCode.myContent.Language)
Dim rr As ICSharpCode.SharpDevelop.Dom.ResolveResult = resolver.Resolve(expResult, ctlCode.parseInfo, txtArea.MotherTextEditorControl.Text)
Dim toolTipText As String = GetText(rr)
If Not String.IsNullOrEmpty(toolTipText) Then
e.ShowToolTip(toolTipText)
End If
End If
End Sub
Public Sub New(myControl As ctlVBCodeEditor, myCodeText As ICSharpCode.TextEditor.TextEditorControl)
Me.ctlCode = myControl
Me.txtCode = myCodeText
End Sub
Public Shared Sub Attach(theControl As ctlVBCodeEditor, theEditor As ICSharpCode.TextEditor.TextEditorControl)
Dim tp As New ToolTipProvider(theControl, theEditor)
AddHandler theEditor.ActiveTextAreaControl.TextArea.ToolTipRequest, AddressOf tp.OnToolTipRequest
End Sub
End Class
Private Const DummyFileName As String = "dummy.vb"
Private pcREG As ICSharpCode.SharpDevelop.Dom.ProjectContentRegistry
Private myContent As ICSharpCode.SharpDevelop.Dom.DefaultProjectContent
Private parseInfo As ICSharpCode.SharpDevelop.Dom.ParseInformation
Private lastCompUnit As ICSharpCode.SharpDevelop.Dom.ICompilationUnit
Private parserThread As Threading.Thread
Private CurrentLanguageProperties As ICSharpCode.SharpDevelop.Dom.LanguageProperties
Private Sub InitializeControl()
parseInfo = New ICSharpCode.SharpDevelop.Dom.ParseInformation
CurrentLanguageProperties = ICSharpCode.SharpDevelop.Dom.LanguageProperties.VBNet
txtCode.SetHighlighting("VBNET")
HostCallbackImplementation.Register(Me)
CodeCompletionKeyHandler.Attach(Me, txtCode)
ToolTipProvider.Attach(Me, txtCode)
pcREG = New ICSharpCode.SharpDevelop.Dom.ProjectContentRegistry
'pcREG.ActivatePersistence(IO.Path.Combine(My.Computer.FileSystem.SpecialDirectories.Temp, "test"))
myContent = New ICSharpCode.SharpDevelop.Dom.DefaultProjectContent()
myContent.Language = CurrentLanguageProperties
End Sub
Private Function ConvertCompilationUnit(cu As ICSharpCode.NRefactory.Ast.CompilationUnit) As ICSharpCode.SharpDevelop.Dom.ICompilationUnit
Dim converter As New ICSharpCode.SharpDevelop.Dom.NRefactoryResolver.NRefactoryASTConvertVisitor(myContent)
cu.AcceptVisitor(converter, Nothing)
Return converter.Cu
End Function
Private Sub ParseStep()
Dim code As String = String.Empty
Invoke(New MethodInvoker(Sub() code = txtCode.Text))
Dim txtReader As IO.TextReader = New IO.StringReader(code)
Dim newCompUnit As ICSharpCode.SharpDevelop.Dom.ICompilationUnit
Dim supportedLanguage As ICSharpCode.NRefactory.SupportedLanguage = ICSharpCode.NRefactory.SupportedLanguage.VBNet
Using p As ICSharpCode.NRefactory.IParser = ICSharpCode.NRefactory.ParserFactory.CreateParser(supportedLanguage, txtReader)
'we only need to parse types and method definitions, no method bodies
p.ParseMethodBodies = False
p.Parse()
newCompUnit = ConvertCompilationUnit(p.CompilationUnit)
End Using
'Remove information from lastCompilationUnit and add from newCompilationUnit.
myContent.UpdateCompilationUnit(lastCompUnit, newCompUnit, DummyFileName)
lastCompUnit = newCompUnit
parseInfo.SetCompilationUnit(newCompUnit)
End Sub
Private Sub BackgroundParser()
BeginInvoke(New MethodInvoker(Sub() lblInfo.Text = "Loading Visual Basic..."))
myContent.AddReferencedContent(pcREG.Mscorlib)
'do one initial parser step to enable code-completion while other references are loading
ParseStep()
Dim refAssemblies As String() = {"System", _
"System.Data", _
"System.Drawing", _
"System.Xml", _
"System.Windows.Forms", _
"Microsoft.VisualBasic"}
For Each asmName As String In refAssemblies
Dim asmNameCopy As String = asmName
BeginInvoke(New MethodInvoker(Sub() lblInfo.Text = "Loading " & asmNameCopy & "..."))
Dim refContent As ICSharpCode.SharpDevelop.Dom.IProjectContent = pcREG.GetProjectContentForReference(asmName, asmName)
myContent.AddReferencedContent(refContent)
If TypeOf refContent Is ICSharpCode.SharpDevelop.Dom.ReflectionProjectContent Then
CType(refContent, ICSharpCode.SharpDevelop.Dom.ReflectionProjectContent).InitializeReferences()
End If
Next
myContent.DefaultImports = New ICSharpCode.SharpDevelop.Dom.DefaultUsing(myContent)
myContent.DefaultImports.Usings.Add("System")
myContent.DefaultImports.Usings.Add("System.Text")
myContent.DefaultImports.Usings.Add("Microsoft.VisualBasic")
BeginInvoke(New MethodInvoker(Sub() lblInfo.Text = "Ready..."))
'Parse the current file every 2 seconds
While Not IsDisposed
ParseStep()
Threading.Thread.Sleep(2000)
End While
End Sub
Protected Overrides Sub OnLoad(e As System.EventArgs)
MyBase.OnLoad(e)
If Not DesignMode Then
parserThread = New Threading.Thread(AddressOf BackgroundParser)
parserThread.IsBackground = True
parserThread.Start()
End If
End Sub
Public Sub New()
' This call is required by the designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
If Not DesignMode Then
InitializeControl()
End If
End Sub
End Class
I have a csv file with 48 columns of data.
I need to open this file, place it into a data structure and then search that data and present it in a DataRepeater.
So far I have successfully used CSVReader to extract the data and bind it to myDataRepeater. However I am now struggling to place the data in a table so that I can filter the results. I do not want to use SQL or any other database.
Does anyone have a suggestion on the best way to do this?
So far, this is working in returning all records:
Private Sub BindCsv()
' open the file "data.csv" which is a CSV file with headers"
Dim dirInfo As New DirectoryInfo(Server.MapPath("~/ftp/"))
Dim fileLocation As String = dirInfo.ToString & "data.txt"
Using csv As New CsvReader(New StreamReader(fileLocation), True)
myDataRepeater.DataSource = csv
myDataRepeater.DataBind()
End Using
End Sub
Protected Sub myDataRepeater_ItemDataBound(ByVal sender As Object, ByVal e As RepeaterItemEventArgs) Handles myDataRepeater.ItemDataBound
Dim dataItem As String() = DirectCast(e.Item.DataItem, String())
DirectCast(e.Item.FindControl("lblPropertyName"), ITextControl).Text = dataItem(2).ToString
DirectCast(e.Item.FindControl("lblPrice"), ITextControl).Text = dataItem(7).ToString
DirectCast(e.Item.FindControl("lblPricePrefix"), ITextControl).Text = dataItem(6)
DirectCast(e.Item.FindControl("lblPropertyID"), ITextControl).Text = dataItem(1)
DirectCast(e.Item.FindControl("lblTYPE"), ITextControl).Text = dataItem(18)
DirectCast(e.Item.FindControl("lblBedrooms"), ITextControl).Text = dataItem(8)
DirectCast(e.Item.FindControl("lblShortDescription"), ITextControl).Text = dataItem(37)
Dim dirInfo As New DirectoryInfo(Server.MapPath("~/ftp/images/"))
DirectCast(e.Item.FindControl("imgMain"), Image).ImageUrl = dirInfo.ToString & "pBRANCH_" & dataItem(1) & ".jpg"
DirectCast(e.Item.FindControl("linkMap"), HyperLink).NavigateUrl = "http://www.multimap.com/map/browse.cgi?client=public&db=pc&cidr_client=none&lang=&pc=" & dataItem(5) & "&advanced=&client=public&addr2=&quicksearch=" & dataItem(5) & "&addr3=&addr1="
End Sub
Code add to filter results:
Try
Dim csv As New CSVFile(fileLocation)
Dim ds As DataSet = csv.ToDataSet("MyTable")
If Not ds Is Nothing Then
Dim strExpr As String = "Bedrooms >= '3'"
Dim strSort As String = "PropertyID ASC"
'Use the Select method to find all rows matching the filter.
Dim myRows() As DataRow
'myRows = Dt.Select(strExpr, strSort)
myRows = csv.ToDataSet("MyTable").Tables("MyTable").Select(strExpr, strSort)
myDataRepeater.DataSource = myRows
myDataRepeater.DataBind()
End If
Catch ex As Exception
End Try
Which does return the two rows I am expecting but then when it binds to the datarepeater I get the following error:
DataBinding: 'System.Data.DataRow' does not contain a property with the name 'PropertyName'.
Corrected code, filter not being applied:
Public Sub PageLoad(ByVal Sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
If Not Page.IsPostBack Then
ReadCsv()
lblSearch.Text = "Lettings Search"
End If
End Sub
Private Sub ReadCsv()
Dim dirInfo As New DirectoryInfo(Server.MapPath("~/ftp/"))
Dim fileLocation As String = dirInfo.ToString & "data.txt"
Try
Dim csv As New CSVFile(fileLocation)
Dim ds As DataSet = csv.ToDataSet("MyTable")
If Not ds Is Nothing Then
myDataRepeater.DataSource = ds
myDataRepeater.DataMember = ds.Tables.Item(0).TableName
myDataRepeater.DataBind()
End If
ds = Nothing
csv = Nothing
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Protected Sub btnSubmit_Click(ByVal sender As Object, ByVal e As System.Web.UI.ImageClickEventArgs) Handles btnSubmit.Click
Dim rowCount As Integer
rowCount = QueryCsv()
pnlSearch.Visible = False
lblResults.Visible = True
lblSearch.Text = "Search Results"
lblResults.Text = "Your search returned " & rowCount.ToString & " results"
If rowCount > 0 Then
myDataRepeater.Visible = True
pnlResults.Visible = True
btnBack.Visible = True
End If
End Sub
Protected Function QueryCsv() As Integer
Dim dirInfo As New DirectoryInfo(Server.MapPath("~/ftp/"))
Dim fileLocation As String = dirInfo.ToString & "data.txt"
Dim numberofRows As Integer
Try
Dim csv As New CSVFile(fileLocation)
Dim ds As DataSet = csv.ToDataSet("MyTable")
If Not ds Is Nothing Then
Dim strExpr As String = "PropertyID = 'P1005'"
Dim strSort As String = "PropertyID DESC"
Try
ds.Tables.Item(0).DefaultView.RowFilter = strExpr
ds.Tables.Item(0).DefaultView.Sort = strSort
myDataRepeater.DataSource = ds.Tables.Item(0).DefaultView
Catch ex As Exception
End Try
End If
numberofRows = ds.Tables("MyTable").Rows.Count
Catch ex As Exception
End Try
Return numberofRows
End Function
Why not use the built-in TextFileParser to get the data into a DataTable? Something like Paul Clement's answer in this thread
One of the ways I've done this is by using a structure array and reflection.
First, set up your structure in a module: CSVFileFields.vb
Imports System.Reflection
Public Module CSVFileFields
#Region " CSV Fields "
Public Structure CSVFileItem
Dim NAME As String
Dim ADDR1 As String
Dim ADDR2 As String
Dim CITY As String
Dim ST As String
Dim ZIP As String
Dim PHONE As String
Public Function FieldNames() As String()
Dim rtn() As String = Nothing
Dim flds() As FieldInfo = Me.GetType.GetFields(BindingFlags.Instance Or BindingFlags.Public)
If Not flds Is Nothing Then
ReDim rtn(flds.Length - 1)
Dim idx As Integer = -1
For Each fld As FieldInfo In flds
idx += 1
rtn(idx) = fld.Name
Next
End If
Return rtn
End Function
Public Function ToStringArray() As String()
Dim rtn() As String = Nothing
Dim flds() As FieldInfo = Me.GetType.GetFields(BindingFlags.Instance Or BindingFlags.Public)
If Not flds Is Nothing Then
ReDim rtn(flds.Length - 1)
Dim idx As Integer = -1
For Each fld As FieldInfo In flds
idx += 1
rtn(idx) = fld.GetValue(Me)
Next
End If
Return rtn
End Function
Public Shadows Function ToString(ByVal Delimiter As String) As String
Dim rtn As String = ""
Dim flds() As FieldInfo = Me.GetType.GetFields(BindingFlags.Instance Or BindingFlags.Public)
If Not flds Is Nothing Then
For Each fld As FieldInfo In flds
rtn &= fld.GetValue(Me) & Delimiter
Next
rtn = rtn.Substring(0, rtn.Length - 1)
End If
Return rtn
End Function
End Structure
#End Region
End Module
Next we will make our own collection out of the structure we just made. This will make it easy to use .Add() .Remove() etc for our structure. We can also remove individual items with .RemoveAt(Index). File: CSVFileItemCollection.vb
#Region " CSVFileItem Collection "
Public Class CSVFileItemCollection
Inherits System.Collections.CollectionBase
Public Sub Add(ByVal NewCSVFileItem As CSVFileItem)
Me.List.Add(NewCSVFileItem)
End Sub
Public Sub Remove(ByVal RemoveCSVFileItem As CSVFileItem)
Me.List.Remove(RemoveCSVFileItem)
End Sub
Default Public Property Item(ByVal index As Integer) As CSVFileItem
Get
Return Me.List.Item(index)
End Get
Set(ByVal value As CSVFileItem)
Me.List.Item(index) = value
End Set
End Property
Public Shadows Sub Clear()
MyBase.Clear()
End Sub
Public Shadows Sub RemoveAt(ByVal index As Integer)
Remove(Item(index))
End Sub
End Class
#End Region
Next you need your class to handle the reflection import: CSVFile.vb
Imports System.Reflection
Imports System.IO
Imports Microsoft.VisualBasic.PowerPacks
Public Class CSVFile
#Region " Private Variables "
Private _CSVFile As CSVFileItem, _Delimiter As String, _Items As New CSVFileItemCollection
#End Region
#Region " Private Methods "
Private Sub FromString(ByVal Line As String, ByVal Delimiter As String)
Dim CSVFileElements() As String = Line.Split(Delimiter)
If Not CSVFileElements Is Nothing Then
Dim fldInfo() As FieldInfo = _CSVFile.GetType.GetFields(BindingFlags.Instance Or BindingFlags.Public)
If Not fldInfo Is Nothing Then
Dim itm As System.ValueType = CType(_CSVFile, System.ValueType)
For fldIdx As Integer = 0 To CSVFileElements.Length - 1
fldInfo(fldIdx).SetValue(itm, CSVFileElements(fldIdx).Replace(Chr(34), ""))
Next
_CSVFile = itm
Else
Dim itms As Integer = 0
If Not fldInfo Is Nothing Then
itms = fldInfo.Length
End If
Throw New Exception("Invalid line definition.")
End If
Else
Dim itms As Integer = 0
If Not CSVFileElements Is Nothing Then
itms = CSVFileElements.Length
End If
Throw New Exception("Invalid line definition.")
End If
End Sub
#End Region
#Region " Public Methods "
Public Sub New()
_CSVFile = New CSVFileItem
End Sub
Public Sub New(ByVal Line As String, ByVal Delimiter As String)
_CSVFile = New CSVFileItem
_Delimiter = Delimiter
FromString(Line, Delimiter)
End Sub
Public Sub New(ByVal Filename As String)
LoadFile(Filename)
End Sub
Public Sub LoadFile(ByVal Filename As String)
Dim inFile As StreamReader = File.OpenText(Filename)
Do While inFile.Peek > 0
FromString(inFile.ReadLine, ",")
_Items.Add(_CSVFile)
_CSVFile = Nothing
Loop
inFile.Close()
End Sub
#End Region
#Region " Public Functions "
Public Function ToDataSet(ByVal TableName As String) As DataSet
Dim dsCSV As DataSet = Nothing
If Not _Items Is Nothing AndAlso _Items.Count > 0 Then
Dim flds() As FieldInfo = _Items.Item(0).GetType.GetFields(BindingFlags.Instance Or BindingFlags.Public)
If Not flds Is Nothing Then
dsCSV = New DataSet
dsCSV.Tables.Add(TableName)
For Each fld As FieldInfo In flds
'Add Column Names
With dsCSV.Tables.Item(TableName)
.Columns.Add(fld.Name, fld.FieldType)
End With
Next
'Populate Table with Data
For Each itm As CSVFileItem In _Items
dsCSV.Tables.Item(TableName).Rows.Add(itm.ToStringArray)
Next
End If
End If
Return dsCSV
End Function
#End Region
#Region " Public Properties "
Public ReadOnly Property Item() As CSVFileItem
Get
Return _CSVFile
End Get
End Property
Public ReadOnly Property Items() As CSVFileItemCollection
Get
Return _Items
End Get
End Property
#End Region
End Class
Okay a little explanation. What this class is doing is first getting the line of delimited (",") text and splitting it into a string array. Then it iterates through every field you have in your structure CSVFileItem and based on the index populates that structure variable. It doesn't matter how many items you have. You could have 1 or 1,000 so long as the order in which your structure is declared is the same as the contents you are loading. For example, your input CSV should match CSVFileItem as "Name,Address1,Address2,City,State,Zip,Phone". That is done with this loop here from the above code:
Dim fldInfo() As FieldInfo = _CSVFile.GetType.GetFields(BindingFlags.Instance Or BindingFlags.Public)
If Not fldInfo Is Nothing Then
Dim itm As System.ValueType = CType(_CSVFile, System.ValueType)
For fldIdx As Integer = 0 To CSVFileElements.Length - 1
fldInfo(fldIdx).SetValue(itm, CSVFileElements(fldIdx).Replace(Chr(34), ""))
Next
_CSVFile = itm
Else
Dim itms As Integer = 0
If Not fldInfo Is Nothing Then
itms = fldInfo.Length
End If
Throw New Exception("Invalid line definition.")
End If
To make things easy, instead of having to load the file from our main class, we can simply pass it the file path and this class will do all of the work and return a collection of our structure. I know this seems like a lot of setup, but it's worth it and you can come back and change your original structure to anything and the rest of the code will still work flawlessly!
Now to get everything going. Now you get to see how easy this is to implement with only a few lines of code. File: frmMain.vb
Public Class Form1
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Try
Dim csv As New CSVFile("C:\myfile.csv")
Dim ds As DataSet = csv.ToDataSet("MyTable")
If Not ds Is Nothing Then
'Add Labels
Dim lblSize As New Size(60, 22), lblY As Integer = 10, lblX As Integer = 10, lblSpacing As Integer = 10
For Each fldName As String In csv.Items.Item(0).FieldNames
Dim lbl As New Label
lbl.AutoSize = True
lbl.Size = lblSize
lbl.Location = New Point(lblX, lblY)
lbl.Name = "lbl" & fldName
lblX += lbl.Width + lblSpacing
lbl.DataBindings.Add(New Binding("Text", ds.Tables.Item(0), fldName, True))
drMain.ItemTemplate.Controls.Add(lbl)
Next
drMain.DataSource = ds
drMain.DataMember = ds.Tables.Item(0).TableName
End If
ds = Nothing
csv = Nothing
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
End Class
This really makes for some dynamic programming. You can wrap these in generic classes and call the functions for any structure. You then have some reusable code that will make your programs efficient and cut down on programming time!
Edit:
Added the ability to dump structure collection to a dataset and then dynamically fill a datarepeater.
Hope this helps. (I know this was a lot of information and seems like a lot of work, but I guarantee you that once you get this in place, it will really cut down on future projects coding time!)