Autor |
Beitrag |
Luckie
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: Sa 18.12.04 19:33
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.
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
Beiträge: 2754
SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
|
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
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
_________________ es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...
|
|
Luckie
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: 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. 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
|
Verfasst: Sa 06.08.05 18:40
Hi Luckie,
darf man deine Unit in Freeware-Programmen einsetzten?
|
|
Luckie
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: Sa 06.08.05 19:53
|
|
Heiko
Beiträge: 3169
Erhaltene Danke: 11
|
Verfasst: 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
Beiträge: 3169
Erhaltene Danke: 11
|
Verfasst: 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.
|
|
Luckie
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: 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 www.luckie-online.de...er/Delphi/Sonstiges/ -> MpuDriveTools.pas
|
|
Heiko
Beiträge: 3169
Erhaltene Danke: 11
|
Verfasst: 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
Beiträge: 1905
W98, XP
D7 PE, Lazarus, WinAVR
|
Verfasst: 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
Beiträge: 3169
Erhaltene Danke: 11
|
Verfasst: 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) 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 .
|
|
|