?? 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獺
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -