使用VB截获WIN98下的IP数据包一 因广大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 = &HFFFFPrivate Const GENERIC_WRITE 3D &H40000000 Private Const GENERIC_READ = &H80000000 Private Const OPEN_EXISTING 3D 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 = &H80000004Private Const IOCTL_PROTOCOL_READ = &H80000010 Private Const OID_GEN_CURRENT_PACKET_FILTER = &H1010EPrivate Const WAIT_FAILED = -1 Private Type OVERLAPPED Internal As Long InternalHigh As Long offset As Long OffsetHigh As Long hEvent As Long End TypeType EtherAddr AddrByte1As Byte AddrByte2As Byte AddrByte3As Byte AddrByte4As Byte AddrByte5As Byte AddrByte6As Byte End TypeType EtherPacketHead DestEther As EtherAddr SourEther As EtherAddr ServTypeAs Integer End Type Type IPAddr AddrByte(0 To 3) As Byte End TypeType 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 TypeType PACKET_OID_DATA Oid As Long Length As Long data As Byte End TypePrivate 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 以上代码来自: SourceCode Explorer(源代码数据库) 复制时间: 2002-05-26 23:46:42 当前版本: 1.0.690 作者: Shawls 个人主页: Http://Shawls.Yeah.Net E-Mail: [email protected] QQ: 9181729 使用VB截获WIN98下的IP数据包二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 Long0D 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 = &H6Const ETHER_HEAD_LEN = 14 Const IP_HEAD_BYTE_LEN = 20 Dim bFirst As Boolean Const SYSERR = -1 Const BUFFER_SIZE = 16384 Const nREAD = 1Type PacketTable hEvent As Long Active As Boolean Overlap As OVERLAPPED Size As Long Buffer(BUFFER_SIZE) As Byte LengthAs Long Type As Integer End TypeConst RECV_MAX = 32Dim RecvTab(RECV_MAX) As PacketTable Dim EventTab(RECV_MAX) As Long Dim InBuff(1514) As Byte Dim OutBuff(1514) As Byte 0A Function Bind(hVxD As Long, inBuffer As String) As Boolean0DDim hEvent As Long Dim cbRetAs Long Dim ovlpAs OVERLAPPEDDim result As Long Dim cbIn As Long cbIn = 5hEvent = CreateEvent(0, 1, 0, vbNullString) If hEvent = 0 Then Bind = False MsgBox "err bind" Exit Function End Ifovlp.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 IfCall 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 hEventAs Long Dim cbRet As Long Dim ovlpAs OVERLAPPED Dim result As Long
hEvent = CreateEvent(0, 1, 0, vbNullString) If hEvent = 0 Then QueryPacket = False MsgBox "err bind" Exit Function End If
使用VB截获WIN98下的IP数据包三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 0AMsgBox "ok2" Else Call CloseHandle(hEvent) Exit Function End If End Ifresult = GetOverlappedResult(hVxD, ovlp, cbRet, 1) End IfQueryPacket = cbRet End Function Function QueryOid(hVxD As Long, ulOid As Long, ulLength As Long) As Long Dim cbInAs Long cbIn = 14 + ulLength Dim cbRet As Long Dim OidData As PACKET_OID_DATA OidData.Oid = ulOid OidData.Length = ulLength OidData.data = 0Dim ioctl As Long Const OID_802_3_PERMANENT_ADDRESS = &H1010101 Const IOCTL_PROTOCOL_QUERY_OID = &H80000000 Const IOCTL_PROTOCOL_STATISTICS = &H80000008If ulOid >= OID_802_3_PERMANENT_ADDRESS Then ioctl = IOCTL_PROTOCOL_QUERY_OID 0AElse ioctl = IOCTL_PROTOCOL_STATISTICS 0AEnd IfCall 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 IfEnd Function Function SetOid(ByVal hVxD As Long, ByVal ulOid As Long, ByVal ulLength As Long, ByVal data As Long) As Long Dim cbInAs Long Dim cbRet As Long Dim OidData As PACKET_OID_DATA Dim ioctl As LongcbIn = 32If (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, cbIncbRet = 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 hEventAs Long Dim cbRetAs Long Dim ovlp As OVERLAPPED Dim result As Long hEvent = CreateEvent(0, 1, 0, vbNullString) If hEvent = 0 Then GetPacket = 0 Exit Function End Ifovlp.hEvent = hEventresult = DeviceIoControl(hVxD, ioctl, InBuff(0), cbIn, OutBuff(0), cbOut, cbRet, ovlp) If (result = 0) Then Call GetOverlappedResult(hVxD, ovlp, cbRet, True)0DGetPacket = 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 LongIf (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 以上代码来自: SourceCode Explorer(源代码数据库) 复制时间: 2002-05-26 23:46:59 当前版本: 1.0.690 作者: Shawls 个人主页: Http://Shawls.Yeah.Net E-Mail: [email protected] QQ: 9181729 使用VB截获WIN98下的IP数据包四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 3D 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" 0ARecvPacket = 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 3D 0 packtab.Overlap.offset = 0 packtab.Overlap.OffsetHigh = 0 packtab.Overlap.hEvent = packtab.hEventresult = 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 FunctionSub Main() bFirst = True Dim hVxD As Long Dim m_EtherPacketHead As EtherPacketHead Dim m_IPPacketHead As IPPacketHeadDim m_EtherAddr As EtherAddr0D hVxD = CreateFile("file://./VPACKET.VXD", _ GENERIC_READ Or GENERIC_WRITE, _ 0, _ 0, _ OPEN_EXISTING, _ FILE_ATTRIBUTE_NORMAL Or _ 0AFILE_FLAG_OVERLAPPED Or _ 0AFILE_FLAG_DELETE_ON_CLOSE, _0D 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) 0A If result = 0 Then Exit Do If result <> SYSERR Then 0ACall 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'源代码结束 以上代码来自: SourceCode Explorer(源代码数据库) 复制时间: 2002-05-26 23:47:11 当前版本: 1.0.690 作者: Shawls 个人主页: Http://Shawls.Yeah.Net E-Mail: [email protected] QQ: 9181729 以上数据来自: SourceCode Explorer(源代码数据库) 当前版本: 1.0.690 作者: Shawl
使用VB在WIN2K下截获IP数据包上为了方便广大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 0ADeclare 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 = 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 Long End TypeType IN_ADDR S_addr As Long End TypeType 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 TypeConst 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& 以上代码来自: SourceCode Explorer(源代码数据库) 复制时间: 2002-05-26 23:47:21 当前版本: 1.0.690 作者: Shawls 个人主页: Http://Shawls.Yeah.Net E-Mail: [email protected] QQ: 9181729 使用VB在WIN2K下截获IP数据包下Private mwsaData As WSA_DATA0D Private m_hSocket As Long 0APrivate msaLocalAddr As SOCK_ADDRPrivate msaRemoteAddr As SOCK_ADDR Sub Main() Dim nResult As LongnResult = WSAStartup(&H202, mwsaData) If nResult <> WSANOERROR Then0D MsgBox "Error en WSAStartup"0D Exit Sub End Ifm_hSocket = socket(AF_INET, SOCK_RAW, IPPROTO_IP) If (m_hSocket = INVALID_SOCKET) Then MsgBox "Error in socket" 0A Exit Sub End If msaLocalAddr.sin_family = AF_INET msaLocalAddr.sin_port = 0 msaLocalAddr.sin_addr.S_addr 3D 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 IfDim InParamBufferAs Long Dim BytesRetAs 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 IPHeaderDo 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 3D HexIp2DotIp(IPH.sourceIP) 0A 'frmHookTcpip.Text1.SelText 3D "----->" 'frmHookTcpip.Text1.SelText 3D HexIp2DotIp(IPH.destIP) 'frmHookTcpip.Text1.SelText 3D vbCrLf Debug.Print HexIp2DotIp(IPH.sourceIP) & "----->" & HexIp2DotIp(IPH.destIP) End Select LoopnResult = 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 '代码结束 以上代码来自: SourceCode Explorer(源代码数据库) 复制时间: 2002-05-26 23:47:28 当前版本: 1.0.690 作者: Shawls 个人主页: Http://Shawls.Yeah.Net E-Mail: [email protected] QQ: 9181729 以上数据来自: SourceCode Explorer(源代码数据库) 当前版本: 1.0.690
一个一个扫,加入超时,
并把结果存成文件。
留下EMAIL,过一阵给你发过去
由于在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 = &HFFFFPrivate Const GENERIC_WRITE 3D &H40000000
Private Const GENERIC_READ = &H80000000
Private Const OPEN_EXISTING 3D 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 = &H80000004Private Const IOCTL_PROTOCOL_READ = &H80000010
Private Const OID_GEN_CURRENT_PACKET_FILTER = &H1010EPrivate Const WAIT_FAILED = -1
Private Type OVERLAPPED
Internal As Long
InternalHigh As Long
offset As Long
OffsetHigh As Long
hEvent As Long
End TypeType EtherAddr
AddrByte1As Byte
AddrByte2As Byte
AddrByte3As Byte
AddrByte4As Byte
AddrByte5As Byte
AddrByte6As Byte
End TypeType EtherPacketHead
DestEther As EtherAddr
SourEther As EtherAddr
ServTypeAs Integer
End Type
Type IPAddr
AddrByte(0 To 3) As Byte
End TypeType 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 TypeType PACKET_OID_DATA
Oid As Long
Length As Long
data As Byte
End TypePrivate 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
以上代码来自: SourceCode Explorer(源代码数据库)
复制时间: 2002-05-26 23:46:42
当前版本: 1.0.690
作者: Shawls
个人主页: Http://Shawls.Yeah.Net
E-Mail: [email protected]
QQ: 9181729
使用VB截获WIN98下的IP数据包二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 Long0D
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 = &H6Const ETHER_HEAD_LEN = 14
Const IP_HEAD_BYTE_LEN = 20
Dim bFirst As Boolean
Const SYSERR = -1
Const BUFFER_SIZE = 16384
Const nREAD = 1Type PacketTable
hEvent As Long
Active As Boolean
Overlap As OVERLAPPED
Size As Long
Buffer(BUFFER_SIZE) As Byte
LengthAs Long
Type As Integer
End TypeConst RECV_MAX = 32Dim RecvTab(RECV_MAX) As PacketTable
Dim EventTab(RECV_MAX) As Long
Dim InBuff(1514) As Byte
Dim OutBuff(1514) As Byte
0A
Function Bind(hVxD As Long, inBuffer As String) As Boolean0DDim hEvent As Long
Dim cbRetAs Long
Dim ovlpAs OVERLAPPEDDim result As Long
Dim cbIn As Long
cbIn = 5hEvent = CreateEvent(0, 1, 0, vbNullString)
If hEvent = 0 Then
Bind = False
MsgBox "err bind"
Exit Function
End Ifovlp.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 IfCall 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 hEventAs Long
Dim cbRet As Long
Dim ovlpAs 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)
以上代码来自: SourceCode Explorer(源代码数据库)
复制时间: 2002-05-26 23:46:48
当前版本: 1.0.690
作者: Shawls
个人主页: Http://Shawls.Yeah.Net
E-Mail: [email protected]
QQ: 9181729
以上数据来自: SourceCode Explorer(源代码数据库)
当
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
0AMsgBox "ok2"
Else
Call CloseHandle(hEvent)
Exit Function
End If
End Ifresult = GetOverlappedResult(hVxD, ovlp, cbRet, 1)
End IfQueryPacket = cbRet
End Function Function QueryOid(hVxD As Long, ulOid As Long, ulLength As Long) As Long
Dim cbInAs Long
cbIn = 14 + ulLength
Dim cbRet As Long
Dim OidData As PACKET_OID_DATA
OidData.Oid = ulOid
OidData.Length = ulLength
OidData.data = 0Dim ioctl As Long
Const OID_802_3_PERMANENT_ADDRESS = &H1010101
Const IOCTL_PROTOCOL_QUERY_OID = &H80000000
Const IOCTL_PROTOCOL_STATISTICS = &H80000008If ulOid >= OID_802_3_PERMANENT_ADDRESS Then
ioctl = IOCTL_PROTOCOL_QUERY_OID
0AElse
ioctl = IOCTL_PROTOCOL_STATISTICS
0AEnd IfCall 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 IfEnd Function
Function SetOid(ByVal hVxD As Long, ByVal ulOid As Long, ByVal ulLength As Long, ByVal data As Long) As Long
Dim cbInAs Long
Dim cbRet As Long
Dim OidData As PACKET_OID_DATA
Dim ioctl As LongcbIn = 32If (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, cbIncbRet = 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 hEventAs Long
Dim cbRetAs Long
Dim ovlp As OVERLAPPED
Dim result As Long
hEvent = CreateEvent(0, 1, 0, vbNullString)
If hEvent = 0 Then
GetPacket = 0
Exit Function
End Ifovlp.hEvent = hEventresult = DeviceIoControl(hVxD, ioctl, InBuff(0), cbIn, OutBuff(0), cbOut, cbRet, ovlp)
If (result = 0) Then Call GetOverlappedResult(hVxD, ovlp, cbRet, True)0DGetPacket = 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 LongIf (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
以上代码来自: SourceCode Explorer(源代码数据库)
复制时间: 2002-05-26 23:46:59
当前版本: 1.0.690
作者: Shawls
个人主页: Http://Shawls.Yeah.Net
E-Mail: [email protected]
QQ: 9181729
使用VB截获WIN98下的IP数据包四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 3D 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"
0ARecvPacket = 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 3D 0
packtab.Overlap.offset = 0
packtab.Overlap.OffsetHigh = 0
packtab.Overlap.hEvent = packtab.hEventresult = 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 FunctionSub Main()
bFirst = True
Dim hVxD As Long
Dim m_EtherPacketHead As EtherPacketHead
Dim m_IPPacketHead As IPPacketHeadDim m_EtherAddr As EtherAddr0D
hVxD = CreateFile("file://./VPACKET.VXD", _
GENERIC_READ Or GENERIC_WRITE, _
0, _
0, _
OPEN_EXISTING, _
FILE_ATTRIBUTE_NORMAL Or _
0AFILE_FLAG_OVERLAPPED Or _
0AFILE_FLAG_DELETE_ON_CLOSE, _0D
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)
0A If result = 0 Then Exit Do
If result <> SYSERR Then
0ACall 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'源代码结束
以上代码来自: SourceCode Explorer(源代码数据库)
复制时间: 2002-05-26 23:47:11
当前版本: 1.0.690
作者: Shawls
个人主页: Http://Shawls.Yeah.Net
E-Mail: [email protected]
QQ: 9181729
以上数据来自: SourceCode Explorer(源代码数据库)
当前版本: 1.0.690
作者: Shawl
'代码开始
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
0ADeclare 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 = 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 Long
End TypeType IN_ADDR
S_addr As Long
End TypeType 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 TypeConst 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&
以上代码来自: SourceCode Explorer(源代码数据库)
复制时间: 2002-05-26 23:47:21
当前版本: 1.0.690
作者: Shawls
个人主页: Http://Shawls.Yeah.Net
E-Mail: [email protected]
QQ: 9181729
使用VB在WIN2K下截获IP数据包下Private mwsaData As WSA_DATA0D
Private m_hSocket As Long
0APrivate msaLocalAddr As SOCK_ADDRPrivate msaRemoteAddr As SOCK_ADDR
Sub Main()
Dim nResult As LongnResult = WSAStartup(&H202, mwsaData)
If nResult <> WSANOERROR Then0D
MsgBox "Error en WSAStartup"0D
Exit Sub
End Ifm_hSocket = socket(AF_INET, SOCK_RAW, IPPROTO_IP)
If (m_hSocket = INVALID_SOCKET) Then
MsgBox "Error in socket"
0A Exit Sub
End If
msaLocalAddr.sin_family = AF_INET
msaLocalAddr.sin_port = 0
msaLocalAddr.sin_addr.S_addr 3D 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 IfDim InParamBufferAs Long
Dim BytesRetAs 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 IPHeaderDo 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 3D HexIp2DotIp(IPH.sourceIP)
0A 'frmHookTcpip.Text1.SelText 3D "----->"
'frmHookTcpip.Text1.SelText 3D HexIp2DotIp(IPH.destIP)
'frmHookTcpip.Text1.SelText 3D vbCrLf
Debug.Print HexIp2DotIp(IPH.sourceIP) & "----->" & HexIp2DotIp(IPH.destIP)
End Select
LoopnResult = 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
'代码结束
以上代码来自: SourceCode Explorer(源代码数据库)
复制时间: 2002-05-26 23:47:28
当前版本: 1.0.690
作者: Shawls
个人主页: Http://Shawls.Yeah.Net
E-Mail: [email protected]
QQ: 9181729
以上数据来自: SourceCode Explorer(源代码数据库)
当前版本: 1.0.690