Holger Nielsen wrote:
> Proceduren synes at virke, men jeg er alligevel ikke tilfreds med den:
Derfor har jeg tilladt mig at hjælpe dig lidt på vej ved at skrive en
unit, som har en klasse, jeg har kaldt DirInfo. Kildeteksten finder du
til sidst i dette indlæg og er ren copy/paste, så undskyld for de
tabulator-stop, men jeg er vant til dem fra C++ :)
Eksempel på brug af klassen:
{$APPTYPE CONSOLE}
var
DirInfo: TDirInfo;
i: Integer;
begin
DirInfo := TDirInfo.Create;
with DirInfo do
begin
Root := 'C:\Mine Dokumenter\Billeder'; // sæt roden, hvor søgningen
skal foretages fra
FileMask := 'gif'; // angiv efternavnet på de filer, som skal
filtreres, hvis der ikke angives noget filter, så vil alle filer blive
tilføjet listen
FindFiles; // starter søgning, alle filer vil blive tilføjet til en
TStringList-klasse, såfremt de opfylder filter-kravet
if not Empty then
begin
// FileList er en TStringList, så her gælder den samme "simple"
kode til at traversere streng-listen
for i := 0 to FileList.Count - 1 do
Writeln(FileList.Strings[i]);
Writeln('Antal under-kataloger fundet: ', DirCount);
Writeln('Antal filer fundet: ', FileCount);
Writeln('Samlet størrelse på alle filer: ', DirSize);
end
else
Writeln('Kunne ikke finde nogle filer der opfylder dit
filter-krav.');
end;
end;
> 1) Jeg troede naivt, at når man ønskede alle filer af en bestemt type,
> så kunne man få dem ved anvendelse af den relevante filmaske, f.eks:
> "if FindFirst(Path + '*.gif',faAnyFile,SR) = 0 then"
> Men det giver kun .gif-filer i rodkataloget, åbenbart fordi
> underkatalogerne ikke matcher. Man er derfor pisket til at bruge masken
> '*.*' og så selv udvælge filerne.
> Er det rigtigt forstået, eller har jeg overset noget?
Så længe jeg har programmet i Pascal/Delphi, så har der ikke været nogen
vej udenom.
> 2) Udvælgelsen sker med funktionen "MaskMatches" af egen avl. Findes der
> en bedre måde, måske en indbygget funktion?
Ja ... f.eks. funktionen ExtractFileExt(FileName: string) - se evt.
koden til min implementation af proceduren TraverseDirectory(Path:
string), som er indkluderet i bunden af dette indlæg.
> 3) Det generer mig, at hvis jeg ønsker at medtage alle filer ('*.*'), så
> skal denne situation behandles specielt, f.eks. ved i MaskMatches at
> tilføje:
> "if Mask = '*.*' then Result:= true else...".
Igen henviser jeg til min egen løsning; du kommer nok ikke uden om en
enkelt if-sætning, men det løsningen er mere kortfattet end din
MaskMatches-funktion :)
> 4) Jeg har bemærket, at Label1 og Label2 aldrig ændrer indhold. Åbenbart
> fordi de første indgange i kataloget er DOS-katalogerne '.' og '..'. Kan
> man være sikke på, at det altid et tilfældet? I så fald kan hele blokken
> efter FindFirst jo droppes.
Alle kataloger har som standard to underkataloger, selvom de er tomme,
og det er ganske rigtigt '.' og '..' katalogerne, som nuværende katalog
og et katalog tilbage respektivt.
> 5) Proceduren er omskrevet efter en version af Roger Fylling på
>
www.gnomehome.demon,nl/uddf/pages/disk.htm.
> Han angiver at men bør bruge konstruktionen
> "if DirectoryExists(Path + SR.Name) then"
> i stedet for
> "if (SR.Attr and faDirectory > 0) then"
> fordi FindFirst og FindNext ikke altid giver korrekte resultater ved
> anvendelse på cd-rom drev. Er det stadig korrekt i Delphi 6, som jeg
> bruger?
Det skal jeg så ikke kunne sige - de par test jeg har kørt med søgning
på CD-ROM ikke vist de tendenser, som Roger Fylling beskriver.
Med venlig hilsen,
René Jensen
Kildetekst:
// Sourcecode by René Jensen
unit DirInfoClass;
interface
uses
Classes,
SysUtils;
type
TDirInfo = class
private
pDirCount: Cardinal;
pDirSize: Cardinal;
pFileCount: Cardinal;
pFileList: TStringList;
public
FileMask: string;
Root: string;
property DirCount: Cardinal read pDirCount;
property DirSize: Cardinal read pDirSize;
property FileCount: Cardinal read pFileCount;
property FileList: TStringList read pFileList;
constructor Create; overload;
function Empty : Boolean;
procedure FindFiles;
procedure Free;
end;
implementation
constructor TDirInfo.Create;
begin
FileMask := '*';
Root := '';
pDirCount := 0;
pDirSize := 0;
pFileCount := 0;
pFileList := TStringList.Create;
pFileList.Clear;
end;
function TDirInfo.Empty : Boolean;
begin
if pFileList.Count = 0 then
Result := TRUE
else
Result := FALSE;
end;
procedure TDirInfo.FindFiles;
procedure TraverseDirectory(Path: string);
var
SearchRec: TSearchRec;
begin
if Path[Length(Path)] <> '\' then
Path := Path + '\';
if FindFirst(Path + '*.*', faAnyFile, SearchRec) = 0 then
begin
while FindNext(SearchRec) = 0 do
begin
if SearchRec.Attr and faDirectory = faDirectory then
begin
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
TraverseDirectory(Path + SearchRec.Name);
pDirCount := pDirCount + 1;
end;
end
else
if (ExtractFileExt(SearchRec.Name) = '.' + FileMask) or (FileMask =
'*') then
begin
pFileList.Add(Path + SearchRec.Name);
pFileCount := pFileCount + 1;
pDirSize := pDirSize + Cardinal(SearchRec.Size);
end;
end;
FindClose(SearchRec);
end;
end;
begin
TraverseDirectory(Root);
end;
procedure TDirInfo.Free;
begin
pFileList.Free;
end;
end.