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

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

作者:天同

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

'-----------------------------代码结束--------------------------------------------------

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航