我是网上找的代码是exe的,现在我写在dll中,但是不知道错在那,求大牛帮我看看,告诉我怎么改
解决方案 »
- SQL Server 返回刚刚插入数据的自动编号
- 困擾了很久的串口通訊的問題,使用SPCOMM接收的問題,啊!!!!!!求教啊
- 找人真累!
- meomo1.selstart:=memo1.maxlength memo1.sellength:=1 什么意思
- 如何将edit1.text的值传给webbrowser1网页中的文本框中,并且产生一个button.click的事件
- 为什么我动态生成的控件看不到!
- 请教ODAC问题
- sql语句--急用谢谢
- 关于ADO连接Access的密码验证问题???
- ******怎样直接进入各自的CSDN?不用输入用户名和密码。
- 请问如何修改gif文件某贞图像?
- IDHTTP 网站登陆:GET提交 提交参数正常 但返回结果错误 一直登陆失败 求高手指点,,,
windows,HookDLLType,ro,Weblib,ExtInfo,SysUtils,JwaWinsock2,my_posj,Messages,Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Grids, ComCtrls, Buttons, Menus,cap_ip;
var
tt:pchar = nil;
tt1:pchar = nil;
cap_ip1:Tcap_ip;
procedure kaishi;stdcall;
procedure go;stdcall;
procedure jieshu;stdcall;procedure cap_ip1Cap(ip, proto, sourceIP, destIP, SourcePort,
DestPort: String; header: PChar; header_size: Integer; data: PChar;
data_size: Integer);
implementationprocedure kaishi;stdcall;
begin
cap_ip1.StartCap; //开始
end;procedure jieshu;stdcall;
begin
cap_ip1.StartCap; //结束
end;
procedure go;stdcall;
begin
//cap_ip1:=Tcap_ip.Create(self); //编译错误
//cap_ip1.OnCap:=cap_ip1Cap; //编译错误
end;
procedure cap_ip1Cap(ip, proto, sourceIP, destIP, SourcePort,
DestPort: String; header: PChar; header_size: Integer; data: PChar;
data_size: Integer);
begin
if destIP = '127.0.0.1' then //判断ip
begin
writedat('iiiippppp:'+destIP); //显示ip
writedat('IE send:'+data); //显示数据
end;
end;
end.
unit cap_ip;interfaceuses
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: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) 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:pchar;iBufSize:integer):integer; //IP解包函数
// function DecodeTcpPack(TcpBuf:pchar;iBufSize:integer):integer; //TCP解包函数
//function DecodeUdpPack(p:pchar;i:integer):integer; //UDP解包函数
//function DecodeIcmpPack(p: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接下面
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^[I] <> nil) and (i<20) do
begin
FActiveIP[I]:=inet_ntoa(pptr^[I]^);
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:DWORD;
dwBytesReturned:DWORD;
begin
if high(FActiveIP)=-1 then exit;
setlength(Fsocket,high(FActiveIP)+1);
for i:=0 to high(FActiveIP) do
begin
Fsocket[i]:= 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[i]));
iErrorCode := bind(Fsocket[i],sa, sizeof(sa));
CheckSockError(iErrorCode); dwBufferInLen := 1 ;
dwBytesReturned:=0;
//设置Fsocket为SIO_RCVALL接收所有的IP包
iErrorCode:=FWSAIoctl(Fsocket[i], SIO_RCVALL,@dwBufferInLen, sizeof(dwBufferInLen),
@dwBufferLen, sizeof(dwBufferLen),@dwBytesReturned ,nil ,nil); CheckSockError(iErrorCode);
iErrorCode:=WSAAsyncSelect(Fsocket[i],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;
接下面
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Free the window handle }
procedure XSocketDeallocateHWnd(Wnd: HWND);
begin
DestroyWindow(Wnd);
end;