Const FD_SETSIZE = 64 Type fd_set fd_count As Long fd_array(FD_SETSIZE) As Long End Type Type timeval tv_sec As Long tv_usec As Long End Type Type HostEnt h_name As long h_aliases As long h_addrtype As Integer h_length As Integer h_addr_list As long End Type Const hostent_size = 16 Const IPPROTO_TCP = 6 Const IPPROTO_UDP = 17 Const INADDR_NONE = &HFFFFFFFF Const INADDR_ANY = &H0 Type sockaddr sin_family As Integer sin_port As Integer sin_addr As Long sin_zero As String * 8 End Type Const sockaddr_size = 16 Type sock_addr sa_family As Integer sa_port As Integer sa_addr as long sa_zero as string End Type Const WSA_DESCRIPTIONLEN = 256 Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1 Const WSA_SYS_STATUS_LEN = 128 Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1 Type 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 Long End Type Const INVALID_SOCKET = -1 Const SOCKET_ERROR = -1 Const SOCK_STREAM = 1 Const SOCK_DGRAM = 2 Const MAXGETHOSTSTRUCT = 1024 Const AF_INET = 2 Const PF_INET = 2 Type LingerType l_onoff As Integer l_linger As Integer End Type '---Windows Sockets definitions of regular Microsoft C error constants Const WSAEINTR = 10004 Const WSAEBADF = 10009 Const WSAEACCES = 10013 Const WSAEFAULT = 10014 Const WSAEINVAL = 10022 Const WSAEMFILE = 10024 '---Windows Sockets definitions of regular Berkeley error constants Const WSAEWOULDBLOCK = 10035 Const WSAEINPROGRESS = 10036 Const WSAEALREADY = 10037 Const WSAENOTSOCK = 10038 Const WSAEDESTADDRREQ = 10039 Const WSAEMSGSIZE = 10040 Const WSAEPROTOTYPE = 10041 Const WSAENOPROTOOPT = 10042 Const WSAEPROTONOSUPPORT = 10043 Const WSAESOCKTNOSUPPORT = 10044 Const WSAEOPNOTSUPP = 10045 Const WSAEPFNOSUPPORT = 10046 Const WSAEAFNOSUPPORT = 10047 Const WSAEADDRINUSE = 10048 Const WSAEADDRNOTAVAIL = 10049 Const WSAENETDOWN = 10050 Const WSAENETUNREACH = 10051 Const WSAENETRESET = 10052 Const WSAECONNABORTED = 10053 Const WSAECONNRESET = 10054 Const WSAENOBUFS = 10055 Const WSAEISCONN = 10056 Const WSAENOTCONN = 10057 Const WSAESHUTDOWN = 10058 Const WSAETOOMANYREFS = 10059 Const WSAETIMEDOUT = 10060 Const WSAECONNREFUSED = 10061 Const WSAELOOP = 10062 Const WSAENAMETOOLONG = 10063 Const WSAEHOSTDOWN = 10064 Const WSAEHOSTUNREACH = 10065 Const WSAENOTEMPTY = 10066 Const WSAEPROCLIM = 10067 Const WSAEUSERS = 10068 Const WSAEDQUOT = 10069 Const WSAESTALE = 10070 Const WSAEREMOTE = 10071 '---Extended Windows Sockets error constant definitions Const WSASYSNOTREADY = 10091 Const WSAVERNOTSUPPORTED = 10092 Const WSANOTINITIALISED = 10093 Const WSAHOST_NOT_FOUND = 11001 Const WSATRY_AGAIN = 11002 Const WSANO_RECOVERY = 11003 Const WSANO_DATA = 11004 Const WSANO_ADDRESS = 11004 '---ioctl Constants Const FIONREAD = &H8004667F Const FIONBIO = &H8004667E Const FIOASYNC = &H8004667D '---Windows System Functions Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Byval Src As long, Byval cb&) Declare Sub MemCopyStr Lib "kernel32" Alias "RtlMoveMemory" (Byval Dest As string, Byval Src As long, Byval cb&) Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As long) As Long '---async notification constants Const SOL_SOCKET = &HFFFF& Const SO_LINGER = &H80& Const FD_READ = &H1& Const FD_WRITE = &H2& Const FD_OOB = &H4& Const FD_ACCEPT = &H8& Const FD_CONNECT = &H10& Const FD_CLOSE = &H20& '---SOCKET FUNCTIONS Declare Function accept Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, addrlen As Long) As Long Declare Function bindls Lib "wsock32.dll" Alias "bind" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long Declare Function connect Lib "wsock32.dll" (ByVal s As Long, addr As sock_addr, ByVal namelen As Long) As Long Declare Function ioctlsocket Lib "wsock32.dll" (ByVal s As Long, ByVal cmd As Long, argp As Long) As Long Declare Function getpeername Lib "wsock32.dll" (ByVal s As Long, sName As sockaddr, namelen As Long) As Long Declare Function getsockname Lib "wsock32.dll" (ByVal s As Long, sName As sockaddr, namelen As Long) As Long Declare Function getsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As String, optlen As Long) As Long Declare Function htonl Lib "wsock32.dll" (ByVal hostlong As Long) As Long Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long Declare Function listen Lib "wsock32.dll" (ByVal s As Long, ByVal backlog As Long) As Long Declare Function ntohl Lib "wsock32.dll" (ByVal netlong As Long) As Long Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer Declare Function recv Lib "wsock32.dll" (ByVal s As Long, ByVal buf As String, ByVal buflen As Long, ByVal flags As Long) As Long Declare Function recvfrom Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long, fromvb As sockaddr, fromlen As Long) As Long Declare Function ws_select Lib "wsock32.dll" Alias "select" (ByVal nfds As Integer, readfds As fd_set, writefds As fd_set, exceptfds As fd_set, timeout As timeval) As Long Declare Function send Lib "wsock32.dll" (ByVal s As Long, ByVal buf As String, ByVal buflen As Long, ByVal flags As Long) As Long 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 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 Declare Function ShutDown Lib "wsock32.dll" Alias "shutdown" (s As long, how As long) As Long Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long '---DATABASE FUNCTIONS Declare Function gethostbyaddr Lib "wsock32.dll" (addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long Declare Function gethostname Lib "wsock32.dll" (ByVal host_name As String, ByVal namelen As Long) As Long Declare Function getservbyport Lib "wsock32.dll" (ByVal Port As Long, ByVal proto As String) As Long Declare Function getservbyname Lib "wsock32.dll" (ByVal serv_name As String, ByVal proto As String) As Long Declare Function getprotobynumber Lib "wsock32.dll" (ByVal proto As Long) As Long Declare Function getprotobyname Lib "wsock32.dll" (ByVal proto_name As String) As Long '---WINDOWS EXTENSIONS Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long Declare Function WSACleanup Lib "wsock32.dll" () As Long Declare Sub WSASetLastError Lib "wsock32.dll" (ByVal iError As Long) Declare Function WSAGetLastError Lib "wsock32.dll" () As Long Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long Declare Function WSAUnhookBlockingHook Lib "wsock32.dll" () As Long Declare Function WSASetBlockingHook Lib "wsock32.dll" (ByVal lpBlockFunc As Long) As Long Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long 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 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 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 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 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 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 Declare Function WSACancelAsyncRequest Lib "wsock32.dll" (ByVal hAsyncTaskHandle As Long) As Long Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long Declare Function WSARecvEx Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long '-------- Functions and dims dim wsadata as wsadatatype Dim heDestHost As HostEnt Dim WSAErr as long 'Return IP address as a long, in network byte order Function GetHostIPAddr(HostName As String) As Long Dim phe As Long, addrList As Long, retIP As Long retIP = inet_addr(HostName) If retIP = INADDR_NONE Then phe = gethostbyname(HostName) If phe <> 0 Then MemCopy heDestHost, Byval phe, Byval 16 MemCopy addrList, Byval heDestHost.h_addr_list, Byval 4 MemCopy retIP, Byval addrList, Byval heDestHost.h_length Else retIP = INADDR_NONE End If End If GetHostIPAddr = retIP End Function Function LongToIP(IP as long) As String Dim pointer As Long Dim IPLen As long Dim IPStr As String * 64 pointer = inet_ntoa(byval IP) IPLen = LStrLen(byval pointer) If IPLen <= 64 then MemCopyStr IPStr, byval pointer, byval IPLen LongToIP = Mid(IPStr,1,Instr(IPStr,Chr(0))-1) End Function Function openConnection(NameOrIp As String, port As Integer) As Long Dim ret As Long Dim sock As Long Dim SocketBuffer As sock_addr Dim haddr As Long ret = WSAStartup(&H101, wsadata) Select Case ret ' specific error returns not used Case 0 Case 10092 openConnection = SOCKET_ERROR WSACleanup Exit Function Case Else openConnection = SOCKET_ERROR WSACleanup Exit Function End Select haddr = GetHostIPAddr(NameOrIP) If haddr = INADDR_NONE Then openConnection = SOCKET_ERROR WSACleanup Exit Function End If sock = socket(AF_INET, SOCK_STREAM, 0) If sock = SOCKET_ERROR Then openConnection = SOCKET_ERROR WSACleanup Exit Function End If SocketBuffer.sa_family = AF_INET SocketBuffer.sa_port = htons(port) SocketBuffer.sa_addr = haddr SocketBuffer.sa_zero = String$(8, 0) If connect(sock, SocketBuffer, 16) = SOCKET_ERROR Then WsaErr = WSAGetLastError() openConnection = SOCKET_ERROR Else openConnection = sock End If End Function Sub closeConnection(sock As Long) Dim recvBuf As String Dim ret As Long recvBuf = String(512, " ") ret = 1 If shutdown(Byval sock, Byval 1) = SOCKET_ERROR Then WsaErr = wsagetlasterror() End If Do While ret > 0 ret = recv(sock, recvBuf, Len(recvBuf), Byval 0) Loop If closesocket(Byval sock) = SOCKET_ERROR Then WSAErr = wsagetlasterror() End If WSACleanup End Sub Function receiveData(sock As Long, buf As String) As Integer Dim buflen As Long Dim RC As Long buflen = Len(buf) RC = recv(Byval sock, Byval buf, Byval buflen, Byval 0) receiveData = RC End Function Function sendData(sock As Long, buf As String) As Integer Dim buflen As Long Dim RC As Long buf = Strconv(buf, 8) buflen = Len(buf) RC = send(Byval sock, Byval buf, Byval buflen, Byval 0) sendData = RC End Function Function isSockReady(sock As Long) As Long Dim rfds As fd_set, wfds As fd_set, efds As fd_set Dim tv As timeval Dim ret As Long ' Dim werr As Long Dim cnt As Integer rfds.fd_count = 1 rfds.fd_array(0) = sock tv.tv_sec = 40 ret = ws_select(Byval 0, rfds, wfds, efds, tv) If ret = SOCKET_ERROR Then WsaErr = WSAGetLastError() isSockReady = 0 Else isSockReady = ret End If End Function