Analitcs

Pesquisar no conteúdo do blog.atlabs.com.br

quinta-feira, 3 de julho de 2014

DELPHI - IPConfig via programação

Reações: 


// Retirado partes do projeto FreePascal
// TESTADO EM DELPHI 6
Download do demo:
http://www.atlabs.com.br/download/pascal/IPCONFIG.rar
/// DFM
object Form1: TForm1
  Left = 192
  Top = 114
  Width = 726
  Height = 554
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  FormStyle = fsStayOnTop
  OldCreateOrder = False
  Position = poScreenCenter
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 0
    Top = 0
    Width = 718
    Height = 520
    Align = alClient
    Color = clBlack
    Font.Charset = OEM_CHARSET
    Font.Color = clSilver
    Font.Height = -16
    Font.Name = 'Terminal'
    Font.Style = []
    ParentFont = False
    TabOrder = 0
  end
end
/// DFM
/// PAS
unit UIPCONFIG;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
  Const
    MIB_IF_TYPE_OTHER = 1;
    MIB_IF_TYPE_ETHERNET = 6;
    IF_TYPE_ISO88025_TOKENRING = 9;
    MIB_IF_TYPE_TOKENRING = 9;
    MIB_IF_TYPE_PPP = 23;
    MIB_IF_TYPE_LOOPBACK = 24;
    MIB_IF_TYPE_SLIP = 28;
    IF_TYPE_IEEE80211 = 71;
    MIB_IF_TYPE_FDDI = 15;
    MAX_ADAPTER_DESCRIPTION_LENGTH = 128; // arb.
    MAX_ADAPTER_NAME_LENGTH        = 256; // arb.
    MAX_ADAPTER_ADDRESS_LENGTH     = 8; // arb.
    DEFAULT_MINIMUM_ENTITIES       = 32; // arb.
    MAX_HOSTNAME_LEN               = 128; // arb.
    MAX_DOMAIN_NAME_LEN            = 128; // arb.
    MAX_SCOPE_ID_LEN               = 256; // arb.
    _SS_MAXSIZE   = 128;               // Maximum size.
    _SS_ALIGNSIZE = SizeOf(Int64);  // Desired alignment.
    _SS_PAD1SIZE = _SS_ALIGNSIZE - SizeOf(short);
    _SS_PAD2SIZE = _SS_MAXSIZE - (SizeOf(short) + _SS_PAD1SIZE + _SS_ALIGNSIZE);
    iphlpapilib = 'iphlpapi.dll';
  type
    time_t = Longint;
    ULONGLONG = Int64;
    u_short = Word;
    sockaddr_storage = record
      ss_family: short;               // Address family.
      __ss_pad1: array [0.._SS_PAD1SIZE - 1] of char;  // 6 byte pad, this is to make
                                     // implementation specific pad up to
                                     // alignment field that follows explicit
                                     // in the data structure.
      __ss_align: Int64;            // Field to force desired structure.
      __ss_pad2: array [0.._SS_PAD2SIZE - 1] of char;  // 112 byte pad to achieve desired size;
                                     // _SS_MAXSIZE value minus size of
                                     // ss_family, __ss_pad1, and
                                     // __ss_align fields is 112.
    end;
    {$EXTERNALSYM sockaddr_storage}
    TSockAddrStorage = sockaddr_storage;
    PSockAddrStorage = ^sockaddr_storage;
    sockaddr = record
      sa_family: u_short;              // address family
      sa_data: array [0..13] of Char;            // up to 14 bytes of direct address
    end;
    {$EXTERNALSYM sockaddr}
    TSockAddr = sockaddr;
    PSockAddr = ^sockaddr;
    LPSOCKADDR = ^sockaddr;
    PSOCKADDR_STORAGE = ^sockaddr_storage;
    LPSOCKADDR_STORAGE = ^sockaddr_storage;
    LPSOCKET_ADDRESS = ^SOCKET_ADDRESS;
    PSOCKET_ADDRESS = ^SOCKET_ADDRESS;
    _SOCKET_ADDRESS = record
      lpSockaddr: LPSOCKADDR;
      iSockaddrLength: Integer;
    end;
    {$EXTERNALSYM _SOCKET_ADDRESS}
    SOCKET_ADDRESS = _SOCKET_ADDRESS;
    {$EXTERNALSYM SOCKET_ADDRESS}
    TSocketAddress = SOCKET_ADDRESS;
    PSocketAddress = PSOCKET_ADDRESS;
  //
  // CSAddr Information
  //
    LPCSADDR_INFO = ^CSADDR_INFO;
    {$EXTERNALSYM LPCSADDR_INFO}
    PCSADDR_INFO = ^CSADDR_INFO;
    {$EXTERNALSYM PCSADDR_INFO}
    _CSADDR_INFO = record
      LocalAddr: SOCKET_ADDRESS;
      RemoteAddr: SOCKET_ADDRESS;
      iSocketType: Integer;
      iProtocol: Integer;
    end;
    {$EXTERNALSYM _CSADDR_INFO}
    CSADDR_INFO = _CSADDR_INFO;
    {$EXTERNALSYM CSADDR_INFO}
    TCsAddrInfo = CSADDR_INFO;
    PCsAddrInfo = PCSADDR_INFO;
  //
  // Address list returned via SIO_ADDRESS_LIST_QUERY
  //
    LPSOCKET_ADDRESS_LIST = ^SOCKET_ADDRESS_LIST;
    {$EXTERNALSYM LPSOCKET_ADDRESS_LIST}
    _SOCKET_ADDRESS_LIST = record
      iAddressCount: Integer;
      Address: array [0..0] of SOCKET_ADDRESS;
    end;
    {$EXTERNALSYM _SOCKET_ADDRESS_LIST}
    SOCKET_ADDRESS_LIST = _SOCKET_ADDRESS_LIST;
    {$EXTERNALSYM SOCKET_ADDRESS_LIST}
    TSocketAddressList = SOCKET_ADDRESS_LIST;
    PSocketAddressList = LPSOCKET_ADDRESS_LIST;
  //
  //  Address Family/Protocol Tuples
  //
    LPAFPROTOCOLS = ^AFPROTOCOLS;
    {$EXTERNALSYM LPAFPROTOCOLS}
    PAFPROTOCOLS = ^AFPROTOCOLS;
    {$EXTERNALSYM PAFPROTOCOLS}
    _AFPROTOCOLS = record
      iAddressFamily: Integer;
      iProtocol: Integer;
    end;
    {$EXTERNALSYM _AFPROTOCOLS}
    AFPROTOCOLS = _AFPROTOCOLS;
    {$EXTERNALSYM AFPROTOCOLS}
    TAfProtocols = AFPROTOCOLS;
    PIP_MASK_STRING = ^IP_MASK_STRING;
    {$EXTERNALSYM PIP_MASK_STRING}
    IP_ADDRESS_STRING = record
      S: array [0..15] of Char;
    end;
    {$EXTERNALSYM IP_ADDRESS_STRING}
    PIP_ADDRESS_STRING = ^IP_ADDRESS_STRING;
    {$EXTERNALSYM PIP_ADDRESS_STRING}
    IP_MASK_STRING = IP_ADDRESS_STRING;
    {$EXTERNALSYM IP_MASK_STRING}
    TIpAddressString = IP_ADDRESS_STRING;
    PIpAddressString = PIP_MASK_STRING;
  //
  // IP_ADDR_STRING - store an IP address with its corresponding subnet mask,
  // both as dotted decimal strings
  //
    PIP_ADDR_STRING = ^IP_ADDR_STRING;
    {$EXTERNALSYM PIP_ADDR_STRING}
    _IP_ADDR_STRING = record
      Next: PIP_ADDR_STRING;
      IpAddress: IP_ADDRESS_STRING;
      IpMask: IP_MASK_STRING;
      Context: DWORD;
    end;
    {$EXTERNALSYM _IP_ADDR_STRING}
    IP_ADDR_STRING = _IP_ADDR_STRING;
    {$EXTERNALSYM IP_ADDR_STRING}
    TIpAddrString = IP_ADDR_STRING;
    PIpAddrString = PIP_ADDR_STRING;
  //
  // ADAPTER_INFO - per-adapter information. All IP addresses are stored as
  // strings
  //
    PIP_ADAPTER_INFO = ^IP_ADAPTER_INFO;
    {$EXTERNALSYM PIP_ADAPTER_INFO}
    _IP_ADAPTER_INFO = record
      Next: PIP_ADAPTER_INFO;
      ComboIndex: DWORD;
      AdapterName: array [0..MAX_ADAPTER_NAME_LENGTH + 3] of Char;
      Description: array [0..MAX_ADAPTER_DESCRIPTION_LENGTH + 3] of Char;
      AddressLength: UINT;
      Address: array [0..MAX_ADAPTER_ADDRESS_LENGTH - 1] of BYTE;
      Index: DWORD;
      Type_: UINT;
      DhcpEnabled: UINT;
      CurrentIpAddress: PIP_ADDR_STRING;
      IpAddressList: IP_ADDR_STRING;
      GatewayList: IP_ADDR_STRING;
      DhcpServer: IP_ADDR_STRING;
      HaveWins: BOOL;
      PrimaryWinsServer: IP_ADDR_STRING;
      SecondaryWinsServer: IP_ADDR_STRING;
      LeaseObtained: time_t;
      LeaseExpires: time_t;
    end;
    {$EXTERNALSYM _IP_ADAPTER_INFO}
    IP_ADAPTER_INFO = _IP_ADAPTER_INFO;
    {$EXTERNALSYM IP_ADAPTER_INFO}
    TIpAdapterInfo = IP_ADAPTER_INFO;
    PIpAdapterInfo = PIP_ADAPTER_INFO;
  //
  // The following types require Winsock2.
  //
    IP_PREFIX_ORIGIN = (
      IpPrefixOriginOther,
      IpPrefixOriginManual,
      IpPrefixOriginWellKnown,
      IpPrefixOriginDhcp,
      IpPrefixOriginRouterAdvertisement);
    {$EXTERNALSYM IP_PREFIX_ORIGIN}
    TIpPrefixOrigin = IP_PREFIX_ORIGIN;
    IP_SUFFIX_ORIGIN = (
      IpSuffixOriginOther,
      IpSuffixOriginManual,
      IpSuffixOriginWellKnown,
      IpSuffixOriginDhcp,
      IpSuffixOriginLinkLayerAddress,
      IpSuffixOriginRandom);
    {$EXTERNALSYM IP_SUFFIX_ORIGIN}
    TIpSuffixOrigin = IP_SUFFIX_ORIGIN;
    IP_DAD_STATE = (
      IpDadStateInvalid,
      IpDadStateTentative,
      IpDadStateDuplicate,
      IpDadStateDeprecated,
      IpDadStatePreferred);
    {$EXTERNALSYM IP_DAD_STATE}
    TIpDadState = IP_DAD_STATE;
    PIP_ADAPTER_UNICAST_ADDRESS = ^_IP_ADAPTER_UNICAST_ADDRESS;
    {$EXTERNALSYM PIP_ADAPTER_UNICAST_ADDRESS}
    _IP_ADAPTER_UNICAST_ADDRESS = record
      Union: record
        case Integer of
          0: (
            Alignment: ULONGLONG);
          1: (
            Length: ULONG;
            Flags: DWORD);
        end;
      Next: PIP_ADAPTER_UNICAST_ADDRESS;
      Address: SOCKET_ADDRESS;
      PrefixOrigin: IP_PREFIX_ORIGIN;
      SuffixOrigin: IP_SUFFIX_ORIGIN;
      DadState: IP_DAD_STATE;
      ValidLifetime: ULONG;
      PreferredLifetime: ULONG;
      LeaseLifetime: ULONG;
      end;
    {$EXTERNALSYM _IP_ADAPTER_UNICAST_ADDRESS}
    IP_ADAPTER_UNICAST_ADDRESS = _IP_ADAPTER_UNICAST_ADDRESS;
    {$EXTERNALSYM IP_ADAPTER_UNICAST_ADDRESS}
    TIpAdapterUnicastAddress = IP_ADAPTER_UNICAST_ADDRESS;
    PIpAdapterUnicastAddress = PIP_ADAPTER_UNICAST_ADDRESS;
    PIP_ADAPTER_ANYCAST_ADDRESS = ^_IP_ADAPTER_ANYCAST_ADDRESS;
    {$EXTERNALSYM PIP_ADAPTER_ANYCAST_ADDRESS}
    _IP_ADAPTER_ANYCAST_ADDRESS = record
      Union: record
        case Integer of
          0: (
            Alignment: ULONGLONG);
          1: (
            Length: ULONG;
            Flags: DWORD);
        end;
      Next: PIP_ADAPTER_ANYCAST_ADDRESS;
      Address: SOCKET_ADDRESS;
      end;
    {$EXTERNALSYM _IP_ADAPTER_ANYCAST_ADDRESS}
    IP_ADAPTER_ANYCAST_ADDRESS = _IP_ADAPTER_ANYCAST_ADDRESS;
    {$EXTERNALSYM IP_ADAPTER_ANYCAST_ADDRESS}
    TIpAdapterAnycaseAddress = IP_ADAPTER_ANYCAST_ADDRESS;
    PIpAdapterAnycaseAddress = PIP_ADAPTER_ANYCAST_ADDRESS;
    PIP_ADAPTER_MULTICAST_ADDRESS = ^_IP_ADAPTER_MULTICAST_ADDRESS;
    {$EXTERNALSYM PIP_ADAPTER_MULTICAST_ADDRESS}
    _IP_ADAPTER_MULTICAST_ADDRESS = record
      Union: record
        case Integer of
          0: (
            Alignment: ULONGLONG);
          1: (
            Length: ULONG;
            Flags: DWORD);
        end;
      Next: PIP_ADAPTER_MULTICAST_ADDRESS;
      Address: SOCKET_ADDRESS;
      end;
    {$EXTERNALSYM _IP_ADAPTER_MULTICAST_ADDRESS}
    IP_ADAPTER_MULTICAST_ADDRESS = _IP_ADAPTER_MULTICAST_ADDRESS;
    TIpAdapterMulticastAddress = IP_ADAPTER_MULTICAST_ADDRESS;
    PIpAdapterMulticastAddress = PIP_ADAPTER_MULTICAST_ADDRESS;
  PFIXED_INFO = ^FIXED_INFO;
  {$EXTERNALSYM PFIXED_INFO}
  FIXED_INFO = record
    HostName: array [0..MAX_HOSTNAME_LEN + 3] of Char;
    DomainName: array[0..MAX_DOMAIN_NAME_LEN + 3] of Char;
    CurrentDnsServer: PIP_ADDR_STRING;
    DnsServerList: IP_ADDR_STRING;
    NodeType: UINT;
    ScopeId: array [0..MAX_SCOPE_ID_LEN + 3] of Char;
    EnableRouting: UINT;
    EnableProxy: UINT;
    EnableDns: UINT;
  end;
  {$EXTERNALSYM FIXED_INFO}
  TFixedInfo = FIXED_INFO;
  PFixedInfo = PFIXED_INFO;
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  function GetNetworkParams(pFixedInfo: PFIXED_INFO; var pOutBufLen: ULONG): DWORD; stdcall;
  function GetNetworkParams; external iphlpapilib name 'GetNetworkParams';
  function GetAdaptersInfo(pAdapterInfo: PIP_ADAPTER_INFO; var pOutBufLen: ULONG): DWORD; stdcall;
  function GetAdaptersInfo; external iphlpapilib name 'GetAdaptersInfo';
var
  Form1: TForm1;
implementation
{$R *.dfm}
function GetAdaterTypeName(Type_:Uint):string;
begin
  case Type_ of
    MIB_IF_TYPE_ETHERNET: begin
      result:='Ethernet adapter';
    end;
    MIB_IF_TYPE_TOKENRING: begin
      result:='Token Ring adapter';
    end;
    MIB_IF_TYPE_FDDI: begin
      result:='FDDI adapter';
    end;
    MIB_IF_TYPE_PPP: begin
      result:='PPP adapter';
    end;
    MIB_IF_TYPE_LOOPBACK: begin
      result:='Loopback adapter';
    end;
    MIB_IF_TYPE_SLIP: begin
      result:='Slip adapter';
    end;
    else begin
      result:='Unknow Adapter type';
    end;
  end; // case
end;
function GetNodeTypeName(Type_:Uint):string;
begin
  case Type_ of
    1: result:='Broadcast';
    2: result:='Peer to peer';
    4: result:='Mixed';
    8: result:='Hybrid';
    else begin
      result:='Unknown';
    end;
  end; // case
end;
function FormatMAC(pAdapt:PIP_ADAPTER_INFO):string;
var
  i:Integer;
begin
  result:='';
  for i:=0 to pAdapt^.AddressLength-1 do begin
    if (i = (pAdapt^.AddressLength - 1)) then begin
      result:=result+Format('%.2X', [Integer(pAdapt^.Address[i])]);
    end else begin
      result:=result+Format('%.2X-', [Integer(pAdapt^.Address[i])]);
    end;
  end; // for
end;
function B2S(b:Boolean):String;
begin
  if b then result:='Yes' else result:='No';
end;
Procedure IPConfig(Target:TStrings);
var
  Err:DWORD;
  pFixedInfo:PFIXED_INFO;
  FixedInfoSize:DWORD;
  pAdapterInfo, pAdapt:PIP_ADAPTER_INFO ;
  AdapterInfoSize:DWORD;
  pAddrStr:PIP_ADDR_STRING;
begin
  // Get the main IP configuration information for this machine using a FIXED_INFO structure
  Err := GetNetworkParams(NIL, FixedInfoSize);
  if (Err <> 0) then begin
    if (Err <> ERROR_BUFFER_OVERFLOW) then begin
      raise Exception.CreateFmt(
        'GetNetworkParams sizing failed with error %d',
        [Err]
      );
    end;
  end;
  // Allocate memory from sizing information
  pFixedInfo := PFIXED_INFO(GlobalAlloc(GPTR, FixedInfoSize));
  if not Assigned(pFixedInfo) then begin
    raise Exception.Create(
      'Memory allocation error'
    );
  end;
  Err := GetNetworkParams(pFixedInfo, FixedInfoSize);
  if (Err = 0) then begin
    Target.Add(Format('Host Name . . . . . . . . . : %s',
[pFixedInfo^.HostName]));
    Target.Add(Format('DNS Servers . . . . . . . . : %s',
[pFixedInfo^.DnsServerList.IpAddress.S]));
    pAddrStr := pFixedInfo^.DnsServerList.Next;
    while (pAddrStr<>NIL) do begin
      Target.Add(Format('%s', [pAddrStr^.IpAddress.S]));
      pAddrStr := pAddrStr^.Next;
    end;
    Target.Add('Node Type . . . . . . . . . : ' + GetNodeTypeName(pFixedInfo^.NodeType));
  end; // if
  //
  // Enumerate all of the adapter specific information using the IP_ADAPTER_INFO structure
  // Note:  IP_ADAPTER_INFO contains a linked list of adapter entries.
  //
  AdapterInfoSize := 0;
  Err := GetAdaptersInfo(NIL, AdapterInfoSize);
  if (Err <> 0) then begin
    if (Err <> ERROR_BUFFER_OVERFLOW) then begin
      raise Exception.CreateFmt(
        'GetAdaptersInfo sizing failed with error %d',
        [Err]
      );
    end;
  end;
  // Allocate memory from sizing information
  pAdapterInfo := PIP_ADAPTER_INFO(GlobalAlloc(GPTR, AdapterInfoSize));
  if not Assigned(pAdapterInfo) then begin
    raise Exception.Create(
      'Memory allocation error'
    );
  end;
  // Get actual adapter information
  Err := GetAdaptersInfo(pAdapterInfo, AdapterInfoSize);
  if (Err <> 0) then begin
    raise Exception.CreateFmt('GetAdaptersInfo failed with error %d', [Err]);
  end;
  pAdapt := pAdapterInfo;
// loop adapters
  while (pAdapt<>NIL) do begin
    Target.Add(GetAdaterTypeName(pAdapt^.Type_));
    Target.Add(pAdapt^.AdapterName);
    Target.Add(Format('Description . . . . . . . . : %s', [pAdapt^.Description]));
    // MAC address
    Target.Add('Physical Addresses (MAC). . : ' + FormatMAC(pAdapt));
    Target.Add('DHCP Enabled. . . . . . . . : ' + B2S(pAdapt^.DhcpEnabled<>0));
    // list ip addresses
    pAddrStr := @pAdapt^.IpAddressList;
    while (pAddrStr<>NIL) do begin
      Target.Add('IP Address. . . . . . . . . : '+pAddrStr^.IpAddress.S);
      Target.Add('Subnet Mask . . . . . . . . : '+pAddrStr^.IpMask.S);
      pAddrStr := pAddrStr^.Next;
    end; // end
    // list gateways
    Target.Add('Default Gateway . . . . . . : '+pAdapt^.GatewayList.IpAddress.S);
    pAddrStr := pAdapt^.GatewayList.Next;
    while(pAddrStr <>NIL) do begin
      Target.Add(pAddrStr^.IpAddress.S);
      pAddrStr := pAddrStr^.Next;
    end; // while
    // DCHP
    Target.Add('DHCP Server . . . . . . . . : '+pAdapt^.DhcpServer.IpAddress.S);
    // WINS
    Target.Add('Primary WINS Server . . . . : '+pAdapt^.PrimaryWinsServer.IpAddress.S);
    Target.Add('Secondary WINS Server . . . : '+pAdapt^.SecondaryWinsServer.IpAddress.S);
    // next adapter
    pAdapt := pAdapt^.Next;
  end; // while
end; // procedure
procedure TForm1.FormCreate(Sender: TObject);
begin
  IPConfig(Memo1.Lines);
end;
end.
/// PAS
/// RESULTADO
Host Name . . . . . . . . . : XP_VMWARE
DNS Servers . . . . . . . . : 126.0.0.1
Node Type . . . . . . . . . : Unknown
Ethernet adapter
{E375DA2C-1591-4A90-A1B5-A5039D3EC377}
Description . . . . . . . . : VMware Accelerated AMD PCNet Adapter - Deterministic Network Enhancer Miniport
Physical Addresses (MAC). . : 00-50-56-29-41-DB
DHCP Enabled. . . . . . . . : Yes
IP Address. . . . . . . . . : 126.0.0.161
Subnet Mask . . . . . . . . : 255.255.255.0
Default Gateway . . . . . . : 126.0.0.2
DHCP Server . . . . . . . . : 126.0.0.1
Primary WINS Server . . . . : 0.0.0.0
Secondary WINS Server . . . : 0.0.0.0
/// RESULTADO 

Nenhum comentário:

Postar um comentário

Observação: somente um membro deste blog pode postar um comentário.

Max Gehringer