不要放在界面上,动态创建控件,跟下代码哪里错了,一点建议,说不定是Socket的问题,下面是MSDN里面的资料,也就是说某个函数参数有区别,自己查查吧
WSAEINVAL
(10022)
Invalid argument.
Some invalid argument was supplied (for example, specifying an invalid level to the setsockopt function). In some instances, it also refers to the current state of the socket - for instance, calling accept on a socket that is not listening.
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;data
char;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 are doing 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 MsgRec do
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.