Pobieranie adresu MAC

0

Poniżej kod ściągnięty ze strony 4programmers, co należy zmienić aby adres MAC wyświetlił się w Labelce?

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, NB30, StdCtrls;

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}
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MachineName: string;

implementation


{$R *.dfm}

 
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;
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}




procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption := {tutaj adres MAC};
end;

end.
0

Najprościej:

var
  SL : TStringList;
begin
  SL := TStringList.Create;
  GetMacAddresses('', SL);
  ShowMessage(SL.Text);
  SL.Free;
end;

Oczywiście pokaże MAC'i wszystkich urządzeń, w tym także takich jak wirtualne drivery sieciówki dla na przykład VMWare. Do dokładnej analizy konfiguracji sieci są inne metody. Na przykład zestaw modułów z: http://www.magsys.co.uk/delphi/magiphlp.asp bo u mnie ten ostatni jest fizycznym adresem karty sieciowej, ale niewykluczone, że to zależeć może od systemu, nazw karty i masy innych czynników.

1 użytkowników online, w tym zalogowanych: 0, gości: 1