DriveTools - nützliche Laufwerks Routinen

Ehemaliges Mitglied Erhaltene Danke: 1

Für ein Projekt brauchte ich ein paar Routinen bezüglich Laufwerke. Rausgekommen ist die Unit DriveTools.

Routinen:
GetLogicalDrives - Listet alle logischen Laufwerke auf

markieren

Delphi-Quelltext

1:
2:

procedure GetLogicalDrives(var Drives: TStringArray; ReadyOnly: Boolean = True;
  WithLabels: Boolean = True);

Drives ist ein dynamisches String-Array, muss bereit gestellt werden
ReadyOnly, es werden nur Laufwerke berücksichtig, die bereit sind
WithLables, es werden zusätzlich die Laufwerksbezeichnungen mit angegeben

FindAllFiles - Sucht Dateien

markieren

Delphi-Quelltext

1:
2:

procedure FindAllFiles(RootFolder: string; Mask: string; Recurse: Boolean =
  True);

RootFolder, Ordner der dursucht werden soll
Mask, Dateimaske der zu findenden Dateien
Recurse, rekursive Suche durch Unterverzeichnisse

Wichtig: zu FindAllFiles gehört:
InitFindAllFiles - initialisiert die globalen Variablen FoundFiles, cntFoundFiles
diese Prozedur muss immer vor FindAllFiles aufgerufen werden. FindAllFiles arbeitet mit den globalen Variablen FoundFiles, einem dynamischen String-Array und cntFoundFiles welches die gefundenen Datein zählt und für die Größe des dynamischen String-Arrays verantwortlich ist.

GetVolumeLabel - ermittelt die Datenträgerbezeichnung

markieren

Delphi-Quelltext

1:	function GetVolumeLabel(const Drive: string): string;

Drive ist das Laufwerk, dessen Datenträgerbezeichnug ermittelt werden soll.

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:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:

{************************************************************}
{                                                            }
{                           DriveTools                       }
{                          Version: 2.0                      }
{                                                            }
{               Copyright (c) 2004 Michael Puff              }
{                     www.luckie-online.de                   }
{                                                            }
{************************************************************}

{*************************************************************

  History:
    - 2004-12-18 - 1.0
      - LoadLogicalDrives
      - FindAllFiles
      - GetVolumeLabel
    - 2004-12-18 - 2.0
      - Rewrote FindAllFiles (no SysUtils, no Classes)
        and added InitFindAllFiles
      - Rewrote GetLogicalDrives (no SysUtils, no Classes)

*************************************************************}

unit DriveTools;

interface

uses Windows;

type
  TStringArray = array of string;

var
  FoundFiles   : TStringArray;
  cntFoundFiles: Integer = 0;

procedure GetLogicalDrives(var Drives: TStringArray; ReadyOnly: Boolean = True;
  WithLabels: Boolean = True);
procedure InitFindAllFiles;
procedure FindAllFiles(RootFolder: string; Mask: string; Recurse: Boolean =
  True);
function GetVolumeLabel(const Drive: string): string;

implementation

////////////////////////////////////////////////////////////////////////////////
//
//  GetVolumeLabel
//
function GetVolumeLabel(const Drive: string): string;
var
  RootDrive    : string;
  Buffer       : array[0..MAX_PATH + 1] of Char;
  FileSysFlags : DWORD;
  MaxCompLength: DWORD;
begin
  result := '';
  FillChar(Buffer, sizeof(Buffer), #0);
  if length(Drive) = 1 then
    RootDrive := Drive + ':\'
  else
    RootDrive := Drive;
  if GetVolumeInformation(PChar(RootDrive), Buffer, sizeof(Buffer), nil,
    MaxCompLength, FileSysFlags, nil, 0) then
  begin
    result := string(Buffer);
  end;
end;

////////////////////////////////////////////////////////////////////////////////
//
//  GetLogicalDrives
//
procedure GetLogicalDrives(var Drives: TStringArray; ReadyOnly: Boolean = True;
  WithLabels: Boolean = True);

  function DriveIsReady(const Drive: string): Boolean;
  var
    wfd        : TWin32FindData;
    hFindData  : THandle;
  begin
    SetErrorMode(SEM_FAILCRITICALERRORS);
    hFindData := FindFirstFile(Pointer(Drive + '*.*'), wfd);
    if hFindData <> INVALID_HANDLE_VALUE then
    begin
      Result := True;
    end
    else
    begin
      Result := False;
    end;
    FindClose(hFindData);
    SetErrorMode(0);
  end;

var
  FoundDrives  : PChar;
  CurrentDrive : PChar;
  len          : DWord;
  cntDrives    : Integer;
begin
  cntDrives := 0;
  SetLength(Drives, 26);
  GetMem(FoundDrives, 255);
  len := GetLogicalDriveStrings(255, FoundDrives);
  if len > 0 then
  begin
    try
      CurrentDrive := FoundDrives;
      while CurrentDrive[0] <> #0 do
      begin
        if ReadyOnly then
        begin
          if DriveIsReady(string(CurrentDrive)) then
          begin
            if WithLabels then
              Drives[cntDrives] := CurrentDrive + ' [' +
                GetVolumeLabel(CurrentDrive) + ']'
            else
              Drives[cntDrives] := CurrentDrive;
            Inc(cntDrives);
          end;
        end
        else
        begin
          if WithLabels then
            Drives[cntDrives] := CurrentDrive + ' [' +
              GetVolumeLabel(CurrentDrive) + ']'
          else
            Drives[cntDrives] := CurrentDrive;
          Inc(cntDrives);
        end;
        CurrentDrive := PChar(@CurrentDrive[lstrlen(CurrentDrive) + 1]);
      end;
    finally
      FreeMem(FoundDrives, len);
    end;
    SetLength(Drives, cntDrives);
  end;
end;

////////////////////////////////////////////////////////////////////////////////
//
//  InitFindAllFiles
//    Resets global variables FoundFiles and cntFoundFiles
//    Must always be called before FindAllFiles!!!
procedure InitFindAllFiles;
begin
  SetLength(FoundFiles, 0);
  cntFoundFiles := 0;
end;

////////////////////////////////////////////////////////////////////////////////
//
//  FindAllFiles
//
procedure FindAllFiles(RootFolder: string; Mask: string; Recurse: Boolean =
  True);
var
  hFindFile    : THandle;
  wfd          : TWin32FindData;
  Filename     : string;
begin
  if RootFolder[length(RootFolder)] <> '\' then
    RootFolder := RootFolder + '\';
  ZeroMemory(@wfd, sizeof(wfd));
  wfd.dwFileAttributes := FILE_ATTRIBUTE_NORMAL;
  if Recurse then
  begin
    hFindFile := FindFirstFile(pointer(RootFolder + '*.*'), wfd);
    if hFindFile <> 0 then
    try
      repeat
        if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY =
          FILE_ATTRIBUTE_DIRECTORY then
          if (string(wfd.cFileName) <> '.') and (string(wfd.cFileName) <> '..')
            then
          begin
            FindAllFiles(RootFolder + wfd.cFileName, Mask, Recurse);
          end;
      until FindNextFile(hFindFile, wfd) = False;
    finally
      Windows.FindClose(hFindFile);
    end;
  end;
  hFindFile := FindFirstFile(pointer(RootFolder + Mask), wfd);
  if hFindFile <> INVALID_HANDLE_VALUE then
  try
    repeat
      if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <>
        FILE_ATTRIBUTE_DIRECTORY then
      begin
        Filename := RootFolder + string(wfd.cFileName);
        if length(FoundFiles) = cntFoundFiles then
          SetLength(FoundFiles, length(FoundFiles) + 100);
        FoundFiles[cntFoundFiles] := Filename;
        Inc(cntFoundFiles);
      end;
    until FindNextFile(hFindFile, wfd) = False;
  finally
    Windows.FindClose(hFindFile);
    setlength(FoundFiles, cntFoundFiles);
  end;
end;

end.

retnyg · Verfasst: Mi 29.06.05 23:43

blöde frage, aber warum lässt du den stringarray nicht als var-parameter übergeben ?
dann würde man sich das initialisieren ersparen...

hier nochn tip zur beschleunigung

markieren

Delphi-Quelltext

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

  function getFirstChar(p:pointer):char; register;
  asm
     mov al, byte ptr[eax]
  end;


...

    if (WFD.dwFileAttributes and 16) = 16 then   // if a folder
      (if getFirstChar(@WFD.cFileName[0]) <> '.' then begin
     ...

//edit: hab n paar assembler-optimierungen getestet, die performance ändert sich aber so gut wie gar nicht ^^
dein code ist von haus aus shcon ziemlich schnell user defined image

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...

Ehemaliges Mitglied Erhaltene Danke: 1

retnyg hat folgendes geschrieben:

blöde frage, aber warum lässt du den stringarray nicht als var-parameter übergeben ?
dann würde man sich das initialisieren ersparen...

Weiß ich auch nicht. :gruebel:

Ich brauchte den Code eben und hatte nicht viel zeit alles zwei dreimal zu ändern.

Zitat:

//edit: hab n paar assembler-optimierungen getestet, die performance ändert sich aber so gut wie gar nicht ^^
dein code ist von haus aus shcon ziemlich schnell

Nein, das bedeutet, dass Delphi von sich aus schon sehr guten Assembler generiert.

Heiko · Beiträge: 3169 Erhaltene Danke: 11

Hi Luckie,

darf man deine Unit in Freeware-Programmen einsetzten?

Ehemaliges Mitglied Erhaltene Danke: 1

Jupp.

Heiko · Beiträge: 3169 Erhaltene Danke: 11

Soll man dich dann auch in der About-Box oder woanders erwähnen? (Auch wenn man die Unit noch ein bissl verändert hat?

)

Heiko · Beiträge: 3169 Erhaltene Danke: 11

Hi Luckie,

deine Unit scheint einen Bug zu haben.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:

for i:=0 to 1 do
begin
  DriveTools.InitFindAllFiles;
  DriveTools.FindAllFiles('C:\', '*.mp3', true);
end;

Durchläuft er ohen Probleme, aber bei

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:

for i:=0 to 1 do
begin
  DriveTools.InitFindAllFiles;
  DriveTools.FindAllFiles('C:\', '*.*', true);
end;

Schmiert er nach einer Weile ab, mit der Fehler Meldung "Zu wenig Arbeitsspeicher vorhanden", obwohl wir einen GB haben

.
PS: Bei meiner ST besteht dieses Problem nicht.

Ehemaliges Mitglied Erhaltene Danke: 1

Die Unit ist auch schon total veraltet. Da man hier aber den Quelltext posten muss und nicht auf eine Datei verweisen darf, die man zentral pflegen kann auf seinen eigenen Webspace, muss der Benutzer der Unit damit klar kommen, dass er mit einer veralteten Version arbeitet.

Die aktuelle findest du auf www.luckie-online.de...er/Delphi/Sonstiges/ -> MpuDriveTools.pas

Heiko · Beiträge: 3169 Erhaltene Danke: 11

Naja, aber vom Aufbau ist die mpuDriveTools doch ein bissl anders, den die verwendet ja zusätzliche Messages & Co. Der Hinweis galt eigentlich eher für den Typ der DriveTools, die hier oben gepostet hast

.

digi_c · Beiträge: 1905 W98, XP D7 PE, Lazarus, WinAVR

Die Frage zum Freitag, WIESO ist den das nun eigentlich schneller?
TSearchRecsowie FindFirst+FindNext+FindMatchingFile haben doch intern keine anderen Aufrufe.

Nur weil dadurch nicht für jede gefundene Datei gleich die Dateinformationen geladen/umgewandelt werden?

Heiko · Beiträge: 3169 Erhaltene Danke: 11

Und zwar hat es einen ganz einfachen Grund. Delphi kapselt noch haufen sch***, der u.a. zur Fehlerbehandlung dient. Und den lassen wir ganz einfach raus. Dadurch sparen wir erheblich Performance. Es ist das gleiche wie bei TFileStream. Bei längeren Test hohlt dort meine Unit UniCodeFileStream v1.0 (TFileStreamW) noch erheblich Performance raus, da ich keine Fehlerbehandlung drin habe (an den meisten Stellen ist die Fehlerwahrscheinlichkeit so gering, dass es sich kaum lohnt eine Fehlerbehandlung ein zu bauen) und auch die WinAPI richtig nutzte und nicht nur halb halb (TFileStream hat z.B. nen eigenes Seek-Verfahren, wo die WinAPI wesentlich schneller ist). Bei kleineren Dingen merkt man die Performanceunterschiede nicht, da ja auch eine schwankende Systemleistung dahinter steckt. Allerdings summeriert sich der Vorteil erheblich bei größeren Sachen auf.
Bei TSearchRec dürfte die Zeitmessung (oder was das ist, was ich dort gerade gesehen habe

) auch noch eine große Rolle spielen (das mit FileTimeToLocalFileTime). Für was braucht man denn bitteschön noch so eine Zeitmessung, wenn man die auch selber wesentlich schneller machen kann (einfach Endzeit von der Startzeit subtrahieren), da ein einzelndes Aufsummieren wesentlich langsamer ist? Insgesamt würde ich es bei SearchRec vor allem auf die Zeitmessung schieben

.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme