如何大量读取局域网中的网卡MAC地址,并将其保准在.txt文件中?(需要详细代码)(50分)

  • 主题发起人 主题发起人 fxly
  • 开始时间 开始时间
F

fxly

Unregistered / Unconfirmed
GUEST, unregistred user!
现在急需做一个读取mac地址的程序,要读取局域网中的所有网卡的MAC地址,请大家帮帮忙,最好能把代码写全。
十万火急!在线等待!
 
程序如下:
unit udp;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, winsock,
StdCtrls, Buttons, ExtCtrls, Spin, ComCtrls, ToolWin, Menus,Inifiles;

const
WM_SOCK = WM_USER + 1; //自定义windows消息
UDPPORT = 6767; //设定UDP端口号
NBTPORT = 137;

type
Tfrmmain = class(TForm)
ListBox1: TListBox;
Panel1: TPanel;
SpeedButton1: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton2: TSpeedButton;
ListView1: TListView;
Splitter1: TSplitter;
StatusBar1: TStatusBar;
CoolBar1: TCoolBar;
Panel2: TPanel;
Edit1: TEdit;
Edit2: TEdit;
SpinEdit1: TSpinEdit;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
SpeedButton4: TSpeedButton;
SaveDlg: TSaveDialog;
SpeedButton5: TSpeedButton;
PopupMenu1: TPopupMenu;
N3: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpinEdit1Change(Sender: TObject);
procedure ListView1Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
procedure N3Click(Sender: TObject);
private
{ Private declarations }
s: TSocket;
addr: TSockAddr;
FSockAddrIn : TSockAddrIn; //利用消息实时获知UDP消息
procedure ReadData(var Message: TMessage); message WM_SOCK;
procedure RecvNbMsg(buffer: Array of byte;len:integer;IP:string);
procedure OpenIni;
procedure SaveIni;
public
{ Public declarations }
procedure SendData(b:array of byte;IP:string);
end;

TSendDataThread=class(TThread)
private
IP,IP2:string;
protected
procedure Execute; override;
procedure GetIP;
procedure Send;
procedure OnExit;
end;

type
PListItem = ^TMyListItem;
TMyListItem = record
//dirName,group: string;
index: integer;
end;

var
frmmain: Tfrmmain;
B1,B2: array [0..3]of byte;
SendDataThread: TSendDataThread;
WAIT_ACK_EVENT: Thandle;
wait_time: integer;
exit_thread: boolean;
ListItemPtr: PListItem;
ini: Tinifile;
mydir: string;

implementation

{$R *.DFM}

function IsLegalIP(IP:string):boolean;
begin

if Longword(inet_addr(pchar(IP)))=INADDR_NONE then
begin
result:=false;
exit;
end
else result:=true;

end;

procedure GetAddrByte(IP:string;var B:array of byte);
var i,j:integer;
s:string;
begin

s:='';
j:=0;
IP:=IP+'.';
for i:=1 to length(IP)do
begin
if IP<>'.' then s:=s+IP
else
begin
B[j]:=byte(strtoint(s));
inc(j);
s:='';
end;
end;

end;

procedure TSendDataThread.Send;
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);
begin

with frmmain do
begin
StatusBar1.Panels[0].Text := '正在测试:'+IP;
senddata(NbtstatPacket,IP);
end;

end;

procedure TSendDataThread.GetIP;
begin

with frmmain do
begin
IP:= Edit1.Text;
IP2:=Edit2.Text;
end;

end;

procedure TSendDataThread.OnExit;
begin

with frmmain do
begin
SpeedButton1.Enabled := true;
SpeedButton2.Enabled := false;
SpeedButton3.Enabled := false;
StatusBar1.Panels[0].Text := '完成';
end;

end;

procedure TSendDataThread.Execute;
begin

Synchronize(GetIP);
if (not IsLegalIP(IP))or(not IsLegalIP(IP2)) then
begin
showmessage('Illegal IP address!');
exit;
end;

GetAddrByte(IP,B1);
GetAddrByte(IP2,B2);

repeat

if exit_thread then
begin
Synchronize(OnExit);
exit;
end;
IP:=format('%d.%d.%d.%d',[B1[0],B1[1],B1[2],B1[3]]);
Synchronize(Send);

waitforsingleobject(WAIT_ACK_EVENT,wait_time);
ResetEvent(WAIT_ACK_EVENT);

if(B1[2]<=B2[2]) then
begin
if(B1[3]<B2[3]) then inc(B1[3])
else if((B1[2]<B2[2]) and (B1[3]<255))then inc(B1[3])
else if((B1[2]<B2[2]) and (B1[3]=255)) then
begin
B1[3]:=1;
inc(B1[2]);
end;
end
else break;
if((B1[3]>=B2[3]) and (B1[2]>=B2[2])) then break;

until ((B1[2]=255));// or (B1[3]=255));
Synchronize(OnExit);

end;

procedure Tfrmmain.OpenIni;
begin

ini:=Tinifile.create(mydir+'Nbtstat.ini');
if not fileexists('Nbtstat.ini')
then
begin
ini.writeInteger('window position','top',top);
ini.writeInteger('window position','left',left);
ini.writeInteger('window position','width',width);
ini.writeInteger('window position','height',height);

ini.writeString('IP','IP1',Edit1.Text);
ini.writeString('IP','IP2',Edit2.Text);
end
else
begin
top:=ini.ReadInteger('window position','top',50);
left:=ini.ReadInteger('window position','left',50);
width:=ini.ReadInteger('window position','width',500);
height:=ini.ReadInteger('window position','height',50);

Edit1.Text:=ini.ReadString('IP','IP1',Edit1.Text);
Edit2.Text:=ini.ReadString('IP','IP2',Edit2.Text);
end;
ini.Free;

end;

procedure Tfrmmain.SaveIni;
begin

if mydir[1]='/' then exit; //open on the LAN
//showmessage(mydir);
ini:=Tinifile.create(mydir+'Nbtstat.ini');

ini.writeInteger('window position','top',top);
ini.writeInteger('window position','left',left);
ini.writeInteger('window position','width',width);
ini.writeInteger('window position','height',height);

ini.writeString('IP','IP1',Edit1.Text);
ini.writeString('IP','IP2',Edit2.Text);

ini.Free;

end;

procedure Tfrmmain.FormCreate(Sender: TObject);
var
TempWSAData: TWSAData;
//optval: integer;
begin
// 初始化SOCKET
if WSAStartup($101, TempWSAData)=1 then
showmessage('StartUp Error!');

s := Socket(AF_INET, SOCK_DGRAM, 0);
if (s = INVALID_SOCKET) then //Socket创建失败
begin
showmessage(inttostr(WSAGetLastError())+' Socket创建失败');
CloseSocket(s);
end;
//本机SockAddr绑定
addr.sin_family := AF_INET;
addr.sin_addr.S_addr := INADDR_ANY;
addr.sin_port := htons(UDPPORT);
if Bind(s, addr, sizeof(addr)) <> 0 then
begin
showmessage('bind fail');
end;
WSAAsyncSelect(s, frmmain.Handle , WM_SOCK, FD_READ);
//对方SockAddrIn设定
FSockAddrIn.SIn_Family := AF_INET;
FSockAddrIn.SIn_Port := htons(NBTPORT);

WAIT_ACK_EVENT:=CreateEvent(nil,true,false,pchar('WAIT_ACK'));
//ResetEvent(WAIT_ACK_EVENT);
wait_time:=100;

mydir:=ExtractFilePath(ParamStr(0));
OpenIni;

end;

procedure Tfrmmain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CloseSocket(s);
SaveIni
end;

procedure Tfrmmain.RecvNbMsg(buffer: Array of byte;len:integer;IP:string);
var
str:string;
i,j,pos,name_num: integer;
item : TListItem;
begin

item:=ListView1.Items.Insert(0);
item.Caption := IP;
for i:=0 to 4 do item.SubItems.Add('');

ListBox1.Items.Add('IP: '+IP);

//
new(ListItemPtr);
ListItemPtr.index := ListBox1.Items.Count;
item.data:= ListItemPtr;

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;

str:='';
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(' ');
str:=str+char(buffer[i+j]);
end;
if (buffer[i+16] and $80)=$80 then
begin
if buffer[i+15]=$0 then item.SubItems[0]:=str;

str:=str+format('<%x>',[buffer[i+15]]);
str:=str+'<GROUP>';
end
else
begin
if buffer[i+15]=$20 then item.SubItems[1]:=str
else
if buffer[i+15]=$3 then item.SubItems[2]:=str;

str:=str+format('<%x>',[buffer[i+15]]);
str:=str+'<UNIQUE>';
end;
ListBox1.Items.Add(str);
str:='';
end;
end;

for i:=0 to 5 do
begin
str:=str+format('%.2x.',[buffer[i+pos+18*name_num]]);
end;
delete(str,length(str),1);
item.SubItems[3]:=str;
str:='MAC:'+str;
ListBox1.Items.Add(str);
ListBox1.Items.Add('------------------------------------------------------');
ListBox1.TopIndex :=ListBox1.Items.count-1;

end;

procedure Tfrmmain.ReadData(var Message: TMessage);
var
buffer: Array [1..500] of byte;
flen,len: integer;
Event: word;
IP:string;
begin

flen:=sizeof(FSockAddrIn);
FSockAddrIn.SIn_Family := AF_INET;
FSockAddrIn.SIn_Port := htons(NBTPORT);
Event := WSAGetSelectEvent(Message.LParam);
if Event = FD_READ then
begin
len := recvfrom(s, 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;

end;

procedure Tfrmmain.SendData(b:array of byte;IP:string);
var
len: integer;
begin

FSockAddrIn.SIn_Addr.S_addr := inet_addr(pchar(IP));
FSockAddrIn.SIn_Family := AF_INET;
FSockAddrIn.SIn_Port := htons(NBTPORT);
len := sendto(s, b[0],50, 0, FSockAddrIn, sizeof(FSockAddrIn));
//if (WSAGetLastError() <> WSAEWOULDBLOCK) and (WSAGetLastError() <> 0) then showmessage(inttostr(WSAGetLastError()));
if len = SOCKET_ERROR then
showmessage('SOCKET_ERROR,send fail.');
if len <> 50 then
showmessage('Not Send all');
end;

procedure Tfrmmain.SpeedButton1Click(Sender: TObject);
begin

exit_thread:=false;
SendDataThread:=TSendDataThread.Create(true);
SpeedButton1.Enabled := false;
SpeedButton2.Enabled := true;
SpeedButton3.Enabled := true;
wait_time:=SpinEdit1.Value;
SendDataThread.Resume;

end;

procedure Tfrmmain.SpeedButton2Click(Sender: TObject);
begin
exit_thread:=true;
end;

procedure Tfrmmain.SpeedButton3Click(Sender: TObject);
begin

if SpeedButton3.Down then
begin
SpeedButton2.Enabled := false;
SendDataThread.Suspend;
end
else
begin
SpeedButton2.Enabled := true;
SendDataThread.Resume;
end;

end;

procedure Tfrmmain.SpinEdit1Change(Sender: TObject);
begin
wait_time:=SpinEdit1.Value;
end;

procedure Tfrmmain.ListView1Click(Sender: TObject);
var ListIndex:integer;
begin

if ListView1.Selected=nil then exit;
ListIndex:=PListitem(ListView1.Selected.Data)^.index;
ListBox1.TopIndex := ListIndex-1;

end;

procedure Tfrmmain.SpeedButton4Click(Sender: TObject);
begin

ListView1.Items.Clear;
ListBox1.Items.Clear;

end;

procedure Tfrmmain.SpeedButton5Click(Sender: TObject);
var f:textfile; i:integer; st:string;
begin

if listview1.Items.Count = 0 then
begin
Application.MessageBox('没有可保存的内容! ','Save File',MB_OK );
exit;
end;

st:=timeToStr(time);
for i:=1 to length(st) do if st=':' then st:='-';
SaveDlg.FileName := 'NbtstatLog('+datetostr(now)+'-'+st+')';
if SaveDlg.Execute then
begin

assignfile(f,SaveDlg.filename);
rewrite(f);
for i:=0 to listview1.Items.Count-1 do
begin
writeln(f,listview1.Items.Caption+': '
+listview1.Items.SubItems[0]+' '
+listview1.Items.SubItems[1]+' '
+listview1.Items.SubItems[2]+' '
+listview1.Items.SubItems[3]+' '
{+listview1.Items.SubItems[4]+' byte)'});

writeln(f);
end;
closefile(f);

end;

end;

procedure Tfrmmain.N3Click(Sender: TObject);
var i:integer; st:string;
begin

if listBox1.Items.Count = 0 then
begin
Application.MessageBox('没有可保存的内容! ','Save File',MB_OK );
exit;
end;

st:=timeToStr(time);
for i:=1 to length(st) do if st=':' then st:='-';
SaveDlg.FileName := 'NbtstatLog2('+datetostr(now)+'-'+st+')';
if SaveDlg.Execute then
begin
ListBox1.Items.SaveToFile(SaveDlg.FileName+'.txt');
end;

end;

end.
 
to cg1120,
怎么程序运行以后没有结果?是不是还要对部分组件进行参数设置?请多指教。
最好能将您的完整的可执行的源程序发到我的信箱里:fxly@yeah.net谢谢~
 
to cg1120,
能否给我来一份?
luoxc0796@sina.com
Thanks!

 
这样看的太累了,发个过来看看。
cxz@gsta.com
 
是呀,不能运行,发一个过来看看!
dodo121@eyou.com
 
发一个过来啊!

yl8555@hotmail.com
 
给我一个,zhaoliz@163.net
 
我也要一个,谢谢!
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
后退
顶部