Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

uses NB30;

 function GetMACAdress: string;
 var
   NCB: PNCB;
   Adapter: PAdapterStatus;

   URetCode: PChar;
   RetCode: char;
   I: integer;
   Lenum: PlanaEnum;
   _SystemID: string;
   TMPSTR: string;
 begin
   Result    := '';
   _SystemID := '';
   Getmem(NCB, SizeOf(TNCB));
   Fillchar(NCB^, SizeOf(TNCB), 0);

   Getmem(Lenum, SizeOf(TLanaEnum));
   Fillchar(Lenum^, SizeOf(TLanaEnum), 0);

   Getmem(Adapter, SizeOf(TAdapterStatus));
   Fillchar(Adapter^, SizeOf(TAdapterStatus), 0);

   Lenum.Length    := chr(0);
   NCB.ncb_command := chr(NCBENUM);
   NCB.ncb_buffer  := Pointer(Lenum);
   NCB.ncb_length  := SizeOf(Lenum);
   RetCode         := Netbios(NCB);

   i := 0;
   repeat
     Fillchar(NCB^, SizeOf(TNCB), 0);
     Ncb.ncb_command  := chr(NCBRESET);
     Ncb.ncb_lana_num := lenum.lana[I];
     RetCode          := Netbios(Ncb);

     Fillchar(NCB^, SizeOf(TNCB), 0);
     Ncb.ncb_command  := chr(NCBASTAT);
     Ncb.ncb_lana_num := lenum.lana[I];
     // Must be 16 
    Ncb.ncb_callname := '*               ';

     Ncb.ncb_buffer := Pointer(Adapter);

     Ncb.ncb_length := SizeOf(TAdapterStatus);
     RetCode        := Netbios(Ncb);
     //---- calc _systemId from mac-address[2-5] XOR mac-address[1]... 
    if (RetCode = chr(0)) or (RetCode = chr(6)) then
     begin
       _SystemId := IntToHex(Ord(Adapter.adapter_address[0]), 2) + '-' +
         IntToHex(Ord(Adapter.adapter_address[1]), 2) + '-' +
         IntToHex(Ord(Adapter.adapter_address[2]), 2) + '-' +
         IntToHex(Ord(Adapter.adapter_address[3]), 2) + '-' +
         IntToHex(Ord(Adapter.adapter_address[4]), 2) + '-' +
         IntToHex(Ord(Adapter.adapter_address[5]), 2);
     end;
     Inc(i);
   until (I >= Ord(Lenum.Length)) or (_SystemID <> '00-00-00-00-00-00');
   FreeMem(NCB);
   FreeMem(Adapter);
   FreeMem(Lenum);
   GetMacAdress := _SystemID;
 end;



 procedure TForm1.Button1Click(Sender: TObject);
 begin
   label1.Caption := GetMACAdress;
 end;



 //*************************************************** 
// Another Code from 
// http://delphi.vitpc.com/treasury/lan.htm 
//*************************************************** 

uses
   NB30;

 type
   TAdapterStatus = record
     adapter_address: array [0..5] of char;
     filler: array [1..4 * SizeOf(char) + 19 * SizeOf(Word) + 3 * SizeOf(DWORD)] of
     Byte;
   end;

   THostInfo = record
     username: PWideChar;
     logon_domain: PWideChar;
     oth_domains: PWideChar;
     logon_server: PWideChar;
   end;{record}


 function IsNetConnect: Boolean;
 begin
   if GetSystemMetrics(SM_NETWORK) and $01 = $01 then Result := True
   else
     Result := False;
 end;{function}

 function AdapterToString(Adapter: TAdapterStatus): string;
 begin
   with Adapter do Result :=
       Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',
       [Integer(adapter_address[0]), Integer(adapter_address[1]),
       Integer(adapter_address[2]), Integer(adapter_address[3]),
       Integer(adapter_address[4]), Integer(adapter_address[5])]);
 end;{function}

 function GetMacAddresses(const Machine: string;
   const Addresses: TStrings): Integer;
 const
   NCBNAMSZ = 16;        // absolute length of a net name 
  MAX_LANA = 254;       // lana's in range 0 to MAX_LANA inclusive 
  NRC_GOODRET = $00;       // good return 
  NCBASTAT = $33;       // NCB ADAPTER STATUS 
  NCBRESET = $32;       // NCB RESET 
  NCBENUM = $37;       // NCB ENUMERATE LANA NUMBERS 
type
   PNCB = ^TNCB;
   TNCBPostProc = procedure(P: PNCB);
   stdcall;
   TNCB = record
     ncb_command: Byte;
     ncb_retcode: Byte;
     ncb_lsn: Byte;
     ncb_num: Byte;
     ncb_buffer: PChar;
     ncb_length: Word;
     ncb_callname: array [0..NCBNAMSZ - 1] of char;
     ncb_name: array [0..NCBNAMSZ - 1] of char;
     ncb_rto: Byte;
     ncb_sto: Byte;
     ncb_post: TNCBPostProc;
     ncb_lana_num: Byte;
     ncb_cmd_cplt: Byte;
     ncb_reserve: array [0..9] of char;
     ncb_event: THandle;
   end;
   PLanaEnum = ^TLanaEnum;
   TLanaEnum = record
     Length: Byte;
     lana: array [0..MAX_LANA] of Byte;
   end;
   ASTAT = record
     adapt: TAdapterStatus;
     namebuf: array [0..29] of TNameBuffer;
   end;
 var
   NCB: TNCB;
   Enum: TLanaEnum;
   I: integer;
   Adapter: ASTAT;
   MachineName: string;
 begin
   Result := -1;
   Addresses.Clear;
   MachineName := UpperCase(Machine);
   if MachineName = '' then    MachineName := '*';
   FillChar(NCB, SizeOf(NCB), #0);
   NCB.ncb_command := NCBENUM;
   NCB.ncb_buffer  := Pointer(@Enum);
   NCB.ncb_length  := SizeOf(Enum);
   if Word(NetBios(@NCB)) = NRC_GOODRET then
   begin
     Result := Enum.Length;
     for I := 0 to Ord(Enum.Length) - 1 do
     begin
       FillChar(NCB, SizeOf(TNCB), #0);
       NCB.ncb_command  := NCBRESET;
       NCB.ncb_lana_num := Enum.lana[I];
       if Word(NetBios(@NCB)) = NRC_GOODRET then
       begin
         FillChar(NCB, SizeOf(TNCB), #0);
         NCB.ncb_command  := NCBASTAT;
         NCB.ncb_lana_num := Enum.lana[i];
         StrLCopy(NCB.ncb_callname, PChar(MachineName), NCBNAMSZ);
         StrPCopy(@NCB.ncb_callname[Length(MachineName)],
           StringOfChar(' ', NCBNAMSZ - Length(MachineName)));
         NCB.ncb_buffer := PChar(@Adapter);
         NCB.ncb_length := SizeOf(Adapter);
         if Word(NetBios(@NCB)) = NRC_GOODRET then
           Addresses.Add(AdapterToString(Adapter.adapt));
       end;
     end;
   end;
 end;{function}