Получить MAC адрес

Автор: 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}

Другое по теме:

• Состояние подключения к сети
• Как подключать сетевые диски
• Как подключить и отключить сетевые диски