sysinfo.pas

国外著名恢复软件Drive_Rescue 公布的早期源码 版本是1.8 delphi6环境开发的。

unit sysinfo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, math, registry, ImgList;

type
  TDialogSystemInfo = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    ListView1: TListView;
    Button1: TButton;
    TabSheet2: TTabSheet;
    ListView2: TListView;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    ListView3: TListView;
    ListView4: TListView;
    ImageListDrives: TImageList;
    ImageListSheets: TImageList;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function Execute: boolean;
  end;

var
  DialogSystemInfo: TDialogSystemInfo;

implementation

uses helpers;

const
  PROCESSOR_ARCHITECTURE_INTEL    = 0;
  PROCESSOR_ARCHITECTURE_MIPS     = 1;
  PROCESSOR_ARCHITECTURE_ALPHA    = 2;
  PROCESSOR_ARCHITECTURE_PPC      = 3;
  PROCESSOR_ARCHITECTURE_SHX      = 4;
  PROCESSOR_ARCHITECTURE_ARM      = 5;
  PROCESSOR_ARCHITECTURE_IA64     = 6;
  PROCESSOR_ARCHITECTURE_ALPHA64  = 7;
  PROCESSOR_ARCHITECTURE_MSIL     = 8;


{$R *.dfm}

Function GetCPUSpeed:Comp;
Var
  MyReg: TRegistry;
  B:LongInt;
  Mhz:LongInt;
begin
  Result:=0;
  MHz:=0;
  TRY
    MyReg:=TRegistry.Create;
    MyReg.RootKey:=HKEY_LOCAL_MACHINE;
    TRY
      if MyReg.OpenKey('\HARDWARE\DESCRIPTION\System\CentralProcessor\0',FALSE) then
      Begin
        B:=MyReg.ReadInteger('~MHz');
        if B > 0 Then Mhz:=B else
        B:=MyReg.ReadInteger('~Mhz');
        if B > 0 Then Mhz:=B else
        B:=MyReg.ReadInteger('~mhz');
        if B > 0 Then Mhz:=B;
      End;
    FINALLY
     MyReg.Free;
    END;
  EXCEPT
    Result:=0;
  END;
  (** Convert MegaHertz to Hertz **)
  Result:=Mhz * 1E6;
  GetCPUSpeed:=Result;
end;



procedure TDialogSystemInfo.FormCreate(Sender: TObject);
var
  ListItem: TListItem;
  si: TSystemInfo;
  ms: TMemoryStatus;
  dm: TDevMode;
  vi: TOSVersionInfo;
  speed: comp;
  drvtype: integer;
  volname: array[0..255] of char;
  maxlen: dword;
  fsflags: dword;
  fsname: array[0..255] of char;
  secpclus, bytepsec, freeclus, totalclus: dword;
  totalsize, freespace: real;
  root: string;
  s: string;
  p: array[0..2047] of char;
  ppos: pchar;
  pVariable: pchar;
  pEnv: pchar;
  len, j: integer;
  scrwidth, scrheight, coldepth: integer;
begin
 
 try
  // Hardware ---------------------------------------------------------------
  GetSystemInfo(si);
  ListItem := ListView1.Items.Add;
  ListItem.Caption := 'Number of processors:';
  ListItem.SubItems.Add(format('%d', [si.dwNumberOfProcessors]));
  ListItem := ListView1.Items.Add;
  ListItem.Caption := 'CPU type:';
  s:='';
  case si.wProcessorArchitecture of
    PROCESSOR_ARCHITECTURE_INTEL:     begin
                                        s:=s+'Intel';
                                        case si.wProcessorLevel of
                                          3: s:=s+' 80386';
                                          4: s:=S+' 80486';
                                          5: s:=s+' Pentium';
                                          6: s:=S+' Pentium II';
                                          7: s:=s+' Pentium III';
                                          8: s:=s+' Pentium IV';
                                          9: s:=s+' Pentium V';
                                        end;
                                        case si.wProcessorLevel of
                                          3,4: s:=s+format(', stepping level %X, stepping %X', [chr(ord('A')+ (si.wProcessorRevision SHR 8)),
                                            (si.wProcessorRevision AND 8)]);
                                          5..9: s:=s+format(', model number %X, stepping %X', [(si.wProcessorRevision SHR 8),
                                            (si.wProcessorRevision AND 8)]);
                                        end;
                                      end;
    PROCESSOR_ARCHITECTURE_MIPS     : s:=s+'MIPS';
    PROCESSOR_ARCHITECTURE_ALPHA    : s:=s+'Alpha';
    PROCESSOR_ARCHITECTURE_PPC      : s:=s+'PPC';
    PROCESSOR_ARCHITECTURE_SHX      : s:=s+'SHX';
    PROCESSOR_ARCHITECTURE_ARM      : s:=s+'ARM';
    PROCESSOR_ARCHITECTURE_IA64     : s:=s+'IA64';
    PROCESSOR_ARCHITECTURE_ALPHA64  : s:=S+'Alpha64';
    PROCESSOR_ARCHITECTURE_MSIL     : s:=s+'MSIL';
  end;

  ListItem.SubItems.Add(s);
  ListItem := ListView1.Items.Add;
  ListItem.Caption := 'Display resolution:';

  scrwidth:=GetDeviceCaps(GetDC(0), HORZRES);
  scrheight:=GetDeviceCaps(GetDC(0), VERTRES);
  coldepth:=GetDeviceCaps(GetDC(0), BITSPIXEL);

  {EnumDisplaySettings(nil, 0, dm);}

  ListItem.SubItems.Add(format('%dx%d, %d-bits(%d colors)', [scrwidth, scrheight, coldepth, round(power(2, coldepth))]));
  ListItem := ListView1.Items.Add;
  ListItem.Caption := 'Installed RAM:';

  GlobalMemoryStatus(ms);
  ListItem.SubItems.Add(format('%d KB', [ms.dwTotalPhys div 1024]));
  ListItem := ListView1.Items.Add;
  if IsWinNT then
  begin
    speed:=GetCPUSpeed;
    if speed <> 0 then
    begin
      ListItem.Caption := 'Frequency:';
      ListItem.SubItems.Add(format('%d MHz',[round(speed/1000000)]));
    end;
  end;

  // Software ---------------------------------------------------------------
  vi.dwOSVersionInfoSize:=sizeof(TOSVersionInfo);
  if GetVersionEx(vi) then
  begin
    ListItem := ListView2.Items.Add;
    ListItem.Caption := 'Windows version:';
    ListItem.SubItems.Add(format('%d.%d (Build %d)', [vi.dwMajorVersion, vi.dwMinorVersion, vi.dwBuildNumber AND $ffff]));

    ListItem := ListView2.Items.Add;
    ListItem.Caption := 'Windows mode:';
    s:='';
    case vi.dwPlatformId of
      VER_PLATFORM_WIN32s:        s:='Win32s on Windows 3.1';
      VER_PLATFORM_WIN32_WINDOWS: s:='Win32';
      VER_PLATFORM_WIN32_NT:      S:='Windows NT';
    end;
    ListItem.SubItems.Add(format('%s', [s]));
  end;

  ListItem := ListView2.Items.Add;
  ListItem.Caption := 'Swap file size:';
  ListItem.SubItems.Add(format('%d MB', [ms.dwTotalPageFile div (1024*1024)]));

  if GetWindowsDirectory(@p, sizeof(p)) > 0 then
  begin
    ListItem := ListView2.Items.Add;
    ListItem.Caption := 'Windows directory:';
    ListItem.SubItems.Add(format('%s', [StrPas(p)]));
  end;

  if GetSystemDirectory(@p, sizeof(p)) > 0 then
  begin
    ListItem := ListView2.Items.Add;
    ListItem.Caption := 'System directory:';
    ListItem.SubItems.Add(format('%s', [StrPas(p)]));
  end;

  // Drives ---------------------------------------------------------------

  len:=GetLogicalDriveStrings(sizeof(p), @p);
  if len > 0 then
  begin
    ppos:=p;
    while ppos^ <> #0 do
    begin
      root:=UpperCase(copy(StrPas(ppos), 1,2)); volname:=''; fsname:='';
      drvtype:=GetDriveType(ppos);

      if NOT (drvtype IN [DRIVE_REMOVABLE, DRIVE_CDROM, DRIVE_REMOTE]) then
      begin
        GetVolumeInformation(ppos, @volname, sizeof(VolName), nil, maxlen, fsflags, @fsname, sizeof(fsname));
      end;
      ListItem := ListView3.Items.Add;
      ListItem.Caption := root + ' '+StrPas(volname);
      case drvType of
        DRIVE_REMOVABLE:
          ListItem.ImageIndex := 0;
        DRIVE_FIXED:
          ListItem.ImageIndex := 1;
        DRIVE_REMOTE:
          ListItem.ImageIndex := 3;
        DRIVE_CDROM:
          ListItem.ImageIndex := 2;
        DRIVE_RAMDISK:
          ListItem.ImageIndex := 1;
      end;
      ListItem.SubItems.Add(StrPas(fsname));

      totalsize:=0; freespace:=0;

      if NOT (drvtype IN [DRIVE_REMOVABLE, DRIVE_CDROM, DRIVE_REMOTE]) then
      begin
        GetDiskFreeSpace(@ppos^, secpclus, bytepsec, freeclus, totalclus);
        totalsize:=(secpclus * bytepsec) / 1024 * totalclus  /1024;
        freespace:=(secpclus * bytepsec) / 1024 * freeclus  /1024;
      end;

      if NOT (drvtype IN [DRIVE_REMOVABLE, DRIVE_CDROM, DRIVE_REMOTE]) then
      begin
        if totalsize < 1024 then
          ListItem.SubItems.Add(Format('%n MB',[totalsize]))
        else
          ListItem.SubItems.Add(Format('%n GB',[totalsize / 1024]));

        if freespace < 1024 then
          ListItem.SubItems.Add(Format('%n MB',[freespace]))
        else
          ListItem.SubItems.Add(Format('%n GB',[freespace / 1024]));
      end;

      inc(longint(ppos), StrLen(ppos)+1);
    end;
  end;

  // Enivironment ---------------------------------------------------------------

  // Get a pointer to the environment block
  pEnv := nil;
  pEnv := GetEnvironmentStrings;

 // Variable strings are separated by NULL byte, and the block is
 // terminated by a NULL byte.

  if pEnv <> nil then
  begin
    pVariable:=pEnv;
    while pVariable^ <> #0 do
    begin
      ListItem := ListView4.Items.Add;
      s:=StrPas(pVariable);
      j:=pos('=', s);
      ListItem.Caption := copy(s, 1, j-1);
      ListItem.SubItems.Add(copy(s, j+1, length(s)-j));
      inc(longint(pVariable), StrLen(pVariable)+1);
    end;
    FreeEnvironmentStrings(pEnv);
  end;

 except
 
 end;
end;

function TDialogSystemInfo.execute: boolean;
begin
  result:=(DialogSystemInfo.showmodal = mrOK);
end;

end.