这样行不?
来自:张磊, 时间:2000-3-25 17:40:00, ID:205420
这个pas文件里面定义了一个TUDPSock2的类,利用
它你可以得到本机的IP与MAC地址。可以发送与接受
UDP的multicast,broadcast与unicast包。
使用方法:
1.创建:
Sock := TUDPSock2.Create;
2.得到IP地址:
slIP := TStringList.Create;
Sock.LocalIPs(slIP);
然后slIP里面就是字符串形式的本机IP了。
例如199.111.111.111
3.得到Mac地址:
slMac := TStringList.Create;
Sock.LocalMac(slMac);
然后旧可以得到Mac地址了,例如
00-10-5a-3e-76-88
4.发送与接受(以multicast为例)
buf : array [0..8192] of Char;
Sock.Setup(stMulticastSender);
Sock.Add('225.0.0.1', 6000);
//前者为multicast地址,后者为端口号
设置好要发送的buf的值,数据长度设为len
Sock.Send(0, @buf, len);
SockRecv := TUDPSock2.Create;
SockRecv.Setup(stMulticastReceiver);
SockRecv.Add('225.0.0.1', 6000);
SockRecv.OnRecv := OnMyRecv;
SockRecv.StartReceive;
5.销毁:
Sock.Free;
SockRecv.Free;
下面是Source:
unit U_UDPSock;
interface
uses
Classes, SysUtils, WinSock, Windows, NB30;
const
MINBUFFERSIZE = 2048;
DEFAULTBUFFERSIZE = 16384;
MAXBUFFERSIZE = 63488; //62*1024
MULTICAST_TTL = 10;
type
TArraySocket = Array Of TSocket;
PASTAT = ^TASTAT;
TASTAT = record
adapter : TAdapterStatus;
name_buf : TNameBuffer;
end;
PIP_mreq = ^TIP_mreq;
TIP_mreq = record
imr_multiaddr : in_addr;
imr_interface : in_addr;
end;
TAPInAddr = Array [0..10] of PInAddr; // array of pInaddr
PAPInAddr = ^TAPInaddr; // pointer of Array
//Note : Dut to broadcast fragmentation's problem, broadcast message can be at most
//512 bytes long defined by WinSock, not longer than 1472 by Berkeley Socket
//not longer than 1468 under MIPS machine
//So don't send a broadcast message longer than 512 here, no use
TUDPSockType = (stMultiCastSender, stMultiCastReceiver, stUnicastSender, stUnicastReceiver,
stBroadcastSender, stBroadcastReceiver);
TUDPOnRecv = procedure (buffer: Pointer; len: integer; fromIP: string; fromPort: u_Short) of Object;
TUDPRecvThd = class(TThread)
private
fSocks : TArraySocket;
fSockCount : integer;
fBufSize : integer;
fOnRecv : TUDPOnRecv;
protected
procedure Execute ; override;
public
constructor Create(var Socks : TArraySocket; OnRecv : TUDPOnRecv; BufSize : integer);
end;
TUDPSock2 = class(TObject)
private
fbSetupReady : Boolean;
fSockType : TUDPSockType;
fOnRecv : TUDPOnRecv;
fSockCount : integer;
fAddrTo : array of TSockAddr;
fMCReq : array of TIP_mreq;
fSocks : TArraySocket;
fRecvThd : TUDPRecvThd;
fLocalIP : String;
fBufSize : integer;
function LocalIPValid(var LocalIP : string): Boolean;
public
property OnRecv : TUDPOnRecv read fOnRecv write fOnRecv;
constructor Create; ReIntroduce;
destructor Destroy; Override;
procedure LocalIPs(slIPs : TStringList);
procedure LocalMAC(slMac : TStringList);
procedure StartReceive;
function Add(RemoteIP : string; Port : u_Short): integer;
function Setup(udpSockType : TUDPSockType; LocalIP : string = '';
BufferSize : integer = DEFAULTBUFFERSIZE) : Boolean;
function Close : Boolean;
function Send(index : integer; buffer : Pointer; len : integer) : Boolean;
end;
implementation
var
wsData : TWSAData;
procedure TUDPRecvThd.Execute;
var
readFDs : TFDSet;
i, nRecved, nAddrLen: integer;
buf : array [0..MAXBUFFERSIZE] of Byte;
SockFrom : TSockAddr;
begin
Priority := tpHighest;
while not Terminated do
begin
nAddrLen := SizeOf(SockFrom);
FD_ZERO(readFDs);
for i := 0 to fSockCount-1 do
FD_SET(fSocks[i], readFDs);
//The first param of select is provided just for
//compatibility with Berkeley Sockets, no meaning in WinSock
//Note!!! the select's last param here is nil
//so it can be blocked forever
Select(0, @readFDs, nil, nil, nil);
for i := 0 to fSockCount-1 do
if FD_ISSET(fSocks[i], readFDs) then
begin
nRecved := RecvFrom(fSocks[i], buf, fBufSize, 0, SockFrom, nAddrLen);
if Assigned(fOnRecv) then
//Note!!! I didn't call Synchronize here so u can call Terminate and WaitFor
//but I suggest using Suspend and Free STRONGLY!
//For the call of select can be blocked forever
fOnRecv(@buf, nRecved, string(Inet_Ntoa(SockFrom.sin_addr)),
Cardinal(Ntohs(SockFrom.sin_port)));
end;
end;
end;
constructor TUDPRecvThd.Create(var Socks : TArraySocket; OnRecv : TUDPOnRecv; BufSize : integer);
begin
fSocks := Socks;
fOnRecv := OnRecv;
fBufSize := BufSize;
fSockCount := High(Socks) + 1; //must start with 0, Low(Socks) is always 0
FreeOnTerminate := True;
inherited Create(False);
end;
procedure TUDPSock2.LocalIPs(slIPs : TStringList);
var
strLocalHost : string;
pHE : PHostent;
pInAd : PAPInAddr;
saLocal : TSockAddr;
i : integer;
begin
SetLength(strLocalHost, 255);
if GetHostName(PChar(strLocalHost), 254) = SOCKET_ERROR then
Exit;
pHE := GetHostByName(PChar(strLocalHost));
pInAd := PAPInAddr(pHE^.h_addr_list);
saLocal.sin_addr := (pInAd^[0]^);
i := 0;
while True do
begin
slIPs.Add(inet_ntoa(saLocal.sin_addr));
i := i + 1;
if(pInAd^[i] <> nil) then
saLocal.sin_addr := (pInAd^[i]^) //local host
else
break;
end;
end;
procedure TUDPSock2.LocalMAC(slMac : TStringList);
var
ncb : TNCB;
adapt : TASTAT;
lanaEnum : TLanaEnum;
i, j : integer;
strPart, strMac : string;
begin
FillChar(ncb, SizeOf(TNCB), 0);
ncb.ncb_command := Char(NCBEnum);
ncb.ncb_buffer := PChar(@lanaEnum);
ncb.ncb_length := SizeOf(TLanaEnum);
Netbios(@ncb);
for i := 0 to integer(lanaEnum.length)-1 do
begin
FillChar(ncb, SizeOf(TNCB), 0);
ncb.ncb_command := Char(NCBReset);
ncb.ncb_lana_num := lanaEnum.lana[i];
Netbios(@ncb);
FillChar(ncb, SizeOf(TNCB), 0);
ncb.ncb_command := Chr(NCBAstat);
ncb.ncb_lana_num := lanaEnum.lana[i];
ncb.ncb_callname := '* ';
ncb.ncb_buffer := PChar(@adapt);
ncb.ncb_length := SizeOf(TASTAT);
if Netbios(@ncb) = Chr(0) then
begin
strMac := '';
for j := 0 to 5 do
begin
strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
strMac := strMac + strPart + '-';
end;
SetLength(strMac, Length(strMac)-1);
slMac.Add(strMac);
end;
end;
end;
procedure TUDPSock2.StartReceive;
begin
if fRecvThd <> nil then
Exit;
if ((fSockType = stUnicastReceiver) or (fSockType = stMulticastReceiver)
or (fSockType = stBroadcastReceiver)) and (fSockCount > 0) then
fRecvThd := TUDPRecvThd.Create(fSocks, fOnRecv, fBufSize);
end;