scanning a directory

UNIT DScan;
{$F+}
INTERFACE

USES Dos;

TYPE	PathType	=STRING[64];
TYPE	NameType	=STRING;

TYPE	DChangeProc	=PROCEDURE(NewPath:PathType);
	FMatchProc	=PROCEDURE(N:NameType);
	ECheckProc	=PROCEDURE(VAR S:SearchRec);
	DMatchProc	=FUNCTION(O,N:NameType):BOOLEAN;

PROCEDURE DirectoryScanner(Dir:PathType;Mask:NameType);
PROCEDURE DriveScanner(D:CHAR;Mask:NameType);
PROCEDURE MultiDriveScanner(Dr:STRING;Mask:NameType);

VAR	DirectoryEntryProc,
	DirectoryLeaveProc,
	DirectorySubLeaveProc,
	DirectorySubReentryProc,
	DriveEntryProc,
	DriveExitProc      	:DChangeProc;
	DirectoryNameMatchProc	:DMatchProc;
	FileNameMatchProc	:FMatchProc;
	EntryCheckProc		:ECheckProc;

IMPLEMENTATION

USES OPSTRING;

VAR     NMask	:NameType;
	MName	:NameType;
	MExt	:NameType;

PROCEDURE DCPDummy(S:PathType);
BEGIN
END;
PROCEDURE FMPDummy(N:NameType);
BEGIN
END;
PROCEDURE ECPDummy(VAR S:SearchRec);
BEGIN
END;
FUNCTION DMPDummy(o,N:NameType):BOOLEAN;
BEGIN
 DMPDummy:=TRUE;
END;
FUNCTION MatchName(S:NameType):BOOLEAN;
VAR	N	:NameType;
	M	:NameType;
	E	:NameType;
	D	:NameType;
	match	:BOOLEAN;
BEGIN
 Match:=FALSE;
 IF (NMask='*.*') THEN Match:=TRUE
 ELSE
  BEGIN
   N:=JustName(S);
   E:=JustExtension(S);
   IF (MName='*')or(N=MName) THEN
    BEGIN
     IF (MExt='*')OR(E=MExt) THEN Match:=TRUE;
    END;
  END;	{ else }
 MatchName:=Match;
END;	{ matchname }

PROCEDURE DirectoryScan(Dir:PathType);
VAR	OrgPath,
	NextPath	:STRING;
        S		:SearchRec;

BEGIN
 GetDir(0,OrgPath);
 {$I-}
 ChDir(Dir);
 IF (IOResult<>0) THEN Exit;
 {$I+}
 DirectoryEntryProc(Dir);
 FindFirst('*.*',AnyFile,S);
 WHILE DOSError=0 DO
  BEGIN
   IF (S.Name<>'.') AND
      (S.Name<>'..') AND
      (S.Attr<>VolumeID) THEN
    BEGIN
     IF ((S.Attr and Directory)=Directory) THEN
      BEGIN
       NextPath:=AddBackSlash(Dir)+S.Name;
       IF (DirectoryNameMatchProc(Dir,S.Name)) THEN
	BEGIN
	 DirectorySubLeaveProc(Dir);
	 DirectoryScan(NextPath);
	 DirectorySubReentryProc(Dir);
	END;
      END
     ELSE
      BEGIN
       IF (@EntryCheckProc<>@ECPDummy) THEN EntryCheckProc(s);
       IF (MatchName(S.Name)) THEN
	BEGIN
	 FileNameMatchProc(S.Name);
	END;
      END;
    END;
   FindNext(S);
  END;
 ChDir(OrgPath);
 DirectoryLeaveProc(Dir);
END;

PROCEDURE DirectoryScanner(Dir:PathType;Mask:NameType);
BEGIN
 NMask:=stupcase(Mask);
 MName:=stupcase(JustName(Mask));
 MExt:=stupcase(JustExtension(Mask));
 DirectoryScan(Dir);
END;

PROCEDURE DriveScanner(D:CHAR;Mask:NameType);
VAR OrgPath,NewPath:PathType;
BEGIN
 GetDir(0,OrgPath);
 NewPath:=UpCase(D)+':\';
 DriveEntryProc(NewPath);
 DirectoryScanner(NewPath,Mask);
 ChDir(OrgPath);
 DriveExitProc(NewPath);
END;

PROCEDURE MultiDriveScanner(Dr:STRING;Mask:NameType);
VAR i:BYTE;
BEGIN
 FOR i:=1 TO Length(Dr) DO
  BEGIN
   DriveScanner(Dr[i],Mask);
  END;
END;

BEGIN
 DirectoryEntryProc:=DCPDummy;
 DirectoryLeaveProc:=DCPDummy;
 DirectorySubLeaveProc:=DCPDummy;
 DirectorySubReentryProc:=DCPDummy;
 DirectoryNameMatchProc:=DMPDummy;
 DriveEntryProc:=DCPDummy;
 DriveExitProc:=DCPDummy;
 FileNameMatchProc:=FMPDummy;
 EntryCheckProc:=ECPDummy;
END.

An application

{$F+}
PROGRAM DirectoryScanTest;
USES Dos,OPCrt,OPString,DScan;

VAR Cnt :LONGINT;
    A,B,C:LONGINT; {a:drivesize,b:local dirsize,c:global dirsize}
    at,bt,ct:LONGINT; { trash }
    F:TEXT;
    X:ARRAY[0..20]OF LONGINT;
    Xt:ARRAY[0..20]OF LONGINT;
    xi,xit:BYTE;

PROCEDURE push(i:LONGINT);
BEGIN  
 inc(xi); 
 X[xi]:=i; 
END;
PROCEDURE pusht(i:LONGINT);
BEGIN  
 inc(xit); 
 Xt[xit]:=i; 
END;
FUNCTION Pop:LONGINT;
BEGIN  
 Pop:=X[xi]; 
 dec(xi);
END;
FUNCTION Popt:LONGINT;
BEGIN  
 Popt:=Xt[xit]; 
 dec(xit);
END;

PROCEDURE DriveEntry(P:PathType);
BEGIN
{ Write(chr(13));}
{ Writeln('now ',P);}
 a:=0;b:=0;c:=0;at:=0;bt:=0;ct:=0;
 push(0); pusht(0);
END;
PROCEDURE DriveExit(P:PathType);
VAR Y:SINGLE;
BEGIN
 a:=pop;at:=popt;
 IF (at<>0) THEN y:=100.0*a/at ELSE y:=0;
 Writeln(f,PadCh('Drive '+P,'.',64),Form('##',y),' ',Form('#,###,###,###.',a));
END;

PROCEDURE DirEntryProc(P:PathType);
BEGIN
{ Write(chr(13));
 Write('Scanning ',P,'              ');}
 push(0);pusht(0);
END;

PROCEDURE DirLeaveProc(P:PathType);
VAR Y:SINGLE;
BEGIN
{ Write(chr(13));
 Write('Leaving ',p,'                 ');}
 b:=pop;bt:=popt;
 X[xi]:=X[xi]+b;Xt[xit]:=Xt[xit]+bt;
 IF (bt<>0) THEN y:=100.0*b/bt ELSE y:=0;
 Writeln(f,PadCh('Dir '+p,'.',64),Form('##',y),' ',Form('#,###,###,###.',b));
END;

PROCEDURE DirSubLeaveProc(P:PathType);
BEGIN
END;
PROCEDURE DirSubReentryProc(P:PathType);
BEGIN
END;

PROCEDURE FileMatchProc(N:NameType);
BEGIN
{ Writeln('Processing ',N);}
END;

PROCEDURE EntryCheckingProc(VAR S:SearchRec);
VAR f:FILE;
BEGIN
 inc(cnt);
{ IF (S.Size=0) THEN
  BEGIN
   Writeln(S.Name);
   inc(cnt);
   Assign(f,s.name);
   Erase(f);
  END; }
 Inc(X[xi],S.Size);
 IF (S.Size>=32868) THEN Inc(Xt[xit],S.Size)
 ELSE Inc(Xt[xit],32868);
END;

BEGIN
 cnt:=0;xi:=0;xit:=0;
 Assign(f,'SIZE.TXT');
 ReWrite(f);
 Writeln(f,'Used size determined by size.exe');
 DirectoryEntryProc:=DirEntryProc;
 DirectoryLeaveProc:=DirLeaveProc;
{ FileNameMatchProc:=FileMatchProc;}
 DriveEntryProc:=DriveEntry;
 DriveExitProc:=DriveExit;
 EntryCheckProc:=EntryCheckingProc;
 DirectorySubLeaveProc:=DirSubLeaveProc;
 DirectorySubReentryProc:=DirSubReentryProc;
{ DirectoryScanner('D:\','*.PAS');}
 MultiDriveScanner('CDEFGHIJ','*.*');
 writeln('done - found : ',cnt);
END.