Entwickler-Ecke
Open Source Units - DriveTools - nützliche Laufwerks Routinen
Delete - Sa 18.12.04 19:33
Titel: DriveTools - nützliche Laufwerks Routinen
Für ein Projekt brauchte ich ein paar Routinen bezüglich Laufwerke. Rausgekommen ist die Unit DriveTools.
Routinen:
GetLogicalDrives - Listet alle logischen Laufwerke auf
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
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
Delphi-Quelltext
1:
| function GetVolumeLabel(const Drive: string): string; |
Drive ist das Laufwerk, dessen Datenträgerbezeichnug ermittelt werden soll.
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:
|
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
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;
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;
procedure InitFindAllFiles; begin SetLength(FoundFiles, 0); cntFoundFiles := 0; end;
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 - 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
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 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
Delete - Fr 01.07.05 17:50
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 - Sa 06.08.05 18:40
Hi Luckie,
darf man deine Unit in Freeware-Programmen einsetzten?
Delete - Sa 06.08.05 19:53
Jupp.
Heiko - Mi 07.09.05 07:43
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 - Sa 22.10.05 14:49
Hi Luckie,
deine Unit scheint einen Bug zu haben.
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
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.
Delete - Sa 22.10.05 14:57
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
http://www.luckie-online.de/Developer/Delphi/Sonstiges/ -> MpuDriveTools.pas
Heiko - Sa 22.10.05 16:17
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 - Fr 14.07.06 14:04
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 - Fr 14.07.06 14:18
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) [
http://www.delphi-forum.de/viewtopic.php?t=62275&start=0&postdays=0&postorder=asc&highlight=] 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 ;).
Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2024 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!