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.

[Muetze1]

Entweder mit SetProcessAffinityMask() oder SetThreadAffinityMask() den Code auf einen Kern festlegen und dann messen. Danach auf zum nächsten Kern. Wieviele Kerne bekommt man mit GetSystemInfo().

[Zacherl]

Wenn man dein Programm startet, erscheinen im Abstand von 1 Sekunde Fehlermeldungen mit dem Inhalt:

Zitat:

---------------------------
Project1
---------------------------
Wert muss zwischen 1 und 2147483647 liegen.
---------------------------
OK
---------------------------

Gruß Zacherl

[hathor]

CPU-Usage - hier ist ein Beispielprogramm:

[Hybrid666]

Hoi hoi.

Ich hab dir mal nen kleinen Code aus dem du vllt das ein oder andere rausbekommst.

Ich schreibe für Gamers.IRC die girc.dll, sie ist opensource und hat eine nette kleine funktion, die sich sysinfo nennt...einfach auf sourceforge.net mal nach gamers.irc suchen und dir den code anschaun.

MfG

[Hobby-Programmierer]

Moin ...,
Danke für die Tipps. Werde mir alles mal in Ruhe anschauen.