Home

Add

Edit

Without Linenumbers

Code in Textfield

Download

  1. '======================================================================
    
  2. ' TSN - TCP-Socket-Networking
    
  3. '======================================================================
    
  4. '======================================================================
    
  5. ' All Functions will give back a GID (Guru-ID).
    
  6. ' GID's has following Syntax and can identify by call 'TSN_GuruCode'.
    
  7. ' If a GID is negativ then a error is given.
    
  8. ' If a GID is positiv then a state change is raisen.
    
  9. ' If a GID is zero (0) the Function is sucessfully.
    
  10. '======================================================================
    
  11. '======================================================================
    
  12. ' 2007 By.: Martin Wiemann (ThePuppetMaster)
    
  13. '======================================================================
    
  14. '======================================================================
    
  15. ' Special THANKS to:
    
  16. ' 'PMedia' and 'Michael1712' for support whis select() under Unix
    
  17. '======================================================================
    
  18. 
    
  19. 
    
  20. #IF Defined(__FB_LINUX__)
    
  21.     #INCLUDE Once "crt/stdlib.bi"
    
  22.     #INCLUDE Once "crt/unistd.bi"
    
  23.     #INCLUDE Once "crt/netdb.bi"
    
  24.     #INCLUDE Once "crt/sys/types.bi"
    
  25.     #INCLUDE Once "crt/sys/socket.bi"
    
  26.     #INCLUDE Once "crt/sys/select.bi"
    
  27.     #INCLUDE Once "crt/netinet/in.bi"
    
  28.     #INCLUDE Once "crt/arpa/inet.bi"
    
  29.     #DEFINE IOCPARM_MASK &h7f
    
  30.     #DEFINE IOC_IN &h80000000
    
  31.     #DEFINE _IOW(x,y,t) (IOC_IN Or ((t And IOCPARM_MASK) Shl 16) Or ((x) Shl 8) Or (y))
    
  32.     #DEFINE FIONBIO _IOW(Asc("f"), 126, Sizeof(Uinteger))
    
  33.     #DEFINE h_addr h_addr_list[0]
    
  34.     #DEFINE CloseSocket_(_a_) close_(_a_)
    
  35.     #DEFINE INVALID_SOCKET (Cast(Socket, -1))
    
  36.     #DEFINE TSNE_MSG_NOSIGNAL &h4000
    
  37.     #DEFINE EINPROGRESS 36
    
  38. #ELSEIF Defined(__FB_WIN32__)
    
  39.     #DEFINE WIN_INCLUDEALL
    
  40.     #INCLUDE Once "windows.bi"
    
  41.     #INCLUDE Once "win\winsock.bi"
    
  42.     #DEFINE close_(_a_) closesocket(_a_)
    
  43.     #DEFINE memcpy(x__, y__, z__) movememory(x__, y__, z__)
    
  44.     #DEFINE TSNE_MSG_NOSIGNAL &h0
    
  45.     #DEFINE EINPROGRESS WSAEINPROGRESS
    
  46.     Const IP_SUCCESS                = 0
    
  47.     Const IP_DEST_NET_UNREACHABLE   = 1102
    
  48.     Const IP_DEST_HOST_UNREACHABLE  = 1103
    
  49.     Const IP_DEST_PROT_UNREACHABLE  = 1104
    
  50.     Const IP_DEST_PORT_UNREACHABLE  = 1105
    
  51.     Const IP_REQ_TIMED_OUT          = 11010
    
  52.     Const IP_TTL_EXPIRED_TRANSIT    = 11013
    
  53.     Type IP_Option_Information
    
  54.         Ttl             As Ubyte
    
  55.         Tos             As Ubyte
    
  56.         Flags           As Ubyte
    
  57.         OptionsSize     As Ubyte
    
  58.         OptionsData     As Ubyte Ptr
    
  59.     End Type
    
  60.     Type ICMP_Echo_Reply
    
  61.         Adress          As in_addr
    
  62.         Status          As Uinteger
    
  63.         RoundTripTime   As Uinteger
    
  64.         DataSize        As Ushort
    
  65.         Reserved        As Ushort
    
  66.         Data            As Any Ptr
    
  67.         Options         As IP_Option_Information
    
  68.     End Type
    
  69.     #IF Defined(TSNE_PINGICMP)
    
  70.         Declare Function IcmpCreateFile Lib "icmp.dll" () As Integer
    
  71.         Declare Function IcmpCloseHandle Lib "icmp.dll" (Byval IcmpHandle As Integer) As Integer
    
  72.         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
    
  73.     #ENDIF
    
  74.     Private Sub TSNE_INT_StartWinsock() Constructor 102
    
  75.         Dim xwsa As WSADATA
    
  76.         WSAStartup(MAKEWORD(2, 0), @xwsa)
    
  77.     End Sub
    
  78.     Private Sub TSNE_INT_EndWinsock() Destructor 102
    
  79.         WSAcleanup()
    
  80.     End Sub
    
  81. #ELSE
    
  82.     #ERROR "Unsupported platform"
    
  83. #ENDIF
    
  84. #INCLUDE Once "crt/sys/time.bi"
    
  85. #INCLUDE Once "crt/fcntl.bi"
    
  86. #INCLUDE Once "vbcompat.bi"
    
  87. 
    
  88. Declare Function TSN_Close(Byref V_Socket As Socket) As Long
    
  89. Declare Function TSN_Create_Listen(Byref B_Socket As Socket, Byref V_Port As Integer) As Long
    
  90. Declare Function TSN_Create_Conection(Byref B_Socket As Socket, Byref V_IPAddress As String, Byref V_Port As Integer) As Long
    
  91. Declare Function TSN_Create_Accept(Byref V_SocketServer As Socket, Byref B_SocketNewClient As Socket) As Long
    
  92. Declare Function TSN_Event_Get(Byref V_Socket As Socket) As Long
    
  93. Declare Function TSN_Data_Get Overload (Byref V_Socket As Socket, Byref B_Data As String, Byref B_DataLen As Long = 0) As Long
    
  94. Declare Function TSN_Data_Get (Byref V_Socket As Socket, Byref B_Data As Any Ptr, Byref B_DataLen As Long = 0) As Long
    
  95. Declare Function TSN_Data_Send Overload (Byref V_Socket As Socket, Byref V_Data As String) As Long
    
  96. Declare Function TSN_Data_Send (Byref V_Socket As Socket, Byref V_Data As Any Ptr) As Long
    
  97. Declare Function TSN_IPAddress_Get(Byref V_Socket As Socket, Byref B_IPAddress As String) As Long
    
  98. Declare Function TSN_GuruCode(Byref V_LangCode As String, Byref V_GCID As Long) As String
    
  99. 
    
  100. 
    
  101. #DEFINE TSN_BufferSize 1024
    
  102. #IFNDEF Wait_mSec
    
  103.    #DEFINE Wait_mSec 0
    
  104. #ENDIF
    
  105. #IFNDEF Wait_Sec
    
  106.    #DEFINE Wait_Sec 0
    
  107. #ENDIF
    
  108. 
    
  109. 
    
  110. Function TSN_IPAddress_Get(Byref V_Socket As Socket, Byref B_IPAddress As String) As Long
    
  111. TSN_IPAddress_Get = -1
    
  112. Dim TADDR As SOCKADDR_IN
    
  113. Dim XSize As Long = 16
    
  114. If getpeername (V_Socket, Cast(sockaddr Ptr, @TADDR), @XSize) = 0 Then
    
  115.     B_IPAddress = *inet_ntoa(TADDR.sin_addr)
    
  116.     Return 0
    
  117. Else: Return -6
    
  118. End If
    
  119. End Function
    
  120. 
    
  121. 
    
  122. Function TSN_Close(Byref V_Socket As Socket) As Long
    
  123. TSN_Close = -1
    
  124. If V_Socket <> INVALID_SOCKET Then
    
  125.     close_(V_Socket)
    
  126.     V_Socket = INVALID_SOCKET
    
  127.     Return 3
    
  128. Else: Return -9
    
  129. Endif
    
  130. End Function
    
  131. 
    
  132. 
    
  133. Function TSN_Create_Listen(Byref B_Socket As Socket, Byref V_Port As Integer) As Long
    
  134. TSN_Create_Listen = -1
    
  135. Dim BV As Long
    
  136. Dim TADDR As SOCKADDR_IN
    
  137. Dim TSock As Socket
    
  138. TSock = opensocket(AF_INET, SOCK_STREAM, IPPROTO_IP)
    
  139. If TSock = INVALID_SOCKET Then Return -2
    
  140. TADDR.sin_family = AF_INET
    
  141. TADDR.sin_port = htons(V_Port)
    
  142. TADDR.sin_addr.s_addr = INADDR_ANY
    
  143. BV = bind(TSock, Cptr(SOCKADDR Ptr, @TADDR), Sizeof(SOCKADDR_IN))
    
  144. If BV = SOCKET_ERROR Then Return - 3
    
  145. BV = listen(TSock, 10)
    
  146. If BV = SOCKET_ERROR Then Return -4
    
  147. B_Socket = TSock
    
  148. Return 0
    
  149. End Function
    
  150. 
    
  151. 
    
  152. Function TSN_Create_Conection(Byref B_Socket As Socket, Byref V_IPAddress As String, Byref V_Port As Integer) As Long
    
  153. TSN_Create_Conection = -1
    
  154. Dim TSock As Socket
    
  155. Dim TADDR As SOCKADDR_IN
    
  156. Dim TADDRIN As in_addr
    
  157. Dim XHost As hostent Ptr
    
  158. Dim BV As Integer
    
  159. TADDRIN.s_addr = inet_addr(Strptr(V_IPAddress))
    
  160. If (TADDRIN.s_addr = -1) Then
    
  161.     XHost = gethostbyname(Strptr(V_IPAddress))
    
  162.     If XHost = 0 Then Return -5
    
  163.     TADDRIN = *Cast(in_addr Ptr, XHost->h_addr_list[0])
    
  164.     If TADDRIN.s_addr = INADDR_NONE Then Return -5
    
  165. End If
    
  166. TADDR.sin_family = AF_INET
    
  167. TADDR.sin_port = htons(V_Port)
    
  168. TADDR.sin_addr = TADDRIN
    
  169. TSock = opensocket(PF_INET, SOCK_STREAM, 0)
    
  170. If TSock = -1 Then Return -2
    
  171. BV = connect(TSock, Cptr(SOCKADDR Ptr,@TADDR), Sizeof(SOCKADDR))
    
  172. If BV = SOCKET_ERROR Then Return -7
    
  173. B_Socket = TSock
    
  174. Return 0
    
  175. End Function
    
  176. 
    
  177. 
    
  178. Function TSN_Create_Accept(Byref V_SocketServer As Socket, Byref B_SocketNewClient As Socket) As Long
    
  179. TSN_Create_Accept = -1
    
  180. Dim TSock As Socket
    
  181. TSock = accept(V_SocketServer, 0, 0)
    
  182. If TSock = INVALID_SOCKET Then Return -8
    
  183. B_SocketNewClient = TSock
    
  184. Return 0
    
  185. End Function
    
  186. 
    
  187. 
    
  188. Function TSN_Event_Get(Byref V_Socket As Socket) As Long
    
  189. TSN_Event_Get = -1
    
  190. Dim TTV As TimeVal
    
  191. Dim TFDSet As fd_Set
    
  192. TTV.tv_sec = 0
    
  193. TTV.tv_usec = 0
    
  194. fd_set_(V_Socket, @TFDSet)
    
  195. If selectsocket(V_Socket + 1, @TFDSet, 0, 0, @TTV) = SOCKET_ERROR Then Return TSN_Close(V_Socket)
    
  196. If (FD_ISSET(V_Socket, @TFDSet)) Then Return 1
    
  197. Return 0
    
  198. End Function
    
  199. 
    
  200. 
    
  201. Function TSN_Data_Get(Byref V_Socket As Socket, Byref B_Data As String, Byref B_DataLen As Long = 0) As Long
    
  202. TSN_Data_Get = -1
    
  203. Dim TLenB As Integer
    
  204. Dim TBuffer As Zstring * TSN_BufferSize
    
  205. Dim TFDSet As FD_SET
    
  206. Dim TTV As TimeVal
    
  207. Dim BV As Long
    
  208. Dim T As String
    
  209. TTV.tv_Sec = 0
    
  210. TTV.tv_uSec = 0
    
  211. FD_Set_(V_Socket, @TFDSet)
    
  212. BV = select_(V_Socket + 1, @TFDSet, 0, 0, @TTV)
    
  213. If (BV <> -1) Then
    
  214.     If (FD_ISSET(V_Socket, @TFDSet)) <> 0 Then
    
  215.         TLenB = recv(V_Socket, Strptr(TBuffer), TSN_BufferSize, 0)
    
  216.         If TLenB <= 0 Then Return TSN_Close(V_Socket)
    
  217.         TBuffer[TLenB] = 0
    
  218.         T = String(TLenB + 1, " ")
    
  219.         MemCpy(Strptr(T), Strptr(TBuffer), TLenB)
    
  220.         B_Data = T
    
  221.     End If
    
  222. Else: Return TSN_Close(V_Socket)
    
  223. End If
    
  224. B_DataLen = TLenB
    
  225. If B_DataLen > 0 Then
    
  226.     Return 2
    
  227. Else: Return 0
    
  228. End If
    
  229. End Function
    
  230. 
    
  231. 
    
  232. Function TSN_Data_Send(Byref V_Socket As socket, Byref V_Data As String) As Long
    
  233. TSN_Data_Send = -1
    
  234. Dim XTemp As String
    
  235. Dim XSC As Long
    
  236. Dim XLen As Long
    
  237. Dim BV As Long
    
  238. XTemp = V_Data
    
  239. XLen = Len(XTemp)
    
  240. Do
    
  241.     BV = send(V_Socket, Strptr(XTemp) + XSC, XLen - XSC, 0)
    
  242.     If BV > 0 Then
    
  243.         XSC += BV
    
  244.     Elseif BV = 0 Then
    
  245.     Else
    
  246.     End If
    
  247. Loop Until XSC = XLen
    
  248. Return XSC
    
  249. End Function
    
  250. 
    
  251. 
    
  252. Function TSN_GuruCode(Byref V_LangCode As String, Byref V_GCID As Long) As String
    
  253. Select Case V_LangCode
    
  254.     Case "EN"
    
  255.         Select Case V_GCID
    
  256.             Case 1: Return "New connection request"
    
  257.             Case 2: Return "New data available"
    
  258.             Case 3: Return "Connection was closed"
    
  259. 
    
  260.             Case 0: Return "No error / No event"
    
  261. 
    
  262.             Case -1: Return "Unknow error in function!"
    
  263.             Case -2: Return "Cant create new socket"
    
  264.             Case -3: Return "Cant bind port on socket"
    
  265.             Case -4: Return "Cant socket set into Listen-Mode"
    
  266.             Case -5: Return "Cant resolve IP-Address from Hostname"
    
  267.             Case -6: Return "Cant resolve Hostname from IP-Address"
    
  268.             Case -7: Return "Cant connect to remote-computer"
    
  269.             Case -8: Return "Cant accept requestet connection"
    
  270.             Case -9: Return "No socket found in V_Socket parameter"
    
  271.             Case Else: Return "Unknow Guru-Code"
    
  272.         End Select
    
  273.     Case "DE"
    
  274.         Select Case V_GCID
    
  275.             Case 1: Return "Neue Verbindungsanfrage"
    
  276.             Case 2: Return "Neue Daten verfügbar"
    
  277.             Case 3: Return "Verbindung wurde beendet"
    
  278. 
    
  279.             Case 0: Return "Kein Fehler / Kein Ereigniss"
    
  280. 
    
  281.             Case -1: Return "Unbekannter Funktionsfehler!"
    
  282.             Case -2: Return "Konnte Socket nicht erstellen"
    
  283.             Case -3: Return "Konnte Port nicht an Socket anbinden"
    
  284.             Case -4: Return "Konnte Socket nicht in den Listen-Mode versetzen"
    
  285.             Case -5: Return "Konnte Hostname nicht in IP-Adresse umwandeln"
    
  286.             Case -6: Return "Konnte IP-Adresse nicht in Hostname umwandeln"
    
  287.             Case -7: Return "Konnte keine Verbindugn mit entferntem Rechner herstellen"
    
  288.             Case -8: Return "Konnte Verbindungsanfrage nicht akzeptieren"
    
  289.             Case -9: Return "Es wurde kein Socket im V_Socket parameter gefunden"
    
  290.             Case Else: Return "Unbekannter Guru-Code"
    
  291.         End Select
    
  292.     Case Else: Return "Unknow Lang-Code!"
    
  293. End Select
    
  294. End Function