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