'wsksock.bas
' (1) I have never used WS_SELECT (select), therefore I must warn that I do' not know if fd_set and timeval are properly defined.' (2) Alot of the functions are declared with "buf as any", when calling these' functions you may either pass strings, byte arrays or UDT's. For 32bit I' I recommend Byte arrays and the use of memcopy to copy the data back out' (3) The async functions (wsaAsync*) require the use of a message hook or' message window control to capture messages sent by the winsock stack. This' is not to be confused with a CallBack control, The only function that uses' callbacks is WSASetBlockingHook()' (4) Alot of "helper" functions are provided in the file for various things' before attempting to figure out how to call a function, look and see if' there is already a helper function for it.' (5) Data types (hostent etc) have kept there 16bit definitions, even under 32bit' windows due to the problem of them not working when redfined following the' suggested rules.Option ExplicitPublic Const FD_SETSIZE = 64Type fd_set fd_count As Integer fd_array(FD_SETSIZE) As IntegerEnd TypeType timeval tv_sec As Long tv_usec As LongEnd TypeType HostEnt h_name As Long h_aliases As Long h_addrtype As Integer h_length As Integer h_addr_list As LongEnd TypePublic Const hostent_size = 16Type servent s_name As Long s_aliases As Long s_port As Integer s_proto As LongEnd TypePublic Const servent_size = 14Type protoent p_name As Long p_aliases As Long p_proto As IntegerEnd TypePublic Const protoent_size = 10Public Const IPPROTO_TCP = 6Public Const IPPROTO_UDP = 17Public Const INADDR_NONE = &HFFFFFFFFPublic Const INADDR_ANY = &H0Type sockaddr sin_family As Integer sin_port As Integer sin_addr As Long sin_zero As String * 8End TypePublic Const sockaddr_size = 16Public saZero As sockaddrPublic Const WSA_DESCRIPTIONLEN = 256Public Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1Public Const WSA_SYS_STATUS_LEN = 128Public Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1Type WSADataType wVersion As Integer wHighVersion As Integer szDescription As String * WSA_DescriptionSize szSystemStatus As String * WSA_SysStatusSize iMaxSockets As Integer iMaxUdpDg As Integer lpVendorInfo As LongEnd TypePublic Const INVALID_SOCKET = -1Public Const SOCKET_ERROR = -1Public Const SOCK_STREAM = 1Public Const SOCK_DGRAM = 2Public Const MAXGETHOSTSTRUCT = 1024Public Const AF_INET = 2Public Const PF_INET = 2Type LingerType l_onoff As Integer l_linger As IntegerEnd Type' Windows Sockets definitions of regular Microsoft C error constantsGlobal Const WSAEINTR = 10004Global Const WSAEBADF = 10009Global Const WSAEACCES = 10013Global Const WSAEFAULT = 10014Global Const WSAEINVAL = 10022Global Const WSAEMFILE = 10024' Windows Sockets definitions of regular Berkeley error constantsGlobal Const WSAEWOULDBLOCK = 10035Global Const WSAEINPROGRESS = 10036Global Const WSAEALREADY = 10037Global Const WSAENOTSOCK = 10038Global Const WSAEDESTADDRREQ = 10039Global Const WSAEMSGSIZE = 10040Global Const WSAEPROTOTYPE = 10041Global Const WSAENOPROTOOPT = 10042Global Const WSAEPROTONOSUPPORT = 10043Global Const WSAESOCKTNOSUPPORT = 10044Global Const WSAEOPNOTSUPP = 10045Global Const WSAEPFNOSUPPORT = 10046Global Const WSAEAFNOSUPPORT = 10047Global Const WSAEADDRINUSE = 10048Global Const WSAEADDRNOTAVAIL = 10049Global Const WSAENETDOWN = 10050Global Const WSAENETUNREACH = 10051Global Const WSAENETRESET = 10052Global Const WSAECONNABORTED = 10053Global Const WSAECONNRESET = 10054Global Const WSAENOBUFS = 10055Global Const WSAEISCONN = 10056Global Const WSAENOTCONN = 10057Global Const WSAESHUTDOWN = 10058Global Const WSAETOOMANYREFS = 10059Global Const WSAETIMEDOUT = 10060Global Const WSAECONNREFUSED = 10061Global Const WSAELOOP = 10062Global Const WSAENAMETOOLONG = 10063Global Const WSAEHOSTDOWN = 10064Global Const WSAEHOSTUNREACH = 10065Global Const WSAENOTEMPTY = 10066Global Const WSAEPROCLIM = 10067Global Const WSAEUSERS = 10068Global Const WSAEDQUOT = 10069Global Const WSAESTALE = 10070Global Const WSAEREMOTE = 10071' Extended Windows Sockets error constant definitionsGlobal Const WSASYSNOTREADY = 10091Global Const WSAVERNOTSUPPORTED = 10092Global Const WSANOTINITIALISED = 10093Global Const WSAHOST_NOT_FOUND = 11001Global Const WSATRY_AGAIN = 11002Global Const WSANO_RECOVERY = 11003Global Const WSANO_DATA = 11004Global Const WSANO_ADDRESS = 11004'---ioctl Constants Public Const FIONREAD = &H8004667F Public Const FIONBIO = &H8004667E Public Const FIOASYNC = &H8004667D#If Win16 Then'---Windows System functions Public Declare Function PostMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Integer Public Declare Sub MemCopy Lib "Kernel" Alias "hmemcpy" (Dest As Any, Src As Any, ByVal cb&) Public Declare Function lstrlen Lib "Kernel" (ByVal lpString As Any) As Integer'---async notification constants Public Const SOL_SOCKET = &HFFFF Public Const SO_LINGER = &H80 Public Const FD_READ = &H1 Public Const FD_WRITE = &H2 Public Const FD_OOB = &H4 Public Const FD_ACCEPT = &H8 Public Const FD_CONNECT = &H10 Public Const FD_CLOSE = &H20'---SOCKET FUNCTIONS Public Declare Function Accept Lib "Winsock.dll" Alias "accept" (ByVal s As Integer, addr As sockaddr, addrlen As Integer) As Integer Public Declare Function bind Lib "Winsock.dll" (ByVal s As Integer, addr As sockaddr, ByVal namelen As Integer) As Integer Public Declare Function closesocket Lib "Winsock.dll" (ByVal s As Integer) As Integer Public Declare Function Connect Lib "Winsock.dll" Alias "connect" (ByVal s As Integer, addr As sockaddr, ByVal namelen As Integer) As Integer Public Declare Function ioctlsocket Lib "Winsock.dll" (ByVal s As Integer, ByVal cmd As Long, argp As Long) As Integer Public Declare Function getpeername Lib "Winsock.dll" (ByVal s As Integer, sName As sockaddr, namelen As Integer) As Integer Public Declare Function getsockname Lib "Winsock.dll" (ByVal s As Integer, sName As sockaddr, namelen As Integer) As Integer 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 Public Declare Function htonl Lib "Winsock.dll" (ByVal hostlong As Long) As Long Public Declare Function htons Lib "Winsock.dll" (ByVal hostshort As Integer) As Integer Public Declare Function inet_addr Lib "Winsock.dll" (ByVal cp As String) As Long Public Declare Function inet_ntoa Lib "Winsock.dll" (ByVal inn As Long) As Long Public Declare Function Listen Lib "Winsock.dll" Alias "listen" (ByVal s As Integer, ByVal backlog As Integer) As Integer Public Declare Function ntohl Lib "Winsock.dll" (ByVal netlong As Long) As Long Public Declare Function ntohs Lib "Winsock.dll" (ByVal netshort As Integer) As Integer Public Declare Function recv Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer) As Integer 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 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 Public Declare Function send Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer) As Integer 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 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 Public Declare Function ShutDown Lib "Winsock.dll" Alias "shutdown" (ByVal s As Integer, ByVal how As Integer) As Integer Public Declare Function socket Lib "Winsock.dll" (ByVal af As Integer, ByVal s_type As Integer, ByVal protocol As Integer) As Integer'---DATABASE FUNCTIONS Public Declare Function gethostbyaddr Lib "Winsock.dll" (addr As Long, ByVal addr_len As Integer, ByVal addr_type As Integer) As Long Public Declare Function gethostbyname Lib "Winsock.dll" (ByVal host_name As String) As Long Public Declare Function gethostname Lib "Winsock.dll" (ByVal host_name As String, ByVal namelen As Integer) As Integer Public Declare Function getservbyport Lib "Winsock.dll" (ByVal Port As Integer, ByVal proto As String) As Long Public Declare Function getservbyname Lib "Winsock.dll" (ByVal serv_name As String, ByVal proto As String) As Long Public Declare Function getprotobynumber Lib "Winsock.dll" (ByVal proto As Integer) As Long Public Declare Function getprotobyname Lib "Winsock.dll" (ByVal proto_name As String) As Long'---WINDOWS EXTENSIONS Public Declare Function WSAStartup Lib "Winsock.dll" (ByVal wVR As Integer, lpWSAD As WSADataType) As Integer Public Declare Function WSACleanup Lib "Winsock.dll" () As Integer Public Declare Sub WSASetLastError Lib "Winsock.dll" (ByVal iError As Integer) Public Declare Function WSAGetLastError Lib "Winsock.dll" () As Integer Public Declare Function WSAIsBlocking Lib "Winsock.dll" () As Integer Public Declare Function WSAUnhookBlockingHook Lib "Winsock.dll" () As Integer Public Declare Function WSASetBlockingHook Lib "Winsock.dll" (ByVal lpBlockFunc As Long) As Long Public Declare Function WSACancelBlockingCall Lib "Winsock.dll" () As Integer 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 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 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 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 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 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 Public Declare Function WSACancelAsyncRequest Lib "Winsock.dll" (ByVal hAsyncTaskHandle As Integer) As Integer 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 Public Declare Function WSARecvEx Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer) As Integer#ElseIf Win32 Then'---Windows System Functions 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 Public Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&) Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long'---async notification constants Public Const SOL_SOCKET = &HFFFF& Public Const SO_LINGER = &H80& Public Const FD_READ = &H1& Public Const FD_WRITE = &H2& Public Const FD_OOB = &H4& Public Const FD_ACCEPT = &H8& Public Const FD_CONNECT = &H10& Public Const FD_CLOSE = &H20&'---SOCKET FUNCTIONS Public Declare Function Accept Lib "wsock32.dll" Alias "accept" (ByVal s As Long, addr As sockaddr, addrlen As Long) As Long Public Declare Function bind Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long Public Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long Public Declare Function Connect Lib "wsock32.dll" Alias "connect" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long Public Declare Function ioctlsocket Lib "wsock32.dll" (ByVal s As Long, ByVal cmd As Long, argp As Long) As Long Public Declare Function getpeername Lib "wsock32.dll" (ByVal s As Long, sName As sockaddr, namelen As Long) As Long Public Declare Function getsockname Lib "wsock32.dll" (ByVal s As Long, sName As sockaddr, namelen As Long) As Long 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 Public Declare Function htonl Lib "wsock32.dll" (ByVal hostlong As Long) As Long Public Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer Public Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long Public Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long Public Declare Function Listen Lib "wsock32.dll" Alias "listen" (ByVal s As Long, ByVal backlog As Long) As Long Public Declare Function ntohl Lib "wsock32.dll" (ByVal netlong As Long) As Long Public Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer Public Declare Function recv Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long 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 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 Public Declare Function send Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long 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 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 Public Declare Function ShutDown Lib "wsock32.dll" Alias "shutdown" (ByVal s As Long, ByVal how As Long) As Long Public Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long'---DATABASE FUNCTIONS Public Declare Function gethostbyaddr Lib "wsock32.dll" (addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long Public Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long Public Declare Function gethostname Lib "wsock32.dll" (ByVal host_name As String, ByVal namelen As Long) As Long Public Declare Function getservbyport Lib "wsock32.dll" (ByVal Port As Long, ByVal proto As String) As Long Public Declare Function getservbyname Lib "wsock32.dll" (ByVal serv_name As String, ByVal proto As String) As Long Public Declare Function getprotobynumber Lib "wsock32.dll" (ByVal proto As Long) As Long Public Declare Function getprotobyname Lib "wsock32.dll" (ByVal proto_name As String) As Long'---WINDOWS EXTENSIONS Public Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long Public Declare Function WSACleanup Lib "wsock32.dll" () As Long Public Declare Sub WSASetLastError Lib "wsock32.dll" (ByVal iError As Long) Public Declare Function WSAGetLastError Lib "wsock32.dll" () As Long Public Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long Public Declare Function WSAUnhookBlockingHook Lib "wsock32.dll" () As Long Public Declare Function WSASetBlockingHook Lib "wsock32.dll" (ByVal lpBlockFunc As Long) As Long Public Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long 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 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 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 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 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 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 Public Declare Function WSACancelAsyncRequest Lib "wsock32.dll" (ByVal hAsyncTaskHandle As Long) As Long 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 Public Declare Function WSARecvEx Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long#End If'SOME STUFF I ADDEDPublic MySocket%Public SockReadBuffer$Public Const WSA_NoName = "Unknown"Public WSAStartedUp As Boolean 'Flag to keep track of whether winsock WSAStartup wascalledPublic glngCount As Long
Public Function WSAGetAsyncBufLen(ByVal lParam As Long) As Long If (lParam And &HFFFF&) > &H7FFF Then WSAGetAsyncBufLen = (lParam And &HFFFF&) - &H10000 Else WSAGetAsyncBufLen = lParam And &HFFFF& End IfEnd FunctionPublic Function WSAGetSelectEvent(ByVal lParam As Long) As Integer If (lParam And &HFFFF&) > &H7FFF Then WSAGetSelectEvent = (lParam And &HFFFF&) - &H10000 Else WSAGetSelectEvent = lParam And &HFFFF& End IfEnd FunctionPublic Function WSAGetAsyncError(ByVal lParam As Long) As Integer WSAGetAsyncError = (lParam And &HFFFF0000) \ &H10000End FunctionPublic Function AddrToIP(ByVal AddrOrIP$) As String AddrToIP$ = GetAscIP(GetHostByNameAlias(AddrOrIP$))End Function'this function should work on 16 and 32 bit systems#If Win16 Then Function ConnectSock(ByVal Host$, ByVal Port%, retIpPort$, ByVal HWndToMsg%, ByVal Async%) As Integer Dim s%, SelectOps%, dummy%#ElseIf Win32 Then Function ConnectSock(ByVal Host$, ByVal Port&, retIpPort$, ByVal HWndToMsg&, ByVal Async%) As Long Dim s&, SelectOps&, dummy&#End If Dim sockin As sockaddr SockReadBuffer$ = "" sockin = saZero sockin.sin_family = AF_INET sockin.sin_port = htons(Port) If sockin.sin_port = INVALID_SOCKET Then ConnectSock = INVALID_SOCKET Exit Function End If sockin.sin_addr = GetHostByNameAlias(Host$) If sockin.sin_addr = INADDR_NONE Then ConnectSock = INVALID_SOCKET Exit Function End If retIpPort$ = GetAscIP$(sockin.sin_addr) & ":" & ntohs(sockin.sin_port) s = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP) If s < 0 Then ConnectSock = INVALID_SOCKET Exit Function End If If SetSockLinger(s, 1, 0) = SOCKET_ERROR Then If s > 0 Then dummy = closesocket(s) End If ConnectSock = INVALID_SOCKET Exit Function End If If Not Async Then If Not Connect(s, sockin, sockaddr_size) = 0 Then If s > 0 Then dummy = closesocket(s) End If ConnectSock = INVALID_SOCKET Exit Function End If If HWndToMsg <> 0 Then 'SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE
SelectOps = FD_CONNECT Or FD_CLOSE 'If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
If WSAAsyncSelect(s, HWndToMsg, ByVal &H200, ByVal SelectOps) Then If s > 0 Then dummy = closesocket(s) End If ConnectSock = INVALID_SOCKET Exit Function End If End If Else SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE
SelectOps = FD_CONNECT Or FD_CLOSE 'If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
If WSAAsyncSelect(s, HWndToMsg, ByVal &H200, ByVal SelectOps) Then If s > 0 Then dummy = closesocket(s) End If ConnectSock = INVALID_SOCKET Exit Function End If If Connect(s, sockin, sockaddr_size) <> -1 Then If s > 0 Then dummy = closesocket(s) End If ConnectSock = INVALID_SOCKET Exit Function End If End If ConnectSock = sEnd Function#If Win32 Then Public Function SetSockLinger(ByVal SockNum&, ByVal OnOff%, ByVal LingerTime%) As Long#Else Public Function SetSockLinger(ByVal SockNum%, ByVal OnOff%, ByVal LingerTime%) As Integer#End If Dim Linger As LingerType Linger.l_onoff = OnOff Linger.l_linger = LingerTime If setsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then 'Debug.Print "Error setting linger info: " & WSAGetLastError() SetSockLinger = SOCKET_ERROR Else If getsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then 'Debug.Print "Error getting linger info: " & WSAGetLastError() SetSockLinger = SOCKET_ERROR Else 'Debug.Print "Linger is on if nonzero: "; Linger.l_onoff 'Debug.Print "Linger time if linger is on: "; Linger.l_linger End If End IfEnd FunctionSub EndWinsock() Dim ret& If WSAIsBlocking() Then ret = WSACancelBlockingCall() End If ret = WSACleanup() WSAStartedUp = FalseEnd SubPublic Function GetAscIP(ByVal inn As Long) As String #If Win32 Then Dim nStr& #Else Dim nStr% #End If Dim lpStr& Dim retString$ retString = String(32, 0) lpStr = inet_ntoa(inn) If lpStr Then nStr = lstrlen(lpStr) If nStr > 32 Then nStr = 32 MemCopy ByVal retString, ByVal lpStr, nStr retString = Left(retString, nStr) GetAscIP = retString Else GetAscIP = "255.255.255.255" End IfEnd FunctionPublic Function GetHostByAddress(ByVal addr As Long) As String Dim phe&, ret& Dim heDestHost As HostEnt Dim HostName$ phe = gethostbyaddr(addr, 4, PF_INET) If phe Then MemCopy heDestHost, ByVal phe, hostent_size HostName = String(256, 0) MemCopy ByVal HostName, ByVal heDestHost.h_name, 256 GetHostByAddress = Left(HostName, InStr(HostName, Chr(0)) - 1) Else GetHostByAddress = WSA_NoName End IfEnd Function'returns IP as long, in network byte orderPublic Function GetHostByNameAlias(ByVal HostName$) As Long 'Return IP address as a long, in network byte order Dim phe& Dim heDestHost As HostEnt Dim addrList& Dim retIP& retIP = inet_addr(HostName$) If retIP = INADDR_NONE Then phe = gethostbyname(HostName$) If phe <> 0 Then MemCopy heDestHost, ByVal phe, hostent_size MemCopy addrList, ByVal heDestHost.h_addr_list, 4 MemCopy retIP, ByVal addrList, heDestHost.h_length Else retIP = INADDR_NONE End If End If GetHostByNameAlias = retIPEnd Function'returns your local machines namePublic Function GetLocalHostName() As String Dim sName$ sName = String(256, 0) If gethostname(sName, 256) Then sName = WSA_NoName Else If InStr(sName, Chr(0)) Then sName = Left(sName, InStr(sName, Chr(0)) - 1) End If End If GetLocalHostName = sNameEnd Function#If Win16 Then Public Function GetPeerAddress(ByVal s%) As String Dim addrlen%#ElseIf Win32 Then Public Function GetPeerAddress(ByVal s&) As String Dim addrlen&#End If Dim sa As sockaddr addrlen = sockaddr_size If getpeername(s, sa, addrlen) Then GetPeerAddress = "" Else GetPeerAddress = SockAddressToString(sa) End IfEnd Function#If Win16 Then Public Function GetPortFromString(ByVal PortStr$) As Integer#ElseIf Win32 Then Public Function GetPortFromString(ByVal PortStr$) As Long#End If 'sometimes users provide ports outside the range of a VB 'integer, so this function returns an integer for a string 'just to keep an error from happening, it converts the 'number to a negative if needed If Val(PortStr$) > 32767 Then GetPortFromString = CInt(Val(PortStr$) - &H10000) Else GetPortFromString = Val(PortStr$) End If If Err Then GetPortFromString = 0End Function#If Win16 Then Function GetProtocolByName(ByVal protocol$) As Integer Dim tmpShort%#ElseIf Win32 Then Function GetProtocolByName(ByVal protocol$) As Long Dim tmpShort&#End If Dim ppe& Dim peDestProt As protoent ppe = getprotobyname(protocol) If ppe Then MemCopy peDestProt, ByVal ppe, protoent_size GetProtocolByName = peDestProt.p_proto Else tmpShort = Val(protocol) If tmpShort Then GetProtocolByName = htons(tmpShort) Else GetProtocolByName = SOCKET_ERROR End If End IfEnd Function#If Win16 Then Function GetServiceByName(ByVal service$, ByVal protocol$) As Integer Dim serv%#ElseIf Win32 Then Function GetServiceByName(ByVal service$, ByVal protocol$) As Long Dim serv&#End If Dim pse& Dim seDestServ As servent pse = getservbyname(service, protocol) If pse Then MemCopy seDestServ, ByVal pse, servent_size GetServiceByName = seDestServ.s_port Else serv = Val(service) If serv Then GetServiceByName = htons(serv) Else GetServiceByName = INVALID_SOCKET End If End IfEnd Function'this function DOES work on 16 and 32 bit systems#If Win16 Then Function GetSockAddress(ByVal s%) As String Dim addrlen% Dim ret%#ElseIf Win32 Then Function GetSockAddress(ByVal s&) As String Dim addrlen& Dim ret&#End If Dim sa As sockaddr Dim szRet$ szRet = String(32, 0) addrlen = sockaddr_size If getsockname(s, sa, addrlen) Then GetSockAddress = "" Else GetSockAddress = SockAddressToString(sa) End IfEnd Function'this function should work on 16 and 32 bit systemsFunction GetWSAErrorString(ByVal errnum&) As String On Error Resume Next Select Case errnum Case 10004: GetWSAErrorString = "Interrupted system call." Case 10009: GetWSAErrorString = "Bad file number." Case 10013: GetWSAErrorString = "Permission Denied." Case 10014: GetWSAErrorString = "Bad Address." Case 10022: GetWSAErrorString = "Invalid Argument." Case 10024: GetWSAErrorString = "Too many open files." Case 10035: GetWSAErrorString = "Operation would block." Case 10036: GetWSAErrorString = "Operation now in progress." Case 10037: GetWSAErrorString = "Operation already in progress." Case 10038: GetWSAErrorString = "Socket operation on nonsocket." Case 10039: GetWSAErrorString = "Destination address required." Case 10040: GetWSAErrorString = "Message too long." Case 10041: GetWSAErrorString = "Protocol wrong type for socket." Case 10042: GetWSAErrorString = "Protocol not available." Case 10043: GetWSAErrorString = "Protocol not supported." Case 10044: GetWSAErrorString = "Socket type not supported." Case 10045: GetWSAErrorString = "Operation not supported on socket." Case 10046: GetWSAErrorString = "Protocol family not supported." Case 10047: GetWSAErrorString = "Address family not supported by protocol family." Case 10048: GetWSAErrorString = "Address already in use." Case 10049: GetWSAErrorString = "Can't assign requested address." Case 10050: GetWSAErrorString = "Network is down." Case 10051: GetWSAErrorString = "Network is unreachable." Case 10052: GetWSAErrorString = "Network dropped connection." Case 10053: GetWSAErrorString = "Software caused connection abort." Case 10054: GetWSAErrorString = "Connection reset by peer." Case 10055: GetWSAErrorString = "No buffer space available." Case 10056: GetWSAErrorString = "Socket is already connected." Case 10057: GetWSAErrorString = "Socket is not connected." Case 10058: GetWSAErrorString = "Can't send after socket shutdown." Case 10059: GetWSAErrorString = "Too many references: can't splice." Case 10060: GetWSAErrorString = "Connection timed out." Case 10061: GetWSAErrorString = "Connection refused." Case 10062: GetWSAErrorString = "Too many levels of symbolic links." Case 10063: GetWSAErrorString = "File name too long." Case 10064: GetWSAErrorString = "Host is down." Case 10065: GetWSAErrorString = "No route to host." Case 10066: GetWSAErrorString = "Directory not empty." Case 10067: GetWSAErrorString = "Too many processes." Case 10068: GetWSAErrorString = "Too many users." Case 10069: GetWSAErrorString = "Disk quota exceeded." Case 10070: GetWSAErrorString = "Stale NFS file handle." Case 10071: GetWSAErrorString = "Too many levels of remote in path." Case 10091: GetWSAErrorString = "Network subsystem is unusable." Case 10092: GetWSAErrorString = "Winsock DLL cannot support this application." Case 10093: GetWSAErrorString = "Winsock not initialized." Case 10101: GetWSAErrorString = "Disconnect." Case 11001: GetWSAErrorString = "Host not found." Case 11002: GetWSAErrorString = "Nonauthoritative host not found." Case 11003: GetWSAErrorString = "Nonrecoverable error." Case 11004: GetWSAErrorString = "Valid name, no data record of requested type." Case Else: GetWSAErrorString = "Unexpert Error!" End SelectEnd Function'this function DOES work on 16 and 32 bit systemsFunction IpToAddr(ByVal AddrOrIP$) As String On Error Resume Next IpToAddr = GetHostByAddress(GetHostByNameAlias(AddrOrIP$)) If Err Then IpToAddr = WSA_NoNameEnd Function'this function DOES work on 16 and 32 bit systemsFunction IrcGetAscIp(ByVal IPL$) As String 'this function is IRC specific, it expects a long ip stored in Network byte order, in a string 'the kind that would be parsed out of a DCC command string On Error GoTo IrcGetAscIPError: Dim lpStr&#If Win16 Then Dim nStr%#ElseIf Win32 Then Dim nStr&#End If Dim retString$ Dim inn& If Val(IPL) > 2147483647 Then inn = Val(IPL) - 4294967296# Else inn = Val(IPL) End If inn = ntohl(inn) retString = String(32, 0) lpStr = inet_ntoa(inn) If lpStr = 0 Then IrcGetAscIp = "0.0.0.0" Exit Function End If nStr = lstrlen(lpStr) If nStr > 32 Then nStr = 32 MemCopy ByVal retString, ByVal lpStr, nStr retString = Left(retString, nStr) IrcGetAscIp = retString Exit FunctionIrcGetAscIPError: IrcGetAscIp = "0.0.0.0" Exit Function ResumeEnd Function'this function DOES work on 16 and 32 bit systemsFunction IrcGetLongIp(ByVal AscIp$) As String 'this function converts an ascii ip string into a long ip in network byte order 'and stick it in a string suitable for use in a DCC command. On Error GoTo IrcGetLongIpError: Dim inn& inn = inet_addr(AscIp) inn = htonl(inn) If inn < 0 Then IrcGetLongIp = CVar(inn + 4294967296#) Exit Function Else IrcGetLongIp = CVar(inn) Exit Function End If Exit FunctionIrcGetLongIpError: IrcGetLongIp = "0" Exit Function ResumeEnd Function'this function should work on 16 and 32 bit systems#If Win16 ThenPublic Function ListenForConnect(ByVal Port%, ByVal HWndToMsg%) As Integer Dim s%, dummy% Dim SelectOps%#ElseIf Win32 ThenPublic Function ListenForConnect(ByVal Port&, ByVal HWndToMsg&) As Long Dim s&, dummy& Dim SelectOps&#End If Dim sockin As sockaddr sockin = saZero 'zero out the structure sockin.sin_family = AF_INET sockin.sin_port = htons(Port) If sockin.sin_port = INVALID_SOCKET Then ListenForConnect = INVALID_SOCKET Exit Function End If sockin.sin_addr = htonl(INADDR_ANY) If sockin.sin_addr = INADDR_NONE Then ListenForConnect = INVALID_SOCKET Exit Function End If s = socket(PF_INET, SOCK_STREAM, 0) If s < 0 Then ListenForConnect = INVALID_SOCKET Exit Function End If If bind(s, sockin, sockaddr_size) Then If s > 0 Then dummy = closesocket(s) End If ListenForConnect = INVALID_SOCKET Exit Function End If SelectOps = FD_READ Or FD_WRITE Or FD_CLOSE Or FD_ACCEPT
SelectOps = FD_CLOSE Or FD_ACCEPT 'If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
If WSAAsyncSelect(s, HWndToMsg, ByVal &H200, ByVal SelectOps) Then If s > 0 Then dummy = closesocket(s) End If ListenForConnect = SOCKET_ERROR Exit Function End If If Listen(s, 1) Then If s > 0 Then dummy = closesocket(s) End If ListenForConnect = INVALID_SOCKET Exit Function End If ListenForConnect = sEnd Function'this function should work on 16 and 32 bit systems#If Win16 ThenPublic Function SendData(ByVal s%, vMessage As Variant) As Integer#ElseIf Win32 ThenPublic Function SendData(ByVal s&, vMessage As Variant) As Long#End If Dim TheMsg() As Byte, sTemp$ Select Case VarType(vMessage) Case 8209 'byte array sTemp = vMessage
Case 8 'string, if we recieve a string, its assumed we are linemode sTemp = StrConv(vMessage, vbFromUnicode)
'sTemp = vMessage ', vbFromUnicode)
Case Else sTemp = CStr(vMessage) End Select TheMsg = sTemp If UBound(TheMsg) > -1 Then SendData = send(s, TheMsg(0), UBound(TheMsg) + 1, 0) End IfEnd FunctionPublic Function SockAddressToString(sa As sockaddr) As String SockAddressToString = GetAscIP(sa.sin_addr) & ":" & ntohs(sa.sin_port)End FunctionPublic Function StartWinsock(sDescription As String) As Boolean Dim StartupData As WSADataType If Not WSAStartedUp Then If Not WSAStartup(&H101, StartupData) Then WSAStartedUp = True' Debug.Print "wVersion="; StartupData.wVersion, "wHighVersion="; StartupData.wHighVersion
'
' Debug.Print "If wVersion == 257 then everything is kewl"
'
' Debug.Print "szDescription="; StartupData.szDescription
'
' Debug.Print "szSystemStatus="; StartupData.szSystemStatus
'
' Debug.Print "iMaxSockets="; StartupData.iMaxSockets, "iMaxUdpDg="; StartupData.iMaxUdpDg sDescription = StartupData.szDescription Else WSAStartedUp = False End If End If StartWinsock = WSAStartedUpEnd FunctionPublic Function WSAMakeSelectReply(TheEvent%, TheError%) As Long WSAMakeSelectReply = (TheError * &H10000) + (TheEvent And &HFFFF&)End Function
' (1) I have never used WS_SELECT (select), therefore I must warn that I do' not know if fd_set and timeval are properly defined.' (2) Alot of the functions are declared with "buf as any", when calling these' functions you may either pass strings, byte arrays or UDT's. For 32bit I' I recommend Byte arrays and the use of memcopy to copy the data back out' (3) The async functions (wsaAsync*) require the use of a message hook or' message window control to capture messages sent by the winsock stack. This' is not to be confused with a CallBack control, The only function that uses' callbacks is WSASetBlockingHook()' (4) Alot of "helper" functions are provided in the file for various things' before attempting to figure out how to call a function, look and see if' there is already a helper function for it.' (5) Data types (hostent etc) have kept there 16bit definitions, even under 32bit' windows due to the problem of them not working when redfined following the' suggested rules.Option ExplicitPublic Const FD_SETSIZE = 64Type fd_set fd_count As Integer fd_array(FD_SETSIZE) As IntegerEnd TypeType timeval tv_sec As Long tv_usec As LongEnd TypeType HostEnt h_name As Long h_aliases As Long h_addrtype As Integer h_length As Integer h_addr_list As LongEnd TypePublic Const hostent_size = 16Type servent s_name As Long s_aliases As Long s_port As Integer s_proto As LongEnd TypePublic Const servent_size = 14Type protoent p_name As Long p_aliases As Long p_proto As IntegerEnd TypePublic Const protoent_size = 10Public Const IPPROTO_TCP = 6Public Const IPPROTO_UDP = 17Public Const INADDR_NONE = &HFFFFFFFFPublic Const INADDR_ANY = &H0Type sockaddr sin_family As Integer sin_port As Integer sin_addr As Long sin_zero As String * 8End TypePublic Const sockaddr_size = 16Public saZero As sockaddrPublic Const WSA_DESCRIPTIONLEN = 256Public Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1Public Const WSA_SYS_STATUS_LEN = 128Public Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1Type WSADataType wVersion As Integer wHighVersion As Integer szDescription As String * WSA_DescriptionSize szSystemStatus As String * WSA_SysStatusSize iMaxSockets As Integer iMaxUdpDg As Integer lpVendorInfo As LongEnd TypePublic Const INVALID_SOCKET = -1Public Const SOCKET_ERROR = -1Public Const SOCK_STREAM = 1Public Const SOCK_DGRAM = 2Public Const MAXGETHOSTSTRUCT = 1024Public Const AF_INET = 2Public Const PF_INET = 2Type LingerType l_onoff As Integer l_linger As IntegerEnd Type' Windows Sockets definitions of regular Microsoft C error constantsGlobal Const WSAEINTR = 10004Global Const WSAEBADF = 10009Global Const WSAEACCES = 10013Global Const WSAEFAULT = 10014Global Const WSAEINVAL = 10022Global Const WSAEMFILE = 10024' Windows Sockets definitions of regular Berkeley error constantsGlobal Const WSAEWOULDBLOCK = 10035Global Const WSAEINPROGRESS = 10036Global Const WSAEALREADY = 10037Global Const WSAENOTSOCK = 10038Global Const WSAEDESTADDRREQ = 10039Global Const WSAEMSGSIZE = 10040Global Const WSAEPROTOTYPE = 10041Global Const WSAENOPROTOOPT = 10042Global Const WSAEPROTONOSUPPORT = 10043Global Const WSAESOCKTNOSUPPORT = 10044Global Const WSAEOPNOTSUPP = 10045Global Const WSAEPFNOSUPPORT = 10046Global Const WSAEAFNOSUPPORT = 10047Global Const WSAEADDRINUSE = 10048Global Const WSAEADDRNOTAVAIL = 10049Global Const WSAENETDOWN = 10050Global Const WSAENETUNREACH = 10051Global Const WSAENETRESET = 10052Global Const WSAECONNABORTED = 10053Global Const WSAECONNRESET = 10054Global Const WSAENOBUFS = 10055Global Const WSAEISCONN = 10056Global Const WSAENOTCONN = 10057Global Const WSAESHUTDOWN = 10058Global Const WSAETOOMANYREFS = 10059Global Const WSAETIMEDOUT = 10060Global Const WSAECONNREFUSED = 10061Global Const WSAELOOP = 10062Global Const WSAENAMETOOLONG = 10063Global Const WSAEHOSTDOWN = 10064Global Const WSAEHOSTUNREACH = 10065Global Const WSAENOTEMPTY = 10066Global Const WSAEPROCLIM = 10067Global Const WSAEUSERS = 10068Global Const WSAEDQUOT = 10069Global Const WSAESTALE = 10070Global Const WSAEREMOTE = 10071' Extended Windows Sockets error constant definitionsGlobal Const WSASYSNOTREADY = 10091Global Const WSAVERNOTSUPPORTED = 10092Global Const WSANOTINITIALISED = 10093Global Const WSAHOST_NOT_FOUND = 11001Global Const WSATRY_AGAIN = 11002Global Const WSANO_RECOVERY = 11003Global Const WSANO_DATA = 11004Global Const WSANO_ADDRESS = 11004'---ioctl Constants Public Const FIONREAD = &H8004667F Public Const FIONBIO = &H8004667E Public Const FIOASYNC = &H8004667D#If Win16 Then'---Windows System functions Public Declare Function PostMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Integer Public Declare Sub MemCopy Lib "Kernel" Alias "hmemcpy" (Dest As Any, Src As Any, ByVal cb&) Public Declare Function lstrlen Lib "Kernel" (ByVal lpString As Any) As Integer'---async notification constants Public Const SOL_SOCKET = &HFFFF Public Const SO_LINGER = &H80 Public Const FD_READ = &H1 Public Const FD_WRITE = &H2 Public Const FD_OOB = &H4 Public Const FD_ACCEPT = &H8 Public Const FD_CONNECT = &H10 Public Const FD_CLOSE = &H20'---SOCKET FUNCTIONS Public Declare Function Accept Lib "Winsock.dll" Alias "accept" (ByVal s As Integer, addr As sockaddr, addrlen As Integer) As Integer Public Declare Function bind Lib "Winsock.dll" (ByVal s As Integer, addr As sockaddr, ByVal namelen As Integer) As Integer Public Declare Function closesocket Lib "Winsock.dll" (ByVal s As Integer) As Integer Public Declare Function Connect Lib "Winsock.dll" Alias "connect" (ByVal s As Integer, addr As sockaddr, ByVal namelen As Integer) As Integer Public Declare Function ioctlsocket Lib "Winsock.dll" (ByVal s As Integer, ByVal cmd As Long, argp As Long) As Integer Public Declare Function getpeername Lib "Winsock.dll" (ByVal s As Integer, sName As sockaddr, namelen As Integer) As Integer Public Declare Function getsockname Lib "Winsock.dll" (ByVal s As Integer, sName As sockaddr, namelen As Integer) As Integer 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 Public Declare Function htonl Lib "Winsock.dll" (ByVal hostlong As Long) As Long Public Declare Function htons Lib "Winsock.dll" (ByVal hostshort As Integer) As Integer Public Declare Function inet_addr Lib "Winsock.dll" (ByVal cp As String) As Long Public Declare Function inet_ntoa Lib "Winsock.dll" (ByVal inn As Long) As Long Public Declare Function Listen Lib "Winsock.dll" Alias "listen" (ByVal s As Integer, ByVal backlog As Integer) As Integer Public Declare Function ntohl Lib "Winsock.dll" (ByVal netlong As Long) As Long Public Declare Function ntohs Lib "Winsock.dll" (ByVal netshort As Integer) As Integer Public Declare Function recv Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer) As Integer 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 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 Public Declare Function send Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer) As Integer 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 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 Public Declare Function ShutDown Lib "Winsock.dll" Alias "shutdown" (ByVal s As Integer, ByVal how As Integer) As Integer Public Declare Function socket Lib "Winsock.dll" (ByVal af As Integer, ByVal s_type As Integer, ByVal protocol As Integer) As Integer'---DATABASE FUNCTIONS Public Declare Function gethostbyaddr Lib "Winsock.dll" (addr As Long, ByVal addr_len As Integer, ByVal addr_type As Integer) As Long Public Declare Function gethostbyname Lib "Winsock.dll" (ByVal host_name As String) As Long Public Declare Function gethostname Lib "Winsock.dll" (ByVal host_name As String, ByVal namelen As Integer) As Integer Public Declare Function getservbyport Lib "Winsock.dll" (ByVal Port As Integer, ByVal proto As String) As Long Public Declare Function getservbyname Lib "Winsock.dll" (ByVal serv_name As String, ByVal proto As String) As Long Public Declare Function getprotobynumber Lib "Winsock.dll" (ByVal proto As Integer) As Long Public Declare Function getprotobyname Lib "Winsock.dll" (ByVal proto_name As String) As Long'---WINDOWS EXTENSIONS Public Declare Function WSAStartup Lib "Winsock.dll" (ByVal wVR As Integer, lpWSAD As WSADataType) As Integer Public Declare Function WSACleanup Lib "Winsock.dll" () As Integer Public Declare Sub WSASetLastError Lib "Winsock.dll" (ByVal iError As Integer) Public Declare Function WSAGetLastError Lib "Winsock.dll" () As Integer Public Declare Function WSAIsBlocking Lib "Winsock.dll" () As Integer Public Declare Function WSAUnhookBlockingHook Lib "Winsock.dll" () As Integer Public Declare Function WSASetBlockingHook Lib "Winsock.dll" (ByVal lpBlockFunc As Long) As Long Public Declare Function WSACancelBlockingCall Lib "Winsock.dll" () As Integer 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 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 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 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 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 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 Public Declare Function WSACancelAsyncRequest Lib "Winsock.dll" (ByVal hAsyncTaskHandle As Integer) As Integer 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 Public Declare Function WSARecvEx Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer) As Integer#ElseIf Win32 Then'---Windows System Functions 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 Public Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&) Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long'---async notification constants Public Const SOL_SOCKET = &HFFFF& Public Const SO_LINGER = &H80& Public Const FD_READ = &H1& Public Const FD_WRITE = &H2& Public Const FD_OOB = &H4& Public Const FD_ACCEPT = &H8& Public Const FD_CONNECT = &H10& Public Const FD_CLOSE = &H20&'---SOCKET FUNCTIONS Public Declare Function Accept Lib "wsock32.dll" Alias "accept" (ByVal s As Long, addr As sockaddr, addrlen As Long) As Long Public Declare Function bind Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long Public Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long Public Declare Function Connect Lib "wsock32.dll" Alias "connect" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long Public Declare Function ioctlsocket Lib "wsock32.dll" (ByVal s As Long, ByVal cmd As Long, argp As Long) As Long Public Declare Function getpeername Lib "wsock32.dll" (ByVal s As Long, sName As sockaddr, namelen As Long) As Long Public Declare Function getsockname Lib "wsock32.dll" (ByVal s As Long, sName As sockaddr, namelen As Long) As Long 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 Public Declare Function htonl Lib "wsock32.dll" (ByVal hostlong As Long) As Long Public Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer Public Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long Public Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long Public Declare Function Listen Lib "wsock32.dll" Alias "listen" (ByVal s As Long, ByVal backlog As Long) As Long Public Declare Function ntohl Lib "wsock32.dll" (ByVal netlong As Long) As Long Public Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer Public Declare Function recv Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long 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 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 Public Declare Function send Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long 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 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 Public Declare Function ShutDown Lib "wsock32.dll" Alias "shutdown" (ByVal s As Long, ByVal how As Long) As Long Public Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long'---DATABASE FUNCTIONS Public Declare Function gethostbyaddr Lib "wsock32.dll" (addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long Public Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long Public Declare Function gethostname Lib "wsock32.dll" (ByVal host_name As String, ByVal namelen As Long) As Long Public Declare Function getservbyport Lib "wsock32.dll" (ByVal Port As Long, ByVal proto As String) As Long Public Declare Function getservbyname Lib "wsock32.dll" (ByVal serv_name As String, ByVal proto As String) As Long Public Declare Function getprotobynumber Lib "wsock32.dll" (ByVal proto As Long) As Long Public Declare Function getprotobyname Lib "wsock32.dll" (ByVal proto_name As String) As Long'---WINDOWS EXTENSIONS Public Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long Public Declare Function WSACleanup Lib "wsock32.dll" () As Long Public Declare Sub WSASetLastError Lib "wsock32.dll" (ByVal iError As Long) Public Declare Function WSAGetLastError Lib "wsock32.dll" () As Long Public Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long Public Declare Function WSAUnhookBlockingHook Lib "wsock32.dll" () As Long Public Declare Function WSASetBlockingHook Lib "wsock32.dll" (ByVal lpBlockFunc As Long) As Long Public Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long 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 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 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 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 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 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 Public Declare Function WSACancelAsyncRequest Lib "wsock32.dll" (ByVal hAsyncTaskHandle As Long) As Long 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 Public Declare Function WSARecvEx Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long#End If'SOME STUFF I ADDEDPublic MySocket%Public SockReadBuffer$Public Const WSA_NoName = "Unknown"Public WSAStartedUp As Boolean 'Flag to keep track of whether winsock WSAStartup wascalledPublic glngCount As Long
Public Function WSAGetAsyncBufLen(ByVal lParam As Long) As Long If (lParam And &HFFFF&) > &H7FFF Then WSAGetAsyncBufLen = (lParam And &HFFFF&) - &H10000 Else WSAGetAsyncBufLen = lParam And &HFFFF& End IfEnd FunctionPublic Function WSAGetSelectEvent(ByVal lParam As Long) As Integer If (lParam And &HFFFF&) > &H7FFF Then WSAGetSelectEvent = (lParam And &HFFFF&) - &H10000 Else WSAGetSelectEvent = lParam And &HFFFF& End IfEnd FunctionPublic Function WSAGetAsyncError(ByVal lParam As Long) As Integer WSAGetAsyncError = (lParam And &HFFFF0000) \ &H10000End FunctionPublic Function AddrToIP(ByVal AddrOrIP$) As String AddrToIP$ = GetAscIP(GetHostByNameAlias(AddrOrIP$))End Function'this function should work on 16 and 32 bit systems#If Win16 Then Function ConnectSock(ByVal Host$, ByVal Port%, retIpPort$, ByVal HWndToMsg%, ByVal Async%) As Integer Dim s%, SelectOps%, dummy%#ElseIf Win32 Then Function ConnectSock(ByVal Host$, ByVal Port&, retIpPort$, ByVal HWndToMsg&, ByVal Async%) As Long Dim s&, SelectOps&, dummy&#End If Dim sockin As sockaddr SockReadBuffer$ = "" sockin = saZero sockin.sin_family = AF_INET sockin.sin_port = htons(Port) If sockin.sin_port = INVALID_SOCKET Then ConnectSock = INVALID_SOCKET Exit Function End If sockin.sin_addr = GetHostByNameAlias(Host$) If sockin.sin_addr = INADDR_NONE Then ConnectSock = INVALID_SOCKET Exit Function End If retIpPort$ = GetAscIP$(sockin.sin_addr) & ":" & ntohs(sockin.sin_port) s = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP) If s < 0 Then ConnectSock = INVALID_SOCKET Exit Function End If If SetSockLinger(s, 1, 0) = SOCKET_ERROR Then If s > 0 Then dummy = closesocket(s) End If ConnectSock = INVALID_SOCKET Exit Function End If If Not Async Then If Not Connect(s, sockin, sockaddr_size) = 0 Then If s > 0 Then dummy = closesocket(s) End If ConnectSock = INVALID_SOCKET Exit Function End If If HWndToMsg <> 0 Then 'SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE
SelectOps = FD_CONNECT Or FD_CLOSE 'If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
If WSAAsyncSelect(s, HWndToMsg, ByVal &H200, ByVal SelectOps) Then If s > 0 Then dummy = closesocket(s) End If ConnectSock = INVALID_SOCKET Exit Function End If End If Else SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE
SelectOps = FD_CONNECT Or FD_CLOSE 'If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
If WSAAsyncSelect(s, HWndToMsg, ByVal &H200, ByVal SelectOps) Then If s > 0 Then dummy = closesocket(s) End If ConnectSock = INVALID_SOCKET Exit Function End If If Connect(s, sockin, sockaddr_size) <> -1 Then If s > 0 Then dummy = closesocket(s) End If ConnectSock = INVALID_SOCKET Exit Function End If End If ConnectSock = sEnd Function#If Win32 Then Public Function SetSockLinger(ByVal SockNum&, ByVal OnOff%, ByVal LingerTime%) As Long#Else Public Function SetSockLinger(ByVal SockNum%, ByVal OnOff%, ByVal LingerTime%) As Integer#End If Dim Linger As LingerType Linger.l_onoff = OnOff Linger.l_linger = LingerTime If setsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then 'Debug.Print "Error setting linger info: " & WSAGetLastError() SetSockLinger = SOCKET_ERROR Else If getsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then 'Debug.Print "Error getting linger info: " & WSAGetLastError() SetSockLinger = SOCKET_ERROR Else 'Debug.Print "Linger is on if nonzero: "; Linger.l_onoff 'Debug.Print "Linger time if linger is on: "; Linger.l_linger End If End IfEnd FunctionSub EndWinsock() Dim ret& If WSAIsBlocking() Then ret = WSACancelBlockingCall() End If ret = WSACleanup() WSAStartedUp = FalseEnd SubPublic Function GetAscIP(ByVal inn As Long) As String #If Win32 Then Dim nStr& #Else Dim nStr% #End If Dim lpStr& Dim retString$ retString = String(32, 0) lpStr = inet_ntoa(inn) If lpStr Then nStr = lstrlen(lpStr) If nStr > 32 Then nStr = 32 MemCopy ByVal retString, ByVal lpStr, nStr retString = Left(retString, nStr) GetAscIP = retString Else GetAscIP = "255.255.255.255" End IfEnd FunctionPublic Function GetHostByAddress(ByVal addr As Long) As String Dim phe&, ret& Dim heDestHost As HostEnt Dim HostName$ phe = gethostbyaddr(addr, 4, PF_INET) If phe Then MemCopy heDestHost, ByVal phe, hostent_size HostName = String(256, 0) MemCopy ByVal HostName, ByVal heDestHost.h_name, 256 GetHostByAddress = Left(HostName, InStr(HostName, Chr(0)) - 1) Else GetHostByAddress = WSA_NoName End IfEnd Function'returns IP as long, in network byte orderPublic Function GetHostByNameAlias(ByVal HostName$) As Long 'Return IP address as a long, in network byte order Dim phe& Dim heDestHost As HostEnt Dim addrList& Dim retIP& retIP = inet_addr(HostName$) If retIP = INADDR_NONE Then phe = gethostbyname(HostName$) If phe <> 0 Then MemCopy heDestHost, ByVal phe, hostent_size MemCopy addrList, ByVal heDestHost.h_addr_list, 4 MemCopy retIP, ByVal addrList, heDestHost.h_length Else retIP = INADDR_NONE End If End If GetHostByNameAlias = retIPEnd Function'returns your local machines namePublic Function GetLocalHostName() As String Dim sName$ sName = String(256, 0) If gethostname(sName, 256) Then sName = WSA_NoName Else If InStr(sName, Chr(0)) Then sName = Left(sName, InStr(sName, Chr(0)) - 1) End If End If GetLocalHostName = sNameEnd Function#If Win16 Then Public Function GetPeerAddress(ByVal s%) As String Dim addrlen%#ElseIf Win32 Then Public Function GetPeerAddress(ByVal s&) As String Dim addrlen&#End If Dim sa As sockaddr addrlen = sockaddr_size If getpeername(s, sa, addrlen) Then GetPeerAddress = "" Else GetPeerAddress = SockAddressToString(sa) End IfEnd Function#If Win16 Then Public Function GetPortFromString(ByVal PortStr$) As Integer#ElseIf Win32 Then Public Function GetPortFromString(ByVal PortStr$) As Long#End If 'sometimes users provide ports outside the range of a VB 'integer, so this function returns an integer for a string 'just to keep an error from happening, it converts the 'number to a negative if needed If Val(PortStr$) > 32767 Then GetPortFromString = CInt(Val(PortStr$) - &H10000) Else GetPortFromString = Val(PortStr$) End If If Err Then GetPortFromString = 0End Function#If Win16 Then Function GetProtocolByName(ByVal protocol$) As Integer Dim tmpShort%#ElseIf Win32 Then Function GetProtocolByName(ByVal protocol$) As Long Dim tmpShort&#End If Dim ppe& Dim peDestProt As protoent ppe = getprotobyname(protocol) If ppe Then MemCopy peDestProt, ByVal ppe, protoent_size GetProtocolByName = peDestProt.p_proto Else tmpShort = Val(protocol) If tmpShort Then GetProtocolByName = htons(tmpShort) Else GetProtocolByName = SOCKET_ERROR End If End IfEnd Function#If Win16 Then Function GetServiceByName(ByVal service$, ByVal protocol$) As Integer Dim serv%#ElseIf Win32 Then Function GetServiceByName(ByVal service$, ByVal protocol$) As Long Dim serv&#End If Dim pse& Dim seDestServ As servent pse = getservbyname(service, protocol) If pse Then MemCopy seDestServ, ByVal pse, servent_size GetServiceByName = seDestServ.s_port Else serv = Val(service) If serv Then GetServiceByName = htons(serv) Else GetServiceByName = INVALID_SOCKET End If End IfEnd Function'this function DOES work on 16 and 32 bit systems#If Win16 Then Function GetSockAddress(ByVal s%) As String Dim addrlen% Dim ret%#ElseIf Win32 Then Function GetSockAddress(ByVal s&) As String Dim addrlen& Dim ret&#End If Dim sa As sockaddr Dim szRet$ szRet = String(32, 0) addrlen = sockaddr_size If getsockname(s, sa, addrlen) Then GetSockAddress = "" Else GetSockAddress = SockAddressToString(sa) End IfEnd Function'this function should work on 16 and 32 bit systemsFunction GetWSAErrorString(ByVal errnum&) As String On Error Resume Next Select Case errnum Case 10004: GetWSAErrorString = "Interrupted system call." Case 10009: GetWSAErrorString = "Bad file number." Case 10013: GetWSAErrorString = "Permission Denied." Case 10014: GetWSAErrorString = "Bad Address." Case 10022: GetWSAErrorString = "Invalid Argument." Case 10024: GetWSAErrorString = "Too many open files." Case 10035: GetWSAErrorString = "Operation would block." Case 10036: GetWSAErrorString = "Operation now in progress." Case 10037: GetWSAErrorString = "Operation already in progress." Case 10038: GetWSAErrorString = "Socket operation on nonsocket." Case 10039: GetWSAErrorString = "Destination address required." Case 10040: GetWSAErrorString = "Message too long." Case 10041: GetWSAErrorString = "Protocol wrong type for socket." Case 10042: GetWSAErrorString = "Protocol not available." Case 10043: GetWSAErrorString = "Protocol not supported." Case 10044: GetWSAErrorString = "Socket type not supported." Case 10045: GetWSAErrorString = "Operation not supported on socket." Case 10046: GetWSAErrorString = "Protocol family not supported." Case 10047: GetWSAErrorString = "Address family not supported by protocol family." Case 10048: GetWSAErrorString = "Address already in use." Case 10049: GetWSAErrorString = "Can't assign requested address." Case 10050: GetWSAErrorString = "Network is down." Case 10051: GetWSAErrorString = "Network is unreachable." Case 10052: GetWSAErrorString = "Network dropped connection." Case 10053: GetWSAErrorString = "Software caused connection abort." Case 10054: GetWSAErrorString = "Connection reset by peer." Case 10055: GetWSAErrorString = "No buffer space available." Case 10056: GetWSAErrorString = "Socket is already connected." Case 10057: GetWSAErrorString = "Socket is not connected." Case 10058: GetWSAErrorString = "Can't send after socket shutdown." Case 10059: GetWSAErrorString = "Too many references: can't splice." Case 10060: GetWSAErrorString = "Connection timed out." Case 10061: GetWSAErrorString = "Connection refused." Case 10062: GetWSAErrorString = "Too many levels of symbolic links." Case 10063: GetWSAErrorString = "File name too long." Case 10064: GetWSAErrorString = "Host is down." Case 10065: GetWSAErrorString = "No route to host." Case 10066: GetWSAErrorString = "Directory not empty." Case 10067: GetWSAErrorString = "Too many processes." Case 10068: GetWSAErrorString = "Too many users." Case 10069: GetWSAErrorString = "Disk quota exceeded." Case 10070: GetWSAErrorString = "Stale NFS file handle." Case 10071: GetWSAErrorString = "Too many levels of remote in path." Case 10091: GetWSAErrorString = "Network subsystem is unusable." Case 10092: GetWSAErrorString = "Winsock DLL cannot support this application." Case 10093: GetWSAErrorString = "Winsock not initialized." Case 10101: GetWSAErrorString = "Disconnect." Case 11001: GetWSAErrorString = "Host not found." Case 11002: GetWSAErrorString = "Nonauthoritative host not found." Case 11003: GetWSAErrorString = "Nonrecoverable error." Case 11004: GetWSAErrorString = "Valid name, no data record of requested type." Case Else: GetWSAErrorString = "Unexpert Error!" End SelectEnd Function'this function DOES work on 16 and 32 bit systemsFunction IpToAddr(ByVal AddrOrIP$) As String On Error Resume Next IpToAddr = GetHostByAddress(GetHostByNameAlias(AddrOrIP$)) If Err Then IpToAddr = WSA_NoNameEnd Function'this function DOES work on 16 and 32 bit systemsFunction IrcGetAscIp(ByVal IPL$) As String 'this function is IRC specific, it expects a long ip stored in Network byte order, in a string 'the kind that would be parsed out of a DCC command string On Error GoTo IrcGetAscIPError: Dim lpStr&#If Win16 Then Dim nStr%#ElseIf Win32 Then Dim nStr&#End If Dim retString$ Dim inn& If Val(IPL) > 2147483647 Then inn = Val(IPL) - 4294967296# Else inn = Val(IPL) End If inn = ntohl(inn) retString = String(32, 0) lpStr = inet_ntoa(inn) If lpStr = 0 Then IrcGetAscIp = "0.0.0.0" Exit Function End If nStr = lstrlen(lpStr) If nStr > 32 Then nStr = 32 MemCopy ByVal retString, ByVal lpStr, nStr retString = Left(retString, nStr) IrcGetAscIp = retString Exit FunctionIrcGetAscIPError: IrcGetAscIp = "0.0.0.0" Exit Function ResumeEnd Function'this function DOES work on 16 and 32 bit systemsFunction IrcGetLongIp(ByVal AscIp$) As String 'this function converts an ascii ip string into a long ip in network byte order 'and stick it in a string suitable for use in a DCC command. On Error GoTo IrcGetLongIpError: Dim inn& inn = inet_addr(AscIp) inn = htonl(inn) If inn < 0 Then IrcGetLongIp = CVar(inn + 4294967296#) Exit Function Else IrcGetLongIp = CVar(inn) Exit Function End If Exit FunctionIrcGetLongIpError: IrcGetLongIp = "0" Exit Function ResumeEnd Function'this function should work on 16 and 32 bit systems#If Win16 ThenPublic Function ListenForConnect(ByVal Port%, ByVal HWndToMsg%) As Integer Dim s%, dummy% Dim SelectOps%#ElseIf Win32 ThenPublic Function ListenForConnect(ByVal Port&, ByVal HWndToMsg&) As Long Dim s&, dummy& Dim SelectOps&#End If Dim sockin As sockaddr sockin = saZero 'zero out the structure sockin.sin_family = AF_INET sockin.sin_port = htons(Port) If sockin.sin_port = INVALID_SOCKET Then ListenForConnect = INVALID_SOCKET Exit Function End If sockin.sin_addr = htonl(INADDR_ANY) If sockin.sin_addr = INADDR_NONE Then ListenForConnect = INVALID_SOCKET Exit Function End If s = socket(PF_INET, SOCK_STREAM, 0) If s < 0 Then ListenForConnect = INVALID_SOCKET Exit Function End If If bind(s, sockin, sockaddr_size) Then If s > 0 Then dummy = closesocket(s) End If ListenForConnect = INVALID_SOCKET Exit Function End If SelectOps = FD_READ Or FD_WRITE Or FD_CLOSE Or FD_ACCEPT
SelectOps = FD_CLOSE Or FD_ACCEPT 'If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
If WSAAsyncSelect(s, HWndToMsg, ByVal &H200, ByVal SelectOps) Then If s > 0 Then dummy = closesocket(s) End If ListenForConnect = SOCKET_ERROR Exit Function End If If Listen(s, 1) Then If s > 0 Then dummy = closesocket(s) End If ListenForConnect = INVALID_SOCKET Exit Function End If ListenForConnect = sEnd Function'this function should work on 16 and 32 bit systems#If Win16 ThenPublic Function SendData(ByVal s%, vMessage As Variant) As Integer#ElseIf Win32 ThenPublic Function SendData(ByVal s&, vMessage As Variant) As Long#End If Dim TheMsg() As Byte, sTemp$ Select Case VarType(vMessage) Case 8209 'byte array sTemp = vMessage
Case 8 'string, if we recieve a string, its assumed we are linemode sTemp = StrConv(vMessage, vbFromUnicode)
'sTemp = vMessage ', vbFromUnicode)
Case Else sTemp = CStr(vMessage) End Select TheMsg = sTemp If UBound(TheMsg) > -1 Then SendData = send(s, TheMsg(0), UBound(TheMsg) + 1, 0) End IfEnd FunctionPublic Function SockAddressToString(sa As sockaddr) As String SockAddressToString = GetAscIP(sa.sin_addr) & ":" & ntohs(sa.sin_port)End FunctionPublic Function StartWinsock(sDescription As String) As Boolean Dim StartupData As WSADataType If Not WSAStartedUp Then If Not WSAStartup(&H101, StartupData) Then WSAStartedUp = True' Debug.Print "wVersion="; StartupData.wVersion, "wHighVersion="; StartupData.wHighVersion
'
' Debug.Print "If wVersion == 257 then everything is kewl"
'
' Debug.Print "szDescription="; StartupData.szDescription
'
' Debug.Print "szSystemStatus="; StartupData.szSystemStatus
'
' Debug.Print "iMaxSockets="; StartupData.iMaxSockets, "iMaxUdpDg="; StartupData.iMaxUdpDg sDescription = StartupData.szDescription Else WSAStartedUp = False End If End If StartWinsock = WSAStartedUpEnd FunctionPublic Function WSAMakeSelectReply(TheEvent%, TheError%) As Long WSAMakeSelectReply = (TheError * &H10000) + (TheEvent And &HFFFF&)End Function
解决方案 »
免费领取超大流量手机卡，每月29元包185G流量+100分钟通话, 中国电信官方发货