Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Otros temas > Trucos
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Los mejores trucos

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 12-10-2006
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
 
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Poder: 24
seoane Va por buen camino
Obtener parametros de red

Este es un ejemplo de como obtener diferentes parámetros de red de nuestro equipo, utilizando solo funciones de la API.

Es una aplicación de consola
Código Delphi [-]
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.

Un ejemplo de lo que muestra este programa:
Código:
--- Network parameters ---
Host name: equipo01
Domain name:
DNS Servers:
        80.58.61.250
        80.58.61.254
Enable routing: No
Enable proxy: No
Enable DNS: No

--- Ip Address Table ---
Direccion IP: 192.168.1.4
Mascara: 255.255.255.0
Interface:
        Direccion MAC: 00-02-33-49-5F-90
        Tipo: ETHERNET
        MTU: 1500
        Speed: 100000000 bits/s
        Recibidos: 8826165 Bytes
        Enviados: 1653809 Bytes
        Descripcion: SURECOM EP-320X-S 100/10M Ethernet PCI Adapter

Direccion IP: 127.0.0.1
Mascara: 255.0.0.0
Interface:
        Direccion MAC:
        Tipo: LOOPBACK
        MTU: 1520
        Speed: 10000000 bits/s
        Recibidos: 630 Bytes
        Enviados: 630 Bytes
        Descripcion: MS TCP Loopback interface

Pulsa "enter" para terminar...
Responder Con Cita
  #2  
Antiguo 06-12-2006
pruz pruz is offline
Miembro
 
Registrado: sep 2003
Posts: 169
Poder: 21
pruz Va por buen camino
super bueno
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 08:38:01.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi