SystemInfoWord文件下载.docx

SystemInfoWord文件下载.docx

《SystemInfoWord文件下载.docx》由会员分享，可在线阅读，更多相关《SystemInfoWord文件下载.docx（22页珍藏版）》请在冰豆网上搜索。

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{'

}=1;

}

defined（$Procedures{'

GetVersionEx'

API->

Import（'

kernel32'

'

BOOLGetVersionEx（LPOSVERSIONINFOlpOSVersionInfo）'

）

ordie

"

Couldnotlocatekernel32.dll-SystemInfo.pmcannotcontinue\n"

$Procedures{'

my$OSVERSIONINFO;

defined（$Structs{'

$OSVERSIONINFO=Win32:

new（'

）;

$Structs{'

}=$OSVERSIONINFO;

else{

$OSVERSIONINFO=$Structs{'

};

{

#IgnoreWin32:

APIwarnings.It'

sugly,butwhatareyougonnado?

local$SIG{__WARN__}=sub{};

$OSVERSIONINFO->

{'

dwMajorVersion'

}=0;

dwMinorVersion'

dwBuildNumber'

dwPlatformID'

szCSDVersion'

}="

"

x128;

dwOSVersionInfoSize'

}=

148;

#Win32:

sizeof（$OSVERSIONINFO）;

#148;

GetVersionEx（$OSVERSIONINFO）orreturnundef;

$dwPlatformId=$OSVERSIONINFO->

{dwPlatformID};

if（$dwPlatformId==2）{

my$majorVersion=$OSVERSIONINFO->

{dwMajorVersion};

if（$majorVersion==4）{

$osType="

WinNT"

else{

Win2K"

}

elsif（$dwPlatformId==1）{$osType="

Win9x"

return（$osTypene"

）?

$osType:

undef;

#==================

my$canUse64Bit=sub（）{#Anotherprivatesub-seeifwecando64bit

eval{my$foo=pack（"

Q"

1234）};

return（$@）?

0:

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"

）&

&

（$use64Bit））{

if（!

MEMORYSTATUSEX'

#（SeeGlobalMemoryStatusExonMSDN）

Win32:

MEMORYSTATUSEX=>

DWORDdwLength;

DWORDMemLoad;

ULONGLONGTotalPhys;

ULONGLONGAvailPhys;

ULONGLONGTotalPage;

ULONGLONGAvailPage;

ULONGLONGTotalVirtual;

ULONGLONGAvailVirtual;

ULONGLONGAvailExtendedVirtual;

}

）;

$Types{'

GlobalMemoryStatusEx'

'

BOOLGlobalMemoryStatusEx（LPMEMORYSTATUSEXlpMemoryStatusEx）'

ordie

"

$Procedures{'

my$MEMORYSTATUSEX;

$MEMORYSTATUSEX=Win32:

else{

$MEMORYSTATUSEX=$Structs{'

$MEMORYSTATUSEX->

{dwLength}=

sizeof（$MEMORYSTATUSEX）;

GlobalMemoryStatusEx（$MEMORYSTATUSEX）;

if（keys（%$return）==0）{

foreach（@params）{

$return->

{$_}=

（$_eq"

MemLoad"

?

$MEMORYSTATUSEX->

{$_}

:

{$_}/$MemFormat;

{$_}=$MEMORYSTATUSEX->

{$_}/$MemFormat

unless（!

defined（$return->

{$_}））;

MEMORYSTATUS'

#（SeeGlobalMemoryStatusonMSDN）

#Ihadtochangesomeofthetypestogetthestructto

#playnicelywithWin32:

API.TheSIZE_T'

sareactually

#DWORDSinpreviousversionsoftheWin32API,sothis

#changedoesn'

thurtanything.

#Thenamesofthemembersinthestructaredifferentthan

#intheAPItomakemylifeeasier,andtokeepthesame

#returnvaluesthismethodhasalwayshad.

MEMORYSTATUS=>

DWORDTotalPhys;

DWORDAvailPhys;

DWORDTotalPage;

DWORDAvailPage;

DWORDTotalVirtual;

DWORDAvailVirtual;

GlobalMemoryStatus'

VOIDGlobalMemoryStatus（LPMEMORYSTATUSlpMemoryStatus）'

my$MEMORYSTATUS;

$MEMORYSTATUS=Win32:

$Structs{'

}=$MEMORYSTATUS;

$MEMORYSTATUS=$Structs{'

$MEMORYSTATUS->

align（'

auto'

dwLength'

MemLoad'

TotalPhys'

AvailPhys'

TotalPage'

AvailPage'

TotalVirtual'

AvailVirtual'

GlobalMemoryStatus（$MEMORYSTATUS）;

returnundefif$MEMORYSTATUS->

{dwLength}==0;

$MEMORYSTATUS->

{$_}=$MEMORYSTATUS->

}

#==========================

subProcessorInfo（;

\%）{

my$allHash=shift;

SYSTEM_INFO'

#（SeeGetSystemInfoonMSDN）

#Win32:

APIdoesnotseemtorecognizeLPVOIDorDWORD_PTRtypes,

#sothey'

vebeenchangedtoDWORDsinthestruct.Thesevaluesare

#notcheckedbythismodule,sothisseemslikeasafewayaroundthe

#problem.

SYSTEM_INFO=>

WORDwProcessorArchitecture;

WORDwReserved;

DWORDdwPageSize;

DWORDlpMinimumApplicationAddress;

DWORDlpMaximumApplicationAddress;

DWORDdwActiveProcessorMask;

DWORDdwNumberOfProcessors;

DWORDdwProcessorType;

DWORDdwAllocationGranularity;

WORDwProcessorLevel;

WORDwProcessorRevision;

GetSystemInfo'

VOIDGetSystemInfo（LPSYSTEM_INFOlpSystemInfo）'

my$SYSTEM_INFO;

$SYSTEM_INFO=Win32:

}=$SYSTEM_INFO;

$SYSTEM_INFO=$Structs{'

$SYSTEM_INFO->

wProcessorArchitecture'

wReserved'

dwPageSize'

lpMinimumApplicationAddress'

lpMaximumApplicationAddress'

dwActiveProcessorMask'

dwNumberOfProcessors'

dwProcessorType'

dwAllocationGranularity'

wProcessorLevel'

wProcessorRevision'

GetSystemInfo（$SYSTEM_INFO）;

my$proc_type;

#Holds386,586,PPC,etc

my$num_proc;

#numberofprocessors

$num_proc=$SYSTEM_INFO->

{dwNumberOfProcessors};

if（$OSeq"

）{

$proc_type=$SYSTEM_INFO->

{dwProcessorType};

elsif（（$OSeq"

）||（$OSeq"

））{

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