« back to all changes in this revision
Viewing changes to src/cls/kse_Net.bas
- browse files at revision 473
- compare with another revision
- download diff
- download tarball
- view history from revision 473
- Committer: creek23
- Date: 2017-09-09 06:35:49 UTC
- Revision ID: svn-v4:5d579d6f-57a3-4165-9b1e-6dacaf8da75a:quixie:674
first attempt to make it compilable
- files modified:
- src/cls/kse_Array.cpp
added
removed
src/cls/kse_Net.bas
1
1
2
2
#Include Once "kageExterns.bi"
3
3
4
Declare Sub ServerThread(ByVal As Any Ptr)
5
6
#Define MAX_CLIENTS 32
7
8
Type CLIENT
9
As FDSOCKET hClient
10
As Any Ptr hThread
11
As Integer blnExit
12
End Type
13
'todo: make client array size resizable (ReDim)
14
Dim Shared As CLIENT Clients(MAX_CLIENTS-1)
15
Dim Shared As Integer g_clientCtr
16
17
Dim Shared As FDSOCKET hEngineConn
18
Dim Shared As SOCKADDR_IN Server, Client
19
Dim Shared As Integer g_ret, addrsize, g_index
20
Dim Shared As String net_sMsg
21
Dim Shared As String net_statMsg
22
Dim Shared As String net_errMsg
23
Dim Shared As Integer bNetConnState
24
25
Const MSG_TYPE_EXIT = 101
26
Const MSG_TYPE_SERVERFULL = 102
27
28
Const MSG_INDEX_TYPE = 0
29
Const MSG_INDEX_SENDER = 1
30
Const MSG_INDEX_RECEIVER = 2
31
Const MSG_INDEX_MESSAGE = 3
32
33
Enum NETCONN_STATE
34
NETCONN_CLOSE = 0 ' Uninitialized.
35
NETCONN_INIT = 1 ' Connection is initialized
36
NETCONN_OPEN = 2 ' Connection is currently in use
37
NETCONN_EXIT = 3 ' Force exit Connection
38
End Enum
39
40
Sub Engine_ServerStart(pAny As Any Ptr)
41
Server.sin_addr = INADDR_ANY
42
g_ret = NetBind(hEngineConn, @Server, SizeOf(SOCKADDR_IN))
43
If g_ret < 0 Then
44
Engine_Log "Socket Port-bind Error", 1
45
bNetConnState = NETCONN_CLOSE
46
Exit Sub
47
End If
48
49
g_ret = NetListen(hEngineConn, 3)
50
If g_ret < 0 Then
51
Engine_Log "Socket Listen Error", 1
52
bNetConnState = NETCONN_CLOSE
53
Exit Sub
54
End If
55
Dim As Integer l_clientMax = Cast(Integer, pAny) - 1 '1 is reserved for server
56
g_clientCtr = 0
57
bNetConnState = NETCONN_OPEN
58
While bNetConnState <> NETCONN_EXIT
59
addrsize = SizeOf(SOCKADDR_IN)
60
'If g_clientCtr < l_clientMax Then
61
'g_ret = NetAccept(hEngineConn, @Client, @addrsize)
62
g_ret = NetAccept(hEngineConn, 0, 0)
63
64
If g_ret > -1 Then
65
net_statMsg = "server: accept"
66
If g_clientCtr < (MAX_CLIENTS - 1) Then
67
' get next free client
68
g_index = 0
69
While Clients(g_index).hClient <> 0
70
g_index += 1
71
Wend
72
Clients(g_index).hClient = g_ret
73
Clients(g_index).hThread = ThreadCreate(@Engine_ServerStartThread, Cast(Any Ptr, g_index))
74
g_clientCtr += 1
75
net_statMsg = "server: connections=" & Str(g_clientCtr)
76
Else
77
net_errMsg = "Server Full Error"
78
Engine_Log net_errMsg, 1
79
Engine_Send(net_errMsg, MSG_TYPE_SERVERFULL)
80
End If
81
ElseIf g_ret = WSAEWOULDBLOCK Then
82
'it's okay
83
ElseIf g_ret = -1 Then
84
'possible case:
85
' * engine closed
86
' * TODO: list as you go along
87
Else
88
Engine_Log "g_ret " & g_ret, 1
89
net_errMsg = "Server Accept Error"
90
Engine_Log net_errMsg, 1
91
bNetConnState = NETCONN_EXIT
92
End If
93
'EndIf
94
95
Sleep 2
96
Wend
97
98
bNetConnState = NETCONN_CLOSE
99
100
net_statMsg = "Server Close"
101
End Sub
102
103
' for use by Engine_ServerStart
104
Sub Engine_ServerStartThread(ByVal lpany As Any Ptr)
105
Dim As Integer l_ret, l_index = Cast(Integer, lpAny)
106
Dim sData As String
107
Dim sDataCopy As String
108
Dim bData As Byte
109
Dim sMsg() As String
110
Dim sMsgTrim() As String
111
Dim i As Integer
112
Dim lngMsgType As Long 'A value indicating the type of message this is
113
net_statMsg = "connected client(" & l_index & ")"
114
Clients(l_index).blnExit = 0
115
While Clients(l_index).blnExit = 0 Or bNetConnState <> NETCONN_EXIT
116
l_ret = NetReceiveString(Clients(l_index).hClient, sData)
117
If l_ret < 1 Then
118
'sData = "thread: l_ret<1"
119
'Clients(l_index).blnExit = 1
120
Else
121
Engine_Log "sData " & sData, 1
122
sDataCopy = sData
123
124
While sData <> ""
125
Split sData, Chr(2), sMsg()
126
127
Split sMsg(MSG_INDEX_MESSAGE), Chr(3), sMsgTrim()
128
129
sMsg(MSG_INDEX_MESSAGE) = sMsgTrim(0)
130
131
lngMsgType = CLng(sMsg(MSG_INDEX_TYPE))
132
133
If lngMsgType > 2400 Then
134
bData = 1
135
lngMsgType = lngMsgType - 2400
136
EndIf
137
138
If CLng(sMsg(MSG_INDEX_RECEIVER)) = 0 Or CLng(sMsg(MSG_INDEX_RECEIVER)) = kseNet.playerID Then
139
sData = sMsg(MSG_INDEX_SENDER) & Chr(2) & sMsg(MSG_INDEX_MESSAGE) 'removed sMsg(2); message is for receiver
140
'TODO: get sender info; lngMsgType should be the index of the user who sent data/msg
141
If bData Then
142
sNetData = sNetData & kseVARSEPARATOR & "KSNET" & kseVALUESEP & lngMsgType & Chr(2) & sData
143
Engine_NetDataPush(lngMsgType, CInt(sMsg(MSG_INDEX_SENDER)), kseNet.playerID, sMsg(MSG_INDEX_MESSAGE))
144
Else
145
sNetMsg = sNetMsg & kseVARSEPARATOR & "KSNET" & kseVALUESEP & lngMsgType & Chr(2) & sData
146
Engine_NetDataPush(lngMsgType, CInt(sMsg(MSG_INDEX_SENDER)), kseNet.playerID, sMsg(MSG_INDEX_MESSAGE))
147
End If
148
EndIf
149
150
151
'TODO: only send copies to fellow Clients every once in a while -- not always
152
If CInt(sMsg(MSG_INDEX_TYPE)) <> MSG_TYPE_EXIT Then
153
For i = 0 To MAX_CLIENTS - 1
154
If Clients(i).hThread <> 0 And i <> l_index Then
155
Engine_Send(sMsg(MSG_INDEX_MESSAGE), CInt(sMsg(MSG_INDEX_TYPE)),Clients(i).hClient) ' 4 is _3 Chr(2) and 1 Chr(3)_
156
End If
157
Next
158
End If
159
160
If iGotMessage > 0 Then kseFunction(iGotMessage).RunScript()
161
162
sData = Mid(sDataCopy, _
163
Len(sMsg(MSG_INDEX_TYPE)) + _
164
Len(sMsg(MSG_INDEX_SENDER)) + _
165
Len(sMsg(MSG_INDEX_RECEIVER)) + _
166
Len(sMsg(MSG_INDEX_MESSAGE)) + 5) ' 3 Chr(2) and 1 Chr(3) and 1 offset
167
168
sDataCopy = sData
169
Wend
170
171
net_statMsg = "thread:(" & Str(l_index) &") got a message " & sData
172
If InStr(sData,"exit") Then
173
Clients(l_index).blnExit = 1
174
NetClose Clients(l_index).hClient
175
bNetConnState = NETCONN_EXIT
176
' Else
177
' net_statMsg = "thread:(" & Str(l_index) &") send ok"
178
' Engine_Send("ok", 102,Clients(l_index).hClient)
179
End If
180
End If
181
Wend
182
net_statMsg = "disconnected client(" & l_index & ")"
183
NetClose Clients(l_index).hClient
184
Clients(l_index).hClient = 0
185
g_clientCtr -= 1
186
End Sub
187
188
Sub Engine_ClientStart(pAny As Any Ptr)
189
Dim As Integer l_ret
190
Dim sData As String
191
Dim sDataCopy As String
192
Dim bData As Byte
193
Dim sMsgTrim() As String
194
Dim sMsg() As String
195
Dim lngMsgType As Long 'A value indicating the type of message this is
196
bNetConnState = NETCONN_OPEN
197
While bNetConnState <> NETCONN_CLOSE
198
'ChiSock
199
' kseNet.sockMain.get(sData)
200
'fbNet
201
l_ret = NetReceiveString(hEngineConn, sData)
202
If (l_ret < 0) Then
203
'bNetConnState = NETCONN_EXIT
204
Else
205
Engine_Log "sData " & sData, 1
206
sDataCopy = sData
207
While sData <> ""
208
Split sData, Chr(2), sMsg()
209
210
Split sMsg(MSG_INDEX_MESSAGE), Chr(3), sMsgTrim()
211
212
sMsg(MSG_INDEX_MESSAGE) = sMsgTrim(0)
213
214
lngMsgType = CLng(sMsg(MSG_INDEX_TYPE))
215
216
If lngMsgType > 2400 Then
217
bData = 1
218
lngMsgType = lngMsgType - 2400
219
EndIf
220
221
If CLng(sMsg(MSG_INDEX_RECEIVER)) = 0 Or CLng(sMsg(MSG_INDEX_RECEIVER)) = kseNet.playerID Then
222
sData = sMsg(MSG_INDEX_SENDER) & Chr(2) & sMsg(MSG_INDEX_MESSAGE) 'removed sMsg(2); message is for receiver
223
'TODO: get sender info; lngMsgType should be the index of the user who sent data/msg
224
If bData Then
225
sNetData = sNetData & kseVARSEPARATOR & "KSNET" & kseVALUESEP & lngMsgType & Chr(2) & sData
226
Engine_NetDataPush(lngMsgType, CInt(sMsg(MSG_INDEX_SENDER)), kseNet.playerID, sMsg(MSG_INDEX_MESSAGE))
227
Else
228
sNetMsg = sNetMsg & kseVARSEPARATOR & "KSNET" & kseVALUESEP & lngMsgType & Chr(2) & sData
229
Engine_NetDataPush(lngMsgType, CInt(sMsg(MSG_INDEX_SENDER)), kseNet.playerID, sMsg(MSG_INDEX_MESSAGE))
230
End If
231
EndIf
232
233
sData = Mid(sDataCopy, _
234
Len(sMsg(MSG_INDEX_TYPE)) + _
235
Len(sMsg(MSG_INDEX_SENDER)) + _
236
Len(sMsg(MSG_INDEX_RECEIVER)) + _
237
Len(sMsg(MSG_INDEX_MESSAGE)) + 5) ' 3 Chr(2) and 1 Chr(3) and 1 offset
238
239
sDataCopy = sData
240
241
If CInt(sMsg(MSG_INDEX_TYPE)) = MSG_TYPE_EXIT Then
242
If iGotDisconnected > 0 Then kseFunction(iGotDisconnected).RunScript()
243
Else
244
If iGotMessage > 0 Then kseFunction(iGotMessage).RunScript()
245
EndIf
246
Wend
247
End If
248
Wend
249
End Sub
250
4
251
''
5
252
' Used by engine for parsing and interpreting
6
253
'
36
283
' @remarks If you plan to implement KonsolScript in other language (C/C++), use linked list instead.
37
284
Dim Shared sNetData As String
38
285
286
Dim Shared kseNetData() As typeNetData
287
Dim Shared kseNetData_count As Long
288
39
289
''
40
290
' Parses and interprets KonsolScript's <b>Net</b> functions.
41
291
'
57
307
' <li><b><a href="modKONSoL_Net.NetGetData.html">GetData</a></b> - retrieves one queued data at a time.
58
308
' </ul>
59
309
'</div>
60
Public Function SynNet(iIndex As Integer) As Integer
310
Public Function SynNet(iIndex As Long) As Integer
61
311
iIndex = GetNearestTokenIndex(kseCOLON, "Net", iIndex) 'look for :
62
312
iIndex = GetNextIndex(iIndex)
63
313
Select Case kseToken(iIndex).sToken
102
352
' Net:Quit()
103
353
' </pre>
104
354
'</div>
105
Private Function NetQuit(iIndex As Integer) As Integer
355
Private Function NetQuit(iIndex As Long) As Integer
106
356
iIndex = Net_SkipOpenParenthesisAfter("Quit", iIndex)
107
iIndex = Net_SkipCloseParenthesisAfter("source", iIndex)
357
iIndex = Net_SkipCloseParenthesisAfter("(", iIndex)
108
358
'EXECUTE SCRIPT ========================================
109
If kseNet.sockMain.Close() <> chi.SOCKET_OK Then
110
'TODO: uninitialize connection object
111
kseNet.Connected = 0
112
kseNet.sockMain.close()
113
EndIf
359
'ChiSock
360
' If kseNet.sockMain.Close() <> chi.SOCKET_OK Then
361
' 'TODO: uninitialize connection object
362
' kseNet.Connected = 0
363
' EndIf
364
Engine_NetQuit
365
114
366
Return iIndex
115
367
End Function
116
368
142
394
' </pre>
143
395
' <b>Parameter : </b>
144
396
'</div>
145
Private Function NetHost(iIndex As Integer) As Integer
397
Private Function NetHost(iIndex As Long) As Integer
146
398
Dim iBool As Integer
147
399
Dim sess_name As String
148
400
Dim pName As String
149
Dim iVal As Integer
401
Dim iMaxPlayer As Integer
150
402
151
403
iIndex = Net_SkipOpenParenthesisAfter("Host", iIndex)
152
404
154
406
155
407
iIndex = Net_SkipCommaAfter("host_player_name", iIndex)
156
408
157
iVal = KSE_GetTokenNumValueOf(iIndex)
409
iMaxPlayer = KSE_GetTokenNumValueOf(iIndex)
158
410
159
411
iIndex = Net_SkipCommaAfter("max_members", iIndex)
160
412
169
421
'EXECUTE SCRIPT ========================================
170
422
With kseNet
171
423
.playerName = pName
172
.hMaxplayer = iVal
424
.hMaxplayer = iMaxPlayer
173
425
.hSessName = sess_name
174
426
175
427
If Engine_Host() = 1 Then
176
428
SetBoolValue iBool, 1
177
.Connected = 1
178
429
Else
179
430
SetBoolValue iBool, 0
180
.Connected = 0
181
431
End If
182
432
End With
183
433
193
443
'<div class="KS">
194
444
' <b>KonsolScript Users:</b><br>
195
445
' <br><b>Description:</b><br>
196
' Placing <b>Net:Check</b> on a loop will repeatedly monitor our connection. In case someone sent a message, the it fires the <b>_onReceive</b> listener function.
446
' Placing <b>Net:Check</b> on a loop will repeatedly monitor our connection. In case someone sent a message, then it fires the <b>_onReceive</b> listener function.
197
447
' <br><br><b>Parameters:</b><br>
198
448
' <ul>
199
449
' <li>None.
207
457
' }
208
458
'</pre>
209
459
'</div>
210
Private Function NetCheck(iIndex As Integer) As Integer
460
Private Function NetCheck(iIndex As Long) As Integer
211
461
iIndex = Net_SkipOpenParenthesisAfter("Check", iIndex)
212
462
iIndex = Net_SkipCloseParenthesisAfter("(", iIndex)
213
463
'EXECUTE SCRIPT ===================================
214
If kseNet.Connected = 1 Then Engine_CheckConnection()
464
On Error GoTo ptrErr
465
'ChiSock
466
' If kseNet.Connected = 1 Then Engine_CheckConnection()
215
467
216
468
Return iIndex
469
ptrErr:
470
trace("Failed at Net:Check")
217
471
End Function
218
472
219
473
''
231
485
' <ul>
232
486
' <li>String <b>client_player_name</b> - name to use in the network game.
233
487
' <li>String <b>session_name</b> - name of the session to join at.
234
' <li>String <b>host_pc_name</b> - name (or IP) of the computer hosting a network game.
488
' <li>String <b>host_pc</b> - name or IP of the computer hosting a network game.
235
489
' <li>Boolean <b>return</b> - a return variable that will have a value depending on the success of attempting to join a network.
236
490
' </ul>
237
491
' <b>Usage:</b><br>
238
492
' <pre>
239
493
' Var:Boolean got_connection;
240
' Net:Join("im_a_client", "my_session", "host_pc_name",got_connection)
494
' Net:Join("im_a_client", "my_session", "host_pc", got_connection)
241
495
' while (got_connection EQ true) {
242
496
' Net:Check()
243
497
' }
244
498
' </pre>
245
499
'</div>
246
Private Function NetJoin(iIndex As Integer) As Integer
500
Private Function NetJoin(iIndex As Long) As Integer
247
501
Dim iBool As Integer
248
502
Dim pName As String
249
503
Dim session_name As String
272
526
.playerName = pName
273
527
.hSessName = session_name
274
528
.IP = host_name
275
.Hosting = 0
276
529
If Engine_Join(host_name, kseNET_PORT) Then
277
530
SetBoolValue iBool, 1
278
.Connected = 1
279
531
Else
280
532
SetBoolValue iBool, 0
281
.Connected = 0
282
533
End If
283
534
End With
284
535
Return iIndex
309
560
' }
310
561
' </pre>
311
562
'</div>
312
Private Function NetSend(iIndex As Integer) As Integer
563
Private Function NetSend(iIndex As Long) As Integer
313
564
Dim sMsg As String
314
565
Dim iBool As Integer
315
566
iIndex = Net_SkipOpenParenthesisAfter("Send", iIndex)
323
574
324
575
iIndex = Net_SkipCloseParenthesisAfter("return", iIndex)
325
576
'EXECUTE SCRIPT ========================================
326
SetBoolValue iBool, Engine_Send(sMsg, 100)
577
578
If kseNet.Hosting = 1 Then
579
Dim i As Integer
580
For i = 0 To MAX_CLIENTS - 1
581
If Clients(i).hThread <> 0 Then
582
Engine_Send(sMsg, 100,Clients(i).hClient) ' 4 is _3 Chr(2) and 1 Chr(3)_
583
End If
584
Next
585
Else
586
SetBoolValue iBool, Engine_Send(sMsg, 100)
587
EndIf
327
588
328
589
Return iIndex
329
590
End Function
354
615
' }
355
616
' </pre>
356
617
'</div>
357
Private Function NetSendTo(iIndex As Integer) As Integer
618
Private Function NetSendTo(iIndex As Long) As Integer
358
619
Dim sMsg As String
359
620
Dim player_name As String
360
621
Dim iBool As Integer
413
674
' }
414
675
' </pre>
415
676
'</div>
416
Private Function NetGetMessage(iIndex As Integer) As Integer
677
Private Function NetGetMessage(iIndex As Long) As Integer
417
678
Dim sMsg As String
418
679
Dim iPlr As Integer
419
680
Dim iMsg As Integer
436
697
437
698
iIndex = Net_SkipCloseParenthesisAfter("return", iIndex)
438
699
'EXECUTE SCRIPT ========================================
439
Dim sDataRaw() As String
440
Dim sData() As String
441
Dim sMsgs() As String
442
443
700
SetStrValue iPlr, ""
444
701
SetStrValue iMsg, ""
445
702
SetBoolValue iBool, 0
703
On Error GoTo ptrErr
704
If kseNetData_count > 0 Then
705
Dim tmpNetData As typeNetData
706
tmpNetData = Engine_NetDataPop()
707
SetStrValue iPlr, Str(tmpNetData.fromID)
708
SetStrValue iMsg, tmpNetData.content
709
SetBoolValue iBool, 1
710
EndIf
711
/'
712
Dim sDataRaw() As String
713
Dim sData() As String
714
Dim sMsgs() As String
446
715
447
716
Split sNetMsg, kseVARSEPARATOR, sDataRaw()
448
717
If UBound(sDataRaw) > 0 Then
449
718
If sDataRaw(1) <> "" Then
450
719
Split sDataRaw(1), kseVALUESEP, sData()
451
720
If sData(0) <> "" Or sData(0) = "KSNET" Then
452
Split sData(1), "^", sMsgs()
721
Split sData(1), Chr(2), sMsgs()
453
722
If UBound(sMsgs) > 0 Then
454
723
SetStrValue iPlr, sMsgs(1)
455
724
SetStrValue iMsg, sMsgs(2)
460
729
End If
461
730
End If
462
731
End If
463
732
'/
464
733
Return iIndex
734
ptrErr:
735
trace("Failed at Net:GetMessage")
465
736
End Function
466
737
467
738
''
490
761
' }
491
762
' </pre>
492
763
'</div>
493
Private Function NetSendData(iIndex As Integer) As Integer
764
Private Function NetSendData(iIndex As Long) As Integer
494
765
Dim sMsg As String
495
Dim iCode As Long
766
Dim iCode As Double
496
767
Dim iBool As Integer
497
768
iIndex = Net_SkipOpenParenthesisAfter("SendData", iIndex)
498
769
510
781
iIndex = Net_SkipCloseParenthesisAfter("return", iIndex)
511
782
'EXECUTE SCRIPT ========================================
512
783
If iCode > 0 Then
513
SetBoolValue iBool, Engine_Send(sMsg, iCode + 2400)
784
'SetBoolValue(iBool, Engine_Send(sMsg, iCode + 2400)) 'original
785
SetBoolValue(iBool, Engine_Send(sMsg, CLng(Str(iCode + 2400)))) 'stupid code just to let FBC generate C codes
514
786
Else
515
787
SetBoolValue iBool, 0
516
788
End If
565
837
' }
566
838
' </pre>
567
839
'</div>
568
Private Function NetGetData(iIndex As Integer) As Integer
840
Private Function NetGetData(iIndex As Long) As Integer
569
841
Dim sMsg As String
570
842
Dim iPlr As Integer
571
843
Dim iCode As Integer
603
875
Split sData(1), kseVALUESEP, sMsgRaw()
604
876
605
877
If sMsgRaw(1) <> "" Then
606
Split sMsgRaw(1), "^", sMsgs()
878
Split sMsgRaw(1), Chr(2), sMsgs()
607
879
608
880
If sMsgs(0) <> "" Then
609
881
SetStrValue iPlr, sMsgs(0)
631
903
'<div class="KS">
632
904
' <b>KonsolScript Users:</b><br>
633
905
' <br><b>Description:</b><br>
634
' Retrieves all client's name in an array.
906
' Retrieves all client's name in a comma-separated string.
635
907
' <br><br><b>Parameters:</b><br>
636
908
' <ul>
637
' <li>String <b>message</b> - message to send.
638
' <li>Boolean <b>return</b> - returns <b>true</b> if message was successfully sent, and <b>false</b> otherwise.
909
' <li>String <b>return</b> - contains comma-separated player names.
639
910
' </ul>
640
911
' <b>Usage:</b><br>
641
912
' <pre>
642
913
' Var:Boolean sent;
643
' Array:New playerList[1];//initialize it with 1
914
' Var:String playerList;
644
915
' //after successful hosting/joining a game
645
' Net:ListClientName("Hello!", playerList)
646
' if (sent EQ true) {
647
' Konsol:Log("Message sent")
648
' }
916
' Net:ListClientName(playerList)
649
917
' </pre>
650
918
'</div>
651
Private Function NetListClientName(iIndex As Integer) As Integer
652
Dim iArr As Integer
919
Private Function NetListClientName(iIndex As Long) As Integer
920
Dim iStr As Integer
653
921
iIndex = Net_SkipOpenParenthesisAfter("ListClientName", iIndex)
654
922
iIndex = GetNextIndex(iIndex)
655
iArr = iIndex
923
iStr = iIndex
656
924
iIndex = Net_SkipCloseParenthesisAfter("return", iIndex)
657
925
'EXECUTE SCRIPT ========================================
658
'set arrays value with the player-list
659
'iArr
926
'set string-value with the comma-separated-player_name
660
927
Return iIndex
661
928
End Function
662
929
667
934
' @param iIndex - Index of the parsed script
668
935
' @return New index value of the parsed script.
669
936
' @remarks Benchmark if organizing is worth the speed.
670
Private Function Net_SkipOpenParenthesisAfter(sWhat As String, iIndex As Integer) As Integer
937
Private Function Net_SkipOpenParenthesisAfter(sWhat As String, iIndex As Long) As Integer
671
938
cNetTxt = "Net:" & sWhat
672
939
Return KSE_SkipOpenParenthesisAfter(cNetTxt, iIndex)
673
940
End Function
679
946
' @param iIndex - Index of the parsed script
680
947
' @return New index value of the parsed script.
681
948
' @remarks Benchmark if organizing is worth the speed.
682
Private Function Net_SkipCommaAfter(sWhat As String, iIndex As Integer) As Integer
949
Private Function Net_SkipCommaAfter(sWhat As String, iIndex As Long) As Integer
683
950
cNetTxt = cNetTxt & sWhat
684
951
iIndex = KSE_SkipCommaAfter(cNetTxt, iIndex)
685
952
cNetTxt = cNetTxt & ", "
693
960
' @param iIndex - Index of the parsed script
694
961
' @return New index value of the parsed script.
695
962
' @remarks Benchmark if organizing is worth the speed.
696
Private Function Net_SkipCloseParenthesisAfter(sWhat As String, iIndex As Integer) As Integer
963
Private Function Net_SkipCloseParenthesisAfter(sWhat As String, iIndex As Long) As Integer
697
964
cNetTxt = cNetTxt & sWhat
698
965
iIndex = KSE_SkipCloseParenthesisAfter(cNetTxt, iIndex)
699
966
cNetTxt = ""
847
1114
' 'DPLSYS_NEWSESSIONHOST = 9
848
1115
' 'DPLSYS_NEWCONNECTIONSETTINGS = 10
849
1116
' End Select
850
' 'If not sent by system, this must be a application-defined message
1117
' 'If not sent by system, this must be an application-defined message
851
1118
' Else
852
1119
' 'Take action depending on the type of application message
853
1120
' Select Case lngMsgType
877
1144
'ptrErr:
878
1145
' Engine_Log "Warning: Net is not initialized"
879
1146
'/
880
If kseNet.sockMain.is_closed() = TRUE then
881
kseNet.Connected = 0
882
Else
883
Dim MSG_INDEX_TYPE As Integer
884
Dim MSG_INDEX_SENDER As Integer
885
Dim MSG_INDEX_RECEIVER As Integer
886
Dim MSG_INDEX_MESSAGE As Integer
887
888
MSG_INDEX_TYPE = 0
889
MSG_INDEX_SENDER = 1
890
MSG_INDEX_RECEIVER = 2
891
MSG_INDEX_MESSAGE = 3
892
893
Dim bData As Byte
894
Dim sData As String
895
Dim sMsg() As String
896
kseNet.sockMain.get(sData)
897
If sData <> "" Then
898
Split sData, "^", sMsg()
899
900
lngMsgType = CLng(sMsg(MSG_INDEX_TYPE))
901
902
If lngMsgType > 2400 Then
903
bData = 1
904
lngMsgType = lngMsgType - 2400
905
EndIf
906
907
If CLng(sMsg(MSG_INDEX_RECEIVER)) = 0 Or CLng(sMsg(MSG_INDEX_RECEIVER)) = kseNet.playerID Then
908
sData = sMsg(MSG_INDEX_SENDER) & "^" & sMsg(MSG_INDEX_MESSAGE) 'removed sMsg(2); message is for receiver
909
'TODO: push new data in ring-like array; like the gun revolver
910
'get sender info
911
'lngMsgType should be the index of the user who sent data/msg
912
If bData Then
913
sNetData = sNetData & kseVARSEPARATOR & "KSNET" & kseVALUESEP & lngMsgType & "^" & sData
914
Else
915
sNetMsg = sNetMsg & kseVARSEPARATOR & "KSNET" & kseVALUESEP & lngMsgType & "^" & sData
916
End If
917
EndIf
918
Else
919
lngMsgType = 0
920
EndIf
921
922
Exit Sub
923
End If
1147
'TODO: to be called from Threads as per fbNet implementation
1148
'ChiSock
1149
' If kseNet.sockMain.is_closed() = TRUE then
1150
' kseNet.Connected = 0
1151
' Else
1152
' '
1153
' Exit Sub
1154
' End If
924
1155
End Sub
925
1156
926
1157
''
930
1161
' @remarks This is called by engine through <b>Net:Host</b>.
931
1162
Private Function Engine_Host() As Byte
932
1163
' Dim oSessionData As DirectPlaySessionData 'How is the session described?
1164
kseNet.Connected = 0
1165
kseNet.Hosting = 1
1166
933
1167
Engine_InitConnectionList()
934
If Engine_InitConnection() = 0 Then Exit Function
1168
If Engine_InitConnection() = 0 Then Return 0
935
1169
936
1170
'' Set oSessionData = DPLAY.CreateSessionData
937
1171
'' oSessionData.SetMaxPlayers IIf(kseNet.hMaxplayer < 2, 2, kseNet.hMaxplayer)
943
1177
' Call DPLAY.Open(oSessionData, DPOPEN_CREATE)
944
1178
' 'add host in this session -- assign name
945
1179
' kseNet.playerID = DPLAY.CreatePlayer(kseNet.playerName, "", 0, 0)
946
Dim iStat As Integer
947
948
1180
kseNet.hMaxplayer = IIf(kseNet.hMaxplayer < 2, 2, kseNet.hMaxplayer)
949
950
iStat = kseNet.sockMain.UDP_server(kseNET_PORT)
951
If ( iStat ) Then
952
'print translate_error( iStat )
953
Engine_Log "Socket unavailable", 1
954
EndIf
955
956
iStat = kseNet.sockMain.UDP_server(kseNET_PORT, kseNet.hMaxplayer)
957
If ( iStat ) Then
958
Engine_Log "Unavailable to open socket", 1
959
EndIf
960
1181
Dim As Any Ptr threadMain = ThreadCreate(@Engine_ServerStart, Cast(Any Ptr, kseNet.hMaxplayer))
1182
While bNetConnState = NETCONN_INIT
1183
Sleep 1 'wait for engine to fully open or close-due-to-error
1184
Wend
1185
If bNetConnState = NETCONN_CLOSE Then
1186
Return 0
1187
EndIf
961
1188
kseNet.Connected = 1
962
kseNet.Hosting = 1
1189
'ChiSock
1190
' l_ret = kseNet.sockMain.UDP_server(kseNET_PORT)', kseNet.hMaxplayer
1191
' If ( l_ret ) Then
1192
' 'print translate_error( iStat )
1193
' Engine_Log "Socket unavailable", 1
1194
' EndIf
963
1195
964
1196
Return 1
965
1197
End Function
966
1198
1199
Private Sub Engine_NetQuit()
1200
If bNetConnState <> NETCONN_CLOSE Then
1201
If kseNet.Hosting = 1 Then
1202
'if server
1203
bNetConnState = NETCONN_EXIT
1204
' While bNetConnState <> NETCONN_CLOSE
1205
Sleep 1
1206
' Wend
1207
1208
Dim i As Integer
1209
If g_clientCtr > 0 Then
1210
For i = 0 To MAX_CLIENTS - 1
1211
Clients(i).blnExit = 1
1212
Next
1213
End If
1214
1215
For i = 0 To MAX_CLIENTS - 1
1216
If Clients(i).hThread <> 0 Then
1217
If Clients(i).hThread <> 0 Then
1218
Engine_Send("", MSG_TYPE_EXIT, Clients(i).hClient)
1219
NetClose Clients(i).hClient
1220
EndIf
1221
ThreadWait(Clients(i).hThread)
1222
End If
1223
Next
1224
Else
1225
'if client
1226
Engine_Send("", MSG_TYPE_EXIT, hEngineConn)
1227
1228
EndIf
1229
NetClose hEngineConn
1230
' bNetConnState = NETCONN_CLOSE
1231
EndIf
1232
End Sub
1233
967
1234
''
968
1235
' (<b>Dev API</b>) Joins a server.
969
1236
'
970
' @return Returns <b>True</b> if successfully joined a game, and <b>False</b>, otherwise.
1237
' @return Returns <b>1</b> if successfully joined a game, and <b>0</b>, otherwise.
971
1238
' @remarks This is called by engine through <b>Net:Join</b>.
972
1239
Private Function Engine_Join(serverName As String, port As Integer) As Byte
1240
kseNet.Connected = 0
1241
kseNet.Hosting = 0
1242
1243
If Engine_InitConnection() = 0 Then Return 0
1244
973
1245
Dim serverIP As Integer
974
1246
serverIP = Engine_ParseIP(serverName)
1247
Engine_Log "serverIP " & serverIP,1
975
1248
If serverIP = 0 Then
976
1249
'is it the server's computer name?
977
If kseNet.sockMain.UDP_client(serverName, port) <> chi.SOCKET_OK Then
978
Return 0
979
Else
980
'TODO: register client to host then get host info
981
Return 1
982
EndIf
1250
'ChiSock
1251
' If kseNet.sockMain.UDP_client(serverName, port) <> chi.SOCKET_OK Then Return 0
1252
'fbNet -- TODO
1253
Return 0
983
1254
Else
984
If kseNet.sockMain.UDP_client(serverIP, port) <> chi.SOCKET_OK Then
985
Return 0
986
Else
987
'TODO: register client to host then get host info
988
Return 1
989
EndIf
990
EndIf
991
992
Return 0
1255
' If kseNet.sockMain.UDP_client(serverIP, port) <> chi.SOCKET_OK Then Return 0
1256
'fbNet
1257
Server.sin_addr = inet_addr(serverName)
1258
EndIf
1259
1260
g_ret = NetConnect(hEngineConn, @Server, SizeOf(SOCKADDR_IN))
1261
1262
If g_ret < 0 Then
1263
NetClose hEngineConn
1264
Engine_Log "Socket Connect Error",1
1265
bNetConnState = NETCONN_CLOSE
1266
Return 0
1267
End If
1268
1269
Dim As Any Ptr threadMain = ThreadCreate(@Engine_ClientStart, 0)
1270
1271
While bNetConnState = NETCONN_INIT
1272
Sleep 1 'wait for engine to fully open or close-due-to-error
1273
Wend
1274
1275
If bNetConnState = NETCONN_CLOSE Then
1276
Return 0
1277
EndIf
1278
1279
Engine_Log " Connected",1
1280
kseNet.Connected = 1
1281
'TODO: register client to host then get host info
1282
993
1283
994
1284
'------------- DX7 implementation from FreeKE sources
995
' Engine_InitConnectionList
1285
Engine_InitConnectionList()
996
1286
' Engine_ListSessions
997
1287
' Dim oSessData As DirectPlaySessionData 'How is the session described?
998
1288
' On Error GoTo ptrErr
1010
1300
' Return 1
1011
1301
' End If
1012
1302
' Next
1303
Return 1
1013
1304
'ptrErr:
1014
1305
' Engine_Log "@Net:(Join) " & Err.Number & " - " & Err.Description
1015
1306
End Function
1021
1312
' @param MsgTYPE - should it be a textual message or engine command (kick)
1022
1313
' @return Always returns <b>True</b> if it has hosted/joined a network.
1023
1314
' @remarks This is called by engine through <b>Net:Send</b> and <b>Net:SendTo</b>.<br>
1024
Private Function Engine_Send(sMsg As String, MsgTYPE As Long = 0) As Byte
1315
Private Function Engine_Send(sMsg As String, MsgTYPE As Long = 0, pTo As FDSOCKET = -1) As Byte
1025
1316
' On Error GoTo ptrErr
1026
1317
' Dim dpMsg As DirectPlayMessage 'Create message object
1027
1318
' Set dpMsg = DPLAY.CreateMessage
1031
1322
' 'Send the message
1032
1323
' DPLAY.SendEx kseNet.playerID, DPID_ALLPLAYERS, DPSEND_GUARANTEED, dpMsg, 0, 0, 0
1033
1324
If kseNet.Connected = 1 Then
1034
' kseNet.sockMain.put(MsgTYPE & "^" & kseNet.playerID & "^" & DPID_ALLPLAYERS & "^" & sMsg)
1035
' kseNet.sockMain.put(MsgTYPE & "^" & sender-LAN-id & "^" & send-to-who & "^" & sMsg)
1036
kseNet.sockMain.put(MsgTYPE & "^" & kseNet.playerID & "^" & "0" & "^" & sMsg)
1037
Return 1
1325
If (pTo = -1) Then
1326
g_ret = NetSendString(hEngineConn, MsgTYPE & Chr(2) & kseNet.playerID & Chr(2) & "0" & Chr(2) & sMsg & Chr(3))
1327
Else
1328
g_ret = NetSendString(pTo, MsgTYPE & Chr(2) & kseNet.playerID & Chr(2) & "0" & Chr(2) & sMsg & Chr(3))
1329
EndIf
1330
If g_ret > -1 Then
1331
Return 1
1332
Else
1333
net_errMsg = "Socket Send Error " & g_ret & ": " & sMsg
1334
Engine_Log net_errMsg, 1
1335
'fail connection here?
1336
Return 0
1337
End If
1338
'ChiSock
1339
' kseNet.sockMain.put(MsgTYPE & Chr(2) & kseNet.playerID & Chr(2) & DPID_ALLPLAYERS & Chr(2) & sMsg)
1340
' kseNet.sockMain.put(MsgTYPE & Chr(2) & sender-LAN-id & Chr(2) & send-to-who & Chr(2) & sMsg)
1341
' If (kseNet.sockMain.put(MsgTYPE & Chr(2) & kseNet.playerID & Chr(2) & "0" & Chr(2) & sMsg) = FALSE) Then
1342
' Return 0
1343
' Else
1344
' Return 1
1345
' EndIf
1038
1346
Else
1039
1347
Return 0
1040
1348
End If
1048
1356
' @return Returns <b>True</b> if successfully created connection, and <b>False</b>, otherwise.
1049
1357
Private Function Engine_InitConnection() As Byte
1050
1358
' On Error GoTo ptrErr
1051
' 'Initialize TCP/IP connection
1052
' If kseNet.Hosting Then
1359
'Initialize TCP/IP connection
1360
bNetConnState = NETCONN_INIT
1361
hEngineConn = NetSocket(AF_INET, SOCK_STREAM, 0)'SOCK_DGRAM
1362
If hEngineConn < 0 Then
1363
Engine_Log "Socket Create Error", 1
1364
bNetConnState = NETCONN_CLOSE
1365
Return 0
1366
End If
1367
Server.sin_family = AF_INET
1368
Server.sin_port = htons(kseNET_PORT)'2310
1369
If kseNet.Hosting Then
1053
1370
' Set DPLAY_Address = oEnumConn.GetAddress(kseNet.TCP_IP)
1054
' Else
1371
'todo: clear player list, etc
1372
Else
1055
1373
' Set DPLAY_Address = DPLAY_Lobby.CreateINetAddress(kseNet.IP, kseNET_PORT)
1056
' End If
1374
'todo: get player list
1375
End If
1376
1057
1377
' 'Initialize this address
1058
1378
' Call DPLAY.InitializeConnection(DPLAY_Address)
1059
1379
1081
1401
Return 0
1082
1402
EndIf
1083
1403
End Function
1404
1405
Private Function Engine_NetDataPush(iMsgType As Integer, iFromID As Integer, iToID As Integer, sContent As String) As Byte
1406
ReDim Preserve kseNetData(kseNetData_count) As typeNetData
1407
1408
With kseNetData(kseNetData_count)
1409
.msgType = iMsgType
1410
.fromID = iFromID
1411
.toID = iToID
1412
.content = sContent
1413
End With
1414
1415
kseNetData_count = kseNetData_count + 1
1416
1417
Return 1
1418
End Function
1419
1420
Private Function Engine_NetDataPop() As typeNetData
1421
Dim tmpNetData As typeNetData
1422
1423
With tmpNetData
1424
.msgType = kseNetData(0).msgType
1425
.fromID = kseNetData(0).fromID
1426
.toID = kseNetData(0).toID
1427
.content = kseNetData(0).content
1428
End With
1429
1430
For i As Integer = 0 To kseNetData_count - 2 'for i = 0 to 0, makes 1 loop which should not be
1431
With kseNetData(i)
1432
.msgType = kseNetData(i+1).msgType
1433
.fromID = kseNetData(i+1).fromID
1434
.toID = kseNetData(i+1).toID
1435
.content = kseNetData(i+1).content
1436
End With
1437
Next
1438
1439
kseNetData_count = kseNetData_count - 1
1440
Redim Preserve kseNetData(kseNetData_count) As typeNetData
1441
1442
Return tmpNetData
1443
End Function
Loggerhead is a web-based interface for Breezy
Version: 2.0.1