unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Gauges, Registry, ComCtrls, ExtCtrls;
type
TForm1 =
class(TForm)
ListBox1: TListBox;
Label1: TLabel;
Label2: TLabel;
Gauge1: TGauge;
Gauge2: TGauge;
Edit1: TEdit;
Edit2: TEdit;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
Edit7: TEdit;
Edit8: TEdit;
Edit9: TEdit;
Edit10: TEdit;
Edit11: TEdit;
Edit12: TEdit;
Edit13: TEdit;
Timer1: TTimer;
Label14: TLabel;
Edit14: TEdit;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//FUNKTIONEN
//------------------------------------------------------------------------------
//PROZESSORNAME
function GetProzessorName:
string;
var reg: TRegistry;
begin
result:='
Unbekannter Prozessor';
reg:=TRegistry.Create;
try
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey('
Hardware\Description\System\CentralProcessor\0', false);
result:=reg.ReadString('
ProcessorNameString');
finally
reg.free;
end;
end;
//DERZEITIGE PROZESSORAUSLASTUNG
function CalcCPUSpeed: Extended;
const
DelayTime = 500;
// measure time in ms
var
TimerHi, TimerLo: DWord;
PriorityClass, Priority: Integer;
begin
try
PriorityClass := GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread,
THREAD_PRIORITY_TIME_CRITICAL);
try
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;
finally
SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);
end;
Result := TimerLo / (1000.0 * DelayTime);
except
Result := 0;
end;
end;
//LAUFWERKE ERMITTELN
procedure GetDrives(
const AItems: TStrings);
const
DriveTypeTexts:
array[DRIVE_UNKNOWN..DRIVE_RAMDISK]
of string =
('
Unbekannt', '
Kein Wurzelverzeichnis', '
Diskette', '
Festplatte', '
Netzlaufwerk', '
CDROM', '
RAMDisk');
var
Drive: Char;
DriveType: Integer;
DriveMask: Integer;
Flag: Integer;
begin
DriveMask:=GetLogicalDrives;
flag:=1;
for Drive := '
A'
to '
Z'
do
begin
if (flag
and DriveMask)<>0
then
begin
DriveType := GetDriveType(PChar(Format('
%S:\',[Drive]) ) ) ;
AItems.Add(Format('
%s: %s', [Drive, DriveTypeTexts[DriveType]]));
end;
flag:=flag
shl 1;
end;
end;
//ANZAHL DER PROZESSOREN ERMITTELN
function GetNumberOfProcessors: Integer;
var
SystemInfo: TSystemInfo;
begin
GetSystemInfo(SystemInfo);
Result:=SystemInfo.dwNumberOfProcessors;
end;
//WINDOWS UPTIME
procedure GetWindowsUpTime(
var ADay, AHours, AMinutes, ASeconds: Integer);
const
OneDay : Integer = 1000 * 60 * 60 * 24;
OneHour : Integer = 1000 * 60 * 60;
OneMinutes : Integer = 1000 * 60;
OneSecond : Integer = 1000;
var
Start : Integer;
d, h, m, s: Integer;
begin
Start:=GetTickCount;
ADay:=Start
div OneDay;
//Tage
d:=Start
mod OneDay;
AHours:=d
div OneHour;
//Stunden
h:=d
mod OneHour;
AMinutes:=h
div OneMinutes;
//Minuten
s:=h
mod OneMinutes;
ASeconds:=s
div OneSecond;
//Sekunden
end;
//PROGRAMMSTART
//------------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
var
Memory: TMemoryStatus;
freeCaller, total: Int64;
begin
GetDrives(listbox1.Items);
edit1.text:=GetProzessorName;
edit2.Text := inttostr(GetNumberOfProcessors);
Memory.dwLength := SizeOf(Memory);
GlobalMemoryStatus(Memory);
edit6.text:=IntToStr(Memory.dwTotalPhys
div 1024
div 1024) +'
MB';
GetDiskFreeSpaceEx('
c:', freeCaller, total,
nil);
edit9.text:=floatToStr(total
div 1024
div 1024 / 1024) +'
GB';
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
Tage, Stunden, Minuten, Sekunden: Integer;
Memory: TMemoryStatus;
SystemPowerStatus: TSystemPowerStatus;
freeCaller, total: Int64;
begin
edit4.Text:=IntToStr(Round(CalcCPUSpeed))+ '
MHz';
GetWindowsUpTime(Tage, Stunden, Minuten, Sekunden);
edit11.text :=Format('
%d Tage %d Stunden %d Minuten %d Sekunden', [Tage, Stunden, Minuten, Sekunden]);
Memory.dwLength := SizeOf(Memory);
GlobalMemoryStatus(Memory);
gauge1.MaxValue := Memory.dwTotalPhys;
gauge1.Progress := Memory.dwAvailPhys;
gauge2.MaxValue := Memory.dwTotalPhys;
gauge2.Progress := Memory.dwTotalPhys - Memory.dwavailPhys;
//Freier Arbeitsspeicher
edit7.Text := inttostr(Memory.dwAvailPhys
div 1024
div 1024)+ '
MB';
edit8.Text := inttostr(Memory.dwTotalPhys
div 1024
div 1024 - Memory.dwavailPhys
div 1024
div 1024)+ '
MB';
GetSystemPowerStatus(SystemPowerStatus);
with SystemPowerStatus
do begin
// Wird das System mit Wechselstrom oder Akku betrieben ?
case ACLineStatus
of
0: edit12.text := '
System wird mit Akku betrieben';
1: edit12.text := '
System wird mit Wechselstrom betrieben';
else Label5.Caption := '
Unbekannter Status';
end;
// Ladezustand der Batterie
case BatteryFlag
of
1 : edit13.text := '
Hoher Ladezustand';
2 : edit13.text := '
Niedriger Ladezustand';
4 : edit13.text := '
Kritischer Ladezustand';
8 : edit13.text := '
Die Batterie wird geladen';
128: edit13.text := '
Es existiert keine System-Batterie';
255: edit13.text := '
Unbekannter Status';
end;
// Ladezustand in Prozent
if BatteryLifePercent <> 255
then
edit14.text := IntToStr(BatteryLifePercent) + '
%'
else
edit14.text := '
Unbekannter Status';
end;
Memory.dwLength := SizeOf(Memory);
GlobalMemoryStatus(Memory);
GetDiskFreeSpaceEx('
c:', freeCaller, total,
nil);
edit10.text:=floattostr(freeCaller
div 1024
div 1024 / 1024)+'
GB';
end;
end.