Forrest Payne wrote:

> I was wondering if anyone had a code snipit that I can use to retreive
> driver information from HBA's or SCSI cards installed in a Windows
> server.  I also want to try and get the firmware version as well but I'm
> not sure if I can even get that using Perl or not. The cards are Emulex
> 10000 Fibre Cards and Adaptec Scsi cards if it matters.

WMI is probably your best bet, but figuring out the class names is
the hard part.  For example, your SCSI controller may be found in
object 'Win32_SCSIController' or 'Win32_SCSIControllerDevice' and
the network cards will probably be in 'Win32_NetworkAdapter' or
'Win32_NetworkAdapterConfiguration'.

WMI classes are enumerated here:

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/win32_classes.asp


Here's a script to display the properties for a given class object:

#!perl -w --

use strict;
use Win32::OLE qw(in);
use Data::Dumper; $Data::Dumper::Indent=1;

our %A;         # get commandline switches into %A
for (my $ii = 0; $ii < @ARGV; ) {
        last if $ARGV[$ii] =~ /^--$/;
        if ($ARGV[$ii] !~ /^-{1,2}(.*)$/) { $ii++; next; }
        my $arg = $1; splice @ARGV, $ii, 1;
        if ($arg =~ /^([\w]+)=(.*)$/) { $A{$1} = $2; } else { $A{$1}++; }
}

$| = 1;

my $debug = $A{d} || 0;
my $mach = $A{m} || Win32::NodeName;
print "mach = $mach\n" if $debug;

my $usage = <<EOD;

Usage: $0 [-m=<machine>] <class> [[<property>|'*']
        class           class to view
        property        property of class (def: *=[all])

EOD
die $usage if $A{h} or $A{help} or (@ARGV < 1 and not $A{a});

print "ARGV = @ARGV\n" if $debug;

my $Win32_Class = shift;
print "Class = '$Win32_Class'\n";

my @Property = @ARGV;
@Property = ('*') if not @Property;

my $Class = "WinMgmts:\\\\$mach";

print "GetObject '$Class', Property='@Property'\n" if $debug;
my $WMI = Win32::OLE->GetObject($Class) or
  die "Win32::OLE->GetObject($Class): $!";

print "Select * From '$Class'\n" if $debug;
my $objs = $WMI->ExecQuery("SELECT * FROM $Win32_Class");
if (scalar (in $objs) < 1) {
        print "Class '$Class' returned no objects\n";
        exit;
}

foreach my $node (in $objs) {

        print Data::Dumper->Dump([$node], [qw($node)]) if $debug;
        my @objs = (Win32::OLE::Enum->All($node->{Properties_}));
        foreach my $obj (@objs) {       # $obj is hashref

                my $name = $obj->{Name};
                print "Property '$name'\n" if $debug;
                my $cnt = grep { $name eq $_ } @Property;
                next if not $cnt and $Property[0] ne '*';

                our $oref;
                eval { $oref = ref $obj->{Value}; };
                next if not defined $oref;

                if (ref ($obj->{Value}) eq "ARRAY") {

                        my $vals = $obj->{Value};
                        print scalar @$vals, " values\n" if $debug;
                        print "  $obj->{Name} = {";
                        my $first = 0;
                        foreach my $value (@$vals) {
                                print ", " if $first++;
                                if (not defined $value) {
                                        print '<undef>';
                                } else {
                                        print "'$value'";
                                }
                        }
                        print "}\n";
                } else {
                        my $value = $obj->{Value};
                        if (not defined $value) {
                                print "  $obj->{Name} = <undef>\n";
                        } else {
                                print "  $obj->{Name} = '$value'\n";
                        }
                }
        }
        print "\n";
}
exit;

#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

__END__

-- 
  ,-/-  __      _  _         $Bill Luebkert    Mailto:[EMAIL PROTECTED]
 (_/   /  )    // //       DBE Collectibles    Mailto:[EMAIL PROTECTED]
  / ) /--<  o // //      Castle of Medieval Myth & Magic http://www.todbe.com/
-/-' /___/_<_</_</_    http://dbecoll.tripod.com/ (My Perl/Lakers stuff)
_______________________________________________
Perl-Win32-Users mailing list
[email protected]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs

Reply via email to