·天新网首页·加入收藏·设为首页·网站导航
数码笔记本手机摄像机相机MP3MP4GPS
硬件台式机网络服务器主板CPU硬盘显卡
办公投影打印传真
家电电视影院空调
游戏网游单机动漫
汽车新车购车试驾
下载驱动源码
学院开发设计
考试公务员高考考研
业界互联网通信探索
您现在的位置:天新网 > 软件开发 > 开发语言 > VB开发
VB设计Win2000下截获IP数据包程序
http://www.21tx.com 2005年02月16日 Blog jyu1221
以下是在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
'-----------------------------代码结束--------------------------------------------------

上一篇: 真没想到VB也可以这样用之VB能做什么
下一篇: 用VB编写异步多线程下载程序

关于我们 | 联系我们 | 加入我们 | 广告服务 | 投诉意见 | 网站导航
Copyright © 2000-2011 21tx.com, All Rights Reserved.
晨新科技 版权所有 Created by TXSite.net