求购IPman的Delphi版源码(100分)

求购IPman的Delphi版源码

留下e-mail，我发给你吧，是g622写的。
不过由于IPMan只能用在Win9x系统，所以意义不大了。所以没有再完善。

这是捕获 IP 数据包的核心单元，Delphi 版：
（只要注册这个控件就可以用他的 OnCap 事件了）

unit UnCYCap_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位标志位/13位偏移量
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 : byte; //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: DWORD;lpOutBuffer: PCHAR; dwOutBufferLen: DWORD;
lpdwOutBytesReturned: LPDWORD;lpOverLapped: POINTER;
lpOverLappedRoutine: POINTER): Integer; stdcall;
TCloseSocket = function (s: TSocket): Integer; stdcall;
Tsend = function (s: TSOCKET; buf: pchar;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: pchar; header_size: integer; data: pchar; data_size: integer; IPHeader: IP_HEADER; TCPHeader: TCP_HEADER) of object;
TOnError = procedure(Error: string) of object;

TCYCap_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;

{
TMsgThread = class(TThread)
private
protected
procedure Execute; override;
public
end;
}

procedure Register;

implementation
function XSocketWindowProc(ahWnd: HWND; auMsg: Integer;awParam: WPARAM; alParam: LPARAM): Integer; stdcall;
var
Obj : TCYCap_ip;
MsgRec: TMessage;
begin
{ At window creation ask windows to store a pointer to our object }
Obj := TCYCap_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 : 'TCYCap_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 TCYCap_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 TCYCap_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 TCYCap_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); //IP解包
CheckSockError(iErrorCode);
end;
end;

//协议识别程序
function TCYCap_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 TCYCap_ip.DecodeIpPack(ip: string; buf: pchar; 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 : pchar;
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, pIpheader, pTcpHeader);
end;

//SOCK错误处理程序
function TCYCap_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 TCYCap_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 TCYCap_ip.Create(Owner: TComponent);
begin
Inherited Create(Owner);
Fpause := False; //暂停标志，创建初设为False
Finitsocket := False; //初始化标志，创建初设为False
setlength(Fsocket, 0); //设置运态数组长度

FWindowHandle := XSocketAllocateHWnd(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TCYCap_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 TCYCap_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'); //第一个Windows Sockets函数

@FOpenSocket := GetProcAddress(Fhand_dll, 'socket'); //创建一个套接口
@FInet_addr := GetProcAddress(Fhand_dll, 'inet_addr'); //将一个点间隔地址转换成一个in_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'); //中止Windows Sockets DLL的使用
@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 TCYCap_ip.StartCap;
begin
if not Finitsocket then
if not init_socket then exit; //若没初始化就先初始化
get_ActiveIP; //取得当前机器的IP
set_socket_state; //设置网卡状态
end;

procedure TCYCap_ip.pause;
begin
if Finitsocket and (high(Fsocket)>-1) then
Fpause := not Fpause;
end;

procedure TCYCap_ip.StopCap;
var i:integer;
begin
for i:=0 to high(Fsocket) do FCloseSocket(Fsocket);
end;

procedure Register;
begin
RegisterComponents('CYInterface', [TCYCap_ip]);
end;

end.

zw84611大哥：
zzhdi@163.com

我这个可以在 2000 下用哦！ ：）

beta兄：
捕获到的数据能drop掉吗

发出去了。
不过你可以看一下这个：
http://www.playicq.com/dispdoc.php?t=27&id=1659
就是beta的那个，Win2k适用。

学习

多人接受答案了。