/ Forside / Teknologi / Udvikling / Delphi/Pascal / Nyhedsindlæg
Login
Glemt dit kodeord?
Brugernavn

Kodeord


Reklame
Top 10 brugere
Delphi/Pascal
#NavnPoint
oldwiking 603
jrossing 525
rpje 520
EXTERMINA.. 500
gandalf 460
gubi 270
DJ_Puden 250
PARKENSS 230
technet 210
10  jdjespers.. 200
Kataloggennemløb med filmasker
Fra : Holger Nielsen


Dato : 10-07-02 14:19

Jeg har brug for at kunne gennemløbe et givet katalog og dets
underkataloger og f.eks. liste alle *.gif-filer.
Nedenstående procedure gennemløber rekursivt kataloget givet ved "Path"
og afleverer samlet filstørrelse og antal af filer, der matcher masken
"Mask", der. f.eks. kan være "GIF".
De fundne filer indsættes i en liste. De fire labels er brugt under
aflusning af proceduren.

procedure TForm1.DirectoryInfo(Path: String; var Size,Count: Longint);
function MaskMatches(FileName: String): Boolean;
var P: Byte;
begin
{ Find last dot in file name }
P:= Length(FileName);
while (FileName[P] <> '.') and (P > 0) do Dec(P);
{ Extract file mask and compare }
Result:= UpperCase(Copy(FileName,P+1,255)) = Mask;
end;
procedure TraverseDirectory(Path: String);
{ Procedures FileExists and DirectoryExists are used rather than
file attributes because FindFirst and FindNext may fail when
browsing cd-roms. Source: UDDF-Disk }
var SR: TSearchRec;
begin
if FindFirst(Path + '*.*',faAnyFile,SR) = 0 then
begin
if DirectoryExists(Path + SR.Name) then
begin
if (SR.Name <> '.') and (SR.Name <> '..') then
begin
Label1.Caption:= SR.Name;
TraverseDirectory(Path + SR.Name + '\');
end;
end
else
if FileExists(Path + SR.Name) then
begin
Label2.Caption:= SR.Name;
if MaskMatches(SR.Name) then
begin
Inc(Size,SR.Size);
Inc(Count);
FileList.Add(SR.Name);
end;
end;
while FindNext(SR) = 0 do
begin
if DirectoryExists(Path + SR.Name) then
begin
if (SR.Name <> '.') and (SR.Name <> '..') then
begin
Label3.Caption:= SR.Name;
TraverseDirectory(Path + SR.Name + '\');
end;
end
else
if FileExists(Path + SR.Name) then
begin
Label4.Caption:= SR.Name;
if MaskMatches(SR.Name) then
begin
Inc(Size,SR.Size);
Inc(Count);
FileList.Add(SR.Name);
end;
end;
end;
end;
FindClose(SR);
end;
begin
Size:= 0; Count:= 0;
if Copy(Path,Length(Path),1) <> '\' then Path:= Path + '\';
TraverseDirectory(Path);
end;


Proceduren synes at virke, men jeg er alligevel ikke tilfreds med den:

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?

2) Udvælgelsen sker med funktionen "MaskMatches" af egen avl. Findes der
en bedre måde, måske en indbygget funktion?

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...".

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.

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?

Venlig hilsen

Holger Nielsen


 
 
René Jensen (11-07-2002)
Kommentar
Fra : René Jensen


Dato : 11-07-02 01:04

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.

Holger Nielsen (11-07-2002)
Kommentar
Fra : Holger Nielsen


Dato : 11-07-02 09:35

René Jensen skriver:

> 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++ :)

....

Tak for din hjælp og dine bemærkninger! Jeg vil straks afprøve din kode.

Venlig hilsen

Holger


Søg
Reklame
Statistik
Spørgsmål : 177552
Tips : 31968
Nyheder : 719565
Indlæg : 6408849
Brugere : 218887

Månedens bedste
Årets bedste
Sidste års bedste