MAC Adresse erkennen

[FlorianK]

Das müsste funktionieren:

Code:

[...]


uses [...] Winsock, IpExport, IpHlpApi, IpTypes, IpIfConst, IpRtrMib [...];


[...]


type
  TPhysAddrByteArray = array [0..MAXLEN_PHYSADDR - 1] of BYTE;

function IPMAC(const Filter: string): String;

[...]


implementation


[...]


function IPMAC(const Filter: string): String;

function GetIpAddrTableWithAlloc: PMibIpAddrTable;
var
  Size: ULONG;
begin
  Size := 0;
  GetIpAddrTable(nil, Size, True);
  Result := AllocMem(Size);
  if GetIpAddrTable(Result, Size, True) <> NO_ERROR then
  begin
    FreeMem(Result);
    Result := nil;
  end;
end;

function IpAddrToString(Addr: DWORD): string;
var
  inad: in_addr;
begin
  inad.s_addr := Addr;
  Result := inet_ntoa(inad);
end;

function PhysAddrToString(Length: DWORD; PhysAddr: TPhysAddrByteArray): string;
var
  I: Integer;
begin
  Result := '';
  if Length = 0 then Exit;
  for I := 0 to Length - 1 do
    if I = Integer(Length - 1) then
      Result := Result + Format('%.2x', [PhysAddr[I]])
    else
      Result := Result + (Format('%.2x-', [PhysAddr[I]]));
end;

var
  Size: ULONG;
  I: Integer;
  NetTable: PMibIpNetTable;      // ARP table
  NetRow: TMibIpNetRow;          // ARP entry from ARP table
  CurrentIndex: DWORD;           // Used for displaying a header in case of multiple interfaces
  IpAddrTable: PMibIpAddrTable;  // Address table used for interface index to IP address mapping
begin
  Result:='';
  Size := 0;
  GetIpNetTable(nil, Size, True);
  NetTable := AllocMem(Size);
  try
    if GetIpNetTable(NetTable, Size, True) = NO_ERROR then
    begin
      // Get the IP address table
      IpAddrTable := GetIpAddrTableWithAlloc;
      try
        // Remember the first interface index and display header
        CurrentIndex := NetTable^.table[0].dwIndex;
        // For each ARP entry
        for I := 0 to NetTable^.dwNumEntries - 1 do
        begin
          {$R-}NetRow := NetTable^.table[I];{$R+}
          if CurrentIndex <> NetRow.dwIndex then
          begin
            // We're changing interfaces, display a new header
            CurrentIndex := NetRow.dwIndex;
          end;
          // Only display the entry if it matches the filter
          if (Filter = '') or (Filter = IpAddrToString(NetRow.dwAddr)) then
            Result:=PhysAddrToString(NetRow.dwPhysAddrLen, TPhysAddrByteArray(NetRow.bPhysAddr));
        end;
      finally
        FreeMem(IpAddrTable);
      end;
    end
    else
    begin
      // Assume failure of GetIpNetTable means there are no ARP entries. This is
      // usually the case but it could fail for other reasons.
    end;
  finally
    FreeMem(NetTable);
  end;
end;


[...]

Das habe ich irgendwo mal ausgegraben...
Ich glaube das Units-Installieren brauche ich nicht weiter zu erklären...

Bitte postet evtl. Fehler (ich habe es aber eingentlich getestet)!

[EDIT]
Beispiel gibt's auf Anfrage

UND: Befor man die MAC auslesen kann, muss man den Zielhost VORHER PINGEN!!!
[/EDIT]