Category: | Win32 Stuff |
Author/Contact Info | dada |
Description: | this script exploits some system APIs to emulate Unix's ifconfig -a on a Win32 machine. should work for Windoze versions 98 and later or NT SP4 and later (2000/XP/...).
it's all fair to me except that the operational status seems to always report UNREACHABLE. go figure... this was already posted in reply to List all network interfaces on the local machine?, but I think it deserves a mention in the Code Catacomb (sorry for the duplication :-). |
#!perl -w #### if_info.pl #### ---------- #### a quasi-replacement for Unix's 'ifconfig -a' under Win32 #### #### written by Aldo Calpini <dada@perl.it> on a sunny 2002.05.16 use strict; use Win32::API 0.20; use vars qw( $size $unpack $if_table $ifs @if_data $ip_table $ips @ip_data ); my $VERSION = "0.01"; my $GetIfTable = new Win32::API( 'IpHlpAPI', 'GetIfTable', 'PPI', 'N' ) or die $^E; my $GetIpAddrTable = new Win32::API( 'IpHlpAPI', 'GetIpAddrTable', 'PPI', 'N' ) or die $^E; #### from the MSDN library my @MIB_IFROW = ( [ wszName => 'a512' ], [ dwIndex => 'L' ], [ dwType => 'L' ], [ dwMtu => 'L' ], [ dwSpeed => 'L' ], [ dwPhysAddrLen => 'L' ], [ bPhysAddr => 'a8' ], [ dwAdminStatus => 'L' ], [ dwOperStatus => 'L' ], [ dwLastChange => 'L' ], [ dwInOctets => 'L' ], [ dwInUcastPkts => 'L' ], [ dwInNUcastPkts => 'L' ], [ dwInDiscards => 'L' ], [ dwInErrors => 'L' ], [ dwInUnknownProtos => 'L' ], [ dwOutOctets => 'L' ], [ dwOutUcastPkts => 'L' ], [ dwOutNUcastPkts => 'L' ], [ dwOutDiscards => 'L' ], [ dwOutErrors => 'L' ], [ dwOutQLen => 'L' ], [ dwDescrLen => 'L' ], [ bDescr => 'a256' ], ); my @MIB_IPADDRROW = ( [ dwAddr => 'L' ], [ dwIndex => 'L' ], [ dwMask => 'L' ], [ dwBCastAddr => 'L' ], [ dwReasmSize => 'L' ], [ unused1 => 'S' ], [ unused2 => 'S' ], ); #### first call to get number of bytes needed $size = pack("L", 0); $GetIpAddrTable->Call(0, $size, 1); #### real call $ip_table = "\0" x unpack("L", $size); $GetIpAddrTable->Call($ip_table, $size, 1); #### unpack the MIB_IPADDRROW structure(s) in ip_table $ips = unpack("L", $ip_table); $unpack = "L"; for my $i (0..$ips-1) { foreach my $member (@MIB_IPADDRROW) { $unpack .= $member->[1]; } } @ip_data = unpack($unpack, $ip_table); #### store ip and mask for interface index my %ip_data = (); shift @ip_data; for my $i (0..$ips-1) { my %struct; foreach my $member (@MIB_IPADDRROW) { $struct{$member->[0]} = shift @ip_data; } my $ip = if_ipaddr($struct{dwAddr}); my $if = $struct{dwIndex}; my $mask = if_ipaddr($struct{dwMask}); $ip_data{$if} = [ $ip, $mask ] if $ip ne '0.0.0.0'; } #### first call to get number of bytes needed $size = pack("L", 0); $GetIfTable->Call(0, $size, 1); #### real call $if_table = "\0" x unpack("L", $size); $GetIfTable->Call($if_table, $size, 1); #### unpack the MIB_IFROW structure(s) in if_table $ifs = unpack("L", $if_table); $unpack = "L"; for my $i (0..$ifs-1) { foreach my $member (@MIB_IFROW) { $unpack .= $member->[1]; } } @if_data = unpack($unpack, $if_table); #### dump the information shift @if_data; for my $i (0..$ifs-1) { my %struct; foreach my $member (@MIB_IFROW) { $struct{$member->[0]} = shift @if_data; } my $if_index = $struct{dwIndex}; printf "\n0x%08x", $if_index; printf " Link encap:%s ", if_type($struct{dwType}); my $hwaddr = if_hwaddr($struct{dwPhysAddrLen}, $struct{bPhysAddr}) +; printf "HWaddr %s", $hwaddr if $hwaddr; print "\n"; #### lookup inet addr and Mask from the GetIpAddrTable call if(exists $ip_data{$if_index}) { printf " inet addr:%s Mask:%s\n", $ip_data{$if_index}->[0], $ip_data{$if_index}->[1], ; } printf " MTU:%d Speed:%.2f Mbps\n", $struct{dwMtu}, $struct{dwSpeed}/1000/1000; printf " Admin status:%s Oper status:%s\n", if_admin_status($struct{dwAdminStatus}), if_oper_status($struct{dwOperStatus}); printf " RX packets:%d dropped:%d errors:%d unknown:%d\n +", $struct{dwInUcastPkts} + $struct{dwInNUcastPkts}, $struct{dwInDiscards}, $struct{dwInErrors}, $struct{dwInUnknownProtos}, ; printf " TX packets:%d dropped:%d errors:%d txqueuelen:% +d\n", $struct{dwOutUcastPkts} + $struct{dwOutNUcastPkts}, $struct{dwOutDiscards}, $struct{dwOutErrors}, $struct{dwOutQLen}, ; print " Descr: \"", unpack("Z*", $struct{bDescr}), "\"\n +"; } #### helper functions sub if_hwaddr { my($len, $addr) = @_; return join(':', map {sprintf '%02x', $_ } unpack('C' x $len, $add +r)); } sub if_type { my($type) = @_; if($type == 1) { return "Other"; } if($type == 6) { return "Ethernet"; } if($type == 9) { return "Tokenring"; } if($type == 15) { return "FDDI"; } if($type == 23) { return "PPP"; } if($type == 24) { return "Local loopback"; } if($type == 28) { return "SLIP"; } return "UNKNOWN($type)"; } sub if_admin_status { my($status) = @_; if($status == 1) { return "UP"; } if($status == 2) { return "DOWN"; } if($status == 3) { return "TESTING"; } return "UNKNOWN($status)"; } sub if_oper_status { my($status) = @_; if($status == 0) { return "NON_OPERATIONAL"; } if($status == 1) { return "UNREACHABLE"; } if($status == 2) { return "DISCONNECTED"; } if($status == 3) { return "CONNECTING"; } if($status == 4) { return "CONNECTED"; } if($status == 5) { return "OPERATIONAL"; } return "UNKNOWN($status)"; } sub if_ipaddr { my($addr) = @_; return join(".", unpack("C4", pack("L", $addr))); } __END__ |
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: if_info.pl
by grinder (Bishop) on May 17, 2002 at 20:40 UTC |
Back to
Code Catacombs