How to change filepath when check a radiobutton? Visual basic - vb.net

My problem here is that i have 3 radiobuttons for 3 different categories:
Huse Folii and Altele.
The idea is when i select a radiobutton,the filepath will change to Huse,Folii or Altele.
For example i tried to make _path :
Dim _path As String = IO.Path.Combine("C:\Descriere\Huse\")
then use the _path here:
Dim ioFile As New System.IO.StreamReader(_path + "a.txt")
but it didn't worked,for sure i do something wrong,but i can't find how or where to use that _path...
Here is the code:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
On Error Resume Next
TextBox1.Clear()
If RadioButton1.Checked = True Then
Dim _path As String = IO.Path.Combine("C:\Descriere\Huse\")
End If
If RadioButton2.Checked = True Then
Dim _path As String = IO.Path.Combine("C:\Descriere\Folii\")
End If
If RadioButton3.Checked = True Then
IO.Path.
Dim _path As String = IO.Path.Combine("C:\Descriere\Altele\")
End If
Dim ioFile As New System.IO.StreamReader(_path + "a.txt")
Dim lines As New List(Of String)
Dim rnd As New Random()
Dim line As Integer
While ioFile.Peek <> -1
lines.Add(ioFile.ReadLine())
End While
line = rnd.Next(lines.Count + 1)
TextBox1.AppendText(lines(line).Trim())
ioFile.Close()
ioFile.Dispose()
Dim ioFile2 As New System.IO.StreamReader(path:=+"core.txt")
Dim lines2 As New List(Of String)
Dim rnd2 As New Random()
Dim line2 As Integer
While ioFile2.Peek <> -1
lines2.Add(ioFile2.ReadLine())
End While
line2 = rnd2.Next(lines2.Count + 1)
TextBox1.AppendText(lines2(line2).Trim())
ioFile2.Close()
ioFile2.Dispose()
Dim ioFile3 As New System.IO.StreamReader(path:=+"x.txt")
Dim lines3 As New List(Of String)
Dim rnd3 As New Random()
Dim line3 As Integer
While ioFile3.Peek <> -1
lines3.Add(ioFile3.ReadLine())
End While
line3 = rnd3.Next(lines3.Count + 1)
TextBox1.AppendText(lines3(line3).Trim())
ioFile3.Close()
ioFile3.Dispose()
TextBox1.Text = Replace(TextBox1.Text, "BRAND", TextBox2.Text)
TextBox1.Text = Replace(TextBox1.Text, "MODEL", TextBox3.Text)
Dim count As Integer = 0
count = TextBox1.Text.Split(" ").Length - 1
Label5.Text = "Caractere:" & Len(TextBox1.Text)
End Sub

You are using IO.Path.Combine but you have nothing to Combine at the place of use in your code. You have to use IO.Path.Combine later in your code because this is a method to Combine part of a path and a filename e.g. set your _path first and combine in a second step. Please note this code is not tested for your needs, because your coding is not clear to me.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim directoryName As String = "D:\"
On Error Resume Next
TextBox1.Clear()
If RadioButton1.Checked = True Then
directoryName = "D:\Descriere\Huse"
End If
If RadioButton2.Checked = True Then
directoryName = "D:\Descriere\Folii"
End If
If RadioButton3.Checked = True Then
'//--- IO.Path.
directoryName = "D:\Descriere\Altele"
End If
Dim ioFile As New System.IO.StreamReader(System.IO.Path.Combine(directoryName, "a.txt"))
...
Dim ioFile2 As New System.IO.StreamReader(System.IO.Path.Combine(directoryName, "core.txt"))
...
Dim ioFile3 As New System.IO.StreamReader(System.IO.Path.Combine(directoryName, "x.txt"))
...
End Sub
Please use the debugger of your IDE because your code isn't clean e.g. a hanging aroung IO.Path.

Related

Get data from cmd, split the values and insert them into textboxes

I'm trying to read battery information from cmd. How can I extract each value and put them in their respective textbox, as shown in the image below?
Here's my code:
Private Results As String
Private Delegate Sub delUpdate()
Private Finished As New delUpdate(AddressOf UpdateText)
Private Sub UpdateText()
TextBox11.Text = Results
End Sub
Private Sub batt_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim CMDThread As New Threading.Thread(AddressOf CMDAutomate)
CMDThread.Start()
End Sub
Private Sub CMDAutomate()
Dim myprocess As New Process
Dim StartInfo As New System.Diagnostics.ProcessStartInfo
StartInfo.FileName = "cmd" 'starts cmd window
StartInfo.RedirectStandardInput = True
StartInfo.RedirectStandardOutput = True
StartInfo.UseShellExecute = False 'required to redirect
StartInfo.CreateNoWindow = False 'creates no cmd window
myprocess.StartInfo = StartInfo
myprocess.Start()
Dim SR As System.IO.StreamReader = myprocess.StandardOutput
Dim SW As System.IO.StreamWriter = myprocess.StandardInput
SW.WriteLine("adb shell dumpsys battery") 'the command you wish to run.....
SW.WriteLine("exit") 'exits command prompt window
Results = SR.ReadToEnd 'returns results of the command window
SW.Close()
SR.Close()
'invokes Finished delegate, which updates textbox with the results text
Invoke(Finished)
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim value As String = TextBox11.Text
Dim topic_start As String = topic_start = value.LastIndexOf("AC Powered:") + 1
Dim topic As String = value.Substring(topic_start, value.Length - topic_start)
TextBox1.Text = topic.ToString
End Sub
Button1 is labeled Get Battery Information in the image.
Private Sub UpdateText()
Dim xList As New List(Of KeyValuePair(Of String, String))
Results = Results.Replace(vbLf, "")
Dim LineSplit() As String = Results.Split(vbCr)
For Each xLine As String In LineSplit
If xLine <> "" Then
xList.Add(New KeyValuePair(Of String, String)(xLine.Split(":")(0), xLine.Split(":")(1).Trim.Replace(" ", "")))
End If
Next
'do some work here to put the values in the right textboxes
End Sub
You can make yourself a custom control made of a label and a textbox that you use in your app. Then you just pass each entry of the list to your custom controls. Makes it easier to add or remove fields without having tons of IF then or a big Select Case
Here one way to extract values from text that is separated with new lines (Enviroment.NewLine) using IndexOf(), Substring() methods and Length property:
Private Sub UpdateGUI()
Dim lines As String() = TextBox1.Text.Split(New String() {Environment.NewLine}, StringSplitOptions.RemoveEmptyEntries)
For Each itm In lines
MsgBox(itm.Substring(itm.IndexOf(":") + 1, itm.Length - itm.IndexOf(":") - 1))
Next
End Sub
Unless your TextBoxes are named exactly like the value in your return string (you'd have to convert the space to some other character anyways), there really isn't any way to do this except to manually code each case. Something like this should do it, just change the name of the TextBoxes accordingly:
Private Sub UpdateText()
Dim lines() As String = Results.Split(vbCrLf.ToCharArray, StringSplitOptions.RemoveEmptyEntries)
For Each line In lines
Dim values() As String = line.Split(":")
Select Case values(0).ToUpper.Trim
Case "AC POWERED"
TextBox1.Text = values(1).ToUpper.Trim
Case "USB POWERED"
TextBox2.Text = values(1).ToUpper.Trim
Case "WIRELESS POWERED"
TextBox3.Text = values(1).ToUpper.Trim
Case "STATUS"
TextBox4.Text = values(1).ToUpper.Trim
Case "HEALTH"
TextBox5.Text = values(1).ToUpper.Trim
Case "PRESENT"
TextBox6.Text = values(1).ToUpper.Trim
Case "LEVEL"
TextBox7.Text = values(1).ToUpper.Trim
Case "SCALE"
TextBox8.Text = values(1).ToUpper.Trim
Case "VOLTAGE"
TextBox9.Text = values(1).ToUpper.Trim
Case "TEMPERATURE"
TextBox10.Text = values(1).ToUpper.Trim
Case "TECHNOLOGY"
TextBox11.Text = values(1).ToUpper.Trim
Case Else
MessageBox.Show(line, "Unknown Value")
End Select
Next
End Sub
If you named your TextBoxes in a predictable manner, then you can use Controls.Find() and shorten the code to the below. For instance, change spaces to underscore, and prepend "txt" in front: "txtAC_Powered", "txtUSB_Powered", "txtStatus", "txtHealth", etc. Case does NOT matter as a match will be found regardless. This means you're doing the manual work in naming your controls, as opposed to writing a long select case statement (or something else):
Private Sub UpdateText()
Dim lines() As String = Results.Split(vbCrLf.ToCharArray, StringSplitOptions.RemoveEmptyEntries)
For Each line In lines
Dim values() As String = line.Split(":")
Dim ctlName As String = "txt" & values(0).Replace(" ", "_").Trim
Dim ctl As Control = Me.Controls.Find(ctlName, True).FirstOrDefault
If Not IsNothing(ctl) Then
ctl.Text = values(1).ToUpper.Trim
End If
Next
End Sub

multi-threaded code to check proxies

I'm suffering with this VB.Net 2017 code which is supposed to check if Proxies working or not. Sometimes it reach to an end successfully, and sometimes the program never reach and end or take lots of time to do so, although I have specified the timeout for every webrequest to be 11000... Also, the list of working proxies always has duplicates! I don't know how that happens, althoug the original (raw) list is unique!
Could you please help? This is supposed to wait till the 99 threads finished then another 99 (or the remaining threads) kick-started.
P.S. MYWEBSITE.com works for me only and it displays the IP address of the visitor, i.e. to double check if the proxy has worked fine
Imports System.Net
Imports System.IO
Imports System
Imports System.Text.RegularExpressions
Imports System.Threading
Public Class frmMain
Dim FinalWorkingProxies As New List(Of String)()
Private Sub btnBrowse_Click(sender As Object, e As EventArgs) Handles btnBrowse.Click
Control.CheckForIllegalCrossThreadCalls = False
PB.Maximum = txtRawIP.Lines.Count
PB.Value = 0
StartCheckingIP(0)
End Sub
Function StartCheckingIP(ByVal num As Integer)
For I As Integer = num To txtRawIP.Lines.Count - 1
Dim StrIPOnly As String = txtRawIP.Lines(I)
StrIPOnly = Trim(StrIPOnly.TrimStart("0"c)) 'remove any leading zeros
Try
Dim clsThreads As New System.Threading.Thread(AddressOf CheckIP)
clsThreads.Start(StrIPOnly)
Catch ex As Exception
MsgBox(I)
End Try
If (I > 0 And (I Mod 99 = 0)) Then Exit For
Next
Return True
End Function
Private Function CheckIP(ByVal Prox As String) As Boolean
'txtHTML.Text += vbCrLf & Prox
'txtHTML.Refresh()
Dim txtWebResult As String = ""
Dim OriginalFullProx As String = Trim(Prox)
Dim proxyObject As WebProxy = New WebProxy("http://" & OriginalFullProx & "/")
proxyObject.BypassProxyOnLocal = True
Prox = Prox.Substring(0, Prox.IndexOf(":"))
Dim sURL As String
sURL = "http://MYWEBSITE.com/testip.php"
Dim wrGETURL As WebRequest
wrGETURL = WebRequest.Create(sURL)
wrGETURL.Proxy = proxyObject
wrGETURL.Timeout = 6000
txtWebResult = "Dosn't work"
Try
Dim objStream As Stream
objStream = wrGETURL.GetResponse.GetResponseStream
Dim objReader As New StreamReader(objStream)
Dim sLine As String = ""
sLine = objReader.ReadLine
If Not sLine Is Nothing Then
txtWebResult = sLine
End If
txtWebResult = Regex.Replace(txtWebResult, “^\s+$[\r\n]*”, “”, RegexOptions.Multiline)
If (Trim(Prox) = Trim(txtWebResult)) Then
FinalWorkingProxies.Add(OriginalFullProx)
End If
Catch ex As Exception
txtWebResult = "Dosn't work"
End Try
If (PB.Value < PB.Maximum) Then PB.Value += 1
PB.Refresh()
If (PB.Value = PB.Maximum) Then
txtFilteredIP.Clear()
Randomize()
Dim RRR As Integer = CInt(Math.Ceiling(Rnd() * 1000)) + 1
Thread.Sleep(RRR)
If (txtFilteredIP.Text <> "") Then Return False
Dim str As String
For Each str In FinalWorkingProxies
txtFilteredIP.Text += str & vbCrLf
Next
ElseIf ((PB.Value - 1) > 0 And ((PB.Value - 1) Mod 99 = 0)) Then
StartCheckingIP(PB.Value)
End If
Return True
End Function
Private Sub txtRawIP_TextChanged(sender As Object, e As EventArgs) Handles txtRawIP.TextChanged
lblRawIPTotal.Text = "Total: " & txtRawIP.Lines.Count
End Sub
Private Sub txtFilteredIP_TextChanged(sender As Object, e As EventArgs) Handles txtFilteredIP.TextChanged
lblFilteredIPTotal.Text = "Total: " & txtFilteredIP.Lines.Count
End Sub
End Class
Here is the modified code, but it stills takes long of time to finalize long list of proxies, although I sat max concurrent connection to 2000 and timeout to 8sec. Please help. Thanks.
Public Class frmMain
Dim FinalWorkingProxies As New List(Of String)()
Private Sub btnBrowse_Click(sender As Object, e As EventArgs) Handles btnBrowse.Click
'Control.CheckForIllegalCrossThreadCalls = False
ServicePointManager.Expect100Continue = False
ServicePointManager.DefaultConnectionLimit = 2000
'ServicePointManager.Expect100Continue = True
FinalWorkingProxies.Clear()
PB.Maximum = txtRawIP.Lines.Count
PB.Value = 0
StartCheckingIP(0)
End Sub
Function StartCheckingIP(ByVal num As Integer)
For I As Integer = num To txtRawIP.Lines.Count - 1
Dim StrIPOnly As String = txtRawIP.Lines(I)
StrIPOnly = Trim(StrIPOnly.TrimStart("0"c)) 'remove any leading zeros
Try
Dim clsThreads As New System.Threading.Thread(AddressOf CheckIP)
clsThreads.Start(StrIPOnly)
Catch ex As Exception
MsgBox(I)
End Try
If (I > 0 And (I Mod 333 = 0)) Then Exit For
Next
Return True
End Function
Private Function CheckIP(ByVal Prox As String) As Boolean
'txtHTML.Text += vbCrLf & Prox
'txtHTML.Refresh()
Dim txtWebResult As String = ""
Dim OriginalFullProx As String = Trim(Prox)
Dim proxyObject As WebProxy = New WebProxy("http://" & OriginalFullProx & "/")
proxyObject.BypassProxyOnLocal = True
Prox = Prox.Substring(0, Prox.IndexOf(":"))
Dim sURL As String
sURL = "http://MYWEBSITE.com/testip.php"
Dim wrGETURL As WebRequest
wrGETURL = WebRequest.Create(sURL)
wrGETURL.Proxy = proxyObject
wrGETURL.Timeout = 8000
txtWebResult = "Dosn't work"
Try
Dim objStream As Stream
objStream = wrGETURL.GetResponse.GetResponseStream
Dim objReader As New StreamReader(objStream)
Dim sLine As String = ""
sLine = objReader.ReadLine
If Not sLine Is Nothing Then
txtWebResult = sLine
End If
txtWebResult = Regex.Replace(txtWebResult, “^\s+$[\r\n]*”, “”, RegexOptions.Multiline)
If (Trim(Prox) = Trim(txtWebResult)) Then
'Now know exact country
sURL = "http://ip-api.com/xml/" & Prox
wrGETURL = WebRequest.Create(sURL)
wrGETURL.Proxy = proxyObject
wrGETURL.Timeout = 8000
objStream = wrGETURL.GetResponse.GetResponseStream
Dim objReader2 As New StreamReader(objStream)
Dim FullCODEOFAPI As String = objReader2.ReadToEnd()
Dim XMLR As XmlReader
XMLR = XmlReader.Create(New StringReader(FullCODEOFAPI))
XMLR.ReadToFollowing("country")
XMLR.Read()
OriginalFullProx += "-" + XMLR.Value
FinalWorkingProxies.Add(OriginalFullProx)
End If
Catch ex As Exception
txtWebResult = "Dosn't work"
End Try
If (PB.Value < PB.Maximum) Then UpdatePB(1)
If (PB.Value = PB.Maximum) Then
UpdateFilteredList(1)
ElseIf ((PB.Value - 1) > 0 And ((PB.Value - 1) Mod 333 = 0)) Then
StartCheckingIP(PB.Value)
End If
Return True
End Function
Private Delegate Sub UpdatePBDelegate(ByVal PBVal As Integer)
Private Sub UpdatePB(ByVal PBVal As Integer)
If PB.InvokeRequired Then
PB.Invoke(New UpdatePBDelegate(AddressOf UpdatePB), New Object() {PBVal})
Else
PB.Value += PBVal
PB.Refresh()
End If
End Sub
Private Delegate Sub UpdateFilteredListDelegate()
Private Sub UpdateFilteredList(ByVal TMP As Integer)
If txtFilteredIP.InvokeRequired Then
txtFilteredIP.Invoke(New UpdatePBDelegate(AddressOf UpdateFilteredList), New Object() {TMP})
Else
txtFilteredIP.Clear()
Dim str As String
For Each str In FinalWorkingProxies
txtFilteredIP.Text += str & vbCrLf
Next
End If
End Sub
Private Sub txtRawIP_TextChanged(sender As Object, e As EventArgs) Handles txtRawIP.TextChanged
lblRawIPTotal.Text = "Total: " & txtRawIP.Lines.Count
End Sub
Private Sub txtFilteredIP_TextChanged(sender As Object, e As EventArgs) Handles txtFilteredIP.TextChanged
lblFilteredIPTotal.Text = "Total: " & txtFilteredIP.Lines.Count
End Sub
Private Sub btnLoadList_Click(sender As Object, e As EventArgs) Handles btnLoadList.Click
OFD.ShowDialog()
If (OFD.FileName <> "") Then
txtRawIP.Text = File.ReadAllText(OFD.FileName)
End If
End Sub
End Class

Data type long can not be converted

I have a problem with error which show me problem with long data type in this part of code:
If Not filename Then
Call Form15.Show()
TextBox1.Clear()
here is full code:
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
Dim filename As String
Dim regCis = TextBox1.Text
filename = TextBox1.Text
Dim zakazCis As Double
Dim found As Boolean = False
found = True
If (Double.TryParse(TextBox2.Text, zakazCis)) Then
zakazCis = TextBox2.Text
Else
zakazCis = Nothing
End If
Dim basePath As String = "C:\_Montix a.s. - cloud\iMontix\Testy"
Dim filePath As String = IO.Path.Combine(basePath, filename & ".lbe")
'Napojeni tabulky
Dim table As DataTable = SdfDataSet.Tables("List1")
Me.Refresh()
'Vytvoreni dotazu
Dim expression As String
expression = ("[Čísla dílů] = '" & regCis & "'")
Dim foundRows() As DataRow
Me.PictureBox1.Invalidate()
Dim bla = "Label10"
'vykonani dotazu
foundRows = table.Select(expression)
If Not filename Then
Call Form15.Show()
TextBox1.Clear()
Else
If (foundRows(0)(2) = zakazCis) Then
'souhlasí regCis a zakcis
PictureBox1.Image = Image.FromFile("C:\_Montix a.s. - cloud\Visual Studio 2015\Projects\WindowsApplication17\WindowsApplication17\img\tick.png")
Label10.BackColor = Color.Green
Me.Controls(bla).Text = "SPRÁVNĚ"
fileprint.PrintThisfile(filePath)
Threading.Thread.Sleep(4000)
SendKeys.Send("{ENTER}")
TextBox2.Clear()
TextBox2.Select()
Button6.Hide()
PictureBox1.Hide()
Label10.Hide()
Else
'NEsouhlasí regCis a zakcis
PictureBox1.Image = Image.FromFile("C:\_Montix a.s. - cloud\Visual Studio 2015\Projects\WindowsApplication17\WindowsApplication17\img\cross.png")
Label10.BackColor = Color.Red
Form15.Show()
TextBox2.Clear()
TextBox2.Select()
End If
End If
End Sub
and here is code from form15
Public Class Form15
Private Sub Button11_Click(ByVal sender As Object, ByVal e As EventArgs)
Me.Hide()
End Sub
End Class
Do you known where is a problem?
You are using a string in a boolean expression. I guess, you might have added the string instead of the boolean by mistake. ('found' instead of 'filename')
If Not found Then
Call Form15.Show()
TextBox1.Clear()
Else

Binary Reader and allowed characters

I have a problem.
Now program working like this:
Reading binary file bytes. &H1E and &H1F Allowed characters only :A123456789
If in file is B or C or D or E or F....... textbox1 = bad file
That's working. Now I want to add verification in &H10.
Allowed characters only 26
If other characters textbox1 = bad file
Imports System.IO
Imports System.IO.SeekOrigin
Public Class Form1
Dim charactersAllowed As String = "A123456789"
Dim swap As String = "26"
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim OFD As New OpenFileDialog
Dim fullFile() As Byte
With OFD
.Filter = "Binary files (*.bin)|*.bin"
End With
If OFD.ShowDialog = Windows.Forms.DialogResult.OK Then
fullFile = File.ReadAllBytes(OFD.FileName)
TextBox1.AppendText(fullFile(&H1E).ToString("X2") & " ")
TextBox1.AppendText(fullFile(&H1F).ToString("X2"))
TextBox4.AppendText(fullFile(&H10).ToString("X2"))
End If
Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs) Handles TextBox1.TextChanged
Dim theText As String = TextBox1.Text
Dim Letter As String
Dim SelectionIndex As Integer = TextBox1.SelectionStart
Dim Change As Integer
For x As Integer = 0 To TextBox1.Text.Length - 1
Letter = TextBox1.Text.Substring(x, 1)
If charactersAllowed.Contains(Letter) = False Then
theText = theText.Replace(Letter, String.Empty)
Change = 1
End If
Next
TextBox1.Text = theText
TextBox1.Select(SelectionIndex - Change, 0)
End Sub
Private Sub TextBox4_TextChanged(sender As Object, e As EventArgs) Handles TextBox4.TextAlignChanged
Dim check As String = TextBox4.Text
Dim check2 As String
Dim check3 As Integer = TextBox4.SelectionStart
Dim check4 As Integer
For x As Integer = 0 To TextBox4.Text.Length - 1
check2 = TextBox4.Text.Substring(x, 1)
If swap.Contains(check2) = False Then
check = check.Replace(check2, String.Empty)
check4 = 1
End If
Next
TextBox1.Text = check
TextBox1.Select(check3 - check4, 0)
End Sub
Hard to decode, but an obvious approach is to prevent editing when the byte has the wrong value:
If OFD.ShowDialog = Windows.Forms.DialogResult.OK Then
fullFile = File.ReadAllBytes(OFD.FileName)
If fullFile(&H10) <> 26 Then
TextBox1.Text = "Bad file"
TextBox1.Enabled = False
TextBox4.Enabled = False
Else
TextBox1.Enabled = True
TextBox4.Enabled = True
'' etc...
End If
End If

Listview - select mosti similar item to value

How would one select item in listview (first column) that is most similar to string value from e.g. label or textbox.
Listview is populated with this code :
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
ListView1.Items.Clear()
ListView1.View = System.Windows.Forms.View.Details
ListView1.Columns.Add("COL1", 100, HorizontalAlignment.Left) 'KONTO
ListView1.Columns.Add("COL2", 140, HorizontalAlignment.Left) 'NAZIV
Dim FilePath As String = "W:\GLAVNI\KOR14\"
Dim DBF_File As String = "MATIKGL"
Dim ColName As String = "KONTO"
'Dim naz As String
Using con As New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FilePath & _
" ;Extended Properties=dBASE IV")
con.Open()
Using cmd As New OleDbCommand("SELECT * FROM MATIKGL ORDER BY KONTO, NAZIV", con)
Using reader As OleDbDataReader = cmd.ExecuteReader()
If reader.HasRows Then
While (reader.Read())
Me.ListView1.Items.Add(reader("KONTO"))
'ListView1.Items(i).SubItems.Add(rdr.Item("YourColumnName").ToString)
'BELOW SELECTS ALL ITEMS THAT STARTS WITH 2020-
For i = 0 To ListView1.Items.Count - 1
If ListView1.Items(i).ToString.Contains("2020-") Then
Else
ListView1.Items.Remove(ListView1.Items(i))
End If
Next
End While
Else
End If
End Using
End Using
con.Close()
End Using
End Sub
I have one textbox and a button.
Textual input from textbox should be compared with all items in listview and closest should be selected. One more thing : All items are sorted alphabetically
Button code is :
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
ListView1.MultiSelect = False
ListView1.FullRowSelect = True
Dim checkInt As Integer = FindItem(ListView1, "2020-" & TextBox1.Text)'this one is changed since all items starts with "2020-"& UCASE TEXT
If checkInt <> -1 Then
ListView1.Items(checkInt).Selected = True
ListView1.Focus()
Else
Label1.Text = "Search string not found"
End If
End Sub
UPDATED CODE
Dim checkInt As Integer = FindItem(ListView1, "2020-" & TextBox3.Text)
If checkInt <> -1 Then
TextBox4.Focus()
Else
Label14.Text = "NEMA"
On Error GoTo ext
Dim li As ListViewItem
ListView1.SelectedItems.Clear()
ListView1.HideSelection = False
li = ListView1.FindItemWithText("2020-" & UCase(TextBox3.Text))
If Not (li Is Nothing) Then
Me.ListView1.Focus()
li.Selected = True
li.EnsureVisible()
ElseIf li Is Nothing Then
li = ListView1.FindItemWithText("2020-" & Strings.Left(TextBox3.Text, 1))
Me.ListView1.Focus()
li.Selected = True
li.EnsureVisible()
Else
End If
Exit Sub
ext:
TextBox3.Text = ""
TextBox3.Focus()
Label14.Text = "String not found"
End If
This one works.
I know it's not the best solution but it's working.
Could fixed this without your help, thank you Phillip Trelford
Define a function to score two strings for closeness then use LINQ to find the lowest score, i.,e.
' Example score function
Function Score(a As String, b As String) As Integer
Dim index = 0
While index < a.Length And index < b.Length
Dim diff = Math.Abs(AscW(a(index)) - AscW(b(index)))
If diff <> 0 Then Return diff
index += 1
End While
Return Math.Abs(a.Length - b.Length)
End Function
Function Closest(searchWord As String, words As String()) As String
Dim ordered =
From w In words
Select Word = w, Score = Score(w, searchWord)
Order By Score
Return ordered.First().Word
End Function
Sub Main()
Dim words = {"Alpha", "Apple", "Ask"}
Dim searchWord = "Ann"
Dim word = Closest(searchWord, words)
Console.WriteLine(word)
End Sub
Update
To select the value in a WinForms ListView, you need to do roughly this:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
ListView1.MultiSelect = False
ListView1.FullRowSelect = True
Dim prefix = "2020-"
' Extract items from Listview
Dim items = New List(Of String)()
For Each item In ListView1.Items
items.Add(item)
Next
Dim words = items.ToArray()
Dim searchWord = TextBox1.Text
Dim resultWord = Closest(searchWord, words)
'this one is changed since all items starts with "2020-"& UCASE TEXT
Dim checkInt As Integer = FindItem(ListView1, prefix & resultWord)
If checkInt <> -1 Then
ListView1.Items(checkInt).Selected = True
ListView1.Focus()
Else
Label1.Text = "Search string not found"
End If
End Sub