Formatting 45.22.30 in VB.NET [duplicate] - vb.net

Under keypress event, I have a function validating the entered characters, this is my code.
Public Function vNum2(val As Object)
Dim result As Boolean = False
Dim allowedChars As String = "0123456789." & vbBack
Try
If allowedChars.IndexOf(val) = -1 Then
result = True
End If
Catch ex As Exception
MsgBox("Error 1010xVNum2: " & ex.Message)
End Try
Return result
End Function
How do i validate a decimal when I entered more than 2 dots in decimal? When I press another dot, the textbox will not receive the character.
E.g: -> correct entry 45.23 receive the first dot.
-> validating entry 45.2.3 will not receive the next dot.

Try this :
Public Function vNum2(val As Object)
Dim result As Boolean = False
Try
'Dim allowedChars As String = "42.2.3"
Dim allowedChars As String = val.ToString()
'Bellow line will count how many dots are in string, if there one or none, result will be True
If allowedChars.Where(Function(dots) dots = ".").Count < 2 Then result = True
Catch ex As Exception
MsgBox("Error 1010xVNum2: " & ex.Message)
End Try
Return result
End Function

Related

Function start doesn't return a value on all code paths. A null reference exception could occur at run time when the result is used

can you help its say's (Function 'Start' doesn't return a value on all code paths. A null reference exception could occur at run time when the result is used.)
Private Function Start() As Object
Dim thr As Integer = TextBox4.Text
Dim Threading As Integer = Nothing
If CheckBox1.Checked = True Then
Threading = thr + 300
Else
Threading = thr
End If
While Not stopp
Try
Try
Dim i As String = Geting("https://i.instagram.com/api/v1/users/search?q=" & TextBox5.Text & "&access_token=" & Guid.NewGuid.ToString.ToUpper & "/")
If i.Contains("""username"": """ & TextBox5.Text & """") Or Nothing Then
intt += 1
Me.Invoke(Sub() TextBox3.Text = intt)
Else
If ChangeUserName(TextBox5.Text) Then
Me.Invoke(Sub() Label1.Text = "username claimed " & TextBox5.Text)
stopp = True
End If
End If
Catch ex2 As Exception
End Try
Thread.Sleep(Threading)
Catch ex As Exception
End Try
End While
End Function
You probably don't need to return a value from your function. Change
Private Function Start() As Object
into
Private Sub Start()
As a side note, your error handling is bad.
Try
(Do something)
Catch Exception
End Try
should never be used. It prevents you from seeing when something goes wrong (even if your code has a flaw).

Speed up search file using Multithreading or Parallel.ForEach

I wrote a code to search for files and folders and (to check all possible combinations of inserted words) I have a sub that gives all permutations of the inserted strings.
My problem is that I'm repeating the code for every permutated string (for 4 words it means 24 times) and I'm trying to use MultiThreading to speed up the code.
I've read a lot of examples but I wasn't able to really understand the logic for many reasons (some examples were in C; any example was wrote with different logic)
I've tried with
Parallel.For
Parallel.ForEach
ThreadPool
but I wasn't able to wait all threads before setting the List (containig all results) as datasource of a listbox.
My code logic is:
Get words by splitting the search string
If search type is "all words in any order" then I get all permutations
I start searching for each of permutated strings
I don't like to add too much code to a question but I think it's necessary in this case to know how I'm working:
Private Sub Btn_Search_Click(sender As Object, e As EventArgs) Handles Btn_Search.Click
Select Case True
Case RBtn_Exact.Checked
StartSearch(Me.TB_Pattern.Text.Trim)
Case RBtn_AllInOrder.Checked
Dim Pattern As String = ""
For Each Word As String In Me.TB_Pattern.Text.Split(New Char() {" "c})
If Word.Trim <> "" Then Pattern &= "*" & Word.Trim
Next
Pattern &= "*"
StartSearch(Pattern)
endsearch()
Case RBtn_AllWithoutOrder.Checked
Dim WordHash As New HashSet(Of String)
For Each Word As String In Split(Me.TB_Pattern.Text, " ")
If Word.Trim <> "" Then WordHash.Add(Word.Trim)
Next
If WordHash.Count > 5 Then
MessageBox.Show("Max 5 words allowed for this kind of search", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
End If
'Get permutations into an array
StringPermutations()
'I need to add "*" at the end of each permutated string
For S As Integer = 0 To PermutationsArr.Length - 1
PermutationsArr(S) &= "*"
Next
'This is for searching without MultiThreading
For Each Pattern As String In PermutationsArr
StartSearch(Pattern)
Next
'This is my last test
'Parallel.ForEach(PermutationsArr,
' Sub(Pattern)
' StartSearch(Pattern)
' End Sub
' )
'Task.WaitAll()
endsearch()
Case RBtn_AnyWord.Checked
Dim WordHash As New HashSet(Of String)
For Each Word As String In Split(Me.TB_Pattern.Text, " ")
If Word.Trim <> "" Then WordHash.Add(Word.Trim)
Next
If WordHash.Count > 5 Then
MessageBox.Show("Max 5 words allowed for this kind of search", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
End If
For Each Word As String In WordHash
StartSearch(pattern:="*" & Word & "*")
Next
endsearch()
End Select
End Sub
Private Sub StartSearch(ByVal pattern As String)
'Search for files
If Me.CBox_Files.Checked Then
FileSearch(Me.TB_StartFolder.Text, pattern)
End If
'Search for folders
If Me.CBox_Folders.Checked Then
ProcessDir(Me.TB_StartFolder.Text, pattern)
DirSearch(Me.TB_StartFolder.Text, pattern)
End If
End Sub
Sub endsearch()
Me.Btn_Search.Text = "Start"
Me.Btn_Search.BackColor = Me.BackColor
If Me.LB_Files.Items.Count > 0 Then
Me.Lbl_FilesFound.Text = Me.LB_Files.Items.Count.ToString
Me.Lbl_FilesFound.Visible = True
End If
If Me.LB_Folders.Items.Count > 0 Then
Me.Lbl_DirFound.Text = Me.LB_Folders.Items.Count.ToString
Me.Lbl_DirFound.Visible = True
End If
End Sub
Sub DirSearch(ByVal sDir As String, ByVal Pattern As String)
Try
For Each Dir As String In Directory.GetDirectories(sDir)
Try
For Each D As String In Directory.GetDirectories(Dir, Pattern)
Try
If LimitReached(LB_Folders) Then
Me.Lbl_LimitReached.Visible = True
Exit Sub
Else
If Me.CBox_Folders.Checked AndAlso Not LB_Folders.Items.Contains(D) Then LB_Folders.Items.Add(D)
End If
Catch ex As Exception
Continue For
End Try
Next
DirSearch(Dir, Pattern)
Catch ex As Exception
Continue For
End Try
Next
Catch ex As Exception
End Try
End Sub
Sub FileSearch(ByVal sDir As String, ByVal Pattern As String)
Dim d As String = ""
Try
For Each f As String In Directory.GetFiles(sDir, Pattern)
Try
If LimitReached(LB_Files) Then
Me.Lbl_LimitReached.Visible = True
Exit Sub
Else
If Me.CBox_LastModRange.Checked Then
If Me.CBox_Files.Checked AndAlso IntoRangeDate(f) AndAlso Not LB_Files.Items.Contains(f) Then LB_Files.Items.Add(f)
Else
If Me.CBox_Files.Checked AndAlso Not LB_Files.Items.Contains(f) Then LB_Files.Items.Add(f)
End If
End If
Catch ex As Exception
Continue For
End Try
Next
'Search for subfolders
For Each d In Directory.GetDirectories(sDir)
Try
ProcessDir(d, Pattern)
Catch ex As Exception
End Try
Try
FileSearch(d, Pattern)
Catch ex As Exception
End Try
Next
Catch excpt As System.Exception
End Try
End Sub
Private Sub ProcessDir(d As String, ByVal Pattern As String)
Try
For Each f As String In Directory.GetFiles(d, Pattern)
Try
If LimitReached(LB_Files) Then
Me.Lbl_LimitReached.Visible = True
Exit Sub
Else
If Me.CBox_LastModRange.Checked Then
If Me.CBox_Files.Checked AndAlso IntoRangeDate(f) AndAlso Not LB_Files.Items.Contains(f) Then LB_Files.Items.Add(f)
Else
If Me.CBox_Files.Checked AndAlso Not LB_Files.Items.Contains(f) Then LB_Files.Items.Add(f)
End If
End If
Catch ex As Exception
Continue For
End Try
Next
Catch ex As System.Exception
End Try
Try
For Each d In Directory.GetDirectories(d, Pattern)
Try
If Me.CBox_Folders.Checked AndAlso Not LB_Folders.Items.Contains(d) Then LB_Folders.Items.Add(d)
Catch ex As Exception
Continue For
End Try
Next
Catch ex As Exception
End Try
End Sub
EDIT
Below my code for getting permutations (I know it has a particular logic but it works and it seems enough fast):
Private Sub StringPermutations()
Try
Dim WordHash As New HashSet(Of String)
For Each Word As String In Split(Me.TB_Pattern.Text, " ")
If Word.Trim <> "" Then WordHash.Add(Word.Trim)
Next
Dim WordList As List(Of String) = WordHash.ToList
ReDim PermutationsArr(Factorial(WordList.Count) - 1)
AddString(WordList, 0)
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub
Private Function Factorial(ByVal Num As Integer) As Integer
Try
If Num > 0 AndAlso Num < 12 Then
Dim Result As Int32 = 1
Do
Result *= Num
Num -= 1
Loop Until Num <= 1
Return Result
Else
Return 0
End If
Catch ex As Exception
Return Nothing
End Try
End Function
Private Sub AddString(ByVal WordList As List(Of String), ByVal StartId As Integer)
Try
Dim InsLoop As Integer = Factorial(WordList.Count - 1)
If InsLoop = 0 Then InsLoop = 1
For Each Word As String In WordList
For InsWord As Integer = 1 To InsLoop
PermutationsArr(StartId + InsWord - 1) &= "*" & Word
Next
If WordList.Count > 1 Then
Dim Remaining As New List(Of String)
For Each RemWord As String In WordList
If RemWord <> Word Then Remaining.Add(RemWord)
Next
AddString(Remaining, StartId)
End If
StartId += InsLoop
Next
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub
Here's my Form class, based on yours but substantially simplified. I used Tasks for multithreading, ConcurrentDictionarys to capture the results with capacity limits, concurrency levels, and without duplicates, and populate the Listboxes in one call at the end to minimize UI updates and the associated slowness. Concurrency level is the number of tasks that will be spawned to feed the ConcurrentDictionary.
Imports System.Text.RegularExpressions
Public Class SearchForm
Private FoldersList As Concurrent.ConcurrentDictionary(Of String, Object)
Private FilesList As Concurrent.ConcurrentDictionary(Of String, Object)
Private Tasks As New List(Of Task)
Private Words As New List(Of String)
Private StopWatch As New Stopwatch
' Capacity of the ConcurrentDictionary objects
' Set this from user input on form to limit # of results returned
Private Capacity As Int32 = 0
Private PermutationsArr() As String = Nothing
Private Sub Btn_Search_Click(sender As Object, e As EventArgs) Handles Btn_Search.Click
Btn_Search.Text = "Wait"
' Capacity of the ConcurrentDictionary objects
' Set this from user input on form to limit # of results returned
Capacity = 10000
Tasks.Clear()
Words.Clear()
LB_Folders.DataSource = Nothing
LB_Files.DataSource = Nothing
Me.Refresh()
StopWatch.Restart()
Words.AddRange(Regex.Split(Regex.Replace(Me.TB_Pattern.Text.Trim, "\*", String.Empty), "\s+"))
Select Case True
Case String.IsNullOrWhiteSpace(Me.TB_Pattern.Text.Trim)
MsgBox("Too few words", vbOKOnly, "Oops")
Case Words.Count < 1
MsgBox("Too few words", vbOKOnly, "Oops")
Case Words.Count > 5
MsgBox("Too many words", vbOKOnly, "Oops")
Case Me.CBox_LastModRange.Checked AndAlso Me.DT_ModRangeEnd.Value < Me.DT_ModRangeStart.Value
MsgBox("Range Start must precede Range End", vbOKOnly, "Oops")
Case Me.RBtn_Exact.Checked
FoldersList = New Concurrent.ConcurrentDictionary(Of String, Object)(1, Capacity)
FilesList = New Concurrent.ConcurrentDictionary(Of String, Object)(1, Capacity)
With Join(Words.ToArray)
If Me.CBox_Folders.Checked Then
' NOTE: SearchFolders will evaluate CBox_Files.Checked and do SearchFiles if True
SearchFolders(Me.TB_StartFolder.Text, .ToString, True)
Else
' NOTE: Only call SearchFiles from here if NOT doing SearchFolders
If Me.CBox_Files.Checked Then
SearchFiles(Me.TB_StartFolder.Text, .ToString, True, True)
End If
End If
End With
Case Me.RBtn_AllInOrder.Checked
FoldersList = New Concurrent.ConcurrentDictionary(Of String, Object)(1, Capacity)
FilesList = New Concurrent.ConcurrentDictionary(Of String, Object)(1, Capacity)
With String.Format("*{0}*", Join(Words.ToArray, "*"))
If Me.CBox_Folders.Checked Then
' NOTE: SearchFolders will evaluate CBox_Files.Checked and do SearchFiles if True
SearchFolders(Me.TB_StartFolder.Text, .ToString, True)
Else
' NOTE: Only call SearchFiles from here if NOT doing SearchFolders
If Me.CBox_Files.Checked Then SearchFiles(Me.TB_StartFolder.Text, .ToString, True, True)
End If
End With
Case Me.RBtn_AllWithoutOrder.Checked
StringPermutations()
' Math.Min caps the concurrency level at 40
FoldersList = New Concurrent.ConcurrentDictionary(Of String, Object)(Math.Min(40, PermutationsArr.Count), Capacity)
FilesList = New Concurrent.ConcurrentDictionary(Of String, Object)(Math.Min(40, PermutationsArr.Count), Capacity)
For Each Pattern As String In PermutationsArr
If Me.CBox_Folders.Checked Then
' NOTE: SearchFolders will evaluate CBox_Files.Checked and do SearchFiles if True
SearchFolders(Me.TB_StartFolder.Text, Pattern, True)
'Tasks.Add(Task.Run(Sub() SearchFolders(Me.TB_StartFolder.Text, Pattern)))
Else
' NOTE: Only call SearchFiles from here if NOT doing SearchFolders
If Me.CBox_Files.Checked Then SearchFiles(Me.TB_StartFolder.Text, Pattern, True, True)
End If
Next
Case Me.RBtn_AnyWord.Checked
FoldersList = New Concurrent.ConcurrentDictionary(Of String, Object)(Words.Count, Capacity)
FilesList = New Concurrent.ConcurrentDictionary(Of String, Object)(Words.Count, Capacity)
For Each Word In Words
With String.Format("*{0}*", Word)
If Me.CBox_Folders.Checked Then
' NOTE: SearchFolders will evaluate CBox_Files.Checked and do SearchFiles if True
SearchFolders(Me.TB_StartFolder.Text, .ToString, True)
Else
' NOTE: Only call SearchFiles from here if NOT doing SearchFolders
If Me.CBox_Files.Checked Then SearchFiles(Me.TB_StartFolder.Text, .ToString, True, True)
End If
End With
Next
End Select
Task.WaitAll(Tasks.ToArray)
Debug.Print("Tasks Completed in {0}", StopWatch.Elapsed.ToString)
Debug.Print("Adding {0} Folders", FoldersList.Keys.Count.ToString)
Me.LB_Folders.DataSource = FoldersList.Keys
Debug.Print("Adding {0} Files", FilesList.Keys.Count.ToString)
Me.LB_Files.DataSource = FilesList.Keys
Btn_Search.Text = "Search"
End Sub
Private Sub SearchFolders(FolderPath As String, Pattern As String, Optional FirstCall As Boolean = False)
Try
Dim Folders() As String = IO.Directory.GetDirectories(FolderPath)
For Each Folder As String In Folders
Dim SubFolders() As String = IO.Directory.GetDirectories(Folder, Pattern)
For Each SubFolder As String In SubFolders
Select Case True
Case Not FilesList.Count < Capacity
Exit For
Case Not Me.CBox_LastModRange.Checked
FoldersList.TryAdd(SubFolder, Nothing)
Case FolderInModRange(Folder)
FoldersList.TryAdd(SubFolder, Nothing)
End Select
Next
If Me.CBox_Files.Checked Then
' Do NOT call this with Recursive = True from here!
SearchFiles(Folder, Pattern)
End If
If FirstCall Then
' Perform multithreaded Recursion
Tasks.Add(Task.Run(Sub() SearchFolders(Folder, Pattern)))
Else
' Perform deep recursion within task thread...don't branch further
SearchFolders(Folder, Pattern)
End If
Next
Catch ex As UnauthorizedAccessException
' Access Denied
Catch ex As Exception
Debug.Print("SearchFiles: {0}", ex.ToString)
End Try
End Sub
Private Sub SearchFiles(FolderPath As String, Pattern As String, Optional Recursive As Boolean = False, Optional FirstCall As Boolean = False)
' Recursive and FirstCall should only be True if NOT doing SearchFolders
' Recursive should only be True if called from the main thread or this method to continue the deep dive
' FirstCall should only be True if called from the main thread
Try
For Each Filename As String In IO.Directory.GetFiles(FolderPath, Pattern)
Select Case True
Case Not FilesList.Count < Capacity
Exit For
Case Not Me.CBox_LastModRange.Checked
FilesList.TryAdd(Filename, Nothing)
Case FileInModRange(Filename)
FilesList.TryAdd(Filename, Nothing)
End Select
Next
If Recursive Then
Try
Dim Folders() As String = IO.Directory.GetDirectories(FolderPath)
For Each Folder As String In Folders
If FirstCall Then
' Perform multithreaded Recursion
Tasks.Add(Task.Run(Sub() SearchFiles(Folder, Pattern, Recursive)))
Else
' Perform deep recursion within task thread...don't branch further
SearchFiles(Folder, Pattern, Recursive)
End If
Next
Catch ex As Exception
' Access Denied - Does this happen?
Debug.Print("Recursive FolderPath: {0}", ex.Message)
End Try
End If
Catch ex As UnauthorizedAccessException
' Access Denied
Catch ex As Exception
Debug.Print("SearchFiles: {0}", ex.ToString)
End Try
End Sub
Private Function FolderInModRange(Folder As String) As Boolean
Try
With New IO.DirectoryInfo(Folder)
Select Case True
Case .LastWriteTime < Me.DT_ModRangeStart.Value
Return False
Case .LastWriteTime > Me.DT_ModRangeEnd.Value
Return False
Case Else
Return True
End Select
End With
Catch ex As Exception
Debug.Print("FolderInModRange: {0}{1}{2}", Folder, Environment.NewLine, ex.ToString)
End Try
' Only if exception is thrown
Return False
End Function
Private Function FileInModRange(Filename As String) As Boolean
Try
With New IO.FileInfo(Filename)
Select Case True
Case .LastWriteTime < Me.DT_ModRangeStart.Value
Return False
Case .LastWriteTime > Me.DT_ModRangeEnd.Value
Return False
Case Else
Return True
End Select
End With
Catch ex As IO.PathTooLongException
' Path Too Long
Catch ex As Exception
Debug.Print("FileInModRange: {0}{1}{2}", Filename, Environment.NewLine, ex.ToString)
End Try
' Only if exception is thrown
Return False
End Function
End Class
Recursion avoids the UnauthorizedAccessException errors generated by .Net's GetDirectories and GetFiles methods when they run into folders that the user doesn't have access rights to.
References:
Task-based Asynchronous
Programming
Concurrent
Collections

How to dispay data from q to textbox on VB.net

this is stored procedure
this is Function for SelectOne
Public Function One(Id As Integer) As Object Implements IStudents.One
Try
Return db.SP_SelectOneStudent(Id).ToArray
Catch ex As Exception
Return False
End Try
End Function
Dim q = student.One(StudentID)
Assuming you want to show every field in the variable q into a TextBox:
...
Dim StringToShow as String = ""
For Each StringToAdd as String In q
StringToShow &= StringToAdd & " "
Next
YourTextBox.Text = StringToShow
...

Delete Keyword Count VB.net

I Have Problem About this count Keyword after that appear that stuff
Here Code
Public Sub searchayumiKn()
Dim myKeyWords() As String = TChat.Text.Split(" "c)
Dim mySQLQuery As String = "SELECT AIRes FROM T_GKnowledge WHERE "
Dim KeyWordCount As Integer
For KeyWordCount = 0 To myKeyWords.Length - 1
Dim strKeyParameter As String = String.Format("#Param{0}", KeyWordCount)
Dim strWhereClause As String
If KeyWordCount = 0 Then
strWhereClause = String.Format("Keyword LIKE {0}", strKeyParameter)
Else
strWhereClause = String.Format(" OR Keyword LIKE {0}", strKeyParameter)
End If
mySQLQuery &= strWhereClause
cmdhikari.Parameters.AddWithValue(strKeyParameter, String.Format("{0}{1}{0}", "%", myKeyWords(KeyWordCount)))
Next
With cmdhikari
.CommandText = mySQLQuery
.Connection = conayumi
End With
Try
dthikari = New DataTable
dahikari.Fill(dthikari)
answers.DataBindings.Add("text", dthikari, "AIRes", True)
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Caution")
End Try
KeyWordCount = 0
TChat.Clear()
Return
End Sub
Got Error #param bla". can anyone delete this count?
i just need original of data record. Not Count every time. just not using count. so freely record
move out from for this declaration
Dim strKeyParameter As String = String.Format("#Param{0}", KeyWordCount)
Dim strWhereClause As String
it's make duplicate declaration the same parameter
hopefully could be useful
regards
Ade Nurhuda

Do something with returned value

I have written a function that tells you its function itselfs as you read it:
Public Function TestConnect()
Dim verbinding As MySqlConnection
Dim errStatus As String
verbinding = New MySqlConnection()
verbinding.ConnectionString = "server=" & vardbHost & "; port=" & vardbPort & "; uid=" & vardbUser & "; pwd=" & vardbPass & "; database=" & vardbName & ";"
Try
verbinding.Open()
verbinding.Close()
errStatus = 0
Catch myerror As MySqlException
verbinding.Dispose()
verbinding.Close()
errStatus = 1
End Try
Return errStatus
End Function
Now I call this function in my main form and I thought that if I used Try and then catch the 1 or 0 then I could do something with it. (eg. Display a form with the error message) but that does not seem to work and I could not find anything on Google that applies to my problem.
Could anybody explain to me why I am so dumb and how I could better understand how to handle a returned value?
The function will be returning your value, but you need to get that assign that returned value to a variable, and then make use of it in your Calling method, eg:
Dim errStatus As Integer
errStatus = SQLHook.TestConnect()
If errStatus = 1 Then
'Show the error form
End If
Or more briefly, just test the returned value directly:
If SQLHook.TestConnect()= 1 Then
'Show the error form
End If
You should also really sort out the variable typing in your function:
Public Function TestConnect() as Boolean
Dim errStatus As Boolean
Try
errStatus = True
Catch myerror As MySqlException
errStatus = False
End Try
Return errStatus
End Function
or even more simply, don't bother with the variable:
Public Function TestConnect() as Boolean
Try
...
Return True
Catch myerror As MySqlException
...
Return False
End Try
End Function
Not entirely sure I understand the question, but do you mean something like this?
Public Function TestConnect() As Int32
...
Dim errStatus As Int32
...
Dim returnCode as Int32 = SQLHook.TestConnect()
MessageBox.show(
If(returnCode = 1, "OK", "Error"), "AppName", MessageBoxButtons.OK,
If(returnCode = 1, MessageBoxIcon.Information, MessageBoxIcon.Error)
)