比如我现在知道我的计算机正在和某IP地址为192.168.1.1:8032进行通信,我怎么去截听并对起进行编程,欢迎大家讨论。分不够继续发。。

解决方案 »

  1.   

    简单的说就是用VB去截听已知IP和端口的数据。。
      

  2.   

    网络包分析程序,使用了vxd,真正的底层网络传输监控程序,不过只能在Win9X下使用
    http://www.applevb.com/sourcecode/Network%20Packet%20Analyzer.zip
      

  3.   

    http://www.diendantinhoc.org/portal/NewsTopic/Programming/1023484243/Packet Sniffer SDK for VB (Network monitoring)!
      

  4.   

    必须调第三方开发包么?
    Win2K 下vb可以使用 wnet 么?呵呵,从来没想过用vb这么做,一般都使用vc实现的,好奇
      

  5.   

    http://microolap.com/net/components/pssdk/index.htmPacket Sniffer SDK for VB (Network monitoring)!
      

  6.   

    http://dev.csdn.net/Develop/article/21/21363.shtm
      

  7.   

    把下面代码放入模块中,使用Sub Main运行。可以侦听数据包
    Option Explicit'-----------------------------代码开始--------------------------------------------------
    Declare Function bind Lib "ws2_32.dll" (ByVal s As Long, addr As SOCK_ADDR, ByVal namelen 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, name As SOCK_ADDR, ByVal namelen As Integer) As Long
    Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
    Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer
    Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, buffer As Any, ByVal length As Long, ByVal flags As Long) As Long
    Declare Function send Lib "ws2_32.dll" (ByVal s As Long, buffer As Any, ByVal length As Long, ByVal flags As Long) As Long
    Declare Function shutdown Lib "ws2_32.dll" (ByVal s As Long, ByVal how As Long) As Long
    Declare Function ioctlsocket Lib "ws2_32.dll" (ByVal s As Long, ByVal v As Long, ut As Long) As Long
    Declare Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal type_specification As Long, ByVal protocol As Long) As Long
    Declare Function WSACancelBlockingCall Lib "ws2_32.dll" () As Long
    Declare Function WSACleanup Lib "ws2_32.dll" () As Long
    Declare Function WSAGetLastError Lib "ws2_32.dll" () As Long
    Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Integer, wsData As WSA_DATA) As Long
    Declare Function WSASocketA Lib "ws2_32.dll" (ByVal af As Long, ByVal type1 As Long, ByVal protocol As Long, lpProtocolInfo As Long, g As Long, ByVal dwFlags As Long)
    Declare Function WSAIoctl Lib "ws2_32.dll" (ByVal s As Long, ByVal dwIoControlCode As Long, lpvInBuffer As Long, ByVal cbInBuffer As Long, lpvOutBuffer As Long, ByVal cbOutBuffer As Long, lpcbBytesReturned As Long, lpOverlapped As Long, lpCompletionRoutine As Long) As Long
     Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Public Const WSADESCRIPTION_LEN = 256
    Public Const WSASYS_STATUS_LEN = 128Type WSA_DATA
        wVersion As Integer
        wHighVersion As Integer
        strDescription(WSADESCRIPTION_LEN + 1) As Byte
        strSystemStatus(WSASYS_STATUS_LEN + 1) As Byte
        iMaxSockets As Integer
        iMaxUdpDg As Integer
        lpVendorInfo As Long
    End TypeType IN_ADDR
        S_addr As Long
    End TypeType SOCK_ADDR
        sin_family As Integer
        sin_port As Integer
        sin_addr As IN_ADDR
        sin_zero(0 To 7) As Byte
    End Type
    Type IPHeader
        lenver As Byte
        tos As Byte
        len As Integer
        ident As Integer
        flags As Integer
        ttl As Byte
        proto As Byte
        checksum As Integer
        sourceIP As Long
        destIP As Long
    End Type
        
    Const AF_INET = 2
    Const SOCK_RAW = 3
    Const IPPROTO_IP = 0
    Const IPPROTO_TCP = 6
    Const IPPROTO_UDP = 17
    Const MAX_PACK_LEN = 65535
    Const SOCKET_ERROR = -1&
        
    Private mwsaData As WSA_DATA
    Private m_hSocket As Long
    Private msaLocalAddr As SOCK_ADDRPrivate msaRemoteAddr As SOCK_ADDRConst WSANOERROR = 0
    Const INVALID_SOCKET = -1
    Sub Main()
        Dim nResult As Long
        
        nResult = WSAStartup(&H202, mwsaData)
        If nResult <> WSANOERROR Then
          MsgBox "Error en WSAStartup"
          Exit Sub
        End If
        
        m_hSocket = socket(AF_INET, SOCK_RAW, IPPROTO_IP)
        If (m_hSocket = INVALID_SOCKET) Then
           MsgBox "Error in socket"
           Exit Sub
        End If
        
        
        msaLocalAddr.sin_family = AF_INET
        msaLocalAddr.sin_port = 4000
        msaLocalAddr.sin_addr.S_addr = inet_addr("10.138.7.228") '这里需要你自己的网卡的IP地址
        
        nResult = bind(m_hSocket, msaLocalAddr, Len(msaLocalAddr))
        If (nResult = SOCKET_ERROR) Then
           MsgBox "Error in bind"
           Exit Sub
        End If
        
        Dim InParamBuffer  As Long
        Dim BytesRet  As Long
        BytesRet = 0
        InParamBuffer = 1
        nResult = ioctlsocket(m_hSocket, &H98000001, 1)
        If nResult <> 0 Then
           MsgBox "ioctlsocket"
           Exit Sub
        End If
        
        
        Dim strData As String
        Dim nReceived As Long
        
        
        '截获来的数据放在BUFF里面
        Dim Buff(0 To MAX_PACK_LEN) As Byte
        Dim IPH As IPHeader
        
        Do Until False     '这个例子里,一直获取
           DoEvents
           nResult = recv(m_hSocket, Buff(0), MAX_PACK_LEN, 0)
           If nResult = SOCKET_ERROR Then
               MsgBox "Error in RecvData::recv"
               Exit Do
           End If
           CopyMemory IPH, Buff(0), Len(IPH)     '为了访问方便
           Select Case IPH.proto
                 Case IPPROTO_TCP
                   'frmHookTcpip.Text1.SelText = HexIp2DotIp(IPH.sourceIP)
                   'frmHookTcpip.Text1.SelText = "  ----->  "
                   'frmHookTcpip.Text1.SelText = HexIp2DotIp(IPH.destIP)
                   'frmHookTcpip.Text1.SelText = vbCrLf
                   Debug.Print HexIp2DotIp(IPH.sourceIP) & "  ----->  " & HexIp2DotIp(IPH.destIP)
           End Select
        Loop
        
        nResult = shutdown(m_hSocket, 2)
        nResult = closesocket(m_hSocket)
        nResult = WSACancelBlockingCall
        nResult = WSACleanup
    End Sub
    Function HexIp2DotIp(ByVal ip As Long) As String
        Dim s As String, p1 As String, p2 As String, p3 As String, p4 As String
        s = Right("00000000" & Hex(ip), 8)
        p1 = Val("&h" & Mid(s, 1, 2))
        p2 = Val("&h" & Mid(s, 3, 2))
        p3 = Val("&h" & Mid(s, 5, 2))
        p4 = Val("&h" & Mid(s, 7, 2))
        HexIp2DotIp = p4 & "." & p3 & "." & p2 & "." & p1
    End Function
    '-----------------------------代码结束--------------------------------------------------