| VB 源码 | VC 源码 | ASP源码 | JSP源码 | PHP源码 | CGI源码 | FLASH源码 | 素材模板 | C 源程序 | 站长工具 | 站长教程 |

VB技术

ASP技术
PHP技术
JSP技术
VB技术
.NET技术

本类阅读TOP10

·VB到底为我们做了什么?
·利用shell编程实现DOS风格的Linux命令行
·屏保程序模板化完整源代码
·用VB6实现中英文文本的私钥加密
·VB解决Unicode文本转换的问题
·用VB编写网络监控软件
·一组VB实用小程序
·新手必学:windows网络编程经典入门
·用VB编写定时关闭计算机的程序
·用VB制作屏幕保护程序

站内搜索

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

  为了方便广大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
  '-----------------------------代码结束--------------------------------------------------

  作者:天同 QQ:19632995




相关文章
  • 21个实用PHP代码
  • 精通PHP的十大要点
  • VB解决Unicode文本转换的问题
  • 一个基于WEB的QQ程序
  • 使用xmlhttp查询域名是否被注的小程序
  • 用VB6实现中英文文本的私钥加密
  • 一组VB实用小程序
  • 用VB编写异步多线程下载程序
  • 屏保程序模板化完整源代码
  • VB中实现窗体自动隐藏
  • 用VB编写网络监控软件
  • VB到底为我们做了什么?
  • 键盘幽灵VB版
  • 用VB编写定时关闭计算机的程序
  • 用MCI命令做一个播放器
  • VB中字符串中文的问题
  • 用VB制作屏幕保护程序
  • VB枚举主机IP
  • 用VB编写一个弹出菜单类
  • 自己的IE——用VB制作浏览器
  • 相关软件

  • VBScript编辑器源码  
  • 字体观察器FontViewer源码  
  • 自动壁纸更换器源码[第二部分]  
  • 自动壁纸更换器源码[第一部分]  
  • WINDOWS 3.0终端程序的C源码  
  • 一个取得 CPU 信息的程序源码  
  • 广告窗口终结者源码  
  • 下载整个网站程序ssnag与源码  
  • CGI邮件程序源码  
  • ISAPI留言簿源码  

  • 下载首页关于我们广告服务联系方式常见问题隐私声明法律条款本站声明下载帮助发布软件站点地图谷歌卫星地图