在Delphi中如何获得计算机上网卡的MAC地址。

Question

unit Main;  interface  uses  
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 
    Forms, Dialogs, StdCtrls,  
  Nb, ExtCtrls;  type  
  TForm1 = class(TForm)  
    Panel1: TPanel;  
    Memo1: TMemo;  
    Panel2: TPanel;  
    Button1: TButton;  
    procedure Button1Click(Sender: TObject);  
    procedure FormCreate(Sender: TObject);  
  private  
    { Private declarations }  
  public  
    { Public declarations }  
  end;  var  
  Form1: TForm1;  implementation  {$R *.DFM}  
{---------------------------------------------}  
{ enumerate the lana's  - works only on WIN32 }  
{---------------------------------------------}  
function NbLanaEnum: TLana_Enum;  
var  
  NCB: TNCB;  
  L_Enum: TLana_Enum;  
  RetCode: Word;  
begin  
{$IFDEF WIN32}  
  FillChar(NCB, SizeOf(NCB), 0);  
  FillChar(L_Enum, SizeOf(TLana_Enum), 0);  
  NCB.Command := NCB_ENUM;  
  NCB.Buf := @L_Enum;  
  NCB.Length := Sizeof(L_Enum);  
  RetCode := NetBiosCmd(NCB);  
  if RetCode <> NRC_GOODRET then begin  
    L_Enum.Length := 0;  
    L_Enum.Lana[0] := Byte(RetCode);  
  end;  
{$ELSE}                     { not supported for WIN16, fake LANA 0 }    L_Enum.Length := 1;  
  L_Enum.Lana[0] := 0;  
{$ENDIF}  
  Result := L_Enum;  
end;  {----------------------------------------}  
{ Reset the lana - don't for WIN16 !     }  
{----------------------------------------}  
function NbReset(l: Byte): Word;  
var  
  NCB: TNCB;  
begin  
{$IFNDEF WIN32}             { will reset all your connections for WIN1 
  
6 }  
  Result := NRC_GOODRET;    { so just fake a reset for Win16           
  
  }  
{$ELSE}  
  FillChar(NCB, SizeOf(NCB), 0);  
  NCB.Command := NCB_RESET;  
  NCB.Lana_Num := l;  
  Result := NetBiosCmd(NCB);  
{$ENDIF}  
end;  
{----------------------------------------}  
{ return the MAC address of an interface }  
{ in the form of a string like :         }  
{ 'xx:xx:xx:xx:xx:xx'                    }  
{ using the definitions in nb.pas        }  
{----------------------------------------}  function NbGetMacAddr(LanaNum: Integer): String;  
var  
  NCB: TNCB;  
  AdpStat: TAdpStat;  
  RetCode: Word;  
begin  
  FillChar(NCB, SizeOf(NCB), 0);  
  FillChar(AdpStat, SizeOf(AdpStat), 0);  
  NCB.Command := NCB_ADPSTAT;  
  NCB.Buf := @AdpStat;  
  NCB.Length := Sizeof(AdpStat);  
  FillChar(NCB.CallName, Sizeof(TNBName), $20);  
  NCB.CallName[0] := Byte('*');  
  NCB.Lana_Num := LanaNum;  
  RetCode := NetBiosCmd(NCB);  
  if RetCode = NRC_GOODRET then begin  
    Result := Format('%2.2x:%2.2x:%2.2x:%2.2x:%2.2x:%2.2x',  
                   [AdpStat.ID[0],  
                   AdpStat.ID[1],  
                   AdpStat.ID[2],  
                   AdpStat.ID[3],  
                   AdpStat.ID[4],  
                   AdpStat.ID[5]  
                   ]);  
  end else begin  
    Result := '??:??:??:??:??:??';  
  end;  
end;  
procedure TForm1.Button1Click(Sender: TObject);  
begin  
  Close;  
end;  procedure TForm1.FormCreate(Sender: TObject);  
var  
  L_Enum : TLana_Enum;  
  RetCode: Word;  
  i: Integer;  
begin  
  L_Enum := NbLanaEnum;                       { enumerate lanas for WI 
  
N NT }  
  if L_Enum.Length = 0 then begin  
    Button1.Caption := Format('LanaEnum err=%2.2x', [L_Enum.Lana[0]]); 
      exit;  
  end;    for i := 0 to (L_Enum.Length - 1)do begin   { for every lana found   
  
     }      RetCode := NbReset(L_Enum.Lana[i]);       { Reset lana for WIN NT  
  
     }  
    if RetCode <> NRC_GOODRET then begin  
       Button1.Caption := Format('Reset Lana %d err=%2.2x',[i, RetCode 
  
]);  
       exit;  
    end;  
                                             { Get MAC Address         
  
     }  
    Memo1.Lines.Add(Format('Lana %x = %s', [L_Enum.Lana[i], NbGetMacAd 
  
dr(i)]));    end;    Button1.Caption := 'Stop';  
end;  end.  
—————————————————————————————————— -  

Answer 1

unit Nb;  {$F+}  {  nb.pas     16/32 bit windows netbios access (follows IBM's Netbios 3.0 spec)  
   (C) CEVI VZW - 29 april 1998     -- DH ([email protected]) --     You can (ab)use this code as you like, but please do not remove the 
  
 credits.     I used reference material from IBM, Microsoft, Syntax and Byte when 
  
 I wrote  
   the 16-bit (DOS) c-version ages ago (in Borland Turbo C 2.0 on a 38 
  
6SX PC)  
   with a Syntax SMB server running on Interactive Unix.  
   I now converted this to 16 and 32 bit Delphi code.  }  interface  
uses SysUtils, Winprocs, Wintypes;  const  
{ size of a netbios name }  
  NBNAMESIZE    = 16;  { max number of network adapters }  
{ remeber it's BIG Blue, right ? }  
  MAXLANAS      = 254;  { NCB Command codes }    NCB_ASYNC     = $80;   { asynch command bit to be or-ed into command 
  
 }    NCB_CALL      = $10;   { open a session }  
  NCB_LISTEN    = $11;   { wait for a call }  
  NCB_HANGUP    = $12;   { end session }  
  NCB_SEND      = $14;   { send data }  
  NCB_RECV      = $15;   { receive data }  
  NCB_RECVANY   = $16;   { receive data on any session }  
  NCB_CHAINSEND = $17;   { chain send data }  
  NCB_DGSEND    = $20;   { send a datagram }  
  NCB_DGRECV    = $21;   { receive datagram }  
  NCB_DGSENDBC  = $22;   { send broadcast datagram }  
  NCB_DGREVCBC  = $23;   { receive broadcast datagram }  
  NCB_ADDNAME   = $30;   { add unique name to local table }  
  NCB_DELNAME   = $31;   { delete name from local table }  
  NCB_RESET     = $32;   { reset adapter }  
  NCB_ADPSTAT   = $33;   { adapter status }  
  NCB_SSTAT     = $34;   { session status }  
  NCB_CANCEL    = $35;   { cancel NCB request }  
  NCB_ADDGRPNAME= $36;   { add group name to local table }  
  NCB_ENUM      = $37;   { enum adapters }  
  NCB_UNLINK    = $70;   { unlink remote boot code }  
  NCB_SENDNA    = $71;   { send, don't wait for ACK }  
  NCB_CHAINSENDNA=$72;   { chain send, but don't wait for ACK }  
  NCB_LANSTALERT= $73;   { lan status alert }  
  NCB_ACTION    = $77;   { enable extensions }  
  NCB_FINDNAME  = $78;   { search for name on the network }  
  NCB_TRACE     = $79;   { activate / stop tracing }  { NCB return codes }    NRC_GOODRET     = $00;    { good return  
                              also returned when ASYNCH request accept 
  
ed }  
  NRC_BUFLEN      = $01;    { illegal buffer length                    
  
   }  
  NRC_ILLCMD      = $03;    { illegal command                          
  
   }  
  NRC_CMDTMO      = $05;    { command timed out                        
  
   }  
  NRC_INCOMP      = $06;    { message incomplete, issue another comman 
  
d  }  
  NRC_BADDR       = $07;    { illegal buffer address                   
  
   }  
  NRC_SNUMOUT     = $08;    { session number out of range              
  
   }  
  NRC_NORES       = $09;    { no resource available                    
  
   }  
  NRC_SCLOSED     = $0a;    { session closed                           
  
   }  
  NRC_CMDCAN      = $0b;    { command cancelled                        
  
   }  
  NRC_DUPNAME     = $0d;    { duplicate name                           
  
   }  
  NRC_NAMTFUL     = $0e;    { name table full                          
  
   }  
  NRC_ACTSES      = $0f;    { no deletions, name has active sessions   
  
   }  
  NRC_LOCTFUL     = $11;    { local session table full                 
  
   }  
  NRC_REMTFUL     = $12;    { remote session table full                
  
   }  
  NRC_ILLNN       = $13;    { illegal name number                      
  
   }  
  NRC_NOCALL      = $14;    { no callname                              
  
   }  
  NRC_NOWILD      = $15;    { cannot put * in NCB_NAME                 
  
   }  
  NRC_INUSE       = $16;    { name in use on remote adapter            
  
   }  
  NRC_NAMERR      = $17;    { name deleted                             
  
   }  
  NRC_SABORT      = $18;    { session ended abnormally                 
  
   }  
  NRC_NAMCONF     = $19;    { name conflict detected                   
  
   }  
  NRC_IFBUSY      = $21;    { interface busy, IRET before retrying     
  
   }  
  NRC_TOOMANY     = $22;    { too many commands outstanding, retry lat 
  
er }  
  NRC_BRIDGE      = $23;    { ncb_lana_num field invalid               
  
   }  
  NRC_CANOCCR     = $24;    { command completed while cancel occurring 
  
   }  
  NRC_CANCEL      = $26;    { command not valid to cancel              
  
   }  
  NRC_DUPENV      = $30;    { name defined by anther local process     
  
   }  
  NRC_ENVNOTDEF   = $34;    { environment undefined. RESET required    
  
   }  
  NRC_OSRESNOTAV  = $35;    { required OS resources exhausted          
  
   }  
  NRC_MAXAPPS     = $36;    { max number of applications exceeded      
  
   }  
  NRC_NOSAPS      = $37;    { no saps available for netbios            
  
   }  
  NRC_NORESOURCES = $38;    { requested resources are not available    
  
   }  
  NRC_INVADDRESS  = $39;    { invalid ncb address or length > segment  
  
   }  
  NRC_INVDDID     = $3B;    { invalid NCB DDID                         
  
   }  
  NRC_LOCKFAIL    = $3C;    { lock of user area failed                 
  
   }  
  NRC_OPENERR     = $3f;    { NETBIOS not loaded                       
  
   }  
  NRC_SYSTEM      = $40;    { system error                             
  
   }    NRC_PENDING     = $ff;    { asynchronous command is not yet finished 
  
   }  {  Values for transport_id }   ALL_TRANSPORTS = 'M'#$00#$00#$00;  
 MS_NBF         = 'MNBF';

Answer 2

var
  temp:string
procedure TForm1.Button1Onclick(Sender:TObject);
begin
  memo1.lines.clear;
  if fileexists(temp) then
    deletefile(temp);
  winexec(pchar('command.com /c ipconfig/all>'+temp),sw_hide);
  while not fileexists(temp) do
   sleep(2000);
  try
   memo1.lines.loadfromfile(temp);
  except
  end;
end;

Answer 3

里面的Physical Address就是MAC地址