tcpclient webrelay and control analog outputs - vb.net

This is the first time that I have ever worked with networking in a program control webrelay. I was able to write my program with success... or so I thought. A couple of days ago I had a device drop off the network and my program "locked up". I know it did not truly lock up. I did some debugging and found out that what is happening is that when the tcpclient throws an exception, it just stops running any code after it. This causes my program to stop updating because of a timer that is never restarted and I con't control analog Outputs.
Public Class ControlPanelX317
Private SQL As New SQLControl
Private Sub ControlPanelX317_Load(sender As Object, e As EventArgs) Handles MyBase.Load
LoadControlsX317()
End Sub
'Dislay Conrol
'__________________________________________________________________________________________________________________________________________________________________________
Private Sub LoadControlsX317()
Dim loadqry As String = "SELECT * FROM controlsX317 WHERE controlsX317.ValueVoltageID = '" & 1 & "' "
Dim SQLCmd As New SqlCommand(loadqry, Sql.SQLCon)
If Sql.SQLCon.State = ConnectionState.Closed Then Sql.SQLCon.Open()
Dim reader As SqlDataReader = SQLCmd.ExecuteReader
While reader.Read = True
txt_S1_VolueVoltage.Text = reader("S1VolueVoltage")
txt_S2_VolueVoltage.Text = reader("S2VolueVoltage")
txt_S3_VolueVoltage.Text = reader("S3VolueVoltage")
txt_S4_VolueVoltage.Text = reader("S4VolueVoltage")
End While
SQLCmd.Dispose()
reader.Close()
Sql.SQLCon.Close()
End Sub
Private Sub btn_Save_ValueVoltage_Click(sender As Object, e As EventArgs) Handles btn_Save_ValueVoltage.Click
If txt_S1_VolueVoltage.Text > 10 Then
MsgBox("Max Voltage is 10V")
txt_S1_VolueVoltage.Clear()
Exit Sub
End If
If txt_S2_VolueVoltage.Text > 10 Then
MsgBox("Max Voltage is 10V")
txt_S2_VolueVoltage.Clear()
Exit Sub
End If
If txt_S3_VolueVoltage.Text > 10 Then
MsgBox("Max Voltage is 10V")
txt_S3_VolueVoltage.Clear()
Exit Sub
End If
If txt_S4_VolueVoltage.Text > 10 Then
MsgBox("Max Voltage is 10V")
txt_S4_VolueVoltage.Clear()
Exit Sub
End If
If txt_S1_VolueVoltage.Text <> "" Then
Dim UpdateValueVoltage As String = "UPDATE controlsX317 SET S1VolueVoltage='" & txt_S1_VolueVoltage.Text & "', S2VolueVoltage='" & txt_S2_VolueVoltage.Text & "',
S3VolueVoltage='" & txt_S3_VolueVoltage.Text & "', S4VolueVoltage='" & txt_S4_VolueVoltage.Text & "'
WHERE ValueVoltageID ='" & 1 & "' "
If SQL.DataUpdate(UpdateValueVoltage) = 0 Then
MsgBox("The Sysytem could not be found!!! ")
Else
MsgBox("VolueVoltage successfully changed")
End If
Else
MsgBox("You must restart a Sysytem")
End If
End Sub
Private Sub btn_S1_SetVoltage_Click(sender As Object, e As EventArgs) Handles btn_S1_SetVoltage.Click
lbl_S1_AnalogOutput.Text = Val(txt_S1_VolueVoltage.Text) * Val(txt_S1_ControlViltage.Text / 100) & "V"
End Sub
Private Sub btn_S2_SetVoltage_Click(sender As Object, e As EventArgs) Handles btn_S2_SetVoltage.Click
lbl_S2_AnalogOutput.Text = Val(txt_S2_VolueVoltage.Text) * Val(txt_S2_ControlViltage.Text / 100) & "V"
End Sub
Private Sub btn_S3_SetVoltage_Click(sender As Object, e As EventArgs) Handles btn_S3_SetVoltage.Click
lbl_S3_AnalogOutput.Text = Val(txt_S3_VolueVoltage.Text) * Val(txt_S3_ControlViltage.Text / 100) & "V"
End Sub
Private Sub btn_S4_SetVoltage_Click(sender As Object, e As EventArgs) Handles btn_S4_SetVoltage.Click
lbl_S4_AnalogOutput.Text = Val(txt_S4_VolueVoltage.Text) * Val(txt_S4_ControlViltage.Text / 100) & "V"
End Sub
'End Display Control
'_________________________________________________________________________________________________________________________________________________________________________
'Conection to WebRelay X317
'_________________________________________________________________________________________________________________________________________________________________________
Public Sub getWebRelayState()
Dim tcpClient As New TcpClient()
Dim port As Integer
Try
port = Convert.ToInt32(txtPort.Text)
tcpClient.Connect(txt_IPAddress.Text, port)
If tcpClient.Connected Then
'Create a network stream object
Dim netStream As NetworkStream = tcpClient.GetStream()
'If we can read and write to the stream then do so
If netStream.CanWrite And netStream.CanRead Then
'Send the on command to webrelay
Dim sendBytes As Byte() = Encoding.ASCII.GetBytes("GET /state.xml?noReply=0 HTTP/1.1" & vbCrLf & "Authorization: Basic bm9uZTp3ZWJyZWxheQ==" & vbCrLf & vbCrLf)
netStream.Write(sendBytes, 0, sendBytes.Length)
'Get the response from webrelay
Dim bytes(tcpClient.ReceiveBufferSize) As Byte
netStream.Read(bytes, 0, CInt(tcpClient.ReceiveBufferSize))
'Parse the response and update the webrelay state and input text boxes
Dim returndata As String = Encoding.ASCII.GetString(bytes)
'Parse out the relay state and input state
Dim array1 As Char() = returndata.ToCharArray()
Dim ana(4) As Integer
'Relay State found at index 66
If array1(66) = "1" Then
RelayState.Text = "ON"
Else
RelayState.Text = "OFF"
End If
'Input State found at index 94
If array1(94) = "1" Then
inputState.Text = "ON"
Else
inputState.Text = "OFF"
End If
End If
'Close the connection
tcpClient.Close()
End If
Catch ex As Exception
inputState.Text = "Error"
RelayState.Text = "Error"
'Disable the timer
TimerRelayRefresh.Enabled = False
End Try
End Sub
Private Sub sendRequest(ByVal val As String)
Dim tcpClient As New TcpClient()
Dim port As Integer
Try
'Disable the timer
TimerRelayRefresh.Enabled = False
port = Convert.ToInt32(txtPort.Text)
tcpClient.Connect(txt_IPAddress.Text, port)
If tcpClient.Connected Then
MsgBox("connection successful")
'Create a network stream object
Dim netStream As NetworkStream = tcpClient.GetStream()
'If we can read and write to the stream then do so
If netStream.CanWrite And netStream.CanRead Then
'Send the on command to webrelay
Dim sendBytes As Byte() = Encoding.ASCII.GetBytes("GET /state.xml?relayState=1 HTTP/1.1<CR><LF>" & vbCrLf & "Authorization: Basic bm9uZTp3ZWJyZWxheQ==<CR><LF><CR><LF>" & vbCrLf & vbCrLf)
netStream.Write(sendBytes, 0, sendBytes.Length)
'Get the response from webrelay
Dim bytes(tcpClient.ReceiveBufferSize) As Byte
netStream.Read(bytes, 0, CInt(tcpClient.ReceiveBufferSize))
'Parse the response and update the webrelay state and input text boxes
Dim returndata As String = Encoding.ASCII.GetString(bytes)
'Parse out the relay state and input state
Dim array1 As Char() = returndata.ToCharArray()
'Relay State found at index 66
If array1(66) = "1" Then
RelayState.Text = "ON"
Else
RelayState.Text = "OFF"
End If
'Input State found at index 94
If array1(94) = "1" Then
inputState.Text = "ON"
End If
Else
inputState.Text = "OFF"
End If
End If
'Enable the timer
TimerRelayRefresh.Enabled = True
Catch ex As Exception
inputState.Text = "Error"
RelayState.Text = "Error"
'Disable the timer
TimerRelayRefresh.Enabled = False
End Try
End Sub
Private Sub btn_ControlsX317_On_Click(sender As Object, e As EventArgs) Handles btn_ControlsX317_On.Click
sendRequest("1")
End Sub
Private Sub btn_ControlsX317_Off_Click(sender As Object, e As EventArgs) Handles btn_ControlsX317_Off.Click
sendRequest("0")
End Sub
Private Sub btn_ControlsX317_PULSE_Click(sender As Object, e As EventArgs) Handles btn_ControlsX317_PULSE.Click
sendRequest("2")
End Sub
'End Conetion
'_________________________________________________________________________________________________________________________________________________________________________
End Class

Related

Access denied during production

The code below works as intended in DEBUG with no errors. I input my search parameters, the record returns and populates all textboxes and loads the PDF file into the AxAcroPDF1 viewer.
However, after I compile and install the program I am receiving the error "Access to the path 'C:\Program Files (x86)\NAME OF PROGRAM\temp.file' is denied'
This only occurs when I search for a record and the PDF (in Binary format in the DB) to that record is supposed to load fails with the error message listed above. How can I resolve the permissions level (assuming this is the issue) to allow for the PDF to load? The area of concern presumably and more specifically is the LoadPDF() sub.
My code is as follows:
Imports System.Data.SqlClient
Public Class LoadDocs
Private DV As DataView
Private currentRow As String
Private Sub LoadDocs_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'TODO: This line of code loads data into the 'DocDataset.Documents_Table' table. You can move, or remove it, as needed.
Documents_TableTableAdapter.Fill(DocDataset.Documents_Table)
'Loads last record on to form
DocumentsTableBindingSource.Position = DocDataset.Documents_Table.Rows.Count - 1
DV = New DataView(DocDataset.Documents_Table)
'LoadPDF()
End Sub
Private Sub BtnOpenPDF_Click(sender As Object, e As EventArgs) Handles btnOpenPDF.Click
tbRecNumb.Clear()
tbFileName.Clear()
tbPetsLoadNumber.Clear()
tbBrokerLoadNumber.Clear()
tbFilePath.Clear()
Dim CurYear As String = CType(Now.Year(), String)
On Error Resume Next
OpenFileDialog1.Filter = "PDF Files(*.pdf)|*.pdf"
OpenFileDialog1.ShowDialog()
AxAcroPDF1.src = OpenFileDialog1.FileName
tbFilePath.Text = OpenFileDialog1.FileName
Dim filename As String = tbFilePath.Text.ToString
tbFileName.Text = filename.Substring(Math.Max(0, filename.Length - 18))
Dim loadnumber As String = tbFileName.Text
tbPetsLoadNumber.Text = loadnumber.Substring(7, 7)
End Sub
' Search for PETS Load Number, Broker Load Numberthen load record if found
Private Sub BtnSearchBtn_MouseEnter(sender As Object, e As EventArgs) Handles btnSearch.MouseEnter
Cursor = Cursors.Hand
btnSearch.BackgroundImage = My.Resources.ButtonDwn_Teal_Trans
End Sub
Private Sub BtnSearchBtn_MouseLeave(sender As Object, e As EventArgs) Handles btnSearch.MouseLeave
Cursor = Cursors.Default
btnSearch.BackgroundImage = My.Resources.Button_Teal_Trans
End Sub
Private Sub TbSearchInput_KeyDown(sender As Object, e As KeyEventArgs) Handles tbSearchInput.KeyDown
Cursor = Cursors.Hand
If e.KeyCode = Keys.Enter Then
Search()
End If
End Sub
Private Sub BtnSearch_Click(sender As Object, e As EventArgs) Handles btnSearch.Click
btnSearch.BackgroundImage = My.Resources.ButtonClk_Teal_Trans
Cursor = Cursors.Hand
Search()
End Sub
Private Sub Search()
Cursor = Cursors.WaitCursor
If cbColName.Text = "SEARCH BY:" Then
MeMsgBoxSearchCriteria.ShowDialog()
Else : lblSearchResults.Items.Clear()
Select Case DocDataset.Documents_Table.Columns(cbColName.Text).DataType
Case GetType(Integer)
DV.RowFilter = cbColName.Text & " = " & tbSearchInput.Text.Trim
Case GetType(Date)
DV.RowFilter = cbColName.Text & " = #" & tbSearchInput.Text.Trim & "#"
Case Else
DV.RowFilter = cbColName.Text & " LIKE '*" & tbSearchInput.Text.Trim & "*'"
End Select
If DV.Count > 0 Then
For IX As Integer = 0 To DV.Count - 1
lblSearchResults.Items.Add(DV.Item(IX)("PETS_LOAD_NUMBER"))
Next
If DV.Count = 1 Then
lblSearchResults.SelectedIndex = 0
Dim ix As Integer = DocumentsTableBindingSource.Find("PETS_LOAD_NUMBER", CInt(lblSearchResults.SelectedItem.ToString))
DocumentsTableBindingSource.Position = ix
LoadPDF()
Else
lblSearchResults.Visible = True
lblSearchResults.BringToFront()
End If
Else
' Display a message box notifying users the record cannot be found.
MeMsgBoxNoSearch.ShowDialog()
End If
End If
Cursor = Cursors.Default
End Sub
Private Sub LblSearchResults_SelectedIndexChanged(sender As Object, e As EventArgs) Handles lblSearchResults.SelectedIndexChanged
Dim ix As Integer = DocumentsTableBindingSource.Find("PETS_LOAD_NUMBER", CInt(lblSearchResults.SelectedItem.ToString))
DocumentsTableBindingSource.Position = ix
lblSearchResults.Visible = False
End Sub
Private Sub LoadPDF()
Dim temp = Environment.GetEnvironmentVariable("TEMP", EnvironmentVariableTarget.User)
If File.Exists(Application.StartupPath() & "\temp.file") = True Then
AxAcroPDF1.src = "blank.pdf"
My.Computer.FileSystem.DeleteFile(Application.StartupPath() & "\temp.file")
End If
Dim cmd As New SqlCommand
cmd.CommandText = "SELECT DOCUMENTS FROM Documents_Table WHERE PETS_LOAD_NUMBER = #pl"
cmd.Parameters.AddWithValue("#pl", tbPetsLoadNumber.Text)
cmd.CommandType = CommandType.Text
cmd.Connection = New SqlConnection With {
.ConnectionString = My.MySettings.Default.PETS_DatabaseConnectionString
}
Dim Buffer As Byte()
cmd.Connection.Open()
Buffer = cmd.ExecuteScalar
cmd.Connection.Close()
File.WriteAllBytes(Application.StartupPath() & "\temp.file", Buffer)
'DATA READER
AxAcroPDF1.src = Application.StartupPath() & "\temp.file"
End Sub
Private Sub DocumentsTableBindingSource_PositionChanged(sender As Object, e As EventArgs) Handles DocumentsTableBindingSource.PositionChanged
Try
currentRow = DocDataset.Documents_Table.Item(DocumentsTableBindingSource.Position).ToString
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub
Private Sub BtnSavePDF_Click(sender As Object, e As EventArgs) Handles btnSavePDF.Click
If tbPetsLoadNumber.Text.Length = 0 Then
MessageBox.Show("Please enter a PETS Load Number", "Missing Load Number", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
ElseIf tbBrokerLoadNumber.Text.Length = 0 Then
MessageBox.Show("Please enter a Broker Load Number", "Missing Load Number", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
ElseIf tbFileName.Text.Length = 0 Then
MessageBox.Show("Please enter a Filename", "Missing Filename", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
End If
Try
Using OpenFileDialog As OpenFileDialog = OpenFileDialog1()
If (OpenFileDialog.ShowDialog(Me) = DialogResult.OK) Then
tbFilePath.Text = OpenFileDialog.FileName
Else 'Cancel
Exit Sub
End If
End Using
'Call Upload Images Or File
Dim sFileToUpload As String = ""
sFileToUpload = LTrim(RTrim(tbFilePath.Text))
'Initialize byte array with a null value initially.
Dim data As Byte() = Nothing
'Use FileInfo object to get file size.
Dim fInfo As New FileInfo(tbFilePath.Text)
Dim numBytes As Long = fInfo.Length
'Open FileStream to read file
Dim fStream As New FileStream(tbFilePath.Text, FileMode.Open, FileAccess.Read)
'Use BinaryReader to read file stream into byte array.
Dim br As New BinaryReader(fStream)
'Supply number of bytes to read from file.
'In this case we want to read entire file. So supplying total number of bytes.
data = br.ReadBytes(CInt(numBytes))
'Insert the details into the database
Dim cmd As New SqlCommand
cmd.CommandText = "INSERT INTO Documents_Table (BROKER_LOAD_NUMBER, PDF_FILENAME, PETS_LOAD_NUMBER, DOCUMENTS)
VALUES (#bl, #fn, #pl, #pdf)"
cmd.Parameters.Add("#fn", SqlDbType.NVarChar, 50).Value = tbFileName.Text
cmd.Parameters.Add("#pl", SqlDbType.Int).Value = tbPetsLoadNumber.Text
cmd.Parameters.Add("#bl", SqlDbType.NVarChar, 20).Value = tbBrokerLoadNumber.Text
cmd.Parameters.Add("#pdf", SqlDbType.VarBinary, -1).Value = data
cmd.CommandType = CommandType.Text
cmd.Connection = New SqlConnection With {
.ConnectionString = My.MySettings.Default.PETS_DatabaseConnectionString
}
cmd.Connection.Open()
cmd.ExecuteNonQuery()
cmd.Connection.Close()
MsgBox("File Successfully Imported to Database")
Catch ex As Exception
MessageBox.Show(ex.ToString())
End Try
End Sub
End Class
In your function LoadPDF you create a reference to tempdir and then don't use it. Instead, you use Application.StartupPath() which will point to C:\Programs(x86) and is usually not writeable without admin rights.
But why don't you use your temp dir:
Dim temp = SpecialDirectories.Temp 'more robust approach to get tempdir
If File.Exists(temp & "\temp.file") = True Then
AxAcroPDF1.src = "blank.pdf"
My.Computer.FileSystem.DeleteFile(temp & "\temp.file")
End If
...
File.WriteAllBytes(temp & "\temp.file", Buffer)
'DATA READER
AxAcroPDF1.src = temp & "\temp.file"

How to get ipv4 addresses of all computers on a network in VB.NET

I have a Windows Forms app in Visual basic that is currently sending messages back and forth between two computers. Currently, the user has to manually enter the ipv4 address of the receiver of the message. what I would like to do is put the ipv4 addresses of all the computers on the network into a combo box so the user has a list to pick from.
I have searched a whole bunch of different forums and am unable to find a working solution.
Public Class Form1
Dim strHostName As String
Dim strIPAddress As String
Dim running As Boolean = False
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
strHostName = System.Net.Dns.GetHostName()
strIPAddress = System.Net.Dns.GetHostByName(strHostName).AddressList(0).ToString()
Me.Text = strIPAddress
txtIP.Text = strIPAddress
running = True
'run listener on separate thread
Dim listenTrd As Thread
listenTrd = New Thread(AddressOf StartServer)
listenTrd.IsBackground = True
listenTrd.Start()
End Sub
Private Sub Form1_FormClosing(sender As Object, e As EventArgs) Handles MyBase.FormClosing
running = False
End Sub
Sub StartServer()
Dim serverSocket As New TcpListener(CInt(txtPort.Text))
Dim requestCount As Integer
Dim clientSocket As TcpClient
Dim messageReceived As Boolean = False
While running
messageReceived = False
serverSocket.Start()
msg("Server Started")
clientSocket = serverSocket.AcceptTcpClient()
msg("Accept connection from client")
requestCount = 0
While (Not (messageReceived))
Try
requestCount = requestCount + 1
Dim networkStream As NetworkStream = clientSocket.GetStream()
Dim bytesFrom(10024) As Byte
networkStream.Read(bytesFrom, 0, bytesFrom.Length)
Dim dataFromClient As String = System.Text.Encoding.ASCII.GetString(bytesFrom)
dataFromClient = dataFromClient.Substring(0, dataFromClient.Length)
'invoke into other thread
txtOut.Invoke(Sub()
txtOut.Text += dataFromClient
txtOut.Text += vbNewLine
End Sub)
messageReceived = True
Dim serverResponse As String = "Server response " + Convert.ToString(requestCount)
Dim sendBytes As [Byte]() = Encoding.ASCII.GetBytes(serverResponse)
networkStream.Write(sendBytes, 0, sendBytes.Length)
networkStream.Flush()
Catch ex As Exception
End
End Try
End While
clientSocket.Close()
serverSocket.Stop()
msg("exit")
Console.ReadLine()
End While
End Sub
Sub msg(ByVal mesg As String)
mesg.Trim()
Console.WriteLine(" >> " + mesg)
End Sub
Public Sub WriteData(ByVal data As String, ByRef IP As String)
Try
txtOut.Text += data.PadRight(1)
txtOut.Text += vbNewLine
txtMsg.Clear()
Console.WriteLine("Sending message """ & data & """ to " & IP)
Dim client As TcpClient = New TcpClient()
client.Connect(New IPEndPoint(IPAddress.Parse(IP), CInt(txtPort.Text)))
Dim stream As NetworkStream = client.GetStream()
Dim sendBytes As Byte() = Encoding.ASCII.GetBytes(data)
stream.Write(sendBytes, 0, sendBytes.Length)
Catch ex As Exception
msg(ex.ToString)
End Try
End Sub
Private Sub btnSend_Click(sender As Object, e As EventArgs) Handles btnSend.Click
If Not (txtMsg.Text = vbNullString) AndAlso Not (txtIP.Text = vbNullString) Then
WriteData(txtMsg.Text, txtIP.Text)
End If
End Sub
Private Sub txtMsg_KeyDown(sender As Object, e As KeyEventArgs) Handles txtMsg.KeyDown
If e.KeyCode = Keys.Enter Then
If Not (txtMsg.Text = vbNullString) AndAlso Not (txtIP.Text = vbNullString) Then
WriteData(txtMsg.Text, txtIP.Text)
End If
End If
End Sub
Private Sub BtnFind_Click(sender As Object, e As EventArgs) Handles btnFind.Click
'find all local addresses and put in combobox (button will be removed later)
End Sub
End Class
For PC names "as you suggested in your comments", I used this at work to get pc names i was on domain, try it:
AFAIK it works on domains...
Make sure you have a listbox on your form, or change listbox and populate in your combobox directly, play with that as you like :)
Private Delegate Sub UpdateDelegate(ByVal s As String)
Dim t As New Threading.Thread(AddressOf GetNetworkComputers)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
t.IsBackground = True
t.Start()
End Sub
Private Sub AddListBoxItem(ByVal s As String)
ListBox1.Items.Add(s)
End Sub
Private Sub GetNetworkComputers()
Try
Dim alWorkGroups As New ArrayList
Dim de As New DirectoryEntry
de.Path = "WinNT:"
For Each d As DirectoryEntry In de.Children
If d.SchemaClassName = "Domain" Then alWorkGroups.Add(d.Name)
d.Dispose()
Next
For Each workgroup As String In alWorkGroups
de.Path = "WinNT://" & workgroup
For Each d As DirectoryEntry In de.Children
If d.SchemaClassName = "Computer" Then
Dim del As UpdateDelegate = AddressOf AddListBoxItem
Me.Invoke(del, d.Name)
End If
d.Dispose()
Next
Next
Catch ex As Exception
'MsgBox(Ex.Message)
End Try
End Sub
POC:

How to save Received Messages From Gsm Modem to your Mysql Database?

I am trying to save received sms from my modem to MySQL database, and I am using MySQL Workbench for my database.
Here's my functionalities:
1. Auto detect modem
2. Connect modem
3. Send Messages
4. Read Messages
5. Handles (SerialPort Data received)
Here's the Code:1. Auto Detect Modem
'Some Imports
Imports System.Management
Imports System.Threading
Imports System.Text.RegularExpressions
Imports MySql.Data.MySqlClient
Public Class Form1
Dim result() As String
Dim query As String
Dim rcvdata As String = ""
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Dim ports() As String
ports = Split(ModemsConnected(), "***")
For i As Integer = 0 To ports.Length - 2
ComboBox1.Items.Add(ports(i))
Next
End Sub
Public Function ModemsConnected() As String
Dim modems As String = ""
Try
Dim searcher As New ManagementObjectSearcher("root\CIMV2", "SELECT * FROM Win32_POTSModem")
For Each queryObj As ManagementObject In searcher.Get()
If queryObj("Status") = "OK" Then
modems = modems & (queryObj("AttachedTo") & " - " & queryObj("Description") & "***")
End If
Next
Catch err As ManagementException
MessageBox.Show("An error occurred while querying for WMI data: " & err.Message)
Return ""
End Try
Return modems
End Function
'Show Detected or Available modem
Private Sub ComboBox1_SelectedValueChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles ComboBox1.SelectedValueChanged
Label1.Text = Trim(Mid(ComboBox1.Text, 1, 5))
End Sub
2. Connect/Disconnect Modem
'button connect
Private Sub btnConnect_Click(sender As System.Object, e As System.EventArgs) Handles btnConnect.Click
Try
With SerialPort1
.PortName = Label1.Text
.BaudRate = 9600
.Parity = IO.Ports.Parity.None
.DataBits = 8
.StopBits = IO.Ports.StopBits.One
.Handshake = IO.Ports.Handshake.None
.RtsEnable = True
.ReceivedBytesThreshold = 1
.NewLine = vbCr
.ReadTimeout = 1000
.Open()
End With
If SerialPort1.IsOpen Then
Label3.Visible = True
btnDisconnect.Visible = True
Label3.Text = "Connected - Port " & Label1.Text & " is used"
Else
Label3.Text = "Got some Error, Check your connection with your Modem."
End If
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Text Messaging")
End Try
End Sub
'button Disconnect
Private Sub btnDisconnect_Click(sender As System.Object, e As System.EventArgs) Handles btnDisconnect.Click
Try
If SerialPort1.IsOpen Then
With SerialPort1
.Close()
.Dispose()
Label1.Visible = False
Label3.Visible = False
btnDisconnect.Visible = False
ListView1.Items.Clear()
End With
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
3. Send Messages
Private Sub btnSend_Click(sender As System.Object, e As System.EventArgs) Handles btnSend.Click
Dim query As String
Try
Connection()
query = "INSERT INTO thesis.tblsentitems (PhoneNumber, message) VALUES('" & txtNumber.Text & "', '" & txtMessage.Text & "')"
sqlcmd = New MySqlCommand(query, conn)
sqlreader = sqlcmd.ExecuteReader
With SerialPort1
.Write("at" & vbCrLf)
Threading.Thread.Sleep(200)
.Write("at+cmgf=1" & vbCrLf)
Threading.Thread.Sleep(200)
.Write("at+cmgs=" & Chr(34) & txtNumber.Text & Chr(34) & vbCrLf)
.Write(txtMessage.Text & Chr(26))
Threading.Thread.Sleep(200)
End With
If rcvdata.ToString.Contains(">") Then
MsgBox("Message Succesfully Sent")
conn.Close()
Else
MsgBox("Got some error!")
End If
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Text Messaging")
End Try
End Sub
4. Read Messages
Private Sub btnReadsms_Click(sender As System.Object, e As System.EventArgs) Handles btnReadsms.Click
Try
With SerialPort1
.Write("AT" & vbCrLf)
Threading.Thread.Sleep(1000)
.Write("AT+CMGF=1" & vbCrLf)
Threading.Thread.Sleep(1000)
.Write("AT+CPMS=""SM""" & vbCrLf)
Threading.Thread.Sleep(1000)
.Write("AT+CMGL=""ALL""" & vbCrLf)
Threading.Thread.Sleep(1000)
'MsgBox(rcvdata.ToString)
readmsg()
End With
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
'Save Received message to ListView1
Private Sub readmsg()
Try
Dim lineoftext As String
Dim i As Integer
Dim arytextfile() As String
lineoftext = rcvdata.ToString
arytextfile = Split(lineoftext, "+CMGL", , CompareMethod.Text)
For i = 1 To UBound(arytextfile)
Dim input As String = arytextfile(i)
Dim pattern As String = "(:)|(,"")|("","")"
result = Regex.Split(input, pattern)
Dim concat() As String
With ListView1.Items.Add("null")
'for index
.SubItems.AddRange(New String() {result(2).ToString})
'for status
.SubItems.AddRange(New String() {result(4).ToString})
'for number
Dim my_string, position As String
my_string = result(6)
position = my_string.Length - 2
my_string = my_string.Remove(position, 2)
.SubItems.Add(my_string)
'for date and time
concat = New String() {result(8)}
.SubItems.AddRange(concat)
'for message
Dim lineoftexts As String
Dim arytextfiles() As String
lineoftexts = arytextfile(i)
arytextfiles = Split(lineoftexts, "+32", , CompareMethod.Text)
.SubItems.Add(arytextfiles(1))
End With
Next
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
5. Handles (SerialPort Data received)
Private Sub SerialPort1_datareceived(ByVal sender As Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles SerialPort1.DataReceived
Dim datain As String = ""
Dim numbytes As Integer = SerialPort1.BytesToRead
For i As Integer = 1 To numbytes
datain &= Chr(SerialPort1.ReadChar)
Next
test(datain)
End Sub
Private Sub test(ByVal indata As String)
rcvdata &= indata
End Sub
Hope someone can Help, please... :/

Making a string from a listbox

I have 2 projects, one which has a highscorelist stored on it, and one which tries to add highscores to that list and retrieve all items on the list. Trying to put items on the list works good, but retrieving the list doesn't work well. Here's the code:
Option Strict On
Option Explicit On
Imports System.Net.Sockets
Imports System.Threading
Public Class Main
Dim server As New TcpListener(45888)
Dim client As New TcpClient
Dim stream As NetworkStream
Dim connected As Boolean
Private Sub cmd_start_Click(sender As Object, e As EventArgs) Handles cmd_start.Click
server.Start()
cmd_start.Enabled = False
cmd_stop.Enabled = True
lbl_status.Text = "Running"
lbl_status.ForeColor = Color.Green
tmr.Start()
End Sub
Private Sub cmd_stop_Click(sender As Object, e As EventArgs) Handles cmd_stop.Click
server.Stop()
cmd_start.Enabled = True
cmd_stop.Enabled = False
lbl_status.Text = "Not running"
lbl_status.ForeColor = Color.Red
tmr.Stop()
End Sub
Private Sub Main_Load(sender As Object, e As EventArgs) Handles MyBase.Load
connected = False
CheckForIllegalCrossThreadCalls = False
End Sub
Dim x As Integer = 0
Private Sub tmr_Tick(sender As Object, e As EventArgs) Handles tmr.Tick
If server.Pending Then
client = server.AcceptTcpClient()
stream = client.GetStream()
tmr.Stop()
read()
Else
tmr.Start()
End If
lbl_mseconds.Text = "Relative time: " & x
x += 1
End Sub
Private Sub SendMessage(message As String)
Dim sendtext() As Byte = System.Text.Encoding.ASCII.GetBytes(message)
stream.Write(sendtext, 0, sendtext.Length)
stream.Flush()
End Sub
Private Sub read()
Dim rec(client.ReceiveBufferSize) As Byte
stream.Read(rec, 0, client.ReceiveBufferSize)
Dim rectext As String = System.Text.Encoding.ASCII.GetString(rec)
If rectext.Contains("#1#") Then
rectext = rectext.Substring(3)
If rectext.Split(CChar("-"))(0).Length = 2 Then rectext = "0" & rectext
If rectext.Split(CChar("-"))(0).Length = 1 Then rectext = "00" & rectext
listbox_highscores.Items.Add(rectext)
ElseIf rectext.Contains("#2#") Then
Dim tosend As String = listbox_highscores.Items(0).ToString
For i = 1 To listbox_highscores.Items.Count - 1
tosend &= "," & listbox_highscores.Items(i).ToString
Next
MsgBox(tosend)
SendMessage(tosend)
End If
tmr.Start()
End Sub
End Class
On the other project I have this:
Dim server As New TcpListener(45888)
Dim client As New TcpClient
Dim stream As NetworkStream
Friend Sub sendHighscore(name As String, score As Integer)
Try
client.Connect("192.168.1.127", 45888)
Catch ex As Exception
Exit Sub
End Try
stream = client.GetStream()
Dim sendtext() As Byte = Encoding.ASCII.GetBytes("#1#" & score & "-" & name)
stream.Write(sendtext, 0, sendtext.Length)
client = New TcpClient
End Sub
Friend Sub getHighscoreList()
ListBox_highscores.Items.Clear()
Try
client.Connect("192.168.1.127", 45888)
Catch ex As Exception
ListBox_highscores.Items.Add("Couldn't connect")
Exit Sub
End Try
stream = client.GetStream()
Dim sendtext() As Byte = Encoding.ASCII.GetBytes("#2#")
stream.Write(sendtext, 0, sendtext.Length)
client = New TcpClient
read()
End Sub
Private Sub read()
Dim rec(client.ReceiveBufferSize) As Byte
stream.Read(rec, 0, client.ReceiveBufferSize)
Dim rectext As String = Encoding.ASCII.GetString(rec)
Label2.Text = rectext
For Each item In rectext.Split(",")
ListBox_highscores.Items.Add(item)
Next
End Sub
Then when I use the sub sendHighscore() with a name and score, everything perfectly works and it shows in the other project on the list, but when I use the sub getHighscoreList() the list on the second project only contains the first item from the first list. Does someone has ideas?
Edit: Original answer removed entirely because it wasn't actually the problem (although it did offer improvements). My answer was nearly identical to this one anyway.
After analyzing this project much more closely, the problem with the For..Next loop not returning the expected results is because the strings are being sent back and forth as byte arrays in buffers much larger than necessary (client.ReceiveBufferSize). The actual "strings" received contain large amounts of non-printable characters (garbage) added to the end to fill the buffer. The quick and dirty solution is to remove all non-printable characters:
rectext = System.Text.RegularExpressions.Regex.Replace(rectext, _
"[^\u0020-\u007F]", String.Empty)
The whole Sub would read like this:
Private Sub read()
Dim rec(client.ReceiveBufferSize) As Byte
stream.Read(rec, 0, client.ReceiveBufferSize)
Dim rectext As String = System.Text.Encoding.ASCII.GetString(rec)
If rectext.Contains("#1#") Then
rectext = rectext.Substring(3)
If rectext.Split(CChar("-"))(0).Length = 2 Then rectext = "0" & rectext
If rectext.Split(CChar("-"))(0).Length = 1 Then rectext = "00" & rectext
rectext = System.Text.RegularExpressions.Regex.Replace(rectext, "[^\u0020-\u007F]", String.Empty)
listbox_highscores.Items.Add(rectext)
ElseIf rectext.Contains("#2#") Then
Dim tosend As String = listbox_highscores.Items(0).ToString
For i As Integer = 1 To (listbox_highscores.Items.Count - 1)
tosend &= "," & listbox_highscores.Items(i).ToString
Next
SendMessage(tosend)
End If
tmr.Start()
End Sub
Try this, your comma's are off as well...
Dim tosend As String = String.Empty
Dim intCount As Integer = 0
For i As Integer = 0 To listbox.Items.Count - 1
If intCount >= 1 Then
tosend &= "," & listbox.Items(i).ToString
Else
tosend &= listbox.Items(i).ToString
intCount += 1
End If
Next
MessageBox.Show(tosend)
Screenshot THAT IT WORKS!

How do I close the tcp client (client.close) with a button?

I have a client server application.
if the client has disconnected the server can detect it automatically and remove it from the connected clients list.
I am going to focus on the server now.
I would like to have a Stop Server button. To stop the Listener and Tcp Client Connections.
I can easily stop the listener, but I am having a hard time trying to figure out how to stop the tcp client ( or issue a Client.Close )
[SERVER]
Public Class Server
Dim ClientList As New Hashtable
Dim Listener As TcpListener
Dim ListenerThread As System.Threading.Thread
Private Sub ButtonStart_Click(sender As Object, e As EventArgs) Handles ButtonStart.Click
ListenerThread = New System.Threading.Thread(AddressOf Listen)
ListenerThread.IsBackground = True
ListenerThread.Start(TextBoxPort.Text)
ButtonStart.Enabled = False
ButtonStop.Enabled = True
ListBox1.Items.Add("[SERVER] Waiting For A Connection...")
End Sub
Sub ClientDisconnected(ByVal Client As ConnectedClient)
ClientList.Remove(Client) 'remove the client from the hashtable
ListBox2.Items.Remove(Client.Name) 'remove it from our listbox
End Sub
Sub Listen(ByVal Port As Integer)
Try
Listener = New TcpListener(IPAddress.Any, Port)
Listener.Start()
Do
Dim Client As New ConnectedClient(Listener.AcceptTcpClient)
AddHandler Client.ReceivedMessage, AddressOf ReceivedMessage
AddHandler Client.ClientDisconnected, AddressOf ClientDisconnected
Loop Until False
Catch
End Try
End Sub
Dim TotalItemCount As String
Sub ReceivedMessage(ByVal Msg As String, ByVal Client As ConnectedClient)
Dim Message() As String = Msg.Split("|")
Select Case Message(0)
Case "CHAT" 'if it's CHAT
ListBox1.Items.Add(Client.Name & " Says: " & " " & Message(1))
Case "SAVETRAN"
ListBox1.Items.Add("Transaction Number: " + Message(1) + vbCrLf + "Customer Number: " + Message(2))
Case "TRANDETAIL"
ListBox1.Items.Add("Barcode: " + Message(1) + vbCrLf + "Quantity: " + Message(2) + vbCrLf + "Price Sold: " + Message(3))
ProgressBar1.Value += 1
Label1.Text = ProgressBar1.Value
If Label1.Text = ProgressBar1.Maximum Then
ProgressBar1.Value = 0
End If
Case "ITEMCOUNT"
ListBox1.Items.Add("SERVER IS EXPECTED TO RECEIVE " + Message(1) + " ITEMS.")
TotalItemCount = Message(1)
ProgressBar1.Maximum = TotalItemCount
Case "LOGIN" 'A client has connected
ClientList.Add(Client, Client.Name)
ListBox2.Items.Add(Client.Name)
End Select
End Sub
Private Sub ButtonStop_Click(sender As Object, e As EventArgs) Handles ButtonStop.Click
Listener.Stop()
ListBox1.Items.Add("Server Stopped")
ButtonStop.Enabled = False
ButtonStart.Enabled = True
End Sub
Private Sub Server_Load(sender As Object, e As EventArgs) Handles MyBase.Load
CheckForIllegalCrossThreadCalls = False
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
ListBox1.Items.Clear()
End Sub
End Class
In the Server Application there is a class call ConnectedClient
[Connected Client]
Public Class ConnectedClient
Public Cli As TcpClient
Private UniqueID As String
Public Property Name
Get
Return UniqueID
End Get
Set(ByVal Value)
UniqueID = Value
End Set
End Property
Public Sub New(Client As TcpClient)
Dim r As New Random
Dim x As String = String.Empty
For i = 0 To 7
x &= Chr(r.Next(65, 89))
Next
Me.Name = Client.Client.RemoteEndPoint.ToString().Remove(Client.Client.RemoteEndPoint.ToString().LastIndexOf(":")) & " - " & x
Cli = Client
Cli.GetStream.BeginRead(New Byte() {0}, 0, 0, AddressOf Reading, Nothing)
End Sub
Public Event ReceivedMessage(ByVal Message As String, ByVal Client As ConnectedClient)
Public Event ClientDisconnected(ByVal Client As ConnectedClient)
Sub Reading(ByVal AR As IAsyncResult)
Try
Dim Reader As New StreamReader(Cli.GetStream)
Dim Msg As String = Reader.ReadLine()
RaiseEvent ReceivedMessage(Msg, Me)
Cli.GetStream.BeginRead(New Byte() {0}, 0, 0, AddressOf Reading, Nothing)
Catch ex As Exception
'Try and read again
Try
Dim Reader As New StreamReader(Cli.GetStream)
Dim Msg As String = Reader.ReadLine()
RaiseEvent ReceivedMessage(Msg, Me)
Cli.GetStream.BeginRead(New Byte() {0}, 0, 0, AddressOf Reading, Nothing)
Catch
RaiseEvent ClientDisconnected(Me)
End Try
End Try
End Sub
Sub SendData(ByVal Message As String)
Dim Writer As New StreamWriter(Cli.GetStream)
Writer.WriteLine(Message)
Writer.Flush()
End Sub
End Class
I was trying somehow to link to the connected client class and get the Client.Close, but I cannot
figure it out.