home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD58465162000.psc / server / WsockAPI.bas < prev   
Encoding:
BASIC Source File  |  2000-05-16  |  37.5 KB  |  1,420 lines
  1. Attribute VB_Name = "WsockAPI"
  2.  
  3.  
  4. '   (1) I have never used WS_SELECT (select), therefore I must warn that I do
  5. '       not know if fd_set and timeval are properly defined.
  6. '   (2) Alot of the functions are declared with "buf as any", when calling these
  7. '       functions you may either pass strings, byte arrays or UDT's. For 32bit I
  8. '       I recommend Byte arrays and the use of memcopy to copy the data back out
  9. '   (3) The async functions (wsaAsync*) require the use of a message hook or
  10. '       message window control to capture messages sent by the winsock stack. This
  11. '       is not to be confused with a CallBack control, The only function that uses
  12. '       callbacks is WSASetBlockingHook()
  13. '   (4) Alot of "helper" functions are provided in the file for various things
  14. '       before attempting to figure out how to call a function, look and see if
  15. '       there is already a helper function for it.
  16. '   (5) Data types (hostent etc) have kept there 16bit definitions, even under 32bit
  17. '       windows due to the problem of them not working when redfined following the
  18. '       suggested rules.
  19.  
  20. Option Explicit
  21.  
  22. Public Const FD_SETSIZE = 64
  23.  
  24. Type fd_set
  25.     fd_count As Integer
  26.     fd_array(FD_SETSIZE) As Integer
  27. End Type
  28.  
  29.  
  30. Type timeval
  31.     tv_sec As Long
  32.     tv_usec As Long
  33. End Type
  34.  
  35.  
  36. Type HostEnt
  37.     h_name As Long
  38.     h_aliases As Long
  39.     h_addrtype As Integer
  40.     h_length As Integer
  41.     h_addr_list As Long
  42. End Type
  43.  
  44. Public Const hostent_size = 16
  45.  
  46. Type servent
  47.     s_name As Long
  48.     s_aliases As Long
  49.     s_port As Integer
  50.     s_proto As Long
  51. End Type
  52.  
  53. Public Const servent_size = 14
  54.  
  55. Type protoent
  56.     p_name As Long
  57.     p_aliases As Long
  58.     p_proto As Integer
  59. End Type
  60.  
  61. Public Const protoent_size = 10
  62. Public Const IPPROTO_TCP = 6
  63. Public Const IPPROTO_UDP = 17
  64. Public Const INADDR_NONE = &HFFFFFFFF
  65. Public Const INADDR_ANY = &H0
  66.  
  67. Type sockaddr
  68.     sin_family As Integer
  69.     sin_port As Integer
  70.     sin_addr As Long
  71.     sin_zero As String * 8
  72. End Type
  73.  
  74. Public Const sockaddr_size = 16
  75. Public saZero As sockaddr
  76. Public Const WSA_DESCRIPTIONLEN = 256
  77. Public Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1
  78. Public Const WSA_SYS_STATUS_LEN = 128
  79. Public Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1
  80.  
  81. Type WSADataType
  82.     wVersion As Integer
  83.     wHighVersion As Integer
  84.     szDescription As String * WSA_DescriptionSize
  85.     szSystemStatus As String * WSA_SysStatusSize
  86.     iMaxSockets As Integer
  87.     iMaxUdpDg As Integer
  88.     lpVendorInfo As Long
  89. End Type
  90.  
  91. Public Const INVALID_SOCKET = -1
  92. Public Const SOCKET_ERROR = -1
  93. Public Const SOCK_STREAM = 1
  94. Public Const SOCK_DGRAM = 2
  95. Public Const MAXGETHOSTSTRUCT = 1024
  96. Public Const AF_INET = 2
  97. Public Const PF_INET = 2
  98.  
  99. Type LingerType
  100.     l_onoff As Integer
  101.     l_linger As Integer
  102. End Type
  103.  
  104. ' Windows Sockets definitions of regular Microsoft C error constants
  105.  
  106. Global Const WSAEINTR = 10004
  107. Global Const WSAEBADF = 10009
  108. Global Const WSAEACCES = 10013
  109. Global Const WSAEFAULT = 10014
  110. Global Const WSAEINVAL = 10022
  111. Global Const WSAEMFILE = 10024
  112.  
  113. ' Windows Sockets definitions of regular Berkeley error constants
  114.  
  115. Global Const WSAEWOULDBLOCK = 10035
  116. Global Const WSAEINPROGRESS = 10036
  117. Global Const WSAEALREADY = 10037
  118. Global Const WSAENOTSOCK = 10038
  119. Global Const WSAEDESTADDRREQ = 10039
  120. Global Const WSAEMSGSIZE = 10040
  121. Global Const WSAEPROTOTYPE = 10041
  122. Global Const WSAENOPROTOOPT = 10042
  123. Global Const WSAEPROTONOSUPPORT = 10043
  124. Global Const WSAESOCKTNOSUPPORT = 10044
  125. Global Const WSAEOPNOTSUPP = 10045
  126. Global Const WSAEPFNOSUPPORT = 10046
  127. Global Const WSAEAFNOSUPPORT = 10047
  128. Global Const WSAEADDRINUSE = 10048
  129. Global Const WSAEADDRNOTAVAIL = 10049
  130. Global Const WSAENETDOWN = 10050
  131. Global Const WSAENETUNREACH = 10051
  132. Global Const WSAENETRESET = 10052
  133. Global Const WSAECONNABORTED = 10053
  134. Global Const WSAECONNRESET = 10054
  135. Global Const WSAENOBUFS = 10055
  136. Global Const WSAEISCONN = 10056
  137. Global Const WSAENOTCONN = 10057
  138. Global Const WSAESHUTDOWN = 10058
  139. Global Const WSAETOOMANYREFS = 10059
  140. Global Const WSAETIMEDOUT = 10060
  141. Global Const WSAECONNREFUSED = 10061
  142. Global Const WSAELOOP = 10062
  143. Global Const WSAENAMETOOLONG = 10063
  144. Global Const WSAEHOSTDOWN = 10064
  145. Global Const WSAEHOSTUNREACH = 10065
  146. Global Const WSAENOTEMPTY = 10066
  147. Global Const WSAEPROCLIM = 10067
  148. Global Const WSAEUSERS = 10068
  149. Global Const WSAEDQUOT = 10069
  150. Global Const WSAESTALE = 10070
  151. Global Const WSAEREMOTE = 10071
  152.  
  153. ' Extended Windows Sockets error constant definitions
  154.  
  155. Global Const WSASYSNOTREADY = 10091
  156. Global Const WSAVERNOTSUPPORTED = 10092
  157. Global Const WSANOTINITIALISED = 10093
  158. Global Const WSAHOST_NOT_FOUND = 11001
  159. Global Const WSATRY_AGAIN = 11002
  160. Global Const WSANO_RECOVERY = 11003
  161. Global Const WSANO_DATA = 11004
  162. Global Const WSANO_ADDRESS = 11004
  163.  
  164. '---ioctl Constants
  165.  
  166.     Public Const FIONREAD = &H8004667F
  167.     Public Const FIONBIO = &H8004667E
  168.     Public Const FIOASYNC = &H8004667D
  169.  
  170. #If Win16 Then
  171.  
  172. '---Windows System functions
  173.  
  174.     Public Declare Function PostMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Integer
  175.     Public Declare Sub MemCopy Lib "Kernel" Alias "hmemcpy" (Dest As Any, Src As Any, ByVal cb&)
  176.     Public Declare Function lstrlen Lib "Kernel" (ByVal lpString As Any) As Integer
  177.  
  178. '---async notification constants
  179.  
  180.     Public Const SOL_SOCKET = &HFFFF
  181.     Public Const SO_LINGER = &H80
  182.     Public Const FD_READ = &H1
  183.     Public Const FD_WRITE = &H2
  184.     Public Const FD_OOB = &H4
  185.     Public Const FD_ACCEPT = &H8
  186.     Public Const FD_CONNECT = &H10
  187.     Public Const FD_CLOSE = &H20
  188.  
  189. '---SOCKET FUNCTIONS
  190.  
  191.     Public Declare Function accept Lib "Winsock.dll" (ByVal s As Integer, addr As sockaddr, addrlen As Integer) As Integer
  192.     Public Declare Function bind Lib "Winsock.dll" (ByVal s As Integer, addr As sockaddr, ByVal namelen As Integer) As Integer
  193.     Public Declare Function closesocket Lib "Winsock.dll" (ByVal s As Integer) As Integer
  194.     Public Declare Function connect Lib "Winsock.dll" (ByVal s As Integer, addr As sockaddr, ByVal namelen As Integer) As Integer
  195.     Public Declare Function ioctlsocket Lib "Winsock.dll" (ByVal s As Integer, ByVal cmd As Long, argp As Long) As Integer
  196.     Public Declare Function getpeername Lib "Winsock.dll" (ByVal s As Integer, sName As sockaddr, namelen As Integer) As Integer
  197.     Public Declare Function getsockname Lib "Winsock.dll" (ByVal s As Integer, sName As sockaddr, namelen As Integer) As Integer
  198.     Public Declare Function getsockopt Lib "Winsock.dll" (ByVal s As Integer, ByVal level As Integer, ByVal optname As Integer, optval As Any, optlen As Integer) As Integer
  199.     Public Declare Function htonl Lib "Winsock.dll" (ByVal hostlong As Long) As Long
  200.     Public Declare Function htons Lib "Winsock.dll" (ByVal hostshort As Integer) As Integer
  201.     Public Declare Function inet_addr Lib "Winsock.dll" (ByVal cp As String) As Long
  202.     Public Declare Function inet_ntoa Lib "Winsock.dll" (ByVal inn As Long) As Long
  203.     Public Declare Function listen Lib "Winsock.dll" (ByVal s As Integer, ByVal backlog As Integer) As Integer
  204.     Public Declare Function ntohl Lib "Winsock.dll" (ByVal netlong As Long) As Long
  205.     Public Declare Function ntohs Lib "Winsock.dll" (ByVal netshort As Integer) As Integer
  206.     Public Declare Function recv Lib "Winsock.dll" (ByVal s As Integer, ByVal buf As Any, ByVal buflen As Integer, ByVal flags As Integer) As Integer
  207.     Public Declare Function recvfrom Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer, from As sockaddr, fromlen As Integer) As Integer
  208.     Public Declare Function ws_select Lib "Winsock.dll" Alias "select" (ByVal nfds As Integer, readfds As Any, writefds As Any, exceptfds As Any, timeout As timeval) As Integer
  209.     Public Declare Function send Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer) As Integer
  210.     Public Declare Function sendto Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer, to_addr As sockaddr, ByVal tolen As Integer) As Integer
  211.     Public Declare Function setsockopt Lib "Winsock.dll" (ByVal s As Integer, ByVal level As Integer, ByVal optname As Integer, optval As Any, ByVal optlen As Integer) As Integer
  212.     Public Declare Function ShutDown Lib "Winsock.dll" Alias "shutdown" (ByVal s As Integer, ByVal how As Integer) As Integer
  213.     Public Declare Function socket Lib "Winsock.dll" (ByVal af As Integer, ByVal s_type As Integer, ByVal protocol As Integer) As Integer
  214.  
  215. '---DATABASE FUNCTIONS
  216.  
  217.     Public Declare Function gethostbyaddr Lib "Winsock.dll" (addr As Long, ByVal addr_len As Integer, ByVal addr_type As Integer) As Long
  218.     Public Declare Function gethostbyname Lib "Winsock.dll" (ByVal host_name As String) As Long
  219.     Public Declare Function gethostname Lib "Winsock.dll" (ByVal host_name As String, ByVal namelen As Integer) As Integer
  220.     Public Declare Function getservbyport Lib "Winsock.dll" (ByVal Port As Integer, ByVal proto As String) As Long
  221.     Public Declare Function getservbyname Lib "Winsock.dll" (ByVal serv_name As String, ByVal proto As String) As Long
  222.     Public Declare Function getprotobynumber Lib "Winsock.dll" (ByVal proto As Integer) As Long
  223.     Public Declare Function getprotobyname Lib "Winsock.dll" (ByVal proto_name As String) As Long
  224.  
  225. '---WINDOWS EXTENSIONS
  226.  
  227.     Public Declare Function WSAStartup Lib "Winsock.dll" (ByVal wVR As Integer, lpWSAD As WSADataType) As Integer
  228.     Public Declare Function WSACleanup Lib "Winsock.dll" () As Integer
  229.     Public Declare Sub WSASetLastError Lib "Winsock.dll" (ByVal iError As Integer)
  230.     Public Declare Function WSAGetLastError Lib "Winsock.dll" () As Integer
  231.     Public Declare Function WSAIsBlocking Lib "Winsock.dll" () As Integer
  232.     Public Declare Function WSAUnhookBlockingHook Lib "Winsock.dll" () As Integer
  233.     Public Declare Function WSASetBlockingHook Lib "Winsock.dll" (ByVal lpBlockFunc As Long) As Long
  234.     Public Declare Function WSACancelBlockingCall Lib "Winsock.dll" () As Integer
  235.     Public Declare Function WSAAsyncGetServByName Lib "Winsock.dll" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal serv_name As String, ByVal proto As String, buf As Any, ByVal buflen As Integer) As Integer
  236.     Public Declare Function WSAAsyncGetServByPort Lib "Winsock.dll" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal Port As Integer, ByVal proto As String, buf As Any, ByVal buflen As Integer) As Integer
  237.     Public Declare Function WSAAsyncGetProtoByName Lib "Winsock.dll" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal proto_name As String, buf As Any, ByVal buflen As Integer) As Integer
  238.     Public Declare Function WSAAsyncGetProtoByNumber Lib "Winsock.dll" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal number As Integer, buf As Any, ByVal buflen As Integer) As Integer
  239.     Public Declare Function WSAAsyncGetHostByName Lib "Winsock.dll" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal host_name As String, buf As Any, ByVal buflen As Integer) As Integer
  240.     Public Declare Function WSAAsyncGetHostByAddr Lib "Winsock.dll" (ByVal hWnd As Integer, ByVal wMsg As Integer, addr As Long, ByVal addr_len As Integer, ByVal addr_type As Integer, buf As Any, ByVal buflen As Integer) As Integer
  241.     Public Declare Function WSACancelAsyncRequest Lib "Winsock.dll" (ByVal hAsyncTaskHandle As Integer) As Integer
  242.     Public Declare Function WSAAsyncSelect Lib "Winsock.dll" (ByVal s As Integer, ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal lEvent As Long) As Integer
  243.     Public Declare Function WSARecvEx Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer) As Integer
  244.  
  245. #ElseIf Win32 Then
  246.  
  247. '---Windows System Functions
  248.  
  249.     Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  250.     Public Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
  251.     Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
  252.  
  253. '---async notification constants
  254.  
  255.     Public Const SOL_SOCKET = &HFFFF&
  256.     Public Const SO_LINGER = &H80&
  257.     Public Const FD_READ = &H1&
  258.     Public Const FD_WRITE = &H2&
  259.     Public Const FD_OOB = &H4&
  260.     Public Const FD_ACCEPT = &H8&
  261.     Public Const FD_CONNECT = &H10&
  262.     Public Const FD_CLOSE = &H20&
  263.  
  264. '---SOCKET FUNCTIONS
  265.  
  266.     Public Declare Function accept Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, addrlen As Long) As Long
  267.     Public Declare Function bind Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
  268.     Public Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
  269.     Public Declare Function connect Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
  270.     Public Declare Function ioctlsocket Lib "wsock32.dll" (ByVal s As Long, ByVal cmd As Long, argp As Long) As Long
  271.     Public Declare Function getpeername Lib "wsock32.dll" (ByVal s As Long, sName As sockaddr, namelen As Long) As Long
  272.     Public Declare Function getsockname Lib "wsock32.dll" (ByVal s As Long, sName As sockaddr, namelen As Long) As Long
  273.     Public Declare Function getsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Any, optlen As Long) As Long
  274.     Public Declare Function htonl Lib "wsock32.dll" (ByVal hostlong As Long) As Long
  275.     Public Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
  276.     Public Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
  277.     Public Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long
  278.     Public Declare Function listen Lib "wsock32.dll" (ByVal s As Long, ByVal backlog As Long) As Long
  279.     Public Declare Function ntohl Lib "wsock32.dll" (ByVal netlong As Long) As Long
  280.     Public Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer
  281.     Public Declare Function recv Lib "wsock32.dll" (ByVal s As Long, ByVal buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
  282.     Public Declare Function recvfrom Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long, from As sockaddr, fromlen As Long) As Long
  283.     Public Declare Function ws_select Lib "wsock32.dll" Alias "select" (ByVal nfds As Long, readfds As fd_set, writefds As fd_set, exceptfds As fd_set, timeout As timeval) As Long
  284.     Public Declare Function send Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
  285.     Public Declare Function sendto Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long, to_addr As sockaddr, ByVal tolen As Long) As Long
  286.     Public Declare Function setsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Any, ByVal optlen As Long) As Long
  287.     Public Declare Function ShutDown Lib "wsock32.dll" Alias "shutdown" (ByVal s As Long, ByVal how As Long) As Long
  288.     Public Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
  289.  
  290. '---DATABASE FUNCTIONS
  291.  
  292.     Public Declare Function gethostbyaddr Lib "wsock32.dll" (addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long
  293.     Public Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
  294.     Public Declare Function gethostname Lib "wsock32.dll" (ByVal host_name As String, ByVal namelen As Long) As Long
  295.     Public Declare Function getservbyport Lib "wsock32.dll" (ByVal Port As Long, ByVal proto As String) As Long
  296.     Public Declare Function getservbyname Lib "wsock32.dll" (ByVal serv_name As String, ByVal proto As String) As Long
  297.     Public Declare Function getprotobynumber Lib "wsock32.dll" (ByVal proto As Long) As Long
  298.     Public Declare Function getprotobyname Lib "wsock32.dll" (ByVal proto_name As String) As Long
  299.  
  300. '---WINDOWS EXTENSIONS
  301.  
  302.     Public Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long
  303.     Public Declare Function WSACleanup Lib "wsock32.dll" () As Long
  304.     Public Declare Sub WSASetLastError Lib "wsock32.dll" (ByVal iError As Long)
  305.     Public Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
  306.     Public Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long
  307.     Public Declare Function WSAUnhookBlockingHook Lib "wsock32.dll" () As Long
  308.     Public Declare Function WSASetBlockingHook Lib "wsock32.dll" (ByVal lpBlockFunc As Long) As Long
  309.     Public Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long
  310.     Public Declare Function WSAAsyncGetServByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal serv_name As String, ByVal proto As String, buf As Any, ByVal buflen As Long) As Long
  311.     Public Declare Function WSAAsyncGetServByPort Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal Port As Long, ByVal proto As String, buf As Any, ByVal buflen As Long) As Long
  312.     Public Declare Function WSAAsyncGetProtoByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal proto_name As String, buf As Any, ByVal buflen As Long) As Long
  313.     Public Declare Function WSAAsyncGetProtoByNumber Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal number As Long, buf As Any, ByVal buflen As Long) As Long
  314.     Public Declare Function WSAAsyncGetHostByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal host_name As String, buf As Any, ByVal buflen As Long) As Long
  315.     Public Declare Function WSAAsyncGetHostByAddr Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, addr As Long, ByVal addr_len As Long, ByVal addr_type As Long, buf As Any, ByVal buflen As Long) As Long
  316.     Public Declare Function WSACancelAsyncRequest Lib "wsock32.dll" (ByVal hAsyncTaskHandle As Long) As Long
  317.     Public Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long
  318.     Public Declare Function WSARecvEx Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
  319.  
  320. #End If
  321.  
  322.  
  323.  
  324.  
  325.  
  326. 'SOME STUFF I ADDED
  327.  
  328. Public MySocket%
  329. Public SockReadBuffer$
  330. Public Const WSA_NoName = "Unknown"
  331. Public WSAStartedUp As Boolean     'Flag to keep track of whether winsock WSAStartup wascalled
  332.  
  333.  
  334. Public Function WSAGetAsyncBufLen(ByVal lParam As Long) As Long
  335.  
  336.     If (lParam And &HFFFF&) > &H7FFF Then
  337.  
  338.         WSAGetAsyncBufLen = (lParam And &HFFFF&) - &H10000
  339.  
  340.     Else
  341.  
  342.         WSAGetAsyncBufLen = lParam And &HFFFF&
  343.  
  344.     End If
  345.  
  346. End Function
  347.  
  348.  
  349.  
  350. Public Function WSAGetSelectEvent(ByVal lParam As Long) As Integer
  351.  
  352.     If (lParam And &HFFFF&) > &H7FFF Then
  353.  
  354.         WSAGetSelectEvent = (lParam And &HFFFF&) - &H10000
  355.  
  356.     Else
  357.  
  358.         WSAGetSelectEvent = lParam And &HFFFF&
  359.  
  360.     End If
  361.  
  362. End Function
  363.  
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  
  370. Public Function WSAGetAsyncError(ByVal lParam As Long) As Integer
  371.  
  372.     WSAGetAsyncError = (lParam And &HFFFF0000) \ &H10000
  373.  
  374. End Function
  375.  
  376.  
  377.  
  378.  
  379.  
  380.  
  381.  
  382. Public Function AddrToIP(ByVal AddrOrIP$) As String
  383.  
  384.     AddrToIP$ = GetAscIP(GetHostByNameAlias(AddrOrIP$))
  385.  
  386. End Function
  387.  
  388.  
  389.  
  390. 'this function should work on 16 and 32 bit systems
  391.  
  392. #If Win16 Then
  393.  
  394.     Function ConnectSock(ByVal Host$, ByVal Port%, retIpPort$, ByVal HWndToMsg%, ByVal Async%) As Integer
  395.  
  396.     Dim s%, SelectOps%, dummy%
  397.  
  398. #ElseIf Win32 Then
  399.  
  400.     Function ConnectSock(ByVal Host$, ByVal Port&, retIpPort$, ByVal HWndToMsg&, ByVal Async%) As Long
  401.  
  402.     Dim s&, SelectOps&, dummy&
  403.  
  404. #End If
  405.  
  406.     Dim sockin As sockaddr
  407.  
  408.     SockReadBuffer$ = ""
  409.  
  410.     sockin = saZero
  411.  
  412.     sockin.sin_family = AF_INET
  413.  
  414.     sockin.sin_port = htons(Port)
  415.  
  416.     If sockin.sin_port = INVALID_SOCKET Then
  417.  
  418.         ConnectSock = INVALID_SOCKET
  419.  
  420.         Exit Function
  421.  
  422.     End If
  423.  
  424.  
  425.  
  426.     sockin.sin_addr = GetHostByNameAlias(Host$)
  427.  
  428.     If sockin.sin_addr = INADDR_NONE Then
  429.  
  430.         ConnectSock = INVALID_SOCKET
  431.  
  432.         Exit Function
  433.  
  434.     End If
  435.  
  436.     retIpPort$ = GetAscIP$(sockin.sin_addr) & ":" & ntohs(sockin.sin_port)
  437.  
  438.  
  439.  
  440.     s = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP)
  441.  
  442.     If s < 0 Then
  443.  
  444.         ConnectSock = INVALID_SOCKET
  445.  
  446.         Exit Function
  447.  
  448.     End If
  449.  
  450.     If SetSockLinger(s, 1, 0) = SOCKET_ERROR Then
  451.  
  452.         If s > 0 Then
  453.  
  454.             dummy = closesocket(s)
  455.  
  456.         End If
  457.  
  458.         ConnectSock = INVALID_SOCKET
  459.  
  460.         Exit Function
  461.  
  462.     End If
  463.  
  464.     If Not Async Then
  465.  
  466.         If Not connect(s, sockin, sockaddr_size) = 0 Then
  467.  
  468.             If s > 0 Then
  469.  
  470.                 dummy = closesocket(s)
  471.  
  472.             End If
  473.  
  474.             ConnectSock = INVALID_SOCKET
  475.  
  476.             Exit Function
  477.  
  478.         End If
  479.  
  480.         If HWndToMsg <> 0 Then
  481.  
  482.             SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE
  483.  
  484.             If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
  485.  
  486.                 If s > 0 Then
  487.  
  488.                     dummy = closesocket(s)
  489.  
  490.                 End If
  491.  
  492.                 ConnectSock = INVALID_SOCKET
  493.  
  494.                 Exit Function
  495.  
  496.             End If
  497.  
  498.         End If
  499.  
  500.     Else
  501.  
  502.         SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE
  503.  
  504.         If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
  505.  
  506.             If s > 0 Then
  507.  
  508.                 dummy = closesocket(s)
  509.  
  510.             End If
  511.  
  512.             ConnectSock = INVALID_SOCKET
  513.  
  514.             Exit Function
  515.  
  516.         End If
  517.  
  518.         If connect(s, sockin, sockaddr_size) <> -1 Then
  519.  
  520.             If s > 0 Then
  521.  
  522.                 dummy = closesocket(s)
  523.  
  524.             End If
  525.  
  526.             ConnectSock = INVALID_SOCKET
  527.  
  528.             Exit Function
  529.  
  530.         End If
  531.  
  532.     End If
  533.  
  534.     ConnectSock = s
  535.  
  536. End Function
  537.  
  538.  
  539.  
  540. #If Win32 Then
  541.  
  542.     Public Function SetSockLinger(ByVal SockNum&, ByVal OnOff%, ByVal LingerTime%) As Long
  543.  
  544. #Else
  545.  
  546.     Public Function SetSockLinger(ByVal SockNum%, ByVal OnOff%, ByVal LingerTime%) As Integer
  547.  
  548. #End If
  549.  
  550.     Dim Linger As LingerType
  551.  
  552.     Linger.l_onoff = OnOff
  553.  
  554.     Linger.l_linger = LingerTime
  555.  
  556.     If setsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then
  557.  
  558.         Debug.Print "Error setting linger info: " & WSAGetLastError()
  559.  
  560.         SetSockLinger = SOCKET_ERROR
  561.  
  562.     Else
  563.  
  564.         If getsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then
  565.  
  566.             Debug.Print "Error getting linger info: " & WSAGetLastError()
  567.  
  568.             SetSockLinger = SOCKET_ERROR
  569.  
  570.         Else
  571.  
  572.             Debug.Print "Linger is on if nonzero: "; Linger.l_onoff
  573.  
  574.             Debug.Print "Linger time if linger is on: "; Linger.l_linger
  575.  
  576.         End If
  577.  
  578.     End If
  579.  
  580. End Function
  581.  
  582.  
  583.  
  584. Sub EndWinsock()
  585.  
  586.     Dim ret&
  587.  
  588.     If WSAIsBlocking() Then
  589.  
  590.         ret = WSACancelBlockingCall()
  591.  
  592.     End If
  593.  
  594.     ret = WSACleanup()
  595.  
  596.     WSAStartedUp = False
  597.  
  598. End Sub
  599.  
  600.  
  601.  
  602. Public Function GetAscIP(ByVal inn As Long) As String
  603.  
  604.     #If Win32 Then
  605.  
  606.         Dim nStr&
  607.  
  608.     #Else
  609.  
  610.         Dim nStr%
  611.  
  612.     #End If
  613.  
  614.     Dim lpStr&
  615.  
  616.     Dim retString$
  617.  
  618.     retString = String(32, 0)
  619.  
  620.     lpStr = inet_ntoa(inn)
  621.  
  622.     If lpStr Then
  623.  
  624.         nStr = lstrlen(lpStr)
  625.  
  626.         If nStr > 32 Then nStr = 32
  627.  
  628.         MemCopy ByVal retString, ByVal lpStr, nStr
  629.  
  630.         retString = Left(retString, nStr)
  631.  
  632.         GetAscIP = retString
  633.  
  634.     Else
  635.  
  636.         GetAscIP = "255.255.255.255"
  637.  
  638.     End If
  639.  
  640. End Function
  641.  
  642.  
  643.  
  644. Public Function GetHostByAddress(ByVal addr As Long) As String
  645.  
  646.     Dim phe&, ret&
  647.  
  648.     Dim heDestHost As HostEnt
  649.  
  650.     Dim HostName$
  651.  
  652.     phe = gethostbyaddr(addr, 4, PF_INET)
  653.  
  654.     If phe Then
  655.  
  656.         MemCopy heDestHost, ByVal phe, hostent_size
  657.  
  658.         HostName = String(256, 0)
  659.  
  660.         MemCopy ByVal HostName, ByVal heDestHost.h_name, 256
  661.  
  662.         GetHostByAddress = Left(HostName, InStr(HostName, Chr(0)) - 1)
  663.  
  664.     Else
  665.  
  666.         GetHostByAddress = WSA_NoName
  667.  
  668.     End If
  669.  
  670. End Function
  671.  
  672.  
  673.  
  674. 'returns IP as long, in network byte order
  675.  
  676. Public Function GetHostByNameAlias(ByVal HostName$) As Long
  677.  
  678.     'Return IP address as a long, in network byte order
  679.  
  680.     Dim phe&
  681.  
  682.     Dim heDestHost As HostEnt
  683.  
  684.     Dim addrList&
  685.  
  686.     Dim retIP&
  687.  
  688.     retIP = inet_addr(HostName$)
  689.  
  690.     If retIP = INADDR_NONE Then
  691.  
  692.         phe = gethostbyname(HostName$)
  693.  
  694.         If phe <> 0 Then
  695.  
  696.             MemCopy heDestHost, ByVal phe, hostent_size
  697.  
  698.             MemCopy addrList, ByVal heDestHost.h_addr_list, 4
  699.  
  700.             MemCopy retIP, ByVal addrList, heDestHost.h_length
  701.  
  702.         Else
  703.  
  704.             retIP = INADDR_NONE
  705.  
  706.         End If
  707.  
  708.     End If
  709.  
  710.     GetHostByNameAlias = retIP
  711.  
  712. End Function
  713.  
  714.  
  715.  
  716. 'returns your local machines name
  717.  
  718. Public Function GetLocalHostName() As String
  719.  
  720.     Dim sName$
  721.  
  722.     sName = String(256, 0)
  723.  
  724.     If gethostname(sName, 256) Then
  725.  
  726.         sName = WSA_NoName
  727.  
  728.     Else
  729.  
  730.         If InStr(sName, Chr(0)) Then
  731.  
  732.             sName = Left(sName, InStr(sName, Chr(0)) - 1)
  733.  
  734.         End If
  735.  
  736.     End If
  737.  
  738.     GetLocalHostName = sName
  739.  
  740. End Function
  741.  
  742.  
  743.  
  744. #If Win16 Then
  745.  
  746.     Public Function GetPeerAddress(ByVal s%) As String
  747.  
  748.     Dim addrlen%
  749.  
  750. #ElseIf Win32 Then
  751.  
  752.     Public Function GetPeerAddress(ByVal s&) As String
  753.  
  754.     Dim addrlen&
  755.  
  756. #End If
  757.  
  758.     Dim sa As sockaddr
  759.  
  760.     addrlen = sockaddr_size
  761.  
  762.     If getpeername(s, sa, addrlen) Then
  763.  
  764.         GetPeerAddress = ""
  765.  
  766.     Else
  767.  
  768.         GetPeerAddress = SockAddressToString(sa)
  769.  
  770.     End If
  771.  
  772. End Function
  773.  
  774.  
  775.  
  776. #If Win16 Then
  777.  
  778.     Public Function GetPortFromString(ByVal PortStr$) As Integer
  779.  
  780. #ElseIf Win32 Then
  781.  
  782.     Public Function GetPortFromString(ByVal PortStr$) As Long
  783.  
  784. #End If
  785.  
  786.     'sometimes users provide ports outside the range of a VB
  787.  
  788.     'integer, so this function returns an integer for a string
  789.  
  790.     'just to keep an error from happening, it converts the
  791.  
  792.     'number to a negative if needed
  793.  
  794.     If Val(PortStr$) > 32767 Then
  795.  
  796.         GetPortFromString = CInt(Val(PortStr$) - &H10000)
  797.  
  798.     Else
  799.  
  800.         GetPortFromString = Val(PortStr$)
  801.  
  802.     End If
  803.  
  804.     If Err Then GetPortFromString = 0
  805.  
  806. End Function
  807.  
  808.  
  809.  
  810. #If Win16 Then
  811.  
  812.     Function GetProtocolByName(ByVal protocol$) As Integer
  813.  
  814.     Dim tmpShort%
  815.  
  816. #ElseIf Win32 Then
  817.  
  818.     Function GetProtocolByName(ByVal protocol$) As Long
  819.  
  820.     Dim tmpShort&
  821.  
  822. #End If
  823.  
  824.     Dim ppe&
  825.  
  826.     Dim peDestProt As protoent
  827.  
  828.     ppe = getprotobyname(protocol)
  829.  
  830.     If ppe Then
  831.  
  832.         MemCopy peDestProt, ByVal ppe, protoent_size
  833.  
  834.         GetProtocolByName = peDestProt.p_proto
  835.  
  836.     Else
  837.  
  838.         tmpShort = Val(protocol)
  839.  
  840.         If tmpShort Then
  841.  
  842.             GetProtocolByName = htons(tmpShort)
  843.  
  844.         Else
  845.  
  846.             GetProtocolByName = SOCKET_ERROR
  847.  
  848.         End If
  849.  
  850.     End If
  851.  
  852. End Function
  853.  
  854.  
  855.  
  856. #If Win16 Then
  857.  
  858.     Function GetServiceByName(ByVal service$, ByVal protocol$) As Integer
  859.  
  860.     Dim serv%
  861.  
  862. #ElseIf Win32 Then
  863.  
  864.     Function GetServiceByName(ByVal service$, ByVal protocol$) As Long
  865.  
  866.     Dim serv&
  867.  
  868. #End If
  869.  
  870.     Dim pse&
  871.  
  872.     Dim seDestServ As servent
  873.  
  874.     pse = getservbyname(service, protocol)
  875.  
  876.     If pse Then
  877.  
  878.         MemCopy seDestServ, ByVal pse, servent_size
  879.  
  880.         GetServiceByName = seDestServ.s_port
  881.  
  882.     Else
  883.  
  884.         serv = Val(service)
  885.  
  886.         If serv Then
  887.  
  888.             GetServiceByName = htons(serv)
  889.  
  890.         Else
  891.  
  892.             GetServiceByName = INVALID_SOCKET
  893.  
  894.         End If
  895.  
  896.     End If
  897.  
  898. End Function
  899.  
  900.  
  901.  
  902. 'this function DOES work on 16 and 32 bit systems
  903.  
  904. #If Win16 Then
  905.  
  906.     Function GetSockAddress(ByVal s%) As String
  907.  
  908.     Dim addrlen%
  909.  
  910.     Dim ret%
  911.  
  912. #ElseIf Win32 Then
  913.  
  914.     Function GetSockAddress(ByVal s&) As String
  915.  
  916.     Dim addrlen&
  917.  
  918.     Dim ret&
  919.  
  920. #End If
  921.  
  922.     Dim sa As sockaddr
  923.  
  924.     Dim szRet$
  925.  
  926.     szRet = String(32, 0)
  927.  
  928.     addrlen = sockaddr_size
  929.  
  930.     If getsockname(s, sa, addrlen) Then
  931.  
  932.         GetSockAddress = ""
  933.  
  934.     Else
  935.  
  936.         GetSockAddress = SockAddressToString(sa)
  937.  
  938.     End If
  939.  
  940. End Function
  941.  
  942.  
  943.  
  944. 'this function should work on 16 and 32 bit systems
  945.  
  946. Function GetWSAErrorString(ByVal errnum&) As String
  947.  
  948.     On Error Resume Next
  949.  
  950.     Select Case errnum
  951.  
  952.         Case 10004: GetWSAErrorString = "Interrupted system call."
  953.  
  954.         Case 10009: GetWSAErrorString = "Bad file number."
  955.  
  956.         Case 10013: GetWSAErrorString = "Permission Denied."
  957.  
  958.         Case 10014: GetWSAErrorString = "Bad Address."
  959.  
  960.         Case 10022: GetWSAErrorString = "Invalid Argument."
  961.  
  962.         Case 10024: GetWSAErrorString = "Too many open files."
  963.  
  964.         Case 10035: GetWSAErrorString = "Operation would block."
  965.  
  966.         Case 10036: GetWSAErrorString = "Operation now in progress."
  967.  
  968.         Case 10037: GetWSAErrorString = "Operation already in progress."
  969.  
  970.         Case 10038: GetWSAErrorString = "Socket operation on nonsocket."
  971.  
  972.         Case 10039: GetWSAErrorString = "Destination address required."
  973.  
  974.         Case 10040: GetWSAErrorString = "Message too long."
  975.  
  976.         Case 10041: GetWSAErrorString = "Protocol wrong type for socket."
  977.  
  978.         Case 10042: GetWSAErrorString = "Protocol not available."
  979.  
  980.         Case 10043: GetWSAErrorString = "Protocol not supported."
  981.  
  982.         Case 10044: GetWSAErrorString = "Socket type not supported."
  983.  
  984.         Case 10045: GetWSAErrorString = "Operation not supported on socket."
  985.  
  986.         Case 10046: GetWSAErrorString = "Protocol family not supported."
  987.  
  988.         Case 10047: GetWSAErrorString = "Address family not supported by protocol family."
  989.  
  990.         Case 10048: GetWSAErrorString = "Address already in use."
  991.  
  992.         Case 10049: GetWSAErrorString = "Can't assign requested address."
  993.  
  994.         Case 10050: GetWSAErrorString = "Network is down."
  995.  
  996.         Case 10051: GetWSAErrorString = "Network is unreachable."
  997.  
  998.         Case 10052: GetWSAErrorString = "Network dropped connection."
  999.  
  1000.         Case 10053: GetWSAErrorString = "Software caused connection abort."
  1001.  
  1002.         Case 10054: GetWSAErrorString = "Connection reset by peer."
  1003.  
  1004.         Case 10055: GetWSAErrorString = "No buffer space available."
  1005.  
  1006.         Case 10056: GetWSAErrorString = "Socket is already connected."
  1007.  
  1008.         Case 10057: GetWSAErrorString = "Socket is not connected."
  1009.  
  1010.         Case 10058: GetWSAErrorString = "Can't send after socket shutdown."
  1011.  
  1012.         Case 10059: GetWSAErrorString = "Too many references: can't splice."
  1013.  
  1014.         Case 10060: GetWSAErrorString = "Connection timed out."
  1015.  
  1016.         Case 10061: GetWSAErrorString = "Connection refused."
  1017.  
  1018.         Case 10062: GetWSAErrorString = "Too many levels of symbolic links."
  1019.  
  1020.         Case 10063: GetWSAErrorString = "File name too long."
  1021.  
  1022.         Case 10064: GetWSAErrorString = "Host is down."
  1023.  
  1024.         Case 10065: GetWSAErrorString = "No route to host."
  1025.  
  1026.         Case 10066: GetWSAErrorString = "Directory not empty."
  1027.  
  1028.         Case 10067: GetWSAErrorString = "Too many processes."
  1029.  
  1030.         Case 10068: GetWSAErrorString = "Too many users."
  1031.  
  1032.         Case 10069: GetWSAErrorString = "Disk quota exceeded."
  1033.  
  1034.         Case 10070: GetWSAErrorString = "Stale NFS file handle."
  1035.  
  1036.         Case 10071: GetWSAErrorString = "Too many levels of remote in path."
  1037.  
  1038.         Case 10091: GetWSAErrorString = "Network subsystem is unusable."
  1039.  
  1040.         Case 10092: GetWSAErrorString = "Winsock DLL cannot support this application."
  1041.  
  1042.         Case 10093: GetWSAErrorString = "Winsock not initialized."
  1043.  
  1044.         Case 10101: GetWSAErrorString = "Disconnect."
  1045.  
  1046.         Case 11001: GetWSAErrorString = "Host not found."
  1047.  
  1048.         Case 11002: GetWSAErrorString = "Nonauthoritative host not found."
  1049.  
  1050.         Case 11003: GetWSAErrorString = "Nonrecoverable error."
  1051.  
  1052.         Case 11004: GetWSAErrorString = "Valid name, no data record of requested type."
  1053.  
  1054.         Case Else:
  1055.  
  1056.     End Select
  1057.  
  1058. End Function
  1059.  
  1060.  
  1061.  
  1062. 'this function DOES work on 16 and 32 bit systems
  1063.  
  1064. Function IpToAddr(ByVal AddrOrIP$) As String
  1065.  
  1066.     On Error Resume Next
  1067.  
  1068.     IpToAddr = GetHostByAddress(GetHostByNameAlias(AddrOrIP$))
  1069.  
  1070.     If Err Then IpToAddr = WSA_NoName
  1071.  
  1072. End Function
  1073.  
  1074.  
  1075.  
  1076. 'this function DOES work on 16 and 32 bit systems
  1077.  
  1078. Function IrcGetAscIp(ByVal IPL$) As String
  1079.  
  1080.     'this function is IRC specific, it expects a long ip stored in Network byte order, in a string
  1081.  
  1082.     'the kind that would be parsed out of a DCC command string
  1083.  
  1084.     On Error GoTo IrcGetAscIPError:
  1085.  
  1086.     Dim lpStr&
  1087.  
  1088. #If Win16 Then
  1089.  
  1090.     Dim nStr%
  1091.  
  1092. #ElseIf Win32 Then
  1093.  
  1094.     Dim nStr&
  1095.  
  1096. #End If
  1097.  
  1098.     Dim retString$
  1099.  
  1100.     Dim inn&
  1101.  
  1102.     If Val(IPL) > 2147483647 Then
  1103.  
  1104.         inn = Val(IPL) - 4294967296#
  1105.  
  1106.     Else
  1107.  
  1108.         inn = Val(IPL)
  1109.  
  1110.     End If
  1111.  
  1112.     inn = ntohl(inn)
  1113.  
  1114.     retString = String(32, 0)
  1115.  
  1116.     lpStr = inet_ntoa(inn)
  1117.  
  1118.     If lpStr = 0 Then
  1119.  
  1120.         IrcGetAscIp = "0.0.0.0"
  1121.  
  1122.         Exit Function
  1123.  
  1124.     End If
  1125.  
  1126.     nStr = lstrlen(lpStr)
  1127.  
  1128.     If nStr > 32 Then nStr = 32
  1129.  
  1130.     MemCopy ByVal retString, ByVal lpStr, nStr
  1131.  
  1132.     retString = Left(retString, nStr)
  1133.  
  1134.     IrcGetAscIp = retString
  1135.  
  1136.     Exit Function
  1137.  
  1138. IrcGetAscIPError:
  1139.  
  1140.     IrcGetAscIp = "0.0.0.0"
  1141.  
  1142.     Exit Function
  1143.  
  1144.     Resume
  1145.  
  1146. End Function
  1147.  
  1148.  
  1149.  
  1150. 'this function DOES work on 16 and 32 bit systems
  1151.  
  1152. Function IrcGetLongIp(ByVal AscIp$) As String
  1153.  
  1154.     'this function converts an ascii ip string into a long ip in network byte order
  1155.  
  1156.     'and stick it in a string suitable for use in a DCC command.
  1157.  
  1158.     On Error GoTo IrcGetLongIpError:
  1159.  
  1160.     Dim inn&
  1161.  
  1162.     inn = inet_addr(AscIp)
  1163.  
  1164.     inn = htonl(inn)
  1165.  
  1166.     If inn < 0 Then
  1167.  
  1168.         IrcGetLongIp = CVar(inn + 4294967296#)
  1169.  
  1170.         Exit Function
  1171.  
  1172.     Else
  1173.  
  1174.         IrcGetLongIp = CVar(inn)
  1175.  
  1176.         Exit Function
  1177.  
  1178.     End If
  1179.  
  1180.     Exit Function
  1181.  
  1182. IrcGetLongIpError:
  1183.  
  1184.     IrcGetLongIp = "0"
  1185.  
  1186.     Exit Function
  1187.  
  1188.     Resume
  1189.  
  1190. End Function
  1191.  
  1192.  
  1193.  
  1194. 'this function should work on 16 and 32 bit systems
  1195.  
  1196. #If Win16 Then
  1197.  
  1198. Public Function ListenForConnect(ByVal Port%, ByVal HWndToMsg%) As Integer
  1199.  
  1200.     Dim s%, dummy%
  1201.  
  1202.     Dim SelectOps%
  1203.  
  1204. #ElseIf Win32 Then
  1205.  
  1206. Public Function ListenForConnect(ByVal Port&, ByVal HWndToMsg&) As Long
  1207.  
  1208.     Dim s&, dummy&
  1209.  
  1210.     Dim SelectOps&
  1211.  
  1212. #End If
  1213.  
  1214.     Dim sockin As sockaddr
  1215.  
  1216.     sockin = saZero     'zero out the structure
  1217.  
  1218.     sockin.sin_family = AF_INET
  1219.  
  1220.     sockin.sin_port = htons(Port)
  1221.  
  1222.     If sockin.sin_port = INVALID_SOCKET Then
  1223.  
  1224.         ListenForConnect = INVALID_SOCKET
  1225.  
  1226.         Exit Function
  1227.  
  1228.     End If
  1229.  
  1230.     sockin.sin_addr = htonl(INADDR_ANY)
  1231.  
  1232.     If sockin.sin_addr = INADDR_NONE Then
  1233.  
  1234.         ListenForConnect = INVALID_SOCKET
  1235.  
  1236.         Exit Function
  1237.  
  1238.     End If
  1239.  
  1240.     s = socket(PF_INET, SOCK_STREAM, 0)
  1241.  
  1242.     If s < 0 Then
  1243.  
  1244.         ListenForConnect = INVALID_SOCKET
  1245.  
  1246.         Exit Function
  1247.  
  1248.     End If
  1249.  
  1250.     If bind(s, sockin, sockaddr_size) Then
  1251.  
  1252.         If s > 0 Then
  1253.  
  1254.             dummy = closesocket(s)
  1255.  
  1256.         End If
  1257.  
  1258.         ListenForConnect = INVALID_SOCKET
  1259.  
  1260.         Exit Function
  1261.  
  1262.     End If
  1263.  
  1264.     SelectOps = FD_READ Or FD_WRITE Or FD_CLOSE Or FD_ACCEPT
  1265.  
  1266.     If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
  1267.  
  1268.         If s > 0 Then
  1269.  
  1270.             dummy = closesocket(s)
  1271.  
  1272.         End If
  1273.  
  1274.         ListenForConnect = SOCKET_ERROR
  1275.  
  1276.         Exit Function
  1277.  
  1278.     End If
  1279.  
  1280.     
  1281.  
  1282.     If listen(s, 1) Then
  1283.  
  1284.         If s > 0 Then
  1285.  
  1286.             dummy = closesocket(s)
  1287.  
  1288.         End If
  1289.  
  1290.         ListenForConnect = INVALID_SOCKET
  1291.  
  1292.         Exit Function
  1293.  
  1294.     End If
  1295.  
  1296.     ListenForConnect = s
  1297.  
  1298. End Function
  1299.  
  1300.  
  1301.  
  1302. 'this function should work on 16 and 32 bit systems
  1303.  
  1304. #If Win16 Then
  1305.  
  1306. Public Function SendData(ByVal s%, vMessage As Variant) As Integer
  1307.  
  1308. #ElseIf Win32 Then
  1309.  
  1310. Public Function SendData(ByVal s&, vMessage As Variant) As Long
  1311.  
  1312. #End If
  1313.  
  1314.     Dim TheMsg() As Byte, sTemp$
  1315.  
  1316.     TheMsg = ""
  1317.  
  1318.     Select Case VarType(vMessage)
  1319.  
  1320.         Case 8209   'byte array
  1321.  
  1322.             sTemp = vMessage
  1323.  
  1324.             TheMsg = sTemp
  1325.  
  1326.         Case 8      'string, if we recieve a string, its assumed we are linemode
  1327.  
  1328.             #If Win32 Then
  1329.  
  1330.                 sTemp = StrConv(vMessage, vbFromUnicode)
  1331.  
  1332.             #Else
  1333.  
  1334.                 sTemp = vMessage
  1335.  
  1336.             #End If
  1337.  
  1338.         Case Else
  1339.  
  1340.             sTemp = CStr(vMessage)
  1341.  
  1342.             #If Win32 Then
  1343.  
  1344.                 sTemp = StrConv(vMessage, vbFromUnicode)
  1345.  
  1346.             #Else
  1347.  
  1348.                 sTemp = vMessage
  1349.  
  1350.             #End If
  1351.  
  1352.     End Select
  1353.  
  1354.     TheMsg = sTemp
  1355.  
  1356.     If UBound(TheMsg) > -1 Then
  1357.  
  1358.         SendData = send(s, TheMsg(0), UBound(TheMsg) + 1, 0)
  1359.  
  1360.     End If
  1361.  
  1362. End Function
  1363.  
  1364.  
  1365.  
  1366. Public Function SockAddressToString(sa As sockaddr) As String
  1367.  
  1368.     SockAddressToString = GetAscIP(sa.sin_addr) & ":" & ntohs(sa.sin_port)
  1369.  
  1370. End Function
  1371.  
  1372.  
  1373.  
  1374. Public Function StartWinsock(sDescription As String) As Boolean
  1375.  
  1376.     Dim StartupData As WSADataType
  1377.  
  1378.     If Not WSAStartedUp Then
  1379.  
  1380.         If Not WSAStartup(&H101, StartupData) Then
  1381.  
  1382.             WSAStartedUp = True
  1383.  
  1384.             Debug.Print "wVersion="; StartupData.wVersion, "wHighVersion="; StartupData.wHighVersion
  1385.  
  1386.             Debug.Print "If wVersion == 257 then everything is kewl"
  1387.  
  1388.             Debug.Print "szDescription="; StartupData.szDescription
  1389.  
  1390.             Debug.Print "szSystemStatus="; StartupData.szSystemStatus
  1391.  
  1392.             Debug.Print "iMaxSockets="; StartupData.iMaxSockets, "iMaxUdpDg="; StartupData.iMaxUdpDg
  1393.  
  1394.             sDescription = StartupData.szDescription
  1395.  
  1396.         Else
  1397.  
  1398.             WSAStartedUp = False
  1399.  
  1400.         End If
  1401.  
  1402.     End If
  1403.  
  1404.     StartWinsock = WSAStartedUp
  1405.  
  1406. End Function
  1407.  
  1408.  
  1409.  
  1410. Public Function WSAMakeSelectReply(TheEvent%, TheError%) As Long
  1411.  
  1412.     WSAMakeSelectReply = (TheError * &H10000) + (TheEvent And &HFFFF&)
  1413.  
  1414. End Function
  1415.  
  1416.  
  1417.  
  1418.  
  1419.  
  1420.