Hi list.
Any help appreciated on this: I get the following message:
Win32::OLE(0.1502) error 0x800401e4: "Invalid syntax"
after character 0 in "WinMgmts://ST_WT08978_16" at dbill.pl line 33
eval {. . .} called ad dbill.pl line 30
when running this code:
use warnings;
use strict;
use Win32::OLE;
use Data::Dumper;
$Data::Dumper::Indent=1;
sub get_all_installed ($);
sub get_vendor_serial ($);
sub os_version ($$);
my $debug = 0;
my %reg;
use Win32::TieRegistry (Delimiter => '/', TiedHash => \%reg);
Win32::OLE->Option('Warn' => 1);
@ARGV = Win32::NodeName if not @ARGV;
# dump software inventory for host
foreach my $target (@ARGV) {
chomp( $target );
$target =~ s!\0x0!!g;
print "Host: $target\n";
# Get a connection to the WMI service on the remote machine, if possible.
my $wmi = Win32::OLE->GetObject("WinMgmts://$target");
my ($vendor, $serial) = get_vendor_serial ($wmi);
print "Vendor: $vendor\n";
print "Serial: $serial\n";
# Get handle to HKLM/Software key on remote system
my $software_key = $reg{"//$target/HKEY_LOCAL_MACHINE/Software/"};
print "OS Ver: ", os_version ($wmi, $software_key), "\n";
my @pkgs = get_all_installed ($software_key);
print "----------------\n";
foreach my $pkg (@pkgs) {
my ($name, $version) = ($pkg->{'DisplayName'},
$pkg->{'DisplayVersion'});
print "Name: $name Version: $version\n";
}
print "----------------\n";
}
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Get all of the installed items on a machine. That is, find all of the things
# which show up in "Add/Remove Programs". Return a list of informational hashes,
# including the DisplayName and DisplayVersion (if any).
sub get_all_installed ($) {
my $s_key = shift;
my $uninstall_key = $s_key->{'Microsoft/Windows/CurrentVersion/Uninstall'};
my @results;
defined $uninstall_key or die "Unable to open Uninstall key: $^E";
foreach my $subkey_name ($uninstall_key->SubKeyNames) {
print $subkey_name, "\n" if $debug;
my $subkey = $uninstall_key->{$subkey_name};
print Data::Dumper->Dump([$subkey], [qw($subkey)]) if $debug;
next if (not exists $subkey->{DisplayName} or
not exists $subkey->{UninstallString});
my $pkg = { };
$pkg->{DisplayName} = $subkey->{DisplayName};
if (exists $subkey->{DisplayVersion}) {
$pkg->{DisplayVersion} = $subkey->{DisplayVersion};
} else {
$pkg->{DisplayVersion} = '<unknown>';
}
print "$subkey_name\n" if $debug;
push @results, $pkg;
}
return @results;
}
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Get the vendor and serial number of a host's BIOS, if possible. Return a pair
# of question marks if not.
sub get_vendor_serial ($) {
my $wmi = shift;
my ($vendor, $serial) = ('?', '?');
if (defined $wmi) {
# Get BIOS objects from WMI. See
# <http://msdn.microsoft.com/library/en-us/wmisdk/wmi/win32_bios.asp>
my @bioses = Win32::OLE::Enum->All($wmi->InstancesOf ('Win32_BIOS'));
my $bios = $bioses[0];
my @enclosures = Win32::OLE::Enum->All($wmi->InstancesOf(
'Win32_SystemEnclosure'));
my $enclosure = $enclosures[0];
my $new_vendor = $bios->{'Manufacturer'};
$vendor = $new_vendor if defined $new_vendor;
my $new_serial = $bios->{'SerialNumber'};
if (defined $new_serial && $new_serial =~ /\S/) {
$serial = $new_serial;
} else {
$new_vendor = $enclosure->{'Manufacturer'};
$vendor = $new_vendor if defined $new_vendor;
foreach my $key ('SerialNumber', 'SMBIOSAssetTag') {
$new_serial = $enclosure->{$key};
$serial = $new_serial if defined $new_serial && $new_serial =~ /\S/;
}
}
}
return ($vendor, $serial);
}
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub os_version ($$) {
my ($wmi, $s_key) = @_;
my $ret;
if (defined $wmi) { # We have a working WMI connection, so use it.
my @oses = Win32::OLE::Enum->All($wmi->InstancesOf('Win32_OperatingSystem'));
$ret = $oses[0]->{'Caption'};
} else {
my $base_ver = $s_key->{'Microsoft/Windows NT/CurrentVersion//CurrentVersion'};
if ($base_ver eq '4.0') {
$ret = 'Windows NT 4.0 (UNKNOWN)';
} else { # Other versions of Windows should support WMI.
die "Unrecognized base Windows version $base_ver";
}
}
return $ret;
}
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
_______________________________________________ ActivePerl mailing list [EMAIL PROTECTED] To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
