Receiving processes through TCPClient with VB.NET - vb.net

I have been attempting a TCP client/server program and have been playing around with GetProcesses. I am able to get the full list of processes on the client side, however it only lists one process per call.
I added a log to see what was happening and I actually am getting all the data. Maybe my issue is when I split up the data on the client side..
If you are familiar with TCPClient, or just know where I am going wrong, id greatly appreciate your input as I have only been writing in VB for a few months now and I feel quite annoyed. lol
Thanks
Id post the image here but I need more reputation.. Here is the link
https://i.ibb.co/7rS8bRY/listproc-issue.png
Client code:
Dim ns As NetworkStream = clientOne.GetStream()
Dim gs(clientOne.ReceiveBufferSize) As Byte
ns.Read(gs, 0, CInt(clientOne.ReceiveBufferSize))
Dim rs As String = Encoding.ASCII.GetString(gs)
Dim id() As String = Split(rs, "*", -1, CompareMethod.Text)
Dim tri As String = id(1)
If id(0) = 14 Then
Try
Dim idsa As Integer = tri.IndexOf("#")
Dim fdsa As String = tri.Substring(idsa + 1, tri.IndexOf("&", idsa + 1) - idsa - 1)
Dim idsb As Integer = tri.IndexOf("%")
Dim fdsb As String = tri.Substring(idsb + 1, tri.IndexOf("#", idsb + 1) - idsb - 1)
Dim idsc As Integer = tri.IndexOf("!")
Dim fdsc As String = tri.Substring(idsc + 1, tri.IndexOf("$", idsc + 1) - idsc - 1)
LVProc.Items.Add(New ListViewItem({fdsa, fdsb, fdsc}))
TextBox1.Text = TextBox1.Text + vbNewLine + "Process added to list" + vbNewLine
LVProc.Refresh()
Catch
End Try
End If
If id(0) = 13 Then
TextBox1.Text = TextBox1.Text + vbNewLine + "Unable to list Process" + vbNewLine
End If
Server code:
If id(0) = 10 Then
Try
For Each findp As Process In Process.GetProcesses()
If findp.MainWindowTitle = "" Then
Else
Dim msgRespa As String = "14*" + "#" + findp.Id.ToString + "&%" + findp.ProcessName + "#!" + findp.MainWindowTitle + "$"
Dim msgSenda As [Byte]() = System.Text.Encoding.ASCII.GetBytes(msgRespa)
ns.Write(msgSenda, 0, msgSenda.Length)
End If
Next findp
Catch
Dim msgResp As String = "13*"
Dim msgSend As [Byte]() = System.Text.Encoding.ASCII.GetBytes(msgResp)
ns.Write(msgSend, 0, msgSend.Length)
End Try
End If

Related

I want to make a maths quiz on vb.net that uses bracket questions

So I've used visual basics (vb.net) for a bit now and understand some stuff. Right now I want to make a maths quiz that when I click a button it takes me to a new form and starts the quiz. When the quiz starts I want it so it gives the user random numbers and the user needs to answer it in a textbox and if correct it moves on to the next question (Basic, I should be able to do). IMPORTANT - my question is, there's a maths rule called BODMAS (Bracket.Order.Division.Multiply.Add.Subtract) and I want to add this rule into my coding instead of doing regular simple maths...
EXAMPLE question is 2 x (2+3) - 1 = ?
2 x 5 - 1 = ?
10 - 1 = ?
9 = 9
person writes answer to textbox and moves to next similar question
This is my first time using this but I wanted to write in-depth so people can understand. Please help me if you find a video explaining what I'm looking for or if someone has a file with a similar code I could download would be greatly appreciated!
Basically,you need to determine the range of numbers you use, and then match them randomly among '*', '/', '+', '-'. Then randomly insert brackets into it.
Private codeStr As String
Private Function GenerateMathsQuiz() As String
Dim r As Random = New Random()
Dim builder As StringBuilder = New StringBuilder()
'The maximum number of operations is five, and you can increase the number [5] to increase the difficulty
Dim numOfOperand As Integer = r.[Next](1, 5)
Dim numofBrackets As Integer = r.[Next](0, 2)
Dim randomNumber As Integer
For i As Integer = 0 To numOfOperand - 1
'All numbers will be random between 1 and 10
randomNumber = r.[Next](1, 10)
builder.Append(randomNumber)
Dim randomOperand As Integer = r.[Next](1, 4)
Dim operand As String = Nothing
Select Case randomOperand
Case 1
operand = "+"
Case 2
operand = "-"
Case 3
operand = "*"
Case 4
operand = "/"
End Select
builder.Append(operand)
Next
randomNumber = r.[Next](1, 10)
builder.Append(randomNumber)
If numofBrackets = 1 Then
codeStr = InsertBrackets(builder.ToString())
Else
codeStr = builder.ToString()
End If
Return codeStr
End Function
Public Function InsertBrackets(ByVal source As String) As String
Dim rx As Regex = New Regex("\d+", RegexOptions.Compiled Or RegexOptions.IgnoreCase)
Dim matches As MatchCollection = rx.Matches(source)
Dim count As Integer = matches.Count
Dim r As Random = New Random()
Dim numIndexFirst As Integer = r.[Next](0, count - 2)
Dim numIndexLast As Integer = r.[Next](1, count - 1)
While numIndexFirst >= numIndexLast
numIndexLast = r.[Next](1, count - 1)
End While
Dim result As String = source.Insert(matches(numIndexFirst).Index, "(")
result = result.Insert(matches(numIndexLast).Index + matches(numIndexLast).Length + 1, ")")
Return result
End Function
When you finish this, you will get a math quiz, then you need to know how to compile and run code at runtime.
Private Function GetResult(ByVal str As String) As String
Dim sb As StringBuilder = New StringBuilder("")
sb.Append("Namespace calculator" & vbCrLf)
sb.Append("Class calculate " & vbCrLf)
sb.Append("Public Function Main() As Integer " & vbCrLf)
sb.Append("Return " & str & vbCrLf)
sb.Append("End Function " & vbCrLf)
sb.Append("End Class " & vbCrLf)
sb.Append("End Namespace" & vbCrLf)
Dim CompilerParams As CompilerParameters = New CompilerParameters()
CompilerParams.GenerateInMemory = True
CompilerParams.TreatWarningsAsErrors = False
CompilerParams.GenerateExecutable = False
CompilerParams.CompilerOptions = "/optimize"
Dim references As String() = {"System.dll"}
CompilerParams.ReferencedAssemblies.AddRange(references)
Dim provider As VBCodeProvider = New VBCodeProvider()
Dim compile As CompilerResults = provider.CompileAssemblyFromSource(CompilerParams, sb.ToString())
If compile.Errors.HasErrors Then
Dim text As String = "Compile error: "
For Each ce As CompilerError In compile.Errors
text += "rn" & ce.ToString()
Next
Throw New Exception(text)
End If
Dim Instance = compile.CompiledAssembly.CreateInstance("calculator.calculate")
Dim type = Instance.GetType
Dim methodInfo = type.GetMethod("Main")
Return methodInfo.Invoke(Instance, Nothing).ToString()
End Function
Finally, you can use these methods like:
Private Sub GetMathQuizBtn_Click(sender As Object, e As EventArgs) Handles GetMathQuizBtn.Click
Label1.Text = GenerateMathsQuiz()
End Sub
Private Sub ResultBtn_Click(sender As Object, e As EventArgs) Handles ResultBtn.Click
If TextBox1.Text = GetResult(Label1.Text) Then
MessageBox.Show("bingo!")
TextBox1.Text = ""
Label1.Text = GenerateMathsQuiz()
Else
MessageBox.Show("result is wrong")
End If
End Sub
Result:

Check if an item is available in a JSON.NET Newtonsoft object

I have the line of code that I want which is:
mid= jToken.Value<double?>("mid") ?? 100;
in C# but I need it in VB.NET I got it from Get value from JToken that may not exist (best practices)
But I'm have a bit of trouble in converting that to the proper syntax in VB. I've tried
Dim mid As String = item.Value(Of String)("mid") ?? ""
But it does not like the?
What I would like is to end with an empty string or blank if the value is not in the object. This is my full code
Dim obj As JObject = JObject.Parse(respHTML)
Dim records As JArray = DirectCast(obj("records"), JArray)
For i As Integer = 0 To records.Count - 1
Dim item As JObject = DirectCast(records(i), JObject)
Dim pmid As Integer = item("pmid").Value(Of Integer)
Dim pmcid As String = item("pmcid").Value(Of String)
Dim doi As String = item("doi").Value(Of String)
' Dim mid As String = item("mid").Value(Of String)
Dim mid As String = item.Value(Of String)("mid") ?? ""
MessageBox.Show(pmid.ToString + " " + pmcid + " " + doi + " " + mid)
Next
I ended up with:
Dim obj As JObject = JObject.Parse(respHTML)
Dim records As JArray = DirectCast(obj("records"), JArray)
For i As Integer = 0 To records.Count - 1
Dim item As JObject = DirectCast(records(i), JObject)
Dim pmid As String = If(item.Value(Of String)("pmid"), "")
Dim pmcid As String = If(item.Value(Of String)("pmcid"), "")
Dim doi As String = If(item.Value(Of String)("doi"), "")
Dim mid As String = If(item.Value(Of String)("mid"), "")
MessageBox.Show(pmid.ToString + " " + pmcid + " " + doi + " " + mid)
Next
The message box line will be replaced with a database call

Using MailMessage with semi cologn seperation

If I manually put my address in for EmailMessage.To.Add(GetDelimitedField(x, strEmailRep, ";")) It sends me the message just fine. However If I use the code as is below which is using a list that looks like ;email1#mail.com;email2.mail.com
Then it gives an error that email address cannot be blank
Somewhere in GetDelimitedField is erasing addresses. I'm not sure where the problem is actually occurring. Here is all the code involved with this.
strmsg = "LOW STOCK ALERT: Component (" & rsMPCS("MTI_PART_NO") & ") has reached or fallen below it's minimum quantity(" & rsMPCS("MIN_QTY") & ")."
Dim EmailMessage As MailMessage = New MailMessage
EmailMessage.From = New MailAddress("noreply#mail.com")
For x = 1 To GetCommaCount(strEmailRep) + 1
EmailMessage.To.Add(GetDelimitedField(x, strEmailRep, ";"))
Next
EmailMessage.Subject = ("LOW STOCK ALERT!")
EmailMessage.Body = strmsg
EmailMessage.Priority = MailPriority.High
EmailMessage.IsBodyHtml = True
Dim smtp As New SmtpClient("smtp.mycompany.com")
smtp.UseDefaultCredentials = True
smtp.Send(EmailMessage)
Public Function GetCommaCount(ByVal sText As String)
Dim X As Integer
Dim Count As Integer
Dim Look As String
For X = 1 To Len(sText)
Look = Microsoft.VisualBasic.Left(sText, X)
If InStr(X, Look, ";", 1) > 0 Then
Count = Count + 1
End If
Next
GetCommaCount = Count
End Function
Public Function GetDelimitedField(ByRef FieldNum As Short, ByRef DelimitedString As String, ByRef Delimiter As String) As String
Dim NewPos As Short
Dim FieldCounter As Short
Dim FieldData As String
Dim RightLength As Short
Dim NextDelimiter As Short
If (DelimitedString = "") Or (Delimiter = "") Or (FieldNum = 0) Then
GetDelimitedField = ""
Exit Function
End If
NewPos = 1
FieldCounter = 1
While (FieldCounter < FieldNum) And (NewPos <> 0)
NewPos = InStr(NewPos, DelimitedString, Delimiter, CompareMethod.Text)
If NewPos <> 0 Then
FieldCounter = FieldCounter + 1
NewPos = NewPos + 1
End If
End While
RightLength = Len(DelimitedString) - NewPos + 1
FieldData = Microsoft.VisualBasic.Right(DelimitedString, RightLength)
NextDelimiter = InStr(1, FieldData, Delimiter, CompareMethod.Text)
If NextDelimiter <> 0 Then
FieldData = Microsoft.VisualBasic.Left(FieldData, NextDelimiter - 1)
End If
GetDelimitedField = FieldData
End Function
You can split the list easier using string.Split:
Dim strEmails = "a#test.com;b#test.com;c#test.com;"
Dim lstEmails = strEmails.Split(";").ToList()
'In case the last one had a semicolon:
If (lstEmails(lstEmails.Count - 1).Trim() = String.Empty) Then
lstEmails.RemoveAt(lstEmails.Count - 1)
End If
If (lstEmails.Count > 0) Then
lstEmails.AddRange(lstEmails)
End If

Copying same file to multiple locations / drives with progress bar

I am trying to make a vb.net appliaction designed to copy one file to multiple locations at the same time. But I can't figure out how to stop the System.IO.IOException I am receiving because multiple threads are trying to access the file. Here is my current code:
Dim parts As String() = targ.Split(New Char() {"\"c})
Dim filename As String = parts(parts.Count - 1) 'target folder name
Dim dir_path As String = "" 'directory without target folder name
Dim FolderList As New List(Of String)
Dim copied As Integer = 0<
For f As Integer = 0 To parts.Count - 2
dir_path += parts(f) + "\"
Next
Dim counter As Integer = IO.Directory.GetFiles(targ, "*.*", IO.SearchOption.AllDirectories).Length 'counts the number of files
newitm.SubItems(4).Text = "Copied (0/" + counter.ToString + ")" 'displays the amount of copied files
FolderList.Add(targ) 'Set first folder
Do While True
Dim FoldersInsideDirectory As New List(Of String)
If FolderList.Count = 0 Then
Exit Do 'If there is no folder to copy Exit Do
Else
For l As Integer = 0 To FolderList.Count - 1
Dim fileSystemInfo As System.IO.FileSystemInfo
Dim sourceDirectoryInfo As New System.IO.DirectoryInfo(FolderList(l))
Dim dest As String = FolderList(l).Replace(dir_path, "")
If (Not System.IO.Directory.Exists(des + "\" + dest)) Then 'create subFolder inside directory
System.IO.Directory.CreateDirectory(des + "\" + dest)
End If
For Each fileSystemInfo In sourceDirectoryInfo.GetFileSystemInfos
Dim destinationFileName As String = System.IO.Path.Combine(des + "\" + dest, fileSystemInfo.Name)
If TypeOf fileSystemInfo Is System.IO.FileInfo Then
Dim streamRead As New System.IO.FileStream(fileSystemInfo.FullName, System.IO.FileMode.Open)
Dim streamWrite As New System.IO.FileStream(des + "\" + dest + "\" + fileSystemInfo.Name, IO.FileMode.Create, IO.FileAccess.Write, IO.FileShare.None)
Dim lngLen As Long = streamRead.Length - 1
newitm.SubItems(3).Text = "Copy bytes : (0/" + (lngLen * 100).ToString + ")"
Dim byteBuffer(1048576) As Byte 'our stream buffer
Dim intBytesRead As Integer 'number of bytes read
While streamRead.Position < lngLen 'keep streaming until EOF
newitm.SubItems(3).Text = "Copy bytes : (" + CInt(streamRead.Position).ToString + "/" + (lngLen * 100).ToString + ")"
intBytesRead = (streamRead.Read(byteBuffer, 0, 1048576))
streamWrite.Write(byteBuffer, 0, intBytesRead)
streamRead.Flush()
End While
'Clean up
streamWrite.Flush()
streamWrite.Close()
streamRead.Close()
copied += 1
newitm.SubItems(4).Text = "Copied (" + copied.ToString + "/" + counter.ToString + ")"
Else
FoldersInsideDirectory.Add(fileSystemInfo.FullName)
End If
Next
Next
FolderList.Clear()
FolderList = FoldersInsideDirectory
End If
MsgBox("Done")
Loop
You need to specify FileShare.Read in the FileStream's constructor:
Read
Allows subsequent opening of the file for reading. If this flag is not specified, any request to open the file for reading (by this process or another process) will fail until the file is closed.
Dim streamRead As New System.IO.FileStream(fileSystemInfo.FullName, System.IO.FileMode.Open, System.IO.FileAccess.Read, System.IO.FileShare.Read)

VB.NET IP disconnector: what is the correct usage of SetTcpEntry to disconnect

I am trying to create an IP disconnector. This is part from a template that I took that creates a TCPtable. I was trying to add a disconnecting function. However, it does not disconnect.
Dim liste() = {"76.9.24.130" ... ... ...}
Dim pdwSize As Integer
Dim iRetVal As Integer
Dim i As Integer
Dim TcpTableRow As MIB_TCPROW
Dim pStructPointer As IntPtr = IntPtr.Zero
Dim iNumberOfStructures As Integer
ListView1.Items.Clear()
iRetVal = GetTcpTable(pStructPointer, pdwSize, 0)
pStructPointer = Marshal.AllocHGlobal(pdwSize)
iRetVal = GetTcpTable(pStructPointer, pdwSize, 0)
iNumberOfStructures = Math.Ceiling((pdwSize - 4) / Marshal.SizeOf(GetType(MIB_TCPROW)))
For i = 0 To iNumberOfStructures - 1
Dim pStructPointerTemp As IntPtr = New IntPtr(pStructPointer.ToInt32() + 4 + (i * Marshal.SizeOf(GetType(MIB_TCPROW))))
TcpTableRow = New MIB_TCPROW()
With TcpTableRow
.dwLocalAddr = 0
.dwState = 0
.dwLocalPort = 0
.dwRemoteAddr = 0
.dwRemotePort = 0
End With
'Marshal.PtrToStructure(pStructPointerTemp, TcpTableRow)
TcpTableRow = CType(Marshal.PtrToStructure(pStructPointerTemp, GetType(MIB_TCPROW)), MIB_TCPROW)
' Process each MIB_TCPROW here
'If Not ((Check1.CheckState = System.Windows.Forms.CheckState.Checked) And (GetIpFromLong(TcpTableRow.dwLocalAddr) = "0.0.0.0" Or GetIpFromLong(TcpTableRow.dwLocalAddr) = "127.0.0.1")) Then
If Not GetIpFromLong(TcpTableRow.dwRemoteAddr) = "127.0.0.1" And Not GetIpFromLong(TcpTableRow.dwRemoteAddr) = "0.0.0.0" Then
'Add the data to the ListView control
With TcpTableRow
Dim itemAdd As ListViewItem
itemAdd = ListView1.Items.Add(GetIpFromLong(.dwLocalAddr))
itemAdd.SubItems.Add(CStr(GetTcpPortNumber(.dwLocalPort)))
itemAdd.SubItems.Add(GetIpFromLong(.dwRemoteAddr))
itemAdd.SubItems.Add(CStr(GetTcpPortNumber(.dwRemotePort)))
itemAdd.SubItems.Add(GetState(.dwState))
End With
'-------------- Kill Connection--------------
If Array.IndexOf(liste, GetIpFromLong(TcpTableRow.dwRemoteAddr)) >= 0 Then
TcpTableRow.dwState = 12
SetTcpEntry(TcpTableRow)
End If
End If
Next
I could not solve it but found an alternative solution using CurrPorts
Shell(Application.StartupPath & "\cports /close * * " & GetIpFromLong(TcpTableRow.dwRemoteAddr) & " " & GetTcpPortNumber(TcpTableRow.dwRemotePort))
I am not sure if this is the same situation or not but I was using:
session = New Socket(,,,) as my means of connecting via TCP PORT23 and my issue was that I too could not get the connection to close for some reason. I did try the CurrPorts workaround above but I found that did not meet my expectations. Instead I am using TCPClient.
Dim TCPConnection as TCPClient 'Init TCPConnect
Private Sub Connect(Byval inIP)
Dim PiP = IPAddress.Parse(inIP)
Dim iplocal As New System.Net.IPEndPoint(PiP, 23)
Try
TCPsession = New TcpClient
TCPsession.Client.Connect(ipLocal)
Catch
'On Error Do Nothing
End Try
End Sub
Private Sub Disconnect()
TCPsession.Client.Close()
End Sub
This code solved my issue but I am not sure if thats what you where even talking about.