100分难题：如何用VB取得网络传递的二进制包

Question

网上找了很久，但多是C++的。没找到VB实现的
主要功能就是需要取得网络传递的二进制包,并能进行传递与接收

Answer 1

装winpcap然后看winpcap的开发文档旧可以了

Answer 2

应该很费事，著名的sniffer软件据说是将网卡置成混杂模式再监听的。

Answer 3

最主要的是取得数据包的详细内容，我需要用底层方式进行数据分析与发送
如下面的代码可找到IP但数据不够详细。
  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 = 128
   
  Type 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 Type
   
  Type IN_ADDR
          S_addr   As Long
  End Type
   
  Type 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_ADDR
   
  Private msaRemoteAddr     As SOCK_ADDR
   
  Const 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("192.168.1.6")       '这里需要你自己的网卡的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
  '-----------------------------代码结束--------------------------------------------------

Answer 4

常见的监听软件都是基于winpcap的，微软的netmon是自己增加了一个网卡驱动来完成监听的

Answer 5

我需要发送自定义包，另一方接收这个包，这种程序如何做呢 (基于tcp)其它的不管

Answer 6

有人能提供一个这样的tcp 发包与接包的vb例子吗，

Answer 7

winpcap 只能支持用vc 对于vb无法使用，我想的是有没有简单的vb的例子,我在网上也找到了vb for sniffer的例子但相对来说很复杂

Answer 8

没有人能回答，改变一下问题：哪里有Tcp包的详细规则，分就给他了