vbwinsock.bas

功能强大的API

Public servent As servent

Type sockaddr
    sa_family As Integer          ' Address family
    sa_data(14) As Byte           ' Data
End Type

Public sockaddr As sockaddr

Type sockaddr_inet
    sin_family As Integer           ' Address family
    sin_port As Integer             ' Port Number in Network Order
    sin_addr As Inet_Address        ' IP Address as Long
    sin_zero(8) As Byte             ' Padding
End Type

Type FD_SET
    fd_count As Integer
    fd_array(FD_SETSIZE) As Integer
End Type

Public FD_SET As FD_SET

Type timeval
    tv_sec As Long
    tv_usec As Long
End Type

Public timeval As timeval

Type sockproto
    sp_family As Integer          ' Address family
    sp_protocol As Integer        ' Protocol Number
End Type

Public sockproto As sockproto

' The following Kernel32 funtions are needed

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long

' The following WSOCK32.DLL functions are needed

Declare Function gethostbyaddr Lib "wsock32.dll" (addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long
Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired As Long, lpWSAData As WSAData) As Long
Declare Function WSACleanUp Lib "wsock32.dll" Alias "WSACleanup" () As Long
Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
Declare Function inet_addr Lib "wsock32.dll" (ByVal addr As String) As Long
Declare Function inet_ntoa Lib "wsock32.dll" (ByVal addr As Long) As Long
Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal HostName As String) As Long
Declare Function GetHostName Lib "wsock32.dll" Alias "gethostname" (ByVal HostName As String, HostLen As Long) As Long
Declare Function getprotobyname Lib "wsock32.dll" (ByVal protoname As String) As Long
Declare Function getprotobynumber Lib "wsock32.dll" (ByVal protonumber As Integer) As Long
Declare Function getservbyport Lib "wsock32.dll" (ByVal Port As Integer, ByVal protoname As Long) As Long
Declare Function getservbyname Lib "wsock32.dll" (ByVal servname As Long, ByVal protoname As Long) As Long
Declare Function WSASetLastError Lib "wsock32.dll" (ByVal iError As Integer) As Integer

Declare Function Accept Lib "wsock32.dll" (ByVal s As Long, ByRef addr As sockaddr, ByRef namelen As Integer) As Long
Declare Function acceptIn Lib "wsock32.dll" (ByVal s As Long, ByRef addr As sockaddr_inet, ByRef namelen As Integer) As Long
Declare Function acceptNull Lib "wsock32.dll" (ByVal s As Long, ByVal sNull As String, ByVal sNull As String) As Long

Declare Function bind Lib "wsock32.dll" (ByVal s As Long, ByRef addr As sockaddr, ByVal namelen As Integer) As Integer
Declare Function bindIn Lib "wsock32.dll" (ByVal s As Long, ByRef addr As sockaddr_inet, ByVal namelen As Integer) As Integer

Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Integer
Declare Function connect Lib "wsock32.dll" (ByVal s As Long, ByRef addr As sockaddr, ByVal namelen As Integer) As Integer
Declare Function connectIn Lib "wsock32.dll" (ByVal s As Long, ByRef addr As sockaddr_inet, ByVal namelen As Integer) As Integer

Declare Function FD_ISSET Lib "wsock32.dll" (ByVal s As Long, ByRef passed_set As FD_SET) As Integer

Declare Function getpeername Lib "wsock32.dll" (ByVal s As Long, ByRef peername As sockaddr, ByRef namelen As Integer) As Integer
Declare Function getpeernameIn Lib "wsock32.dll" (ByVal s As Long, ByRef peername As sockaddr_inet, ByRef namelen As Integer) As Integer
Declare Function getsockname Lib "wsock32.dll" (ByVal s As Long, ByRef sockname As sockaddr, ByRef namelen As Integer) As Integer
Declare Function getsocknameIn Lib "wsock32.dll" (ByVal s As Long, ByRef sockname As sockaddr_inet, ByRef namelen As Integer) As Integer
Declare Function getsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Integer, ByVal optname As Integer, ByRef optval As Long, ByRef optlen As Integer) As Integer

Declare Function htonl Lib "wsock32.dll" (ByVal hostlong As Long) As Long
Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Integer) As Integer

Declare Function ioctlsocket Lib "wsock32.dll" (ByVal s As Long, ByVal cmd As Long, ByRef argp As Long) As Integer

Declare Function listen Lib "wsock32.dll" (ByVal s As Long, ByVal backlog As Integer) As Integer

Declare Function ntohl Lib "wsock32.dll" (ByVal netlong As Long) As Long
Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Integer) As Integer

Declare Function recv Lib "wsock32.dll" (ByVal s As Long, ByVal buf As Long, ByVal buflen As Integer, ByVal Flags As Integer) As Integer
Declare Function recvfrom Lib "wsock32.dll" (ByVal s As Long, ByRef buf As Long, ByVal buflen As Integer, ByVal Flags As Integer, fromaddr As sockaddr, fromlen As Integer) As Integer
Declare Function recvfromIn Lib "wsock32.dll" (ByVal s As Long, ByRef buf As Long, ByVal buflen As Integer, ByVal Flags As Integer, fromaddr As sockaddr_inet, fromlen As Integer) As Integer

Declare Function send Lib "wsock32.dll" (ByVal s As Long, ByRef buf As String, ByVal buflen As Integer, ByVal Flags As Integer) As Integer
Declare Function sendto Lib "wsock32.dll" (ByVal s As Long, ByRef buf As Long, ByVal buflen As Integer, ByVal Flags As Integer, ByRef toaddr As sockaddr, ByRef tolen As Integer) As Integer
Declare Function sendtoIn Lib "wsock32.dll" (ByVal s As Long, ByRef buf As Long, ByVal buflen As Integer, ByVal Flags As Integer, ByRef toaddr As sockaddr_inet, ByRef tolen As Integer) As Integer
Declare Function setsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Integer, ByVal optname As Integer, ByRef optval As Long, ByVal optlen As Integer) As Integer
Declare Function shutdown Lib "wsock32.dll" (ByVal s As Long, ByVal how As Integer) As Integer
Declare Function socket Lib "wsock32.dll" (ByVal af As Integer, ByVal socktype As Integer, ByVal protocol As Integer) As Long

Declare Function WSAAsyncGetHostByAddr Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal addr As String, ByVal addrlen As Integer, ByVal addrtype As Integer, ByRef buf As hostent_async, ByVal buflen As Integer) As Integer
Declare Function WSAAsyncGetHostByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal HostName As String, ByRef buf As hostent_async, ByVal buflen As Integer) As Integer
Declare Function WSAAsyncGetProtoByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal protoname As String, ByRef buf As Long, ByVal buflen As Integer) As Integer
Declare Function WSAAsyncGetProtoByNumber Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal number As Integer, ByRef buf As Long, ByVal buflen As Integer) As Integer
Declare Function WSAAsyncGetServByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal HostName As String, ByVal proto As String, ByRef buf As Long, ByVal buflen As Integer) As Integer
Declare Function WSAAsyncGetServByPort Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal Port As Integer, ByVal proto As String, ByRef buf As Long, ByVal buflen As Integer) As Integer
Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hWnd As Long, ByVal wMsg As Integer, ByVal lEvent As Long) As Integer
Declare Function WSACancelAsyncRequest Lib "wsock32.dll" (ByVal hAsyncTaskHandle As Integer) As Integer
Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Integer
Declare Function WSAIsBlocking Lib "wsock32.dll" () As Integer
Declare Function WSAUnhookBlockingHook Lib "wsock32.dll" () As Integer
Declare Function WSASelect Lib "wsock32.dll" (ByVal nfds As Integer, ByRef readfds As FD_SET, ByRef writefds As FD_SET, ByRef exceptfds As FD_SET, ByVal TimeOut As timeval) As Integer
Declare Function WSASetBlockingHook Lib "wsock32.dll" (lpFunc As Long) As Long

Declare Function x_WSAFDIsSet Lib "wsock32.dll" (ByVal s As Long, ByRef passed_set As FD_SET) As Integer
Function vbGetHostName() As String

    Host = Space(256)      ' Set Host value to a bunch of spaces

    ' This routine is where we get the host's name

    If GetHostName(Host, Len(Host)) = SOCKET_ERROR Then

        ' If WSOCK32 error, then tell me about it

        Debug.Print "Winsock Error detected in vbGetHostName function"
        vbWSAGetLastError

    Else

        ' Trim up the results

        Host = Left$(Trim$(Host), Len(Trim$(Host)) - 1)
        
        ' Return the Host's name

        vbGetHostName = Host

    End If

End Function
Function vbGetHostByName(Host As String) As String

    Dim szString As String
    Dim sMsg As String
    Dim PointerToPointer As Long
    Dim hostent As hostent
    Dim ListAddress As Long
    Dim ListAddr As Long
    Dim Address As Long

    szString = String(64, &H0)

    Host = Host + Right$(szString, 64 - Len(Host))

    ' Modified to prevent a fatal error in some cases on vb5

    PointerToPointer = GetHostByName(Host)

    ' August 25, 1998 (Entry by Jim Huff)
    ' Encountered a problem when trying to resolve a bad
    ' Domain Name.  The PointerToPointer value returned should
    ' be equal SOCKET_ERROR, but the return is a zero (0).  Don't
    ' know why.

    If PointerToPointer = SOCKET_ERROR Then
        Debug.Print "Winsock Error detected in vbGetHostByName function"
        vbWSAGetLastError
    Else
        If PointerToPointer <> 0 Then
            CopyMemory hostent.h_name, ByVal PointerToPointer, Len(hostent)           ' Copy Winsock structure to the VisualBasic structure

            ListAddress = hostent.h_addr_list                                         ' Get the ListAddress of the Address List
            Debug.Print hostent.h_length & Len(hostent.h_addr_list)
            CopyMemory ListAddr, ByVal ListAddress, 4                                 ' Copy Winsock structure to the VisualBasic structure
            Dim barray(128) As Byte
            CopyMemory barray(1), ByVal ListAddr, 32
            Dim i As Integer
            For i = 1 To 128
                Debug.Print barray(i),
            Next i
            CopyMemory Address, ByVal ListAddr, 4                                     ' Get the first list entry from the Address List

            vbGetHostByName = vbInet_Ntoa(Address)
        Else
            vbGetHostByName = "No DNS Entry"
        End If
    End If

End Function
Function vbGetProtoByName(protoname As String) As String

'    Type protoent
'        p_name As Long            ' Official name of the protocol
'        p_aliases As Long         ' A Null-terminated array of alternate names
'        p_proto As Integer        ' The protocol number, in host byte order
'    End Type

    Dim lReturn As Long

    If getprotobyname(protoname) = SOCKET_ERROR Then
        Debug.Print "Winsock Error detected in vbGetProtoByName function"
        vbWSAGetLastError
    Else

        lReturn = getprotobyname(protoname)

        protoname = String(128, 0)

        ' Copy the data from the pointer to the protoent structure

        CopyMemory protoent, ByVal lReturn, Len(protoent)

        CopyMemory ByVal protoname, ByVal protoent.p_name, 128

        ' Trim the data received from the Memory Location and return the trimmed string
        ' back to the Calling Procedure.

        vbGetProtoByName = Left(protoname, InStr(protoname, Chr(0)) - 1)

    End If

End Function
Function vbGetProtoByNumber(protonumber As Integer) As String

'    Type protoent
'        p_name As Long            ' Official name of the protocol
'        p_aliases As Long         ' A Null-terminated array of alternate names
'        p_proto As Integer        ' The protocol number, in host byte order
'    End Type

'     I haven't figured this one out, yet.  If you have a solution to this, please let me
'     know and I will incorporate it into the vbWinSock.BAS file.

'     Thanks

'     Jim Huff


End Function
Function vbInet_Addr(Address As String) As Long

    ' Removed the following 3 lines of code.  They were
    ' not needed.

    ' If inet_addr(Address) = SOCKET_ERROR Then
    '     vbWSAGetLastError
    ' End If

    vbInet_Addr = inet_addr(Address)

End Function
Function vbInet_Ntoa(Address As Long) As String

    ' This is the Jim Huff technique of the inet_ntoa function call.

    ' This function converts the Long value of the IP Address
    ' into Dotted-Decimal Notation.

    ' There are actually many ways to do this.  I will show you the Jim Huff method
    ' and the correct method.  I chose to use the Jim Huff method, but if you want
    ' to do it the correct method, then remark out the next few lines and do it
    ' that way.  You could also do it your way.

    CopyMemory IPLong, Address, 4

    vbInet_Ntoa = CStr(Asc(IPLong.Byte4)) + "." + CStr(Asc(IPLong.Byte3)) + "." + CStr(Asc(IPLong.Byte2)) + "." + CStr(Asc(IPLong.Byte1))

    ' The following was added on November 16, 1997 in order to demonstrate the
    ' actual inet_ntoa function call:

'     The following is the correct method.  You will find that this is more complex,
'     however, it is just as effective.


'    Dim sReturn As String
'    Dim lReturn As Long
'    Dim lLength As Long

'    sReturn = String(32, 0)

'    lReturn = inet_ntoa(Address)

'    If lReturn Then

'        lLength = lstrlen(lReturn)

'        If lLength > 32 Then lLength = 32

'        CopyMemory ByVal sReturn, ByVal lReturn, lLength

'        sReturn = Left(sReturn, lLength)

'        vbInet_Ntoa = sReturn

'    Else

'        vbInet_Ntoa = "Invalid Address"

'    End If

End Function
Function vbWSAAsyncGetHostByName(hWnd As Long, HostName As String) As Integer

    ' Note:  This is an asynchrounous call. We are using the handle of Form1.ReceiveWindow to return the results
    '        to.  When the Results arrive, they will cause a Mouse_Up event in the Textbox.

    If WSAAsyncGetHostByName(hWnd, &H202, HostName, hostent_async, Len(hostent_async)) = SOCKET_ERROR Then

        Debug.Print "Winsock Error detected in vbWSAAsyncGetHostByName function"
        vbWSAGetLastError

    Else

        ' Put a TextBox on Your form and change the name of the TextBox to ReceiveWindow.
        ' Then, copy and paste the following in the Mouse_Up event of the ReceiveWindow
        ' TextBox.  Once everything has been copied over, then remove the "'" marks off of
        ' each line.