使用VB在WIN2000下截获IP数据包

作者:天同
QQ:19632995
MSN:jyu1221@hotmail.com
日期:2002.04.30

      为了方便广大VB爱好者也能向C语言一样能截获IP包,本人特地写了以下的源代码,以供VB开发者参考。

       以下是在VB中截获WIN2000下TCP/IP包的源代码,在VB6.0,win2000下测试通过,需要注意的地方是,1.必须和本地的一块网卡,2.每次获取数据后必须有一段延时。3.数据取到之后放在Buff的数组中。4.把以下的代码放在一个模块中就可以了。
'-----------------------------代码开始--------------------------------------------------
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


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 = 0
    msaLocalAddr.sin_addr.S_addr = inet_addr("192.168.1.125") '这里需要你自己的网卡的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
'-----------------------------代码结束--------------------------------------------------

  • 0
    点赞
  • 0
    收藏
  • 打赏
    打赏
  • 1
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
©️2022 CSDN 皮肤主题:大白 设计师:CSDN官方博客 返回首页
评论 1

打赏作者

jyu1221

你的鼓励将是我创作的最大动力

¥2 ¥4 ¥6 ¥10 ¥20
输入1-500的整数
余额支付 (余额:-- )
扫码支付
扫码支付:¥2
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值