winsock.bas

《Windows网络编程技术》随书源码.rar

Global Const NS_SAP = 1
Global Const NS_NDS = 2
Global Const NS_PEER_BROWSE = 3

Global Const NS_TCPIP_LOCAL = 10
Global Const NS_TCPIP_HOSTS = 11
Global Const NS_DNS = 12
Global Const NS_NETBT = 13
Global Const NS_WINS = 14

Global Const NS_NBP = 20

Global Const NS_MS = 30
Global Const NS_STDA = 31
Global Const NS_NTDS = 32

Global Const NS_X500 = 40
Global Const NS_NIS = 41
Global Const NS_NISPLUS = 42

Global Const NS_WRQ = 50

Type WSANAMESPACE_INFO
    NSProviderId As GUID
    dwNameSpace As Long
    fActive As Long
    dwVersion As Long
    lpszIdentifier As Long
End Type

Type sockaddr
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type
Global Const sockaddr_size = 16

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
Global Const hostent_size = 16

Global Const WSA_DESCRIPTIONLEN = 256
Global Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1
Global Const WSA_SYS_STATUS_LEN = 128
Global 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

Type LingerType
    l_onoff As Integer
    l_linger As Integer
End Type


Global Const FD_READ_BIT = 0
Global Const FD_READ = 1         ''(1 << FD_READ_BIT)

Global Const FD_WRITE_BIT = 1
Global Const FD_WRITE = &H2        ''(1 << FD_WRITE_BIT)

Global Const FD_OOB_BIT = 2
Global Const FD_OOB = &H4          '(1 << FD_OOB_BIT)

Global Const FD_ACCEPT_BIT = 3
Global Const FD_ACCEPT = &H8       '(1 << FD_ACCEPT_BIT)

Global Const FD_CONNECT_BIT = 4
Global Const FD_CONNECT = &H10      '(1 << FD_CONNECT_BIT)

Global Const FD_CLOSE_BIT = 5
Global Const FD_CLOSE = &H20       '(1 << FD_CLOSE_BIT)

Global Const FD_QOS_BIT = 6
Global Const FD_QOS = &H40          '(1 << FD_QOS_BIT)

Global Const FD_GROUP_QOS_BIT = 7
Global Const FD_GROUP_QOS = &H80   '(1 << FD_GROUP_QOS_BIT)

Global Const FD_ROUTING_INTERFACE_CHANGE_BIT = 8
Global Const FD_ROUTING_INTERFACE_CHANGE = &H100     '(1 << FD_ROUTING_INTERFACE_CHANGE_BIT)

Global Const FD_ADDRESS_LIST_CHANGE_BIT = 9
Global Const FD_ADDRESS_LIST_CHANGE = &H200   '(1 << FD_ADDRESS_LIST_CHANGE_BIT)

Global Const FD_MAX_EVENTS = 10
Global Const FD_ALL_EVENTS = &H3FF     '(1 << FD_MAX_EVENTS) - 1)


Type WSANETWORKEVENTS
    lNetWorkEvents As Long
    iErrorCode(FD_MAX_EVENTS - 1) As Long
End Type

Global Const WSA_WAIT_FAILED = &HFFFFFFFF
Global Const WSA_WAIT_EVENT_0 = 0
Global Const WSA_WAIT_TIMEOUT = &H102

Public Const GMEM_FIXED = &H0
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 Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (dest As Any, src As Any, ByVal cb As Long)
Public Declare Sub CopyMemory2 Lib "Kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal src As Long, ByVal cb As Long)
Public Declare Sub CopyMemory3 Lib "Kernel32" Alias "RtlMoveMemory" (dest As Long, ByVal src As Long, ByVal cb As Long)
Public Declare Sub ZeroMemory Lib "Kernel32" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As Long)
Public Declare Function StringFromGUID2 Lib "ole32.dll" (pGUID As GUID, ByVal _
PointerToString As String, ByVal MaxLength As Long) As Long
Public Declare Function lstrcpy Lib "Kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, lpString2 As Byte) As Long
Public Declare Function lstrlen Lib "Kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Public Declare Function lstrcpy1 Lib "Kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Public Declare Function GetCurrentProcessId Lib "Kernel32" () As Long
Public Declare Function GetTickCount Lib "Kernel32" () As Long
Public Declare Function Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long) As Long

Declare Function getsockname Lib "ws2_32.DLL" (ByVal s As Long, sname As sockaddr, namelen As Long) As Long
Declare Function WSAStartup Lib "ws2_32.DLL" (ByVal wVR As Long, lpWSAD As WSADataType) As Long
Declare Function WSACleanup Lib "ws2_32.DLL" () As Long
Declare Function bind Lib "ws2_32.DLL" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
Declare Function accept Lib "ws2_32.DLL" (ByVal s As Long, addr As sockaddr, namelen As Long) As Long
Declare Function socket Lib "ws2_32.DLL" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
Declare Function WSASocket Lib "ws2_32.DLL" Alias "WSASocketA" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long, lpProtocolInfo As Any, ByVal g As Long, ByVal dwFlags As Long) As Long
Declare Function closesocket Lib "ws2_32.DLL" (ByVal s As Long) As Long
Declare Function connect Lib "ws2_32.DLL" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
Declare Function gethostbyname Lib "ws2_32.DLL" (ByVal host_name As String) As Long
Declare Function gethostbyaddr Lib "ws2_32.DLL" (addr As Any, ByVal nlen As Long, ByVal ntype As Long) As Long
Declare Function gethostname Lib "ws2_32.DLL" (ByVal host_name As String, ByVal namelen As Long) As Long
Declare Function recv Lib "ws2_32.DLL" (ByVal s As Long, Buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Declare Function recvfrom Lib "ws2_32.DLL" (ByVal s As Long, Buf As Any, ByVal buflen As Long, ByVal flags As Long, from As sockaddr, fromlen As Long) As Long
Declare Function send Lib "ws2_32.DLL" (ByVal s As Long, Buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Declare Function sendto Lib "ws2_32.DLL" (ByVal s As Long, Buf As Any, ByVal buflen As Long, ByVal flags As Long, to_addr As Any, ByVal tolen As Long) As Long
Declare Function htonl Lib "ws2_32.DLL" (ByVal hostlong As Long) As Long
Declare Function htons Lib "ws2_32.DLL" (ByVal hostshort As Long) As Integer
Declare Function ntohs Lib "ws2_32.DLL" (ByVal netshort As Long) As Integer
Declare Function ntohl Lib "ws2_32.DLL" (ByVal netlong As Long) As Long
Declare Function inet_addr Lib "ws2_32.DLL" (ByVal cp As String) As Long
Declare Function inet_ntoa Lib "ws2_32.DLL" (ByVal in_n As Long) As Long
Declare Function setsockopt Lib "ws2_32.DLL" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Long, ByVal optlen As Long) As Long
Declare Function setsockopt2 Lib "ws2_32.DLL" Alias "setsockopt" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Any, ByVal optlen As Long) As Long
Declare Function getsockopt Lib "ws2_32.DLL" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Long, optlen As Long) As Long
Declare Function getsockopt2 Lib "ws2_32.DLL" Alias "getsockopt" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Any, optlen As Long) As Long
Declare Function listen Lib "ws2_32.DLL" (ByVal s As Long, ByVal backlog As Long) As Long
Declare Function WSAIoctl Lib "ws2_32.DLL" (ByVal s As Long, ByVal dwIoControlCode As Long, lpvInBuffer As Any, ByVal cbInBuffer As Long, _
     lpvOutBuffer As Any, ByVal cbOutBuffer As Long, lpcbBytesReturned As Long, lpOverlapped As Any, lpCompletionRoutine As Any) As Long
Declare Function WSAEnumProtocols Lib "ws2_32.DLL" Alias "WSAEnumProtocolsA" (ByVal lpiProtocols As Long, ByVal lpProtocolBuffer As Long, lpdwBufferLength As Long) As Long
'in VB, application should use Err.LastDllError to get last error of any API call
'Declare Function WSAGetLastError Lib "ws2_32.DLL" () As Long
Declare Function WSACreateEvent Lib "ws2_32.DLL" () As Long
Declare Function WSACloseEvent Lib "ws2_32.DLL" (ByVal hEvent As Long) As Boolean
Declare Function WSAEventSelect Lib "ws2_32.DLL" (ByVal s As Long, ByVal hEventOjbect As Long, ByVal lNetWorkEvents As Long) As Long
Declare Function WSAEnumNetworkEvents Lib "ws2_32.DLL" (ByVal s As Long, ByVal hEventOjbect As Long, lpNetWorkEvents As WSANETWORKEVENTS) As Long
Declare Function WSAWaitForMultipleEvents Lib "ws2_32.DLL" (ByVal cEvents As Long, _
    lphEvents As Long, ByVal fWaitAll As Boolean, _
    ByVal dwTimeOUT As Long, ByVal fAlertable As Boolean) As Long
Declare Function WSAResetEvent Lib "ws2_32.DLL" (ByVal hEvent As Long) As Boolean

Declare Function WSAEnumNameSpaceProviders Lib "ws2_32.DLL" Alias "WSAEnumNameSpaceProvidersA" (lpdwBufferLength As Long, ByVal lpnspBuffer As Long) As Boolean

Public Const ICMP_ECHO = 8
Public Const ICMP_ECHOREPLY = 0
Public Const ICMP_MIN = 8  'minimum 8 byte icmp packet (header)
Public Const IP_RECORD_ROUTE = 7

' The IP header
Type IpHeader
   h_len As Byte              ' length of the header and  Version of IP
   tos As Byte                ' Type of service
   total_len As Integer       ' total length of the packet
   ident As Integer           ' unique identifier
   frag_and_flags As Integer  ' flags
   ttl As Byte
   proto As Byte              ' protocol (TCP, UDP etc)
   CheckSum As Integer        ' IP checksum
   sourceIP As Long
   destIP As Long
End Type

' ICMP header
Type IcmpHeader
  i_type As Byte
  i_code As Byte
  i_cksum As Integer
  i_id As Integer
  i_seq As Integer
  timestamp As Long   '/* This is not the std header, but we reserve space for time */
End Type

' IP option header - user with socket option IP_OPTIONS
Type IpOptionHeader
    code As Byte        'option type
    len As Byte         'length of option hdr
    ptr As Byte         'offset into options
    addr(8) As Long     'list of IP addrs
End Type

Function GetHostByNameAlias(ByVal hostname As String) As Long
    On Error Resume Next
    'Return IP address as a long, in network byte order

    Dim phe As Long    ' pointer to host information entry
    Dim heDestHost As HostEnt 'hostent structure
    Dim addrList As Long
    Dim retIP As Long
    'first check to see if what we have been passed is a valid IP
    retIP = inet_addr(hostname)
    If retIP = INADDR_NONE Then
        'it wasn't an IP, so do a DNS lookup
        phe = gethostbyname(hostname)
        If phe <> 0 Then
            'Pointer is non-null, so copy in hostent structure
            CopyMemory heDestHost, ByVal phe, hostent_size
            'Now get first pointer in address list
            CopyMemory addrList, ByVal heDestHost.h_addr_list, 4
            CopyMemory retIP, ByVal addrList, heDestHost.h_length
        Else
            'its not a valid address
            retIP = INADDR_NONE
        End If
    End If
    GetHostByNameAlias = retIP
    If Err Then GetHostByNameAlias = INADDR_NONE
End Function

Public Function TCPIPStartup() As Boolean
  Dim rc As Integer   'Return code
  Dim wVersionRequested As Long   'Version requested for winsocks
  Dim WSAData As WSADataType          'Detais os winsock implementation
  
  wVersionRequested = &H202
  TCPIPStartup = True
  rc = WSAStartup(wVersionRequested, WSAData)
  If rc <> 0 Then
    MsgBox ("RC: " & rc & " Unable to start winsocks" & ", Error " & Err.LastDllError)
    Call TCPIPShutDown
    TCPIPStartup = False
    Exit Function
  End If

End Function

Public Function TCPIPShutDown() As Boolean
    WSACleanup
End Function