Programowanie w języku Delphi » FAQ

Jak pobrać adres MAC

  • 2006-01-28 13:41
  • 9 komentarzy
  • 1155 odsłon
  • Oceń ten tekst jako pierwszy
Pobranie adresu MAC</wiki> 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

9 komentarzy

woolfik 2009-10-16 09:05

Co do pierwszej funkcji to zmienna RetCode musi byc typu AnsiChar (w delphi 2009) :)

kromp12 2004-12-03 08:08

jeszcze raz wstawie nie moja funkcje - dzialajaca

function TF_Main.GetMacAddress(const CompName : string) : string;
type
     TNetTransportEnum = function(pszServer : PWideChar;
                                  Level : DWORD;
                                  var pbBuffer : pointer;
                                  PrefMaxLen : LongInt;
                                  var EntriesRead : DWORD;
                                  var TotalEntries : DWORD;
                                  var ResumeHandle : DWORD) : DWORD;
stdcall;
     TNetApiBufferFree = function(Buffer : pointer) : DWORD; stdcall;
     PTransportInfo = ^TTransportInfo;
     TTransportInfo = record
                       quality_of_service : DWORD;
                       number_of_vcs : DWORD;
                       transport_name : PWChar;
                       transport_address : PWChar;
                       wan_ish : boolean;
                     end;
var E,ResumeHandle, EntriesRead, TotalEntries : DWORD;
    FLibHandle : THandle;
    sMachineName, sMacAddr,  Retvar : string;
    pBuffer : pointer;
    pInfo : PTransportInfo;
    FNetTransportEnum : TNetTransportEnum;
    FNetApiBufferFree : TNetApiBufferFree;
    pszServer : array[0..128] of WideChar;
    i,ii,iIdx : integer;
begin
  sMachineName := trim(CompName);
  Retvar := '00-00-00-00-00-00';
  if (sMachineName <> '') and (length(sMachineName) >= 2) then
  begin
    if copy(sMachineName,1,2) <> '\\' then sMachineName := '\\' + sMachineName
  end;
  pBuffer := nil;
  ResumeHandle := 0;
  FLibHandle := LoadLibrary('NETAPI32.DLL');
  // Execute the external function
  if FLibHandle <> 0 then
    begin
      @FNetTransportEnum := GetProcAddress(FLibHandle,'NetWkstaTransportEnum');
      @FNetApiBufferFree := GetProcAddress(FLibHandle,'NetApiBufferFree');
      E := FNetTransportEnum(StringToWideChar(sMachineName,pszServer,129),0,
           pBuffer,-1,EntriesRead,TotalEntries,Resumehandle);
      if E = 0 then
        begin
          pInfo := pBuffer;
          for i := 1 to EntriesRead do
            begin
              if pos('TCPIP',UpperCase(pInfo^.transport_name)) <> 0 then
              begin
                iIdx := 1;
                sMacAddr := pInfo^.transport_address;
                for ii := 1 to 12 do
                  begin
                    Retvar[iIdx] := sMacAddr[ii];
                    inc(iIdx);
                    if iIdx in [3,6,9,12,15] then inc(iIdx);
                  end;
              end;
            inc(pInfo);
        end;
      if pBuffer <> nil then FNetApiBufferFree(pBuffer);
    end;
    try
      FreeLibrary(FLibHandle);
    except
      // Silent Error
    end;
  end;
  Result := Retvar;
end;

Sebek 2003-02-23 13:49

Vogel: się zapomniało o < delphi > </ delphi >

Vogel 2003-02-22 23:56

Sebek: fajnie się pokolorowało, zauważyłeś :P

Sebek 2003-02-22 21:51

Lofix z torry.net :)

lofix 2003-02-22 21:35

Mam wrazenie sebek ze chyba skads znam ten kod:)))

brodny 2003-02-22 20:58

Odczytać ręcznie? Tego to chyba nawet programik nie będzie potrafił ;)

Sebek 2003-02-22 19:49

nie wiem jakieś literki i cyferki jak ktoś nie umie odczytac ręcznie to niechh se zrobi program i ... zarabia na nim kase :P

Drajwer 2003-02-22 19:47

a co to za adres?:d