SysInfo mit einigen Fragen

[S4SH1981]

Hallo zusammen

Hier ein Sammelsurium von Systeminformation in einem Programm.

Habe da aber noch meine Probleme mit z.B. dem CPU Kram.
Name, Kerne, derzeitige Taktfrequenz habe ich.
Fehlen "nurnoch" MAximale genaue Taktfrequenz und die CPU Auslastung

Steh dazu noch auf dem Schlauch, wie ich die GB Werte der Festplatte ohne tausend NAchkommastellen angezeigt bekomme.
Und wie ich es hinkriege, dass ich nach Auswahl des Laufwerks die aktuellen Werte bekomme.

Sind mit Sicherheit einfach zu lösende vermeintliche Probleme.

Delphi-Quellcode:

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.

[RWarnecke]

Zitat von S4SH1981:

... Steh dazu noch auf dem Schlauch, wie ich die GB Werte der Festplatte ohne tausend NAchkommastellen angezeigt bekomme ...

Dieses kanst Du über den Befehl Format lösen.

[S4SH1981]

Folgende Situation:

Am Laptop Delphi 2005 habe ich bei Festplatte z.B. 50,5050505050505
Am DesktopPC Delphi 2005 ohne was am Code zu machem habe ich 132,123

Muss ich das verstehen?

[Dunkel]

Zitat von S4SH1981:

Folgende Situation:

Am Laptop Delphi 2005 habe ich bei Festplatte z.B. 50,5050505050505
Am DesktopPC Delphi 2005 ohne was am Code zu machem habe ich 132,123

Muss ich das verstehen?

Öhmm, lass mich raten, die Festplatten sind unterschiedlich groß; oder was willst Du uns damit sagen?

[Luckie]

Ich glaube, er meinte die Anzahl der Nachkommastellen. Bei der einen Festpaltte passt es wohl zufälligerweise mit den drei Nachkommastellen.

[Dunkel]

Zitat von Luckie:

Ich glaube, er meinte die Anzahl der Nachkommastellen. Bei der einen Festpaltte passt es wohl zufälligerweise mit den drei Nachkommastellen.

Das kann sein. Format() (wie RWarnecke schon erwähnt hat) richtig angewandt, und dann passt das.
Mein Beitrag war, an und für sich, nur als "zeig mal, was Du bisher gemacht hast" gemeint...

[RWarnecke]

Ich benutze gerne diese Funktion um die Größe der Platte anzuzeigen.

Delphi-Quellcode:

////////////////////////////////////////////////////////////////////////////////
//
//  Funktion zum bestimmen der Größe in Byte, KiloByte, MegaByte, GigaByte oder
//  TeraByte
//
function FormatSize(SizeB: Extended): String;
begin
  if SizeB>1099511627776 then result:=Format('%f TB',[SizeB/1024/1024/1024/1024]) else
  if SizeB>1024*1024*1024 then result:=Format('%f GB',[SizeB/1024/1024/1024]) else
  if SizeB>1024*1024 then result:=Format('%f MB',[SizeB/1024/1024]) else
  if SizeB>1024 then result:=Format('%f KB',[SizeB/1024]) else
  if SizeB>=0 then result:=Format('%f Byte',[SizeB]);
end;

[Micha88]

Ich hab das ganze Ding mal UNFACHMÄNNISCH und nur SPORADISCH abgeändert, Anhang

[hathor]

Zitat von MichaelLinden:

Ich hab das ganze Ding mal UNFACHMÄNNISCH und nur SPORADISCH abgeändert, Anhang

Im Prinzip besser, aber noch fehlerhaft:

Maximale Taktfrequenz - derzeitige Taktfrequenz: vertauscht, gerundet sähe es besser aus:
edit4.Text:=IntToStr(Round(vMaxFrequ div 100 +1)* 100)+ ' MHz';
edit3.Text:=IntToStr(Round(vCurrFrequ div 100 +1)* 100)+ ' MHz';

Prozessorauslastung: bei Mehrkern-CPU einzeln messen

Festplatte 1 Kapazität: Bezeichnung falsch, Wert gilt nur für C:

Ladezustand der Batterie: Edit13 -> unschön

[Hobby-Programmierer]

Zitat von hathor:

Prozessorauslastung: bei Mehrkern-CPU einzeln messen

Hallo ...,
hat jemand lauffähigem Code um die einzelnen Kerne auszulesen ? Habe schon einige Codefragmente getestet, leider immmer ohne Erfolg ...