-
Notifications
You must be signed in to change notification settings - Fork 0
/
TSNE_V3.bi
2060 lines (1874 loc) · 77 KB
/
TSNE_V3.bi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
'##############################################################################################################
'##############################################################################################################
' TSNE_V3 - TCP Socket Networking [Eventing] Version: (see line 18 till 20)
'##############################################################################################################
'##############################################################################################################
' (c) 2009-.... By.: /_\ DeltaLab's Germany - Experimental Computing
' Autor: Martin Wiemann
' IRC: IRC://DeltaLabs.de/#mln
'##############################################################################################################
' Free for NON-comercial use! For comercial usage send me a mail -> FreeBasic[at]DeltaLabs.de or IRC and u get a free usage
'##############################################################################################################
#IFNDEF _TSNE_
#DEFINE _TSNE_
#Define TSNE_Version 3.10
#Define TSNE_VersionDate 20210503
#Define TSNE_VersionFull 3.10_20210503 (0.18.5 -> 1.05.0)(L32,L64)
'>...
'TODO:
'UDP Sockets: wenn vorhanden und erzeugt, dann funzt END nicht mehr, da vermutlich das disconnect auf UDP nicht richtig arbeitet.
'�nderungen:
'##############################################################################################################
'BUGFIX for 0.18.5 fbc version inspired by: TJF -> http://www.freebasic.net/forum/viewtopic.php?f=3&t=19889&p=174666&hilit=tsne#p174535
#IF __FB_VERSION__ = "0.18.5"
TYPE timeval
tv_sec AS __time_t
tv_usec AS __suseconds_t
END TYPE
#ENDIF
'##############################################################################################################
#IF DEFINED(TSNE_SleepLock)
Dim Shared TSNE_INT_SleepMutex as Any Ptr
#ENDIF
'##############################################################################################################
#define EMFILE 24
#define ENFILE 23
#define ENOMEM 12
#IF DEFINED(TSNE_ERRNO)
declare function errno cdecl alias "__errno_location" () as integer ptr ptr
#ENDIF
#IF DEFINED(__FB_LINUX__)
#INCLUDE once "crt/stdlib.bi"
#INCLUDE once "crt/unistd.bi"
#INCLUDE once "crt/netdb.bi"
#INCLUDE once "crt/sys/types.bi"
#INCLUDE once "crt/sys/socket.bi"
#INCLUDE once "crt/sys/select.bi"
#INCLUDE once "crt/netinet/in.bi"
#INCLUDE once "crt/arpa/inet.bi"
#INCLUDE once "crt/string.bi"
#DEFINE IOCPARM_MASK &h7f
#DEFINE IOC_IN &h80000000
#DEFINE _IOW(x,y,t) (IOC_IN or ((t and IOCPARM_MASK) shl 16) or ((x) shl 8) or (y))
#DEFINE FIONBIO _IOW(asc("f"), 126, sizeof(UInteger))
#DEFINE h_addr h_addr_list[0]
#DEFINE CloseSocket_(_a_) close_(_a_)
#DEFINE INVALID_SOCKET (Cast(Socket, -1))
#DEFINE TSNE_MSG_NOSIGNAL &h4000
#DEFINE EINPROGRESS 36
#IF __FB_VERSION__ >= "1.05.0"
#INCLUDE once "crt/mem.bi"
#ENDIF
#ELSEIF DEFINED(__FB_WIN32__)
#DEFINE WIN_INCLUDEALL
#INCLUDE once "windows.bi"
#INCLUDE once "win\winsock.bi"
#DEFINE close_(_a_) closesocket(_a_)
#IF __FB_VERSION__ < "1.00.0"
#DEFINE memcpy(x__, y__, z__) movememory(x__, y__, z__)
#ENDIF
#DEFINE TSNE_MSG_NOSIGNAL &h0
#DEFINE EINPROGRESS WSAEINPROGRESS
#IF __FB_VERSION__ = "1.02"
#DEFINE opensocket socket
#DEFINE selectsocket select_
#ENDIF
Const IP_SUCCESS = 0
Const IP_DEST_NET_UNREACHABLE = 1102
Const IP_DEST_HOST_UNREACHABLE = 1103
Const IP_DEST_PROT_UNREACHABLE = 1104
Const IP_DEST_PORT_UNREACHABLE = 1105
Const IP_REQ_TIMED_OUT = 11010
Const IP_TTL_EXPIRED_TRANSIT = 11013
Type IP_Option_Information
Ttl as UByte
Tos as UByte
Flags as UByte
OptionsSize as UByte
OptionsData as UByte Ptr
End type
Type ICMP_Echo_Reply
Adress as in_addr
Status as UInteger
RoundTripTime as UInteger
DataSize as UShort
Reserved as UShort
Data as Any Ptr
Options as IP_Option_Information
End Type
#IF DEFINED(TSNE_PINGICMP)
Declare Function IcmpCreateFile Lib "icmp.dll" () As Integer
Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Integer) As Integer
Declare Function IcmpSendEcho Lib "icmp.dll" (ByVal IcmpHandle As Integer, ByVal DestinationAddress As in_addr, ByVal RequestData As String, ByVal RequestSize As Short, ByVal RequestOptions As Integer, ReplyBuffer As ICMP_Echo_Reply Ptr, ByVal ReplySize As Integer, ByVal TimeOut As Integer) As Integer
#ENDIF
#IFNDEF TSNE_NOSTRUCTOR
Private Sub TSNE_INT_StartWinsock() CONSTRUCTOR 102
Dim xwsa as WSADATA
WSAStartup(MAKEWORD(2, 0), @xwsa)
End Sub
Private Sub TSNE_INT_EndWinsock() DESTRUCTOR 102
WSAcleanup()
End Sub
#ENDIF
#ELSE
#error "Unsupported platform"
#ENDIF
#INCLUDE once "crt/sys/time.bi"
#INCLUDE once "crt/fcntl.bi"
#Include once "vbcompat.bi"
#IFNDEF icmp
Type icmphdr
type as UByte
code as UByte
cksum as UShort
icd_id as UShort
icd_seq as UShort
ih_gateway as UInteger
unused as UInteger
mtu as UInteger
End Type
#define ICMP_ECHOREPLY 0
#define ICMP_DEST_UNREACH 3
#define ICMP_SOURCE_QUENCH 4
#define ICMP_REDIRECT 5
#define ICMP_ECHO 8
#define ICMP_TIME_EXCEEDED 11
#define ICMP_PARAMETERPROB 12
#define ICMP_TIMESTAMP 13
#define ICMP_TIMESTAMPREPLY 14
#define ICMP_INFO_REQUEST 15
#define ICMP_INFO_REPLY 16
#define ICMP_ADDRESS 17
#define ICMP_ADDRESSREPLY 18
#define NR_ICMP_TYPES 18
#define ICMP_NET_UNREACH 0
#define ICMP_HOST_UNREACH 1
#define ICMP_PROT_UNREACH 2
#define ICMP_PORT_UNREACH 3
#define ICMP_FRAG_NEEDED 4
#define ICMP_SR_FAILED 5
#define ICMP_NET_UNKNOWN 6
#define ICMP_HOST_UNKNOWN 7
#define ICMP_HOST_ISOLATED 8
#define ICMP_NET_ANO 9
#define ICMP_HOST_ANO 10
#define ICMP_NET_UNR_TOS 11
#define ICMP_HOST_UNR_TOS 12
#define ICMP_PKT_FILTERED 13
#define ICMP_PREC_VIOLATION 14
#define ICMP_PREC_CUTOFF 15
#define NR_ICMP_UNREACH 15
#define ICMP_REDIR_NET 0
#define ICMP_REDIR_HOST 1
#define ICMP_REDIR_NETTOS 2
#define ICMP_REDIR_HOSTTOS 3
#define ICMP_EXC_TTL 0
#define ICMP_EXC_FRAGTIME 1
Type ICMP
icmp_type as UByte
icmp_code as UByte
icmp_cksum as UShort
icd_id as UShort
icd_seq as UShort
ih_pptr as UByte
ih_gwaddr as in_addr
ih_void as UInteger
ipm_void as UShort
ipm_nextmtu as UShort
irt_num_addrs as UByte
irt_wpa as UByte
irt_lifetime as UShort
#Define icmp_pptr ih_pptr
#Define icmp_gwadr ih_gwadr
#Define icmp_id icd_id
#Define icmp_seq icd_seq
#Define icmp_void ih_void
#Define icmp_pmvoid ipm_void
#Define icmp_nextmtu ipm_nextmtu
#Define icmp_num_addrs irt_num_addrs
#Define icmp_wpa irt_wpa
#Define icmp_lifetiem irt_lifetime
End Type
#ENDIF
'##############################################################################################################
'#DEFINE _TSNE_DODEBUG_
'#DEFINE _TSNE_DEBUG_IO_
'#DEFINE _TSNE_DEBUG_I_
'#DEFINE _TSNE_DEBUG_O_
#IF DEFINED(_TSNE_DEBUG_IO_)
#IFNDEF _TSNE_DEBUG_I_
#DEFINE _TSNE_DEBUG_I_
#ENDIF
#IFNDEF _TSNE_DEBUG_O_
#DEFINE _TSNE_DEBUG_O_
#ENDIF
#ENDIF
'##############################################################################################################
Dim Shared TSNE_INT_Thread_Master_Ptr as Any PTR
Dim Shared TSNE_INT_Thread_Master_Close as UByte
Dim Shared TSNE_INT_Mutex_Master as Any PTR
'##############################################################################################################
Private Const TSNE_INT_BufferSize as UInteger = 7936
Private Const TSNE_INT_TXSize as UInteger = 1440
Dim Shared TSNE_INT_StackSize as UInteger = 512000
#IF Defined(TSNE_ConstStackSizeOverride)
TSNE_INT_StackSize = TSNE_ConstStackSizeOverride
#ENDIF
'--------------------------------------------------------------------------------------------------------------
Private Const TSNE_Const_UnknowError as Integer = 0
Private Const TSNE_Const_NoError as Integer = -1
Private Const TSNE_Const_UnknowEventID as Integer = -2
Private Const TSNE_Const_NoSocketFound as Integer = -3
Private Const TSNE_Const_CantCreateSocket as Integer = -4
Private Const TSNE_Const_CantBindSocket as Integer = -5
Private Const TSNE_Const_CantSetListening as Integer = -6
Private Const TSNE_Const_SocketAlreadyInit as Integer = -7
Private Const TSNE_Const_MaxSimConReqOutOfRange as Integer = -8
Private Const TSNE_Const_PortOutOfRange as Integer = -9
Private Const TSNE_Const_CantResolveIPfromHost as Integer = -10
Private Const TSNE_Const_CantConnectToRemote as Integer = -11
Private Const TSNE_Const_TSNEIDnotFound as Integer = -12
Private Const TSNE_Const_MissingEventPTR as Integer = -13
Private Const TSNE_Const_IPAalreadyInList as Integer = -14
Private Const TSNE_Const_IPAnotInList as Integer = -15
Private Const TSNE_Const_ReturnErrorInCallback as Integer = -16
Private Const TSNE_Const_IPAnotFound as Integer = -17
Private Const TSNE_Const_ErrorSendingData as Integer = -18
Private Const TSNE_Const_UnknowGURUcode as Integer = -19
Private Const TSNE_Const_TSNENoServer as Integer = -20
Private Const TSNE_Const_NoIPV6 as Integer = -21
Private Const TSNE_Const_CantCreateSocketLimit as Integer = -22
Private Const TSNE_Const_UnstableState as Integer = -23
Private Const TSNE_Const_InternalError as Integer = -99
'--------------------------------------------------------------------------------------------------------------
Private Enum TSNE_BW_Mode_Enum
TSNE_BW_Mode_None = 0
TSNE_BW_Mode_Black = 1
TSNE_BW_Mode_White = 2
End Enum
'##############################################################################################################
Private Enum TSNE_Event
TSNE_E_Disconnect = 0
TSNE_E_Connect = 1
TSNE_E_NewConnection = 2
TSNE_E_NewData = 3
End Enum
'--------------------------------------------------------------------------------------------------------------
Private Type TSNE_Event_Type
#IF DEFINED(TSNE_SUBCALLBACK)
'THX an TheMuh für die Idee.
TSNE_Disconnected as Sub (ByVal V_TSNEID as UInteger, ByVal V_CallBackPtr as Any Ptr)
TSNE_Connected as Sub (ByVal V_TSNEID as UInteger, ByVal V_CallBackPtr as Any Ptr)
TSNE_NewData as Sub (ByVal V_TSNEID as UInteger, ByRef V_Data as String, ByVal V_CallBackPtr as Any Ptr)
#ELSE
TSNE_Disconnected as Sub (ByVal V_TSNEID as UInteger)
TSNE_Connected as Sub (ByVal V_TSNEID as UInteger)
TSNE_NewData as Sub (ByVal V_TSNEID as UInteger, ByRef V_Data as String)
#ENDIF
#IF DEFINED(TSNE_SERVERSUBCALLBACK)
TSNE_NewConnection as Sub (ByVal V_TSNEID as UInteger, ByVal V_RequestID as Socket, ByVal V_IPA as String, ByVal V_CallBackPtr as Any Ptr)
TSNE_NewConnectionCanceled as Sub (ByVal V_TSNEID as UInteger, ByVal V_IPA as String, ByVal V_CallBackPtr as Any Ptr)
TSNE_NewDataUDP as Sub (ByVal V_TSNEID as UInteger, ByVal V_IPA as String, ByRef V_Data as String, ByVal V_CallBackPtr as Any Ptr)
#ELSE
TSNE_NewConnection as Sub (ByVal V_TSNEID as UInteger, ByVal V_RequestID as Socket, ByVal V_IPA as String)
TSNE_NewConnectionCanceled as Sub (ByVal V_TSNEID as UInteger, ByVal V_IPA as String)
TSNE_NewDataUDP as Sub (ByVal V_TSNEID as UInteger, ByVal V_IPA as String, ByRef V_Data as String)
#ENDIF
V_AnyPtr as Any Ptr
End Type
'##############################################################################################################
Private Type TSNE_INT_DNSIPA_Type
V_Next as TSNE_INT_DNSIPA_Type Ptr
V_Prev as TSNE_INT_DNSIPA_Type Ptr
V_HostIPA as String
V_InAddr as in_addr
V_TimeOut as Double
End Type
'--------------------------------------------------------------------------------------------------------------
Dim Shared TSNE_INT_DNSIPAD as TSNE_INT_DNSIPA_Type Ptr
Dim Shared TSNE_INT_DNSIPAL as TSNE_INT_DNSIPA_Type Ptr
Dim Shared TSNE_INT_DNSIPA_Mutex as Any Ptr
'##############################################################################################################
Private Type TSNE_BWL_Type
V_Next as TSNE_BWL_Type Ptr
V_Prev as TSNE_BWL_Type Ptr
V_IPA as String
V_LockTill as Double
End Type
'--------------------------------------------------------------------------------------------------------------
Private Enum TSNE_Protocol
TSNE_P_TCP = 0
TSNE_P_UDP = 1
End Enum
'##############################################################################################################
Private Type TSNE_Socket_Que
V_Next as TSNE_Socket_Que Ptr
V_Prev as TSNE_Socket_Que Ptr
V_Data as String
End Type
Private Type TSNE_Socket
V_Next as TSNE_Socket Ptr
V_Prev as TSNE_Socket Ptr
V_TSNEID as UInteger
V_Event as TSNE_Event_Type
V_Socket as Socket
V_Prot as TSNE_Protocol
V_IsServer as UByte
V_Host as String
V_IPA as String
V_Port as UShort
V_USP as SOCKADDR_IN
T_DataIn as ULongInt
T_DataOut as ULongInt
T_ThreadOn as Integer
T_Thread as Any Ptr
V_BWL_UseType as UByte
V_BWL_IPAD as TSNE_BWL_Type Ptr
V_BWL_IPAL as TSNE_BWL_Type Ptr
V_Que_F as TSNE_Socket_Que Ptr
V_Que_L as TSNE_Socket_Que Ptr
End Type
'--------------------------------------------------------------------------------------------------------------
Dim Shared TSNE_INT_D as TSNE_Socket Ptr
Dim Shared TSNE_INT_L as TSNE_Socket Ptr
Dim Shared TSNE_INT_C as UInteger
Dim Shared TSNE_INT_CC as UInteger
Dim Shared TSNE_INT_Mutex as Any Ptr
'##############################################################################################################
Declare Sub TSNE_INT_Thread_Master (ByVal I_Nothing as Any Ptr)
Declare Sub TSNE_INT_Thread_Event (ByVal V_TSNEID as Any Ptr)
'##############################################################################################################
Declare Function TSNE_GetGURUCode (ByRef V_GURUID as Integer) as String
Declare Function TSNE_Stats (ByRef V_TSNEID as UInteger, ByRef R_RX as ULongInt, ByRef R_TX as ULongInt) as Integer
Declare Function TSNE_Disconnect (ByRef V_TSNEID as UInteger) as Integer
Declare Function TSNE_Create_Server (ByRef R_TSNEID as UInteger, ByRef V_Port as UShort, ByRef V_MaxSimConReq as UShort = 10, ByVal V_Event_NewConPTR as Any Ptr, ByVal V_Event_NewConCancelPTR as Any Ptr = 0, ByVal V_StackSizeOverride as UInteger = TSNE_INT_StackSize, ByVal V_CallbackBackPtr as Any Ptr = 0) as Integer
Declare Function TSNE_Create_ServerWithBindIPA (ByRef R_TSNEID as UInteger, ByRef V_Port as UShort, ByRef V_IPA as String, ByRef V_MaxSimConReq as UShort = 10, ByVal V_Event_NewConPTR as Any Ptr, ByVal V_Event_NewConCancelPTR as Any Ptr = 0, ByVal V_StackSizeOverride as UInteger = TSNE_INT_StackSize, ByVal V_CallbackBackPtr as Any Ptr = 0) as Integer
Declare Function TSNE_Create_Client (ByRef R_TSNEID as UInteger, ByVal V_IPA as String, ByVal V_Port as UShort, ByVal V_Event_DisconPTR as Any Ptr = 0, ByVal V_Event_ConPTR as Any Ptr = 0, ByVal V_Event_NewDataPTR as Any Ptr, ByVal V_TimeoutSecs as UInteger = 60, ByVal V_StackSizeOverride as UInteger = TSNE_INT_StackSize, ByVal V_WaitThreadRunning as UByte = 1, ByVal V_CallbackBackPtr as Any Ptr = 0) as Integer
Declare Function TSNE_Create_Accept (ByVal V_RequestID as Socket, ByRef R_TSNEID as UInteger, ByRef R_IPA as String = "", ByVal V_Event_DisconPTR as Any Ptr = 0, ByVal V_Event_ConPTR as Any Ptr = 0, ByVal V_Event_NewDataPTR as Any Ptr, ByRef R_RemoteShownServerIPA as String = "", ByVal V_StackSizeOverride as UInteger = TSNE_INT_StackSize, ByVal V_WaitThreadRunning as UByte = 1, ByVal V_CallbackBackPtr as Any Ptr = 0) as Integer
Declare Function TSNE_Create_UDP_RX (ByRef R_TSNEID as UInteger, ByVal V_Port as UShort, ByVal V_Event_NewDataUDPPTR as Any Ptr, ByVal V_StackSizeOverride as UInteger = TSNE_INT_StackSize, ByVal V_WaitThreadRunning as UByte = 1) as Integer
Declare Function TSNE_Create_UDP_TX (ByRef R_TSNEID as UInteger, ByVal V_DoBroadcast as UByte = 0) as Integer
Declare Function TSNE_Data_Send (ByRef V_TSNEID as UInteger, ByRef V_Data as String, ByRef R_BytesSend as UInteger = 0, ByVal V_IPA as String = "", ByVal V_Port as UShort = 0, ByVal V_TCPQueSend as Integer = 0) as Integer
Declare Function TSNE_Ping (ByVal V_IPA as String, ByRef R_Runtime as Double, ByVal V_TimeoutSecs as UByte = 10, ByVal V_ForceRAWPing as UByte = 0, ByVal V_FileIOMutex as Any Ptr = 0) as Integer
Declare Sub TSNE_WaitClose (ByRef V_TSNEID as UInteger)
Declare Function TSNE_WaitConnected (ByRef V_TSNEID as UInteger, V_TimeOut as UInteger = 60) as Integer
Declare Function TSNE_IsClosed (ByRef V_TSNEID as UInteger) as Integer
Declare Function TSNE_BW_SetEnable (ByVal V_Server_TSNEID as UInteger, V_Type as TSNE_BW_Mode_Enum) as Integer
Declare Function TSNE_BW_GetEnable (ByVal V_Server_TSNEID as UInteger, R_Type as TSNE_BW_Mode_Enum) as Integer
Declare Function TSNE_BW_Clear (ByVal V_Server_TSNEID as UInteger) as Integer
Declare Function TSNE_BW_Add (ByVal V_Server_TSNEID as UInteger, V_IPA as String, V_BlockTimeSeconds as UInteger = 3600) as Integer
Declare Function TSNE_BW_Del (ByVal V_Server_TSNEID as UInteger, V_IPA as String) as Integer
Declare Function TSNE_BW_List (ByVal V_Server_TSNEID as UInteger, ByRef R_IPA_List as TSNE_BWL_Type Ptr) as Integer
'##############################################################################################################
Private Function TSNE_INT_BW_GetPtr(ByRef V_TSNE as TSNE_Socket Ptr, ByRef V_IPA as String) as TSNE_BWL_Type Ptr
If V_TSNE = 0 Then Return 0
Dim TPtr as TSNE_BWL_Type Ptr = V_TSNE->V_BWL_IPAD
Do Until TPtr = 0
If TPtr->V_IPA = V_IPA Then
' If TPtr->V_LockTill
Return TPtr
End If
TPtr = TPtr->V_Next
Loop
Return 0
End Function
'---------------------------------------------------------------------------------------------------------------
Private Sub TSNE_INT_BW_Clear(ByRef V_TSNE as TSNE_Socket Ptr)
If V_TSNE = 0 Then Exit Sub
Dim TPtr as TSNE_BWL_Type Ptr = V_TSNE->V_BWL_IPAD
Dim TNPtr as TSNE_BWL_Type Ptr
Do Until TPtr = 0
TNPtr = TPtr->V_Next
TPtr->V_IPA = ""
DeAllocate(TPtr)
TPtr = TNPtr
Loop
End Sub
'---------------------------------------------------------------------------------------------------------------
Private Function TSNE_INT_BW_Del(ByRef V_TSNE as TSNE_Socket Ptr, ByRef V_IPA as String) as UByte
If V_TSNE = 0 Then Return 0
Dim TPtr as TSNE_BWL_Type Ptr = TSNE_INT_BW_GetPtr(V_TSNE, V_IPA)
If TPtr = 0 Then Return 0
If V_TSNE->V_BWL_IPAD = TPtr Then V_TSNE->V_BWL_IPAD = TPtr->V_Next
If V_TSNE->V_BWL_IPAL = TPtr Then V_TSNE->V_BWL_IPAL = TPtr->V_Prev
If TPtr->V_Prev <> 0 Then TPtr->V_Prev->V_Next = TPtr->V_Next
If TPtr->V_Next <> 0 Then TPtr->V_Next->V_Prev = TPtr->V_Prev
TPtr->V_IPA = ""
DeAllocate(TPtr)
Return 1
End Function
'---------------------------------------------------------------------------------------------------------------
Private Function TSNE_INT_BW_Add(ByRef V_TSNE as TSNE_Socket Ptr, ByRef V_IPA as String, ByVal V_BlockTimeSeconds as UInteger = 3600) as UByte
If V_TSNE = 0 Then Return 0
If TSNE_INT_BW_GetPtr(V_TSNE, V_IPA) <> 0 Then Return 0
If V_TSNE->V_BWL_IPAL <> 0 Then
V_TSNE->V_BWL_IPAL->V_Next = CAllocate(SizeOf(TSNE_BWL_Type))
V_TSNE->V_BWL_IPAL->V_Next->V_PreV = V_TSNE->V_BWL_IPAL
V_TSNE->V_BWL_IPAL = V_TSNE->V_BWL_IPAL->V_Next
Else
V_TSNE->V_BWL_IPAL = CAllocate(SizeOf(TSNE_BWL_Type))
V_TSNE->V_BWL_IPAD = V_TSNE->V_BWL_IPAL
End If
V_TSNE->V_BWL_IPAL->V_IPA = V_IPA
V_TSNE->V_BWL_IPAL->V_LockTill = Now() + V_BlockTimeSeconds
Return 1
End Function
'##############################################################################################################
Private Function TSNE_INT_GetPtr(ByRef V_TSNEID as UInteger) as TSNE_Socket Ptr
If V_TSNEID = 0 Then Return 0
Dim TPtr as TSNE_Socket Ptr = TSNE_INT_D
Do Until TPtr = 0
If TPtr->V_TSNEID = V_TSNEID Then Return TPtr
TPtr = TPtr->V_Next
Loop
Return 0
End Function
'---------------------------------------------------------------------------------------------------------------
Private Function TSNE_INT_Del(ByRef V_TSNE as TSNE_Socket Ptr) as UByte
MutexLock(TSNE_INT_Mutex)
If V_TSNE = 0 Then MutexUnLock(TSNE_INT_Mutex): Return 0
If TSNE_INT_D = V_TSNE Then TSNE_INT_D = V_TSNE->V_Next
If TSNE_INT_L = V_TSNE Then TSNE_INT_L = V_TSNE->V_Prev
If V_TSNE->V_Prev <> 0 Then V_TSNE->V_Prev->V_Next = V_TSNE->V_Next
If V_TSNE->V_Next <> 0 Then V_TSNE->V_Next->V_Prev = V_TSNE->V_Prev
With *V_TSNE
Do Until .V_Que_F = 0
.V_Que_L = .V_Que_F->V_Next
.V_Que_F->V_Data = ""
DeAllocate(.V_Que_F)
.V_Que_F = .V_Que_L
Loop
End With
TSNE_INT_BW_Clear(V_TSNE)
V_TSNE->V_Host = ""
V_TSNE->V_IPA = ""
DeAllocate(V_TSNE)
V_TSNE = 0
MutexUnLock(TSNE_INT_Mutex)
Return 1
End Function
'---------------------------------------------------------------------------------------------------------------
Private Function TSNE_INT_Add() as TSNE_Socket Ptr
MutexLock(TSNE_INT_Mutex)
TSNE_INT_CC += 1
If TSNE_INT_CC = 0 Then TSNE_INT_CC += 1
Do Until TSNE_INT_GetPtr(TSNE_INT_CC) = 0
TSNE_INT_CC += 1
If TSNE_INT_CC = 0 Then TSNE_INT_CC += 1
Loop
If TSNE_INT_L <> 0 Then
TSNE_INT_L->V_Next = CAllocate(SizeOf(TSNE_Socket))
TSNE_INT_L->V_Next->V_PreV = TSNE_INT_L
TSNE_INT_L = TSNE_INT_L->V_Next
Else
TSNE_INT_L = CAllocate(SizeOf(TSNE_Socket))
TSNE_INT_D = TSNE_INT_L
End If
Dim TPtr as TSNE_Socket Ptr = TSNE_INT_L
TPtr->V_TSNEID = TSNE_INT_CC
MutexUnLock(TSNE_INT_Mutex)
Return TPtr
End Function
'##############################################################################################################
#IF DEFINED(TSNE_NOSTRUCTOR)
Private Sub TSNE_INT_Init()
#IF DEFINED(__FB_WIN32__)
Dim xwsa as WSADATA
WSAStartup(MAKEWORD(2, 0), @xwsa)
#ENDIF
#ELSE
Private Sub TSNE_INT_Init() CONSTRUCTOR 101
#ENDIF
#IF DEFINED(TSNE_SleepLock)
TSNE_INT_SleepMutex = MutexCreate
#ENDIF
TSNE_INT_Mutex = MutexCreate
TSNE_INT_Mutex_Master = MutexCreate
TSNE_INT_DNSIPA_Mutex = MutexCreate
MutexLock(TSNE_INT_Mutex_Master)
TSNE_INT_Thread_Master_Ptr = ThreadCreate(cast(Any Ptr, @TSNE_INT_Thread_Master), , TSNE_INT_StackSize)
MutexLock(TSNE_INT_Mutex_Master)
MutexUnLock(TSNE_INT_Mutex_Master)
End Sub
'--------------------------------------------------------------------------------------------------------------
#IF DEFINED(TSNE_NOSTRUCTOR)
Private Sub TSNE_INT_Term()
#IF DEFINED(__FB_WIN32__)
WSAcleanup()
#ENDIF
#ELSE
Private Sub TSNE_INT_Term() DESTRUCTOR 101
#ENDIF
MutexLock(TSNE_INT_Mutex)
Dim TPtr as TSNE_Socket Ptr = TSNE_INT_D
Dim TNPtr as TSNE_Socket Ptr
Dim XTID as UInteger
Do until TPtr = 0
TNPtr = TPtr->V_Next
If TPtr->T_Thread <> 0 Then
XTID = TPtr->V_TSNEID
MutexUnLock(TSNE_INT_Mutex)
TSNE_Disconnect(XTID)
MutexLock(TSNE_INT_Mutex)
End If
TPtr = TNPtr
Loop
MutexUnLock(TSNE_INT_Mutex)
MutexLock(TSNE_INT_Mutex_Master)
TSNE_INT_Thread_Master_Close = 1
MutexUnLock(TSNE_INT_Mutex_Master)
ThreadWait(TSNE_INT_Thread_Master_Ptr)
MutexLock(TSNE_INT_DNSIPA_Mutex)
Dim TDNSPtr as TSNE_INT_DNSIPA_Type Ptr = TSNE_INT_DNSIPAD
Dim NDNSPtr as TSNE_INT_DNSIPA_Type Ptr
Do Until TDNSPtr = 0
NDNSPtr = TDNSPtr->V_Next
TDNSPtr->V_HostIPA = ""
DeAllocate(TDNSPtr)
TDNSPtr = NDNSPtr
Loop
MutexUnLock(TSNE_INT_DNSIPA_Mutex)
MutexDestroy(TSNE_INT_DNSIPA_Mutex): TSNE_INT_DNSIPA_Mutex = 0
MutexDestroy(TSNE_INT_Mutex_Master): TSNE_INT_Mutex_Master = 0
MutexDestroy(TSNE_INT_Mutex): TSNE_INT_Mutex = 0
#IF DEFINED(TSNE_SleepLock)
MutexDestroy(TSNE_INT_SleepMutex)
#ENDIF
End Sub
'##############################################################################################################
Private Function TSNE_INT_GetHostEnd(ByRef V_HostIPA as String, ByRef R_InAddr as in_addr) as Integer
MutexLock(TSNE_INT_DNSIPA_Mutex)
Dim TDNSPtr as TSNE_INT_DNSIPA_Type Ptr = TSNE_INT_DNSIPAD
Dim NDNSPtr as TSNE_INT_DNSIPA_Type Ptr
Do Until TDNSPtr = 0
If TDNSPtr->V_TimeOut <= Timer() Then
If TDNSPtr->V_Prev <> 0 Then TDNSPtr->V_Prev->V_Next = TDNSPtr->V_Next
If TDNSPtr->V_Next <> 0 Then TDNSPtr->V_Next->V_Prev = TDNSPtr->V_Prev
If TSNE_INT_DNSIPAD = TDNSPtr Then TSNE_INT_DNSIPAD = TDNSPtr->V_Next
If TSNE_INT_DNSIPAL = TDNSPtr Then TSNE_INT_DNSIPAL = TDNSPtr->V_Prev
NDNSPtr = TDNSPtr->V_Next
TDNSPtr->V_HostIPA = ""
DeAllocate(TDNSPtr)
TDNSPtr = NDNSPtr
Else: TDNSPtr = TDNSPtr->V_Next
End If
Loop
TDNSPtr = TSNE_INT_DNSIPAD
Do Until TDNSPtr = 0
If TDNSPtr->V_HostIPA = V_HostIPA Then
R_InAddr = TDNSPtr->V_InAddr
MutexUnLock(TSNE_INT_DNSIPA_Mutex)
Return TSNE_Const_NoError
End If
TDNSPtr = TDNSPtr->V_Next
Loop
Dim TADDRIN as in_addr
TADDRIN.s_addr = inet_addr(StrPtr(V_HostIPA))
If (TADDRIN.s_addr = cast(ULong, -1)) Then
Dim XHost as hostent Ptr = gethostbyname(StrPtr(V_HostIPA))
If XHost = 0 Then
MutexUnLock(TSNE_INT_DNSIPA_Mutex)
Return TSNE_Const_CantResolveIPfromHost
End If
TADDRIN = *Cast(in_addr Ptr, XHost->h_addr_list[0])
If TADDRIN.s_addr = INADDR_NONE Then MutexUnLock(TSNE_INT_DNSIPA_Mutex): Return TSNE_Const_CantResolveIPfromHost
End If
If TSNE_INT_DNSIPAL <> 0 Then
TSNE_INT_DNSIPAL->V_Next = CAllocate(SizeOf(TSNE_INT_DNSIPA_Type))
TSNE_INT_DNSIPAL->V_Next->V_Prev = TSNE_INT_DNSIPAL
TSNE_INT_DNSIPAL = TSNE_INT_DNSIPAL->V_Next
Else
TSNE_INT_DNSIPAL = CAllocate(SizeOf(TSNE_INT_DNSIPA_Type))
TSNE_INT_DNSIPAD = TSNE_INT_DNSIPAL
End If
TSNE_INT_DNSIPAL->V_HostIPA = V_HostIPA
TSNE_INT_DNSIPAL->V_InAddr = TADDRIN
TSNE_INT_DNSIPAL->V_TimeOut = Timer() + 60
R_InAddr = TADDRIN
MutexUnLock(TSNE_INT_DNSIPA_Mutex)
Return TSNE_Const_NoError
End Function
'##############################################################################################################
Private Sub TSNE_INT_Thread_Master(ByVal I_Nothing as Any Ptr) 'THX dkl
MutexUnLock(TSNE_INT_Mutex_Master)
Dim TPtr as TSNE_Socket Ptr
Dim TNPtr as TSNE_Socket Ptr
Dim TThPtr as Any Ptr
Dim TID as UInteger
Dim TEvent as TSNE_Event_Type
Do
#IF DEFINED(_TSNE_DODEBUG_)
' Print Fix(Timer()) & "=[TSNE]=[TMA]= Lock..."
#ENDIF
MutexLock(TSNE_INT_Mutex)
#IF DEFINED(_TSNE_DODEBUG_)
' Print Fix(Timer()) & "=[TSNE]=[TMA]= Lock-K"
#ENDIF
TPtr = TSNE_INT_D
Do Until TPtr = 0
TNPtr = TPtr->V_Next
If TPtr->T_ThreadOn = 3 Then
TID = TPtr->V_TSNEID
#IF DEFINED(_TSNE_DODEBUG_)
Print Fix(Timer()) & "=[" & Str(TID) & "]=[TSNE]=[TMA]= ThreadON 3"
#ENDIF
TPtr->T_ThreadOn = 4
#IF DEFINED(_TSNE_DODEBUG_)
Print Fix(Timer()) & "=[" & Str(TID) & "]=[TSNE]=[TMA]= ThreadON 4"
#ENDIF
TThPtr = TPtr->T_Thread
TEvent = TPtr->V_Event
MutexUnLock(TSNE_INT_Mutex)
#IF DEFINED(_TSNE_DODEBUG_)
Print Fix(Timer()) & "=[" & Str(TID) & "]=[TSNE]=[TMA]= Unlock"
Print Fix(Timer()) & "=[" & Str(TID) & "]=[TSNE]=[TMA]= Wait..."
#ENDIF
ThreadWait(TThPtr)
#IF DEFINED(_TSNE_DODEBUG_)
Print Fix(Timer()) & "=[" & Str(TID) & "]=[TSNE]=[TMA]= Wait-K"
Print Fix(Timer()) & "=[" & Str(TID) & "]=[TSNE]=[TMA]= Call-Dis..."
#ENDIF
#IF DEFINED(TSNE_SUBCALLBACK)
If TEvent.TSNE_Disconnected <> 0 Then TEvent.TSNE_Disconnected(TID, TEvent.V_AnyPtr)
#ELSE
If TEvent.TSNE_Disconnected <> 0 Then TEvent.TSNE_Disconnected(TID)
#ENDIF
#IF DEFINED(_TSNE_DODEBUG_)
Print Fix(Timer()) & "=[" & Str(TID) & "]=[TSNE]=[TMA]= Call-Dis-K"
#ENDIF
TSNE_INT_Del(TPtr)
#IF DEFINED(_TSNE_DODEBUG_)
Print Fix(Timer()) & "=[" & Str(TID) & "]=[TSNE]=[TMA]= Lock..."
#ENDIF
MutexLock(TSNE_INT_Mutex)
#IF DEFINED(_TSNE_DODEBUG_)
Print Fix(Timer()) & "=[" & Str(TID) & "]=[TSNE]=[TMA]= Lock-K"
#ENDIF
End If
TPtr = TNPtr
Loop
#IF DEFINED(_TSNE_DODEBUG_)
' Print Fix(Timer()) & "=[TSNE]=[TMA]= M-Lock..."
#ENDIF
MutexLock(TSNE_INT_Mutex_Master)
#IF DEFINED(_TSNE_DODEBUG_)
' Print Fix(Timer()) & "=[TSNE]=[TMA]= M-Lock-K"
#ENDIF
If TSNE_INT_Thread_Master_Close = 1 Then If TSNE_INT_D = 0 Then MutexUnLock(TSNE_INT_Mutex): MutexUnLock(TSNE_INT_Mutex_Master): Exit Do
MutexUnLock(TSNE_INT_Mutex_Master)
#IF DEFINED(_TSNE_DODEBUG_)
' Print Fix(Timer()) & "=[TSNE]=[TMA]= M-Unlock"
#ENDIF
MutexUnLock(TSNE_INT_Mutex)
#IF DEFINED(_TSNE_DODEBUG_)
' Print Fix(Timer()) & "=[TSNE]=[TMA]= Unlock"
#ENDIF
#IF DEFINED(TSNE_SleepLock)
' MutexLock(TSNE_INT_SleepMutex)
#ENDIF
'USleep 1000
Sleep 1, 1
#IF DEFINED(TSNE_SleepLock)
' MutexUnLock(TSNE_INT_SleepMutex)
#ENDIF
Loop
#IF DEFINED(_TSNE_DODEBUG_)
Print Fix(Timer()) & "=[TSNE]=[TMA]= END SUB"
#ENDIF
End Sub
'##############################################################################################################
Private Function TSNE_Stats(ByRef V_TSNEID as UInteger, ByRef R_RX as ULongInt, ByRef R_TX as ULongInt) as Integer
MutexLock(TSNE_INT_Mutex)
Dim TPtr as TSNE_Socket Ptr = TSNE_INT_GetPtr(V_TSNEID)
If TPtr = 0 Then MutexUnLock(TSNE_INT_Mutex): Return TSNE_Const_TSNEIDnotFound
R_RX = TPtr->T_DataIn
R_TX = TPtr->T_DataOut
MutexUnLock(TSNE_INT_Mutex)
Return TSNE_Const_NoError
End Function
'##############################################################################################################
Private Function TSNE_GetHost(ByRef V_TSNEID as UInteger) as String
MutexLock(TSNE_INT_Mutex)
Dim TPtr as TSNE_Socket Ptr = TSNE_INT_GetPtr(V_TSNEID)
If TPtr = 0 Then MutexUnLock(TSNE_INT_Mutex): Return ""
Function = TPtr->V_Host
MutexUnLock(TSNE_INT_Mutex)
End Function
'--------------------------------------------------------------------------------------------------------------
Private Function TSNE_GetIPA(ByRef V_TSNEID as UInteger) as String
MutexLock(TSNE_INT_Mutex)
Dim TPtr as TSNE_Socket Ptr = TSNE_INT_GetPtr(V_TSNEID)
If TPtr = 0 Then MutexUnLock(TSNE_INT_Mutex): Return ""
Function = TPtr->V_IPA
MutexUnLock(TSNE_INT_Mutex)
End Function
'--------------------------------------------------------------------------------------------------------------
Private Function TSNE_GetPort(ByRef V_TSNEID as UInteger) as UShort
MutexLock(TSNE_INT_Mutex)
Dim TPtr as TSNE_Socket Ptr = TSNE_INT_GetPtr(V_TSNEID)
If TPtr = 0 Then MutexUnLock(TSNE_INT_Mutex): Return 0
Function = TPtr->V_Port
MutexUnLock(TSNE_INT_Mutex)
End Function
'##############################################################################################################
'### !!! TSNE_Ping is EXPERIMENTAL !!! ###
'#########################################
Private Function TSNE_Ping(ByVal V_IPA as String, ByRef R_Runtime as Double, ByVal V_TimeoutSecs as UByte = 10, ByVal V_ForceRAWPing as UByte = 0, ByVal V_FileIOMutex as Any Ptr = 0) as Integer
If V_IPA = "" Then Return TSNE_Const_IPAnotFound
If InStr(1, V_IPA, ":") > 0 Then Return TSNE_Const_NoIPV6
Dim TADDRIN as in_addr
Dim RV as Integer = TSNE_INT_GetHostEnd(V_IPA, TADDRIN)
If RV <> TSNE_Const_NoError Then Return RV
Dim XFN as Integer
#IF DEFINED(__FB_LINUX__)
If V_ForceRAWPing = 0 Then
If Dir("/bin/ping", -1) <> "" Then
If V_FileIOMutex <> 0 Then MutexLock(V_FileIOMutex)
XFN = FreeFile
If Open Pipe ("/bin/ping -t " & Str(V_TimeoutSecs) & " -c 1 -qU " & V_IPA for Input as XFN) = 0 Then
If V_FileIOMutex <> 0 Then MutexUnLock(V_FileIOMutex)
Dim T as String
Dim TL as String
Do Until EOF(XFN)
Line Input #XFN, TL
If Trim(TL) <> "" Then T = TL
Loop
Close #XFN
XFN = InStr(1, T, "=")
If XFN = 0 Then Return TSNE_Const_InternalError
T = Trim(Mid(T, XFN + 1))
XFN = InStr(1, T, "/")
If XFN = 0 Then Return TSNE_Const_InternalError
R_Runtime = Val(Trim(Left(T, XFN - 1))) / 1000
Return TSNE_Const_NoError
End If
If V_FileIOMutex <> 0 Then MutexUnLock(V_FileIOMutex)
End If
End If
#ELSEIF DEFINED(__FB_WIN32__)
If V_ForceRAWPing = 0 Then
#IF DEFINED(TSNE_PINGICMP)
Dim TBuff as ICMP_Echo_Reply Ptr = CAllocate(SizeOf(ICMP_Echo_Reply) + 4)
XFN = IcmpCreateFile()
If IcmpSendEcho(XFN, TADDRIN, "PING", 4, 0, TBuff, SizeOf(TBuff), (V_TimeoutSecs * 1000)) >= 1 Then
IcmpCloseHandle(XFN)
With *TBuff
Select Case .Status
Case IP_SUCCESS
R_Runtime = .RoundTripTime / 1000
DeAllocate(TBuff)
Return TSNE_Const_NoError
Case IP_DEST_NET_UNREACHABLE, IP_DEST_HOST_UNREACHABLE, IP_DEST_PROT_UNREACHABLE, IP_DEST_PORT_UNREACHABLE, IP_REQ_TIMED_OUT, IP_TTL_EXPIRED_TRANSIT
DeAllocate(TBuff)
Return TSNE_Const_CantConnectToRemote
Case Else: DeAllocate(TBuff): Return TSNE_Const_InternalError
End Select
End With
Else
DeAllocate(TBuff)
#ENDIF
If V_FileIOMutex <> 0 Then MutexLock(V_FileIOMutex)
XFN = FreeFile
If Open Pipe ("ping -w " & Str(V_TimeoutSecs) & " -n 1 " & V_IPA for Input as XFN) = 0 Then
If V_FileIOMutex <> 0 Then MutexUnLock(V_FileIOMutex)
Dim T as String
Dim TL as String
Do Until EOF(XFN)
Line Input #XFN, TL
If Trim(TL) <> "" Then T = TL
Loop
Close #XFN
XFN = InStr(1, T, "=")
If XFN = 0 Then Return TSNE_Const_InternalError
T = Trim(Mid(T, XFN + 1))
XFN = InStr(1, T, "ms")
If XFN = 0 Then Return TSNE_Const_InternalError
R_Runtime = Val(Trim(Left(T, XFN - 1))) / 1000
Return TSNE_Const_NoError
End If
If V_FileIOMutex <> 0 Then MutexUnLock(V_FileIOMutex)
#IF DEFINED(TSNE_PINGICMP)
End If
#ENDIF
End If
#ENDIF
Dim TADDR as SOCKADDR_IN
With TADDR
.sin_family = AF_INET
.sin_addr = TADDRIN
End With
Dim TSock as Socket = opensocket(PF_INET, SOCK_RAW, IPPROTO_ICMP)
If TSock = INVALID_SOCKET Then
#IF DEFINED(TSNE_ERRNO)
Select Case errno
Case EMFILE, ENFILE, ENOMEM: Return TSNE_Const_CantCreateSocketLimit
Case Else: Return TSNE_Const_CantCreateSocket
End Select
#ELSE
Return TSNE_Const_CantCreateSocket
#ENDIF
End If
Dim XMode as UInteger
#IF DEFINED(__FB_LINUX__)
Dim XFlag as Integer = fcntl(TSock, F_GETFL, 0)
If XFlag = -1 Then close_(TSock): Return TSNE_Const_ReturnErrorInCallback
'| If fcntl(TSock, F_SETFL, XFlag or O_NONBLOCK) = -1 Then close_(TSock): Return TSNE_Const_ReturnErrorInCallback
If fcntl(TSock, F_SETFL, XFlag) = -1 Then close_(TSock): Return TSNE_Const_ReturnErrorInCallback
#ELSEIF DEFINED(__FB_WIN32__)
XMode = 1
' Dim XFlag as Integer = ioctlsocket(TSock, FIONBIO, @XMode)
Dim XFlag as Integer = ioctlsocket(TSock, FIONBIO, Cast(Any Ptr, 1))
#ENDIF
Dim TICMP as ICMP
With TICMP
.icmp_type = ICMP_ECHO
.icmp_code = 0
.icmp_seq = 1
.icmp_id = 0
End With
Dim TUBP as UByte Ptr = Cast(UByte Ptr, @TICMP)
Dim TSum as UInteger
For X as UInteger = 0 To SizeOf(ICMP) -1
TSum += *(TUBP + X)
Next
TSum = (TSum shr 16) + (TSum and &HFFFF)
TSum += (TSum shr 16)
TSum = &HFFFF - TSum
TICMP.icmp_cksum = TSum
Dim TBuffer as ZString * TSNE_INT_BufferSize
Dim TLenB as Integer
Dim TFDSet as fd_Set
#IF __FB_VERSION__ >= "1.03"
Dim TTLen as ULong = SizeOf(TADDR)
#ELSE
Dim TTLen as UInteger = SizeOf(TADDR)
#ENDIF
Dim TTV AS TimeVal
With TTV
.tv_sec = CUInt(V_TimeoutSecs)
.tv_usec = 0
End With
fd_set_(TSock, @TFDSet)
Dim TRTT as Double = Timer()
RV = sendto(TSock, Cast(UByte Ptr, @TICMP), SizeOf(ICMP), 0, Cast(SOCKADDR Ptr, @TADDR), SizeOf(SOCKADDR_IN))
If RV <> SizeOf(ICMP) Then close_(TSock): Return TSNE_Const_ErrorSendingData
Do
RV = select_(TSock + 1, @TFDSet, 0, 0, @TTV)
If RV <> 1 Then close_(TSock): Return TSNE_Const_CantConnectToRemote
If TSock = INVALID_SOCKET Then close_(TSock): Return TSNE_Const_InternalError
TLenB = recvfrom(TSock, StrPtr(TBuffer), TSNE_INT_BufferSize, 0, Cast(SOCKADDR Ptr, @TADDR), cast(any ptr, @TTLen))
If TLenB <= 0 Then close_(TSock): Return TSNE_Const_InternalError
If TLenB >= 2 Then
If (((TBuffer[0] and &B11110000) shr 4) = &H4) and (TBuffer[1] = &H00) Then
Dim TIHL as UInteger = (TBuffer[0] and &B00001111) * 4
If TIHL >= 16 Then
If TBuffer[TIHL + 0] = ICMP_ECHOREPLY Then
Dim TSN as UShort = (TBuffer[TIHL + 6] shl 8) or TBuffer[TIHL + 7]
If TSN = 256 Then
close_(TSock)
R_Runtime = Timer() - TRTT
Return TSNE_Const_NoError
End If
End If
End If
End If
End If
Loop