home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD9687962000.psc / wsksock.bas < prev   
Encoding:
BASIC Source File  |  2000-08-28  |  22.4 KB  |  563 lines
  1. Attribute VB_Name = "wsksock"
  2. Option Explicit
  3.  
  4. Public Const FD_SETSIZE = 64
  5. Type fd_set
  6.     fd_count As Integer
  7.     fd_array(FD_SETSIZE) As Integer
  8. End Type
  9.  
  10. Type timeval
  11.     tv_sec As Long
  12.     tv_usec As Long
  13. End Type
  14.  
  15. Type HostEnt
  16.     h_name As Long
  17.     h_aliases As Long
  18.     h_addrtype As Integer
  19.     h_length As Integer
  20.     h_addr_list As Long
  21. End Type
  22. Public Const hostent_size = 16
  23.  
  24. Type servent
  25.     s_name As Long
  26.     s_aliases As Long
  27.     s_port As Integer
  28.     s_proto As Long
  29. End Type
  30. Public Const servent_size = 14
  31.  
  32. Type protoent
  33.     p_name As Long
  34.     p_aliases As Long
  35.     p_proto As Integer
  36. End Type
  37.  
  38. Public Const protoent_size = 10
  39.  
  40. Public Const IPPROTO_TCP = 6
  41. Public Const IPPROTO_UDP = 17
  42.  
  43. Public Const INADDR_NONE = &HFFFFFFFF
  44. Public Const INADDR_ANY = &H0
  45.  
  46. Type sockaddr
  47.     sin_family As Integer
  48.     sin_port As Integer
  49.     sin_addr As Long
  50.     sin_zero As String * 8
  51. End Type
  52.  
  53. Public Const sockaddr_size = 16
  54. Public saZero As sockaddr
  55.  
  56. Public Const WSA_DESCRIPTIONLEN = 256
  57. Public Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1
  58.  
  59. Public Const WSA_SYS_STATUS_LEN = 128
  60. Public Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1
  61.  
  62. Type WSADataType
  63.     wVersion As Integer
  64.     wHighVersion As Integer
  65.     szDescription As String * WSA_DescriptionSize
  66.     szSystemStatus As String * WSA_SysStatusSize
  67.     iMaxSockets As Integer
  68.     iMaxUdpDg As Integer
  69.     lpVendorInfo As Long
  70. End Type
  71.  
  72. Public Const INVALID_SOCKET = -1
  73. Public Const SOCKET_ERROR = -1
  74.  
  75. Public Const SOCK_STREAM = 1
  76. Public Const SOCK_DGRAM = 2
  77.  
  78. Public Const MAXGETHOSTSTRUCT = 1024
  79.  
  80. Public Const AF_INET = 2
  81. Public Const PF_INET = 2
  82.  
  83. Type LingerType
  84.     l_onoff As Integer
  85.     l_linger As Integer
  86. End Type
  87.  
  88. ' Windows Sockets definitions of regular Microsoft C error constants
  89. Global Const WSAEINTR = 10004
  90. Global Const WSAEBADF = 10009
  91. Global Const WSAEACCES = 10013
  92. Global Const WSAEFAULT = 10014
  93. Global Const WSAEINVAL = 10022
  94. Global Const WSAEMFILE = 10024
  95.  
  96. ' Windows Sockets definitions of regular Berkeley error constants
  97. Global Const WSAEWOULDBLOCK = 10035
  98. Global Const WSAEINPROGRESS = 10036
  99. Global Const WSAEALREADY = 10037
  100. Global Const WSAENOTSOCK = 10038
  101. Global Const WSAEDESTADDRREQ = 10039
  102. Global Const WSAEMSGSIZE = 10040
  103. Global Const WSAEPROTOTYPE = 10041
  104. Global Const WSAENOPROTOOPT = 10042
  105. Global Const WSAEPROTONOSUPPORT = 10043
  106. Global Const WSAESOCKTNOSUPPORT = 10044
  107. Global Const WSAEOPNOTSUPP = 10045
  108. Global Const WSAEPFNOSUPPORT = 10046
  109. Global Const WSAEAFNOSUPPORT = 10047
  110. Global Const WSAEADDRINUSE = 10048
  111. Global Const WSAEADDRNOTAVAIL = 10049
  112. Global Const WSAENETDOWN = 10050
  113. Global Const WSAENETUNREACH = 10051
  114. Global Const WSAENETRESET = 10052
  115. Global Const WSAECONNABORTED = 10053
  116. Global Const WSAECONNRESET = 10054
  117. Global Const WSAENOBUFS = 10055
  118. Global Const WSAEISCONN = 10056
  119. Global Const WSAENOTCONN = 10057
  120. Global Const WSAESHUTDOWN = 10058
  121. Global Const WSAETOOMANYREFS = 10059
  122. Global Const WSAETIMEDOUT = 10060
  123. Global Const WSAECONNREFUSED = 10061
  124. Global Const WSAELOOP = 10062
  125. Global Const WSAENAMETOOLONG = 10063
  126. Global Const WSAEHOSTDOWN = 10064
  127. Global Const WSAEHOSTUNREACH = 10065
  128. Global Const WSAENOTEMPTY = 10066
  129. Global Const WSAEPROCLIM = 10067
  130. Global Const WSAEUSERS = 10068
  131. Global Const WSAEDQUOT = 10069
  132. Global Const WSAESTALE = 10070
  133. Global Const WSAEREMOTE = 10071
  134.  
  135. ' Extended Windows Sockets error constant definitions
  136. Global Const WSASYSNOTREADY = 10091
  137. Global Const WSAVERNOTSUPPORTED = 10092
  138. Global Const WSANOTINITIALISED = 10093
  139. Global Const WSAHOST_NOT_FOUND = 11001
  140. Global Const WSATRY_AGAIN = 11002
  141. Global Const WSANO_RECOVERY = 11003
  142. Global Const WSANO_DATA = 11004
  143. Global Const WSANO_ADDRESS = 11004
  144.  
  145. '---ioctl Constants
  146.     Public Const FIONREAD = &H8004667F
  147.     Public Const FIONBIO = &H8004667E
  148.     Public Const FIOASYNC = &H8004667D
  149.  
  150. '---Windows System Functions
  151.     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
  152.     Public Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
  153.     Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
  154.  
  155. '---async notification constants
  156.     Public Const SOL_SOCKET = &HFFFF&
  157.     Public Const SO_LINGER = &H80&
  158.     Public Const FD_READ = &H1&
  159.     Public Const FD_WRITE = &H2&
  160.     Public Const FD_OOB = &H4&
  161.     Public Const FD_ACCEPT = &H8&
  162.     Public Const FD_CONNECT = &H10&
  163.     Public Const FD_CLOSE = &H20&
  164.  
  165. '---SOCKET FUNCTIONS
  166.     Public Declare Function accept Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, addrlen As Long) As Long
  167.     Public Declare Function bind Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
  168.     Public Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
  169.     Public Declare Function connect Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
  170.     Public Declare Function ioctlsocket Lib "wsock32.dll" (ByVal s As Long, ByVal cmd As Long, argp As Long) As Long
  171.     Public Declare Function getpeername Lib "wsock32.dll" (ByVal s As Long, sName As sockaddr, namelen As Long) As Long
  172.     Public Declare Function getsockname Lib "wsock32.dll" (ByVal s As Long, sName As sockaddr, namelen As Long) As Long
  173.     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
  174.     Public Declare Function htonl Lib "wsock32.dll" (ByVal hostlong As Long) As Long
  175.     Public Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
  176.     Public Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
  177.     Public Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long
  178.     Public Declare Function listen Lib "wsock32.dll" (ByVal s As Long, ByVal backlog As Long) As Long
  179.     Public Declare Function ntohl Lib "wsock32.dll" (ByVal netlong As Long) As Long
  180.     Public Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer
  181.     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
  182.     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
  183.     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
  184.     Public Declare Function send Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
  185.     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
  186.     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
  187.     Public Declare Function ShutDown Lib "wsock32.dll" Alias "shutdown" (ByVal s As Long, ByVal how As Long) As Long
  188.     Public Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
  189.  
  190. '---DATABASE FUNCTIONS
  191.     Public Declare Function gethostbyaddr Lib "wsock32.dll" (addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long
  192.     Public Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
  193.     Public Declare Function gethostname Lib "wsock32.dll" (ByVal host_name As String, ByVal namelen As Long) As Long
  194.     Public Declare Function getservbyport Lib "wsock32.dll" (ByVal Port As Long, ByVal proto As String) As Long
  195.     Public Declare Function getservbyname Lib "wsock32.dll" (ByVal serv_name As String, ByVal proto As String) As Long
  196.     Public Declare Function getprotobynumber Lib "wsock32.dll" (ByVal proto As Long) As Long
  197.     Public Declare Function getprotobyname Lib "wsock32.dll" (ByVal proto_name As String) As Long
  198.  
  199. '---WINDOWS EXTENSIONS
  200.     Public Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long
  201.     Public Declare Function WSACleanup Lib "wsock32.dll" () As Long
  202.     Public Declare Sub WSASetLastError Lib "wsock32.dll" (ByVal iError As Long)
  203.     Public Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
  204.     Public Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long
  205.     Public Declare Function WSAUnhookBlockingHook Lib "wsock32.dll" () As Long
  206.     Public Declare Function WSASetBlockingHook Lib "wsock32.dll" (ByVal lpBlockFunc As Long) As Long
  207.     Public Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long
  208.     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
  209.     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
  210.     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
  211.     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
  212.     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
  213.     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
  214.     Public Declare Function WSACancelAsyncRequest Lib "wsock32.dll" (ByVal hAsyncTaskHandle As Long) As Long
  215.     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
  216.     Public Declare Function WSARecvEx Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
  217.  
  218. 'Public Declare Function InternetGetConnectedState _
  219.                   Lib "wininet.dll" (ByRef lpdwFlags As Long, _
  220.                   ByVal dwReserved As Long) As Long
  221.  
  222. Public MySocket%
  223. Public SockReadBuffer$
  224. Public Const WSA_NoName = "Unknown"
  225. Public WSAStartedUp As Boolean     'Flag to keep track of whether winsock WSAStartup wascalled
  226.  
  227. Public Function WSAGetAsyncBufLen(ByVal lParam As Long) As Long
  228.     If (lParam And &HFFFF&) > &H7FFF Then
  229.         WSAGetAsyncBufLen = (lParam And &HFFFF&) - &H10000
  230.     Else
  231.         WSAGetAsyncBufLen = lParam And &HFFFF&
  232.     End If
  233. End Function
  234.  
  235. Public Function WSAGetSelectEvent(ByVal lParam As Long) As Integer
  236.     If (lParam And &HFFFF&) > &H7FFF Then
  237.         WSAGetSelectEvent = (lParam And &HFFFF&) - &H10000
  238.     Else
  239.         WSAGetSelectEvent = lParam And &HFFFF&
  240.     End If
  241. End Function
  242.  
  243. Public Function WSAGetAsyncError(ByVal lParam As Long) As Integer
  244.     WSAGetAsyncError = (lParam And &HFFFF0000) \ &H10000
  245. End Function
  246.  
  247. Public Function AddrToIP(ByVal AddrOrIP$) As String
  248.     AddrToIP$ = GetAscIP(GetHostByNameAlias(AddrOrIP$))
  249. End Function
  250.  
  251. Function ConnectSock(ByVal Host$, ByVal Port&, retIpPort$, ByVal HWndToMsg&, ByVal Async%) As Long
  252.     Dim s&, SelectOps&, dummy&
  253.     Dim sockin As sockaddr
  254.     SockReadBuffer$ = ""
  255.     sockin = saZero
  256.     sockin.sin_family = AF_INET
  257.     sockin.sin_port = htons(Port)
  258.     If sockin.sin_port = INVALID_SOCKET Then
  259.         ConnectSock = INVALID_SOCKET
  260.         Exit Function
  261.     End If
  262.  
  263.     sockin.sin_addr = GetHostByNameAlias(Host$)
  264.     If sockin.sin_addr = INADDR_NONE Then
  265.         ConnectSock = INVALID_SOCKET
  266.         Exit Function
  267.     End If
  268.     retIpPort$ = GetAscIP$(sockin.sin_addr) & ":" & ntohs(sockin.sin_port)
  269.  
  270.     s = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP)
  271.     If s < 0 Then
  272.         ConnectSock = INVALID_SOCKET
  273.         Exit Function
  274.     End If
  275.     If SetSockLinger(s, 1, 0) = SOCKET_ERROR Then
  276.         If s > 0 Then
  277.             dummy = closesocket(s)
  278.         End If
  279.         ConnectSock = INVALID_SOCKET
  280.         Exit Function
  281.     End If
  282.     If Not Async Then
  283.         If Not connect(s, sockin, sockaddr_size) = 0 Then
  284.             If s > 0 Then
  285.                 dummy = closesocket(s)
  286.             End If
  287.             ConnectSock = INVALID_SOCKET
  288.             Exit Function
  289.         End If
  290.         If HWndToMsg <> 0 Then
  291.             SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE
  292.             If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
  293.                 If s > 0 Then
  294.                     dummy = closesocket(s)
  295.                 End If
  296.                 ConnectSock = INVALID_SOCKET
  297.                 Exit Function
  298.             End If
  299.         End If
  300.     Else
  301.         SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE
  302.         If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
  303.             If s > 0 Then
  304.                 dummy = closesocket(s)
  305.             End If
  306.             ConnectSock = INVALID_SOCKET
  307.             Exit Function
  308.         End If
  309.         If connect(s, sockin, sockaddr_size) <> -1 Then
  310.             If s > 0 Then
  311.                 dummy = closesocket(s)
  312.             End If
  313.             ConnectSock = INVALID_SOCKET
  314.             Exit Function
  315.         End If
  316.     End If
  317.     ConnectSock = s
  318. End Function
  319.  
  320. Public Function SetSockLinger(ByVal SockNum&, ByVal OnOff%, ByVal LingerTime%) As Long
  321.     Dim Linger As LingerType
  322.     Linger.l_onoff = OnOff
  323.     Linger.l_linger = LingerTime
  324.     If setsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then
  325.         Debug.Print "Error setting linger info: " & WSAGetLastError()
  326.         SetSockLinger = SOCKET_ERROR
  327.     Else
  328.         If getsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then
  329.             Debug.Print "Error getting linger info: " & WSAGetLastError()
  330.             SetSockLinger = SOCKET_ERROR
  331.         Else
  332.             Debug.Print "Linger is on if nonzero: "; Linger.l_onoff
  333.             Debug.Print "Linger time if linger is on: "; Linger.l_linger
  334.         End If
  335.     End If
  336. End Function
  337.  
  338. Sub EndWinsock()
  339.     Dim ret&
  340.     If WSAIsBlocking() Then
  341.         ret = WSACancelBlockingCall()
  342.     End If
  343.     ret = WSACleanup()
  344.     WSAStartedUp = False
  345. End Sub
  346.  
  347. Public Function GetAscIP(ByVal inn As Long) As String
  348.     Dim nStr&
  349.     Dim lpStr&
  350.     Dim retString$
  351.     retString = String(32, 0)
  352.     lpStr = inet_ntoa(inn)
  353.     If lpStr Then
  354.         nStr = lstrlen(lpStr)
  355.         If nStr > 32 Then nStr = 32
  356.         MemCopy ByVal retString, ByVal lpStr, nStr
  357.         retString = Left(retString, nStr)
  358.         GetAscIP = retString
  359.     Else
  360.         GetAscIP = "255.255.255.255"
  361.     End If
  362. End Function
  363.  
  364. Public Function GetHostByAddress(ByVal addr As Long) As String
  365.     Dim phe&, ret&
  366.     Dim heDestHost As HostEnt
  367.     Dim HostName$
  368.     phe = gethostbyaddr(addr, 4, PF_INET)
  369.     If phe Then
  370.         MemCopy heDestHost, ByVal phe, hostent_size
  371.         HostName = String(256, 0)
  372.         MemCopy ByVal HostName, ByVal heDestHost.h_name, 256
  373.         GetHostByAddress = Left(HostName, InStr(HostName, Chr(0)) - 1)
  374.     Else
  375.         GetHostByAddress = WSA_NoName
  376.     End If
  377. End Function
  378.  
  379. 'returns IP as long, in network byte order
  380. Public Function GetHostByNameAlias(ByVal HostName$) As Long
  381.     'Return IP address as a long, in network byte order
  382.     Dim phe&
  383.     Dim heDestHost As HostEnt
  384.     Dim addrList&
  385.     Dim retIP&
  386.     retIP = inet_addr(HostName$)
  387.     If retIP = INADDR_NONE Then
  388.         phe = gethostbyname(HostName$)
  389.         If phe <> 0 Then
  390.             MemCopy heDestHost, ByVal phe, hostent_size
  391.             MemCopy addrList, ByVal heDestHost.h_addr_list, 4
  392.             MemCopy retIP, ByVal addrList, heDestHost.h_length
  393.         Else
  394.             retIP = INADDR_NONE
  395.         End If
  396.     End If
  397.     GetHostByNameAlias = retIP
  398. End Function
  399.  
  400. 'returns your local machines name
  401. Public Function GetLocalHostName() As String
  402.     Dim sName$
  403.    
  404.     sName = String(256, 0)
  405.     
  406. Call gethostname(sName, 256)
  407. '    If gethostname(sName, 256) Then
  408. '        sName = WSA_NoName
  409. '    Else
  410.         If InStr(sName, Chr(0)) Then
  411.             sName = Left(sName, InStr(sName, Chr(0)) - 1)
  412.         End If
  413. '    End If
  414.     GetLocalHostName = sName
  415. End Function
  416.  
  417. Public Function GetPeerAddress(ByVal s&) As String
  418.     Dim addrlen&
  419.     Dim sa As sockaddr
  420.     addrlen = sockaddr_size
  421.     If getpeername(s, sa, addrlen) Then
  422.         GetPeerAddress = ""
  423.     Else
  424.         GetPeerAddress = SockAddressToString(sa)
  425.     End If
  426. End Function
  427.  
  428. Public Function GetPortFromString(ByVal PortStr$) As Long
  429.     'sometimes users provide ports outside the range of a VB
  430.     'integer, so this function returns an integer for a string
  431.     'just to keep an error from happening, it converts the
  432.     'number to a negative if needed
  433.     If Val(PortStr$) > 32767 Then
  434.         GetPortFromString = CInt(Val(PortStr$) - &H10000)
  435.     Else
  436.         GetPortFromString = Val(PortStr$)
  437.     End If
  438.     If Err Then GetPortFromString = 0
  439. End Function
  440.  
  441. Function GetProtocolByName(ByVal protocol$) As Long
  442.     Dim tmpShort&
  443.     Dim ppe&
  444.     Dim peDestProt As protoent
  445.     ppe = getprotobyname(protocol)
  446.     If ppe Then
  447.         MemCopy peDestProt, ByVal ppe, protoent_size
  448.         GetProtocolByName = peDestProt.p_proto
  449.     Else
  450.         tmpShort = Val(protocol)
  451.         If tmpShort Then
  452.             GetProtocolByName = htons(tmpShort)
  453.         Else
  454.             GetProtocolByName = SOCKET_ERROR
  455.         End If
  456.     End If
  457. End Function
  458.  
  459. Function GetServiceByName(ByVal service$, ByVal protocol$) As Long
  460.     Dim serv&
  461.     Dim pse&
  462.     Dim seDestServ As servent
  463.     pse = getservbyname(service, protocol)
  464.     If pse Then
  465.         MemCopy seDestServ, ByVal pse, servent_size
  466.         GetServiceByName = seDestServ.s_port
  467.     Else
  468.         serv = Val(service)
  469.         If serv Then
  470.             GetServiceByName = htons(serv)
  471.         Else
  472.             GetServiceByName = INVALID_SOCKET
  473.         End If
  474.     End If
  475. End Function
  476.  
  477. Function GetSockAddress(ByVal s&) As String
  478.     Dim addrlen&
  479.     Dim ret&
  480.     Dim sa As sockaddr
  481.     Dim szRet$
  482.     szRet = String(32, 0)
  483.     addrlen = sockaddr_size
  484.     If getsockname(s, sa, addrlen) Then
  485.         GetSockAddress = ""
  486.     Else
  487.         GetSockAddress = SockAddressToString(sa)
  488.     End If
  489. End Function
  490.  
  491. Function GetWSAErrorString(ByVal errnum&) As String
  492.     On Error Resume Next
  493.     Select Case errnum
  494.         Case 10004: GetWSAErrorString = "Interrupted system call."
  495.         Case 10009: GetWSAErrorString = "Bad file number."
  496.         Case 10013: GetWSAErrorString = "Permission Denied."
  497.         Case 10014: GetWSAErrorString = "Bad Address."
  498.         Case 10022: GetWSAErrorString = "Invalid Argument."
  499.         Case 10024: GetWSAErrorString = "Too many open files."
  500.         Case 10035: GetWSAErrorString = "Operation would block."
  501.         Case 10036: GetWSAErrorString = "Operation now in progress."
  502.         Case 10037: GetWSAErrorString = "Operation already in progress."
  503.         Case 10038: GetWSAErrorString = "Socket operation on nonsocket."
  504.         Case 10039: GetWSAErrorString = "Destination address required."
  505.         Case 10040: GetWSAErrorString = "Message too long."
  506.         Case 10041: GetWSAErrorString = "Protocol wrong type for socket."
  507.         Case 10042: GetWSAErrorString = "Protocol not available."
  508.         Case 10043: GetWSAErrorString = "Protocol not supported."
  509.         Case 10044: GetWSAErrorString = "Socket type not supported."
  510.         Case 10045: GetWSAErrorString = "Operation not supported on socket."
  511.         Case 10046: GetWSAErrorString = "Protocol family not supported."
  512.         Case 10047: GetWSAErrorString = "Address family not supported by protocol family."
  513.         Case 10048: GetWSAErrorString = "Address already in use."
  514.         Case 10049: GetWSAErrorString = "Can'l
  515.      nrotocol family."
  516.    ."
  517. etWSAErrorString =-otocol wrong tycing = "C"
  518.     ocol wrong  nWgcket rmaamily."
  519. 64ce(nlAs sockaddr
  520.     SockR_Oe.dsLong, BylnDim phe&
  521.     Dim heDestHost As HostEnt
  522.     Dim ad,LHostEnt
  523.  heDestHost As HostEnt
  524.     Dim HostName$
  525.     s
  526.     hdToMsg&, ByVal Async%) As Long
  527.     im HosEblic Declare Function WSACancelAsyncRequest Lib "wsock32.dll" (ByVal hAsyncTaskHandle As Long) As Long
  528.     Public Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, Gsd Ifshort As Long) se _Oe.dsLoAs Long
  529.     Public De
  530.     ocolStrin_s protoent
  531.   SAAsyncSelect L"Address aHostName$
  532.     s
  533.     hdnyncTaskHandleoAs Long
  534. eclare Function W+n_s Long
  535.     Public DLHostEnt
  536.  a Il hAsyncTaskHandle As Long) As Loi   Di Tsska   ne7.Tclare F,Tublic Dt L"AddrePPublic D.dsLong, Bylllllllllmg
  537. eclare Function W+n_s LrV_ddrePPublic D.dsLL8iwl hI Dtm   "ddress aHostName9olStrin_s protoess0ska   ne7.TclHostName9olStrin_s prom           sme9oC.TclHostName9olStrin_s pksme9oC.TclHoPe9oled Bylllllllllmg  n    llltion W+ Lo'om           sme9oC.Tclcoprock32e$
  538.     s
  539. lllm'om           sme9oC.Tclcohom   col$) As Long
  540.     Dim Oka   ne7.TclHosond As Lon col$) As Long
  541.   C col$) fbprotoent
  542.   SAAsyncSelect L"Address aHostName$
  543.     s
  544.     hdnyn ne7.TclHosond Asnt. Function getserv.dll  s
  545.     hdnyn n     Mess aHostNamm   "ddress aHostName9one7.Tclare F,Tublic Dt L"AddrePPublic OD _7gAsnt. Functi2Se 10rString = "Bad file n,Tublic Dt LErrorString = "Operats   tdown" (ByVal s ASn    lT0rStri Dt L"AddrePPublic OD _7gAsnt. Functi2Se 10rString = "Bad file n,Tublic DetByAddress(ByVal addr As Long) As String
  546.     Dim pheOByVal addr As Long) As String
  547.     Dim pheO2andleoAs Long
  548. eclare$) fbfem pheO2ng) As Strogress."
  549.         Case_eclare$eerAddrsrogrnss."lHosond Asnt. Function getserv.dll  s
  550.     hdnyn n   
  551.     hdnyn n   
  552.     hdnyn n   
  553.     hdnyn n   
  554.     hdnyn n   
  555.     hdnyn n   
  556.     hdnyn n  (    Case_eclare$eerAddrssame9one7.Tclare F,Tuble   hdnyA"
  557.         Caseeclare F,Tuble   tion GetHostByNameAeerAddrssame9one7.Tclare F,Tub(Strogress."
  558.         ts Strograyare F,Tub(Strogress."
  559.   snt. Funfwse 1004f  snsStr, nStr
  560.  Functi. Funfwsfd'Pnt. Er
  561. , ByVal protocol$) As Long
  562.     Diti.ieclare sfdti. l" (ByVal s As Long, Gsd Ifshon woyVal7T
  563. $amene( flags 9  snt. Funfws  snt. F rin_s protoent
  564.   SAal(PortStr$)shon woyVal7T
  565. $amene( flags 9  snt'4f  snsStr, nStr
  566.  Fre F,TuTuTuTuTuTuTuTuTuTuByVal retStrinnSO_