AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Projekte SysInfo mit einigen Fragen

SysInfo mit einigen Fragen

Ein Thema von S4SH1981 · begonnen am 27. Feb 2009 · letzter Beitrag vom 16. Mär 2009
Antwort Antwort
Seite 2 von 2     12
S4SH1981
Registriert seit: 13. Jul 2007
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 := 'Ato 'Zdo
  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.
Angehängte Dateien
Dateityp: rar sysinfos_165.rar (185,5 KB, 76x aufgerufen)
 
Muetze1
 
#11
  Alt 1. Mär 2009, 14:27
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().
  Mit Zitat antworten Zitat
Benutzerbild von Zacherl
Zacherl

 
Delphi 10.2 Tokyo Starter
 
#12
  Alt 1. Mär 2009, 14:40
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
  Mit Zitat antworten Zitat
hathor
 
#13
  Alt 1. Mär 2009, 17:40
CPU-Usage - hier ist ein Beispielprogramm:
Angehängte Dateien
Dateityp: zip cpu_explorer_734.zip (410,2 KB, 96x aufgerufen)
  Mit Zitat antworten Zitat
Hybrid666

 
Delphi 7 Personal
 
#14
  Alt 1. Mär 2009, 18:39
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
  Mit Zitat antworten Zitat
Hobby-Programmierer

 
Delphi XE Starter
 
#15
  Alt 16. Mär 2009, 05:04
Moin ...,
Danke für die Tipps. Werde mir alles mal in Ruhe anschauen.
Mario
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 06:11 Uhr.
Powered by vBulletin® Copyright ©2000 - 2022, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf