Delphi 利用注册表和API取WIN系统下硬件信息

小弟刚刚接触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
      GetWin98CPU();                //取98下cpu信息
      GetWin98BIOS();               //取98下BIOS信息
    end
    else
    begin
      GetWin2kxpCPUSingle();        //单个cpu
      GetWin2kxpBIOS();             //取2k下BIOS
    end;
  end
  else   //NumberOfProcessors > 1
  begin
     GetWin2kxpCPUMore(); //多个cpu
     GetWin2kxpBIOS();    //取2k下BIOS   多个
  end;  // NumberOfProcessors = 1
  GetWinMemory();  //os内存
  //网卡信息
  GetAdapterInformation();         //通过API来取网卡信息
  //声卡信息     通过注册表去取
  {if JudgeVoice then   //首先判断声卡是否存在，不存在就取，不存在就不去取
  begin
    if (WindowsFlag = 1) or (WindowsFlag = 2) or (WindowsFlag = 6) then    //98os系列
      GetWin98SoundCardInfo()
    else
      GetWin2kxpSoundCardInfo();     //NT OS系列
  end; //声卡信息 }
  if JudgeVoice then
  begin
    APIGetSoundCardInfo(); //通过API去取声卡信息
  end;
  //通过API取声卡信息
  GetDisplayCardInfo();
  //显卡信息  网卡 磁盘驱动器
  if (WindowsFlag = 1) or (WindowsFlag = 2) or (WindowsFlag = 6) then
  begin
    //GetWin98DisplayCardInfo();    //取98下多个显卡信息
    //GetWin98NetCardInfo();        //通过注册表取98下网卡信息
    GetWin98FloppyDiskInfo();      //取98下软盘驱动器
    GetWin98PeripheralDiskInfo();  //取98下硬盘驱动器
    GetWin98CDDiskInfo();          //取98下光盘驱动器
  end
  else
  begin
    //GetWin2kxpDisplayCardInfo();     //取2k/xp下多个显卡信息
    //GetWin2kxpNetCardInfo();       //通过注册表取2k/xp下网卡信息
    GetWin2kxpFloppyDiskInfo();      //2k以上软盘驱动器
    GetWin2kxpPeripheralDiskInfo();  //物理固定磁盘、真实光驱和虚拟光驱信息
  end;   //显卡信息
  Get2kxpDiskNumber();               //取系统中磁盘数量
  if Diskcount >1 then
     GetWin2kxpUSBDiskInfo();        //取可移动磁盘驱动器
end;
//*************************************CPU**************************************
//
//当前系统(NT以上)中单个CPU取信息信息
//
procedure TFrm_test.GetWin2kxpCPUSingle;
var
  myreg: TRegistry; //定义TRegistry型变量myreg
  Temp : String;
begin
  myreg:= TRegistry.Create;//利用Tregistry的Create方法创建一个实例myreg。
  try
    myreg.RootKey:= HKEY_LOCAL_MACHINE;//确定打开注册表的主键。
    if myreg.OpenKey('/HARDWARE/DESCRIPTION/System/CentralProcessor/0',false) then
    begin
      if myreg.ValueExists('ProcessorNameString') then //判断是否存在'ProcessorNameString'
      begin
        Temp := Trim(myreg.ReadString('ProcessorNameString'));
        LBox_hardware.Items.Add('CPU：       '+Temp);
      end
      else
      begin
        Temp := Trim(myreg.ReadString('VendorIdentifier'))+'  '+ Trim(myreg.ReadString('Identifier'));
        LBox_hardware.Items.Add('CPU：      '+Temp);
      end;
    end;
  finally
    myreg.CloseKey;
    myreg.Free;
  end;
end;
//
//当前系统(NT以上)中多个CPU取信息信息
//
procedure TFrm_test.GetWin2kxpCPUMore;
var
  myreg: TRegistry; //定义TRegistry型变量myreg
  Temp : String;
  i:integer; //循环变量
  sTemp: TStringList;
const
  rk = '/HARDWARE/DESCRIPTION/System/CentralProcessor/';
begin
  myreg:= TRegistry.Create;//利用Tregistry的Create方法创建一个实例myreg。
  sTemp := TStringList.Create;
  try
    myreg.RootKey:= HKEY_LOCAL_MACHINE;//确定打开注册表的主键。
    if myreg.OpenKey(rk,false) then
    begin
      myreg.GetKeyNames(sTemp);  //取下级键值，并存入 TStringList 中
      myreg.CloseKey;
      for i := 0 to sTemp.Count-1 do
      if myReg.OpenKey(rk+sTemp[i],false) then
      begin
        if myreg.ValueExists('ProcessorNameString') then //判断是否存在'ProcessorNameString'
        begin
          Temp := Trim(myreg.ReadString('ProcessorNameString'));
          LBox_hardware.Items.Add('CPU：       '+Temp);
        end
        else
        begin
          Temp := Trim(myreg.ReadString('VendorIdentifier'))+'  '+ Trim(myreg.ReadString('Identifier'));
          LBox_hardware.Items.Add('CPU：      '+Temp);
        end;  // myreg.ValueExists('ProcessorNameString')
      end; // myReg.OpenKey(rk+'/'+sTemp1[i],false)
    end;  // myreg.OpenKey(rk,false)
  finally
    if Assigned(myreg) then
      myreg.Free;
    if Assigned(sTemp) then
      sTemp.Free;
  end;
end;
//
// 98os 下无此 ProcessorNameString 值
//
procedure TFrm_test.GetWin98CPU;
var
  myreg: TRegistry; //定义TRegistry型变量myreg
  Temp : string;
begin
  myreg:= TRegistry.Create;//利用Tregistry的Create方法创建一个实例myreg。

  try
    myreg.RootKey:= HKEY_LOCAL_MACHINE;//确定打开注册表的主键。
    if myreg.OpenKey('/HARDWARE/DESCRIPTION/System/CentralProcessor/0',false) then
    begin
     if myreg.ValueExists('Identifier') then
     begin
       Temp:=myreg.ReadString('VendorIdentifier')+'   '+ myreg.ReadString('Identifier')+'  '+ Trim(myreg.ReadString('ProcessorNameString'));
       LBox_hardware.Items.Add('CPU：       '+Trim(Temp));
     end;
    end;
  finally
    myreg.CloseKey;
    myreg.Free;
  end;
end;
//************************************CPU***************************************

//***************************************BIOS***********************************
//
//win2k/xp 下取BIOS信息  涉及到处理多重字符串  REG_MULTI_SZ
//
procedure TFrm_test.GetWin2kxpBIOS;
var
  myreg: TRegistry; //定义TRegistry型变量myreg
  STemp,sTemp1,sTemp2: string;
  Mtype,ValueSize:Dword;
  ArrChar:array [0..1000] of char;
  i: Integer;
  c: char;
begin
  myreg := TRegistry.Create; //利用Tregistry的Create方法创建一个实例myreg。
  try
   Mtype:=REG_MULTI_SZ;
   myreg.RootKey:= HKEY_LOCAL_MACHINE;//确定打开注册表的主键。
   if myreg.OpenKey('/HARDWARE/DESCRIPTION/System',false) then
     begin
       ValueSize:=sizeof(ArrChar);
       //bdata := StrAlloc(ValueSize);
       RegQueryValueEx(myreg.CurrentKey, PChar('SystemBiosVersion'), nil, @Mtype, @ArrChar,@ValueSize);
       sTemp1:=ArrChar;
       //***********去除数组中的“#0” 如果遇到连续两个“#0”则退出。
       for i:=0 to 1000 do
       begin
          c := ArrChar[i];
          while c = #0 do
          begin
            while ArrChar[i+1]<>#0 do
            begin
              ArrChar[i]:=' ';
              break;
            end;
            break;
          end;
       end;
      //***********************
       sTemp := ArrChar;
       sTemp2 := GetSysRegistry('SystemBiosDate','/HARDWARE/DESCRIPTION/System'); //调用共用函数取bios时间
       LBox_hardware.Items.Add('BIOS：       '+Trim(STemp)+'  '+Trim(sTemp2));
     end;
  finally
    myreg.CloseKey;
    myreg.Free;
  end;
end;
//
//98下取BIOS信息
//
procedure TFrm_test.GetWin98BIOS;
var
  STemp: string;
const
  rkBIOSwIN98 = '/ENUM/ROOT/*PNP0C01/0000'; //  98os注册表路径
  rvBiosDate = 'SystemBiosDate';
  rvBiosVersion = 'SystemBiosVersion';
begin
  STemp := Trim(GetSysRegistry('BIOSVersion', rkBIOSwIN98)) + '   ';
  STemp:= STemp + Trim(GetSysRegistry('BIOSDate', rkBIOSwIN98));
  LBox_hardware.Items.Add('BIOS：       '+STemp);
end;
//**********************************BIOS****************************************

//*******************************OS物理内存和虚拟内存***************************
//
//通过结构体 MEMORYSTATUS  取内存参数
//
procedure TFrm_test.GetWinMemory;
var
  PhysicalTotalOut,PhysicalFreeOut,VirtualTotalOut,VirtualFreeOut:string;
  MemStatus: MEMORYSTATUS;
begin
  MemStatus.dwLength := sizeof(MEMORYSTATUS);
  GlobalMemoryStatus(MemStatus); //返回内存使用信息
  PhysicalTotalOut:=FormatFloat(' Physical Memory Total: #,## ',Round(MemStatus.dwTotalPhys/ 1024 / 1024));
  PhysicalFreeOut:=FormatFloat(' Physical Memory Free: #,## ',MemStatus.dwAvailPhys/ 1024 / 1024);
  VirtualTotalOut:=FormatFloat(' Virtual Memory Total: #,## ',MemStatus.dwTotalVirtual/ 1024 / 1024);
  VirtualFreeOut:=FormatFloat(' Virtual Memory Free: #,## ',MemStatus.dwAvailVirtual/ 1024 / 1024);
  LBox_hardware.Items.Add('物理内存：    '+'Total' +  PhysicalTotalOut  + 'M   Free' +  PhysicalFreeOut + 'M');
  LBox_hardware.Items.Add('虚拟内存：    '+'Total' +  VirtualTotalOut  + 'M   Free' +  VirtualFreeOut + 'M');
end;
//******************************OS物理内存和虚拟内存****************************

//**************************************声卡信息********************************
//
//判断声卡是否存在，存在返回true、不存在返回false
//
function TFrm_test.JudgeVoice: Boolean;
begin
  if WaveOutGetNumDevs <=0 then
    Result := false
  else
    Result := true;
end;
//
//取2k/xp下声卡信息,可能存在多个声卡信息，进行循环取
//
procedure TFrm_test.GetWin2kxpSoundCardInfo;
var
  i,a:integer;
  sTemp1,sTemp2: TStringList;
  SML1,SML2,Temp,MEDIAtype: string;
  Registry: TRegistry;
const
  rk = '/SYSTEM/CurrentControlSet/Control/Class/{4D36E96C-E325-11CE-BFC1-08002BE10318}';
begin
  Registry := TRegistry.Create; //创建 TRegistry 实例
  sTemp1 := TStringList.Create;//创建 TStringList 实例
  sTemp2 := TStringList.Create;
  try
    begin
      Registry.RootKey := HKEY_LOCAL_MACHINE;
      if Registry.OpenKey(rk, False) then
      begin
        Registry.GetKeyNames(sTemp1);
        Registry.CloseKey;
        for i := 0 to sTemp1.Count - 1 do
          if Registry.OpenKey(rk+'/'+sTemp1[i],false) then
          begin
            SML1 := sTemp1[i];
            Registry.GetKeyNames(sTemp2);
            Registry.CloseKey;
            if sTemp2.Count <> 0 then
            begin
               SML2 := rk + '/' + SML1;
               if Registry.OpenKey(SML2,false) then
               begin
                 if (Registry.ValueExists('DriverDesc')) and Registry.ValueExists('MatchingDeviceId') then
                 begin
                   Temp := Trim(Registry.ReadString('MatchingDeviceId'));
                   while Pos('/',Temp) > 0 do
                   begin
                     a := Pos('/',Temp);
                     MEDIAtype := Copy(Temp,0,a -1);
                     if UpperCase(MEDIAtype) = 'PCI'  then
                       LBox_hardware.Items.Add('声卡：  '+Trim(Registry.ReadString('DriverDesc')));
                     break;
                   end;// while Pos('/',Temp) > 0 do
                 end;
               end;//if Registry.OpenKey(SML2,false) then
            end;
          end;//if Registry.OpenKey(rk+'/'+sTemp1[i],false) then
      end;//if Registry.OpenKey(rk, False) then
    end;
  finally
    if Assigned(Registry) then
      Registry.Free;
    if Assigned(sTemp1) then
      sTemp1.Free;
    if Assigned(sTemp2) then
      sTemp2.Free;
  end;
end;
//
//取98下声卡信息,可能存在多个声卡信息，进行循环取
//
procedure TFrm_test.GetWin98SoundCardInfo;
var
  i:integer;
  sTemp1,sTemp2: TStringList;
  SML1,SML2: string;
  Registry: TRegistry;
const
  rk = '/Enum/ACPI';
begin
  Registry := TRegistry.Create; //创建 TRegistry 实例
  sTemp1 := TStringList.Create;//创建 TStringList 实例
  sTemp2 := TStringList.Create;
  try
   // while Registry do
    begin
      Registry.RootKey := HKEY_LOCAL_MACHINE;
      if Registry.OpenKey(rk, False) then
      begin
        Registry.GetKeyNames(sTemp1);
        Registry.CloseKey;
        for i := 0 to sTemp1.Count - 1 do
          if Registry.OpenKey(rk+'/'+sTemp1[i],false) then
          begin
            SML1 := sTemp1[i];
            Registry.GetKeyNames(sTemp2);
            Registry.CloseKey;
            if sTemp2.Count <> 0 then
            begin
               SML2 := rk + '/' + SML1 + '/0' ;
               if Registry.OpenKey(SML2,false) then
                begin
                    if Registry.ReadString('Class')='MEDIA' then
                      LBox_hardware.Items.Add('声卡：    '+ Trim(Registry.ReadString('DeviceDesc')));
                end;
            end;
          end;//if Registry.OpenKey(rk+'/'+sTemp1[i],false) then
      end;//if Registry.OpenKey(rk, False) then
    end;
  finally
    if Assigned(Registry) then
      Registry.Free;
    if Assigned(sTemp1) then
      sTemp1.Free;
    if Assigned(sTemp2) then
      sTemp2.Free;
  end;
end;
//
//通过API来取声卡信息
//
procedure TFrm_test.APIGetSoundCardInfo;
var
  wavecap:  TWaveOutCaps;
  i,iNumDevs:integer;
  sTemp:string;
begin
  iNumDevs:=waveOutGetNumDevs;
  if ( iNumDevs> 0) then
  begin
    for I := 0 to iNumDevs - 1 do
    begin
      waveOutGetDevCaps(I, @wavecap, SizeOf(wavecap));
      sTemp:=string(wavecap.szPname);
      LBox_hardware.Items.Add('声卡：   '+Trim(sTemp))
    end;
  end;
end;
//************************************声卡信息**********************************

//************************************显卡信息**********************************
//
//获取2k/xp下显卡信息
//
procedure TFrm_test.GetWin2kxpDisplayCardInfo;
var
  i: integer;
  slTempl: TStringList;
  rk: string;
  Registry: TRegistry;
  Temp,Displaytype : String;
  a : Integer;
begin
  rk := '/SYSTEM/CurrentControlSet/Control/Class/{4D36E968-E325-11CE-BFC1-08002BE10318}';
  Registry := TRegistry.Create;
  try
    with Registry do
    begin
      rootkey := HKEY_LOCAL_MACHINE;
      if openkey(rk, False) then
      begin
        slTempl := TStringList.Create;
        getkeynames(slTempl);
        closekey;
        try
          for  i := 0 to slTempl.Count-1 do
          begin
            if openkey(rk+'/'+slTempl[i], False) then
            begin
              if  (valueexists('DriverDesc')) and (valueexists('MatchingDeviceId')) then
              begin
                Temp := Trim(ReadString('MatchingDeviceId'));
                while Pos('/',Temp) > 0 do
                begin
                   a := Pos('/',Temp);
                   Displaytype := Copy(Temp,0,a -1);
                   if UpperCase(Displaytype) = 'PCI'  then
                     LBox_hardware.Items.Add('显卡：   '+Trim(ReadString('DriverDesc')));
                     break;
                end;
              end;
            end;
            closekey;
          end;
        finally
          slTempl.Free
        end;
      end;
    end;
  finally
    if Assigned(Registry) then
      Registry.Free;
  end;
end;
//
//获取98下显卡信息
//
procedure TFrm_test.GetWin98DisplayCardInfo;
var
  i,a : integer;
  slTempl: TStringList;
  rk, Temp, Displaytype: string;
  Registry: TRegistry;
begin
  rk := '/System/CurrentControlSet/Services/Class/display';
  Registry := TRegistry.Create;
  try
    with Registry do
    begin
      rootkey := HKEY_LOCAL_MACHINE;
      if openkey(rk, False) then
      begin
        slTempl := TStringList.Create;
        getkeynames(slTempl);
        closekey;
        try
          for  i := 0 to slTempl.Count-1 do
          begin
            if openkey(rk+'/'+slTempl[i], False) then
            begin
              if (valueexists('DriverDesc')) and (valueexists('MatchingDeviceId')) then
              begin
                Temp := Trim(ReadString('MatchingDeviceId'));
                while Pos('/',Temp) > 0 do
                begin
                   a := Pos('/',Temp);
                   Displaytype := Copy(Temp,0,a -1);
                   if UpperCase(Displaytype) = 'PCI'  then
                     LBox_hardware.Items.Add('显卡：   '+Trim(ReadString('DriverDesc')));
                     break;
                end; // Pos('/',Temp) > 0
              end;  //(valueexists('DriverDesc')) and (valueexists('MatchingDeviceId'))
            end;
            closekey;
          end;
        finally
          slTempl.Free
        end;
      end;
    end;
  finally
    if Assigned(Registry) then
      Registry.Free;
  end;
end;
//
//调用API取显卡信息
//
procedure TFrm_test.GetDisplayCardInfo;
var
  lpDisplayDevice: TDisplayDevice;
  dwFlags: DWORD;
  cc: DWORD;
  sTemp:string;
begin
  lpDisplayDevice.cb := sizeof(lpDisplayDevice);
  dwFlags := 0;
  cc:= 0;
  while EnumDisplayDevices(nil, cc, lpDisplayDevice , dwFlags) do
  begin
    Inc(cc);
    if (lpDisplayDevice.DeviceName='//./Display1') or (lpDisplayDevice.DeviceName='//./DISPLAY1') then
    begin
      sTemp:=lpDisplayDevice.DeviceString;
      //('显卡',Trim(sTemp));
      LBox_hardware.Items.Add('显卡：   '+Trim(sTemp));
    end;
  end;
end;
//*********************************显卡信息*************************************

//***********************************网卡信息***********************************
//
//通过调用系统Dll来取网卡信息
//
function TFrm_test.myGetDriveinfoCHeck(var SDrive: TStringList): boolean;
var
  pcDriveinfo: array [0..99] of char;
  i, ITemp: integer;
  dwDriveinfoSize: DWORD;
begin
  dwDriveinfoSize := 100; // user name can be up to 20 characters
  i := 0;
  ITemp := Windows.GetLogicalDriveStrings(dwDriveinfoSize, (pcDriveinfo));
  while i < ITemp do
  begin
    SDrive.Add(pcDriveinfo[i]);
    i := i + 4;
  end;
  Result := True;
end;

procedure TFrm_test.GetAdapterInformation;
Var
  AI,Work : PIPAdapterInfo;
  Size : Integer;
  Res : Integer;
begin
  Size := 5120;
  GetMem(AI,Size);
  Res := GetAdaptersInfo(AI,Size);
  If (Res <> ERROR_SUCCESS) Then
  Begin
    SetLastError(Res);
  End;
  With LBox_hardware do
  Begin
    Work := AI;
    Repeat
    LBox_hardware.Items.Add('网卡：   '+Work^.Description);
    Work := Work^.Next;
    Until (Work = nil);
  End;
  FreeMem(AI);
end;
//
//通过注册表来获取2k/xp下网卡信息
//
procedure TFrm_test.GetWin2kxpNetCardInfo;
var
  i: integer;
  slTempl: TStringList;
  STemp,rk: string;
  Registry: TRegistry;
begin
  rk := '/System/CurrentControlSet/Control/Class/{4D36E972-E325-11CE-BFC1-08002BE10318}';
  Registry := TRegistry.Create;
  try
    with Registry do
    begin
      rootkey := HKEY_LOCAL_MACHINE;
      if openkey(rk, False) then
      begin
        slTempl := TStringList.Create;
        getkeynames(slTempl);
        closekey;
        try
          for  i := 0 to slTempl.Count-1 do
          begin
            if openkey(rk+'/'+slTempl[i], False) then
            begin
              if (valueexists('DriverDesc')) and (valueexists('BusType')) then
              begin
                STemp := ReadString('BusType');
                if STemp = '5' then
                begin
                  LBox_hardware.Items.Add('网卡：   '+ Trim(ReadString('DriverDesc')));
                end;
              end;
            end;
            closekey;
          end;
        finally
          slTempl.Free
        end;
      end;
    end;
  finally
    if Assigned(Registry) then
      Registry.Free;
  end;
end;
//
//通过注册表来获取98下网卡信息
//
procedure TFrm_test.GetWin98NetCardInfo;
var
  i: integer;
  slTempl: TStringList;
  STemp, rk: string;
  Registry: TRegistry;
begin
  rk := '/System/currentControlset/Services/Class/net/';
  Registry := TRegistry.Create;
  try
    with Registry do
    begin
      rootkey := HKEY_LOCAL_MACHINE;
      if openkey(rk, False) then
      begin
        slTempl := TStringList.Create;
        getkeynames(slTempl);
        closekey;
        try
          for  i := 0 to slTempl.Count - 1 do
          begin
            if openkey(rk + slTempl[i], False) then
            begin
              if (valueexists('DriverDesc')) and (valueexists('BusType')) then
              begin
                STemp := ReadString('BusType');
                if STemp = '5' then
                begin
                  LBox_hardware.Items.Add('网卡：  '+ Trim(ReadString('DriverDesc')));
                end;
              end;
              closekey;
            end;
          end;
        finally
          slTempl.Free
        end;
      end;
    end;
  finally
    if Assigned(Registry) then
      Registry.Free;
  end;
end;
//**************************************网卡信息********************************

//*************************************磁盘驱动器*******************************
//
//取2k/xp磁盘数量 得到的数据赋给全局变量  除去光驱软驱外的磁盘驱动器
//
procedure TFrm_test.Get2kxpDiskNumber;
var
  Registry : TRegistry;
const
  rk = '/SYSTEM/CurrentControlSet/Services/Disk/Enum';  //注册表路径
begin
  Registry := TRegistry.Create;
  try
    with Registry do
    begin
      Registry.RootKey := HKEY_LOCAL_MACHINE;
      if Registry.OpenKey(rk,False) then
      begin
        if Registry.ValueExists('Count') then
        begin
          Diskcount := Registry.ReadInteger('Count'); //统计磁盘块数
        end
        else
          Diskcount :=0;  //统计磁盘块数
      end; // if Registry.OpenKey(rk,False) then
    end; // with Registry do
  finally
    if Assigned(Registry) then
       Registry.Free;
  end; // try
end;
//
//取2k/xp下软盘硬盘信息
//
procedure TFrm_test.GetWin2kxpFloppyDiskInfo;
var
  i: integer;
  sTempl, sTemp2 : TStringList;
  Registry: TRegistry;
  floppyClass : String;
const
  rv = 'DriverDesc';
  rk = '/SYSTEM/CurrentControlSet/Control/Class/{4D36E969-E325-11CE-BFC1-08002BE10318}';
begin
  Registry := TRegistry.Create;
  sTempl := TStringList.Create;
  sTemp2 := TStringList.Create;
  try
    with Registry do
    begin
      rootkey := HKEY_LOCAL_MACHINE;
      if openkey(rk, False) then
      begin
        floppyClass := ReadString('Class');  //软驱类型 'fdc'
        getkeynames(sTempl);
        closekey;
        for i := 0 to sTempl.Count - 1 do
          if openkey(rk + '/'+ sTempl[i], False) then
          begin
              if valueexists('DriverDesc') then
              begin
                 LBox_hardware.Items.Add('软盘驱动器：   '+Trim(ReadString('DriverDesc')));
              end;
              closekey;
          end;
      end;
    end;
  finally
    if Assigned(Registry) then
      Registry.Free;
    if Assigned(sTempl) then
      sTempl.Free;
    if Assigned(sTemp2) then
      sTemp2.Free;
  end;
end;
//
//取2k/xp下物理硬盘  真实光盘和虚拟光盘 信息
//
procedure TFrm_test.GetWin2kxpPeripheralDiskInfo;
var
  i, j: integer;
  sTempl, sTemp2, sTemp3: TStringList;
  SML1, SML2,STemp: string;
  Registry: TRegistry;
const
  rv = 'DriverDesc';
  rk = '/HARDWARE/DEVICEMAP/Scsi';
begin
  Registry := TRegistry.Create;
  sTempl := TStringList.Create;
  sTemp2 := TStringList.Create;
  sTemp3 := TStringList.Create;
  try
    with Registry do
    begin
      rootkey := HKEY_LOCAL_MACHINE;
      if openkey(rk, False) then
      begin
        getkeynames(sTempl);
        closekey;
        for i := 0 to sTempl.Count - 1 do
          if openkey(rk + '/' + sTempl[i] + '/Scsi Bus 0', False) then
          begin
            SML1 := sTempl[i];
            getkeynames(sTemp2);
            closekey;
            for j := 0 to sTemp2.Count - 1 do
            begin
              SML2 := rk + '/' + SML1 + '/Scsi Bus 0/' + sTemp2[j];
              if openkey(SML2, False) then
              begin
                getkeynames(sTemp3);
                closekey;
                if sTemp3.Count <> 0 then
                begin
                if   openkey(SML2 + '/Logical Unit Id 0', False)  then
                begin
                  if valueexists('Identifier') and valueexists('Type') then
                  begin
                    STemp := ReadString('Type');
                    if STemp = 'DiskPeripheral' then
                      //TTypeInfo.Add('硬盘驱动器')
                      LBox_hardware.Items.Add('硬盘驱动器：   '+ReadString('Identifier'))
                    else if STemp = 'CdRomPeripheral' then
                     // TTypeInfo.Add('光盘驱动器')
                      LBox_hardware.Items.Add('光盘驱动器：   '+ReadString('Identifier'))
                    else
                     // TTypeInfo.Add('未知驱动器')
                      LBox_hardware.Items.Add('未知驱动器：   '+ReadString('Identifier'))
                  end;
                  closekey;
                end;
                end;
              end;                 // break;
            end;
          end;
      end;
    end;
  finally
    if Assigned(Registry) then
      Registry.Free;
    if Assigned(sTempl) then
      sTempl.Free;
    if Assigned(sTemp2) then
      sTemp2.Free;
    if Assigned(sTemp3) then
      sTemp3.Free;
  end;
end;
//
////取2k/xp下可移动磁盘驱动器信息
//
procedure TFrm_test.GetWin2kxpUSBDiskInfo;
var
  Registry : TRegistry;
  i : Integer;    //定义循环变量，进行寻找磁盘个数
  Temp : String;
  a : Integer;
  disktype : String;
const
  rk = '/SYSTEM/CurrentControlSet/Services/Disk/Enum';  //注册表路径
begin
  Registry := TRegistry.Create;
  Registry.RootKey := HKEY_LOCAL_MACHINE;
  if diskcount > 1 then
  begin
    if Registry.OpenKey(rk,False) then
    begin
      for i:= 0 to diskcount-1 do
      begin
        Temp := Registry.ReadString(IntToStr(i));
        //取字符串
        while Pos('/',Temp) > 0 do
        begin
          a := Pos('/',Temp);
          disktype := Copy(Temp,0,a -1);
          if disktype <> 'IDE' then
          begin
            if disktype = 'USBSTOR' then
            begin
              LBox_hardware.Items.Add('磁盘驱动器：   '+'可移动磁盘');
            end
            else
            begin
              LBox_hardware.Items.Add('磁盘驱动器：   '+'其它形式磁盘');
            end;
          end;
          break;
        end;
        //取字符串
      end; // for i:= 0 to diskcount do
    end;
  end;
end;
//
//取98下软盘硬盘信息
//
procedure TFrm_test.GetWin98FloppyDiskInfo;
var
  Registry : TRegistry;
  S1Temp1, S1Temp2: TStringList;
  i: integer; //考虑多硬盘
const
  rv = 'DriverDesc';  //取的值
  rk = '/ENUM/FLOP';  //路径
begin
  Registry := TRegistry.Create;
  S1Temp1 := TStringList.Create;
  S1Temp2 := TStringList.Create;
  try
    with Registry do
    begin
      Registry.RootKey := HKEY_LOCAL_MACHINE;
      if Registry.OpenKey(rk, False) then
      begin
        Registry.GetKeyNames(S1Temp1);
        Registry.CloseKey;
        for i := 0 to S1Temp1.Count - 1 do
          if Registry.OpenKey(rk + '/' + S1Temp1[i], False) then
          begin
            Registry.GetKeyNames(S1Temp2);
            Registry.CloseKey;
            if S1Temp2.Count <> 0 then
            begin
              if Registry.OpenKey(rk + '/' + S1Temp1[i]+'/'+S1Temp2[0],False) then
              begin
                 if valueexists('DeviceDesc') then
                   LBox_hardware.Items.Add('软盘驱动器：   '+ Trim(ReadString('DeviceDesc')));
              end;
            end;
          end;
       end;
    end;
  finally
    if Assigned(Registry) then
      Registry.Free;
    if Assigned(S1Temp1) then
      S1Temp1.Free;
    if Assigned(S1Temp2) then
      S1Temp2.Free;
  end;
end;
//
////取98下物理硬盘信息
//
procedure TFrm_test.GetWin98PeripheralDiskInfo;
var
  Registry : TRegistry;
  S1Temp1, S1Temp2: TStringList;
  //STemp: string;
  i: integer; //考虑多硬盘
const
  rv = 'DriverDesc';  //取的值
  rk = '/ENUM/ESDI';  //路径
begin
  Registry := TRegistry.Create;
  S1Temp1 := TStringList.Create;
  S1Temp2 := TStringList.Create;
  try
    with Registry do
    begin
      Registry.RootKey := HKEY_LOCAL_MACHINE;
      if Registry.OpenKey(rk, False) then
      begin
        Registry.GetKeyNames(S1Temp1);
        Registry.CloseKey;
        for i := 0 to S1Temp1.Count - 1 do
          if Registry.OpenKey(rk + '/' + S1Temp1[i], False) then
          begin
            Registry.GetKeyNames(S1Temp2);
            Registry.CloseKey;
            if S1Temp2.Count <> 0 then
            begin
              if Registry.OpenKey(rk + '/' + S1Temp1[i]+'/'+S1Temp2[0],False) then
              begin
                 if valueexists('DeviceDesc') then
                   LBox_hardware.Items.Add('硬盘驱动器：   '+ ReadString('DeviceDesc'));
              end;
            end;
          end;
       end;
    end;
  finally
    if Assigned(Registry) then
      Registry.Free;
    if Assigned(S1Temp1) then
      S1Temp1.Free;
    if Assigned(S1Temp2) then
      S1Temp2.Free;
  end;
end;
//
//98os下的光盘驱动器信息
//
procedure TFrm_test.GetWin98CDDiskInfo;
var
  S1Temp1, S1Temp2,SLPF: TStringList;
  STemp1: string;
  i,j: integer;
begin
  SLPF:=TStringList.Create;
  try
  myGetDriveinfoCHeck(SLPF);
  with TRegistry.Create do
  begin
    rootkey := HKEY_LOCAL_MACHINE;
    if openkey('/ENUM/SCSI', False) then
    begin
      S1Temp1 := TStringList.Create;
      try
        getkeynames(S1Temp1);
        closekey;
        if S1Temp1.Count <> 0 then
        begin
          for i := 0 to S1Temp1.Count-1 do
          begin
            if openkey('/ENUM/SCSI/' + S1Temp1[i], False) then
            begin
              S1Temp2 := TStringList.Create;
              try
                getkeynames(S1Temp2);
                closekey;
                if S1Temp2.Count <> 0 then
                begin
                  if openkey('/ENUM/SCSI/' + S1Temp1[i] + '/' + S1Temp2[0], False) then
                  begin
                    if valueexists('DeviceDesc')and valueexists('Class') and  valueexists('CurrentDriveLetterAssignment') then
                    begin
                       STemp1:= trim(ReadString('CurrentDriveLetterAssignment'));
                       for j:=0 to SLPF.Count-1 do
                       begin
                        if   uppercase(STemp1)=uppercase(SLPF[j])  then
                        begin
                        if trim(ReadString('Class'))='CDROM' then
                        begin
                         //  SCDRom.Add(ReadString('DeviceDesc'));
                         LBox_hardware.Items.Add('光盘驱动器：   '+ReadString('DeviceDesc')) ;
                        end;
                        end;
                       end;
                    end;
                    closekey;
                  end;
                end;
              finally
                S1Temp2.Clear;
                S1Temp2.Free;
              end;
            end;
          end;
        end;
      finally
        S1Temp1.Clear;
        S1Temp1.Free;
      end;
    end;
  end;
  finally
     SLPF.Clear;
    SLPF.Free;
  end;
end;
//********************************磁盘驱动器***********************
end.