SystemInfo.docx

1、SystemInfo Win32-SystemInfo-0.11.zip SystemInfo.pm, change:2008-08-26,size:22028b package Win32:SystemInfo; require 5.005_62; use strict; use warnings; use Win32:API 0.55; use Win32:TieRegistry qw(:KEY_); use vars qw($VERSION); $VERSION = 0.11; # Not sure how useful these are anymore - # may get rid

2、 of them soon. use constant PROCESSOR_ARCHITECTURE_INTEL = 0; use constant PROCESSOR_ARCHITECTURE_MIPS = 1; use constant PROCESSOR_ARCHITECTURE_ALPHA = 2; use constant PROCESSOR_ARCHITECTURE_PPC = 3; use constant PROCESSOR_ARCHITECTURE_UNKNOWN = 0xFFFF; my %Procedures = (); my %Types = (); my %Struc

3、ts = (); #= my $check_OS = sub () # Attempt to make this as private as possible my $dwPlatformId; my $osType; if ( !defined( $TypesOSVERSIONINFO ) ) # (See GetVersionEx on MSDN) Win32:API:Struct-typedef( OSVERSIONINFO = qw DWORD dwOSVersionInfoSize; DWORD dwMajorVersion; DWORD dwMinorVersion; DWORD

4、dwBuildNumber; DWORD dwPlatformID; TCHAR szCSDVersion128; ); $TypesOSVERSIONINFO = 1; if ( !defined( $ProceduresGetVersionEx ) ) Win32:API-Import( kernel32, BOOL GetVersionEx(LPOSVERSIONINFO lpOSVersionInfo) ) or die Could not locate kernel32.dll - SystemInfo.pm cannot continuen; $ProceduresGetVersi

5、onEx = 1; my $OSVERSIONINFO; if ( !defined( $StructsOSVERSIONINFO ) ) $OSVERSIONINFO = Win32:API:Struct-new(OSVERSIONINFO); $StructsOSVERSIONINFO = $OSVERSIONINFO; else $OSVERSIONINFO = $StructsOSVERSIONINFO; # Ignore Win32:API warnings. Its ugly, but what are you gonna do? local $SIG_WARN_ = sub ;

6、$OSVERSIONINFO-dwMajorVersion = 0; $OSVERSIONINFO-dwMinorVersion = 0; $OSVERSIONINFO-dwBuildNumber = 0; $OSVERSIONINFO-dwPlatformID = 0; $OSVERSIONINFO-szCSDVersion = x 128; $OSVERSIONINFO-dwOSVersionInfoSize = 148; #Win32:API:Struct-sizeof($OSVERSIONINFO); #148; #Win32:API:Struct-sizeof($OSVERSIONI

7、NFO); GetVersionEx($OSVERSIONINFO) or return undef; $dwPlatformId = $OSVERSIONINFO-dwPlatformID; if ( $dwPlatformId = 2 ) my $majorVersion = $OSVERSIONINFO-dwMajorVersion; if ( $majorVersion = 4 ) $osType = WinNT; else $osType = Win2K; elsif ( $dwPlatformId = 1 ) $osType = Win9x; return ( $osType ne

8、 ) ? $osType : undef; ; #= #= my $canUse64Bit = sub () # Another private sub - see if we can do 64 bit eval my $foo = pack( Q, 1234 ) ; return ($) ? 0 : 1; ; #= #= sub MemoryStatus (%;$) my $return = shift; #hash to return my $ret_type |= shift | B; #what format does the user want? my %fmt_types = (

9、 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 = /BKMGB?$/

10、) ? $fmt_types$ret_type : $fmt_typesB; # Determine operating system return undef unless my $OS = &$check_OS; my $use64Bit = &$canUse64Bit; if ( ( $OS eq Win2K ) & ($use64Bit) ) if ( !defined( $TypesMEMORYSTATUSEX ) ) # (See GlobalMemoryStatusEx on MSDN) Win32:API:Struct-typedef( MEMORYSTATUSEX = qw

11、DWORD dwLength; DWORD MemLoad; ULONGLONG TotalPhys; ULONGLONG AvailPhys; ULONGLONG TotalPage; ULONGLONG AvailPage; ULONGLONG TotalVirtual; ULONGLONG AvailVirtual; ULONGLONG AvailExtendedVirtual; ); $TypesMEMORYSTATUSEX = 1; if ( !defined( $ProceduresGlobalMemoryStatusEx ) ) Win32:API-Import( kernel3

12、2, BOOL GlobalMemoryStatusEx(LPMEMORYSTATUSEX lpMemoryStatusEx) ) or die Could not locate kernel32.dll - SystemInfo.pm cannot continuen; $ProceduresGlobalMemoryStatusEx = 1; my $MEMORYSTATUSEX; if ( !defined( $StructsMEMORYSTATUSEX ) ) $MEMORYSTATUSEX = Win32:API:Struct-new(MEMORYSTATUSEX); else $ME

13、MORYSTATUSEX = $StructsMEMORYSTATUSEX; $MEMORYSTATUSEX-dwLength = Win32:API:Struct-sizeof($MEMORYSTATUSEX); GlobalMemoryStatusEx($MEMORYSTATUSEX); if ( keys(%$return) = 0 ) foreach (params) $return-$_ = ( $_ eq MemLoad ) ? $MEMORYSTATUSEX-$_ : $MEMORYSTATUSEX-$_ / $MemFormat; else foreach (params) $

14、return-$_ = $MEMORYSTATUSEX-$_ / $MemFormat unless ( !defined( $return-$_ ) ); else if ( !defined( $TypesMEMORYSTATUS ) ) # (See GlobalMemoryStatus on MSDN) # I had to change some of the types to get the struct to # play nicely with Win32:API. The SIZE_Ts are actually # DWORDS in previous versions o

15、f the Win32 API, so this # change doesnt 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 T

16、otalPhys; DWORD AvailPhys; DWORD TotalPage; DWORD AvailPage; DWORD TotalVirtual; DWORD AvailVirtual; ); $TypesMEMORYSTATUS = 1; if ( !defined( $ProceduresGlobalMemoryStatus ) ) Win32:API-Import( kernel32, VOID GlobalMemoryStatus(LPMEMORYSTATUS lpMemoryStatus) ) or die Could not locate kernel32.dll -

17、 SystemInfo.pm cannot continuen; $ProceduresGlobalMemoryStatus = 1; my $MEMORYSTATUS; if ( !defined( $StructsMEMORYSTATUS ) ) $MEMORYSTATUS = Win32:API:Struct-new(MEMORYSTATUS); $StructsMEMORYSTATUS = $MEMORYSTATUS; else $MEMORYSTATUS = $StructsMEMORYSTATUS; $MEMORYSTATUS-align(auto); $MEMORYSTATUS-

18、dwLength = 0; $MEMORYSTATUS-MemLoad = 0; $MEMORYSTATUS-TotalPhys = 0; $MEMORYSTATUS-AvailPhys = 0; $MEMORYSTATUS-TotalPage = 0; $MEMORYSTATUS-AvailPage = 0; $MEMORYSTATUS-TotalVirtual = 0; $MEMORYSTATUS-AvailVirtual = 0; GlobalMemoryStatus($MEMORYSTATUS); return undef if $MEMORYSTATUS-dwLength = 0;

19、if ( keys(%$return) = 0 ) foreach (params) $return-$_ = ( $_ eq MemLoad ) ? $MEMORYSTATUS-$_ : $MEMORYSTATUS-$_ / $MemFormat; else foreach (params) $return-$_ = $MEMORYSTATUS-$_ / $MemFormat unless ( !defined( $return-$_ ) ); 1; #= #= sub ProcessorInfo (;%) my $allHash = shift; # Determine operating

20、 system return undef unless my $OS = &$check_OS; if ( !defined( $TypesSYSTEM_INFO ) ) # (See GetSystemInfo on MSDN) # Win32:API does not seem to recognize LPVOID or DWORD_PTR types, # so theyve been changed to DWORDs in the struct. These values are # not checked by this module, so this seems like a

21、safe way around the # problem. Win32:API:Struct-typedef( SYSTEM_INFO = qw WORD wProcessorArchitecture; WORD wReserved; DWORD dwPageSize; DWORD lpMinimumApplicationAddress; DWORD lpMaximumApplicationAddress; DWORD dwActiveProcessorMask; DWORD dwNumberOfProcessors; DWORD dwProcessorType; DWORD dwAlloc

22、ationGranularity; WORD wProcessorLevel; WORD wProcessorRevision; ); $TypesSYSTEM_INFO = 1; if ( !defined( $ProceduresGetSystemInfo ) ) Win32:API-Import( kernel32, VOID GetSystemInfo(LPSYSTEM_INFO lpSystemInfo) ) or die Could not locate kernel32.dll - SystemInfo.pm cannot continuen; $ProceduresGetSys

23、temInfo = 1; my $SYSTEM_INFO; if ( !defined( $StructsSYSTEM_INFO ) ) $SYSTEM_INFO = Win32:API:Struct-new(SYSTEM_INFO); $StructsSYSTEM_INFO = $SYSTEM_INFO; else $SYSTEM_INFO = $StructsSYSTEM_INFO; # Ignore Win32:API warnings. Its ugly, but what are you gonna do? local $SIG_WARN_ = sub ; $SYSTEM_INFO-

24、wProcessorArchitecture = 0; $SYSTEM_INFO-wReserved = 0; $SYSTEM_INFO-dwPageSize = 0; $SYSTEM_INFO-lpMinimumApplicationAddress = 0; $SYSTEM_INFO-lpMaximumApplicationAddress = 0; $SYSTEM_INFO-dwActiveProcessorMask = 0; $SYSTEM_INFO-dwNumberOfProcessors = 0; $SYSTEM_INFO-dwProcessorType = 0; $SYSTEM_IN

25、FO-dwAllocationGranularity = 0; $SYSTEM_INFO-wProcessorLevel = 0; $SYSTEM_INFO-wProcessorRevision = 0; GetSystemInfo($SYSTEM_INFO); my $proc_type; # Holds 386,586,PPC, etc my $num_proc; # number of processors $num_proc = $SYSTEM_INFO-dwNumberOfProcessors; if ( $OS eq Win9x ) $proc_type = $SYSTEM_INF

26、O-dwProcessorType; elsif ( ( $OS eq WinNT ) | ( $OS eq Win2K ) ) my $proc_level; # first digit of Intel chip (5,6,etc) my $proc_val; $proc_val = $SYSTEM_INFO-wProcessorArchitecture; $proc_level = $SYSTEM_INFO-wProcessorLevel; # Not sure we need to make this check - who # uses this value? if ( $proc_val = PROCESSOR_ARCHITECTURE_INTEL ) $proc_type = $proc_level . 86; el