Delphi World - Получить MAC адрес
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Получить MAC адрес

Оформил: 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}
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования