|
作者: abctm [abctm] 版主 | 登录 |
【看贴要回帖呦!^_^】【转】 因广大VB爱好者开发捕获IP数据包的需要,我花了一个下午的工夫,终于把它整里出来了,由于时间关系,以下的数据分析部分写的不是很详细。以下代码在WIN98+VB6.0上测试通过,主函数部分比较简单,1。打开设备驱动程序,2。绑定网卡,3。设置捕获数据,4。循环截获IP包。 由于在WIN98下捕获IP数据包,必须要使用VXD技术,它不像WIN2000(可以参照前二天写的,“使用VB捕获WIN2000下的IP数据包”),捕获IP数据包不需要VXD文件,单单只要使用VB就可以了。因为编写VXD的步骤比较麻烦,在以下的源代码中,直接使用IPMAN中的VPACKET.VXD这个驱动程序。可以在网上比较容易得到,需要的朋友也可以跟我联系。以下包含了截获数据包的所有源代码,只要把下面的代码放到一个模块(.BAS)文件中就可以了,里面信息截获到以后,并没有对数据做太多的处理,所有的数据都放在OutBuff数组中,只是简单的分离出了以太网头部m_EtherPacketHead,IP包头部m_IPPacketHead,其中程序中只是简单的输出了源IP地址,目的IP地址,需要更进一不分析里面的内容,可以参照别的资料。在这里为了程序尽量的简单,所以不过多的牵涉。进一步分析的内容可以添加到输出内容的附近代码就可以了。 '--------源代码开始,放到.bas中即可以测试---------- Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long Private Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long Private Declare Function WaitForMultipleObjectsEx Lib "kernel32" (ByVal nCount As Long, lpHandles As Long, ByVal bWaitAll As Long, ByVal dwMilliseconds As Long, ByVal bAlertable As Long) As Long Private Const INFINITE = &HFFFF Private Const GENERIC_WRITE = &H40000000 Private Const GENERIC_READ = &H80000000 Private Const OPEN_EXISTING = 3 Private Const FILE_ATTRIBUTE_NORMAL = &H80 Private Const FILE_FLAG_OVERLAPPED = &H40000000 Private Const FILE_FLAG_DELETE_ON_CLOSE = &H4000000 Private Const ERROR_IO_INCOMPLETE = 996& Private Const NDIS_PACKET_TYPE_DIRECTED = &H1 Private Const IOCTL_PROTOCOL_SET_OID = &H80000004 Private Const IOCTL_PROTOCOL_READ = &H80000010 Private Const OID_GEN_CURRENT_PACKET_FILTER = &H1010E Private Const WAIT_FAILED = -1 Private Type OVERLAPPED Internal As Long InternalHigh As Long offset As Long OffsetHigh As Long hEvent As Long End Type Type EtherAddr AddrByte1 As Byte AddrByte2 As Byte AddrByte3 As Byte AddrByte4 As Byte AddrByte5 As Byte AddrByte6 As Byte End Type Type EtherPacketHead DestEther As EtherAddr SourEther As EtherAddr ServType As Integer End Type Type IPAddr AddrByte(0 To 3) As Byte End Type Type IPPacketHead VerHLen As Byte Type1 As Byte TtlLen As Integer Id As Integer FlgOff As Integer TTL As Byte Proto As Byte ChkSum As Integer SourIP As IPAddr DestIP As IPAddr End Type Type PACKET_OID_DATA Oid As Long Length As Long data As Byte End Type Private Declare Function DeviceIoControlAsString Lib "kernel32" Alias "DeviceIoControl" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, ByVal lpInBuffer As String, ByVal nInBufferSize As Long, ByVal lpOutBuffer As String, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As OVERLAPPED) As Long Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As OVERLAPPED) As Long Private Declare Function GetOverlappedResult Lib "kernel32" (ByVal hFile As Long, lpOverlapped As OVERLAPPED, lpNumberOfBytesTransferred As Long, ByVal bWait As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (ByVal dest As Long, ByVal numbytes As Long) Private Declare Function GetLastError Lib "kernel32" () As Long Const ETHER_PROTO_IP = &H8 Const IP_PROTO_TCP = &H6 Const ETHER_HEAD_LEN = 14 Const IP_HEAD_BYTE_LEN = 20 Dim bFirst As Boolean Const SYSERR = -1 Const BUFFER_SIZE = 16384 Const nREAD = 1 Type PacketTable hEvent As Long Active As Boolean Overlap As OVERLAPPED Size As Long Buffer(BUFFER_SIZE) As Byte Length As Long Type As Integer End Type Const RECV_MAX = 32 Dim RecvTab(RECV_MAX) As PacketTable Dim EventTab(RECV_MAX) As Long Dim InBuff(1514) As Byte Dim OutBuff(1514) As Byte Function Bind(hVxD As Long, inBuffer As String) As Boolean Dim hEvent As Long Dim cbRet As Long Dim ovlp As OVERLAPPED Dim result As Long Dim cbIn As Long cbIn = 5 hEvent = CreateEvent(0, 1, 0, vbNullString) If hEvent = 0 Then Bind = False MsgBox "err bind" Exit Function End If ovlp.hEvent = hEvent '((0x8000) << 16) | ((0) << 14) | ((7) << 2) | (0)) Const IOCTL_PROTOCOL_BIND = &H8000001C result = DeviceIoControlAsString(hVxD, _ IOCTL_PROTOCOL_BIND, _ ByVal inBuffer, _ cbIn, _ ByVal inBuffer, _ cbIn, _ cbRet, _ ovlp) If (result = 0) Then Call GetOverlappedResult(hVxD, ovlp, cbRet, True) End If Call CloseHandle(hEvent) Bind = True End Function Function QueryPacket(ByVal hVxD As Long, ByVal ioctl As Long, ByVal cbIn As Long, ByVal cbOut As Long) As Long Dim hEvent As Long Dim cbRet As Long Dim ovlp As OVERLAPPED Dim result As Long hEvent = CreateEvent(0, 1, 0, vbNullString) If hEvent = 0 Then QueryPacket = False MsgBox "err bind" Exit Function End If ovlp.Internal = 0 ovlp.InternalHigh = 0 ovlp.offset = 0 ovlp.OffsetHigh = 0 ovlp.hEvent = hEvent ' ioc = &H80000018 result = DeviceIoControl(hVxD, ioctl, InBuff(0), cbIn, InBuff(0), cbOut, cbRet, ovlp) If result = 0 Then If (GetLastError() = ERROR_IO_PENDING) Then MsgBox "Ok0" Else Call CloseHandle(hEvent) Exit Function End If If (0 = GetOverlappedResult(hVxD, ovlp, cbRet, 0)) Then If (GetLastError() = ERROR_IO_INCOMPLETE) Then MsgBox "ok2" Else Call CloseHandle(hEvent) Exit Function End If End If result = GetOverlappedResult(hVxD, ovlp, cbRet, 1) End If QueryPacket = cbRet End Function Function QueryOid(hVxD As Long, ulOid As Long, ulLength As Long) As Long Dim cbIn As Long cbIn = 14 + ulLength Dim cbRet As Long Dim OidData As PACKET_OID_DATA OidData.Oid = ulOid OidData.Length = ulLength OidData.data = 0 Dim ioctl As Long Const OID_802_3_PERMANENT_ADDRESS = &H1010101 Const IOCTL_PROTOCOL_QUERY_OID = &H80000000 Const IOCTL_PROTOCOL_STATISTICS = &H80000008 If ulOid >= OID_802_3_PERMANENT_ADDRESS Then ioctl = IOCTL_PROTOCOL_QUERY_OID Else ioctl = IOCTL_PROTOCOL_STATISTICS End If Call CopyMemory(InBuff(0), OidData, cbIn) cbRet = QueryPacket(hVxD, ioctl, cbIn, cbIn) QueryOid = cbRet End Function Function GetHardEtherAddr(ByVal hVxD As Long, petheraddr As EtherAddr) As Boolean Dim nret As Long Const OID_802_3_CURRENT_ADDRESS = &H1010102 nret = QueryOid(hVxD, OID_802_3_CURRENT_ADDRESS, 6) If (nret > 0) Then Call CopyMemory(petheraddr, InBuff(8), 6) GetHardEtherAddr = True Else GetHardEtherAddr = False End If End Function Function SetOid(ByVal hVxD As Long, ByVal ulOid As Long, ByVal ulLength As Long, ByVal data As Long) As Long Dim cbIn As Long Dim cbRet As Long Dim OidData As PACKET_OID_DATA Dim ioctl As Long cbIn = 32 If (ulOid = OID_GEN_CURRENT_PACKET_FILTER) Then ioctl = IOCTL_PROTOCOL_SET_OID OidData.Oid = ulOid OidData.Length = ulLength OidData.data = 1 CopyMemory InBuff(0), OidData, cbIn cbRet = QueryPacket(hVxD, ioctl, cbIn, cbIn) SetOid = 0 End Function Function GetPacket(ByVal hVxD As Long, ByVal ioctl As Long, ByVal cbIn As Long, ByVal cbOut As Long) As Long Dim hEvent As Long Dim cbRet As Long Dim ovlp As OVERLAPPED Dim result As Long hEvent = CreateEvent(0, 1, 0, vbNullString) If hEvent = 0 Then GetPacket = 0 Exit Function End If ovlp.hEvent = hEvent result = DeviceIoControl(hVxD, ioctl, InBuff(0), cbIn, OutBuff(0), cbOut, cbRet, ovlp) If (result = 0) Then Call GetOverlappedResult(hVxD, ovlp, cbRet, True) GetPacket = cbRet End Function Function RecvPacket(ByVal hVxD As Long, ByVal pbuf As Variant) As Long Dim hEvent As Long Dim I As Long, J As Long, K As Long Dim len1 As Long If (bFirst) Then For I = 0 To RECV_MAX - 1 hEvent = CreateEvent(0, 1, 0, vbNullString) If (hEvent = 0) Then MsgBox "ERROR" RecvPacket = SYSERR Exit Function End If RecvTab(I).hEvent = hEvent RecvTab(I).Size = BUFFER_SIZE RecvTab(I).Active = True RecvTab(I).Type = nREAD EventTab(I) = hEvent Call RecvStart(hVxD, RecvTab(I)) Next bFirst = False End If I = WaitForMultipleObjectsEx(RECV_MAX, EventTab(0), 0, INFINITE, 0) If (I = WAIT_FAILED) Then MsgBox "error WaitForMultipleObjectsEx" RecvPacket = SYSERR Exit Function End If For J = 0 To RECV_MAX - 1 If (EventTab(I) = RecvTab(J).hEvent) Then Exit For Next K = J If (RecvTab(K).Type = nREAD And RecvTab(K).Active = True) Then Call GetOverlappedResult(hVxD, RecvTab(K).Overlap, RecvTab(K).Length, 0) If (RecvTab(K).Length > BUFFER_SIZE) Then RecvTab(K).Length = BUFFER_SIZE Call CopyMemory(OutBuff(0), RecvTab(K).Buffer(0), RecvTab(K).Length) len1 = RecvTab(K).Length Call CloseHandle(RecvTab(K).hEvent) For J = I + 1 To RECV_MAX - 1 EventTab(I) = EventTab(J) I = I + 1 Next hEvent = CreateEvent(0, 1, 0, vbNullString) If (hEvent = 0) Then MsgBox "ERROR CREATEEVENT" RecvPacket = SYSERR Exit Function End If RecvTab(K).hEvent = hEvent 'memset(RecvTab[k].Buffer,0,BUFFER_SIZE); RecvTab(K).Size = BUFFER_SIZE RecvTab(K).Active = True RecvTab(K).Type = nREAD EventTab(RECV_MAX - 1) = hEvent Call RecvStart(hVxD, RecvTab(K)) RecvPacket = len1 Exit Function Else RecvPacket = SYSERR End If End Function Function RecvStart(ByVal hVxD As Long, packtab As PacketTable) As Long Dim result As Long packtab.Overlap.Internal = 0 packtab.Overlap.InternalHigh = 0 packtab.Overlap.offset = 0 packtab.Overlap.OffsetHigh = 0 packtab.Overlap.hEvent = packtab.hEvent result = DeviceIoControl(hVxD, _ IOCTL_PROTOCOL_READ, _ packtab.Buffer(0), _ packtab.Size, _ packtab.Buffer(0), _ packtab.Size, _ packtab.Length, _ packtab.Overlap) If (result <> 0) Then RecvStart = SYSERR Else RecvStart = 0 End If End Function Sub Main() bFirst = True Dim hVxD As Long Dim m_EtherPacketHead As EtherPacketHead Dim m_IPPacketHead As IPPacketHead Dim m_EtherAddr As EtherAddr hVxD = CreateFile("\\.\VPACKET.VXD", _ GENERIC_READ Or GENERIC_WRITE, _ 0, _ 0, _ OPEN_EXISTING, _ FILE_ATTRIBUTE_NORMAL Or _ FILE_FLAG_OVERLAPPED Or _ FILE_FLAG_DELETE_ON_CLOSE, _ 0) Bind hVxD, "0001" Call GetHardEtherAddr(hVxD, m_EtherAddr) SetOid hVxD, OID_GEN_CURRENT_PACKET_FILTER, 4, NDIS_PACKET_TYPE_DIRECTED Do Until False DoEvents 'result = GetPacket(hVxD, IOCTL_PROTOCOL_READ, 1514, 1514) result = RecvPacket(hVxD, OutBuff) If result = 0 Then Exit Do If result <> SYSERR Then Call CopyMemory(m_EtherPacketHead, OutBuff(0), ETHER_HEAD_LEN) If m_EtherPacketHead.ServType = ETHER_PROTO_IP Then Call CopyMemory(m_IPPacketHead, OutBuff(ETHER_HEAD_LEN), IP_HEAD_BYTE_LEN) If m_IPPacketHead.Proto = IP_PROTO_TCP Then Debug.Print "SourIP:", m_IPPacketHead.SourIP.AddrByte(0) & "." & m_IPPacketHead.SourIP.AddrByte(1) & "." & m_IPPacketHead.SourIP.AddrByte(2) & "." & m_IPPacketHead.SourIP.AddrByte(3) Debug.Print "DestIP:", m_IPPacketHead.DestIP.AddrByte(0) & "." & m_IPPacketHead.DestIP.AddrByte(1) & "." & m_IPPacketHead.DestIP.AddrByte(2) & "." & m_IPPacketHead.DestIP.AddrByte(3) End If End If End If Loop Call CloseHandle(hVxD) End Sub '----------------------源代码结束----------------- |
地主 发表时间: 10/13 22:00 |
|
20CN网络安全小组版权所有
Copyright © 2000-2010 20CN Security Group. All Rights Reserved.
论坛程序编写:NetDemon
粤ICP备05087286号