1 |
cvsrabit |
1.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 |
|
|
|