Laufwerke mit Namen und Speicher erkennen

Stread · Beiträge: 188 Win 7 Delphi XE

Hi,
Ich möchte in meinem Programm erkennen welche und wieviele Laufwerkstypen auf dem Computer sind, den Namen dazu und noch wenn es eine Festplatte ist wie viel Speicher es insgesamt hat und wieviel noch frei ist. Das Ganze soll dann übersichtlich in einer ListBox (oder Memo) darstellbar sein.
Bsp wie es in der Listbox aussehen soll

C: Festplatte (Speicherplatz) 50,34 GB frei von 350 GB
...
E: DVD-RRom (DVD-Rom Laufwerk)
H: USB-Stick (Arbeit) 2,65 GB frei von 7,98 GB

Ich habe bisher nur einzelne Komponenten. Alle Laufwerkstypen(außer Netzlaufwerke) werden erkannt und in der ListBox dargestellt.
Die Namen kann ich nur abfragen wenn ich den Laufwerksbuchstaben eingebe. Ebenso den Speicherplatz.
Beim herausfinden der Laufwerkstypen habe ich schon geprüft was eine Festplatte ist und welchen Buchstaben sie hat.
Diese Daten müsste ich nun für den Namen und den Speicherplatz verwenden.
Letztes (kleines) Problem ist es alle Daten richtig in die ListBox einzutragen.

Danke fürs Durchlesen :flehan:

Komponenten

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:

//Laufwerkstyp (Drives) ermitteln
procedure GetDrives(const AItems: TStrings);
const
   DriveTypeTexts: array[DRIVE_UNKNOWN..DRIVE_RAMDISK] of string =
    ('Unbekannt', 'Kein Wurzelverzeichnis', 'USB-Stick', 'Festplatte', 'Netzlaufwerk', 'DVD-ROM', 'RAMDisk');
var
   Drive: Char;
   DriveType: Integer;
   DriveMask: Integer;
   Flag: Integer;
begin
   DriveMask := GetLogicalDrives; //Bitmaske holen
   flag := 1; //Startflag setzen
   for Drive := 'A' to 'Z' do //Jeden Buchstaben gegenprüfen
   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; //Ein Bit weiter nach links gehen ( = flag * 2)
   end;
end;

//Volume Name
function GetVolumeName(DriveLetter: Char): string;
var
   dummy: DWORD;
   buffer: array[0..MAX_PATH] of Char;
   oldmode: LongInt;
begin
   oldmode := SetErrorMode(SEM_FAILCRITICALERRORS);
   try
     GetVolumeInformation(PChar(DriveLetter + ':\'),
                          buffer,SizeOf(buffer), nil, dummy,dummy, nil,  0);
     Result := StrPas(buffer);
   finally
     SetErrorMode(oldmode);
   end;
end;

//Speicherplatz ermitteln
procedure TFormSys.Button1Click(Sender: TObject);
var freeCaller, total: Int64;
freefl, totalfl: Extended;
begin
   GetDiskFreeSpaceEx('C:', freeCaller, total, nil);
   freefl:=freeCaller/1073741824;
   totalfl:=total/1073741824;
   Freefl:=Trunc(freefl*1000)/1000;
   Freefl:=RoundTo(freefl, -2);
   Totalfl:=Trunc(Totalfl*1000)/1000;
   Totalfl:=RoundTo(totalfl, -2);
   label3.caption:='C: '+ FloatToStr(freefl)+' GB';
   label6.caption:='C: '+ FloatToStr(totalfl)+' GB';

   GetDiskFreeSpaceEx('D:', freeCaller, total, nil);
   freefl:=freeCaller/1073741824;
   totalfl:=total/1073741824;
   Freefl:=Trunc(freefl*1000)/1000;
   Freefl:=RoundTo(freefl, -2);
   Totalfl:=Trunc(Totalfl*1000)/1000;
   Totalfl:=RoundTo(totalfl, -2);
   label21.caption:='D: '+ FloatToStr(freefl)+' GB';
   label22.caption:='D: '+ FloatToStr(totalfl)+' GB';
end;

//GetVolumeName Button
 procedure TFormSys.Button4Click(Sender: TObject);
begin
Label37.Caption:=GetVolumeName('c');
end;

// GetDrives Button
procedure TFormSys.Button5Click(Sender: TObject);
begin
Listbox1.Clear;
GetDrives(Listbox1.Items)
end;

jaenicke · Verfasst: Mi 29.06.11 22:41

Dein Fehler ist einfach, dass du die Daten nicht in eine geeignete Datenstruktur (z.B. eine Objektliste von Klassen) packst, sondern stattdessen alles direkt als String formatierst in eine Stringliste packst.
Damit kannst du dann später aber nichts mehr anfangen um es anders formatiert auszugeben...

In diesem Fall kannst du aber doch in der Schleife einfach noch die anderen Daten zu dem Laufwerksbuchstaben abfragen und direkt mit in den String speichern, wenn dir diese Ausgabe reicht und du die Daten nicht anderweitig brauchst. Wo ist dabei denn das Problem?

Verstehst du Teile des Quelltextes nicht? Ich weiß gerade nicht wo eigentlich dein Problem liegt. :nixweiss:

Stread · Beiträge: 188 Win 7 Delphi XE

Mein Problem ist hauptsächlich das ich z.B bei der Abfrage nach dem Speicherplatz den Laufwerksbuchstaben als Char angeben muss.
Wenn ich aber nicht weiß welchen Buchstaben oder wie viele Festplatten es gibt, geht mein Programm nicht.

Also meinst du ich soll in die getDrives Prozedur die anderen beiden einbauen?

PS. Ich bin auf dem Gebiet noch nicht so bewandert.

jaenicke · Verfasst: Do 30.06.11 06:57

Stread hat folgendes geschrieben :

Mein Problem ist hauptsächlich das ich z.B bei der Abfrage nach dem Speicherplatz den Laufwerksbuchstaben als Char angeben muss.

Du hast in GetDrives ja auch einen Char, nämlich Drive. :nixweiss:

Du kannst dort ja je nach Typ unterscheiden, ob du die weiteren Abfragen machst. Wenn der Typ "unbekannt" ist, dann kannst du es ja z.B. lassen.

Tranx · Verfasst: Do 30.06.11 12:58

Mal eine schnelle Umsetzung:

In dem Programm habe ich ein Stringgrid (Stringgrid1) und einen Button (Button1). Bei Druck auf den Button werden die Laufwerke ausgelesen.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:

unit LWUnit;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  StdCtrls,
  Grids;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Drives(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

function GetVolumeName(DriveLetter: Char): string;
procedure VolumeSpace(Drive: char; var free, whole: double);

implementation

{$R *.DFM}

// Laufwerke auslesen und in Stringgrid die Daten abspeichern

procedure TForm1.Drives(Sender: TObject);
const
  DriveTypeTexts: array[DRIVE_UNKNOWN..DRIVE_RAMDISK] of string =
  ('Unbekannt', 'Kein Wurzelverzeichnis', 'USB-Stick', 'Festplatte', 'Netzlaufwerk', 'DVD-ROM', 'RAMDisk');
var
  Drive: Char;
  DriveType: Integer;
  DriveMask: Integer;
  Flag: Integer;
  Anz: integer;
  freeSp, wholeSp: double;
begin
  Anz := 1;
  DriveMask := GetLogicalDrives; //Bitmaske holen
  flag := 1; //Startflag setzen
  with Stringgrid1 do
  begin
    for Drive := 'A' to 'Z' do //Jeden Buchstaben gegenprüfen
    begin
      if (flag and DriveMask) <> 0 then
      begin
        DriveType := GetDriveType(PChar(Format('%S:\', [Drive])));
        Stringgrid1.Cells[0, Anz] := Drive + ':';
        StringGrid1.Cells[1, Anz] := DriveTypeTexts[DriveType];
        Stringgrid1.Cells[2, Anz] := GetVolumeName(Drive);
        VolumeSpace(Drive, freeSp, wholeSp);
        if freeSp < 0.0 then  // falls zwar vorbelegt, aber nicht genutzt (z.B. Kartenlesegerät, CD/DVD-LW ohne CD/DVD)
        begin
          StringGrid1.Cells[3, Anz] := 'n.b.';
          StringGrid1.Cells[4, Anz] := 'n.b.';
        end
        else
        begin
          if WholeSp < 0.1 then   // Ausgabe in MB, falls gesamte Kapazität < 100 MB
          begin
            StringGrid1.Cells[3, Anz] := FormatFloat('0.00 MB', 1024 * freeSp);
            StringGrid1.Cells[4, Anz] := FormatFloat('0.00 MB', 1024 * wholeSp);
          end
          else
          begin
            StringGrid1.Cells[3, Anz] := FormatFloat('0.00 GB', freeSp);
            StringGrid1.Cells[4, Anz] := FormatFloat('0.00 GB', wholeSp);
          end;
        end;
        inc(Anz);
      end;
      flag := flag shl 1; //Ein Bit weiter nach links gehen ( = flag * 2)
    end;
    RowCount := Anz;
    FixedRows := 1;
  end;
end;

//Volume Name

function GetVolumeName(DriveLetter: Char): string;
var
  dummy: DWORD;
  buffer: array[0..MAX_PATH] of Char;
  oldmode: LongInt;
begin
  oldmode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    GetVolumeInformation(PChar(DriveLetter + ':\'),
      buffer, SizeOf(buffer), nil, dummy, dummy, nil, 0);
    Result := StrPas(buffer);
  finally
    SetErrorMode(oldmode);
  end;
end;

//Speicherplatz ermitteln

procedure VolumeSpace(Drive: char; var freeSp, wholeSp: double);
var
  freeCaller, totalCaller: Int64;
  freefl, totalfl: Extended;
  s: string;
begin
  s := Drive + ':';
  GetDiskFreeSpaceEx(PChar(s), freeCaller, totalCaller, nil);
  freefl := freeCaller / 1073741824;
  totalfl := totalCaller / 1073741824;
  if FreeFl > 1E6 then
    freeSp := -1.0
  else
    freeSp := freefl;
  if totalFl > 1E6 then
    wholeSp := -1.0
  else
    wholeSp := totalfl;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Drives(Sender);
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  with Stringgrid1 do
  begin
    Cells[0, 0] := 'LW';
    Cells[1, 0] := 'Typ';
    Cells[2, 0] := 'Name';
    Cells[3, 0] := 'freier Speicher';
    Cells[4, 0] := 'gesamter Speicher';
  end;
end;

end.

Die Prozedur VOLUMESPACE belegt die Werte für freeSp und wholeSp
Die Funktion GETVOLUMENAME gibt den Name des Laufwerks aus.

_________________
Toleranz ist eine Grundvoraussetzung für das Leben.

Stread · Beiträge: 188 Win 7 Delphi XE

Danke erstmal für den Code.
Allerdings habe ich bei mir noch ein paar Fehler die ich nicht ganz verstehe.

markieren

Quelltext

1:
2:
3:

[DCC Fehler] LWUnit.pas(114): E2037 Deklaration von 'VolumeSpace' unterscheidet sich von vorheriger Deklaration
[DCC Fehler] LWUnit.pas(125): E2003 Undeklarierter Bezeichner: 'freeSp'
[DCC Fehler] LWUnit.pas(129): E2003 Undeklarierter Bezeichner: 'wholeSp'

Falls es wichtig ist: Ich verwende Delphi XE

Tranx · Verfasst: Do 30.06.11 14:16

Oha, ich hatte das nicht übernommen. Ich hatte in der Prozedur die Variablen Free, Whole durch FreeSp und WholeSp ersetzt, denn Free als Variablenname macht in Objektorientierten Programmen Probleme, weil es zu jedem Objekt dioe Prozedur free gibt, welche Speicher einer Komponente frei gibt. Du musst nur die Prozedurzeile bei der Prozedur Volumenspace in den Interfaceteil kopieren und die fehlerhafte Deklaration mit free, whole löschen.

Entschuldigung, passiert, wenn man nicht direkt aus Delphi das kopiert, sondern nachträglich ändert.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:

var
  Form1: TForm1;

function GetVolumeName(DriveLetter: Char): string;
procedure VolumeSpace(Drive: char; var freeSp, wholeSp: double); // richtig
//procedure VolumeSpace(Drive: char; var free, whole: double); // FALSCH, löschen

:
:

_________________
Toleranz ist eine Grundvoraussetzung für das Leben.

jaenicke · Verfasst: Do 30.06.11 15:51

Stread hat folgendes geschrieben :

Falls es wichtig ist: Ich verwende Delphi XE

Dann bietet es sich an die Daten im Hintergrund in eine generische TObjectList zu legen:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

type
  TDriveData = class
  private
    FDriveLetter: Char;
  public
    property DriveLetter: Char read FDriveLetter write FDriveLetter;
  end;

  ...

  FDriveList: TObjectList<TDriveData>;

  ...

Stread · Beiträge: 188 Win 7 Delphi XE

Uih das ist mir ja schon peinlich dass ich vor lauter free das SP überlesen habe :oops:

Es funktioniert nun, hat aber wohl einen Darstellungsfehler.
Bei CD/DVD-Rom Laufwerken erscheint als Namen die Speichermenge der Festplatte darüber + komische Zeichen.
Hat der PC noch ein Diskettenlaufwerk kommt ein Error den man aber wegklicken kann.
Diskettenlaufwerke werden als Wechselmedium angezeigt.
Meine Idee war jetzt mit der Suche einfach bei B: zu beginnen da viele Diskettenlaufwerke A: sind. Funktioniert ist aber natürlich nicht ideal.
Warum die CD/DVD Namen so komisch sind weiß ich nicht.

Moderiert von Narses: Bilder als Anhang hochgeladen.

Einloggen, um Attachments anzusehen!

Tranx · Verfasst: Do 30.06.11 21:01

Stread,
bei mir funktioniert das mit Audio-CD, Daten-CD oder ganz ohne CD problemlos. Möglicherweise liegt es irgendwie an der Verarbeitung der Prozedur GetVolumeInformation. Ich habe Delphi 5. Vielleicht verarbeitet Delphi XE das Ganze anders. Gib bei Cursor auf "GetVolumeInformation" mal F1 an. Vielleicht erscheint dann eine Hilfe zu dieser Funktion. Ich kann leider das ganze nicht testen. Allerdings an Windows kann es nicht liegen, da ich die Funktion sowohl bei XP als auch bei Windows 7 32 bit ausprobiert habe. Wie das mit Windows 7 64 bit ist, weiß ich natürlich nicht.

_________________
Toleranz ist eine Grundvoraussetzung für das Leben.

Stread · Beiträge: 188 Win 7 Delphi XE

Getestet bei mir unter Windows 7 64Bit (1. Bild) und XP 32Bit

Moderiert von Narses: Bilder als Anhang hochgeladen.

Komisch ist auch dass Delphi bei mir nur Netzlaufwerke findet wenn ich die Exe manuell starte, aus Delphi heraus findet er keine.

Einloggen, um Attachments anzusehen!

jaenicke · Verfasst: Do 30.06.11 22:45

Im Anhang einmal eine saubere Lösung...

Einloggen, um Attachments anzusehen!

Stread · Beiträge: 188 Win 7 Delphi XE

Danke, funktioniert gut. Ich werde morgen mal sehen wieviel ich vom Code verstehe

PS. Ist die Unterteilung in Verfügbar und frei nicht sinnlos?

jaenicke · Verfasst: Do 30.06.11 23:25

Stread hat folgendes geschrieben :

PS. Ist die Unterteilung in Verfügbar und frei nicht sinnlos?

Frei ist die Anzahl Bytes, die auf dem Datenträger frei ist. Verfügbar ist die Anzahl Bytes, die dem aktuellen Benutzer unter Berücksichtigung der ggf. vorhandenen Quota (also des dem Benutzer auf dem Laufwerk zugeteilten Speicherplatzes) etc. zur Verfügung stehen.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme