Jak pobrać adres MAC

Pobranie adresu MAC realizuje poniższa funkcja; zwraca adres MAC w postaci łańcucha String:

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; 

Inna wersja realizująca to samo zadanie:

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}

---

Źródło: Torry.net