SystemInfo.docx
《SystemInfo.docx》由会员分享，可在线阅读，更多相关《SystemInfo.docx（22页珍藏版）》请在冰豆网上搜索。
SystemInfo
>Win32-SystemInfo-0.11.zip>SystemInfo.pm,change:
2008-08-26,size:
22028b
packageWin32:
:
SystemInfo;
require5.005_62;
usestrict;
usewarnings;
useWin32:
:
API0.55;
useWin32:
:
TieRegistryqw（:
KEY_）;
usevarsqw（$VERSION）;
$VERSION='0.11';
#Notsurehowusefultheseareanymore-
#maygetridofthemsoon.
useconstantPROCESSOR_ARCHITECTURE_INTEL=>0;
useconstantPROCESSOR_ARCHITECTURE_MIPS=>1;
useconstantPROCESSOR_ARCHITECTURE_ALPHA=>2;
useconstantPROCESSOR_ARCHITECTURE_PPC=>3;
useconstantPROCESSOR_ARCHITECTURE_UNKNOWN=>0xFFFF;
my%Procedures=（）;
my%Types=（）;
my%Structs=（）;
#===========================
my$check_OS=sub（）#Attempttomakethisasprivateaspossible
{
my$dwPlatformId;
my$osType;
if（!
defined（$Types{'OSVERSIONINFO'}））{
#（SeeGetVersionExonMSDN）
Win32:
:
API:
:
Struct->typedef（
OSVERSIONINFO=>qw{
DWORDdwOSVersionInfoSize;
DWORDdwMajorVersion;
DWORDdwMinorVersion;
DWORDdwBuildNumber;
DWORDdwPlatformID;
TCHARszCSDVersion[128];
}
）;
$Types{'OSVERSIONINFO'}=1;
}
if（!
defined（$Procedures{'GetVersionEx'}））{
Win32:
:
API->Import（'kernel32',
'BOOLGetVersionEx（LPOSVERSIONINFOlpOSVersionInfo）'）
ordie
"Couldnotlocatekernel32.dll-SystemInfo.pmcannotcontinue\n";
$Procedures{'GetVersionEx'}=1;
}
my$OSVERSIONINFO;
if（!
defined（$Structs{'OSVERSIONINFO'}））{
$OSVERSIONINFO=Win32:
:
API:
:
Struct->new（'OSVERSIONINFO'）;
$Structs{'OSVERSIONINFO'}=$OSVERSIONINFO;
}
else{
$OSVERSIONINFO=$Structs{'OSVERSIONINFO'};
}
{
#IgnoreWin32:
:
APIwarnings.It'sugly,butwhatareyougonnado?
local$SIG{__WARN__}=sub{};
$OSVERSIONINFO->{'dwMajorVersion'}=0;
$OSVERSIONINFO->{'dwMinorVersion'}=0;
$OSVERSIONINFO->{'dwBuildNumber'}=0;
$OSVERSIONINFO->{'dwPlatformID'}=0;
$OSVERSIONINFO->{'szCSDVersion'}=""x128;
$OSVERSIONINFO->{'dwOSVersionInfoSize'}=
148;#Win32:
:
API:
:
Struct->sizeof（$OSVERSIONINFO）;
#148;#Win32:
:
API:
:
Struct->sizeof（$OSVERSIONINFO）;
GetVersionEx（$OSVERSIONINFO）orreturnundef;
$dwPlatformId=$OSVERSIONINFO->{dwPlatformID};
if（$dwPlatformId==2）{
my$majorVersion=$OSVERSIONINFO->{dwMajorVersion};
if（$majorVersion==4）{
$osType="WinNT";
}
else{
$osType="Win2K";
}
}
elsif（$dwPlatformId==1）{$osType="Win9x";}
return（$osTypene""）?
$osType:
undef;
}
};
#==================
#==================
my$canUse64Bit=sub（）{#Anotherprivatesub-seeifwecando64bit
eval{my$foo=pack（"Q",1234）};
return（$@）?
0:
1;
};
#==================
#==================
subMemoryStatus（\%;$）{
my$return=shift;#hashtoreturn
my$ret_type||=shift||"B";#whatformatdoestheuserwant?
my%fmt_types=
（B=>1,KB=>1024,MB=>1024*1024,GB=>1024*1024*1024）;
my@params=qw（MemLoadTotalPhysAvailPhysTotalPage
AvailPageTotalVirtualAvailVirtual）;
my%results;#resultsoffncall
my$MemFormat;#divisorforformat
my$dwMSLength;#validatorfromfncall
$MemFormat=
（$ret_type=~/^[BKMG]B?
$/）?
$fmt_types{$ret_type}:
$fmt_types{B};
#Determineoperatingsystem
returnundefunlessmy$OS=&$check_OS;
my$use64Bit=&$canUse64Bit;
if（（$OSeq"Win2K"）&&（$use64Bit））{
if（!
defined（$Types{'MEMORYSTATUSEX'}））{
#（SeeGlobalMemoryStatusExonMSDN）
Win32:
:
API:
:
Struct->typedef（
MEMORYSTATUSEX=>qw{
DWORDdwLength;
DWORDMemLoad;
ULONGLONGTotalPhys;
ULONGLONGAvailPhys;
ULONGLONGTotalPage;
ULONGLONGAvailPage;
ULONGLONGTotalVirtual;
ULONGLONGAvailVirtual;
ULONGLONGAvailExtendedVirtual;
}
）;
$Types{'MEMORYSTATUSEX'}=1;
}
if（!
defined（$Procedures{'GlobalMemoryStatusEx'}））{
Win32:
:
API->Import（'kernel32',
'BOOLGlobalMemoryStatusEx（LPMEMORYSTATUSEXlpMemoryStatusEx）'）
ordie
"Couldnotlocatekernel32.dll-SystemInfo.pmcannotcontinue\n";
$Procedures{'GlobalMemoryStatusEx'}=1;
}
my$MEMORYSTATUSEX;
if（!
defined（$Structs{'MEMORYSTATUSEX'}））{
$MEMORYSTATUSEX=Win32:
:
API:
:
Struct->new（'MEMORYSTATUSEX'）;
}
else{
$MEMORYSTATUSEX=$Structs{'MEMORYSTATUSEX'};
}
$MEMORYSTATUSEX->{dwLength}=
Win32:
:
API:
:
Struct->sizeof（$MEMORYSTATUSEX）;
GlobalMemoryStatusEx（$MEMORYSTATUSEX）;
if（keys（%$return）==0）{
foreach（@params）{
$return->{$_}=
（$_eq"MemLoad"）
?
$MEMORYSTATUSEX->{$_}
:
$MEMORYSTATUSEX->{$_}/$MemFormat;
}
}
else{
foreach（@params）{
$return->{$_}=$MEMORYSTATUSEX->{$_}/$MemFormat
unless（!
defined（$return->{$_}））;
}
}
}
else{
if（!
defined（$Types{'MEMORYSTATUS'}））{
#（SeeGlobalMemoryStatusonMSDN）
#Ihadtochangesomeofthetypestogetthestructto
#playnicelywithWin32:
:
API.TheSIZE_T'sareactually
#DWORDSinpreviousversionsoftheWin32API,sothis
#changedoesn'thurtanything.
#Thenamesofthemembersinthestructaredifferentthan
#intheAPItomakemylifeeasier,andtokeepthesame
#returnvaluesthismethodhasalwayshad.
Win32:
:
API:
:
Struct->typedef（
MEMORYSTATUS=>qw{
DWORDdwLength;
DWORDMemLoad;
DWORDTotalPhys;
DWORDAvailPhys;
DWORDTotalPage;
DWORDAvailPage;
DWORDTotalVirtual;
DWORDAvailVirtual;
}
）;
$Types{'MEMORYSTATUS'}=1;
}
if（!
defined（$Procedures{'GlobalMemoryStatus'}））{
Win32:
:
API->Import（'kernel32',
'VOIDGlobalMemoryStatus（LPMEMORYSTATUSlpMemoryStatus）'）
ordie
"Couldnotlocatekernel32.dll-SystemInfo.pmcannotcontinue\n";
$Procedures{'GlobalMemoryStatus'}=1;
}
my$MEMORYSTATUS;
if（!
defined（$Structs{'MEMORYSTATUS'}））{
$MEMORYSTATUS=Win32:
:
API:
:
Struct->new（'MEMORYSTATUS'）;
$Structs{'MEMORYSTATUS'}=$MEMORYSTATUS;
}
else{
$MEMORYSTATUS=$Structs{'MEMORYSTATUS'};
}
$MEMORYSTATUS->align（'auto'）;
$MEMORYSTATUS->{'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）;
returnundefif$MEMORYSTATUS->{dwLength}==0;
if（keys（%$return）==0）{
foreach（@params）{
$return->{$_}=
（$_eq"MemLoad"）
?
$MEMORYSTATUS->{$_}
:
$MEMORYSTATUS->{$_}/$MemFormat;
}
}
else{
foreach（@params）{
$return->{$_}=$MEMORYSTATUS->{$_}/$MemFormat
unless（!
defined（$return->{$_}））;
}
}
}
1;
}
#==========================
#==========================
subProcessorInfo（;\%）{
my$allHash=shift;
#Determineoperatingsystem
returnundefunlessmy$OS=&$check_OS;
if（!
defined（$Types{'SYSTEM_INFO'}））{
#（SeeGetSystemInfoonMSDN）
#Win32:
:
APIdoesnotseemtorecognizeLPVOIDorDWORD_PTRtypes,
#sothey'vebeenchangedtoDWORDsinthestruct.Thesevaluesare
#notcheckedbythismodule,sothisseemslikeasafewayaroundthe
#problem.
Win32:
:
API:
:
Struct->typedef（
SYSTEM_INFO=>qw{
WORDwProcessorArchitecture;
WORDwReserved;
DWORDdwPageSize;
DWORDlpMinimumApplicationAddress;
DWORDlpMaximumApplicationAddress;
DWORDdwActiveProcessorMask;
DWORDdwNumberOfProcessors;
DWORDdwProcessorType;
DWORDdwAllocationGranularity;
WORDwProcessorLevel;
WORDwProcessorRevision;
}
）;
$Types{'SYSTEM_INFO'}=1;
}
if（!
defined（$Procedures{'GetSystemInfo'}））{
Win32:
:
API->Import（'kernel32',
'VOIDGetSystemInfo（LPSYSTEM_INFOlpSystemInfo）'）
ordie
"Couldnotlocatekernel32.dll-SystemInfo.pmcannotcontinue\n";
$Procedures{'GetSystemInfo'}=1;
}
my$SYSTEM_INFO;
if（!
defined（$Structs{'SYSTEM_INFO'}））{
$SYSTEM_INFO=Win32:
:
API:
:
Struct->new（'SYSTEM_INFO'）;
$Structs{'SYSTEM_INFO'}=$SYSTEM_INFO;
}
else{
$SYSTEM_INFO=$Structs{'SYSTEM_INFO'};
}
{
#IgnoreWin32:
:
APIwarnings.It'sugly,butwhatareyougonnado?
local$SIG{__WARN__}=sub{};
$SYSTEM_INFO->{'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_INFO->{'dwAllocationGranularity'}=0;
$SYSTEM_INFO->{'wProcessorLevel'}=0;
$SYSTEM_INFO->{'wProcessorRevision'}=0;
GetSystemInfo（$SYSTEM_INFO）;
my$proc_type;#Holds386,586,PPC,etc
my$num_proc;#numberofprocessors
$num_proc=$SYSTEM_INFO->{dwNumberOfProcessors};
if（$OSeq"Win9x"）{
$proc_type=$SYSTEM_INFO->{dwProcessorType};
}
elsif（（$OSeq"WinNT"）||（$OSeq"Win2K"））{
my$proc_level;#firstdigitofIntelchip（5,6,etc）
my$proc_val;
$proc_val=$SYSTEM_INFO->{wProcessorArchitecture};
$proc_level=$SYSTEM_INFO->{wProcessorLevel};
#Notsureweneedtomakethischeck-who
#usesthisvalue?
if（$proc_val==PROCESSOR_ARCHITECTURE_INTEL）{
$proc_type=$proc_level."86";
}
el
升级会员 