sys.~pas

系統硬件測試,主板的型號

unit sys;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,Registry,ShlObj;

type
 PRomBiosDump = ^TRomBiosDump;
 TRomBiosDump = array[$000F0000..$000FFFFF] of Byte;
type
 TReadRomBiosMethod = (
   rrbmAutomatic, { Autodetect OS type and use proper method }
   rrbmGeneric, { Use 16-bit COM program to dump the BIOS  }
   rrbmMemory, { Read from memory (Win9x)                 }
   rrbmPhysical { Read from physical memory object (WinNT) }
   );

type
    TcpuMSG = record
      ID1    : string;
      ID2    : String;
      ID3    : String;
      ID4    : String;
   PValue    : String;
   FValue    : String;
   MValue    : String;
   SValue    : String;
   Vendor    : String;
                  end;
  function GetDisplayFrequency: Integer;
  function GetIdeSerialNumber: pchar;
  function GetCPUSpeed: Double;
  function GetDisplayDevice:string;
  function GetProcessorType:string;
  function GetWindowsVersion: string;
  function GetIdeDiskSerialNumber(var SerialNumber: string; var ModelNumber: string;
           var FirmwareRev: string; var TotalAddressableSectors: ULong;
           var SectorCapacity: ULong; var SectorsPerTrack: Word): Boolean;
  function GetcpuMSG:TcpuMSG;

  function myGetComputerName : String;
  function myGetUserName : String;
  function myGetWindowsDirectory : String;
  function myGetSystemDirectory : String;
  function myGetTempPath: String;

function Get_REGSTR_PATH(name: integer): string;
procedure GetSysInfo(TreeViewName:TTreeView;ImageListName:TImageList);


implementation

uses BiosHelp;

const
	ID_BIT	=	$200000;
type
	TCPUID	= array[1..4] of Longint;
	TVendor	= array [0..11] of char;

function GetCPUSpeed: Double;
const
 DelayTime = 500;
var
 TimerHi, TimerLo: DWORD;
 PriorityClass, Priority: Integer;
begin
    PriorityClass := GetPriorityClass(GetCurrentProcess);
    Priority := GetThreadPriority(GetCurrentThread);
    SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
    SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
    Sleep(10);
    asm
       dw 310Fh // rdtsc
       mov TimerLo, eax
       mov TimerHi, edx
    end;
    Sleep(DelayTime);
    asm
       dw 310Fh // rdtsc 
       sub eax, TimerLo
       sbb edx, TimerHi
       mov TimerLo, eax
       mov TimerHi, edx
    end;

    SetThreadPriority(GetCurrentThread, Priority);
    SetPriorityClass(GetCurrentProcess, PriorityClass);
    Result := TimerLo / (1000.0 * DelayTime);
end;
//*************
function GetCpuSpeed9: Comp;
var
  t: DWORD;
  mhi, mlo, nhi, nlo: DWORD;
  t0, t1, chi, clo, shr32: Comp;
begin
  shr32 := 65536;
  shr32 := shr32 * 65536;
  t := GetTickCount;
  while t = GetTickCount do begin end;
  asm
    DB 0FH
    DB 031H
    mov mhi,edx
    mov mlo,eax
  end;
  while GetTickCount < (t + 1000) do begin end;
  asm
    DB 0FH
    DB 031H
    mov nhi,edx
    mov nlo,eax
  end;
  chi := mhi; if mhi < 0 then chi := chi + shr32;
  clo := mlo; if mlo < 0 then clo := clo + shr32;
  t0 := chi * shr32 + clo;
  chi := nhi; if nhi < 0 then chi := chi + shr32;
  clo := nlo; if nlo < 0 then clo := clo + shr32;
  t1 := chi * shr32 + clo;
  Result := (t1 - t0) / 1E6;
end;
function GetCPUSpeed1: Double;
const
  DelayTime = 500; // measure time in ms
var
  TimerHi, TimerLo: DWORD;
  PriorityClass, Priority: Integer;
begin
  PriorityClass := GetPriorityClass(GetCurrentProcess);
  Priority := GetThreadPriority(GetCurrentThread);

  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

  Sleep(10);
  asm
  dw 310Fh // rdtsc
  mov TimerLo, eax
  mov TimerHi, edx
  end;
  Sleep(DelayTime);
  asm
  dw 310Fh // rdtsc
  sub eax, TimerLo
  sbb edx, TimerHi
  mov TimerLo, eax
  mov TimerHi, edx
  end;

  SetThreadPriority(GetCurrentThread, Priority);
  SetPriorityClass(GetCurrentProcess, PriorityClass);
  Result := TimerLo / (1000.0 * DelayTime);
end;
function RDTSC : Int64; assembler;
asm
  db $0F, $31
end;

function RDQPC : Int64;
begin
  QueryPerformanceCounter(result);
end;

function CPUSpeed : Integer;
var
  f,tsc,pc : Int64;
begin
  if QueryPerformanceFrequency(f) then
  begin
  Sleep(0);
  pc := RDQPC;
  tsc := RDTSC;
  Sleep(100);
  pc := RDQPC-pc;
  tsc := RDTSC-tsc;
  result := round(tsc*f/(pc*1000000));
  end
  else
  result := -1;
end;

function GetIdeSerialNumber : pchar;
const IDENTIFY_BUFFER_SIZE = 512;
type
  TIDERegs = packed record
   bFeaturesReg     : BYTE;
   bSectorCountReg  : BYTE;
   bSectorNumberReg : BYTE;
   bCylLowReg       : BYTE;
   bCylHighReg      : BYTE;
   bDriveHeadReg    : BYTE;
   bCommandReg      : BYTE;
   bReserved        : BYTE;
 end;
 TSendCmdInParams = packed record
   cBufferSize  : DWORD;
   irDriveRegs  : TIDERegs;
   bDriveNumber : BYTE;
   bReserved    : Array[0..2] of Byte;
   dwReserved   : Array[0..3] of DWORD;
   bBuffer      : Array[0..0] of Byte;  // Input buffer.
 end;
 TIdSector = packed record
   wGenConfig                 : Word;
   wNumCyls                   : Word;
   wReserved                  : Word;
   wNumHeads                  : Word;
   wBytesPerTrack             : Word;
   wBytesPerSector            : Word;
   wSectorsPerTrack           : Word;
   wVendorUnique              : Array[0..2] of Word;
   sSerialNumber              : Array[0..19] of CHAR;
   wBufferType                : Word;
   wBufferSize                : Word;
   wECCSize                   : Word;
   sFirmwareRev               : Array[0..7] of Char;
   sModelNumber               : Array[0..39] of Char;
   wMoreVendorUnique          : Word;
   wDoubleWordIO              : Word;
   wCapabilities              : Word;
   wReserved1                 : Word;
   wPIOTiming                 : Word;
   wDMATiming                 : Word;
   wBS                        : Word;
   wNumCurrentCyls            : Word;
   wNumCurrentHeads           : Word;
   wNumCurrentSectorsPerTrack : Word;
   ulCurrentSectorCapacity    : DWORD;
   wMultSectorStuff           : Word;
   ulTotalAddressableSectors  : DWORD;
   wSingleWordDMA             : Word;
   wMultiWordDMA              : Word;
   bReserved                  : Array[0..127] of BYTE;
 end;
 PIdSector = ^TIdSector;
 TDriverStatus = packed record
   bDriverError : Byte;
   bIDEStatus   : Byte;
   bReserved    : Array[0..1] of Byte;
   dwReserved   : Array[0..1] of DWORD;
 end;
 TSendCmdOutParams = packed record
   cBufferSize  : DWORD;
   DriverStatus : TDriverStatus;
   bBuffer      : Array[0..0] of BYTE;
 end;
 var hDevice : THandle;
     cbBytesReturned : DWORD;
     ptr : PChar;
     SCIP : TSendCmdInParams;
     aIdOutCmd : Array [0..(SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1)-1] of Byte;
     IdOutCmd  : TSendCmdOutParams absolute aIdOutCmd;
 procedure ChangeByteOrder( var Data; Size : Integer );
 var ptr : PChar;
     i : Integer;
     c : Char;
 begin
   ptr := @Data;
   for i := 0 to (Size shr 1)-1 do begin
     c := ptr^;
     ptr^ := (ptr+1)^;
     (ptr+1)^ := c;
     Inc(ptr,2);
   end;
end;
begin
   Result := '';
   if SysUtils.Win32Platform=VER_PLATFORM_WIN32_NT then begin
       hDevice := CreateFile( '\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
         FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
   end else
     hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
     if hDevice=INVALID_HANDLE_VALUE then Exit;
    try
     FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);
     FillChar(aIdOutCmd,SizeOf(aIdOutCmd),#0);
     cbBytesReturned := 0;
     with SCIP do begin
       cBufferSize  := IDENTIFY_BUFFER_SIZE;
       with irDriveRegs do begin
         bSectorCountReg  := 1;
         bSectorNumberReg := 1;
         bDriveHeadReg    := $A0;
         bCommandReg      := $EC;
       end;
     end;
     if not DeviceIoControl( hDevice, $0007c088, @SCIP, SizeOf(TSendCmdInParams)-1,
       @aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil ) then Exit;
   finally
     CloseHandle(hDevice);
   end;
   with PIdSector(@IdOutCmd.bBuffer)^ do begin
     ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) );
     (PChar(@sSerialNumber)+SizeOf(sSerialNumber))^ := #0;
     Result := PChar(@sSerialNumber);
   end;
 end;


function GetDisplayFrequency: Integer;
var
 DeviceMode: TDeviceMode;
begin
 EnumDisplaySettings(nil, Cardinal(-1), DeviceMode);
 Result := DeviceMode.dmDisplayFrequency;
end;
function GetDisplayDevice: string;
var
 lpDisplayDevice: TDisplayDevice;
 dwFlags: DWORD;
 cc: DWORD;
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
    Result :=lpDisplayDevice.DeviceString;
  end;
end;
function GetProcessorType:string;
const
  PROCESSOR_INTEL_386=386;
  PROCESSOR_INTEL_486=486;
  PROCESSOR_INTEL_PENTIUM=586;
  PROCESSOR_INTEL_IA64=2200;
  PROCESSOR_MIPS_R4000=4000;
  PROCESSOR_ALPHA_21064=21064;
var
  SysInfo: TSYSTEMINFO;
  CPUName:string;
begin
   GetSystemInfo(SysInfo);//?眔CPU獺