Example: TCP Server + Thread + Accès aux composants GUI D'une form depuis le thread
Vu que j'ai pas mal galéré avec ça, surtout avec cette histoire de delegates, je poste ici un example qui permets d'accepter une connection et de démarrer un thread.
Mon soucis était de pouvoir accéder aux données de ma forme principale depuis mes threads.
En gros, j'ai un thread qui accepte les connections clients, et démarre un autre thread pour chacune d'elle.
Le but de mon soft est de pouvoir récuper via le réseau le contenu d'une listview distante.
En espérant que ça serve :)
Coté serveur, classe réseau:
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
Imports System.Net.Sockets
Imports System.Net
Imports System.Threading
Imports System.IO
Imports System.Xml
Imports CrocoScheduler.functions
Public Class remoteConsole
Private port As Integer
Private listener As TcpListener
Private serverThread As Thread
Public Sub New(rport As Integer)
Me.port = rport
End Sub
Public Sub setport(rport As Integer)
If rport <> port Then
port = rport
stopServer()
startServer()
End If
End Sub
Public Sub startServer()
frmMain.log("Starting console server")
If Not IsNothing(listener) Then
listener.Stop()
Else
listener = New TcpListener(IPAddress.Any, port)
End If
If Not IsNothing(serverThread) Then
serverThread.Abort()
End If
listener.Start()
serverThread = New Thread(AddressOf startThread) 'starting thread to accept connections
serverThread.Start()
End Sub
Private Sub localLog(msg As String, sev As String)
Dim main As frmMain = CType(Application.OpenForms(0), frmMain)
Dim logger As New frmMain.dlog(AddressOf main.log)
main.Invoke(logger, msg, sev)
End Sub
Private Function getLvOverviewitemLocal() As ListView.ListViewItemCollection
Dim main As frmMain = CType(Application.OpenForms(0), frmMain)
'Dim f As New frmMain.dgetlvOverviewItems(AddressOf main.getlvOverviewItems)
'Return main.Invoke(f)
Return main.Invoke(Function()
Return main.lvOverView.Items
End Function)
End Function
Private Function getlvScheduledItemsLocal() As ListView.ListViewItemCollection
Dim main As frmMain = CType(Application.OpenForms(0), frmMain)
'Dim f As New frmMain.dgetlvScheduledItems(AddressOf main.getlvScheduledItems)
'Return main.Invoke(f)
'Return f()
Return main.Invoke(Function()
Return main.lvScheduledEvents.Items
End Function)
End Function
Private Sub processClientConnection(client As TcpClient)
Try
Dim TCPstream As NetworkStream = client.GetStream()
Dim TCPReader As StreamReader = New StreamReader(TCPstream)
Dim TCPWriter As StreamWriter = New StreamWriter(TCPstream)
Dim pass As String = TCPReader.ReadLine()
If pass = getAppData().RCPassword Then
Me.localLog("Password accepted", "DEBUG")
Dim XmlDoc As XmlDocument = New XmlDocument()
XmlDoc.LoadXml("<response></response>")
Dim scheduled As XmlElement = XmlDoc.CreateElement("scheduled")
Dim overView As XmlElement = XmlDoc.CreateElement("overview")
Dim items As ListView.ListViewItemCollection = Me.getlvScheduledItemsLocal()
For Each item As ListViewItem In items
Dim line As XmlElement = XmlDoc.CreateElement("line")
line.SetAttribute("color", CStr(item.BackColor.ToArgb()))
line.SetAttribute("color-hex", colorToHexString(item.BackColor))
For i = 0 To item.SubItems.Count() - 1
Dim element As XmlElement = XmlDoc.CreateElement("column")
element.InnerText = item.SubItems(i).Text
line.AppendChild(element)
Next
scheduled.AppendChild(line)
Next
items = Me.getLvOverviewitemLocal()
For Each item As ListViewItem In items
Dim line As XmlElement = XmlDoc.CreateElement("line")
line.SetAttribute("color", CStr(item.BackColor.ToArgb()))
line.SetAttribute("color-hex", colorToHexString(item.BackColor))
For i = 0 To item.SubItems.Count() - 1
Dim element As XmlElement = XmlDoc.CreateElement("column")
element.InnerText = item.SubItems(i).Text
line.AppendChild(element)
Next
overView.AppendChild(line)
Next
XmlDoc.DocumentElement.AppendChild(scheduled)
XmlDoc.DocumentElement.AppendChild(overView)
TCPWriter.Write(XmlDoc.InnerXml)
Else
Me.localLog("Password not correct from " & client.Client.RemoteEndPoint.ToString(), "ERROR")
TCPWriter.Write("FUCK YOU")
End If
TCPWriter.Flush()
client.Close()
Catch ex As Exception
Me.localLog("Error in thread/socket " & ex.Message, "ERROR")
End Try
End Sub
Private Sub startThread()
Me.localLog("Starting console server thread", "INFO")
While True
Dim TCPClient As TcpClient = listener.AcceptTcpClient()
Me.localLog("Incoming connection from " & TCPClient.Client.RemoteEndPoint.ToString(), "DEBUG")
Dim clientThread As Thread = New Thread(Sub()
processClientConnection(TCPClient)
End Sub)
clientThread.Start() 'starting thread to process client connection
End While
End Sub
Public Sub stopServer()
If Not IsNothing(listener) Then
listener.Stop()
End If
serverThread.Abort()
frmMain.log("Stopped console server")
End Sub
End Class |
Quelques fonctions avec leur delegate de ma form principale:
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
Delegate Function dgetlvOverviewItems() As ListView.ListViewItemCollection
Public Function getlvOverviewItems() As ListView.ListViewItemCollection
Return lvOverView.Items
End Function
Delegate Function dgetlvScheduledItems() As ListView.ListViewItemCollection
Public Function getlvScheduledItems() As ListView.ListViewItemCollection
Return lvScheduledEvents.Items
End Function
Delegate Sub dlog(msg As String, sev As String)
Public Sub log(msg As String, Optional sev As String = "INFO")
' do sth here
end sub |
et mon client qui utilise aussi des threads
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
Imports System.Net.Sockets
Imports System.Net
Imports System.IO
Imports System.Threading
Imports System.Xml
Public Class frmMain
Private Sub btnConnect_Click(sender As Object, e As EventArgs) Handles btnConnect.Click
connectDisconnect(Not timerRefresh.Enabled)
End Sub
Delegate Sub dconnectDisconnect(connect As Boolean)
Private Sub connectDisconnect(connect As Boolean)
If Not connect Then
timerRefresh.Enabled = False
btnConnect.Text = "Connect"
txtAddress.Enabled = True
txtPassword.Enabled = True
txtPort.Enabled = True
Else
If IsNumeric(txtPort.Text) Then
timerRefresh.Enabled = True
btnConnect.Text = "Disconnect"
txtAddress.Enabled = False
txtPassword.Enabled = False
txtPort.Enabled = False
refreshData()
Else
MsgBox("Please put a valid port number")
End If
End If
End Sub
Private Sub connectDisconnectThread(connect As Boolean)
Dim conn As New dconnectDisconnect(AddressOf connectDisconnect)
Me.Invoke(conn, connect)
End Sub
Sub updateOrInsertLVItem(ByRef lv As ListView, values As String(), colKeys As Integer, color As Color)
For Each item As ListViewItem In lv.Items
Dim isEqual As Boolean = True
For i = 0 To colKeys
isEqual = isEqual And (values(i) = item.SubItems(i).Text)
Next
If isEqual Then
For i = 0 To UBound(values)
If item.SubItems(i).Text <> values(i) Then
item.SubItems(i).Text = values(i)
End If
Next
If item.BackColor <> color Then
item.BackColor = color
End If
Exit Sub
End If
Next
Dim Line As ListViewItem = New ListViewItem(values)
Line.BackColor = color
lv.Items.Add(Line)
End Sub
Delegate Sub dparseData(data As String)
Private Sub parseData(data As String)
Dim xmlDoc = New XmlDocument()
Try
xmlDoc.LoadXml(data)
Catch ex As Exception
MsgBox("Error " & ex.Message)
connectDisconnect(False)
End Try
For Each eventSubNode As XmlNode In xmlDoc.SelectNodes("response/overview/line")
Dim values As String()
ReDim values(eventSubNode.ChildNodes.Count)
For i = 0 To eventSubNode.ChildNodes.Count - 1
values(i) = eventSubNode.ChildNodes(i).InnerText
Next
Dim c As Color = Color.FromArgb(CInt(eventSubNode.Attributes("color").Value))
updateOrInsertLVItem(lvOverView, values, 3, c)
Next
For Each eventSubNode As XmlNode In xmlDoc.SelectNodes("response/scheduled/line")
Dim values As String()
ReDim values(eventSubNode.ChildNodes.Count)
For i = 0 To eventSubNode.ChildNodes.Count - 1
values(i) = eventSubNode.ChildNodes(i).InnerText
Next
Dim c As Color = Color.FromArgb(CInt(eventSubNode.Attributes("color").Value))
updateOrInsertLVItem(lvScheduledEvents, values, 3, c)
Next
End Sub
Private Sub parseDataThread(data As String)
Dim parser As New dparseData(AddressOf parseData)
Me.Invoke(parser, data)
End Sub
Private Sub refreshDataThread()
Try
Dim TCPClient As TcpClient = New TcpClient(txtAddress.Text, CInt(txtPort.Text))
Dim TCPstream As NetworkStream = TCPClient.GetStream()
Dim TCPReader As StreamReader = New StreamReader(TCPstream)
Dim TCPWriter As StreamWriter = New StreamWriter(TCPstream)
TCPWriter.WriteLine(txtPassword.Text)
TCPWriter.Flush()
Dim resp As String = TCPReader.ReadToEnd()
Me.parseDataThread(resp)
Catch ex As Exception
MsgBox("Error " & ex.Message)
connectDisconnectThread(False)
End Try
End Sub
Private Sub refreshData()
Dim clientThread = New Thread(AddressOf refreshDataThread)
clientThread.Start()
End Sub
Private Sub timerRefresh_Tick(sender As Object, e As EventArgs) Handles timerRefresh.Tick
refreshData()
End Sub
Private Sub frmMain_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
saveAppData()
End Sub
Private Sub frmMain_Load(sender As Object, e As EventArgs) Handles Me.Load
txtAddress.Text = getAppData().RCAddress
txtPassword.Text = getAppData().RCPassword
txtPort.Text = getAppData().RCPort
connectDisconnect(getAppData().Connected)
End Sub
End Class |
Je sais c'est pas beaucoup commenté tout ça, mais si y'a des questions n'hésitez pas ;)
