ARP包还是提示每发出去。。。贴源码,大家找找原因。。。谢谢。。 ( 积分: 0 )

  • 主题发起人 linuxping
  • 开始时间
L

linuxping

Unregistered / Unconfirmed
GUEST, unregistred user!
{Packet32头文件}
unit Packet32;

interface

uses Windows, // OVERLAPPED syncronization structure
winsock,
bpf; // Needs bpf structures

Const
DLL = 'packet.dll'; // Name of DLL file
DEFAULT_DRIVERBUFFER = 1000000; // Dimension of the buffer in driver
MAX_LINK_NAME_LENGTH = 64; // Adapters symbolic names maximum length

type

// Adapter with which the driver communicates
Padapter = ^Tadapter;
Tadapter = packed Record
hFile : LongWord;
SymbolicLink : array [0..MAX_LINK_NAME_LENGTH-1] of char;
end;

// Packet the driver uses as means of data transport.
// both snooped data and certain device controlling
Ppacket = ^Tpacket;
Tpacket = packed record // Changed Jan.1 2002. Thanks to Deheng Xu
hevent :Thandle;
OverLapped :TOVERLAPPED;
Buffer :pointer;
//Next :pointer; // also commented out in "packet32.h"
Length :Longword;
ulBytesReceived :LongWord;
bIoComplete :Boolean;
end;


// [Gotten from LIBPCAP/ntddpack.h]
// Data structure to control the device driver
PPACKET_OID_DATA = ^TPACKET_OID_DATA;
TPACKET_OID_DATA = packed record
Oid : LongWord; // Device control code
Length: LongWord; // Length of data field
Data : Pointer; // Start of data field
end;

// [Gotten from BPF.h? - more appropiate here!]
Pnet_type = ^Tnet_type;
Tnet_type = packed record
LinkType,
LinkSpeed : LongWord;
end;

// from winsock2.h
// Portable socket structure (RFC 2553).

// Desired design of maximum size and alignment.
// These are implementation specific.

const
_SS_MAXSIZE = 128; // Maximum size.
{$EXTERNALSYM _SS_MAXSIZE}
_SS_ALIGNSIZE = SizeOf(Int64); // Desired alignment.
{$EXTERNALSYM _SS_ALIGNSIZE}

// Definitions used for sockaddr_storage structure paddings design (holds both ip4 and ip6 addresses)

_SS_PAD1SIZE = _SS_ALIGNSIZE - SizeOf(short);
{$EXTERNALSYM _SS_PAD1SIZE}
_SS_PAD2SIZE = _SS_MAXSIZE - (SizeOf(short) + _SS_PAD1SIZE + _SS_ALIGNSIZE);
{$EXTERNALSYM _SS_PAD2SIZE}

type
sockaddr_storage = record
ss_family: short; // Address family.
__ss_pad1: array [0.._SS_PAD1SIZE - 1] of char; // 6 byte pad, this is to make
// implementation specific pad up to
// alignment field that follows explicit
// in the data structure.
__ss_align: Int64; // Field to force desired structure.
__ss_pad2: array [0.._SS_PAD2SIZE - 1] of char; // 112 byte pad to achieve desired size;
// _SS_MAXSIZE value minus size of
// ss_family, __ss_pad1, and
// __ss_align fields is 112.
end;
{$EXTERNALSYM sockaddr_storage}
TSockAddrStorage = sockaddr_storage;
PSockAddrStorage = ^sockaddr_storage;

// from packet32.h - used by PacketGetNetInfoEx for 3.1 and later
Pnpf_if_addr = ^Tnpf_if_addr ;
Tnpf_if_addr = packed record
IPAddress: TSockAddrStorage ; // includes IP4 and IP6 addresses
SubnetMask: TSockAddrStorage ;
Broadcast: TSockAddrStorage ;
end ;

// from packet32.h - used by PacketGetNetInfoEx for 3.0 and earlier
Pnpf_if_addr30 = ^Tnpf_if_addr30 ;
Tnpf_if_addr30 = packed record
IPAddress: TSockAddrIn ;
SubnetMask: TSockAddrIn ;
Broadcast: TSockAddrIn ;
end ;

var

//------------------------------------------------------------------------------
//ULONG PacketGetAdapterNames(PTSTR pStr, PULONG BufferSize)
//------------------------------------------------------------------------------
PacketGetAdapterNames: Function (pStr: pchar; BufferSize: PLongWord) : Boolean; cdecl ;
{
This is the first function that must be used to communicate with the driver.
It returns the names of the adapters installed in the system through the user
allocated buffer pStr. BufferSize is the length of the buffer.

Warning: the result of this function is obtained querying directly the registry,
therefore the format of the result in Windows NT is different from the one in
Windows 95/98. This is due to the fact that Windows 95 uses the ASCII
encoding method to store a string, while Windows NT uses UNICODE. After a
call to PacketGetAdapterNames in Windows 95, pStr contains an ASCII string
with the names of the adapters separated by ASCII "/0". The string is
terminated by a double "/0". In Windows NT, pStr contains a UNICODE string
with the names of the adapters separated by a "/0" UNICODE character
(i.e. 2 ASCII "/0"), and the string ends with a double UNICODE "/0".

Angus - above warning only relates to WinPcap 3.0 and earlier
with WinPcap 3.1 and later only ASCII is returned

Returns:
If the function succeeds, the return value is nonzero. If the return value is zero, BufferSize contains the number of bytes that are needed to contain the adapter list.
Usually, this is the first function that should be used to communicate with the driver. It returns the names of the adapters installed on the system and supported by WinPcap. After the names of the adapters, pStr contains a string that describes each of them.
After a call to PacketGetAdapterNames pStr contains, in succession:

1 a variable number of ASCII (Unicode for 3.0 and earlier) strings, each with the
names of an adapter, separated by a "/0"
2 a double "/0"
3 a number of ASCII strings (for all versions), each with the description of an
adapter, separated by a "/0". The number of descriptions is the same of the one
of names. The fisrt description corresponds to the first name, and so on.
4 a double "/0".

}

//------------------------------------------------------------------------------
// LPADAPTER PacketOpenAdapter(LPTSTR AdapterName)
//------------------------------------------------------------------------------
PacketOpenAdapter: Function (AdapterName:pchar) : PAdapter; cdecl ;
{
This function receives a string containing the name of the adapter to open and
returns the pointer to a properly initialized ADAPTER object. The names of the
adapters can be obtained calling the PacketGetAdapterNames function.

Note: as already said, the Windows 95 version of the capture driver works with
the ASCII format, the Windows NT version with UNICODE. Therefore, AdapterName
should be an ASCII string in Windows 95, and a UNICODE string in Windows NT.
This difference is not a problem if the string pointed by AdapterName was
obtained through the PacketGetAdapterNames function, because it returns the
names of the adapters in the proper format. Instead, some problems can arise
in Windows NT if the string is obtained from ANSI C functions like scanf,
because they use the ASCII format. This can be a relevant problem when porting
command-line applications from UNIX. To avoid it, we included in the Windows NT
version of PacketOpenAdapter a routine to convert strings from ASCII to UNICODE.
PacketOpenAdapter in Windows NT accepts both the ASCII and the UNICODE format.
If a ASCII string is received, it is converted to UNICODE before being passed
to the driver.
}

//------------------------------------------------------------------------------
// VOID PacketCloseAdapter(LPADAPTER lpAdapter)
//------------------------------------------------------------------------------
PacketCloseAdapter: Procedure (pAdapter:padapter); cdecl ;
{
This function deallocates the ADAPTER structure lpAdapter, and closes the
adapter pointed by it.
}

//------------------------------------------------------------------------------
// LPPACKET PacketAllocatePacket(void)
//------------------------------------------------------------------------------
PacketAllocatePacket: Function: PPacket; cdecl ;
{
Allocates a PACKET structure and returns a pointer to it. The structure
returned must be properly initialized by calling the PacketInitPacket function.

Warning: The Buffer field of the PACKET structure is not set by this function.
The buffer must be allocated by the programmer, and associated to the PACKET
structure with a call to PacketInitPacket.
}

//------------------------------------------------------------------------------
// VOID PacketInitPacket(LPPACKET lpPacket, PVOID Buffer, UINT Length)
//------------------------------------------------------------------------------
PacketInitPacket: Procedure (pPacket:ppacket;Buffer:pointer;Length:LongWord); cdecl;
{
It initializes a structure PACKET. There are three input parameters:

* a pointer to the structure to initialize
* a pointer to the user-allocated buffer that will contain the packet data
* length of the buffer. This is the maximum length that will be transferred in a
single read from the driver to the application.

Note: The dimension of the buffer associated with the PACKET structure is a
parameter that can sensibly influence the performances of the capture process.
This buffer will in fact receive the packets from the packet capture driver.
The driver is able to collect data from several packets, returning it with only
one read call (see the PacketReceivePacket function). The number of packets
that the driver can transfer to the application in a single call with this
method is limited only by the dimension of the buffer associated with the
PACKET structure used to perform the reading. Therefore setting a big buffer
with PacketInitPacket can throw down the number of system calls, improving the
capture speed. Notice also that, when the application performs a
PacketReceivePacket, it is usually NOT blocked until the buffer associated with
the PACKET structure full. The driver copies the data present in its buffer,
but awakes the application without filling its buffer if it has not enough data
at the moment. In this way, also with big buffers, the application works
efficiently when the data rate on the network is low.
}


//------------------------------------------------------------------------------
// VOID PacketFreePacket(LPPACKET lpPacket)
//------------------------------------------------------------------------------

PacketFreePacket: Procedure( pPacket:ppacket); cdecl ;
{
This function frees the PACKET structure pointed by lpPacket.

Warning: The Buffer field of the PACKET structure is not deallocated by this
function, and must be deallocated by the programmer.
}

//------------------------------------------------------------------------------
// BOOLEAN PacketReceivePacket(LPADAPTER AdapterObject, LPPACKET lpPacket,
// BOOLEAN Sync)
//------------------------------------------------------------------------------
PacketReceivePacket: Function (AdapterObject:padapter;pPacket:pPacket;
Sync:Boolean):Longbool; cdecl ;

{
This function performs the capture of a set of packets. It has the following
input parameters:

* a pointer to an ADAPTER structure identifying the network adapter from which
the packets must be captured
* a pointer to a PACKET structure that will contain the packets
* a flag that indicates if the operation will be done in a synchronous or
asynchronous way. If the operation is synchronous, the function blocks the
program, returning only when the it is completed. If the operation is
asynchronous, the function doesn抰 block the program, and the PacketWaitPacket
procedure must be used to verify the correct completion.

The number of packets received with this function cannot be known before the
call and can vary a lot. It depends on the number of packets actually stored in
the driver抯 buffer, on the size of these packets, and on the size of the buffer
associated with the lpPacket parameter. Figure 3.1 shows the method used by the
driver in order to send the packets to the application.

[BPF_HDR]
[ DATA ]
[PADDING]
[BPF_HDR]
[ DATA ]
[PADDING]

Figure 3.1: method used to encode the packets

Packets are stored in the buffer associated with the lpPacket PACKET structure.
Each packet has a trailer consisting in a bpf_hdr structure that defines its
length and holds its timestamp. At the end of the packet there is a padding
used to word-align the data in the buffer (to increase the speed of the copies).
In order to extract the packets from the buffer the bh_datalen and bh_hdrlen of
the bpf_hdr structures should be used. An example can be seen in the sample
application provided in the developer's pack, or in the pcap_read() function in
the pcap-win32.c file (that can be found in the source distribution). Pcap
extracts correctly each incoming packet before passing it to the application,
so an application that uses it will not have to do this operation.
}

//------------------------------------------------------------------------------
// BOOLEAN PacketWaitPacket(LPADAPTER AdapterObject, LPPACKET lpPacket)
//------------------------------------------------------------------------------
PacketWaitPacket: Function (AdapterObject:padapter;lpPacket:ppacket):LongBool; cdecl ;
{
This function is used to verify the completion of an I/O operation on the
packet capture driver. It is blocking if the operation has still to be
completed by the driver. The return value is TRUE if the operation was
successful, FALSE otherwise, and the SDK GetLastError function can be used in
order to retrieve the error code.
}



//------------------------------------------------------------------------------
// BOOLEAN PacketSendPacket(LPADAPTER AdapterObject, LPPACKET pPacket, BOOLEAN Sync)
//------------------------------------------------------------------------------
PacketSendPacket: Function ( AdapterObject:padapter;pPacket:pPacket;Sync:boolean)
:Longbool ;cdecl ;

{This function is used to send a packet to the network through the adapter
specified with the AdapterObject parameter. It has the same syntax of the
PacketReceivePacket function. This function can be used to send only a packet
at a time and the user will not have to put a bpf_hdr header before it.
}

//------------------------------------------------------------------------------
// BOOLEAN PacketResetAdapter(LPADAPTER AdapterObject)
//------------------------------------------------------------------------------
PacketResetAdapter: Function ( AdapterObject:padapter):Longbool; cdecl ;
{
It resets the adapter passed as input parameter. Returns TRUE if the operation
is performed successfully.
}




//------------------------------------------------------------------------------
// BOOLEAN PacketSetHwFilter(LPADAPTER AdapterObject, ULONG Filter)
//------------------------------------------------------------------------------
PacketSetHwFilter: Function( AdapterObject:pointer;Filter:Longword):Longbool; cdecl ;
{
This function sets a hardware filter on the incoming packets. The constants
that define the filters are declared in the file ntddndis.h. The input
parameters are the adapter on which the filter must be defined, and the
identifier of the filter. The value returned is TRUE if the operation was
successful. Here is a list of the most useful filters:

NDIS_PACKET_TYPE_PROMISCUOUS: set the promiscuous mode. Every incoming packet is
accepted by the adapter.
NDIS_PACKET_TYPE_DIRECTED : only the packets destined to the adapter are
accepted.
NDIS_PACKET_TYPE_BROADCAST : only the broadcast packets are accepted.
NDIS_PACKET_TYPE_MULTICAST : only the multicast packets belonging to the groups
of which this adapter is a member are accepted.
NDIS_PACKET_TYPE_ALL_MULTICAST: every multicast packet is accepted
}


//------------------------------------------------------------------------------
// BOOLEAN PacketRequest(LPADAPTER AdapterObject,BOOLEAN Set, PPACKET_OID_DATA
// OidData)
//------------------------------------------------------------------------------
PacketRequest: Function ( AdapterObject:padapter;isSet:Longbool;OidData:
PPacket_oid_data ):Longbool;cdecl ;

{This function is used to perform a query/set operation on the adapter pointed
by AdapterObject. The second parameter defines if the operation is a set
(set=1) or a query (set=0). The third parameter is a pointer to a
PACKET_OID_DATA structure (see the section on the data structures).
The return value is true if the function is completed without errors.
The constants that define the operations are declared in the file ntddndis.h.
More details on the argument can be found in the documentation provided with
the DDK.

NOTE: not all the network adapters implement all the query/set functions.
There is a set of mandatory OID functions that is granted to be present on all
the adapters, and a set of facultative functions, no provided by all the
adapters (see the DDKs to see which functions are mandatory). If you use a
facultative function, please be careful and enclose it in an if statement to
check the result.
}


//------------------------------------------------------------------------------
//BOOLEAN PacketSetBuff(LPADAPTER AdapterObject, int dim)
//------------------------------------------------------------------------------
PacketSetBuff: Function (AdapterObject: Padapter;dim:integer) : Longbool; cdecl ;

{This function is used to set a new dimension of the driver抯 circular buffer
associated with the adapter pointed by AdapterObject. dim is the new dimension
in bytes. The function returns TRUE if successfully completed, FALSE if there
is not enough memory to allocate the new buffer. When a new dimension is set,
the data in the old buffer is discarded and the packets stored in it are lost.

Note: the dimension of the driver抯 buffer affects HEAVILY the performances of
the capture process. In fact, a capture application needs to make operations on
each packet while the CPU is shared with other tasks. Therefore the application
should not be able to work at network speed during heavy traffic or bursts,
especially in presence of high CPU load due to other applications. This problem
is more noticeable on slower machines. The driver, on the other hand, runs in
kernel mode and is written explicitly to capture packets, so it is very fast
and usually does not loose packets. Therefore, an adequate buffer in the driver
to store the packets while the application is busy can compensate the slowness
of the application and can avoid the loss of packets during bursts or high
network activity. When an instance of the driver is opened the dimension of the
buffer is set to 0. The programmer must remember to set it to a proper value.

Libpcap calls this functions and sets the buffer size to 1MB. Therefore programs
written using libpcap usually do not need to cope with this problem.
}


//------------------------------------------------------------------------------
// BOOLEAN PacketSetBpf(LPADAPTER AdapterObject, struct bpf_program *fp)
//------------------------------------------------------------------------------
PacketSetBpf: Function ( AdapterObject:padapter;fp:pbpf_program):Longbool; cdecl;

{This function associates a new BPF filter with the adapter AdapterObject.
The filter, pointed by fp, is a set of instructions that the BPF
register-machine of the driver will execute on each packet. Details can be
found into the chapter on the driver, or in [McCanne and Jacobson 1993].
This function returns TRUE if the driver is set successfully, FALSE if an
error occurs or if the filter program is not accepted. The driver performs a
check on every new filter in order to avoid system crashes due to bogus or
buggy programs, and it rejects the invalid filters.

If you need to create a filter, use the pcap_compile function of libpcap.
It converts a text filter with the syntax of WinDump (see the manual of
WinDump for more details) into a BPF program. If you don't want to use libpcap,
but you need to know the code of a filter, launch WinDump with the -d or -dd
or -ddd parameters.
}

//------------------------------------------------------------------------------
// BOOLEAN PacketGetStats(LPADAPTER AdapterObject, struct bpf_stat *s)
//------------------------------------------------------------------------------
PacketGetStats: Function ( AdapterObject:padapter;s: Pbpf_stat):Longbool; cdecl;

{With this function, the programmer can know the value of two internal variables
of the driver:

* the number of packets that have been received by the adapter AdapterObject,
starting at the time in which it was opened.
* the number of packets received by the adapter but that have been dropped by
the kernel. A packet is dropped when the application is not ready to get it
and the buffer associated with the adapter is full.

The two values are copied by the driver in a bpf_stat structure (see section 3
of this manual) provided by the application. These values are very useful to
know the situation of the network and the behavior of the capture application.
They are also very useful to tune the capture stack and to choose the
dimension of the buffers. In fact:

a high value of the bs_recv variable means that there is a lot of traffic on the
network. If the application doesn抰 need all the packets (for example a monitor
application may want to capture only the traffic generated by a particular
protocol, or by a single host), it is better to set a selective BPF filter,
to minimize the number of packets that the application has to process. Since
the filter works at kernel level, an appropriate filter increases the
performances of the application and decreases the load on the system. In
this way a non interesting packet does not need to be transferred from kernel
to user space, avoiding the memory copy and the context switch between kernel
and user mode.
If bs_drop is greater than zero, the application is too slow and is loosing
packets. The programmer can try, as a first solution, to set a greater buffer
in the driver with the PacketSetBuff function. A proper dimension of the buffer
often decreases dramatically the packet loss. Another solution is to speed up
the capture process associating a bigger buffer with the PACKET structure used
in the PacketReceivePacket call (see the PacketInitPacket function). This
decreases the number of system calls, improving the speed.
If the application keeps on loosing packets, probably it should be rewritten or
optimized. The driver is already very fast, and probably it is better to modify
the application than the driver, where the main optimization that can be done
is the implementation of the word-alignment.
}

//------------------------------------------------------------------------------
// BOOLEAN PacketGetNetType (LPADAPTER AdapterObject,NetType *type)
//------------------------------------------------------------------------------
PacketGetNetType: Function (AdapterObject:padapter; nettype:pnet_Type):LongBool; cdecl;
{Returns the type of the adapter pointed by AdapterObject in a NetType structure.
The LinkType of the type paramter can be set to one of the following values:

NdisMedium802_3: Ethernet (802.3)
NdisMedium802_5: Token Ring (802.5)
NdisMediumFddi: FDDI
NdisMediumWan: WAN
NdisMediumLocalTalk: LocalTalk
NdisMediumDix: DIX
NdisMediumArcnetRaw: ARCNET (raw)
NdisMediumArcnet878_2: ARCNET (878.2)
NdisMediumWirelessWan: Various types of NdisWirelessXxx media.
The LinkSpeed field indicates the speed of the network in Bits per second.

The return value is TRUE if the operation is performed successfully.
}

//------------------------------------------------------------------------------
// BOOLEAN PacketGetNetType (LPADAPTER AdapterObject,NetType *type)
//------------------------------------------------------------------------------
PacketSetReadTimeout: Function (AdapterObject:padapter;timeout:integer):boolean; cdecl;
{Sets the timeout value for the given adapter. }

//------------------------------------------------------------------------------
// PCHAR PacketGetDriverVersion ( ) 3.1 and later
//------------------------------------------------------------------------------
PacketGetDriverVersion: function: PChar ; cdecl;

{ Return a string with the version of the NPF.sys device driver.
Returns:
A char pointer to the version of the driver. }

//------------------------------------------------------------------------------
// PCHAR PacketGetVersion ( )
//------------------------------------------------------------------------------
PacketGetVersion: function: PChar ; cdecl;

{ Return a string with the dll version.
Returns:
A char pointer to the version of the library. }

//------------------------------------------------------------------------------
// BOOLEAN PacketGetNetInfoEx ( PCHAR AdapterName, npf_if_addr * buffer, PLONG NEntries )
//------------------------------------------------------------------------------
PacketGetNetInfoEx: function (AdapterName: PChar; Buffer: Pnpf_if_addr;
NEntries: PInteger): boolean ; cdecl ;
//PacketGetNetInfoEx: function (AdapterName: PChar; Buffer: PChar; NEntries: integer): boolean ; cdecl ;

{ Returns comprehensive information the addresses of an adapter.
Parameters:
AdapterName String that contains the name of the adapter.
buffer A user allocated array of npf_if_addr that will be filled by the function.
NEntries Size of the array (in npf_if_addr).

Returns:
If the function succeeds, the return value is nonzero.
This function grabs from the registry information like the IP addresses,
the netmasks and the broadcast addresses of an interface. The buffer passed
by the user is filled with npf_if_addr structures, each of which contains the
data for a single address. If the buffer is full, the reaming addresses are dropped,
therefore set its dimension to sizeof(npf_if_addr) if you want only the first address. }

//------------------------------------------------------------------------------
// BOOLEAN PacketSetMinToCopy ( LPADAPTER AdapterObject, int nbytes )
//------------------------------------------------------------------------------
PacketSetMinToCopy: function (AdapterObject: Padapter ; nbytes: integer): boolean ; cdecl ;

{ Defines the minimum amount of data that will be received in a read.

Parameters:
AdapterObject Pointer to an _ADAPTER structure
nbytes the minimum amount of data in the kernel buffer that will cause the driver
to release a read on this adapter.

Returns:
If the function succeeds, the return value is nonzero.
In presence of a large value for nbytes, the kernel waits for the arrival of several
packets before copying the data to the user. This guarantees a low number of system
calls, i.e. lower processor usage, i.e. better performance, which is a good setting
for applications like sniffers. Vice versa, a small value means that the kernel will
copy the packets as soon as the application is ready to receive them. This is suggested
for real time applications (like, for example, a bridge) that need the better
responsiveness from the kernel.
note: this function has effect only in Windows NTx. The driver for Windows 9x doesn't
offer this possibility, therefore PacketSetMinToCopy is implemented under these systems
only for compatibility. }


//------------------------------------------------------------------------------
// INT PacketSetSnapLen ( LPADAPTER AdapterObject, int snaplen ) 3.1 and later
//------------------------------------------------------------------------------
PacketSetSnapLen: function (AdapterObject: Padapter ; snaplen: integer): integer ; cdecl ;

{ Sets the snap len on the adapters that allow it.
Parameters:
AdapterObject Pointer to an _ADAPTER structure.
snaplen Desired snap len for this capture.

Returns:
If the function succeeds, the return value is nonzero and specifies the actual snaplen
that the card is using. If the function fails or if the card does't allow to set snap
length, the return value is 0.
The snap len is the amount of packet that is actually captured by the interface and
received by the application. Some interfaces allow to capture only a portion of any
packet for performance reasons.

Note:
: the return value can be different from the snaplen parameter, for example some
boards round the snaplen to 4 bytes. }

PacketSetNumWrites:function (AdapterObject: Padapter ;nwrites:Integer):Boolean;cdecl;


//------------------------------------------------------------------------------





var
PacketDllModule: THandle;
function LoadPacketDll: Boolean;

implementation

function LoadPacketDll: Boolean;
begin
Result := True;
if PacketDllModule <> 0 then Exit;

// open DLL
PacketDllModule := LoadLibrary (DLL);
if PacketDllModule = 0 then
begin
Result := false;
exit ;
end ;
PacketGetAdapterNames := GetProcAddress (PacketDllModule, 'PacketGetAdapterNames') ;
PacketOpenAdapter := GetProcAddress (PacketDllModule, 'PacketOpenAdapter') ;
PacketCloseAdapter := GetProcAddress (PacketDllModule, 'PacketCloseAdapter') ;
PacketAllocatePacket := GetProcAddress (PacketDllModule, 'PacketAllocatePacket') ;
PacketInitPacket := GetProcAddress (PacketDllModule, 'PacketInitPacket') ;
PacketFreePacket := GetProcAddress (PacketDllModule, 'PacketFreePacket') ;
PacketReceivePacket := GetProcAddress (PacketDllModule, 'PacketReceivePacket') ;
PacketWaitPacket := GetProcAddress (PacketDllModule, 'PacketWaitPacket') ;
PacketSendPacket := GetProcAddress (PacketDllModule, 'PacketSendPacket') ;
PacketResetAdapter := GetProcAddress (PacketDllModule, 'PacketResetAdapter') ;
PacketSetHwFilter := GetProcAddress (PacketDllModule, 'PacketSetHwFilter') ;
PacketRequest := GetProcAddress (PacketDllModule, 'PacketRequest') ;
PacketSetBuff := GetProcAddress (PacketDllModule, 'PacketSetBuff') ;
PacketSetBpf := GetProcAddress (PacketDllModule, 'PacketSetBpf') ;
PacketGetStats := GetProcAddress (PacketDllModule, 'PacketGetStats') ;
PacketGetNetType := GetProcAddress (PacketDllModule, 'PacketGetNetType') ;
PacketSetReadTimeout := GetProcAddress (PacketDllModule, 'PacketSetReadTimeout') ;
PacketGetVersion := GetProcAddress (PacketDllModule, 'PacketGetVersion') ;
PacketGetNetInfoEx := GetProcAddress (PacketDllModule, 'PacketGetNetInfoEx') ;
PacketSetMinToCopy := GetProcAddress (PacketDllModule, 'PacketSetMinToCopy') ;
PacketGetDriverVersion := GetProcAddress (PacketDllModule, 'PacketGetDriverVersion') ; // 3.1 and later
PacketSetSnapLen := GetProcAddress (PacketDllModule, 'PacketSetSnapLen') ; // 3.1 and later
PacketSetNumWrites := GetProcAddress (PacketDllModule, 'PacketSetNumWrites') ;
end;

initialization
PacketDllModule := 0 ;
finalization
if PacketDllModule <> 0 then
begin
FreeLibrary (PacketDllModule) ;
PacketDllModule := 0 ;
end ;
end.


//////////////////////////////////////////////////////////////
//////////////// /////////////////////
//////////////// ARP格式定义 //////////////////////
/////////////// /////////////////////
//////////////////////////////////////////////////////////////
unit ARPPacket;

interface
uses Windows,Classes,StrUtils,SysUtils,IpExport,IpHlpApi ,IpIfConst ,IpRtrMib ,IPTypes,WinSock2;
{*************************************************************************************

ARP包结构:
-------------------------------------------
以太网 | 以太网 | 帧 | 硬件 | 协议| 硬件 | 协议 | OP| 发送端 |发送端|目的以太|目的

目的地址| 源地址 | 类型| 类型 | 类型| 长度 | 长度 | |以太网地址| IP |网地址 | IP
-------------------------------------------
6 6 2 2 2 1 1 2 6 4 6 4

|<---以太网首部------->|<--------------------28字节的ARP请求/应答---------------->|

*************************************************************************************}


{
硬件类型字段指明了发送方想知道的硬件接口类型,以太网的值为1.
协议类型字段指明了发送方提供的高层协议类型,IP为0806(16进制)。
硬件地址长度和协议长度指明了硬件地址和高层协议地址的长度.
操作字段用来表示这个报文的目的,ARP请求为1,ARP响应为2,RARP请求为3,RARP响应为4。
}

const
HardWareType_Ether=$0001; //硬件接口类型,以太网的值为1
//HardWareType_xx=$xx
//...

FrameType=$0806; //帧类型。 arp=0x0806,rarp=0x8035 。
ProtoType_IP=$0800; //高层协议类型,IP为0800(16进制)。
//ProtoType_UDP=$xx;
//ProtoType_TCP=$xx;
//...

HardWare_Len=$06; //硬件地址长度
MACAddr_Len=HardWare_Len;
Proto_Len=$04; //协议长度

Op_ARP_Request=$0001; //ARP请求
Op_ARP_Response=$0002; //ARP响应
Op_RARP_Request=$0003; //RARP请求
Op_RARP_Response=$0004; //RARP响应

Broadcast_Mac_Addr='FF-FF-FF-FF-FF-FF'; //ARP广播地址

type

//以太网地址
TEtherHardAddr=array[0..5]of Byte;


//开始构造ARP数据包。
//首先构造&quot;以太网首部&quot;
TEtherHeader=packed record
Ether_Dest:TEtherHardAddr; //以太网目的地址
Ether_Src:TEtherHardAddr; //以太网源地址
Frame_Type:Word; //帧类型
end;
TARPHeader=TEtherHeader;

//构造”28字节的ARP请求/应答“
TRequestResponse=packed record
HardAddrType:Word; //硬件类型
ProtoAddrType:Word; //协议类型
HardAddr_Len:Byte; //硬件地址长度
ProtoAddr_Len:Byte; //协议地址长度
Operation:Word; //操作. ARP/RARP.
Sender_Hard_Addr:TEtherHardAddr; //发送端以太网地址
Sender_IP:LongWord; //发送端IP
Dest_Hard_Addr:TEtherHardAddr; //目的以太网地址
Dest_IP:LongWord; //目的IP
end;
TARPData=TRequestResponse;
PARPData=^TARPData;

//构造ARP包
PARPPacket=^TARPPacket;
TARPPacket=packed record
Header:TARPHeader;
RequestResponse:TARPData;

Padding:array[0..17]of byte; //填充. 因为以太网每帧至少60 Byte。
end;

//定义ARP包的操作字段。
TARPOperation=(aoArpRequest,aoARPResponse,aoRARPRequest,aoRARPResponse);

//==========================================================
TMIBIfArray = array of TMIBIFRow;


//==========================================================

TMacAddrOperation=class
public
class function Str2MacAddr(StrMac:string):TEtherHardAddr;
class function MacAddr2Str(Addr:TEtherHardAddr):string;
class function GetLocaleMAC:TEtherHardAddr;
end;
implementation

uses
IdGlobal ;


//====================================Global===============================
function StrToTInAddr(IP:String):TInAddr; //点分结构的IP转换成TInAddr结构
begin
Result.S_un_b.s_b1:=Byte(StrToInt(Fetch(IP,'.')));
Result.S_un_b.s_b2:=Byte(StrToInt(Fetch(IP,'.')));
Result.S_un_b.s_b3:=Byte(StrToInt(Fetch(IP,'.')));
Result.S_un_b.s_b4:=Byte(StrToInt(Fetch(IP,'.')));
end;

function TInAddrToStr(Addr:TInAddr):string; //TInAddr结构的IP转换成点分结构
begin
Result:=IntToStr(byte(Addr.S_un_b.s_b1));
Result:=Result+'.';
Result:=Result+ IntToStr(byte(Addr.S_un_b.s_b2));
Result:=Result+'.';
Result:=Result+ IntToStr(byte(Addr.S_un_b.s_b3));
Result:=Result+'.';
Result:=Result+ IntToStr(byte(Addr.S_un_b.s_b4));
end;

procedure Get_IfTableMIB( var MIBIfArray: TMIBIfArray ); //获得硬件接口(网卡)信息
var
i,
Error,
TableSize : Cardinal;
pBuf : PChar; //PMIB_IFTABLE;
NumEntries : DWORD;
sDescr,
Temp : string;
begin
TableSize := 0;
// first call: get memsize needed
Error := GetIfTable(PMIB_IFTABLE(pBuf) , TableSize, LongBool(false) );
if Error<>ERROR_INSUFFICIENT_BUFFER then
EXIT;
GetMem(pBuf,TableSize);

// get table pointer
Error:=GetIfTable( PMib_IfTable(pBuf),TableSize,false);
if Error=NO_ERROR then
begin
NumEntries := PMib_IfTable(pBuf)^.dwNumEntries;
if NumEntries > 0 then
begin
SetLength( MIBIfArray, NumEntries );
inc(pBuf, SizeOf( NumEntries));
for i := 0 to pred(NumEntries) do
begin
MIBIfArray := PMibIfRow(pBuf)^;
inc(pBuf,SizeOf(TMIBIfRow));
end;
end
end;
dec(pBuf,SizeOf(DWORD)+NumEntries*SizeOf(TMIBIfRow));
FreeMem( pBuf );
end;


{ TMacAddrOperation }

class function TMacAddrOperation.GetLocaleMAC: TEtherHardAddr;
var
MibArr : TMIBIfArray;
I:Integer;
begin
Get_IfTableMIB( MibArr ); // get current MIB data
if (Length(MibArr) > 0) then
{$R-}
for I:=0 to MibArr[0].dwPhysAddrLen-1 do Result:= MIBArr[0].bPhysAddr
{$R+}
else
FillChar(Result[0],Length(Result),0);
end;

class function TMacAddrOperation.MacAddr2Str(Addr: TEtherHardAddr): string;
var
I:Integer;
begin
Result:='';
for I:=Low(Addr) to High(Addr) do
Result:=Result+InttoHex(ADDR,2)+'-';
Delete(Result,Length(Result),1);
end;

class function TMacAddrOperation.Str2MacAddr(
StrMac: string): TEtherHardAddr;
var
I:Integer;
Section:string;
begin
StrMac:=StrPas(StrUpper(PAnsiChar(StrMac)));
StrMac:=Trim(StrMac);
for I:=0 to 4 do
begin
Section:=Fetch(StrMac,'-');
Result:=Byte(StrToInt('$'+Section));
end;
Result[5]:=Byte(StrToInt('$'+StrMac));
end;

end.


/////////////////////////////////////////////////
//////////////// Pcap ////////////////////
////////////////////////////////////////////////
unit Pcap;

interface
uses windows,
Ndis_def,
bpf,
sysutils, // formatting tools. Could use FormatMessage,but is more complex
classes,
winsock,
Packet32, // This is what we wrap

ARPPacket, //Added by wp.
packhdrs; //Added by wp.

const
PCAP_ERRBUF_SIZE = 256; //String size of error descriptions
PcapBufSize = 256000; //Dimension of the buffer in TPcap


// [taken from interface.h]

DEFAULT_SNAPLEN = 68; //The default snapshot length.
//This value allows most printers to
//print useful information while keeping
//the amount of unwanted data down.In
//particular, it allows for an ethernet
//header, tcp/ip header, and 14 bytes of
//data (assuming no ip options).


type
TWinVersion = (wv_WinS,
wv_Win9x, //Added by Lars Peter Christiansen.
wv_WinNT, //Eases the process of determing the
wv_Win2000, //platform and do proper instructions
wv_WinXP, //I.e : Char vs. WideChar issue
wv_Unknown );



PPcap_Stat = ^TPcap_stat;
Tpcap_stat = record
ps_recv, //* number of packets received */
ps_drop, //* number of packets dropped */
ps_ifdrop : LongWord; //* drops by interface not supported */
end;

TPcap_sf = record // Save file for offline reading.
rfile : HFILE;
swapped:integer;
version_major : integer;
Version_Minor : integer;
base : Pointer;
end;

TPcap_md = record
Stat : TPcap_stat;
use_bpf : integer;
TotPkts : LongWord; // Can owerflow after 79hours on ethernet
TotAccepted:LongWord; // accepted by filter/sniffer
TotDrops : LongWord; // dropped packets
TotMissed: Longword; // missed by i/f during this run
OrigMissed:LongWord; // missed by i/f before this run
end;

PPcap_PktHdr = ^Tpcap_pkthdr; // Wrapped Drivers packetHeader
TPcap_pkthdr = record
ts : TUnixTimeVal; // Time of capture
CapLen, // captured length
Len : Integer; // actual length of packet
end;

PPcap = ^TPcap; // THE MAIN INTERFACE HANDLE
TPcap = record // used with allmost all Pcap calls.
Adapter:padapter;
Packet :pPacket; // Global Driver packet. kind of a buffer
snapshot:integer;
linktype:integer; // Type and speed of net
tzoff :integer; // timezone offset
offset :integer;
sf :Tpcap_sf; // Save file
md :Tpcap_md; // Diagnostics
//READ BUFFER
bufsize :integer;
buffer :pointer; //*u_char
bp :pointer; //*u_char
cc :integer;
//Place holder for pcap_next().
pkt :pointer; //*U_char
//Placeholder for filter code if bpf not in kernel.
fcode :Tbpf_program;
errbuf : array [0..PCAP_ERRBUF_SIZE-1] of char; //Last error message
end;


// Callback procedure
Ppcap_handler =^Tpcap_handler;
Tpcap_handler = procedure(User:pointer;const Header:ppcap_pkthdr;const Data:pchar);

// array of IP addresses
IPAddrArray = array of TInAddr ;

// a MAC address
TMacAddr = array [0..5] of byte ;

function pcap_open_live(Device:String;SnapLen:LongWord;Promisc:boolean;
To_ms:integer;var errstr:String) : ppcap;
function pcap_read(p:pPcap;cnt:integer;CallBack:Tpcap_handler;User:pointer) :integer;
function pcap_stats (P: pPcap;ps:pPcap_stat) : integer;
function pcap_setbuff (p : Ppcap;dim:integer) : integer;
procedure pcap_close (var p : ppcap);
function pcap_lookupdev(var ErrStr:string) : pchar;
function pcap_loop(P:ppcap;cnt:integer;Callback:Tpcap_handler;user:pointer):integer;
function pcap_datalink(P:pPcap) : integer;
function pcap_getwinversion(var verstr:string) : Twinversion;
function Pcap_getAdapternames(Delimiter:char;var ErrStr:string):string;
function Pcap_GetAdapternamesEx (NameList, DescList: TStringList; var ErrStr:string):integer;
function Pcap_GetDriverVersion: string ;
function Pcap_GetPacketVersion: string ;
function Pcap_GetIPAddresses (AdapterName: string ; var IPArray, MaskArray,
BcastArray: IPAddrArray; var ErrStr:string): integer ;
function Pcap_SetMinToCopy (P: pPcap ; nbytes: integer) : integer;
function Pcap_GetMacAddress (P: pPcap; var ErrStr:string): TMacAddr ;

//added by wp
function pcap_SendARPPacket(P: pPcap;SrcIP,DstIP,SrcMac,DstMac:string;Retries:Integer;IsRequest:Boolean):Boolean;
function pcap_ExtratARPPacket():Boolean;


implementation


//------------------------------------------------------------------------------
// pcap_t *pcap_open_live(char *device, int snaplen, int promisc,
// int to_ms, char *ebuf)
//------------------------------------------------------------------------------
function pcap_open_live(Device:String;SnapLen:LongWord;Promisc:boolean;
To_ms:integer;var errstr:String) : ppcap;
var
P : Ppcap;
NetType : Tnet_type;
S : Pchar;

procedure CleanUp;
begin
if P.adapter<>nil then PacketCloseAdapter(P.adapter);
if P.buffer<>nil then FreeMem(P.buffer,PcapBufSize);
Freemem(P,SizeOf(Tpcap));

end;
begin
result :=nil;
if NOT LoadPacketDll then
begin
ErrStr := 'Cannot load packet.dll';
exit;
end;

// CREATE PCAP OBJECT

GetMem(P,SizeOf(Tpcap));
if P=nil then
begin
ErrStr := 'Cannot allocate pcap object';
exit;
end;
FillChar(p^,sizeof(Tpcap),0);
P.Adapter := nil;

// CREATE ADAPTER OBJECT
GetMem(S,2048); // Making temporary pchar
StrPCopy(S,Device);
P.Adapter := PacketOpenAdapter(S);
FreeMem(S,2048);
if P.Adapter = nil then
begin
ErrStr := 'Cannot Open Adapter &quot;'+Device+'&quot;';
CleanUp;
exit;
end;


// SET FILTER MODE
if Promisc then
begin
if not PacketSetHWFilter(P.adapter,NDIS_PACKET_TYPE_PROMISCUOUS) then
Begin
ErrStr:= 'Cannot set Device Filter to Promiscuous mode';
cleanup;
exit;
end;
end else if not PacketSetHWFilter(P.adapter,NDIS_PACKET_TYPE_DIRECTED) then
begin
ErrStr:= 'Cannot set Device Filter to Directed mode';
cleanup;
exit;
end;

// GET NETCARD SPEED AND TYPE
if not PacketGetNetType(P.Adapter,@Nettype) then
Begin
ErrStr := 'Cannot determine network type and speed';
Cleanup;
exit;
end;

Case TNDIS_MEDIUM(nettype.LinkType) of

NdisMediumWan : P.linktype := DLT_PPP_WIN32;

NdisMedium802_3 : begin
if nettype.LinkSpeed = 100000000 then
p.linktype := DLT_EN100MB
else if nettype.LinkSpeed=10000000 then
p.linktype := DLT_EN10MB
else p.linktype:=DLT_PPP_WIN32;
end;
else p.linktype := DLT_EN10MB;
end;

// Allocate room for Link header

p.bufsize := PcapBufSize;
GetMem(p.buffer,PcapBufSize);
if P.buffer = nil then
begin
ErrStr := 'Cannot allocate Link Header space';
cleanup;
exit;
end;

if Assigned (PacketSetSnapLen) then
p.snapshot := PacketSetSnapLen(P.adapter, Snaplen) // Angus - added, actually set it for 3.1
else
p.snapshot := Snaplen ;

// Allocate Global Packet for capturing

p.packet := PacketAllocatePacket;
if p.packet = nil then
begin
ErrStr := 'Cannot allocate Global Packet Object';
cleanup;
exit;
end;
PacketInitPacket(p.Packet,p.buffer,p.bufsize);

// Allocate Driver Buffer
if not PacketSetBuff(p.adapter,DEFAULT_DRIVERBUFFER) then
begin
ErrStr := 'Not enough memory to allocate Driver buffer';
CleanUp;
exit;
end;

result := p;

end;


//------------------------------------------------------------------------------
//int pcap_read(pcap_t *p, int cnt, pcap_handler callback, u_char *user)
//
//------------------------------------------------------------------------------
function pcap_read( p:pPcap;cnt:integer;CallBack:Tpcap_handler;User:pointer)
: integer;
var cc : Longword;//Counter ?
n : integer;
bp,ep: pointer; //Begin and End Point ?
//bhp : Pbpf_hdr;//pointer to BPF header struct - removed by Lars Peter
hdrlen, //Length of Header
caplen: integer;//Length of captured
begin
if NOT LoadPacketDll then
begin
p.errbuf := 'Cannot load packet.dll';
result:=-1;
exit;
end;
cc := p.cc;
n := 0;

if p.cc = 0 then
begin

// *Capture the Packets*
if PacketReceivePacket(p.adapter,p.packet,TRUE)=false then
begin
// ERROR!
p.errbuf :='Read Error: PacketRecievePacket failed';
result:=-1;
exit;
end;
cc := p.packet.ulBytesReceived;

bp := p.buffer;

end else bp := p.bp;


// Loop through each packet.

ep := ptr(longword(bp)+cc); //move end pointer
while (longword(bp) < longword(ep) ) do
begin
caplen := Pbpf_hdr(bp).bh_caplen;
hdrlen := Pbpf_hdr(bp).bh_hdrlen;

// XXX A bpf_hdr matches apcap_pkthdr.

callback(user,
Ppcap_pkthdr(bp),
ptr(longword(bp)+longword(HdrLen)));

LongWord(bp) := LongWord(bp) + BPF_WORDALIGN(caplen + hdrlen);
inc(n);
if (n >= cnt)and(cnt>0) then
begin
p.bp := bp;
p.cc := longword(ep)-longword(bp);
result := n;
exit;
end;
end;

p.cc := 0;
result:=n;
end;


//------------------------------------------------------------------------------
// int pcap_stats(pcap_t *p, struct pcap_stat *ps)
//
//------------------------------------------------------------------------------
function pcap_stats(P: pPcap;ps:pPcap_stat) : integer;
var s:Tbpf_stat;
begin
if NOT LoadPacketDll then
begin
p.errbuf := 'Cannot load packet.dll';
result:=-1;
exit;
end;
if PacketGetStats(
P.Adapter,
@s) = false then
begin
P.errbuf := 'PacketGetStats error';
result := -1;
exit;
end;

ps.ps_recv := s.bs_recv;
ps.ps_drop := s.bs_drop;
result:= 0;
end;

//------------------------------------------------------------------------------
// int pcap_setbuff(pcap_t *p, int dim)
//
//------------------------------------------------------------------------------
function pcap_setbuff(p : Ppcap;dim:integer) : integer;
begin

if NOT LoadPacketDll then
begin
p.errbuf := 'Cannot load packet.dll';
result:=-1;
exit;
end;
if p=nil then
begin
result:=-2;
P.errbuf := 'invalid pcap handle';
exit;
end;

if PacketSetBuff(p.adapter,dim)=false then
begin
P.Errbuf := 'Driver error : Not enough memory to allocate buffer';
result := -1;
exit;
end;
result := 0;
end;


//------------------------------------------------------------------------------
// void pcap_close(pcap_t *p)
//
// Very simplified from the original
//------------------------------------------------------------------------------
procedure pcap_close(var p : ppcap);
begin

if NOT LoadPacketDll then exit ;
if p=nil then exit;
if p.Adapter<>nil then
begin
PacketCloseAdapter(p.adapter);
p.adapter:=nil;
end;

if p.buffer<>nil then
begin
FreeMem(P.buffer,p.bufsize);
p.buffer := nil;
end;
FreeMem(p,sizeof(Tpcap));
p:=nil;
end;



//------------------------------------------------------------------------------
//
// Following procedures is taken from inet.c part of Pcap
//
//------------------------------------------------------------------------------


//------------------------------------------------------------------------------
//int pcap_loop(pcap_t *p, int cnt, pcap_handler callback, u_char *user)
//------------------------------------------------------------------------------
{pcap_loop() is similar to pcap_dispatch() except it keeps reading
packets until cnt packets are processed or an error occurs. It does
not return when live read timeouts occur. Rather, specifying a
non-zero read timeout to pcap_open_live() and then calling
pcap_dispatch() allows the reception and processing of any
packets that arrive when the timeout occurs. A negative cnt
causes pcap_loop() to loop forever (or at least until an error
occurs).
}
function pcap_loop(P:ppcap;cnt:integer;Callback:Tpcap_handler;user:pointer):integer;
begin
result:=-1;
if NOT LoadPacketDll then
begin
p.errbuf := 'Cannot load packet.dll';
exit;
end;
if p=nil then exit;
while true do begin

if p.sf.rfile<>0 then
begin
result:= -1; //pcap_offline_read(p,cnt,callback,user);
exit;
end
else Repeat
// Keep reading until we get something(or get an error)
result := pcap_read(p,cnt,callback,user);
until result<>0;

if result<=0 then exit;

if cnt>0 then
begin
cnt:=cnt-result;
if cnt<=0 then
begin
result:=0;
exit;
end;
end;
end;
end;



//------------------------------------------------------------------------------
{int pcap_dispatch(pcap_t *p, int cnt, pcap_handler callback, u_char *user)}
//------------------------------------------------------------------------------
{pcap_dispatch() is used to collect and process packets. cnt
specifies the maximum number of packets to process before returning.
A cnt of -1 processes all the packets received in one buffer.
A cnt of 0 processes all packets until an error occurs, EOF is
reached, or the read times out (when doing live reads and a
non-zero read timeout is specified). callback specifies a routine
to be called with three arguments: a u_char pointer which is
passed in from pcap_dispatch(), a pointer to the pcap_pkthdr
struct (which precede the actual network headers and data),
and a u_char pointer to the packet data. The number of packets read
is returned. Zero is returned when EOF is reached in a
``savefile.'' A return of -1 indicates an error in which
case pcap_perror() or pcap_geterr() may be used to display the
error text.}

function pcap_dispatch(P :pPcap;cnt:integer;CallBack:Tpcap_handler;User:pointer)
:integer;
begin
if NOT LoadPacketDll then
begin
p.errbuf := 'Cannot load packet.dll';
result:=-1;
exit;
end;
if P.sf.rfile<>0 Then
result := -1//pcap_offline_read(p,cnt,callback,user)
else
result := pcap_read(p,cnt,callback,user)
end;


//------------------------------------------------------------------------------
//char * pcap_lookupdev(errbuf)
//------------------------------------------------------------------------------
//*
// * Return the name of a network interface attached to the system, or NULL
// * if none can be found. The interface must be configured up; the
// * lowest unit number is preferred; loopback is ignored.
//
function pcap_lookupdev(var ErrStr:string) : pchar;
var NameLength : integer;
AdapterNames : array[0..1024-1] of char;
WadapterNames: array[0..1024-1] of widechar;
i : integer;
AdapterName1 : Pchar;
pversion : string;
wideflag : boolean ;
// Ver : Twinversion;
begin
Result := Nil ;
if NOT LoadPacketDll then
begin
ErrStr:='Cannot load packet.dll';
exit;
end;
NameLength := 1024;
pversion := PacketGetVersion ; // of packet.dll
wideflag := false ;
if ((Length (pversion) > 3)) and (Win32Platform = VER_PLATFORM_WIN32_NT) then
begin
if pversion [1] = '2' then wideflag := true ;
if Pos ('3.0', pversion) = 1 then wideflag := true ;
end ;
// Ver := pcap_GetwinVersion(S);

// WINDOWS 95,98 or ME
// if (Ver=wv_Win9x) then // Angus
if NOT wideflag then
begin
GetMem(AdapterName1,NameLength);
PacketGetAdapterNames(AdapterNames,@NameLength);
i:=0;
While i<NameLength do
begin
if AdapterNames=' ' then AdapterName1:=#0
else AdapterName1:= AdapterNames;
if AdapterNames=#0 then break else inc(i);
end;

AdapterName1[i-1] := #0;
AdapterName1[i+1] := #0;
AdapterName1 := #0;

result := Adaptername1;
end
// WINDOWS NT,2000 or XP
Else{ if (ver=wv_winNT) or (ver=wv_win2000) or (ver=wv_winXP) then }
begin
Getmem(AdapterName1,1024*Sizeof(char));
PacketGetAdapterNames(Pchar(@wAdapterNames),@NameLength);

for i:=0 to NameLength-1 do
begin
if (Wadapternames=#0)and(wadapternames[i+1]=#0) then break;
AdapterName1 := char(wAdapterNames);
end;

result := adaptername1;
end;

end;

//------------------------------------------------------------------------------
// int pcap_datalink(pcap_t *p)
//------------------------------------------------------------------------------
// Returns the link type of the device
function pcap_datalink(P:pPcap) : integer;
begin
result := p.linktype;
end;


//------------------------------------------------------------------------------
// Get OS version // Added By Lars Peter
//------------------------------------------------------------------------------
function pcap_GetWinVersion(var VerStr:string) : TWinVersion;
var
OSversion:OSVERSIONINFO;
begin
OSversion.dwOSVersionInfoSize:=sizeof(OSVERSIONINFO);
result := wv_unknown;
if not GetVersionEx(osversion) then exit;

with OSversion do begin
Case dwPlatformId of
VER_PLATFORM_WIN32s:
begin
verStr:=Format('Windows %d.%d',[dwMajorVersion,dwMinorVersion]);
result:=Wv_wins;
end;
VER_PLATFORM_WIN32_WINDOWS:
begin
case dwMinorVersion of
0 : verstr := 'Windows 95';
10 : verstr := 'Windows 98';
90 : verstr := 'Windows Me';
end;
Result := Wv_win9x;
end;
VER_PLATFORM_WIN32_NT:
begin
if (dwMajorVersion=5)and (dwMinorVersion=0) then
begin
verstr:='Windows 2000';
if szCSDVersion<>'' then Verstr:=verstr+' with '+szCSDVersion;
result := wv_win2000;
end
else if (dwMajorVersion=5)and(dwMinorVersion=1) then
begin
verstr:=Format('Windows XP %s',[szCSDVersion]);
if szCSDVersion<>'' then Verstr:=verstr+' with '+szCSDVersion;
result := wv_winxp;
end
else if(dwMajorVersion<=4) then
begin
verstr:=Format('Windows NT %d.%d',[dwMajorVersion,dwMinorVersion]);
if szCSDVersion<>'' then Verstr:=verstr+' with '+szCSDVersion;
result:=wv_winNT;
end
else
//for newest windows version
verstr:=format('Windows %d.%d ',[dwMajorVersion,dwMinorVersion]);
end;
end;
end;
end;

//------------------------------------------------------------------------------
// Get All AdapterNames seperated with chosen delimiter // Added By Lars Peter
// angus - note this function does not return the adaptor friendly descriptions
//------------------------------------------------------------------------------
function Pcap_GetAdapternames(Delimiter:char;var ErrStr:string):string;
var
NameList : Array [0..(4096*2)-1] of char;
NameLength, i :Longword;
// Ver :Twinversion;
pversion : string;
wideflag : boolean ;
begin
result := '' ;
ErrStr := '' ;
if NOT LoadPacketDll then
begin
ErrStr:='Cannot load packet.dll';
exit;
end;
// Ver := pcap_GetwinVersion(S);
pversion := PacketGetVersion ; // of packet.dll
wideflag := false ;
if ((Length (pversion) > 3)) and (Win32Platform = VER_PLATFORM_WIN32_NT) then
begin
if pversion [1] = '2' then wideflag := true ;
if Pos ('3.0', pversion) = 1 then wideflag := true ;
end ;
NameLength := 4096;
FillChar (NameList, Sizeof(NameList), 0) ;
PacketGetAdapterNames(NameList,@NameLength);

// WINDOWS 95,98 or ME and all Windows for Winpcap 3.1 and later, 8bits per character
// if (Ver=wv_Win9x) or (Ver=wv_WinXP)then
if NOT wideflag then
begin
for i:=0 to NameLength-1 do
begin
if ((NameList=#0) and (NameList[i+1]=#0))then
break
else if {(NameList=' ') or} (NameList=#0) then // Angus - spaces allowed in names
NameList:=delimiter;
end;
result := NameList;
end

// WINDOWS NT,2000 or XP 16bits per character - only for Wincap 3.0 and earlier
Else
begin
for i:=0 to NameLength-1 do
begin
if (Pwidechar(@NameList)=#0) and (PwideChar(@namelist)[i+1]=#0) then
break
else if (Pwidechar(@NameList)=#0) then
PwideChar(@NameList):=WideChar(delimiter);
end;
result := WideCharToString(PWideChar(@NameList)) ;
end;

end;

//------------------------------------------------------------------------------
// Get All AdapterNames into two TStringLists, return total adaptors
// Added By Angus Robertson
//------------------------------------------------------------------------------
function Pcap_GetAdapternamesEx (NameList, DescList: TStringList; var ErrStr: string): integer ;
var
NameBuff : Array [0..4096-1] of char;
CurChar, CurName: PChar ;
CurWChar, CurWName: PWideChar ;
newname, pversion: string;
BuffLen: integer;
wideflag, descflag: boolean ;
begin
result := 0 ;
ErrStr := '' ;
if NOT LoadPacketDll then
begin
ErrStr:='Cannot load packet.dll';
exit;
end;
if (NOT Assigned (NameList)) or (NOT Assigned (DescList)) then
begin
ErrStr:='String List not intialised';
exit;
end;
NameList.Clear ;
DescList.Clear ;
BuffLen := 4096;
FillChar (NameBuff, BuffLen, 0) ;
pversion := PacketGetVersion ; // of packet.dll
wideflag := false ;
if ((Length (pversion) > 3)) and (Win32Platform = VER_PLATFORM_WIN32_NT) then
begin
if pversion [1] = '2' then wideflag := true ;
if Pos ('3.0', pversion) = 1 then wideflag := true ;
end ;
if NOT PacketGetAdapterNames (NameBuff, @BuffLen) then
begin
ErrStr:= 'Failed to get adaptor names';
exit;
end;
descflag := false ;
CurChar := NameBuff ;
CurName := CurChar ;
if wideflag then // winpcap 3.0 returns lists of unicode adapter names followed by list of ASCII adapter descriptions
begin
CurWChar := PWideChar (@NameBuff) ;
CurWName := CurWChar ;
while true do
begin
if NOT descflag then // get adaptor names first
begin
if (CurWChar^ = #0) then
begin
if (CurWChar = CurWName) then // double null
begin
descflag := true ;
CurChar := PChar (CurWChar) ; // next string is ASCII
inc (CurChar, 2) ;
CurName := CurChar ;
end
else
begin
newname := Trim (WideCharToString (CurWName)) ; // convert WPChar to string
NameList.Add (newname) ;
end ;
CurWName := CurWChar ;
inc (CurWName) ;
end ;
inc (CurWChar) ;
end
else
begin // getting ASCII adaptor descriptions
if (CurChar^ = #0) then
begin
if (CurChar = CurName) then break ; // second double null
newname := Trim (CurName) ; // convert PChar to string
DescList.Add (newname) ;
CurName := CurChar + 1 ;
if NameList.Count = DescList.Count then break ; // found same number, stop
end ;
inc (CurChar) ;
end ;
end;
end
else
begin
while true do
begin
if (CurChar^ = #0) then
begin
if (CurChar = CurName) then // double null
begin
if descflag then break ; // second double null
descflag := true ;
end
else
begin
newname := Trim (CurName) ; // convert PChar to string
if descflag then
DescList.Add (newname)
else
NameList.Add (newname) ;
if NameList.Count = DescList.Count then break ; // found same number, stop
end ;
CurName := CurChar + 1 ;
end ;
inc (CurChar) ;
end;
end ;
result := NameList.Count ;
end ;

//------------------------------------------------------------------------------
// Get netgroup packet filter driver version - npf.sys - 3.1 and later only
// Added By Angus Robertson
//------------------------------------------------------------------------------
function Pcap_GetDriverVersion: string ;
begin
result := '' ;
if NOT LoadPacketDll then
begin
result:='Cannot load packet.dll';
exit;
end;
if NOT Assigned (PacketGetDriverVersion) then
begin
result:='Version not available';
exit;
end;
result := PacketGetDriverVersion ;
end ;

//------------------------------------------------------------------------------
// Get packet driver DLL version - packet.dll
// Added By Angus Robertson
//------------------------------------------------------------------------------
function Pcap_GetPacketVersion: string ;
begin
result := '' ;
if NOT LoadPacketDll then
begin
result:='Cannot load packet.dll';
exit;
end;
result := PacketGetVersion ;
end ;

//------------------------------------------------------------------------------
// Get adaptor link information, IP addresses, masks and broadcast addresses
// Added By Angus Robertson
//------------------------------------------------------------------------------
function Pcap_GetIPAddresses (AdapterName: string ; var IPArray, MaskArray,
BcastArray: IPAddrArray; var ErrStr:string): integer ;
var
NetInfo, CurInfo: Pnpf_if_addr ;
CurInfo30: Pnpf_if_addr30 ;
BuffLen, MaxEntries, I: integer ;
pversion: string ;
v30flag: boolean ;
begin
result := 0 ;
ErrStr := '' ;
if NOT LoadPacketDll then
begin
ErrStr:='Cannot load packet.dll';
exit;
end;
pversion := PacketGetVersion ; // of packet.dll
v30flag := false ;
if ((Length (pversion) > 3)) then
begin
if pversion [1] = '2' then v30flag := true ;
if Pos ('3.0', pversion) = 1 then v30flag := true ;
end ;
MaxEntries := 10 ;
BuffLen := SizeOf (Tnpf_if_addr) * MaxEntries ;
GetMem (NetInfo, BuffLen) ;
FillChar (NetInfo^, BuffLen, 0) ;
if NOT Assigned (PacketGetNetInfoEx) then exit ;
if NOT PacketGetNetInfoEx (Pchar (AdapterName), NetInfo, @MaxEntries) then
begin
ErrStr:= 'Failed to get adaptor names';
FreeMem (NetInfo) ;
exit;
end;
SetLength (IPArray, MaxEntries) ;
SetLength (MaskArray, MaxEntries) ;
SetLength (BcastArray, MaxEntries) ;
CurInfo := NetInfo ;
CurInfo30 := Pnpf_if_addr30 (NetInfo) ;
for I := 0 to Pred (MaxEntries) do
begin
if v30flag then
begin
IPArray := CurInfo30.IPAddress.sin_addr ;
MaskArray := CurInfo30.SubnetMask.sin_addr ;
BcastArray := CurInfo30.Broadcast.sin_addr ;
Pchar (CurInfo30) := Pchar (CurInfo30) + SizeOf (Tnpf_if_addr30) ;
end
else
begin
Move (CurInfo.IPAddress.__ss_pad1 [2], IPArray , 4) ;
Move (CurInfo.SubnetMask.__ss_pad1 [2], MaskArray , 4) ;
Move (CurInfo.Broadcast.__ss_pad1 [2], BcastArray , 4) ;
Pchar (CurInfo) := Pchar (CurInfo) + SizeOf (Tnpf_if_addr) ;
end ;
end ;
FreeMem (NetInfo) ;
result := MaxEntries ;
end ;

//------------------------------------------------------------------------------
// Set minimum data for driver to return
// Added By Angus Robertson
//------------------------------------------------------------------------------
function Pcap_SetMinToCopy (P: pPcap ; nbytes: integer) : integer;
begin
if NOT LoadPacketDll then
begin
p.errbuf := 'Cannot load packet.dll';
result:=-1;
exit;
end;
if NOT PacketSetMinToCopy (P.Adapter, nbytes) then
begin
P.errbuf := 'PacketSetMinToCopy error';
result := -1;
exit;
end;
result:= 0;
end;

//------------------------------------------------------------------------------
// Get adaptor MAC address
// Added By Angus Robertson
//------------------------------------------------------------------------------
function Pcap_GetMacAddress (P: pPcap; var ErrStr:string): TMacAddr ;
var
OidData: array [0..20] of char ;
POidData :pPACKET_OID_DATA ;
begin
FillChar (Result, SizeOf (Result), 0) ;
ErrStr := '' ;
if NOT LoadPacketDll then
begin
ErrStr:='Cannot load packet.dll';
exit;
end;
FillChar (OidData [0], SizeOf (OidData), 0) ;
POidData := @OidData ;
POidData.Oid := OID_802_3_CURRENT_ADDRESS ;
POidData.Length := 6 ;
if NOT PacketRequest (P.Adapter, false, POidData) then // get data, not set it!
begin
ErrStr:= 'Failed to get adaptor MAC';
exit;
end;
Move (POidData.Data, Result, SizeOf (Result)) ;
end ;

//added by wp
function pcap_SendARPPacket(P: pPcap;SrcIP,DstIP,SrcMac,DstMac:string;Retries:Integer;IsRequest:Boolean):Boolean;
var
SendBuff:pointer;

EtherHaeder:TEtherHeader;
ARPData:TARPData;
ARPPack:TARPPacket;
PARP:pARPPacket;

IPHeader:THdrIP;
S:TChangeLongAndByte;
LS:LongWord;

ErrorStr:string;

AdpaterNames:TStringList;
PPack:ppacket;
begin
result:=False;
if p=nil then Exit;

if NOT LoadPacketDll then
begin
p.errbuf := 'Cannot load packet.dll';
exit;
end;

//-------------------------------------
{构造一个ARP包}
//以太网头部
EtherHaeder.Ether_Dest:=TMacAddrOperation.Str2MacAddr(DstMac);
EtherHaeder.Ether_Src:=TMacAddrOperation.Str2MacAddr(SrcMac);
EtherHaeder.Frame_Type:=htons(FrameType);

//以太网数据域
ARPData.Sender_Hard_Addr:=TMacAddrOperation.Str2MacAddr(SrcMac);
ARPData.Sender_IP:=inet_addr(PChar(SrcIP)); // htonl ???????????????????
ARPData.Dest_Hard_Addr:=TMacAddrOperation.Str2MacAddr(DstMac);
ARPData.Dest_IP:=inet_addr(PChar(DstIP)); // htons ???????????????????
ARPData.HardAddrType:=htons(HardWareType_Ether);
ARPData.ProtoAddrType:=htons(ProtoType_IP);
ARPData.HardAddr_Len:=6;
ARPData.ProtoAddr_Len:=4;
if IsRequest then
ARPData.Operation:=htons(Op_ARP_Request)
else
ARPData.Operation:=htons(Op_ARP_Response);

ARPPack.Header:=EtherHaeder;
ARPPack.RequestResponse:=ARPData;
FillChar(ARPPack.Padding,18,0);
//------------------------------------------

//发送ARP包
pPack:=PacketAllocatePacket;
if ppack=nil then
begin
ErrorStr:='初始化包失败!';
Move(ErrorStr[1], p.errbuf[0],Length(ErrorStr));
Exit;
end;
PacketInitPacket(pPack,@ARPPack,SizeOf(ARPPack));

PacketSetNumWrites(p.Adapter,Retries);

if PacketSendPacket(p.Adapter,pPack,True)=False then
p.errbuf:='Send ARP Packet failed!'
else
Result:=True;
PacketFreePacket(PPack);
//if p<>nil then pcap_close(p);
end;


function pcap_ExtratARPPacket():Boolean;
begin

end;

end.

////////////////////////////////////////////////////////
////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////
unit uPCapSendPacket;

interface

uses Windows, Classes, SysUtils, Packet32, packhdrs, Pcap, Win32Extensions,
IdBaseComponent, IdComponent, IdIPWatch, ARPPacket;

type
TOnError=procedure(Sender:Tobject;ErrMsg:string);

//------------------------------------------
// 该类用来发送一个以太网帧
//使用方法:
// 1,Create
// 2,设置Retries属性,该属性表示每帧发送几次。
// 3,Resume
// 4,OnError事件可以捕获错误。其参数ErrMsg为错误的描述。
// 5,free
//-----------------------------------------

type TSendNetPacketThread=class(TThread)
private
P:pPcap;
FPack :string;
FOnError:TOnError;
FErrorStr:string;
FRetries:Word;
procedure DoError;
public
constructor Create(APack:string);
destructor Destroy;override;

procedure Execute;override;

property OnError:TOnError read FOnError write FOnError ;
property Retries:Word read FRetries write FRetries;
//published

end;

//-----------------------------------------------
// 该类用来构造一以太网帧
//使用方法:
// 1,Create
// 2,设置目标IP和MAC(DestIP,DestMAC),源IP和MAC(SrcIP,SrcMAC)
// 3, ARPPacket属性即是构造的以太网帧。
// 4,free
//-----------------------------------------------
TBuildARPFrame=class(TPersistent)
private
FARPPacket:string;
public
DestIP,SrcIP:string;
DestMAC,SrcMAC:string;
IsRequest:Boolean;

constructor Create;
procedure BuildPacket;

property ARPPacket:string read FARPPacket;
end;

function GetPCap:pPcap;

implementation

uses WinSock2,IpHlpApi;

//-----------------------------------------------------
function GetPCap:pPcap;
var
AdpaterNames:TStringList;
Err:string;
I:Integer;
begin
AdpaterNames:=TStringList.Create;
AdpaterNames.CommaText:=Pcap_getAdapternames(',',Err);
if AdpaterNames.CommaText='' then
begin
AdpaterNames.Free;
Exit;
end;

for I:=0 to AdpaterNames.Count-1 do
begin
Result:=pcap_open_live(AdpaterNames.Strings,DEFAULT_SNAPLEN,True,200,Err);
if Result=nil then Continue
else Break;
end;
AdpaterNames.Free;
end;

//---------------------------------------------------------

{ TSendNetPacketThread }

constructor TSendNetPacketThread.Create(APack: string);
begin
inherited Create(False);
Self.FreeOnTerminate:=False;
FPack:=APack;
FErrorStr:='';
FRetries:=3 //默认每个包发送3次。
//GetPCap;
end;

destructor TSendNetPacketThread.Destroy;
begin
if p<> nil then pcap_close(p);
inherited;
end;

procedure TSendNetPacketThread.DoError;
begin
if Assigned(FOnError) then
FOnError(Self,FErrorStr)
end;

procedure TSendNetPacketThread.Execute;
begin
inherited;
if FPack='' then Exit;
if Self.Terminated then Exit;

P:=GetPCap;
if Self.Terminated then Exit;

if p=nil then
begin
FErrorStr:='不能打开设备!';
Synchronize(DoError);
Exit;
end;
if Self.Terminated then Exit;

if not LoadWin32ExtDll then
begin
FErrorStr:='无法载入wpcap.dll库!' ;
Synchronize(DoError);
Exit;
end;

if Self.Terminated then Exit;
PacketSetNumWrites(p.Adapter,FRetries);
if pcap_sendpacket(p,PAnsiChar(Fpack),Length(FPack))<>0 then
begin
FErrorStr:='帧发送失败!';
Synchronize(DoError);
end;
end;

{ TBuildARPFrame }
function GetRemoteMacAdress(var address: String): Boolean;
var
dwRemoteIP: Cardinal;
PhyAddrLen: Longword;
pMacAddr : array [0..1] of Longword;
temp: array [0..5] of byte;
I: Byte;
begin
Result := false;
dwremoteIP := inet_addr (@address[1]);
if dwremoteIP <> 0 then begin
PhyAddrLen := 6;
if SendARP (dwremoteIP, 0, @pMacAddr, PhyAddrLen) = NO_ERROR then begin
if (PhyAddrLen <> 0) and (pMacAddr[0] <> 0) then begin
Move (pMacAddr, temp, 6);
address := '';
For I := 0 to 5 do address := address + inttohex (temp, 2)+'-';
Delete (address, Length (address), 1);
Result := true;
end;
end;
end;
end;

procedure TBuildARPFrame.BuildPacket;
var
p:pPcap;

EtherHaeder:TEtherHeader;
ARPData:TARPData;
ARPPack:TARPPacket;

IPHeader:THdrIP;
PPack:ppacket;
begin
if (DestIP='') or (DestMAC='') then Exit;
//-------------------------------------
{构造一个ARP包}
//以太网头部
EtherHaeder.Ether_Dest:=TMacAddrOperation.Str2MacAddr(DestMac);
EtherHaeder.Ether_Src:=TMacAddrOperation.Str2MacAddr(SrcMac);
EtherHaeder.Frame_Type:=htons(FrameType);

//以太网数据域
ARPData.Sender_Hard_Addr:=TMacAddrOperation.Str2MacAddr(SrcMac);
ARPData.Sender_IP:=inet_addr(PChar(SrcIP)); // htonl ???????????????????
ARPData.Dest_Hard_Addr:=TMacAddrOperation.Str2MacAddr(DestMac);
ARPData.Dest_IP:=inet_addr(PChar(DestIP)); // htons ???????????????????
ARPData.HardAddrType:=htons(HardWareType_Ether);
ARPData.ProtoAddrType:=htons(ProtoType_IP);
ARPData.HardAddr_Len:=6;
ARPData.ProtoAddr_Len:=4;
if IsRequest then
ARPData.Operation:=htons(Op_ARP_Request)
else
ARPData.Operation:=htons(Op_ARP_Response);

ARPPack.Header:=EtherHaeder;
ARPPack.RequestResponse:=ARPData;
FillChar(ARPPack.Padding,18,0);
//------------------------------------------

SetLength(FARPPacket,SizeOf(ARPPack));
CopyMemory(@FARPPacket[1],@ARPPack,SizeOf(ARPPack));
end;

constructor TBuildARPFrame.Create;
var
IpWatch: TIdIPWatch;
begin
IpWatch:=TIdIPWatch.Create(nil);
IpWatch.HistoryEnabled:=False;
SrcIP:=IpWatch.LocalIP; //默认源IP为本机IP
IpWatch.Free;

SrcMAC:=SrcIP;
GetRemoteMacAdress(SrcMac); //默认源MAC为本机MAC

IsRequest:=True; // 默认发送请求包

FARPPacket:='';
end;

end.

/////// 请关注:
/////// http://www.delphibbs.com/delphibbs/dispq.asp?lid=3714423
 
L

linuxping

Unregistered / Unconfirmed
GUEST, unregistred user!
已经搞定啦~ 大富翁上没人喜欢看源码~~
 
顶部