小弟刚刚接触Delphi,写了一个“利用注册表和API取WIN系统下硬件信息”程序,此程序在多台机器上测试过,并获得想要的结果,只是小弟的手中机型不是很多,可能还有好多机型没有测试过,如果那位对小弟的程序感兴趣的话不妨帮小弟测试一下,并提出宝贵意见,在此谢谢!^0^
以下是整个程序,有相关的文字注释,我就不多说了,有兴趣人慢慢看看吧!如果有错误之处,敬请指出!
unit Unit_test;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Registry, MMSystem;
{以下定义的全局变量和结构体是调用iphlpapi.dll来精确取网卡信息而用的}
Const
MAX_ADAPTER_NAME_LENGTH = 256;
MAX_ADAPTER_DESCRIPTION_LENGTH = 128;
type
PIPAdapterInfo = ^TIPAdapterInfo;
TIPAdapterInfo = Record { IP_ADAPTER_INFO }
Next : PIPAdapterInfo;
ComboIndex : Integer; //列出未用
AdapterName : Array[0..MAX_ADAPTER_NAME_LENGTH+3] of Char; //列出未用
Description : Array[0..MAX_ADAPTER_DESCRIPTION_LENGTH+3] of Char;
end;
{以上定义的全局变量和结构体是调用iphlpapi.dll来精确取网卡信息而用的}
type
TFrm_test = class(TForm)
Btn_hardware: TButton;
LBox_hardware: TListBox;
procedure FormCreate(Sender: TObject);
procedure Btn_hardwareClick(Sender: TObject);
private
{ Private declarations }
WindowsFlag:integer; // 定义一个全局变量存放 由 Win32Type过程取出得os类型
NumberOfProcessors : Integer; //CPU个数
Diskcount : Integer; //定义一个全局变量 统计磁盘块数
procedure GetWin32Type(var ICode, WinINfo: string); //操作系统以及SP版本
procedure GetProcessNumber(); //取当前系统中存在几个CPU API GetSystemInfo 取cpu个数,不分os类型
procedure GetWin2kxpCPUSingle(); //在WIN2k/xp下单个取cpu信息
procedure GetWin2kxpCPUMore(); //在WIN2k/xp下多个取cpu信息
procedure GetWin98CPU(); //在WIN98下单个cpu取信息 多个cpu不考虑
procedure GetWin2kxpBIOS(); //在WIN2k/xp下取BIOS信息
procedure GetWin98BIOS(); //在98下取BIOS信息
procedure GetWinMemory(); //取当前OS中的物理内存和虚拟内存,通过API函数取值
function JudgeVoice():Boolean; //判断声卡是否存在,存在返回 true 不存在返回 false
procedure GetWin2kxpSoundCardInfo(); //获取2k/xp下声卡信息
procedure GetWin98SoundCardInfo(); //获取98下声卡信息
//调用API取声卡信息
procedure APIGetSoundCardInfo();
procedure GetWin2kxpDisplayCardInfo(); //获取2k/xp下显卡信息
procedure GetWin98DisplayCardInfo(); //获取98下显卡信息
//调用API取显卡信息
procedure GetDisplayCardInfo();
procedure GetWin2kxpNetCardInfo(); //获取2k/xp下网卡信息
procedure GetWin98NetCardInfo(); //获取98下网卡信息
//调用未公开的API来精确取网卡信息
procedure GetAdapterInformation();
//以下是磁盘驱动信息
procedure Get2kxpDiskNumber(); //取2k/xp磁盘数量
procedure GetWin2kxpPeripheralDiskInfo(); //取2k/xp下物理硬盘、真实光盘和虚拟光盘 信息
procedure GetWin2kxpFloppyDiskInfo(); //取2k/xp下软盘硬盘信息
procedure GetWin2kxpUSBDiskInfo(); //取2k/xp下可移动硬盘信息
procedure GetWin98FloppyDiskInfo(); //取98下软盘硬盘信息
procedure GetWin98PeripheralDiskInfo(); //取98下物理硬盘信息
procedure GetWin98CDDiskInfo(); //取98下光盘信息
function myGetDriveinfoCHeck(var SDrive: TStringList): boolean; //返回合法驱动器字符串
public
{ Public declarations }
function GetSysRegistry(skey, conSysDBInfoKey: string): string; //读注册表公共函数
end;
//加载DLL iphlpapi.dll 此中用未开放的API函数
//2k/xp在系统的C:/WINDOWS/system32 文件夹里面
//98os在C:/WINDOWS/SYSTEM 文件夹里面
Function GetAdaptersInfo(AI : PIPAdapterInfo; Var BufLen : Integer) : Integer;
StdCall; External 'iphlpapi.dll' Name 'GetAdaptersInfo';
var
Frm_test: TFrm_test;
implementation
{$R *.dfm}
{ TFrm_test }
//
//窗体创建时调用事件
//
procedure TFrm_test.FormCreate(Sender: TObject);
var
ICode, WinINfo: string;
begin
GetWin32Type(ICode, WinINfo); //调用此函数为了确认当前os是什么版本
Application.Title := Frm_test.Caption;
end;
//
//读注册表公共函数,不含循环查找,本公共函数就是直接查找
//
function TFrm_test.GetSysRegistry(skey, conSysDBInfoKey: string): string;
var
Registry: TRegistry;
sTemp: string;
begin
Registry := TRegistry.Create;
try
try
Registry.RootKey := HKEY_LOCAL_MACHINE;
if Registry.OpenKey(conSysDBInfoKey, False) then
begin
sTemp := Registry.ReadString(skey);
Result := sTemp;
end;
except
Result := '';
end;
finally
Registry.CloseKey;
Registry.Free;
end;
end;
//
//API GetSystemInfo 取cpu个数,不分os类型
//
procedure TFrm_test.GetProcessNumber;
var
SysInfo: SYSTEM_INFO;
begin
//获取CPU信息
GetSystemInfo(SysInfo);
//处理器的个数
NumberOfProcessors:=SysInfo.dwNumberOfProcessors;
end;
//
//取os的类型,由API GetVersionEx() 和结构体OSVERSIONINFO 取得
//
procedure TFrm_test.GetWin32Type(var ICode, WinINfo: string);
var
VerInfo: OSVERSIONINFO;
begin
VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(VerInfo);
// win98 1 @ winme 2 @ win2000 3 @ winxp 4 @ win2003 5 @ win95 6 @ win nt 7 @ 未知版本 0
{is this Windows 2000 or XP?}
if Win32MajorVersion >= 5 then
begin
if Win32MinorVersion = 1 then
begin
WinINfo := 'WindowsXP';
ICode := '006';
WindowsFlag := 4;
end
else if Win32MinorVersion = 2 then
begin
WinINfo := 'Windows Server 2003 family';
ICode := '007';
WindowsFlag := 5;
end
else
begin
WinINfo := 'Windows2000';
ICode := '005';
WindowsFlag := 3;
end;
end
else
begin
{is this WIndows 95, 98, Me, or NT 40}
// win98 1 @ winme 2 @ win2000 3 @ winxp 4 @ win2003 5 @ win95 6 @ win nt 7 @ 未知版本 0
if Win32MajorVersion > 3 then
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
WinINfo := 'WindowsNT40';
ICode := '004';
WindowsFlag := 7;
end
else
begin
{mask off junk}
Win32BuildNumber := Win32BuildNumber and $FFFF;
if Win32MinorVersion >= 90 then
begin
WinINfo := 'WindowsMe';
ICode := '003';
WindowsFlag := 2;
end
else
begin
if Win32MinorVersion >= 10 then
begin
{Windows 98}
// win98 1 @ winme 2 @ win2000 3 @ winxp 4 @ win2003 5 @ win95 6 @ win nt 7 @ 未知版本 0
if Win32BuildNumber >= 2222 then
begin
WinINfo := 'Windows98SE';
ICode := '002';
WindowsFlag := 1;
end
else
begin
WinINfo := 'Windows98';
ICode := '002';
WindowsFlag := 1;
end;
end
else
begin {Windows 95}
if Win32BuildNumber >= 1000 then
begin
WinINfo := 'Windows95OSR2';
ICode := '001';
WindowsFlag := 6;
end
else
begin
WinINfo := 'Windows95';
ICode := '001';
WindowsFlag := 6;
end;
end;
end;
end;//if VER_PLATFORM_WIN32_NT
end
else
begin
//WinINfo := 'Win32s';
WinINfo := 'Unknown';
ICode := '999';
WindowsFlag := 0;
end;
end;//if Win32MajorVersion >= 5
WinINfo := WinINfo + ' ' + VerInfo.szCSDVersion;
end;
//
//按钮事件
//
procedure TFrm_test.Btn_hardwareClick(Sender: TObject);
begin
LBox_hardware.Clear; //清空
GetProcessNumber(); //取CPU个数
if NumberOfProcessors = 1 then //判断cpu数量,进而进行取值
begin
if (WindowsFlag = 1) or (WindowsFlag = 2) or (WindowsFlag = 6) then
begin
GetWi