Option Explicit

Public Const SOCKET_ERROR = -1

Public Const AF_INET = 2

Public Const PF_INET = AF_INET

Public Const MAXGETHOSTSTRUCT = 1024

Public Const SOCK_STREAM = 1

Public Const MSG_PEEK = 2

Private Type SockAddr

    sin_family As Integer

    sin_port As Integer

    sin_addr As Long

    sin_zero(7) As Byte

End Type

Private Type T_WSA

    wVersion As Integer

    wHighVersion As Integer

    szDescription(0 To 255) As Byte

    szSystemStatus(0 To 128) As Byte

    iMaxSockets As Integer

    iMaxUdpDg As Integer

    lpVendorInfo As Long

End Type

Dim WSAData As T_WSA

Type Inet_Address

    Byte4 As String * 1

    Byte3 As String * 1

    Byte2 As String * 1

    Byte1 As String * 1

End Type

Public IPStruct As Inet_Address

Public Type T_Host

    h_name As Long

    h_aliases As Long

    h_addrtype As Integer

    h_length As Integer

    h_addr_list As Long

End Type

' KERNEL32.DLL funtions

Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)

' WSOCK32.DLL functions

Declare Function gethostbyaddr Lib "wsock32.dll" (addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long

Declare Function inet_addr Lib "wsock32.dll" (ByVal addr As String) 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 WSAStartup Lib "wsock32.dll" (ByVal a As Long, b As T_WSA) As Long

Declare Function WSACleanUp Lib "wsock32.dll" Alias "WSACleanup" () As Integer

Declare Function Socket Lib "wsock32.dll" Alias "socket" (ByVal afinet As Integer, ByVal socktype As Integer, ByVal protocol As Integer) As Long

Declare Function ConnectWinsock Lib "wsock32.dll" Alias "connect" (ByVal sock As Long, sockstruct As SockAddr, ByVal structlen As Integer) As Integer

Declare Function send Lib "wsock32.dll" (ByVal sock As Long, ByVal msg As String, ByVal msglen As Integer, ByVal flag As Integer) As Integer

Declare Function recv Lib "wsock32.dll" (ByVal sock As Long, ByVal msg As String, ByVal msglen As Integer, ByVal flag As Integer) As Integer

Declare Function htonl Lib "wsock32.dll" (ByVal a As Long) As Long

Declare Function ntohl Lib "wsock32.dll" (ByVal a As Long) As Long

Declare Function htons Lib "wsock32.dll" (ByVal a As Integer) As Integer

Declare Function ntohs Lib "wsock32.dll" (ByVal a As Integer) As Integer

Declare Function closesocket Lib "wsock32.dll" (ByVal sn As Long) As Integer

 Function HostByName(sHost As String) As String

    Dim s As String

    Dim p As Long

    Dim Host As T_Host

    Dim ListAddress As Long

    Dim ListAddr As Long

    Dim Address As Long

    s = String(64, 0)

    sHost = sHost + Right(s, 64 - Len(sHost))

    p = GetHostByName(sHost)

    If p = SOCKET_ERROR Then

        Exit Function

    Else

        If p <> 0 Then

            CopyMemory Host.h_name, ByVal p, Len(Host)

            ListAddress = Host.h_addr_list

            CopyMemory ListAddr, ByVal ListAddress, 4

            CopyMemory Address, ByVal ListAddr, 4

            HostByName = InetAddrLongToString(Address)

        Else

            HostByName = "No DNS Entry"

        End If

    End If

End Function

Private Function InetAddrStringToLong(Address As String) As Long

    InetAddrStringToLong = inet_addr(Address)

End Function

Private Function InetAddrLongToString(Address As Long) As String

    CopyMemory IPStruct, Address, 4

    InetAddrLongToString = CStr(Asc(IPStruct.Byte4)) + "." + _

            CStr(Asc(IPStruct.Byte3)) + "." + CStr(Asc(IPStruct.Byte2)) + "." + _

            CStr(Asc(IPStruct.Byte1))

End Function

Function HostByAddress(ByVal sAddress As String) As String

    Dim lAddress As Long

    Dim p As Long

    Dim HostName As String

    Dim Host As T_Host

    lAddress = inet_addr(sAddress)

    p = gethostbyaddr(lAddress, 4, PF_INET)

    If p <> 0 Then

        CopyMemory Host, ByVal p, Len(Host)

        HostName = String(256, 0)

        CopyMemory ByVal HostName, ByVal Host.h_name, 256

        If HostName = "" Then HostByAddress = "Unable to Resolve Address"

        HostByAddress = Left(HostName, InStr(HostName, Chr(0)) - 1)

    Else

        HostByAddress = "No DNS Entry"

    End If

End Function

Private Function ResolveHost(sHost As String) As Long

    Dim lAddress As Long

    lAddress = InetAddrStringToLong(sHost)

    If lAddress = SOCKET_ERROR Then

        ResolveHost = inet_addr(HostByName(sHost))

    Else

        ResolveHost = lAddress

    End If

End Function

Public Function WinsockConnect(ByVal m_RemoteHost As String, m_RemotePort As Long, iSocket As Long) As Boolean

'这个iSocket参数，现在是没用的，以后扩展的话，创建Socket一般是放在函数之外，这统治有用了。

    Dim sock As SockAddr

    iSocket = Socket(AF_INET, SOCK_STREAM, 6) '6是TCP协议，原来的0，我也不知是什么，你自己查查资料，好像在这也能用，不过还是明确点好。

'    If iSocket <> -1 Then

    If iSocket = -1 Then

'Socket的handle可能是负值，不能用<1来判断，返回INVALID_SOCKET = -1才是失败

        WinsockConnect = False

        Exit Function

    End If

    sock.sin_family = AF_INET

    sock.sin_addr = ResolveHost(m_RemoteHost)

    sock.sin_port = htons(m_RemotePort)

    If ConnectWinsock(iSocket, sock, Len(sock)) = SOCKET_ERROR Then

'返回值不是SOCKET_ERROR才是成功，不能用bool判断，因为0也是成功

        WinsockConnect = False

        Exit Function

    End If

    WinsockConnect = True

End Function

Public Sub WinsockInit()

    WSAStartup &H101, WSAData

End Sub

调用：

Private Sub Command1_Click()

    Dim iID As Long

    WinsockInit

    If WinsockConnect("192.168.33.137", 1433, iID) = True Then

        MsgBox "连接成功"

    Else

        MsgBox "连接失败"

    End If

        

    WSACleanUp

End Sub