http://www.delphibbs.com/delphibbs/dispq.asp?lid=1158914
问题:从这里取得的一段代码,改成构件发布!取对方MAC地址等。
分类:控件 - 开发 ( 版主:cAkk, amo )
来自:UnKnow365, 时间:2002-6-12 14:21:00, ID:1158914 [显示:小字体 | 大字体]
[
]设置IP后调用GetMac方法,取结果代码放在OnReceive事件里。
原来写构件这么有趣!
unit GetMac;
interface
uses
Windows, Messages, SysUtils, Classes, WinSock, Dialogs;
const
WM_SOCK = WM_USER + $0001; //自定义windows消息
UDPPort = 6767; //设定本端UDP端口号
NBTPort = 137; //设定对端UDP端口号
var
MyByte: array [0..3]of byte;
WAIT_ACK_EVENT: Thandle;
MySock: TSocket;
MyAddr: TSockAddr;
FSockAddrIn : TSockAddrIn;
type
TGetMac = class(TComponent)
private
{ Private declarations }
FIP:string; //输入的欲取得MAC地址的机子的IP地址
FWorkGroup:string; //返回的工作组名称
FHostName:string; //返回的主机名
FUserName:string; //返回的用户名
FMacAddress:string; //返回的网卡Mac地址
FHandle: HWnd; //非可视构件消息处理使用
FOnReceive: TNotifyEvent;//接收到返回结果触发的事件
Binded: Boolean;
//对输入的IP地址进行合法性检查并赋给FIP变量
procedure SetFIP(Value: string);
//判断IP地址是否合法
Function IsLegalIP(IP:string):Boolean;
//将IP地址分成四部份
procedure GetAddrByte(IP:string;var B:array of byte);
protected
{ Protected declarations }
procedure ReceiveReturn; dynamic;
//利用消息实时获知UDP消息
procedure ReadData(var Msg: TMessage);//message WM_SOCK;
//分析返回的消息内容
procedure RecvNbMsg(buffer: Array of byte;len:integer;IP:string);
public
{ Public declarations }
procedure GetMac; //先对IP属性赋值后调用此方法取得相关资料
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property IP: string read FIP write SetFIP;
property WorkGroup: string read FWorkGroup;// write FWorkGroup;
property UserName: string read FUserName;// write FUserName;
property HostName: string read FHostName;// write FHostName;
property MacAddress: string read FMacAddress;// write FMacAddress;
property OnReceive: TNotifyEvent read FOnReceive write FOnReceive;
end;
procedure Register;
implementation
//接收到返回的数据后内部处理完毕执行用户定义的代码
procedure TGetMac.ReceiveReturn;
begin
if Assigned(FOnReceive) then FOnReceive(Self);
end;
//检测输入的IP地址是否合法并赋值给FIP变量
procedure TGetMac.SetFIP(Value: string);
begin
if (not IsLegalIP(Value)) then
begin
ShowMessage('非法IP地址!');
FIP:='127.0.0.1';
exit;
end
else
begin
GetAddrByte(Value,MyByte);
FIP:=format('%d.%d.%d.%d',[MyByte[0],MyByte[1],MyByte[2],MyByte[3]]);
end;
end;
//判断IP地址是否合法
Function TGetMac.IsLegalIP(IP:string):Boolean;
begin
if inet_addr(pchar(IP))=INADDR_NONE then
begin
Result:=False;
exit;
end
else result:=true;
end;
//将IP地址分成四部份
procedure TGetMac.GetAddrByte(IP:string;var B:array of byte);
var i,j:integer;
sTemp:string;
begin
sTemp:='';
j:=0;
IP:=IP+'.';
for i:=1 to length(IP)do
begin
if IP
<>'.' then sTemp:=sTemp+IP
else
begin
B[j]:=byte(strtoint(sTemp));
inc(j);
sTemp:='';
end;
end;
end;
//开始取网卡地址
procedure TGetMac.GetMac;
//欲发送的数据包内容
const NbtstatPacket:array[0..49]of byte
=($0,$0,$0,$0,$0,$1,
$0,$0,$0,$0,$0,$0,$20,$43,$4b,
$41,$41,$41,$41,$41,$41,$41,$41,
$41,$41,$41,$41,$41,$41,$41,$41,
$41,$41,$41,$41,$41,$41,$41,$41,
$41,$41,$41,$41,$41,$41,$0,$0,$21,$0,$1);
var
len: integer;
TempWSAData: TWSAData;
begin
if not Binded then begin
// 初始化SOCKET,0成功,使用WinSock1.1版本$0001是1.0版本$0002是2.0版本
if WSAStartup($0101, TempWSAData)<>ERROR_SUCCESS then
ShowMessage('启动错误');
MySock := Socket(AF_INET, SOCK_DGRAM, 0);
if (MySock = INVALID_SOCKET) then //Socket创建失败
begin
ShowMessage(inttostr(WSAGetLastError())+' Socket创建失败!');
CloseSocket(MySock);
end;
//本机SockAddr绑定
MyAddr.sin_family := AF_INET;
MyAddr.sin_addr.S_addr := INADDR_ANY;
MyAddr.sin_port := htons(UDPPORT);
if Bind(MySock, MyAddr, sizeof(MyAddr)) <> 0 then
begin
ShowMessage('绑定错误!');
Binded:=False;
end
else Binded:=True;
WSAAsyncSelect(MySock, FHandle, WM_SOCK, FD_READ);
WAIT_ACK_EVENT:=CreateEvent(nil,true,false,pchar('WAIT_ACK'));
//ResetEvent(WAIT_ACK_EVENT);}
end;
//向对方主机UDP指定的端口发送数据包
FSockAddrIn.SIn_Addr.S_addr := inet_addr(pchar(FIP));
FSockAddrIn.SIn_Family := AF_INET;
FSockAddrIn.SIn_Port := htons(NBTPORT);
len := SendTo(MySock, NbtstatPacket[0],50, 0, FSockAddrIn, sizeof(FSockAddrIn));
//if (WSAGetLastError() <> WSAEWOULDBLOCK) and (WSAGetLastError() <> 0) then showmessage(inttostr(WSAGetLastError()));
if len = SOCKET_ERROR then ShowMessage('SOCKET_ERROR,发送失败!');
if len <> 50 then ShowMessage('数据没有全部发送!');
// WaitForSingleObject(WAIT_ACK_EVENT,WaitTime);
ResetEvent(WAIT_ACK_EVENT);
end;
//接收返回的消息数据
procedure TGetMac.ReadData(var Msg:TMessage);
var
buffer: Array [1..500] of byte;
flen,len: integer;
Event: word;
IP:string;
begin
if Msg.msg<>WM_SOCK then exit;
flen:=sizeof(FSockAddrIn);
FSockAddrIn.SIn_Family := AF_INET;
FSockAddrIn.SIn_Port := htons(NBTPORT);
Event := WSAGetSelectEvent(Msg.LParam);
if Event = FD_READ then
begin
len := recvfrom(MySock, buffer, sizeof(buffer), 0, FSockAddrIn, flen);
if len> 0 then
begin
//FSockAddrIn.sin_addr.S_un_b.s_b1
with FSockAddrIn.sin_addr.S_un_b
do IP:=format('%d.%d.%d.%d',[ord(s_b1),ord(s_b2),ord(s_b3),ord(s_b4)]);
RecvNbMsg(buffer,len,IP);
end;
SetEvent(WAIT_ACK_EVENT);
end;
//触发事件,执行用户指定的代码
ReceiveReturn;
end;
//分析返回的消息
procedure TGetMac.RecvNbMsg(buffer: Array of byte;len:integer;IP:string);
var
TempStr:string;
i,j,pos,name_num: integer;
begin
name_num:=0;
for i:=1 to len do
begin
if((buffer=$21)and(buffer[i+1]=$00)and(buffer[i+2]=$01))
then
begin
name_num:=buffer[i+9];
break;
end;
end;
if name_num=0 then exit;
pos:=i+10;
TempStr:='';
for i:=pos to (pos+18*name_num-1) do
begin
if (((i-pos)mod 18) =0) then
begin
for j:=0 to 14 do
begin
if trim(char(buffer[i+j]))='' then buffer[i+j]:=ord(' ');
TempStr:=TempStr+char(buffer[i+j]);
end;
if (buffer[i+16] and $80)=$80 then
begin
if buffer[i+15]=$0 then FWorkGroup:=TempStr;
end
else
begin
if buffer[i+15]=$20 then FHostName:=TempStr
else
if buffer[i+15]=$3 then FUserName:=TempStr;
end;
TempStr:='';
end;
end;
//取得网卡地址
for i:=0 to 5 do
begin
TempStr:=TempStr+format('%.2x.',[buffer[i+pos+18*name_num]]);
end;
delete(TempStr,length(TempStr),1);
FMacAddress:=TempStr;
end;
//构件创建
constructor TGetMac.Create;
begin
inherited Create(AOwner);
FHandle := Classes.AllocateHWnd(ReadData);
//初始化属性值
FIP:='127.0.0.1';
FUserName:='';
FHostName:='';
FWorkGroup:='';
FMacAddress:='';
Binded:=False;
end;
//构件消毁
destructor TGetMac.Destroy;
begin
CloseSocket(MySock);
WSACleanup();
Classes.DeallocateHWnd(FHandle);
inherited Destroy;
end;
//登记控件
procedure Register;
begin
RegisterComponents('FastNet', [TGetMac]);
end;
end.
来自:jingtao, 时间:2002-9-24 23:30:00, ID:1344048
Classes.AllocateHWnd(ReadData);
Classes.DeallocateHWnd(FHandle);
哪里来的中?D5无法编译
注释后无效
来自:yzhshi, 时间:2002-9-25 8:13:00, ID:1344183
两个都在Forms里面。去掉classes,然后uses forms就可以了。
没有测试你的代码,不过已经收藏了。
来自:tianhf, 时间:2002-9-25 8:54:00, ID:1344295
好,已经测试通过,我原来读取ARP表得到MAC,不能跨网段,这个控件能,谢谢.