不用WINSOCK控件，用API，测试一个端口是否开发，有成熟的代码么？

我有一段代码，测试自己机器的端口，可以用但是测试别人的IP，对方端口是开的，测试出来也是连接失败···
''''模块
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 = 2Private Type SockAddr
    sin_family As Integer
    sin_port As Integer
    sin_addr As String * 4
    sin_zero As String * 8
End TypePrivate 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 TypeDim WSAData As T_WSAType Inet_Address
    Byte4 As String * 1
    Byte3 As String * 1
    Byte2 As String * 1
    Byte1 As String * 1
End TypePublic IPStruct As Inet_AddressPublic 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 FunctionPrivate Function InetAddrStringToLong(Address As String) As Long
    InetAddrStringToLong = inet_addr(Address)
End FunctionPrivate 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 FunctionFunction 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 FunctionPrivate 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 FunctionPublic Function WinsockConnect(ByVal m_RemoteHost As String, m_RemotePort As Long, iSocket As Long) As Boolean
    Dim sock As SockAddr
    Dim sRemoteIP As String
    Dim x As Long
    Dim bAddr(0 To 3) As Byte
    Dim i As Integer    iSocket = Socket(AF_INET, SOCK_STREAM, 0)
    If iSocket < 1 Then
        WinsockConnect = False
        Exit Function
    End If
    sRemoteIP = ""
    sock.sin_family = AF_INET
    x = ResolveHost(m_RemoteHost)
    CopyMemory bAddr(0), x, 4
    For i = 0 To 3
        sRemoteIP = sRemoteIP & Chr(bAddr(i))
    Next
    sock.sin_addr = sRemoteIP
    sock.sin_port = htons(m_RemotePort)
    sock.sin_zero = String(8, 0)
    If ConnectWinsock(iSocket, sock, Len(sock)) Then
        WinsockConnect = False
        Exit Function
    End If
    WinsockConnect = True
End FunctionPublic Sub WinsockInit()
    WSAStartup &H101, WSAData
End Sub
'''''窗体
Private Sub Command4_Click()
    Dim iID As Long
    WinsockInit
    If WinsockConnect("127.0.0.1", 1111, iID) = True Then  '这里的127.0.0.1是本机，如果换成别人的IP，对方端口开放，也测试不出来，郁闷~~~~
        MsgBox "连接成功"
    Else
        MsgBox "连接失败"
    End If
    WSACleanUp
End Sub

解决方案 »

  1.   

    即使测试本机，换成本机的公网IP也是测试不到端口开着在命令提示符里用 telnet IP 端口 可以测试到端口开放着的
      

  2.   

    这个代码是API操作Socket的雏形，要走的路还很长。
    就你的问题而言，问题出在SockAddr结构上！
    这个结构的sin_addr成员是一个Long表示的IP地址，你这里绕了十万八千里的大弯，非要把它转成String，实在不懂这是从哪抄来的代码！这样改：
    首先，结构声明要变一下
    Private Type SockAddr
        sin_family As Integer
        sin_port As Integer
        sin_addr As Long
        sin_zero(7) As Byte
    End TypeWinsockConnect函数改一下：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
    '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
      

  3.   

    看到 小吉 ，就看到解决问题的希望·····加入CSDN不久，不知小吉是谁，能得到这样的评论，好像很有Reputation,他有什么作品？
      

  4.   

    哎！我的失误！前边还在对你说怎么判断，自己却写反了
    If iSocket <> -1 Then
    你要改过来
    If iSocket = -1 Then这种问题的错误，你要是看明白我的说明，自己应该能改过来呀，看别人的代码一定要弄懂才有意义，不然看再多也没用！想给你说明几点：
    1、你这个示例，理论上只支持IP连接，因为这样写的ResolveHost函数，并不能适合解析本地缓存之外的远程域名，一般通过DNS解析远程域名应采用WSAAsyncGetHostByName，通过Socket消息进行动态获取，以防止线程阻塞；
    2、ConnectWinsock返回非SOCKET_ERROR，只代表调用成功，并不肯定代表连接成功；最终能否被对方接受，是否有人接受，最终也是要通过Socket消息来获取；接收Socket消息，要用到窗体与SubClass，你要走的路还很长。
      

  5.   

    请教一个问题：
    能否设置Socket发送消息停留的时间呢？
    我试了下Socket发送出消息，如果对方不接受或对方主机未开机都会停留20秒左右。
    请问能否设置短一点的时间，比如2秒。
    因为如果对方端口开启一般都会在2秒内有返回消息，如果超过2秒则表示对方不在线！各位有谁能帮我完成这个问题本人定有报答（希望各位高手门肯帮帮我）