msocketsupport.bas

简单、实用、特别。 有很多不足之处

Attribute VB_Name = "MSocketSupport"


Option Explicit
'
Public Const INADDR_NONE = &HFFFF
'
Public Const SOCKET_ERROR = -1
Public Const INVALID_SOCKET = -1
Public Const INADDR_ANY = &H0
'
Public Const FD_SETSIZE = 64
'
'/*
' * Define constant based on rfc883, used by gethostbyxxxx() calls.
' */
Public Const MAXGETHOSTSTRUCT = 1024
'
'/*
' * WinSock 2 extension -- manifest constants for shutdown()
' */
Public Const SD_RECEIVE = &H0
Public Const SD_SEND = &H1
Public Const SD_BOTH = &H2
'
Public Const MSG_OOB = &H1         '/* process out-of-band data */
Public Const MSG_PEEK = &H2        '/* peek at incoming message */
Public Const MSG_DONTROUTE = &H4   '/* send without using routing tables */
Public Const MSG_PARTIAL = &H8000  '/* partial send or recv for message xport */
'
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&
'
Public Const SOL_SOCKET = 65535
'
' option flags per socket
Public Const SO_DEBUG = &H0&         ' Turn on debugging info recording
Public Const SO_ACCEPTCONN = &H2&    ' Socket has had listen() - READ-ONLY.
Public Const SO_REUSEADDR = &H4&     ' Allow local address reuse.
Public Const SO_KEEPALIVE = &H8&     ' Keep connections alive.
Public Const SO_DONTROUTE = &H10&    ' Just use interface addresses.
Public Const SO_BROADCAST = &H20&    ' Permit sending of broadcast msgs.
Public Const SO_USELOOPBACK = &H40&  ' Bypass hardware when possible.
Public Const SO_LINGER = &H80&       ' Linger on close if data present.
Public Const SO_OOBINLINE = &H100&   ' Leave received OOB data in line.

Public Const SO_DONTLINGER = Not SO_LINGER
Public Const SO_EXCLUSIVEADDRUSE = Not SO_REUSEADDR ' Disallow local address reuse.

' Additional options.
Public Const SO_SNDBUF = &H1001&     ' Send buffer size.
Public Const SO_RCVBUF = &H1002&     ' Receive buffer size.
Public Const SO_ERROR = &H1007&      ' Get error status and clear.
Public Const SO_TYPE = &H1008&       ' Get socket type - READ-ONLY.
'
Public Const WSADESCRIPTION_LEN = 257
Public Const WSASYS_STATUS_LEN = 129
'
Public Type WSADATA
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * WSADESCRIPTION_LEN
    szSystemStatus As String * WSASYS_STATUS_LEN
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type
'
Public Type sockaddr_in
    sin_family       As Integer
    sin_port         As Integer
    sin_addr         As Long
    sin_zero(1 To 8) As Byte
End Type

Public Type fd_set
  fd_count                  As Long '// how many are SET?
  fd_array(1 To FD_SETSIZE) As Long '// an array of SOCKETs
End Type
'
'/*
' * All Windows Sockets error constants are biased by WSABASEERR from
' * the "normal"
' */
Public Const WSABASEERR = 10000
'/*
' * Windows Sockets definitions of regular Microsoft C error constants
' */
Public Const WSAEINTR = (WSABASEERR + 4)
Public Const WSAEBADF = (WSABASEERR + 9)
Public Const WSAEACCES = (WSABASEERR + 13)
Public Const WSAEFAULT = (WSABASEERR + 14)
Public Const WSAEINVAL = (WSABASEERR + 22)
Public Const WSAEMFILE = (WSABASEERR + 24)

'/*
' * Windows Sockets definitions of regular Berkeley error constants
' */
Public Const WSAEWOULDBLOCK = (WSABASEERR + 35)
Public Const WSAEINPROGRESS = (WSABASEERR + 36)
Public Const WSAEALREADY = (WSABASEERR + 37)
Public Const WSAENOTSOCK = (WSABASEERR + 38)
Public Const WSAEDESTADDRREQ = (WSABASEERR + 39)
Public Const WSAEMSGSIZE = (WSABASEERR + 40)
Public Const WSAEPROTOTYPE = (WSABASEERR + 41)
Public Const WSAENOPROTOOPT = (WSABASEERR + 42)
Public Const WSAEPROTONOSUPPORT = (WSABASEERR + 43)
Public Const WSAESOCKTNOSUPPORT = (WSABASEERR + 44)
Public Const WSAEOPNOTSUPP = (WSABASEERR + 45)
Public Const WSAEPFNOSUPPORT = (WSABASEERR + 46)
Public Const WSAEAFNOSUPPORT = (WSABASEERR + 47)
Public Const WSAEADDRINUSE = (WSABASEERR + 48)
Public Const WSAEADDRNOTAVAIL = (WSABASEERR + 49)
Public Const WSAENETDOWN = (WSABASEERR + 50)
Public Const WSAENETUNREACH = (WSABASEERR + 51)
Public Const WSAENETRESET = (WSABASEERR + 52)
Public Const WSAECONNABORTED = (WSABASEERR + 53)
Public Const WSAECONNRESET = (WSABASEERR + 54)
Public Const WSAENOBUFS = (WSABASEERR + 55)
Public Const WSAEISCONN = (WSABASEERR + 56)
Public Const WSAENOTCONN = (WSABASEERR + 57)
Public Const WSAESHUTDOWN = (WSABASEERR + 58)
Public Const WSAETOOMANYREFS = (WSABASEERR + 59)
Public Const WSAETIMEDOUT = (WSABASEERR + 60)
Public Const WSAECONNREFUSED = (WSABASEERR + 61)
Public Const WSAELOOP = (WSABASEERR + 62)
Public Const WSAENAMETOOLONG = (WSABASEERR + 63)
Public Const WSAEHOSTDOWN = (WSABASEERR + 64)
Public Const WSAEHOSTUNREACH = (WSABASEERR + 65)
Public Const WSAENOTEMPTY = (WSABASEERR + 66)
Public Const WSAEPROCLIM = (WSABASEERR + 67)
Public Const WSAEUSERS = (WSABASEERR + 68)
Public Const WSAEDQUOT = (WSABASEERR + 69)
Public Const WSAESTALE = (WSABASEERR + 70)
Public Const WSAEREMOTE = (WSABASEERR + 71)

'/*
' * Extended Windows Sockets error constant definitions
' */
Public Const WSASYSNOTREADY = (WSABASEERR + 91)
Public Const WSAVERNOTSUPPORTED = (WSABASEERR + 92)
Public Const WSANOTINITIALISED = (WSABASEERR + 93)
Public Const WSAEDISCON = (WSABASEERR + 101)
Public Const WSAENOMORE = (WSABASEERR + 102)
Public Const WSAECANCELLED = (WSABASEERR + 103)
Public Const WSAEINVALIDPROCTABLE = (WSABASEERR + 104)
Public Const WSAEINVALIDPROVIDER = (WSABASEERR + 105)
Public Const WSAEPROVIDERFAILEDINIT = (WSABASEERR + 106)
Public Const WSASYSCALLFAILURE = (WSABASEERR + 107)
Public Const WSASERVICE_NOT_FOUND = (WSABASEERR + 108)
Public Const WSATYPE_NOT_FOUND = (WSABASEERR + 109)
Public Const WSA_E_NO_MORE = (WSABASEERR + 110)
Public Const WSA_E_CANCELLED = (WSABASEERR + 111)
Public Const WSAEREFUSED = (WSABASEERR + 112)
'
'/* Authoritative Answer: Host not found */
Public Const WSAHOST_NOT_FOUND = (WSABASEERR + 1001)
'/* Non-Authoritative: Host not found, or SERVERFAIL */
Public Const WSATRY_AGAIN = (WSABASEERR + 1002)
'/* Non recoverable errors, FORMERR, REFUSED, NOTIMP */
Public Const WSANO_RECOVERY = (WSABASEERR + 1003)
'/* Valid name, no data record of requested type */
Public Const WSANO_DATA = (WSABASEERR + 1004)
'
'
'Socket types
'
Public Enum SocketType
    SOCK_STREAM = 1    ' /* stream socket */
    SOCK_DGRAM = 2     ' /* datagram socket */
    SOCK_RAW = 3       ' /* raw-protocol interface */
    SOCK_RDM = 4       ' /* reliably-delivered message */
    SOCK_SEQPACKET = 5 ' /* sequenced packet stream */
End Enum
'
Public Enum AddressFamily
    '
    AF_UNSPEC = 0      '/* unspecified */
'/*
' * Although  AF_UNSPEC  is  defined for backwards compatibility, using
' * AF_UNSPEC for the "af" parameter when creating a socket is STRONGLY
' * DISCOURAGED.    The  interpretation  of  the  "protocol"  parameter
' * depends  on the actual address family chosen.  As environments grow
' * to  include  more  and  more  address families that use overlapping
' * protocol  values  there  is  more  and  more  chance of choosing an
' * undesired address family when AF_UNSPEC is used.
' */
    AF_UNIX = 1        '/* local to host (pipes, portals) */
    AF_INET = 2        '/* internetwork: UDP, TCP, etc. */
    AF_IMPLINK = 3     '/* arpanet imp addresses */
    AF_PUP = 4         '/* pup protocols: e.g. BSP */
    AF_CHAOS = 5       '/* mit CHAOS protocols */
    AF_NS = 6          '/* XEROX NS protocols */
    AF_IPX = AF_NS     '/* IPX protocols: IPX, SPX, etc. */
    AF_ISO = 7         '/* ISO protocols */
    AF_OSI = AF_ISO    '/* OSI is ISO */
    AF_ECMA = 8        '/* european computer manufacturers */
    AF_DATAKIT = 9     '/* datakit protocols */
    AF_CCITT = 10      '/* CCITT protocols, X.25 etc */
    AF_SNA = 11        '/* IBM SNA */
    AF_DECnet = 12     '/* DECnet */
    AF_DLI = 13        '/* Direct data link interface */
    AF_LAT = 14        '/* LAT */
    AF_HYLINK = 15     '/* NSC Hyperchannel */
    AF_APPLETALK = 16  '/* AppleTalk */
    AF_NETBIOS = 17    '/* NetBios-style addresses */
    AF_VOICEVIEW = 18  '/* VoiceView */
    AF_FIREFOX = 19    '/* Protocols from Firefox */
    AF_UNKNOWN1 = 20   '/* Somebody is using this! */
    AF_BAN = 21        '/* Banyan */
    AF_ATM = 22        '/* Native ATM Services */
    AF_INET6 = 23      '/* Internetwork Version 6 */
    AF_CLUSTER = 24    '/* Microsoft Wolfpack */
    AF_12844 = 25      '/* IEEE 1284.4 WG AF */
    AF_MAX = 26
    '
End Enum
'
'/*
' * Protocols
' */
Public Enum SocketProtocol
    IPPROTO_IP = 0             '/* dummy for IP */
    IPPROTO_ICMP = 1           '/* control message protocol */
    IPPROTO_IGMP = 2           '/* internet group management protocol */
    IPPROTO_GGP = 3            '/* gateway^2 (deprecated) */
    IPPROTO_TCP = 6            '/* tcp */
    IPPROTO_PUP = 12           '/* pup */
    IPPROTO_UDP = 17           '/* user datagram protocol */
    IPPROTO_IDP = 22           '/* xns idp */
    IPPROTO_ND = 77            '/* UNOFFICIAL net disk proto */
    IPPROTO_RAW = 255          '/* raw IP packet */
    IPPROTO_MAX = 256
End Enum
'
Public Type HostEnt
    hName     As Long
    hAliases  As Long
    hAddrType As Integer
    hLength   As Integer
    hAddrList As Long
End Type
'
Public Declare Function gethostbyaddr Lib "ws2_32.dll" (addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long
Public Declare Function gethostbyname Lib "ws2_32.dll" (ByVal host_name As String) As Long
Public Declare Function gethostname Lib "ws2_32.dll" (ByVal host_name As String, ByVal namelen As Long) As Long
Public Declare Function getservbyname Lib "ws2_32.dll" (ByVal serv_name As String, ByVal proto As String) As Long
Public Declare Function getprotobynumber Lib "ws2_32.dll" (ByVal proto As Long) As Long
Public Declare Function getprotobyname Lib "ws2_32.dll" (ByVal proto_name As String) As Long
Public Declare Function getservbyport Lib "ws2_32.dll" (ByVal Port As Integer, ByVal proto As Long) As Long
Public Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
Public Declare Function inet_ntoa Lib "ws2_32.dll" (ByVal inn As Long) As Long
Public Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer
Public Declare Function htonl Lib "ws2_32.dll" (ByVal hostlong As Long) As Long
Public Declare Function ntohl Lib "ws2_32.dll" (ByVal netlong As Long) As Long
Public Declare Function ntohs Lib "ws2_32.dll" (ByVal netshort As Integer) As Integer
Public Declare Function api_socket Lib "ws2_32.dll" Alias "socket" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
Public Declare Function api_closesocket Lib "ws2_32.dll" Alias "closesocket" (ByVal s As Long) As Long
Public Declare Function api_connect Lib "ws2_32.dll" Alias "connect" (ByVal s As Long, ByRef Name As sockaddr_in, ByVal namelen As Long) As Long
Public Declare Function getsockname Lib "ws2_32.dll" (ByVal s As Long, ByRef Name As sockaddr_in, ByRef namelen As Long) As Long
Public Declare Function getpeername Lib "ws2_32.dll" (ByVal s As Long, ByRef Name As sockaddr_in, ByRef namelen As Long) As Long
Public Declare Function api_bind Lib "ws2_32.dll" Alias "bind" (ByVal s As Long, ByRef Name As sockaddr_in, ByRef namelen As Long) As Long
Public Declare Function api_select Lib "ws2_32.dll" Alias "select" (ByVal nfds As Long, ByRef readfds As Any, ByRef writefds As Any, ByRef exceptfds As Any, ByRef Timeout As Long) As Long
Public Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, ByRef buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function send Lib "ws2_32.dll" (ByVal s As Long, ByRef buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function shutdown Lib "ws2_32.dll" (ByVal s As Long, ByVal how As Long) As Long
Public Declare Function api_listen Lib "ws2_32.dll" Alias "listen" (ByVal s As Long, ByVal backlog As Long) As Long
Public Declare Function api_accept Lib "ws2_32.dll" Alias "accept" (ByVal s As Long, ByRef addr As sockaddr_in, ByRef addrlen As Long) As Long
Public Declare Function setsockopt Lib "ws2_32.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 getsockopt Lib "ws2_32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Any, optlen As Long) As Long
Public Declare Function sendto Lib "ws2_32.dll" (ByVal s As Long, ByRef buf As Any, ByVal buflen As Long, ByVal flags As Long, ByRef toaddr As sockaddr_in, ByVal tolen As Long) As Long
Public Declare Function recvfrom Lib "ws2_32.dll" (ByVal s As Long, ByRef buf As Any, ByVal buflen As Long, ByVal flags As Long, ByRef from As sockaddr_in, ByRef fromlen As Long) As Long

Public Declare Function WSAAsyncSelect Lib "ws2_32.dll" (ByVal s As Long, ByVal hwnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long
Public Declare Function WSAAsyncGetHostByAddr Lib "ws2_32.dll" (ByVal hwnd As Long, ByVal wMsg As Long, ByRef lngAddr As Long, ByVal lngLenght As Long, ByVal lngType As Long, buf As Any, ByVal lngBufLen As Long) As Long
Public Declare Function WSAAsyncGetHostByName Lib "ws2_32.dll" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal strHostName As String, buf As Any, ByVal buflen As Long) As Long
Public Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVR As Long, lpWSAD As WSADATA) As Long
Public Declare Function WSACleanup Lib "ws2_32.dll" () As Long
'
Private Const GWL_WNDPROC = -4
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
'Added: 04-MAR-2002
Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
'
Public Const GMEM_FIXED = &H0
Public Const GMEM_MOVEABLE = &H2
'
Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
'
Private m_lngWindowHandle   As Long
Private m_colSockets        As Collection
Private m_colResolvers      As Collection
Private m_colMemoryBlocks   As Collection
Private m_lngPreviousValue  As Long

Private m_blnGetHostRecv    As Boolean
Private m_blnWinsockInit    As Boolean
Private m_lngMaxMsgSize     As Long

Private Const WM_USER = &H400
'
'Private Const RESOLVE_MESSAGE = WM_USER + 1
'Private Const SOCKET_MESSAGE = WM_USER + 2
'
Private m_lngResolveMessage As Long 'Added: 04-MAR-2002
Private m_lngWinsockMessage As Long 'Added: 04-MAR-2002
'
Private Const OFFSET_4 = 4294967296#
Private Const MAXINT_4 = 2147483647
Private Const OFFSET_2 = 65536
Private Const MAXINT_2 = 32767



Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    '
    'This the callback function of the window created to hook
    'messages sent by the Winsock service. It handles only two
    'types of messages - network events for the sockets the
    'WSAAsyncSelect fucntion was called for, and the messages
    'sent in response to the WSAAsyncGetHostByName and
    'WSAAsyncGetHostByAddress Winsock API functions.
    '
    'Then the message is received, this function creates illegal
    'reference to the instance of the CSocket class and calls