home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 27 / CDROM27.iso / share / progra / mai / wsksock.bas < prev   
Encoding:
BASIC Source File  |  1997-08-08  |  35.5 KB  |  834 lines
  1. Attribute VB_Name = "Module1"
  2. 'date stamp: Aug 8, 1997
  3.  
  4. 'Visual Basic 4.0 Winsock "Header"
  5. '   Alot of the information contained inside this file was originally
  6. '   obtained from ALT.WINSOCK.PROGRAMMING and most of it has since been
  7. '   modified in some way.
  8.  
  9. Option Explicit
  10.  
  11. Public Const FD_SETSIZE = 64
  12. Type fd_set
  13.     fd_count As Integer
  14.     fd_array(FD_SETSIZE) As Integer
  15. End Type
  16.  
  17. Type timeval
  18.     tv_sec As Long
  19.     tv_usec As Long
  20. End Type
  21.  
  22. Type HostEnt
  23.     h_name As Long
  24.     h_aliases As Long
  25.     h_addrtype As Integer
  26.     h_length As Integer
  27.     h_addr_list As Long
  28. End Type
  29. Public Const hostent_size = 16
  30.  
  31. Type servent
  32.     s_name As Long
  33.     s_aliases As Long
  34.     s_port As Integer
  35.     s_proto As Long
  36. End Type
  37. Public Const servent_size = 14
  38.  
  39. Type protoent
  40.     p_name As Long
  41.     p_aliases As Long
  42.     p_proto As Integer
  43. End Type
  44. Public Const protoent_size = 10
  45.  
  46. Public Const IPPROTO_TCP = 6
  47. Public Const IPPROTO_UDP = 17
  48.  
  49. Public Const INADDR_NONE = &HFFFF
  50. Public Const INADDR_ANY = &H0
  51.  
  52. Type sockaddr
  53.     sin_family As Integer
  54.     sin_port As Integer
  55.     sin_addr As Long
  56.     sin_zero As String * 8
  57. End Type
  58. Public Const sockaddr_size = 16
  59. Public saZero As sockaddr
  60.  
  61.  
  62. Public Const WSA_DESCRIPTIONLEN = 256
  63. Public Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1
  64.  
  65. Public Const WSA_SYS_STATUS_LEN = 128
  66. Public Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1
  67.  
  68. Type WSADataType
  69.     wVersion As Integer
  70.     wHighVersion As Integer
  71.     szDescription As String * WSA_DescriptionSize
  72.     szSystemStatus As String * WSA_SysStatusSize
  73.     iMaxSockets As Integer
  74.     iMaxUdpDg As Integer
  75.     lpVendorInfo As Long
  76. End Type
  77.  
  78. Public Const INVALID_SOCKET = -1
  79. Public Const SOCKET_ERROR = -1
  80.  
  81. Public Const SOCK_STREAM = 1
  82. Public Const SOCK_DGRAM = 2
  83.  
  84. Public Const MAXGETHOSTSTRUCT = 1024
  85.  
  86. Public Const AF_INET = 2
  87. Public Const PF_INET = 2
  88.  
  89. Type LingerType
  90.     l_onoff As Integer
  91.     l_linger As Integer
  92. End Type
  93. ' Windows Sockets definitions of regular Microsoft C error constants
  94. Global Const WSAEINTR = 10004
  95. Global Const WSAEBADF = 10009
  96. Global Const WSAEACCES = 10013
  97. Global Const WSAEFAULT = 10014
  98. Global Const WSAEINVAL = 10022
  99. Global Const WSAEMFILE = 10024
  100. ' Windows Sockets definitions of regular Berkeley error constants
  101. Global Const WSAEWOULDBLOCK = 10035
  102. Global Const WSAEINPROGRESS = 10036
  103. Global Const WSAEALREADY = 10037
  104. Global Const WSAENOTSOCK = 10038
  105. Global Const WSAEDESTADDRREQ = 10039
  106. Global Const WSAEMSGSIZE = 10040
  107. Global Const WSAEPROTOTYPE = 10041
  108. Global Const WSAENOPROTOOPT = 10042
  109. Global Const WSAEPROTONOSUPPORT = 10043
  110. Global Const WSAESOCKTNOSUPPORT = 10044
  111. Global Const WSAEOPNOTSUPP = 10045
  112. Global Const WSAEPFNOSUPPORT = 10046
  113. Global Const WSAEAFNOSUPPORT = 10047
  114. Global Const WSAEADDRINUSE = 10048
  115. Global Const WSAEADDRNOTAVAIL = 10049
  116. Global Const WSAENETDOWN = 10050
  117. Global Const WSAENETUNREACH = 10051
  118. Global Const WSAENETRESET = 10052
  119. Global Const WSAECONNABORTED = 10053
  120. Global Const WSAECONNRESET = 10054
  121. Global Const WSAENOBUFS = 10055
  122. Global Const WSAEISCONN = 10056
  123. Global Const WSAENOTCONN = 10057
  124. Global Const WSAESHUTDOWN = 10058
  125. Global Const WSAETOOMANYREFS = 10059
  126. Global Const WSAETIMEDOUT = 10060
  127. Global Const WSAECONNREFUSED = 10061
  128. Global Const WSAELOOP = 10062
  129. Global Const WSAENAMETOOLONG = 10063
  130. Global Const WSAEHOSTDOWN = 10064
  131. Global Const WSAEHOSTUNREACH = 10065
  132. Global Const WSAENOTEMPTY = 10066
  133. Global Const WSAEPROCLIM = 10067
  134. Global Const WSAEUSERS = 10068
  135. Global Const WSAEDQUOT = 10069
  136. Global Const WSAESTALE = 10070
  137. Global Const WSAEREMOTE = 10071
  138. ' Extended Windows Sockets error constant definitions
  139. Global Const WSASYSNOTREADY = 10091
  140. Global Const WSAVERNOTSUPPORTED = 10092
  141. Global Const WSANOTINITIALISED = 10093
  142. Global Const WSAHOST_NOT_FOUND = 11001
  143. Global Const WSATRY_AGAIN = 11002
  144. Global Const WSANO_RECOVERY = 11003
  145. Global Const WSANO_DATA = 11004
  146. Global Const WSANO_ADDRESS = 11004
  147. '---ioctl Constants
  148.     Public Const FIONREAD = &H8004667F
  149.     Public Const FIONBIO = &H8004667E
  150.     Public Const FIOASYNC = &H8004667D
  151.  
  152. #If Win16 Then
  153. '---Windows System functions
  154.     Public Declare Function PostMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Integer
  155.     Public Declare Sub MemCopy Lib "Kernel" Alias "hmemcpy" (Dest As Any, Src As Any, ByVal cb&)
  156.     Public Declare Function lstrlen Lib "Kernel" (ByVal lpString As Any) As Integer
  157. '---async notification constants
  158.     Public Const SOL_SOCKET = &HFFFF
  159.     Public Const SO_LINGER = &H80
  160.     Public Const FD_READ = &H1
  161.     Public Const FD_WRITE = &H2
  162.     Public Const FD_OOB = &H4
  163.     Public Const FD_ACCEPT = &H8
  164.     Public Const FD_CONNECT = &H10
  165.     Public Const FD_CLOSE = &H20
  166. '---SOCKET FUNCTIONS
  167.     Public Declare Function accept Lib "Winsock.dll" (ByVal s As Integer, addr As sockaddr, addrlen As Integer) As Integer
  168.     Public Declare Function bind Lib "Winsock.dll" (ByVal s As Integer, addr As sockaddr, ByVal namelen As Integer) As Integer
  169.     Public Declare Function closesocket Lib "Winsock.dll" (ByVal s As Integer) As Integer
  170.     Public Declare Function connect Lib "Winsock.dll" (ByVal s As Integer, addr As sockaddr, ByVal namelen As Integer) As Integer
  171.     Public Declare Function ioctlsocket Lib "Winsock.dll" (ByVal s As Integer, ByVal cmd As Long, argp As Long) As Integer
  172.     Public Declare Function getpeername Lib "Winsock.dll" (ByVal s As Integer, sName As sockaddr, namelen As Integer) As Integer
  173.     Public Declare Function getsockname Lib "Winsock.dll" (ByVal s As Integer, sName As sockaddr, namelen As Integer) As Integer
  174.     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
  175.     Public Declare Function htonl Lib "Winsock.dll" (ByVal hostlong As Long) As Long
  176.     Public Declare Function htons Lib "Winsock.dll" (ByVal hostshort As Integer) As Integer
  177.     Public Declare Function inet_addr Lib "Winsock.dll" (ByVal cp As String) As Long
  178.     Public Declare Function inet_ntoa Lib "Winsock.dll" (ByVal inn As Long) As Long
  179.     Public Declare Function listen Lib "Winsock.dll" (ByVal s As Integer, ByVal backlog As Integer) As Integer
  180.     Public Declare Function ntohl Lib "Winsock.dll" (ByVal netlong As Long) As Long
  181.     Public Declare Function ntohs Lib "Winsock.dll" (ByVal netshort As Integer) As Integer
  182.     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
  183.     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
  184.     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
  185.     Public Declare Function send Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer) As Integer
  186.     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
  187.     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
  188.     Public Declare Function ShutDown Lib "Winsock.dll" Alias "shutdown" (ByVal s As Integer, ByVal how As Integer) As Integer
  189.     Public Declare Function socket Lib "Winsock.dll" (ByVal af As Integer, ByVal s_type As Integer, ByVal protocol As Integer) As Integer
  190. '---DATABASE FUNCTIONS
  191.     Public Declare Function gethostbyaddr Lib "Winsock.dll" (addr As Long, ByVal addr_len As Integer, ByVal addr_type As Integer) As Long
  192.     Public Declare Function gethostbyname Lib "Winsock.dll" (ByVal host_name As String) As Long
  193.     Public Declare Function gethostname Lib "Winsock.dll" (ByVal host_name As String, ByVal namelen As Integer) As Integer
  194.     Public Declare Function getservbyport Lib "Winsock.dll" (ByVal Port As Integer, ByVal proto As String) As Long
  195.     Public Declare Function getservbyname Lib "Winsock.dll" (ByVal serv_name As String, ByVal proto As String) As Long
  196.     Public Declare Function getprotobynumber Lib "Winsock.dll" (ByVal proto As Integer) As Long
  197.     Public Declare Function getprotobyname Lib "Winsock.dll" (ByVal proto_name As String) As Long
  198. '---WINDOWS EXTENSIONS
  199.     Public Declare Function WSAStartup Lib "Winsock.dll" (ByVal wVR As Integer, lpWSAD As WSADataType) As Integer
  200.     Public Declare Function WSACleanup Lib "Winsock.dll" () As Integer
  201.     Public Declare Sub WSASetLastError Lib "Winsock.dll" (ByVal iError As Integer)
  202.     Public Declare Function WSAGetLastError Lib "Winsock.dll" () As Integer
  203.     Public Declare Function WSAIsBlocking Lib "Winsock.dll" () As Integer
  204.     Public Declare Function WSAUnhookBlockingHook Lib "Winsock.dll" () As Integer
  205.     Public Declare Function WSASetBlockingHook Lib "Winsock.dll" (ByVal lpBlockFunc As Long) As Long
  206.     Public Declare Function WSACancelBlockingCall Lib "Winsock.dll" () As Integer
  207.     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
  208.     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
  209.     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
  210.     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
  211.     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
  212.     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
  213.     Public Declare Function WSACancelAsyncRequest Lib "Winsock.dll" (ByVal hAsyncTaskHandle As Integer) As Integer
  214.     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
  215.     Public Declare Function WSARecvEx Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer) As Integer
  216. #ElseIf Win32 Then
  217. '---Windows System Functions
  218.     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
  219.     Public Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
  220.     Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
  221. '---async notification constants
  222.     Public Const SOL_SOCKET = &HFFFF&
  223.     Public Const SO_LINGER = &H80&
  224.     Public Const FD_READ = &H1&
  225.     Public Const FD_WRITE = &H2&
  226.     Public Const FD_OOB = &H4&
  227.     Public Const FD_ACCEPT = &H8&
  228.     Public Const FD_CONNECT = &H10&
  229.     Public Const FD_CLOSE = &H20&
  230. '---SOCKET FUNCTIONS
  231.     Public Declare Function accept Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, addrlen As Long) As Long
  232.     Public Declare Function bind Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
  233.     Public Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
  234.     Public Declare Function connect Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
  235.     Public Declare Function ioctlsocket Lib "wsock32.dll" (ByVal s As Long, ByVal cmd As Long, argp As Long) As Long
  236.     Public Declare Function getpeername Lib "wsock32.dll" (ByVal s As Long, sName As sockaddr, namelen As Long) As Long
  237.     Public Declare Function getsockname Lib "wsock32.dll" (ByVal s As Long, sName As sockaddr, namelen As Long) As Long
  238.     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
  239.     Public Declare Function htonl Lib "wsock32.dll" (ByVal hostlong As Long) As Long
  240.     Public Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
  241.     Public Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
  242.     Public Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long
  243.     Public Declare Function listen Lib "wsock32.dll" (ByVal s As Long, ByVal backlog As Long) As Long
  244.     Public Declare Function ntohl Lib "wsock32.dll" (ByVal netlong As Long) As Long
  245.     Public Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer
  246.     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
  247.     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
  248.     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
  249.     Public Declare Function send Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
  250.     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
  251.     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
  252.     Public Declare Function ShutDown Lib "wsock32.dll" Alias "shutdown" (ByVal s As Long, ByVal how As Long) As Long
  253.     Public Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
  254. '---DATABASE FUNCTIONS
  255.     Public Declare Function gethostbyaddr Lib "wsock32.dll" (addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long
  256.     Public Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
  257.     Public Declare Function gethostname Lib "wsock32.dll" (ByVal host_name As String, ByVal namelen As Long) As Long
  258.     Public Declare Function getservbyport Lib "wsock32.dll" (ByVal Port As Long, ByVal proto As String) As Long
  259.     Public Declare Function getservbyname Lib "wsock32.dll" (ByVal serv_name As String, ByVal proto As String) As Long
  260.     Public Declare Function getprotobynumber Lib "wsock32.dll" (ByVal proto As Long) As Long
  261.     Public Declare Function getprotobyname Lib "wsock32.dll" (ByVal proto_name As String) As Long
  262. '---WINDOWS EXTENSIONS
  263.     Public Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long
  264.     Public Declare Function WSACleanup Lib "wsock32.dll" () As Long
  265.     Public Declare Sub WSASetLastError Lib "wsock32.dll" (ByVal iError As Long)
  266.     Public Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
  267.     Public Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long
  268.     Public Declare Function WSAUnhookBlockingHook Lib "wsock32.dll" () As Long
  269.     Public Declare Function WSASetBlockingHook Lib "wsock32.dll" (ByVal lpBlockFunc As Long) As Long
  270.     Public Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long
  271.     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
  272.     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
  273.     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
  274.     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
  275.     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
  276.     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
  277.     Public Declare Function WSACancelAsyncRequest Lib "wsock32.dll" (ByVal hAsyncTaskHandle As Long) As Long
  278.     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
  279.     Public Declare Function WSARecvEx Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
  280. #End If
  281.  
  282.  
  283. 'SOME STUFF I ADDED
  284. Public MySocket%
  285. Public SockReadBuffer$
  286. Public Const WSA_NoName = "Unknown"
  287. Public WSAStartedUp As Boolean     'Flag to keep track of whether winsock WSAStartup wascalled
  288.  
  289.  
  290. Public Function WSAGetAsyncBufLen(ByVal lParam As Long) As Long
  291.     If (lParam And &HFFFF&) > &H7FFF Then
  292.         WSAGetAsyncBufLen = (lParam And &HFFFF&) - &H10000
  293.     Else
  294.         WSAGetAsyncBufLen = lParam And &HFFFF&
  295.     End If
  296. End Function
  297.  
  298. Public Function WSAGetSelectEvent(ByVal lParam As Long) As Integer
  299.     If (lParam And &HFFFF&) > &H7FFF Then
  300.         WSAGetSelectEvent = (lParam And &HFFFF&) - &H10000
  301.     Else
  302.         WSAGetSelectEvent = lParam And &HFFFF&
  303.     End If
  304. End Function
  305.  
  306.  
  307.  
  308. Public Function WSAGetAsyncError(ByVal lParam As Long) As Integer
  309.     WSAGetAsyncError = (lParam And &HFFFF0000) \ &H10000
  310. End Function
  311.  
  312.  
  313.  
  314. Public Function AddrToIP(ByVal AddrOrIP$) As String
  315.     AddrToIP$ = GetAscIP(GetHostByNameAlias(AddrOrIP$))
  316. End Function
  317.  
  318. 'this function should work on 16 and 32 bit systems
  319. #If Win16 Then
  320.     Function ConnectSock(ByVal Host$, ByVal Port%, retIpPort$, ByVal HWndToMsg%, ByVal Async%) As Integer
  321.     Dim s%, SelectOps%, dummy%
  322. #ElseIf Win32 Then
  323.     Function ConnectSock(ByVal Host$, ByVal Port&, retIpPort$, ByVal HWndToMsg&, ByVal Async%) As Long
  324.     Dim s&, SelectOps&, dummy&
  325. #End If
  326.     Dim sockin As sockaddr
  327.     SockReadBuffer$ = ""
  328.     sockin = saZero
  329.     sockin.sin_family = AF_INET
  330.     sockin.sin_port = htons(Port)
  331.     If sockin.sin_port = INVALID_SOCKET Then
  332.         ConnectSock = INVALID_SOCKET
  333.         Exit Function
  334.     End If
  335.  
  336.     sockin.sin_addr = GetHostByNameAlias(Host$)
  337.     If sockin.sin_addr = INADDR_NONE Then
  338.         ConnectSock = INVALID_SOCKET
  339.         Exit Function
  340.     End If
  341.     retIpPort$ = GetAscIP$(sockin.sin_addr) & ":" & ntohs(sockin.sin_port)
  342.  
  343.     s = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP)
  344.     If s < 0 Then
  345.         ConnectSock = INVALID_SOCKET
  346.         Exit Function
  347.     End If
  348.     If SetSockLinger(s, 1, 0) = SOCKET_ERROR Then
  349.         If s > 0 Then
  350.             dummy = closesocket(s)
  351.         End If
  352.         ConnectSock = INVALID_SOCKET
  353.         Exit Function
  354.     End If
  355.     If Not Async Then
  356.         If Not connect(s, sockin, sockaddr_size) = 0 Then
  357.             If s > 0 Then
  358.                 dummy = closesocket(s)
  359.             End If
  360.             ConnectSock = INVALID_SOCKET
  361.             Exit Function
  362.         End If
  363.         If HWndToMsg <> 0 Then
  364.             SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE
  365.             If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
  366.                 If s > 0 Then
  367.                     dummy = closesocket(s)
  368.                 End If
  369.                 ConnectSock = INVALID_SOCKET
  370.                 Exit Function
  371.             End If
  372.         End If
  373.     Else
  374.         SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE
  375.         If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
  376.             If s > 0 Then
  377.                 dummy = closesocket(s)
  378.             End If
  379.             ConnectSock = INVALID_SOCKET
  380.             Exit Function
  381.         End If
  382.         If connect(s, sockin, sockaddr_size) <> -1 Then
  383.             If s > 0 Then
  384.                 dummy = closesocket(s)
  385.             End If
  386.             ConnectSock = INVALID_SOCKET
  387.             Exit Function
  388.         End If
  389.     End If
  390.     ConnectSock = s
  391. End Function
  392.  
  393. #If Win32 Then
  394.     Public Function SetSockLinger(ByVal SockNum&, ByVal OnOff%, ByVal LingerTime%) As Long
  395. #Else
  396.     Public Function SetSockLinger(ByVal SockNum%, ByVal OnOff%, ByVal LingerTime%) As Integer
  397. #End If
  398.     Dim Linger As LingerType
  399.     Linger.l_onoff = OnOff
  400.     Linger.l_linger = LingerTime
  401.     If setsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then
  402.         Debug.Print "Error setting linger info: " & WSAGetLastError()
  403.         SetSockLinger = SOCKET_ERROR
  404.     Else
  405.         If getsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then
  406.             Debug.Print "Error getting linger info: " & WSAGetLastError()
  407.             SetSockLinger = SOCKET_ERROR
  408.         Else
  409.             Debug.Print "Linger is on if nonzero: "; Linger.l_onoff
  410.             Debug.Print "Linger time if linger is on: "; Linger.l_linger
  411.         End If
  412.     End If
  413. End Function
  414.  
  415. Sub EndWinsock()
  416.     Dim ret&
  417.     If WSAIsBlocking() Then
  418.         ret = WSACancelBlockingCall()
  419.     End If
  420.     ret = WSACleanup()
  421.     WSAStartedUp = False
  422. End Sub
  423.  
  424. Public Function GetAscIP(ByVal inn As Long) As String
  425.     #If Win32 Then
  426.         Dim nStr&
  427.     #Else
  428.         Dim nStr%
  429.     #End If
  430.     Dim lpStr&
  431.     Dim retString$
  432.     retString = String(32, 0)
  433.     lpStr = inet_ntoa(inn)
  434.     If lpStr Then
  435.         nStr = lstrlen(lpStr)
  436.         If nStr > 32 Then nStr = 32
  437.         MemCopy ByVal retString, ByVal lpStr, nStr
  438.         retString = Left(retString, nStr)
  439.         GetAscIP = retString
  440.     Else
  441.         GetAscIP = "255.255.255.255"
  442.     End If
  443. End Function
  444.  
  445. Public Function GetHostByAddress(ByVal addr As Long) As String
  446.     Dim phe&, ret&
  447.     Dim heDestHost As HostEnt
  448.     Dim HostName$
  449.     phe = gethostbyaddr(addr, 4, PF_INET)
  450.     If phe Then
  451.         MemCopy heDestHost, ByVal phe, hostent_size
  452.         HostName = String(256, 0)
  453.         MemCopy ByVal HostName, ByVal heDestHost.h_name, 256
  454.         GetHostByAddress = Left(HostName, InStr(HostName, Chr(0)) - 1)
  455.     Else
  456.         GetHostByAddress = WSA_NoName
  457.     End If
  458. End Function
  459.  
  460. 'returns IP as long, in network byte order
  461. Public Function GetHostByNameAlias(ByVal HostName$) As Long
  462.     'Return IP address as a long, in network byte order
  463.     Dim phe&
  464.     Dim heDestHost As HostEnt
  465.     Dim addrList&
  466.     Dim retIP&
  467.     retIP = inet_addr(HostName$)
  468.     If retIP = INADDR_NONE Then
  469.         phe = gethostbyname(HostName$)
  470.         If phe <> 0 Then
  471.             MemCopy heDestHost, ByVal phe, hostent_size
  472.             MemCopy addrList, ByVal heDestHost.h_addr_list, 4
  473.             MemCopy retIP, ByVal addrList, heDestHost.h_length
  474.         Else
  475.             retIP = INADDR_NONE
  476.         End If
  477.     End If
  478.     GetHostByNameAlias = retIP
  479. End Function
  480.  
  481. 'returns your local machines name
  482. Public Function GetLocalHostName() As String
  483.     Dim sName$
  484.     sName = String(256, 0)
  485.     If gethostname(sName, 256) Then
  486.         sName = WSA_NoName
  487.     Else
  488.         If InStr(sName, Chr(0)) Then
  489.             sName = Left(sName, InStr(sName, Chr(0)) - 1)
  490.         End If
  491.     End If
  492.     GetLocalHostName = sName
  493. End Function
  494.  
  495. #If Win16 Then
  496.     Public Function GetPeerAddress(ByVal s%) As String
  497.     Dim addrlen%
  498. #ElseIf Win32 Then
  499.     Public Function GetPeerAddress(ByVal s&) As String
  500.     Dim addrlen&
  501. #End If
  502.     Dim sa As sockaddr
  503.     addrlen = sockaddr_size
  504.     If getpeername(s, sa, addrlen) Then
  505.         GetPeerAddress = ""
  506.     Else
  507.         GetPeerAddress = SockAddressToString(sa)
  508.     End If
  509. End Function
  510.  
  511. #If Win16 Then
  512.     Public Function GetPortFromString(ByVal PortStr$) As Integer
  513. #ElseIf Win32 Then
  514.     Public Function GetPortFromString(ByVal PortStr$) As Long
  515. #End If
  516.     'sometimes users provide ports outside the range of a VB
  517.     'integer, so this function returns an integer for a string
  518.     'just to keep an error from happening, it converts the
  519.     'number to a negative if needed
  520.     If Val(PortStr$) > 32767 Then
  521.         GetPortFromString = CInt(Val(PortStr$) - &H10000)
  522.     Else
  523.         GetPortFromString = Val(PortStr$)
  524.     End If
  525.     If Err Then GetPortFromString = 0
  526. End Function
  527.  
  528. #If Win16 Then
  529.     Function GetProtocolByName(ByVal protocol$) As Integer
  530.     Dim tmpShort%
  531. #ElseIf Win32 Then
  532.     Function GetProtocolByName(ByVal protocol$) As Long
  533.     Dim tmpShort&
  534. #End If
  535.     Dim ppe&
  536.     Dim peDestProt As protoent
  537.     ppe = getprotobyname(protocol)
  538.     If ppe Then
  539.         MemCopy peDestProt, ByVal ppe, protoent_size
  540.         GetProtocolByName = peDestProt.p_proto
  541.     Else
  542.         tmpShort = Val(protocol)
  543.         If tmpShort Then
  544.             GetProtocolByName = htons(tmpShort)
  545.         Else
  546.             GetProtocolByName = SOCKET_ERROR
  547.         End If
  548.     End If
  549. End Function
  550.  
  551. #If Win16 Then
  552.     Function GetServiceByName(ByVal service$, ByVal protocol$) As Integer
  553.     Dim serv%
  554. #ElseIf Win32 Then
  555.     Function GetServiceByName(ByVal service$, ByVal protocol$) As Long
  556.     Dim serv&
  557. #End If
  558.     Dim pse&
  559.     Dim seDestServ As servent
  560.     pse = getservbyname(service, protocol)
  561.     If pse Then
  562.         MemCopy seDestServ, ByVal pse, servent_size
  563.         GetServiceByName = seDestServ.s_port
  564.     Else
  565.         serv = Val(service)
  566.         If serv Then
  567.             GetServiceByName = htons(serv)
  568.         Else
  569.             GetServiceByName = INVALID_SOCKET
  570.         End If
  571.     End If
  572. End Function
  573.  
  574. 'this function DOES work on 16 and 32 bit systems
  575. #If Win16 Then
  576.     Function GetSockAddress(ByVal s%) As String
  577.     Dim addrlen%
  578.     Dim ret%
  579. #ElseIf Win32 Then
  580.     Function GetSockAddress(ByVal s&) As String
  581.     Dim addrlen&
  582.     Dim ret&
  583. #End If
  584.     Dim sa As sockaddr
  585.     Dim szRet$
  586.     szRet = String(32, 0)
  587.     addrlen = sockaddr_size
  588.     If getsockname(s, sa, addrlen) Then
  589.         GetSockAddress = ""
  590.     Else
  591.         GetSockAddress = SockAddressToString(sa)
  592.     End If
  593. End Function
  594.  
  595. 'this function should work on 16 and 32 bit systems
  596. Function GetWSAErrorString(ByVal errnum&) As String
  597.     On Error Resume Next
  598.     Select Case errnum
  599.         Case 10004: GetWSAErrorString = "Interrupted system call."
  600.         Case 10009: GetWSAErrorString = "Bad file number."
  601.         Case 10013: GetWSAErrorString = "Permission Denied."
  602.         Case 10014: GetWSAErrorString = "Bad Address."
  603.         Case 10022: GetWSAErrorString = "Invalid Argument."
  604.         Case 10024: GetWSAErrorString = "Too many open files."
  605.         Case 10035: GetWSAErrorString = "Operation would block."
  606.         Case 10036: GetWSAErrorString = "Operation now in progress."
  607.         Case 10037: GetWSAErrorString = "Operation already in progress."
  608.         Case 10038: GetWSAErrorString = "Socket operation on nonsocket."
  609.         Case 10039: GetWSAErrorString = "Destination address required."
  610.         Case 10040: GetWSAErrorString = "Message too long."
  611.         Case 10041: GetWSAErrorString = "Protocol wrong type for socket."
  612.         Case 10042: GetWSAErrorString = "Protocol not available."
  613.         Case 10043: GetWSAErrorString = "Protocol not supported."
  614.         Case 10044: GetWSAErrorString = "Socket type not supported."
  615.         Case 10045: GetWSAErrorString = "Operation not supported on socket."
  616.         Case 10046: GetWSAErrorString = "Protocol family not supported."
  617.         Case 10047: GetWSAErrorString = "Address family not supported by protocol family."
  618.         Case 10048: GetWSAErrorString = "Address already in use."
  619.         Case 10049: GetWSAErrorString = "Can't assign requested address."
  620.         Case 10050: GetWSAErrorString = "Network is down."
  621.         Case 10051: GetWSAErrorString = "Network is unreachable."
  622.         Case 10052: GetWSAErrorString = "Network dropped connection."
  623.         Case 10053: GetWSAErrorString = "Software caused connection abort."
  624.         Case 10054: GetWSAErrorString = "Connection reset by peer."
  625.         Case 10055: GetWSAErrorString = "No buffer space available."
  626.         Case 10056: GetWSAErrorString = "Socket is already connected."
  627.         Case 10057: GetWSAErrorString = "Socket is not connected."
  628.         Case 10058: GetWSAErrorString = "Can't send after socket shutdown."
  629.         Case 10059: GetWSAErrorString = "Too many references: can't splice."
  630.         Case 10060: GetWSAErrorString = "Connection timed out."
  631.         Case 10061: GetWSAErrorString = "Connection refused."
  632.         Case 10062: GetWSAErrorString = "Too many levels of symbolic links."
  633.         Case 10063: GetWSAErrorString = "File name too long."
  634.         Case 10064: GetWSAErrorString = "Host is down."
  635.         Case 10065: GetWSAErrorString = "No route to host."
  636.         Case 10066: GetWSAErrorString = "Directory not empty."
  637.         Case 10067: GetWSAErrorString = "Too many processes."
  638.         Case 10068: GetWSAErrorString = "Too many users."
  639.         Case 10069: GetWSAErrorString = "Disk quota exceeded."
  640.         Case 10070: GetWSAErrorString = "Stale NFS file handle."
  641.         Case 10071: GetWSAErrorString = "Too many levels of remote in path."
  642.         Case 10091: GetWSAErrorString = "Network subsystem is unusable."
  643.         Case 10092: GetWSAErrorString = "Winsock DLL cannot support this application."
  644.         Case 10093: GetWSAErrorString = "Winsock not initialized."
  645.         Case 10101: GetWSAErrorString = "Disconnect."
  646.         Case 11001: GetWSAErrorString = "Host not found."
  647.         Case 11002: GetWSAErrorString = "Nonauthoritative host not found."
  648.         Case 11003: GetWSAErrorString = "Nonrecoverable error."
  649.         Case 11004: GetWSAErrorString = "Valid name, no data record of requested type."
  650.         Case Else:
  651.     End Select
  652. End Function
  653.  
  654. 'this function DOES work on 16 and 32 bit systems
  655. Function IpToAddr(ByVal AddrOrIP$) As String
  656.     On Error Resume Next
  657.     IpToAddr = GetHostByAddress(GetHostByNameAlias(AddrOrIP$))
  658.     If Err Then IpToAddr = WSA_NoName
  659. End Function
  660.  
  661. 'this function DOES work on 16 and 32 bit systems
  662. Function IrcGetAscIp(ByVal IPL$) As String
  663.     'this function is IRC specific, it expects a long ip stored in Network byte order, in a string
  664.     'the kind that would be parsed out of a DCC command string
  665.     On Error GoTo IrcGetAscIPError:
  666.     Dim lpStr&
  667. #If Win16 Then
  668.     Dim nStr%
  669. #ElseIf Win32 Then
  670.     Dim nStr&
  671. #End If
  672.     Dim retString$
  673.     Dim inn&
  674.     If Val(IPL) > 2147483647 Then
  675.         inn = Val(IPL) - 4294967296#
  676.     Else
  677.         inn = Val(IPL)
  678.     End If
  679.     inn = ntohl(inn)
  680.     retString = String(32, 0)
  681.     lpStr = inet_ntoa(inn)
  682.     If lpStr = 0 Then
  683.         IrcGetAscIp = "0.0.0.0"
  684.         Exit Function
  685.     End If
  686.     nStr = lstrlen(lpStr)
  687.     If nStr > 32 Then nStr = 32
  688.     MemCopy ByVal retString, ByVal lpStr, nStr
  689.     retString = Left(retString, nStr)
  690.     IrcGetAscIp = retString
  691.     Exit Function
  692. IrcGetAscIPError:
  693.     IrcGetAscIp = "0.0.0.0"
  694.     Exit Function
  695.     Resume
  696. End Function
  697.  
  698. 'this function DOES work on 16 and 32 bit systems
  699. Function IrcGetLongIp(ByVal AscIp$) As String
  700.     'this function converts an ascii ip string into a long ip in network byte order
  701.     'and stick it in a string suitable for use in a DCC command.
  702.     On Error GoTo IrcGetLongIpError:
  703.     Dim inn&
  704.     inn = inet_addr(AscIp)
  705.     inn = htonl(inn)
  706.     If inn < 0 Then
  707.         IrcGetLongIp = CVar(inn + 4294967296#)
  708.         Exit Function
  709.     Else
  710.         IrcGetLongIp = CVar(inn)
  711.         Exit Function
  712.     End If
  713.     Exit Function
  714. IrcGetLongIpError:
  715.     IrcGetLongIp = "0"
  716.     Exit Function
  717.     Resume
  718. End Function
  719.  
  720. 'this function should work on 16 and 32 bit systems
  721. #If Win16 Then
  722. Public Function ListenForConnect(ByVal Port%, ByVal HWndToMsg%) As Integer
  723.     Dim s%, dummy%
  724.     Dim SelectOps%
  725. #ElseIf Win32 Then
  726. Public Function ListenForConnect(ByVal Port&, ByVal HWndToMsg&) As Long
  727.     Dim s&, dummy&
  728.     Dim SelectOps&
  729. #End If
  730.     Dim sockin As sockaddr
  731.     sockin = saZero     'zero out the structure
  732.     sockin.sin_family = AF_INET
  733.     sockin.sin_port = htons(Port)
  734.     If sockin.sin_port = INVALID_SOCKET Then
  735.         ListenForConnect = INVALID_SOCKET
  736.         Exit Function
  737.     End If
  738.     sockin.sin_addr = htonl(INADDR_ANY)
  739.     If sockin.sin_addr = INADDR_NONE Then
  740.         ListenForConnect = INVALID_SOCKET
  741.         Exit Function
  742.     End If
  743.     s = socket(PF_INET, SOCK_STREAM, 0)
  744.     If s < 0 Then
  745.         ListenForConnect = INVALID_SOCKET
  746.         Exit Function
  747.     End If
  748.     If bind(s, sockin, sockaddr_size) Then
  749.         If s > 0 Then
  750.             dummy = closesocket(s)
  751.         End If
  752.         ListenForConnect = INVALID_SOCKET
  753.         Exit Function
  754.     End If
  755.     SelectOps = FD_READ Or FD_WRITE Or FD_CLOSE Or FD_ACCEPT
  756.     If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
  757.         If s > 0 Then
  758.             dummy = closesocket(s)
  759.         End If
  760.         ListenForConnect = SOCKET_ERROR
  761.         Exit Function
  762.     End If
  763.     
  764.     If listen(s, 1) Then
  765.         If s > 0 Then
  766.             dummy = closesocket(s)
  767.         End If
  768.         ListenForConnect = INVALID_SOCKET
  769.         Exit Function
  770.     End If
  771.     ListenForConnect = s
  772. End Function
  773.  
  774. 'this function should work on 16 and 32 bit systems
  775. #If Win16 Then
  776. Public Function SendData(ByVal s%, vMessage As Variant) As Integer
  777. #ElseIf Win32 Then
  778. Public Function SendData(ByVal s&, vMessage As Variant) As Long
  779. #End If
  780.     Dim TheMsg() As Byte, sTemp$
  781.     TheMsg = ""
  782.     Select Case VarType(vMessage)
  783.         Case 8209   'byte array
  784.             sTemp = vMessage
  785.             TheMsg = sTemp
  786.         Case 8      'string, if we recieve a string, its assumed we are linemode
  787.             #If Win32 Then
  788.                 sTemp = StrConv(vMessage, vbFromUnicode)
  789.             #Else
  790.                 sTemp = vMessage
  791.             #End If
  792.         Case Else
  793.             sTemp = CStr(vMessage)
  794.             #If Win32 Then
  795.                 sTemp = StrConv(vMessage, vbFromUnicode)
  796.             #Else
  797.                 sTemp = vMessage
  798.             #End If
  799.     End Select
  800.     TheMsg = sTemp
  801.     If UBound(TheMsg) > -1 Then
  802.         SendData = send(s, TheMsg(0), UBound(TheMsg) + 1, 0)
  803.     End If
  804. End Function
  805.  
  806. Public Function SockAddressToString(sa As sockaddr) As String
  807.     SockAddressToString = GetAscIP(sa.sin_addr) & ":" & ntohs(sa.sin_port)
  808. End Function
  809.  
  810. Public Function StartWinsock(sDescription As String) As Boolean
  811.     Dim StartupData As WSADataType
  812.     If Not WSAStartedUp Then
  813.         If Not WSAStartup(&H101, StartupData) Then
  814.             WSAStartedUp = True
  815.             Debug.Print "wVersion="; StartupData.wVersion, "wHighVersion="; StartupData.wHighVersion
  816.             Debug.Print "If wVersion == 257 then everything is kewl"
  817.             Debug.Print "szDescription="; StartupData.szDescription
  818.             Debug.Print "szSystemStatus="; StartupData.szSystemStatus
  819.             Debug.Print "iMaxSockets="; StartupData.iMaxSockets, "iMaxUdpDg="; StartupData.iMaxUdpDg
  820.             sDescription = StartupData.szDescription
  821.         Else
  822.             WSAStartedUp = False
  823.         End If
  824.     End If
  825.     StartWinsock = WSAStartedUp
  826. End Function
  827.  
  828. Public Function WSAMakeSelectReply(TheEvent%, TheError%) As Long
  829.     WSAMakeSelectReply = (TheError * &H10000) + (TheEvent And &HFFFF&)
  830. End Function
  831.  
  832.  
  833.  
  834.