20CN网络安全小组论坛 - 编程破解 - VB设计Win2000下截获IP数据包程序

论坛: 编程破解标题: VB设计Win2000下截获IP数据包程序

作者: yunjuanshu [yunjuanshu]

论坛用户

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

地主发表时间: 06-07-11 15:31

回复: 286 [unique]

版主

是你编的吗？你编译通过了吗？你分析原理了吗？

B1层发表时间: 06-07-11 17:27

回复: NetMairco [jbcsk]

论坛用户

好象不可以哦，出现错误，楼住，是不是转载的呀？是的话，请标明作者，不然可是盗版哦

B2层发表时间: 06-09-18 15:47

论坛: 编程破解