冰
冰力不足
Unregistered / Unconfirmed
GUEST, unregistred user!
//cap_main.pas
unit cap_main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cap_ip, StdCtrls, Buttons;
type
Tmy_data=record
buf:array of char;
end;
type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure cap_ip1Cap(ip, proto, sourceIP, destIP, SourcePort,
DestPort: String;
header: PChar;
header_size: Integer;
data: PChar;
data_size: Integer);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
private
{ Private declarations }
public
end;
var
Form1: TForm1;
cap_ip1:Tcap_ip;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
cap_ip1:=Tcap_ip.Create(self);
cap_ip1.OnCap:=cap_ip1Cap;
end;
procedure TForm1.cap_ip1Cap(ip, proto, sourceIP, destIP, SourcePort,
DestPort: String;
header: PChar;
header_size: Integer;
data: PChar;
data_size: Integer);
var
Str, text_str, hex_str, all_str:string;
i:integer;
no: Integer;
begin
Str := '';
text_str := '';
hex_str := '';
all_str := '';
i := 0;
while i <= data_sizedo
begin
no := ord(data);
hex_str := hex_str + format('%0.2x', [no]) + ' ';
if no < 20 then
begin
text_str := text_str + '.';
all_str := all_str + '.';
end else
begin
text_str := text_str + data;
all_str := all_str + data;
end;
if ((i mod 16) = 15) then
begin
Str := Str + hex_str + ' | ' + text_str + #13#10;
text_str := '';
hex_str := '';
end;
inc(i);
end;
if hex_str <> '' then
Memo1.Lines.add(proto + ' ' + sourceIP + ':' + SourcePort + ' -> ' + destIP + ':' + DestPort + ' ' + inttostr(data_size) + #13#10 + Str + #13#10 + all_str + #10#13#10#13#10);
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
cap_ip1.StartCap;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
cap_ip1.pause;
if cap_ip1.Fpause then
BitBtn2.Caption:='继续捕捉'
else
BitBtn2.Caption:='暂停捕捉';
end;
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
cap_ip1.StopCap;
end;
procedure TForm1.BitBtn4Click(Sender: TObject);
begin
Close;
Halt(0);
application.Terminate;
end;
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
cap_ip1.Free;
end;
{
CopyMemory函数:将一块内存的数据从一个位置复制到另一个位置
VOID CopyMemory(PVOID Destination,CONST VOID *Source,DWORD Length);
Destination 要复制内存块的目的地址。
Source 要复制内存块的源地址。
Length 指定要复制内存块的大小，单位为字节
返回值 该函数为VOID型，没有返回值。
}
end.
//--------------------------------------------------------------------
//cap_ip.pas
unit cap_ip;
interface
uses
Windows, Messages,Classes,winsock,sysutils;
const
WM_CapIp = WM_USER + 200;
STATUS_FAILED =$FFFF; //定义异常出错代码
MAX_PACK_LEN =65535; //接收的最大IP报文
MAX_ADDR_LEN =16; //点分十进制地址的最大长度
MAX_PROTO_TEXT_LEN =16; //子协议名称(如"TCP")最大长度
MAX_PROTO_NUM =12; //子协议数量
MAX_HOSTNAME_LAN =255; //最大主机名长度
CMD_PARAM_HELP =true;
IOC_IN =$80000000;
IOC_VENDOR =$18000000;
IOC_out =$40000000;
SIO_RCVALL =IOC_IN or IOC_VENDOR or 1;// or IOC_out;
SIO_RCVALL_MCAST =IOC_IN or IOC_VENDOR or 2;
SIO_RCVALL_IGMPMCAST =IOC_IN or IOC_VENDOR or 3;
SIO_KEEPALIVE_VALS =IOC_IN or IOC_VENDOR or 4;
SIO_ABSORB_RTRALERT =IOC_IN or IOC_VENDOR or 5;
SIO_UCAST_IF =IOC_IN or IOC_VENDOR or 6;
SIO_LIMIT_BROADCASTS =IOC_IN or IOC_VENDOR or 7;
SIO_INDEX_BIND =IOC_IN or IOC_VENDOR or 8;
SIO_INDEX_MCASTIF =IOC_IN or IOC_VENDOR or 9;
SIO_INDEX_ADD_MCAST =IOC_IN or IOC_VENDOR or 10;
SIO_INDEX_DEL_MCAST =IOC_IN or IOC_VENDOR or 11;
type tcp_keepalive=record
onoff:Longword;
keepalivetime:Longword;
keepaliveinterval:Longword;
end;
// New WSAIoctl Options
//IP头
type
_iphdr=record
h_lenver :byte; //4位首部长度+4位IP版本号
tos :char; //8位服务类型TOS
total_len :char; //16位总长度（字节）
ident :word; //16位标识
frag_and_flags :word; //3位标志位
ttl :byte; //8位生存时间 TTL
proto :byte; //8位协议 (TCP, UDP 或其他)
checksum :word; //16位IP首部校验和
sourceIP :Longword; //32位源IP地址
destIP :Longword; //32位目的IP地址
end;
IP_HEADER=_iphdr;
type _tcphdr=record //定义TCP首部
TCP_Sport :word; //16位源端口
TCP_Dport :word; //16位目的端口
th_seq :longword; //32位序列号
th_ack :longword; //32位确认号
th_lenres :byte;
//4位首部长度/6位保留字
th_flag :char; //6位标志位
th_win :word; //16位窗口大小
th_sum :word; //16位校验和
th_urp :word; //16位紧急数据偏移量
end;
TCP_HEADER=_tcphdr;
type _udphdr=record //定义UDP首部
uh_sport :word; //16位源端口
uh_dport :word; //16位目的端口
uh_len :word; //16位长度
uh_sum :word; //16位校验和
end;
UDP_HEADER=_udphdr;
type _icmphdr=record //定义ICMP首部
i_type :byte; //8位类型
i_code :byte; //8位代码
i_cksum :word; //16位校验和
i_id :word; //识别号（一般用进程号作为识别号）
// i_seq :word; //报文序列号
timestamp :word; //时间戳
end;
ICMP_HEADER=_icmphdr;
type _protomap=record //定义子协议映射表
ProtoNum :integer;
ProtoText :array[0..MAX_PROTO_TEXT_LEN] of char;
end;
TPROTOMAP=_protomap;
type
ESocketException = class(Exception);
TWSAStartup = function (wVersionRequired: word;
var WSData: TWSAData): Integer;
stdcall;
TOpenSocket = function (af, Struct, protocol: Integer): TSocket;
stdcall;
TInet_addr = function (cp: PChar): u_long;
stdcall;
Thtons = function (hostshort: u_short): u_short;
stdcall;
TConnect = function (s: TSocket;
var name: TSockAddr;
namelen: Integer): Integer;
stdcall;
TWSAIoctl = function (s: TSocket;
cmd: DWORD;lpInBuffer: PCHAR;
dwInBufferLen
WORD;lpOutBuffer: PCHAR;
dwOutBufferLen: DWORD;
lpdwOutBytesReturned: LPDWORD;lpOverLapped: POINTER;
lpOverLappedRoutine: POINTER): Integer;
stdcall;
TCloseSocket = function (s: TSocket): Integer;
stdcall;
Tsend = function( s:TSOCKET;
bufchar;Len:integer;flags:integer):Integer;stdcall;
Trecv = function( s:TSOCKET;
var buf;Len:integer;flags:integer):Integer;stdcall;
TWSAAsyncSelect =function (s: TSocket;
HWindow: HWND;
wMsg: u_int;
lEvent: Longint): Integer;
stdcall;
TWSACleanup =function():integer;stdcall;
TOnCap = procedure(ip,proto,sourceIP,destIP,SourcePort,DestPort: string;
headerchar;header_size:integer;datachar;data_size:integer) of object;
TOnError = procedure(Error : string) of object;
Tcap_ip = class(TComponent)
private
Fhand_dll :HModule;
// Handle for mpr.dll
FWindowHandle : HWND;
FOnCap :TOnCap;
//捕捉数据的事件
FOnError :TOnError;
//发生错误的事件
Fsocket :array of Tsocket;
FActiveIP :array of string;//存放可用的IP
FWSAStartup : TWSAStartup;
FOpenSocket : TOpenSocket;
FInet_addr : TInet_addr;
Fhtons : Thtons;
FConnect : TConnect;
FCloseSocket : TCloseSocket;
Fsend :Tsend;
FWSAIoctl :TWSAIoctl;
Frecv :Trecv;
FWSACleanup :TWSACleanup;
FWSAAsyncSelect :TWSAAsyncSelect;
protected
procedure WndProc(var MsgRec: TMessage);
function DecodeIpPack(ip:string;bufchar;iBufSize:integer):integer;
//IP解包函数
// function DecodeTcpPack(TcpBufchar;iBufSize:integer):integer;
//TCP解包函数
//function DecodeUdpPack(pchar;i:integer):integer; //UDP解包函数
//function DecodeIcmpPack(pchar;i:integer):integer;
//ICMP解包函数
function CheckProtocol(iProtocol:integer):string; //协议检查
procedure cap_ip(socket_no:integer);
procedure get_ActiveIP;
//得当前的IP列表
procedure set_socket_state;
//设置网卡状态
function CheckSockError(iErrorCode:integer):boolean;
//出错处理函数
public
Fpause :boolean;//暂停
Finitsocket :boolean;//是否已初始化
constructor Create(Owner : TComponent);
override;
destructor Destroy;
override;
function init_socket:boolean;//初始化
procedure StartCap;//开始捕捉
procedure pause;
//暂停
procedure StopCap;//结束捕捉
property Handle : HWND read FWindowHandle;
published
property OnCap : TOnCap read FOnCap write FOnCap;
property OnError : TOnError read FOnError write FOnError;
end;
procedure Register;
implementation
function XSocketWindowProc(ahWnd : HWND;auMsg : Integer;awParam : WPARAM;
alParam : LPARAM): Integer;
stdcall;
var
Obj : Tcap_ip;
MsgRec : TMessage;
begin
{ At window creation ask windows to store a pointer to our object }
Obj := Tcap_ip(GetWindowLong(ahWnd, 0));
{ If the pointer is not assigned, just call the default procedure }
if not Assigned(Obj) then
Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)
else
begin
{ Delphi use a TMessage type to pass paramter to his own kind of }
{ windows procedure. So we aredo
ing the same... }
MsgRec.Msg := auMsg;
MsgRec.wParam := awParam;
MsgRec.lParam := alParam;
Obj.WndProc(MsgRec);
Result := MsgRec.Result;
end;
end;
var
XSocketWindowClass: TWndClass = (
style : 0;
lpfnWndProc : @XSocketWindowProc;
cbClsExtra : 0;
cbWndExtra : SizeOf(Pointer);
hInstance : 0;
hIcon : 0;
hCursor : 0;
hbrBackground : 0;
lpszMenuName : nil;
lpszClassName : 'TCap_ip');
function XSocketAllocateHWnd(Obj : TObject): HWND;
var
TempClass : TWndClass;
ClassRegistered : Boolean;
begin
{ Check if the window class is already registered }
XSocketWindowClass.hInstance := HInstance;
ClassRegistered := GetClassInfo(HInstance,
XSocketWindowClass.lpszClassName,
TempClass);
if not ClassRegistered then
begin
{ Not yet registered,do
it right now }
Result := Windows.RegisterClass(XSocketWindowClass);
if Result = 0 then
Exit;
end;
{ Now create a new window }
Result := CreateWindowEx(WS_EX_TOOLWINDOW,
XSocketWindowClass.lpszClassName,
'', { Window name }
WS_POPUP, { Window Style }
0, 0, { X, Y }
0, 0, { Width, Height }
0, { hWndParent }
0, { hMenu }
HInstance, { hInstance }
nil);
{ CreateParam }
{ if successfull, the ask windows to store the object reference }
{ into the reserved byte (see RegisterClass) }
if (Result <> 0) and Assigned(Obj) then
SetWindowLong(Result, 0, Integer(Obj));
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Free the window handle }
procedure XSocketDeallocateHWnd(Wnd: HWND);
begin
DestroyWindow(Wnd);
end;
//当前机的所有IP地址
procedure Tcap_ip.get_ActiveIP;
type
TaPInAddr = Array[0..20] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
Buffer: Array[0..63] of Char;
I: Integer;
begin
setlength(FActiveIP,20);
GetHostName(Buffer, SizeOf(Buffer));
phe := GetHostByName(buffer);
if phe = nil then
begin
setlength(FActiveIP,0);
if Assigned(FOnError) then
FOnError('没有找到可绑定的IP!');
exit;
end;
pPtr := PaPInAddr(phe^.h_addr_list);
I := 0;
while (pPtr^ <> nil) and (i<20)do
begin
FActiveIP:=inet_ntoa(pptr^^);
Inc(I);
end;
setlength(FActiveIP,i);
end;
procedure Tcap_ip.set_socket_state;
var
i,iErrorCode:integer;
sa: tSockAddrIn;
dwBufferLen:array[0..10]of DWORD;
dwBufferInLenWORD;
dwBytesReturnedWORD;
begin
if high(FActiveIP)=-1 then
exit;
setlength(Fsocket,high(FActiveIP)+1);
for i:=0 to high(FActiveIP)do
begin
Fsocket:= socket(AF_INET , SOCK_RAW , IPPROTO_IP);
sa.sin_family:= AF_INET;
sa.sin_port := htons(i);
sa.sin_addr.S_addr:=Inet_addr(pchar(FActiveIP));
iErrorCode := bind(Fsocket,sa, sizeof(sa));
CheckSockError(iErrorCode);
dwBufferInLen := 1 ;
dwBytesReturned:=0;
//设置Fsocket为SIO_RCVALL接收所有的IP包
iErrorCode:=FWSAIoctl(Fsocket, SIO_RCVALL,@dwBufferInLen, sizeof(dwBufferInLen),
@dwBufferLen, sizeof(dwBufferLen),@dwBytesReturned ,nil ,nil);
CheckSockError(iErrorCode);
iErrorCode:=WSAAsyncSelect(Fsocket,FWindowHandle,WM_CapIp+i,FD_READ or FD_CLOSE);
CheckSockError(iErrorCode);
end;
end;
//读IP数据
procedure Tcap_ip.cap_ip(socket_no:integer);
var
iErrorCode:integer;
RecvBuf:array[0..MAX_PACK_LEN] of char;
begin
fillchar(RecvBuf,sizeof(RecvBuf),0);
iErrorCode := frecv(Fsocket[socket_no], RecvBuf, sizeof(RecvBuf), 0);
CheckSockError(iErrorCode);
if not Fpause then
begin
iErrorCode := DecodeIpPack(FActiveIP[socket_no],RecvBuf, iErrorCode);
CheckSockError(iErrorCode);
end;
end;
//协议识别程序
function Tcap_ip.CheckProtocol(iProtocol:integer):string;
var
i:integer;
begin
result:='';
case iProtocol of
IPPROTO_IP :result:='IP';
IPPROTO_ICMP :result:='ICMP';
IPPROTO_IGMP :result:='IGMP';
IPPROTO_GGP :result:='GGP';
IPPROTO_TCP :result:='TCP';
IPPROTO_PUP :result:='PUP';
IPPROTO_UDP :result:='UDP';
IPPROTO_IDP :result:='IDP';
IPPROTO_ND :result:='NP';
IPPROTO_RAW :result:='RAW';
IPPROTO_MAX :result:='MAX';
else
result:='';
end;
end;
//IP解包程序
function Tcap_ip.DecodeIpPack(ip:string;bufchar;iBufSize:integer):integer;
var
SourcePort,DestPort:word;
iProtocol, iTTL:integer;
szProtocol :array[0..MAX_PROTO_TEXT_LEN] of char;
szSourceIP :array[0..MAX_ADDR_LEN] of char;
szDestIP :array[0..MAX_ADDR_LEN] of char;
pIpheader:IP_HEADER;
pTcpHeader:TCP_HEADER;
pUdpHeader:UDP_HEADER;
pIcmpHeader:ICMP_HEADER;
saSource, saDest:TSockAddrIn;
iIphLen,data_size:integer;
TcpHeaderLen:integer;
TcpDatachar;
begin
result:=0;
CopyMemory(@pIpheader,buf,sizeof(pIpheader));
//协议甄别
iProtocol := pIpheader.proto;
StrLCopy(szProtocol, pchar(CheckProtocol(iProtocol)),15);
//源地址
saSource.sin_addr.s_addr := pIpheader.sourceIP;
strlcopy(szSourceIP, inet_ntoa(saSource.sin_addr), MAX_ADDR_LEN);
//目的地址
saDest.sin_addr.s_addr := pIpheader.destIP;
strLcopy(szDestIP, inet_ntoa(saDest.sin_addr), MAX_ADDR_LEN);
iTTL := pIpheader.ttl;
//计算IP首部的长度
iIphLen :=sizeof(pIpheader);
//根据协议类型分别调用相应的函数
case iProtocol of
IPPROTO_TCP :begin
CopyMemory(@pTcpHeader,buf+iIphLen,sizeof(pTcpHeader));
SourcePort := ntohs(pTcpHeader.TCP_Sport);//源端口
DestPort := ntohs(pTcpHeader.TCP_Dport);
//目的端口
TcpData:=buf+iIphLen+sizeof(pTcpHeader);
data_size:=iBufSize-iIphLen-sizeof(pTcpHeader);
end;
IPPROTO_UDP :begin
CopyMemory(@pUdpHeader,buf+iIphLen,sizeof(pUdpHeader));
SourcePort := ntohs(pUdpHeader.uh_sport);//源端口
DestPort := ntohs(pUdpHeader.uh_dport);
//目的端口
TcpData:=buf+iIphLen+sizeof(pUdpHeader);
data_size:=iBufSize-iIphLen-sizeof(pUdpHeader);
end;
IPPROTO_ICMP :begin
CopyMemory(@pIcmpHeader,buf+iIphLen,sizeof(pIcmpHeader));
SourcePort := pIcmpHeader.i_type;//类型
DestPort := pIcmpHeader.i_code;
//代码
TcpData:=buf+iIphLen+sizeof(pIcmpHeader);
data_size:=iBufSize-iIphLen-sizeof(pIcmpHeader);
end;
else
begin
SourcePort :=0;
DestPort := 0;
//代码
TcpData:=buf+iIphLen;
data_size:=iBufSize-iIphLen;
end;
end;
if Assigned(FOnCap) then
FOnCap(ip,szProtocol,szSourceIP,szDestIP,inttostr(SourcePort),inttostr(DestPort)
,buf,iBufSize-data_size,TcpData,data_size);
end;
//SOCK错误处理程序
function Tcap_ip.CheckSockError(iErrorCode:integer):boolean; //出错处理函数
begin
if(iErrorCode=SOCKET_ERROR) then
begin
if Assigned(FOnError) then
FOnError(inttostr(GetLastError)+SysErrorMessage(GetLastError));
result:=true;
end else
result:=false;
end;
procedure Tcap_ip.WndProc(var MsgRec: TMessage);
begin
with MsgRecdo
if (Msg >=WM_CapIp) and (Msg <= WM_CapIp+high(FActiveIP)) then
cap_ip(msg-WM_CapIp)
else
Result := DefWindowProc(Handle, Msg, wParam, lParam);
end;
constructor Tcap_ip.Create(Owner : TComponent);
begin
Inherited Create(Owner);
Fpause:=false;
Finitsocket:=false;
setlength(Fsocket,0);
FWindowHandle := XSocketAllocateHWnd(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor Tcap_ip.Destroy;
var i:integer;
begin
for i:=0 to high(Fsocket)do
FCloseSocket(Fsocket);
if self.Finitsocket then
begin
FWSACleanup;
if Fhand_dll <> 0 then
FreeLibrary(Fhand_dll);
end;
inherited Destroy;
end;
function Tcap_ip.init_socket:boolean;//初始化
var
GInitData:TWSAData;
begin
result:=true;
IF Finitsocket then
exit;
Fhand_dll := LoadLibrary('ws2_32.dll');
if Fhand_dll = 0 then
begin
raise ESocketException.Create('Unable to register ws2_32.dll');
result:=false;
exit;
end;
@FWSAStartup := GetProcAddress(Fhand_dll, 'WSAStartup');
@FOpenSocket := GetProcAddress(Fhand_dll, 'socket');
@FInet_addr := GetProcAddress(Fhand_dll, 'inet_addr');
@Fhtons := GetProcAddress(Fhand_dll, 'htons');
@FConnect := GetProcAddress(Fhand_dll, 'connect');
@FCloseSocket := GetProcAddress(Fhand_dll, 'closesocket');
@Fsend := GetProcAddress(Fhand_dll, 'send');
@FWSAIoctl := GetProcAddress(Fhand_dll, 'WSAIoctl');
@Frecv := GetProcAddress(Fhand_dll, 'recv');
@FWSACleanup := GetProcAddress(Fhand_dll, 'WSACleanup');
@FWSAAsyncSelect:=GetProcAddress(Fhand_dll, 'WSAAsyncSelect');
if (@FWSAStartup =nil) or(@Fhtons =nil) or (@FConnect =nil) or (@Fsend =nil) or (@FWSACleanup=nil) or
(@FOpenSocket =nil) or (@FInet_addr =nil)or (@FCloseSocket =nil) or (@recv=nil)or (@FWSAIoctl=nil)
or (@FWSAAsyncSelect=nil) then
begin
raise ESocketException.Create('加载dll函数错误!');
result:=false;
exit;
end;
if FWSAStartup($201,GInitData)<>0 then
begin
raise ESocketException.Create('初始化SOCKET2函数失败!');
result:=false;
exit;
end;
Finitsocket:=true;
end;
procedure Tcap_ip.StartCap;
begin
if not Finitsocket then
if not init_socket then
exit;
get_ActiveIP;
set_socket_state;
end;
procedure Tcap_ip.pause;
begin
if Finitsocket and (high(Fsocket)>-1) then
Fpause:=not Fpause;
end;
procedure Tcap_ip.StopCap;
var i:integer;
begin
for i:=0 to high(Fsocket)do
FCloseSocket(Fsocket);
end;
procedure Register;
begin
RegisterComponents('Standard', [Tcap_ip]);
end;
end.
//------------------------------------------------
//cap_main.dfm
object Form1: TForm1
Left = 223
Top = 125
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = '0'
ClientHeight = 373
ClientWidth = 490
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object BitBtn1: TBitBtn
Left = 17
Top = 324
Width = 65
Height = 25
Caption = #24320#22987#25429#25417
TabOrder = 0
OnClick = BitBtn1Click
end
object BitBtn2: TBitBtn
Left = 147
Top = 323
Width = 65
Height = 25
Caption = #26242#20572#25429#25417
TabOrder = 1
OnClick = BitBtn2Click
end
object BitBtn3: TBitBtn
Left = 278
Top = 323
Width = 65
Height = 25
Caption = #32467#26463#25429#25417
TabOrder = 2
OnClick = BitBtn3Click
end
object BitBtn4: TBitBtn
Left = 409
Top = 325
Width = 65
Height = 25
Caption = #36864' '#20986
TabOrder = 3
OnClick = BitBtn4Click
end
object Memo1: TMemo
Left = 8
Top = 8
Width = 473
Height = 297
ScrollBars = ssBoth
TabOrder = 4
end
end
//-------------------------------
//CAP_Test.dpr
program CAP_Test;
uses
Forms,
cap_main in 'cap_main.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
//----------------------------------------------------
如题
要怎么修改才可以监听自己发出去的包?
发来的可以鉴听到,发出去的不可以.
百度上查到:
1。WSAIoctl是不是不能监听自己发出去的包，就算是自己发给自己也不能监听?
2。如果要监听自己发给自己的包，要怎么作？
求教
用packet32就可以做的，只有过你的网卡都可以截到。
设置混杂模式
PacketSetHwFilter(pAdapter, NDIS_PACKET_TYPE_ALL_LOCAL）;
PacketSetBuff（）;
PacketAllocatePacket();
PacketInitPacket();
PacketReceivePacket();
究竟要怎么改?
unit cap_main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cap_ip, StdCtrls, Buttons;
type
Tmy_data=record
buf:array of char;
end;
type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure cap_ip1Cap(ip, proto, sourceIP, destIP, SourcePort,
DestPort: String;
header: PChar;
header_size: Integer;
data: PChar;
data_size: Integer);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
private
{ Private declarations }
public
end;
var
Form1: TForm1;
cap_ip1:Tcap_ip;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
cap_ip1:=Tcap_ip.Create(self);
cap_ip1.OnCap:=cap_ip1Cap;
end;
procedure TForm1.cap_ip1Cap(ip, proto, sourceIP, destIP, SourcePort,
DestPort: String;
header: PChar;
header_size: Integer;
data: PChar;
data_size: Integer);
var
Str, text_str, hex_str, all_str:string;
i:integer;
no: Integer;
begin
Str := '';
text_str := '';
hex_str := '';
all_str := '';
i := 0;
while i <= data_sizedo
begin
no := ord(data);
hex_str := hex_str + format('%0.2x', [no]) + ' ';
if no < 20 then
begin
text_str := text_str + '.';
all_str := all_str + '.';
end else
begin
text_str := text_str + data;
all_str := all_str + data;
end;
if ((i mod 16) = 15) then
begin
Str := Str + hex_str + ' | ' + text_str + #13#10;
text_str := '';
hex_str := '';
end;
inc(i);
end;
if hex_str <> '' then
Memo1.Lines.add(proto + ' ' + sourceIP + ':' + SourcePort + ' -> ' + destIP + ':' + DestPort + ' ' + inttostr(data_size) + #13#10 + Str + #13#10 + all_str + #10#13#10#13#10);
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
cap_ip1.StartCap;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
cap_ip1.pause;
if cap_ip1.Fpause then
BitBtn2.Caption:='继续捕捉'
else
BitBtn2.Caption:='暂停捕捉';
end;
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
cap_ip1.StopCap;
end;
procedure TForm1.BitBtn4Click(Sender: TObject);
begin
Close;
Halt(0);
application.Terminate;
end;
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
cap_ip1.Free;
end;
{
CopyMemory函数:将一块内存的数据从一个位置复制到另一个位置
VOID CopyMemory(PVOID Destination,CONST VOID *Source,DWORD Length);
Destination 要复制内存块的目的地址。
Source 要复制内存块的源地址。
Length 指定要复制内存块的大小，单位为字节
返回值 该函数为VOID型，没有返回值。
}
end.
//--------------------------------------------------------------------
//cap_ip.pas
unit cap_ip;
interface
uses
Windows, Messages,Classes,winsock,sysutils;
const
WM_CapIp = WM_USER + 200;
STATUS_FAILED =$FFFF; //定义异常出错代码
MAX_PACK_LEN =65535; //接收的最大IP报文
MAX_ADDR_LEN =16; //点分十进制地址的最大长度
MAX_PROTO_TEXT_LEN =16; //子协议名称(如"TCP")最大长度
MAX_PROTO_NUM =12; //子协议数量
MAX_HOSTNAME_LAN =255; //最大主机名长度
CMD_PARAM_HELP =true;
IOC_IN =$80000000;
IOC_VENDOR =$18000000;
IOC_out =$40000000;
SIO_RCVALL =IOC_IN or IOC_VENDOR or 1;// or IOC_out;
SIO_RCVALL_MCAST =IOC_IN or IOC_VENDOR or 2;
SIO_RCVALL_IGMPMCAST =IOC_IN or IOC_VENDOR or 3;
SIO_KEEPALIVE_VALS =IOC_IN or IOC_VENDOR or 4;
SIO_ABSORB_RTRALERT =IOC_IN or IOC_VENDOR or 5;
SIO_UCAST_IF =IOC_IN or IOC_VENDOR or 6;
SIO_LIMIT_BROADCASTS =IOC_IN or IOC_VENDOR or 7;
SIO_INDEX_BIND =IOC_IN or IOC_VENDOR or 8;
SIO_INDEX_MCASTIF =IOC_IN or IOC_VENDOR or 9;
SIO_INDEX_ADD_MCAST =IOC_IN or IOC_VENDOR or 10;
SIO_INDEX_DEL_MCAST =IOC_IN or IOC_VENDOR or 11;
type tcp_keepalive=record
onoff:Longword;
keepalivetime:Longword;
keepaliveinterval:Longword;
end;
// New WSAIoctl Options
//IP头
type
_iphdr=record
h_lenver :byte; //4位首部长度+4位IP版本号
tos :char; //8位服务类型TOS
total_len :char; //16位总长度（字节）
ident :word; //16位标识
frag_and_flags :word; //3位标志位
ttl :byte; //8位生存时间 TTL
proto :byte; //8位协议 (TCP, UDP 或其他)
checksum :word; //16位IP首部校验和
sourceIP :Longword; //32位源IP地址
destIP :Longword; //32位目的IP地址
end;
IP_HEADER=_iphdr;
type _tcphdr=record //定义TCP首部
TCP_Sport :word; //16位源端口
TCP_Dport :word; //16位目的端口
th_seq :longword; //32位序列号
th_ack :longword; //32位确认号
th_lenres :byte;
//4位首部长度/6位保留字
th_flag :char; //6位标志位
th_win :word; //16位窗口大小
th_sum :word; //16位校验和
th_urp :word; //16位紧急数据偏移量
end;
TCP_HEADER=_tcphdr;
type _udphdr=record //定义UDP首部
uh_sport :word; //16位源端口
uh_dport :word; //16位目的端口
uh_len :word; //16位长度
uh_sum :word; //16位校验和
end;
UDP_HEADER=_udphdr;
type _icmphdr=record //定义ICMP首部
i_type :byte; //8位类型
i_code :byte; //8位代码
i_cksum :word; //16位校验和
i_id :word; //识别号（一般用进程号作为识别号）
// i_seq :word; //报文序列号
timestamp :word; //时间戳
end;
ICMP_HEADER=_icmphdr;
type _protomap=record //定义子协议映射表
ProtoNum :integer;
ProtoText :array[0..MAX_PROTO_TEXT_LEN] of char;
end;
TPROTOMAP=_protomap;
type
ESocketException = class(Exception);
TWSAStartup = function (wVersionRequired: word;
var WSData: TWSAData): Integer;
stdcall;
TOpenSocket = function (af, Struct, protocol: Integer): TSocket;
stdcall;
TInet_addr = function (cp: PChar): u_long;
stdcall;
Thtons = function (hostshort: u_short): u_short;
stdcall;
TConnect = function (s: TSocket;
var name: TSockAddr;
namelen: Integer): Integer;
stdcall;
TWSAIoctl = function (s: TSocket;
cmd: DWORD;lpInBuffer: PCHAR;
dwInBufferLen
WORD;lpOutBuffer: PCHAR;dwOutBufferLen: DWORD;
lpdwOutBytesReturned: LPDWORD;lpOverLapped: POINTER;
lpOverLappedRoutine: POINTER): Integer;
stdcall;
TCloseSocket = function (s: TSocket): Integer;
stdcall;
Tsend = function( s:TSOCKET;
buf
char;Len:integer;flags:integer):Integer;stdcall;Trecv = function( s:TSOCKET;
var buf;Len:integer;flags:integer):Integer;stdcall;
TWSAAsyncSelect =function (s: TSocket;
HWindow: HWND;
wMsg: u_int;
lEvent: Longint): Integer;
stdcall;
TWSACleanup =function():integer;stdcall;
TOnCap = procedure(ip,proto,sourceIP,destIP,SourcePort,DestPort: string;
header
char;header_size:integer;datachar;data_size:integer) of object;TOnError = procedure(Error : string) of object;
Tcap_ip = class(TComponent)
private
Fhand_dll :HModule;
// Handle for mpr.dll
FWindowHandle : HWND;
FOnCap :TOnCap;
//捕捉数据的事件
FOnError :TOnError;
//发生错误的事件
Fsocket :array of Tsocket;
FActiveIP :array of string;//存放可用的IP
FWSAStartup : TWSAStartup;
FOpenSocket : TOpenSocket;
FInet_addr : TInet_addr;
Fhtons : Thtons;
FConnect : TConnect;
FCloseSocket : TCloseSocket;
Fsend :Tsend;
FWSAIoctl :TWSAIoctl;
Frecv :Trecv;
FWSACleanup :TWSACleanup;
FWSAAsyncSelect :TWSAAsyncSelect;
protected
procedure WndProc(var MsgRec: TMessage);
function DecodeIpPack(ip:string;buf
char;iBufSize:integer):integer;//IP解包函数
// function DecodeTcpPack(TcpBuf
char;iBufSize:integer):integer;//TCP解包函数
//function DecodeUdpPack(p
char;i:integer):integer; //UDP解包函数//function DecodeIcmpPack(p
char;i:integer):integer;//ICMP解包函数
function CheckProtocol(iProtocol:integer):string; //协议检查
procedure cap_ip(socket_no:integer);
procedure get_ActiveIP;
//得当前的IP列表
procedure set_socket_state;
//设置网卡状态
function CheckSockError(iErrorCode:integer):boolean;
//出错处理函数
public
Fpause :boolean;//暂停
Finitsocket :boolean;//是否已初始化
constructor Create(Owner : TComponent);
override;
destructor Destroy;
override;
function init_socket:boolean;//初始化
procedure StartCap;//开始捕捉
procedure pause;
//暂停
procedure StopCap;//结束捕捉
property Handle : HWND read FWindowHandle;
published
property OnCap : TOnCap read FOnCap write FOnCap;
property OnError : TOnError read FOnError write FOnError;
end;
procedure Register;
implementation
function XSocketWindowProc(ahWnd : HWND;auMsg : Integer;awParam : WPARAM;
alParam : LPARAM): Integer;
stdcall;
var
Obj : Tcap_ip;
MsgRec : TMessage;
begin
{ At window creation ask windows to store a pointer to our object }
Obj := Tcap_ip(GetWindowLong(ahWnd, 0));
{ If the pointer is not assigned, just call the default procedure }
if not Assigned(Obj) then
Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)
else
begin
{ Delphi use a TMessage type to pass paramter to his own kind of }
{ windows procedure. So we aredo
ing the same... }
MsgRec.Msg := auMsg;
MsgRec.wParam := awParam;
MsgRec.lParam := alParam;
Obj.WndProc(MsgRec);
Result := MsgRec.Result;
end;
end;
var
XSocketWindowClass: TWndClass = (
style : 0;
lpfnWndProc : @XSocketWindowProc;
cbClsExtra : 0;
cbWndExtra : SizeOf(Pointer);
hInstance : 0;
hIcon : 0;
hCursor : 0;
hbrBackground : 0;
lpszMenuName : nil;
lpszClassName : 'TCap_ip');
function XSocketAllocateHWnd(Obj : TObject): HWND;
var
TempClass : TWndClass;
ClassRegistered : Boolean;
begin
{ Check if the window class is already registered }
XSocketWindowClass.hInstance := HInstance;
ClassRegistered := GetClassInfo(HInstance,
XSocketWindowClass.lpszClassName,
TempClass);
if not ClassRegistered then
begin
{ Not yet registered,do
it right now }
Result := Windows.RegisterClass(XSocketWindowClass);
if Result = 0 then
Exit;
end;
{ Now create a new window }
Result := CreateWindowEx(WS_EX_TOOLWINDOW,
XSocketWindowClass.lpszClassName,
'', { Window name }
WS_POPUP, { Window Style }
0, 0, { X, Y }
0, 0, { Width, Height }
0, { hWndParent }
0, { hMenu }
HInstance, { hInstance }
nil);
{ CreateParam }
{ if successfull, the ask windows to store the object reference }
{ into the reserved byte (see RegisterClass) }
if (Result <> 0) and Assigned(Obj) then
SetWindowLong(Result, 0, Integer(Obj));
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Free the window handle }
procedure XSocketDeallocateHWnd(Wnd: HWND);
begin
DestroyWindow(Wnd);
end;
//当前机的所有IP地址
procedure Tcap_ip.get_ActiveIP;
type
TaPInAddr = Array[0..20] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
Buffer: Array[0..63] of Char;
I: Integer;
begin
setlength(FActiveIP,20);
GetHostName(Buffer, SizeOf(Buffer));
phe := GetHostByName(buffer);
if phe = nil then
begin
setlength(FActiveIP,0);
if Assigned(FOnError) then
FOnError('没有找到可绑定的IP!');
exit;
end;
pPtr := PaPInAddr(phe^.h_addr_list);
I := 0;
while (pPtr^ <> nil) and (i<20)do
begin
FActiveIP:=inet_ntoa(pptr^^);
Inc(I);
end;
setlength(FActiveIP,i);
end;
procedure Tcap_ip.set_socket_state;
var
i,iErrorCode:integer;
sa: tSockAddrIn;
dwBufferLen:array[0..10]of DWORD;
dwBufferInLen
WORD;dwBytesReturned
WORD;begin
if high(FActiveIP)=-1 then
exit;
setlength(Fsocket,high(FActiveIP)+1);
for i:=0 to high(FActiveIP)do
begin
Fsocket:= socket(AF_INET , SOCK_RAW , IPPROTO_IP);
sa.sin_family:= AF_INET;
sa.sin_port := htons(i);
sa.sin_addr.S_addr:=Inet_addr(pchar(FActiveIP));
iErrorCode := bind(Fsocket,sa, sizeof(sa));
CheckSockError(iErrorCode);
dwBufferInLen := 1 ;
dwBytesReturned:=0;
//设置Fsocket为SIO_RCVALL接收所有的IP包
iErrorCode:=FWSAIoctl(Fsocket, SIO_RCVALL,@dwBufferInLen, sizeof(dwBufferInLen),
@dwBufferLen, sizeof(dwBufferLen),@dwBytesReturned ,nil ,nil);
CheckSockError(iErrorCode);
iErrorCode:=WSAAsyncSelect(Fsocket,FWindowHandle,WM_CapIp+i,FD_READ or FD_CLOSE);
CheckSockError(iErrorCode);
end;
end;
//读IP数据
procedure Tcap_ip.cap_ip(socket_no:integer);
var
iErrorCode:integer;
RecvBuf:array[0..MAX_PACK_LEN] of char;
begin
fillchar(RecvBuf,sizeof(RecvBuf),0);
iErrorCode := frecv(Fsocket[socket_no], RecvBuf, sizeof(RecvBuf), 0);
CheckSockError(iErrorCode);
if not Fpause then
begin
iErrorCode := DecodeIpPack(FActiveIP[socket_no],RecvBuf, iErrorCode);
CheckSockError(iErrorCode);
end;
end;
//协议识别程序
function Tcap_ip.CheckProtocol(iProtocol:integer):string;
var
i:integer;
begin
result:='';
case iProtocol of
IPPROTO_IP :result:='IP';
IPPROTO_ICMP :result:='ICMP';
IPPROTO_IGMP :result:='IGMP';
IPPROTO_GGP :result:='GGP';
IPPROTO_TCP :result:='TCP';
IPPROTO_PUP :result:='PUP';
IPPROTO_UDP :result:='UDP';
IPPROTO_IDP :result:='IDP';
IPPROTO_ND :result:='NP';
IPPROTO_RAW :result:='RAW';
IPPROTO_MAX :result:='MAX';
else
result:='';
end;
end;
//IP解包程序
function Tcap_ip.DecodeIpPack(ip:string;buf
char;iBufSize:integer):integer;var
SourcePort,DestPort:word;
iProtocol, iTTL:integer;
szProtocol :array[0..MAX_PROTO_TEXT_LEN] of char;
szSourceIP :array[0..MAX_ADDR_LEN] of char;
szDestIP :array[0..MAX_ADDR_LEN] of char;
pIpheader:IP_HEADER;
pTcpHeader:TCP_HEADER;
pUdpHeader:UDP_HEADER;
pIcmpHeader:ICMP_HEADER;
saSource, saDest:TSockAddrIn;
iIphLen,data_size:integer;
TcpHeaderLen:integer;
TcpData
char;begin
result:=0;
CopyMemory(@pIpheader,buf,sizeof(pIpheader));
//协议甄别
iProtocol := pIpheader.proto;
StrLCopy(szProtocol, pchar(CheckProtocol(iProtocol)),15);
//源地址
saSource.sin_addr.s_addr := pIpheader.sourceIP;
strlcopy(szSourceIP, inet_ntoa(saSource.sin_addr), MAX_ADDR_LEN);
//目的地址
saDest.sin_addr.s_addr := pIpheader.destIP;
strLcopy(szDestIP, inet_ntoa(saDest.sin_addr), MAX_ADDR_LEN);
iTTL := pIpheader.ttl;
//计算IP首部的长度
iIphLen :=sizeof(pIpheader);
//根据协议类型分别调用相应的函数
case iProtocol of
IPPROTO_TCP :begin
CopyMemory(@pTcpHeader,buf+iIphLen,sizeof(pTcpHeader));
SourcePort := ntohs(pTcpHeader.TCP_Sport);//源端口
DestPort := ntohs(pTcpHeader.TCP_Dport);
//目的端口
TcpData:=buf+iIphLen+sizeof(pTcpHeader);
data_size:=iBufSize-iIphLen-sizeof(pTcpHeader);
end;
IPPROTO_UDP :begin
CopyMemory(@pUdpHeader,buf+iIphLen,sizeof(pUdpHeader));
SourcePort := ntohs(pUdpHeader.uh_sport);//源端口
DestPort := ntohs(pUdpHeader.uh_dport);
//目的端口
TcpData:=buf+iIphLen+sizeof(pUdpHeader);
data_size:=iBufSize-iIphLen-sizeof(pUdpHeader);
end;
IPPROTO_ICMP :begin
CopyMemory(@pIcmpHeader,buf+iIphLen,sizeof(pIcmpHeader));
SourcePort := pIcmpHeader.i_type;//类型
DestPort := pIcmpHeader.i_code;
//代码
TcpData:=buf+iIphLen+sizeof(pIcmpHeader);
data_size:=iBufSize-iIphLen-sizeof(pIcmpHeader);
end;
else
begin
SourcePort :=0;
DestPort := 0;
//代码
TcpData:=buf+iIphLen;
data_size:=iBufSize-iIphLen;
end;
end;
if Assigned(FOnCap) then
FOnCap(ip,szProtocol,szSourceIP,szDestIP,inttostr(SourcePort),inttostr(DestPort)
,buf,iBufSize-data_size,TcpData,data_size);
end;
//SOCK错误处理程序
function Tcap_ip.CheckSockError(iErrorCode:integer):boolean; //出错处理函数
begin
if(iErrorCode=SOCKET_ERROR) then
begin
if Assigned(FOnError) then
FOnError(inttostr(GetLastError)+SysErrorMessage(GetLastError));
result:=true;
end else
result:=false;
end;
procedure Tcap_ip.WndProc(var MsgRec: TMessage);
begin
with MsgRecdo
if (Msg >=WM_CapIp) and (Msg <= WM_CapIp+high(FActiveIP)) then
cap_ip(msg-WM_CapIp)
else
Result := DefWindowProc(Handle, Msg, wParam, lParam);
end;
constructor Tcap_ip.Create(Owner : TComponent);
begin
Inherited Create(Owner);
Fpause:=false;
Finitsocket:=false;
setlength(Fsocket,0);
FWindowHandle := XSocketAllocateHWnd(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor Tcap_ip.Destroy;
var i:integer;
begin
for i:=0 to high(Fsocket)do
FCloseSocket(Fsocket);
if self.Finitsocket then
begin
FWSACleanup;
if Fhand_dll <> 0 then
FreeLibrary(Fhand_dll);
end;
inherited Destroy;
end;
function Tcap_ip.init_socket:boolean;//初始化
var
GInitData:TWSAData;
begin
result:=true;
IF Finitsocket then
exit;
Fhand_dll := LoadLibrary('ws2_32.dll');
if Fhand_dll = 0 then
begin
raise ESocketException.Create('Unable to register ws2_32.dll');
result:=false;
exit;
end;
@FWSAStartup := GetProcAddress(Fhand_dll, 'WSAStartup');
@FOpenSocket := GetProcAddress(Fhand_dll, 'socket');
@FInet_addr := GetProcAddress(Fhand_dll, 'inet_addr');
@Fhtons := GetProcAddress(Fhand_dll, 'htons');
@FConnect := GetProcAddress(Fhand_dll, 'connect');
@FCloseSocket := GetProcAddress(Fhand_dll, 'closesocket');
@Fsend := GetProcAddress(Fhand_dll, 'send');
@FWSAIoctl := GetProcAddress(Fhand_dll, 'WSAIoctl');
@Frecv := GetProcAddress(Fhand_dll, 'recv');
@FWSACleanup := GetProcAddress(Fhand_dll, 'WSACleanup');
@FWSAAsyncSelect:=GetProcAddress(Fhand_dll, 'WSAAsyncSelect');
if (@FWSAStartup =nil) or(@Fhtons =nil) or (@FConnect =nil) or (@Fsend =nil) or (@FWSACleanup=nil) or
(@FOpenSocket =nil) or (@FInet_addr =nil)or (@FCloseSocket =nil) or (@recv=nil)or (@FWSAIoctl=nil)
or (@FWSAAsyncSelect=nil) then
begin
raise ESocketException.Create('加载dll函数错误!');
result:=false;
exit;
end;
if FWSAStartup($201,GInitData)<>0 then
begin
raise ESocketException.Create('初始化SOCKET2函数失败!');
result:=false;
exit;
end;
Finitsocket:=true;
end;
procedure Tcap_ip.StartCap;
begin
if not Finitsocket then
if not init_socket then
exit;
get_ActiveIP;
set_socket_state;
end;
procedure Tcap_ip.pause;
begin
if Finitsocket and (high(Fsocket)>-1) then
Fpause:=not Fpause;
end;
procedure Tcap_ip.StopCap;
var i:integer;
begin
for i:=0 to high(Fsocket)do
FCloseSocket(Fsocket);
end;
procedure Register;
begin
RegisterComponents('Standard', [Tcap_ip]);
end;
end.
//------------------------------------------------
//cap_main.dfm
object Form1: TForm1
Left = 223
Top = 125
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = '0'
ClientHeight = 373
ClientWidth = 490
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object BitBtn1: TBitBtn
Left = 17
Top = 324
Width = 65
Height = 25
Caption = #24320#22987#25429#25417
TabOrder = 0
OnClick = BitBtn1Click
end
object BitBtn2: TBitBtn
Left = 147
Top = 323
Width = 65
Height = 25
Caption = #26242#20572#25429#25417
TabOrder = 1
OnClick = BitBtn2Click
end
object BitBtn3: TBitBtn
Left = 278
Top = 323
Width = 65
Height = 25
Caption = #32467#26463#25429#25417
TabOrder = 2
OnClick = BitBtn3Click
end
object BitBtn4: TBitBtn
Left = 409
Top = 325
Width = 65
Height = 25
Caption = #36864' '#20986
TabOrder = 3
OnClick = BitBtn4Click
end
object Memo1: TMemo
Left = 8
Top = 8
Width = 473
Height = 297
ScrollBars = ssBoth
TabOrder = 4
end
end
//-------------------------------
//CAP_Test.dpr
program CAP_Test;
uses
Forms,
cap_main in 'cap_main.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
//----------------------------------------------------
如题
要怎么修改才可以监听自己发出去的包?
发来的可以鉴听到,发出去的不可以.
百度上查到:
1。WSAIoctl是不是不能监听自己发出去的包，就算是自己发给自己也不能监听?
2。如果要监听自己发给自己的包，要怎么作？
求教
用packet32就可以做的，只有过你的网卡都可以截到。
设置混杂模式
PacketSetHwFilter(pAdapter, NDIS_PACKET_TYPE_ALL_LOCAL）;
PacketSetBuff（）;
PacketAllocatePacket();
PacketInitPacket();
PacketReceivePacket();
究竟要怎么改?