使用VB在WIN2000下截获IP数据包 作者： 评价： 上站日期: 2002-05-22 内容说明： 来源： QQ:19632995MSN: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 LongDeclare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As LongDeclare Function connect Lib "ws2_32.dll" (ByVal s As Long, name As SOCK_ADDR, ByVal namelen As Integer) As LongDeclare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As LongDeclare Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As IntegerDeclare Function recv Lib "ws2_32.dll" (ByVal s As Long, buffer As Any, ByVal length As Long, ByVal flags As Long) As LongDeclare Function send Lib "ws2_32.dll" (ByVal s As Long, buffer As Any, ByVal length As Long, ByVal flags As Long) As LongDeclare Function shutdown Lib "ws2_32.dll" (ByVal s As Long, ByVal how As Long) As LongDeclare Function ioctlsocket Lib "ws2_32.dll" (ByVal s As Long, ByVal v As Long, ut As Long) As LongDeclare Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal type_specification As Long, ByVal protocol As Long) As LongDeclare Function WSACancelBlockingCall Lib "ws2_32.dll" () As LongDeclare Function WSACleanup Lib "ws2_32.dll" () As LongDeclare Function WSAGetLastError Lib "ws2_32.dll" () As LongDeclare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Integer, wsData As WSA_DATA) As LongDeclare 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 = 256Public Const WSASYS_STATUS_LEN = 128Type 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 LongEnd TypeType IN_ADDR S_addr As LongEnd TypeType SOCK_ADDR sin_family As Integer sin_port As Integer sin_addr As IN_ADDR sin_zero(0 To 7) As ByteEnd TypeType 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 LongEnd Type Const AF_INET = 2Const SOCK_RAW = 3Const IPPROTO_IP = 0Const IPPROTO_TCP = 6Const IPPROTO_UDP = 17Const MAX_PACK_LEN = 65535Const SOCKET_ERROR = -1& Private mwsaData As WSA_DATAPrivate m_hSocket As LongPrivate msaLocalAddr As SOCK_ADDRPrivate msaRemoteAddr As SOCK_ADDRSub 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 = WSAIoctl(m_hSocket, &H98000001, InParamBuffer, Len(InParamBuffer), 0, 0, BytesRet, 0, 0) 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 Call Sleep(300) '这里这条语句不能去掉，但可以调整一下范围，否则出现GPE错误。 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 = WSACleanupEnd SubFunction 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 & "." & p1End Function'-----------------------------代码结束--------------------------------------------------
评论