#!/usr/bin/perl -w
use strict;
use Data::Dumper;
use Win32::API;

#==================
sub MemoryStatus (\%;$) {
#==================
#
   my $return = shift;    #hash to return
   my $ret_type ||= shift || "B";  #what format does the user want?
   my %fmt_types =
   ( B => 1, KB => 1024, MB => 1024*1024, GB => 1024*1024*1024);
   my @params = qw(MemLoad TotalPhys AvailPhys TotalPage
                   AvailPage TotalVirtual AvailVirtual);
   my %results;          #results of fn call
   my $MemFormat;        #divisor for format
   my $dwMSLength;       #validator from fn call

   $MemFormat = ($ret_type =~ /^[BKMG]B?$/) ?
            $fmt_types{$ret_type} : $fmt_types{B};

   # (See GlobalMemoryStatus on MSDN)
   # I had to change some of the types to get the struct to
   # play nicely with Win32::API. The SIZE_T's are actually
   # DWORDS in previous versions of the Win32 API, so this
   # change doesn't hurt anything.
   # The names of the members in the struct are different than
   # in the API to make my life easier, and to keep the same
   # return values this method has always had.
   
   Win32::API::Struct->typedef( MEMORYSTATUS => qw{
	   DWORD dwLength;
	   DWORD MemLoad;
	   DWORD TotalPhys;
	   DWORD AvailPhys;
	   DWORD TotalPage;
	   DWORD AvailPage;
	   DWORD TotalVirtual;
	   DWORD AvailVirtual;
   });
   Win32::API->Import('kernel32', 'VOID GlobalMemoryStatus(LPMEMORYSTATUS lpMemoryStatus)')
   or die "Could not locate kernel32.dll - SystemInfo.pm cannot continue\n";
   my $MEMORYSTATUS = Win32::API::Struct->new('MEMORYSTATUS');
print "***BEFORE GMS\n";   
   GlobalMemoryStatus($MEMORYSTATUS);
print "***AFTER GMS\n";   
   return undef if $MEMORYSTATUS->{dwLength} == 0;
   if (keys(%$return) == 0) {
   foreach (@params) {
    $return->{$_} = ($_ eq "MemLoad") ? $MEMORYSTATUS->{$_} : $MEMORYSTATUS->{$_}/$MemFormat;
    }
   }
   else {
    foreach (@params){
	 $return->{$_} = $MEMORYSTATUS->{$_}/$MemFormat unless (!exists($return->{$_}));
        }
   }
   1;
}

my %mh;
MemoryStatus(%mh,"KB");
foreach my $k (keys %mh) {
    print "$mh{$k}\n";
}