Author: jyu1221 (same day) QQ: 19632995 MSN: jyu1221@hotmail.com because the majority of enthusiasts VB developers need to capture IP packets, I spent an afternoon time, and finally it came out of a whole, because of the time, The following data analysis part is not very detailed. The following code is tested on Win98 VB6.0, and the main function part is relatively simple, 1. Open the device driver, 2. Bind the NIC, 3. Set capture data, 4. Cycle intercept IP package. Since the IP packet is captured under Win98, you must use VXD technology. It is not like win2000 (can refer to the previous two days, "using VB capture the IP packets"), capture the IP packet does not require VXD file, single single Just use VB. Because the steps to write VXD are more troublesome, in the following source code, use the VPacket.vxd in IPMAN directly using the driver. You can easily get online, you can contact me. The following contains all source code of the intercept packet, just put the following code in a module (.bas) file, it can be intercepted in the future, there is no more processing, all data Placed in the Outbuff array, just simply separating the Ethernet head m_etherpackethead, IP Baodou M_IPCKETHEAD, where only simple output source IP addresses, destination IP addresses, need to be more incomplete, can Refer to other information. In order to make a simple as possible, there is more than a much more concern. Further analysis can be added to the vicinity of the output content.
'-------- Source code start, put it in. BAS can be tested ----------
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate 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 LongPrivate Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As LongPrivate 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 LongPrivate Const INFINITE = & HFFFFPrivate Const GENERIC_WRITE = & H40000000Private Const GENERIC_READ = & H80000000Private Const OPEN_EXISTING = 3Private Const FILE_ATTRIBUTE_NORMAL = & H80Private const file_flag_overlapped = & h40000000p Rivate const file_flag_delete_on_close = & h4000000Private const error_io_incumplete = 996 & private const ndis_packet_type_directed = & h1private constl_protocol_set_oid = & h80000004
PRIVATE IOCTL_PROTOCOL_READ = & H80000010Private const Oid_gen_current_packet_filter = & h1010e
Private const wait_failed = -1private type overlapped Internal AS Long OffsetHigh As Long HEVENT AS LONGEND TYPE
Type EtherAddr AddrByte1 As Byte AddrByte2 As Byte AddrByte3 As Byte AddrByte4 As Byte AddrByte5 As Byte AddrByte6 As ByteEnd TypeType EtherPacketHead DestEther As EtherAddr SourEther As EtherAddr ServType As IntegerEnd Type
Type ipaddr addrbyte (0 to 3) as Byteend 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 ipaddrend type
TYPE PACKET_OID_DATA OID AS Long Length As long data as byteend 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 LongPrivate 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 LongPrivate Declare Function GetOverlappedResult Lib "kernel32" (ByVal hFile As Long, lpOverlapped As OVERLAPPED, lpNumberOfBytesTransferred As Long, ByVal bWait As Long) As LongPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Sub ZeromeMemory LIB "kernel32" Alias "RTLzeromeMory" (Byval Numbytes As Long)
Private Declare Function GetLastError LIB "Kernel32" () AS Long
Const ether_proto_ip = & h8const ip_proto_tcp = & h6
Const Ether_HEAD_LEN = 14const IP_HEAD_BYTE_LEN = 20dim bfirst as booleanconst syserr = -1const buffer_size = 16384const 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 INTEGEREND TYPE
Const RECV_MAX = 32
DIM Recvtab (RECV_MAX) AS PacketTableDim EventTab (Recv_max) As long
DIM INBUFF (1514) AS BYTEDIM 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 results = deviceioControlasstring (hvxd, _ ioctl_protocol_bind, _ byvalinbuffer, _ Cbin, _ byval inbuffer, _ cbin, _ cbret, _ OVLP)
IF (Result = 0) THEN CALL GETOVERLAPPEDRESULT (HVXD, OVLP, CBRET, TRUE) end if call closehandle (hevent) bind = trueEnd 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 results = 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_incumplete) Then MsgBox "OK2" Else Call CloseHandle (HEVENT) EXIT function On end if end if result = getoverlappedResult (HVXD, OVLP, CBRET, 1) end ifquerypacket = CBRETEND 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 = cbRetEnd FunctionFunction 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 = TR UE else gethardetheraddr = false end if End filter
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 = 0End 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 dam get regp.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 = CBRETEND 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 evenettab (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 IfEnd FunctionFunction 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 IFEND FUNCTION
Sub main () bfirst = truedim hvxd as longdim m_etherpackethead as etherpacketheadddim 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.Prin T "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 endiffs End sub '--------------------- Source code end --- ----------------
