1 |
VERSION 5.00 |
2 |
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX" |
3 |
Begin VB.Form Form_NetworkListen |
4 |
BorderStyle = 4 'Fixed ToolWindow |
5 |
Caption = "Network listener" |
6 |
ClientHeight = 720 |
7 |
ClientLeft = 45 |
8 |
ClientTop = 285 |
9 |
ClientWidth = 1815 |
10 |
ControlBox = 0 'False |
11 |
LinkTopic = "Form1" |
12 |
MaxButton = 0 'False |
13 |
MinButton = 0 'False |
14 |
ScaleHeight = 720 |
15 |
ScaleWidth = 1815 |
16 |
ShowInTaskbar = 0 'False |
17 |
StartUpPosition = 3 'Windows Default |
18 |
Begin VB.Timer Timer_ConnectionTimeout |
19 |
Interval = 100 |
20 |
Left = 870 |
21 |
Top = 210 |
22 |
End |
23 |
Begin MSWinsockLib.Winsock Winsock_UDPSend |
24 |
Left = 480 |
25 |
Top = 150 |
26 |
_ExtentX = 741 |
27 |
_ExtentY = 741 |
28 |
_Version = 393216 |
29 |
Protocol = 1 |
30 |
End |
31 |
Begin MSWinsockLib.Winsock Winsock_UDPRecieve |
32 |
Left = 90 |
33 |
Top = 240 |
34 |
_ExtentX = 741 |
35 |
_ExtentY = 741 |
36 |
_Version = 393216 |
37 |
Protocol = 1 |
38 |
End |
39 |
End |
40 |
Attribute VB_Name = "Form_NetworkListen" |
41 |
Attribute VB_GlobalNameSpace = False |
42 |
Attribute VB_Creatable = False |
43 |
Attribute VB_PredeclaredId = True |
44 |
Attribute VB_Exposed = False |
45 |
Option Explicit |
46 |
|
47 |
Dim Col_clRemotePlayerConnections As New Collection |
48 |
|
49 |
Dim strDataBuffer As String |
50 |
' |
51 |
|
52 |
Private Sub Form_Load() |
53 |
|
54 |
ConPrint Const_strConsoleTextLineIndent + "opening port 27666 for remote connections.[brk][brk]" |
55 |
|
56 |
BindLocalPort |
57 |
|
58 |
End Sub |
59 |
|
60 |
Private Sub Timer_ConnectionTimeout_Timer() |
61 |
|
62 |
Dim l As Long |
63 |
|
64 |
Dim clRemotePlayerConnection As Class_RemotePlayerConnection |
65 |
|
66 |
For l = 1 To Col_clRemotePlayerConnections.Count |
67 |
|
68 |
Set clRemotePlayerConnection = Col_clRemotePlayerConnections(l) |
69 |
|
70 |
If clRemotePlayerConnection.lLastPacketTime > 0 And clRemotePlayerConnection.lLastPacketTime < GetTickCount - 4000 Then RemoveRemotePlayer clRemotePlayerConnection.lPlayerID |
71 |
' RemoveRemotePlayer clRemotePlayerConnection.lPlayerID |
72 |
|
73 |
Next l |
74 |
|
75 |
End Sub |
76 |
|
77 |
Private Sub Winsock_UDPRecieve_DataArrival(ByVal bytesTotal As Long) |
78 |
|
79 |
Dim strRecievedData As String |
80 |
Dim lCRLFPos As Long |
81 |
|
82 |
If Winsock_UDPRecieve.State = sckOpen Then |
83 |
|
84 |
Winsock_UDPRecieve.GetData strRecievedData |
85 |
|
86 |
strDataBuffer = strDataBuffer + strRecievedData |
87 |
|
88 |
lCRLFPos = InStr(1, strDataBuffer, vbCrLf) |
89 |
|
90 |
If lCRLFPos > 0 Then |
91 |
|
92 |
strRecievedData = Left(strDataBuffer, lCRLFPos - 1) |
93 |
strDataBuffer = Mid(strDataBuffer, lCRLFPos + 2) |
94 |
|
95 |
ParseData strRecievedData |
96 |
|
97 |
End If |
98 |
|
99 |
End If |
100 |
|
101 |
' ConPrint " " & bytesTotal & " bytes recieved[brk][brk]" |
102 |
|
103 |
End Sub |
104 |
|
105 |
Private Sub ParseData(strData As String) |
106 |
|
107 |
Dim lpstrArguments() As String |
108 |
|
109 |
If Len(strData) > 3 Then |
110 |
|
111 |
lpstrArguments = Split(Mid(strData, 4), " ") |
112 |
|
113 |
Select Case Left(strData, 2) |
114 |
|
115 |
Case "gr" ' Game request |
116 |
|
117 |
CreateRemotePlayer lpstrArguments(0), Val(lpstrArguments(1)), Val(lpstrArguments(2)), lpstrArguments(3) |
118 |
Debug.Print strData |
119 |
|
120 |
Case "cf" |
121 |
|
122 |
If Col_clRemotePlayerConnections.Count > 0 Then |
123 |
|
124 |
Col_clRemotePlayerConnections("i" & lpstrArguments(0)).lLastPacketTime = GetTickCount |
125 |
' Col_clRemotePlayerConnections(1).lLastPacketTime = GetTickCount |
126 |
clGame.Col_clPlayers(Col_clRemotePlayerConnections("i" & lpstrArguments(0)).strPlayerKey).lPlayerControlFlags = Val(lpstrArguments(1)) |
127 |
|
128 |
End If |
129 |
|
130 |
End Select |
131 |
|
132 |
End If |
133 |
|
134 |
' Debug.Print clGame.Col_clPlayers("p" & lPlayerKey).lPlayerControlFlags |
135 |
|
136 |
End Sub |
137 |
|
138 |
Public Function SendData(ByRef clRemoteConnection As Class_RemotePlayerConnection, strData As String) As Boolean |
139 |
|
140 |
With Winsock_UDPSend |
141 |
|
142 |
.RemoteHost = clRemoteConnection.strHostname |
143 |
.RemotePort = clRemoteConnection.lHostPort |
144 |
|
145 |
.Close |
146 |
.Connect |
147 |
|
148 |
If .State = sckOpen Then |
149 |
|
150 |
.SendData strData |
151 |
' Debug.Print strData & "(-> " + .RemoteHost + ":" & .RemotePort & ")" |
152 |
|
153 |
SendData = True |
154 |
|
155 |
End If |
156 |
|
157 |
'BindLocalPort |
158 |
|
159 |
End With |
160 |
|
161 |
End Function |
162 |
|
163 |
Private Sub Winsock_UDPRecieve_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) |
164 |
|
165 |
ConPrint " network error![brk][brk]" |
166 |
|
167 |
End Sub |
168 |
|
169 |
Public Sub RemoveRemotePlayer(lPlayerID As String) |
170 |
|
171 |
Dim clRemoteConnection As Class_RemotePlayerConnection |
172 |
|
173 |
Set clRemoteConnection = Col_clRemotePlayerConnections("i" & lPlayerID) |
174 |
|
175 |
clGame.Col_clPlayers.Remove Col_clRemotePlayerConnections("i" & lPlayerID).strPlayerKey |
176 |
|
177 |
ConPrint " remote player timed out (pkey: " & Col_clRemotePlayerConnections("i" & lPlayerID).strPlayerKey & ")[brk][brk]" |
178 |
|
179 |
Col_clRemotePlayerConnections.Remove "i" & lPlayerID |
180 |
|
181 |
End Sub |
182 |
|
183 |
Private Function CreateRemotePlayer(strRemoteHost As String, lRemotePort As Long, lPlayerID As Long, strPlayerName As String) As Long |
184 |
|
185 |
Dim clPlayer As New Class_Player |
186 |
|
187 |
Dim clRemoteConnection As New Class_RemotePlayerConnection |
188 |
|
189 |
' ucPlayerSock.AcceptRequest lRequestID |
190 |
|
191 |
If lPlayerID >= 1000000000 Then |
192 |
|
193 |
If Not RemoteClientExist(strRemoteHost, lRemotePort, lPlayerID) Then |
194 |
|
195 |
With clRemoteConnection |
196 |
|
197 |
.strHostname = strRemoteHost |
198 |
.lHostPort = lRemotePort |
199 |
|
200 |
SendData clRemoteConnection, "ga " & lPlayerID & vbCrLf |
201 |
|
202 |
.lPlayerID = lPlayerID |
203 |
|
204 |
Set clPlayer = clPlayer.CreatePlayer(1, strPlayerName) |
205 |
|
206 |
clPlayer.lPlayerControlFlags = -1 |
207 |
clPlayer.lPlayerID = lPlayerID |
208 |
|
209 |
.lPlayerHandle = clGame.AddPlayer(clPlayer) |
210 |
.strPlayerKey = "p" & .lPlayerHandle |
211 |
|
212 |
CreateRemotePlayer = .lPlayerHandle |
213 |
|
214 |
End With |
215 |
|
216 |
Col_clRemotePlayerConnections.Add clRemoteConnection, "i" & lPlayerID |
217 |
|
218 |
ConPrint Const_strConsoleTextLineIndent + strPlayerName + " entered the game.[brk][brk]" |
219 |
|
220 |
Set clRemoteConnection = Nothing |
221 |
|
222 |
Col_clRemotePlayerConnections("i" & lPlayerID).lLastPacketTime = GetTickCount |
223 |
|
224 |
End If |
225 |
|
226 |
End If |
227 |
|
228 |
End Function |
229 |
|
230 |
Public Sub SendPlayerData() |
231 |
|
232 |
Dim clPlayer As Class_Player |
233 |
|
234 |
Dim l1 As Long |
235 |
Dim l2 As Long |
236 |
|
237 |
Dim clRemotePlayerConnection As Class_RemotePlayerConnection |
238 |
|
239 |
For l1 = 1 To Col_clRemotePlayerConnections.Count |
240 |
|
241 |
Set clRemotePlayerConnection = Col_clRemotePlayerConnections(l1) |
242 |
|
243 |
For l2 = 1 To clGame.Col_clPlayers.Count |
244 |
|
245 |
Set clPlayer = clGame.Col_clPlayers(l2) |
246 |
|
247 |
If clPlayer.lPlayerControlFlags <> -1 Then SendData clRemotePlayerConnection, "pr " & clPlayer.lPlayerID & " " & clPlayer.GetPosition.X & " " & clPlayer.GetPosition.Y & " " & clPlayer.GetPosition.Z & " " & clPlayer.sgAngleY & " " & -CInt(clPlayer.bOffroad) & vbCrLf |
248 |
|
249 |
Next l2 |
250 |
|
251 |
Next l1 |
252 |
|
253 |
End Sub |
254 |
|
255 |
Private Function BindLocalPort() |
256 |
|
257 |
With Winsock_UDPRecieve |
258 |
|
259 |
.Close |
260 |
.LocalPort = 27666 |
261 |
.Bind |
262 |
|
263 |
End With |
264 |
|
265 |
End Function |
266 |
|
267 |
Private Function RemoteClientExist(strRemoteHost As String, lRemotePort As Long, lPlayerID As Long) As Boolean |
268 |
|
269 |
Dim l As Long |
270 |
Dim clRemotePlayerConnection As Class_RemotePlayerConnection |
271 |
|
272 |
For l = 1 To Col_clRemotePlayerConnections.Count |
273 |
|
274 |
Set clRemotePlayerConnection = Col_clRemotePlayerConnections(l) |
275 |
|
276 |
If (clRemotePlayerConnection.lHostPort = lRemotePort And clRemotePlayerConnection.strHostname = strRemoteHost) Or lPlayerID = clRemotePlayerConnection.lPlayerID Then |
277 |
' If clRemotePlayerConnection.strHostname = strRemoteHost Then |
278 |
|
279 |
RemoteClientExist = True |
280 |
Exit For |
281 |
|
282 |
End If |
283 |
|
284 |
Next l |
285 |
|
286 |
End Function |
287 |
|