Obtener parametros de red

program ipview;
 
{$APPTYPE CONSOLE}
 
uses Windows, SysUtils;
 
const
  MAX_HOSTNAME_LEN = 128;
  MAX_DOMAIN_NAME_LEN = 128;
  MAX_SCOPE_ID_LEN = 256;
 
  MAX_INTERFACE_NAME_LEN = 256;
  MAXLEN_PHYSADDR = 8;
  MAXLEN_IFDESCR = 256;
 
  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;
 
 
type
  PULONG = ^ULONG;
 
  IP_ADDRESS_STRING = array[1..16] of Char;
  IP_MASK_STRING = array[1..16] of Char;
 
  PIP_ADDR_STRING = ^TIP_ADDR_STRING;
  TIP_ADDR_STRING = record
    Next: PIP_ADDR_STRING;
    IpAddress: IP_ADDRESS_STRING;
    IpMask: IP_MASK_STRING;
    Context: DWORD;
  end;
 
  PFIXED_INFO = ^TFIXED_INFO;
  TFIXED_INFO = record
    HostName: array[1..MAX_HOSTNAME_LEN + 4] of Char;
    DomainName: array[1..MAX_DOMAIN_NAME_LEN + 4] of Char;
    CurrentDnsServer: PIP_ADDR_STRING;
    DnsServerList: TIP_ADDR_STRING;
    NodeType: UINT;
    ScopeId: array[1..MAX_SCOPE_ID_LEN + 4] of Char;
    EnableRouting: UINT;
    EnableProxy: UINT;
    EnableDns: UINT;
  end;
 
  PMIB_IPADDRROW = ^TMIB_IPADDRROW;
  TMIB_IPADDRROW = packed record
    dwAddr: DWORD;
    dwIndex: DWORD;
    dwMask: DWORD;
    dwBCastAddr: DWORD;
    dwReasmSize: DWORD;
    unused1: SmallInt;
    wType: SmallInt;
  end;
 
  PMIB_IPADDRTABLE = ^TMIB_IPADDRTABLE;
  TMIB_IPADDRTABLE = record
    dwNumEntries: DWORD;
    table: array[0..0] of TMIB_IPADDRROW;
  end;
 
  PMIB_IFROW = ^TMIB_IFROW;
  TMIB_IFROW  = record
    wszName: array[1..MAX_INTERFACE_NAME_LEN] of WCHAR;
    dwIndex: DWORD;
    dwType: DWORD;
    dwMtu: DWORD;
    dwSpeed: DWORD;
    dwPhysAddrLen: DWORD;
    bPhysAddr: array[1..MAXLEN_PHYSADDR] of Byte;
    dwAdminStatus: DWORD;
    dwOperStatus: DWORD;
    dwLastChange: DWORD;
    dwInOctets: DWORD;
    dwInUcastPkts: DWORD;
    dwInNUcastPkts: DWORD;
    dwInDiscards: DWORD;
    dwInErrors: DWORD;
    dwInUnknownProtos: DWORD;
    dwOutOctets: DWORD;
    dwOutUcastPkts: DWORD;
    dwOutNUcastPkts: DWORD;
    dwOutDiscards: DWORD;
    dwOutErrors: DWORD;
    dwOutQLen: DWORD;
    dwDescrLen: DWORD;
    bDescr: array[1..MAXLEN_IFDESCR] of Byte;
  end;
 
function GetNetworkParams(FixedInfo: PFIXED_INFO; OutBufLen: PULONG): DWORD;
  stdcall; external 'iphlpapi.dll' name 'GetNetworkParams';
 
function GetIpAddrTable(IpAddrTable: PMIB_IPADDRTABLE; pdwSize: PULONG;
  Order: BOOL): DWORD; stdcall; external 'iphlpapi.dll' name 'GetIpAddrTable';
 
function GetIfEntry(pIfRow: PMIB_IFROW): DWORD;
  stdcall; external 'iphlpapi.dll' name 'GetIfEntry';
 
function IpToStr(Ip: DWORD): string;
begin
  Result:= Format('%d.%d.%d.%d',
      [IP and $FF,(IP shr 8) and $FF,(IP shr 16) and $FF,(IP shr 24) and $FF]);
end;
 
function PhysAddrToStr(PhysAddr: PByte; Len: DWORD): string;
begin
  Result:= EmptyStr;
  while Len > 1  do
  begin
    Result:= Result + IntToHex(PhysAddr^,2) + '-';
    inc(PhysAddr);
    dec(Len);
  end;
  if Len > 0 then
    Result:= Result + IntToHex(PhysAddr^,2);
end;
 
function IfTypeToStr(IfType: DWORD): string;
begin
  case ifType of
    MIB_IF_TYPE_ETHERNET: Result:= 'ETHERNET';
    MIB_IF_TYPE_TOKENRING: Result:= 'TOKENRING';
    MIB_IF_TYPE_FDDI: Result:= 'FDDI';
    MIB_IF_TYPE_PPP: Result:= 'PPP';
    MIB_IF_TYPE_LOOPBACK: Result:= 'LOOPBACK';
    MIB_IF_TYPE_SLIP: Result:= 'SLIP';
    else
      Result:= EmptyStr;
  end;
end;
 
function BoolToYesNo(Value: Boolean): string;
begin
  if Value then
    Result:= 'Si'
  else
    Result:= 'No';
end;
 
procedure Vamos;
var
  FixedInfo: PFIXED_INFO;
  OutBufLen: ULONG;
  IpAddr: PIP_ADDR_STRING;
  IfRow: TMIB_IFROW;
  Table: PMIB_IPADDRTABLE;
  Size: DWORD;
  i: Integer;
begin
  // Network parameters
  GetMem(FixedInfo,Sizeof(FixedInfo));
  try
    OutBufLen:= Sizeof(FixedInfo);
    if GetNetworkParams(FixedInfo,@OutBufLen) = ERROR_BUFFER_OVERFLOW then
    begin
      FreeMem(FixedInfo);
      GetMem(FixedInfo,OutBufLen);
    end;
    if GetNetworkParams(FixedInfo,@OutBufLen) = NO_ERROR then
    begin
      Writeln('--- Network parameters ---');
      Writeln('Host name: ' + String(PChar(@FixedInfo.HostName)));
      Writeln('Domain name: ' + String(PChar(@FixedInfo.DomainName)));
      Writeln('DNS Servers:');
      IpAddr:= @FixedInfo.DnsServerList;
      while IpAddr <> nil do
      begin
        Writeln(#9 + String(PChar(@IpAddr.IpAddress)));
        IpAddr:= IpAddr.Next;
      end;
      Writeln('Enable routing: ' + BoolToYesNo(Boolean(FixedInfo.EnableRouting)));
      Writeln('Enable proxy: ' + BoolToYesNo(Boolean(FixedInfo.EnableProxy)));
      Writeln('Enable DNS: ' + BoolToYesNo(Boolean(FixedInfo.EnableDNS)));
      Writeln;
    end;
  finally
    FreeMem(FixedInfo);
  end;
  // Ip Address Table
  GetMem(Table, Sizeof(TMIB_IPADDRTABLE));
  try
    Size:= Sizeof(TMIB_IPADDRTABLE);
    if GetIpAddrTable(Table, @Size,  FALSE) =  ERROR_INSUFFICIENT_BUFFER then
    begin
      FreeMem(Table);
      GetMem(Table,Size);
    end;
    FillChar(Table^,Size,0);
    if GetIpAddrTable(Table, @Size,  FALSE) =  NO_ERROR then
    begin
      Writeln('--- Ip Address Table ---');
      for i:= 0 to Table.dwNumEntries - 1 do
      begin
        with Table.table[i] do
        begin
          Writeln('Direccion IP: ' + IpToStr(dwAddr));
          Writeln('Mascara: ' + IpToStr(dwMask));
        end;
        FillChar(IfRow,Sizeof(IfRow),0);
        IfRow.dwIndex:= Table.table[i].dwIndex;
        if GetIfEntry(@IfRow) =  NO_ERROR then
          with IfRow do
          begin
            Writeln('Interface:');
            Writeln(#9 + 'Direccion MAC: ' + PhysAddrToStr(@bPhysAddr,dwPhysAddrLen));
            Writeln(#9 + 'Tipo: ' + IfTypeToStr(dwType));
            Writeln(#9 + 'MTU: ' + IntToStr(dwMTU));
            Writeln(#9 + 'Speed: ' + IntToStr(dwSpeed) + ' bits/s');
            Writeln(#9 + 'Recibidos: ' + IntToStr(dwInOctets) + ' Bytes');
            Writeln(#9 + 'Enviados: ' + IntToStr(dwOutOctets) + ' Bytes');
            // Recortamos la descripcion a 50 caracteres
            Writeln(#9 + 'Descripcion: ' + Copy(String(PChar(@bDescr)),1,50));
          end;
        Writeln;
      end;
    end;
  finally
    FreeMem(Table);
  end;
end;
 
begin
  Vamos;
  Writeln('Pulsa "enter" para terminar ...'); 
  Readln;
end.