unit UEthernetAddress;

interface

uses classes, sysutils, IpHlpApi, IpTypes, Forms, StdCtrls, Windows, Dialogs;

const
     MAX_INTERFACE_NAME_LEN             = $100;
     ERROR_SUCCESS                      = 0;
     MAXLEN_IFDESCR                     = $100;
     MAXLEN_PHYSADDR                    = 8;

     MIB_IF_OPER_STATUS_NON_OPERATIONAL = 0 ;
     MIB_IF_OPER_STATUS_UNREACHABLE     = 1;
     MIB_IF_OPER_STATUS_DISCONNECTED    = 2;
     MIB_IF_OPER_STATUS_CONNECTING      = 3;
     MIB_IF_OPER_STATUS_CONNECTED       = 4;
     MIB_IF_OPER_STATUS_OPERATIONAL     = 5;

     MIB_IF_TYPE_OTHER                  = 1;
     MIB_IF_TYPE_ETHERNET               = 6;
     MIB_IF_TYPE_TOKENRING              = 9;
     MIB_IF_TYPE_FDDI                   = 15;
     MIB_IF_TYPE_PPP                    = 23;
     MIB_IF_TYPE_LOOPBACK               = 24;
     MIB_IF_TYPE_SLIP                   = 28;

     MIB_IF_ADMIN_STATUS_UP             = 1;
     MIB_IF_ADMIN_STATUS_DOWN           = 2;
     MIB_IF_ADMIN_STATUS_TESTING        = 3;


type
  TNetworkInterface = record
    IPAddress: string;
    BroadcastIPAddress: string;
    SubNetMask: string;
    Name: string;
    DeviceName: string;
    GUID: string;
  end;
  TNetworkInterfaceList = array of TNetworkInterface;

   MIB_IFROW            = Record
     wszName : Array[0 .. (MAX_INTERFACE_NAME_LEN*2-1)] of char;
     dwIndex              : LongInt;
     dwType               : LongInt;
     dwMtu                : LongInt;
     dwSpeed              : LongInt;
     dwPhysAddrLen        : LongInt;
     bPhysAddr : Array[0 .. (MAXLEN_PHYSADDR-1)] of Byte;
     dwAdminStatus        : LongInt;
     dwOperStatus         : LongInt;
     dwLastChange         : LongInt;
     dwInOctets           : LongInt;
     dwInUcastPkts        : LongInt;
     dwInNUcastPkts       : LongInt;
     dwInDiscards         : LongInt;
     dwInErrors           : LongInt;
     dwInUnknownProtos    : LongInt;
     dwOutOctets          : LongInt;
     dwOutUcastPkts       : LongInt;
     dwOutNUcastPkts      : LongInt;
     dwOutDiscards        : LongInt;
     dwOutErrors          : LongInt;
     dwOutQLen            : LongInt;
     dwDescrLen           : LongInt;
     bDescr     : Array[0 .. (MAXLEN_IFDESCR - 1)] of Char;
     end;

function Get_EthernetAddresses: TStringList;
function GetNetworkAdapterList: TNetworkInterfaceList;
Function GetIfTable( pIfTable : Pointer; var pdwSize  : LongInt; bOrder   : LongInt ): LongInt; stdcall;
procedure DisplayIfConf;


implementation

Function GetIfTable; stdcall; external 'IPHLPAPI.DLL';

function Get_EthernetAddresses: TStringList;
const
   _MAX_ROWS_ = 20;
type
   _IfTable = record
      nRows : LongInt;
      ifRow : Array[1.._MAX_ROWS_] of MIB_IFROW;
    end;
var
  pIfTable  : ^_IfTable;
  TableSize : LongInt;
  tmp       : String;
  i,j       : Integer;
  ErrCode   : LongInt;
begin
   pIfTable := nil;
   //------------------------------------------------------------
   Result := TStringList.Create;
   if Assigned(Result) then
   try
      //-------------------------------------------------------
      // First: just get the buffer size.
      // TableSize returns the size needed.
      TableSize:=0; // Set to zero so the GetIfTabel function
                    // won't try to fill the buffer yet,
                    // but only return the actual size it needs.
      GetIfTable(pIfTable, TableSize, 1);
      if (TableSize < SizeOf(MIB_IFROW)+Sizeof(LongInt)) then
      begin
         Exit; // less than 1 table entry?!
      end; // if-end.

      // Second:
      // allocate memory for the buffer and retrieve the
      // entire table.
      GetMem(pIfTable, TableSize);
      ErrCode := GetIfTable(pIfTable, TableSize, 1);
      if ErrCode<>ERROR_SUCCESS then
      begin
         Exit; // OK, that did not work.
               // Not enough memory i guess.
      end; // if-end.

      // Read the ETHERNET addresses.
      for i := 1 to pIfTable^.nRows do
      try
         if pIfTable^.ifRow[i].dwType=MIB_IF_TYPE_ETHERNET then
         begin
            tmp:='';
            for j:=0 to pIfTable^.ifRow[i].dwPhysAddrLen-1 do
            begin
               tmp := tmp + format('%.2x',
                      [ pIfTable^.ifRow[i].bPhysAddr[j] ] );
            end; // for-end.
            //-------------------------------------
            if Length(tmp)>0 then Result.Add(tmp);
         end; // if-end.
      except
         Exit;
      end; // if-try-except-end.
   finally
      if Assigned(pIfTable) then FreeMem(pIfTable,TableSize);
   end; // if-try-finally-end.
end;

function GetNetworkAdapterList: TNetworkInterfaceList;
const
   _MAX_ROWS_ = 20;
type
   _IfTable = record
      nRows : LongInt;
      ifRow : Array[1.._MAX_ROWS_] of MIB_IFROW;
    end;
var
  pIfTable  : ^_IfTable;
  TableSize : LongInt;
  tmp       : String;
  i,j       : Integer;
  ErrCode   : LongInt;
begin
  pIfTable := nil;
  //if Assigned(Result) then
  try
    //-------------------------------------------------------
    // First: just get the buffer size.
    // TableSize returns the size needed.
    TableSize := 0; // Set to zero so the GetIfTabel function
                    // won't try to fill the buffer yet,
                    // but only return the actual size it needs.
    GetIfTable(pIfTable, TableSize, 1);
    if (TableSize < SizeOf(MIB_IFROW)+Sizeof(LongInt)) then
    begin
      Exit; // less than 1 table entry?!
    end; // if-end.

    // Second:
    // allocate memory for the buffer and retrieve the
    // entire table.
    GetMem(pIfTable, TableSize);
    ErrCode := GetIfTable(pIfTable, TableSize, 1);
    if ErrCode<>ERROR_SUCCESS then begin
      Exit; // OK, that did not work.
              // Not enough memory i guess.
    end; // if-end.

      // Read the ETHERNET addresses.
    SetLength(Result, 0);
    for i := 1 to pIfTable^.nRows do with pIfTable^.ifRow[i] do begin
      try
        if (pIfTable^.ifRow[i].dwOperStatus = MIB_IF_OPER_STATUS_OPERATIONAL) and
        (pIfTable^.ifRow[i].dwType=MIB_IF_TYPE_ETHERNET) then
        begin
          SetLength(Result, Length(Result) + 1);
          with Result[High(Result)] do begin
            SetLength(DeviceName, dwDescrLen);
            Move(bDescr[0], DeviceName[1], dwDescrLen);
            Name := DeviceName;
            IPAddress := '192.168.0.3';
            BroadcastIPAddress := '192.168.0.255';
            BroadcastIPAddress := '255.255.255.0';
//            IPAddress := '127.0.0.1';
//            BroadcastIPAddress := '255.0.0.0';
          end;

{            tmp := '';
            for j:=0 to pIfTable^.ifRow[i].dwPhysAddrLen-1 do
            begin
               tmp := tmp + format('%.2x',
                      [ pIfTable^.ifRow[i].bPhysAddr[j] ] );
            end; // for-end.
            //-------------------------------------
            if Length(tmp)>0 then Result.Add(tmp);
}       end; // if-end.
      except
        Exit;
      end; // if-try-except-end.
;    end;
  finally
    if Assigned(pIfTable) then FreeMem(pIfTable,TableSize);
  end; // if-try-finally-end.
end;

procedure DisplayIfConf;
type
  DWORD = Cardinal;
var
  AdapterInfo : array of IP_ADAPTER_INFO;
  pAdapterInfo : PIP_ADAPTER_INFO;
  BufSize : DWORD;
  Status : DWORD;
  I : Integer;
  Buf : String;
  DisplayMemo: TMemo;
const
  BooleanToStr : array [Boolean] of String = ('FALSE', 'TRUE');
procedure Display(Text: string);
begin
  ShowMessage(Text);
end;
  function IpListToStr(pIpAddr : PIP_ADDR_STRING) : String;
  begin
     Result := '';
     repeat
       Result := Result + ', ' + Pchar(Addr(pIpAddr^.IpAddress));
       pIpAddr := pIpAddr.Next;
     until pIpAddr = nil;
     Delete(Result, 1, 2);
     if Result = '' then Result := 'none';
  end;
begin
//  DisplayMemo.Clear;
  BufSize := SizeOf(AdapterInfo);
//  pAdapterInfo := ;
  Status := GetAdaptersInfo(@AdapterInfo[0], BufSize);
  SetLength(AdapterInfo, BufSize div SizeOf(IP_ADAPTER_INFO));

  Status := GetAdaptersInfo(@AdapterInfo[0], BufSize);
  if Status <> ERROR_SUCCESS then begin
      case Status of
      ERROR_NOT_SUPPORTED :
          Display('GetAdaptersInfo is not supported by the operating ' +
                  'system running on the local computer.');
      ERROR_NO_DATA :
          Display('No network adapter on the local computer.');
      else
          Display('GetAdaptersInfo failed with error #' +
IntToStr(Status));
      end;
      Exit;
  end;
  repeat
      Display('Description: ' + pAdapterInfo^.Description);
      Display('Name: ' + pAdapterInfo^.AdapterName);

      Buf := '';
      for I := 0 to pAdapterInfo^.AddressLength - 1 do
          Buf := Buf + '-' + IntToHex(pAdapterInfo^.Address[I], 2);
      Delete(Buf, 1, 1);
      Display('MAC address: ' + Buf);

      Display('IP address: ' +
IpListToStr(@pAdapterInfo^.IpAddressList));
      Display('Gateway: ' +
IpListToStr(@pAdapterInfo^.GatewayList));
      DIsplay('DHCP enabled: ' + BooleanToStr[pAdapterInfo^.DhcpEnabled
<> 0]);
      Display('DHCP: ' + IpListToStr(@pAdapterInfo^.DhcpServer));
      DIsplay('Have WINS: ' + BooleanToStr[pAdapterInfo^.HaveWins]);
      Display('Primary WINS: ' +
IpListToStr(@pAdapterInfo^.PrimaryWinsServer));
      Display('Secondary WINS: ' +
IpListToStr(@pAdapterInfo^.SecondaryWinsServer));

      pAdapterInfo := pAdapterInfo^.Next;
  until pAdapterInfo = nil;
  Display('Done.');
end;

end.