rabit/r3/Form_NetworkListen.frm

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form_NetworkListen 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "Network listener"
   ClientHeight    =   720
   ClientLeft      =   45
   ClientTop       =   285
   ClientWidth     =   1815
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   720
   ScaleWidth      =   1815
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer_ConnectionTimeout 
      Interval        =   100
      Left            =   870
      Top             =   210
   End
   Begin MSWinsockLib.Winsock Winsock_UDPSend 
      Left            =   480
      Top             =   150
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      Protocol        =   1
   End
   Begin MSWinsockLib.Winsock Winsock_UDPRecieve 
      Left            =   90
      Top             =   240
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      Protocol        =   1
   End
End
Attribute VB_Name = "Form_NetworkListen"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim Col_clRemotePlayerConnections As New Collection

Dim strDataBuffer As String
'

Private Sub Form_Load()

    ConPrint Const_strConsoleTextLineIndent + "opening port 27666 for remote connections.[brk][brk]"

    BindLocalPort

End Sub

Private Sub Timer_ConnectionTimeout_Timer()

Dim l As Long

Dim clRemotePlayerConnection As Class_RemotePlayerConnection

    For l = 1 To Col_clRemotePlayerConnections.Count
    
        Set clRemotePlayerConnection = Col_clRemotePlayerConnections(l)
        
        If clRemotePlayerConnection.lLastPacketTime > 0 And clRemotePlayerConnection.lLastPacketTime < GetTickCount - 4000 Then RemoveRemotePlayer clRemotePlayerConnection.lPlayerID
'        RemoveRemotePlayer clRemotePlayerConnection.lPlayerID

    Next l
    
End Sub

Private Sub Winsock_UDPRecieve_DataArrival(ByVal bytesTotal As Long)

Dim strRecievedData As String
Dim lCRLFPos As Long

    If Winsock_UDPRecieve.State = sckOpen Then

        Winsock_UDPRecieve.GetData strRecievedData
        
        strDataBuffer = strDataBuffer + strRecievedData
        
        lCRLFPos = InStr(1, strDataBuffer, vbCrLf)
        
        If lCRLFPos > 0 Then
        
            strRecievedData = Left(strDataBuffer, lCRLFPos - 1)
            strDataBuffer = Mid(strDataBuffer, lCRLFPos + 2)
    
            ParseData strRecievedData
            
        End If
    
    End If
    
'    ConPrint "  " & bytesTotal & " bytes recieved[brk][brk]"

End Sub

Private Sub ParseData(strData As String)

Dim lpstrArguments() As String

    If Len(strData) > 3 Then
    
        lpstrArguments = Split(Mid(strData, 4), " ")

        Select Case Left(strData, 2)
        
            Case "gr" ' Game request
            
                CreateRemotePlayer lpstrArguments(0), Val(lpstrArguments(1)), Val(lpstrArguments(2)), lpstrArguments(3)
                Debug.Print strData
                
            Case "cf"

                If Col_clRemotePlayerConnections.Count > 0 Then
                
                    Col_clRemotePlayerConnections("i" & lpstrArguments(0)).lLastPacketTime = GetTickCount
'                    Col_clRemotePlayerConnections(1).lLastPacketTime = GetTickCount
                    clGame.Col_clPlayers(Col_clRemotePlayerConnections("i" & lpstrArguments(0)).strPlayerKey).lPlayerControlFlags = Val(lpstrArguments(1))
        
                End If
        
        End Select
        
    End If
        
'    Debug.Print clGame.Col_clPlayers("p" & lPlayerKey).lPlayerControlFlags

End Sub

Public Function SendData(ByRef clRemoteConnection As Class_RemotePlayerConnection, strData As String) As Boolean
    
    With Winsock_UDPSend
    
        .RemoteHost = clRemoteConnection.strHostname
        .RemotePort = clRemoteConnection.lHostPort
        
        .Close
        .Connect
        
        If .State = sckOpen Then
        
            .SendData strData
'            Debug.Print strData & "(-> " + .RemoteHost + ":" & .RemotePort & ")"

            SendData = True
        
        End If

        'BindLocalPort

    End With

End Function

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)

    ConPrint "  network error![brk][brk]"

End Sub

Public Sub RemoveRemotePlayer(lPlayerID As String)

Dim clRemoteConnection As Class_RemotePlayerConnection

    Set clRemoteConnection = Col_clRemotePlayerConnections("i" & lPlayerID)

    clGame.Col_clPlayers.Remove Col_clRemotePlayerConnections("i" & lPlayerID).strPlayerKey
    
    ConPrint "  remote player timed out (pkey: " & Col_clRemotePlayerConnections("i" & lPlayerID).strPlayerKey & ")[brk][brk]"

    Col_clRemotePlayerConnections.Remove "i" & lPlayerID
    
End Sub

Private Function CreateRemotePlayer(strRemoteHost As String, lRemotePort As Long, lPlayerID As Long, strPlayerName As String) As Long

Dim clPlayer As New Class_Player

Dim clRemoteConnection As New Class_RemotePlayerConnection
    
'    ucPlayerSock.AcceptRequest lRequestID
    
    If lPlayerID >= 1000000000 Then
    
        If Not RemoteClientExist(strRemoteHost, lRemotePort, lPlayerID) Then
    
            With clRemoteConnection
                
                .strHostname = strRemoteHost
                .lHostPort = lRemotePort
                
                SendData clRemoteConnection, "ga " & lPlayerID & vbCrLf
            
                .lPlayerID = lPlayerID
                
                Set clPlayer = clPlayer.CreatePlayer(1, strPlayerName)
                
                clPlayer.lPlayerControlFlags = -1
                clPlayer.lPlayerID = lPlayerID
                
                .lPlayerHandle = clGame.AddPlayer(clPlayer)
                .strPlayerKey = "p" & .lPlayerHandle
                
                CreateRemotePlayer = .lPlayerHandle
                
            End With
            
            Col_clRemotePlayerConnections.Add clRemoteConnection, "i" & lPlayerID
        
            ConPrint Const_strConsoleTextLineIndent + strPlayerName + " entered the game.[brk][brk]"
        
            Set clRemoteConnection = Nothing

            Col_clRemotePlayerConnections("i" & lPlayerID).lLastPacketTime = GetTickCount

        End If

    End If

End Function

Public Sub SendPlayerData()

Dim clPlayer As Class_Player

Dim l1 As Long
Dim l2 As Long

Dim clRemotePlayerConnection As Class_RemotePlayerConnection

    For l1 = 1 To Col_clRemotePlayerConnections.Count
    
        Set clRemotePlayerConnection = Col_clRemotePlayerConnections(l1)
        
        For l2 = 1 To clGame.Col_clPlayers.Count
        
            Set clPlayer = clGame.Col_clPlayers(l2)
        
            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
        
        Next l2
        
    Next l1

End Sub

Private Function BindLocalPort()

    With Winsock_UDPRecieve
    
        .Close
        .LocalPort = 27666
        .Bind

    End With

End Function

Private Function RemoteClientExist(strRemoteHost As String, lRemotePort As Long, lPlayerID As Long) As Boolean

Dim l As Long
Dim clRemotePlayerConnection As Class_RemotePlayerConnection

    For l = 1 To Col_clRemotePlayerConnections.Count
    
        Set clRemotePlayerConnection = Col_clRemotePlayerConnections(l)
    
        If (clRemotePlayerConnection.lHostPort = lRemotePort And clRemotePlayerConnection.strHostname = strRemoteHost) Or lPlayerID = clRemotePlayerConnection.lPlayerID Then
'        If clRemotePlayerConnection.strHostname = strRemoteHost Then
        
            RemoteClientExist = True
            Exit For
        
        End If
    
    Next l

End Function

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
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26