[Back to DIRS SWAG index] [Back to Main SWAG index] [Original]

    UNIT Engine;

    {$V-}

    (**************************************************************************)
    (* SEARCH ENGINE                                                          *)
    (*        Input Parameters:                                               *)
    (*              Mask  : The file specification to search for              *)
    (*                      May contain wildcards                             *)
    (*              Attr  : File attribute to search for                      *)
    (*              Proc  : Procedure to process each found file              *)
    (*                                                                        *)
    (*        Output Parameters:                                              *)
    (*              ErrorCode  : Contains the final error code.               *)
    (**************************************************************************)

    (************************)
    (**)   INTERFACE      (**)
    (************************)

    USES DOS;

    TYPE
        ProcType     = PROCEDURE (VAR S : SearchRec; P : PathStr);
        FullNameStr  = STRING[12];

        PROCEDURE SearchEngine(Mask : PathStr; Attr : Byte; Proc : ProcType; VAR ErrorCode : Byte);

        FUNCTION GoodDirectory(S : SearchRec) : Boolean;
        PROCEDURE ShrinkPath(VAR path   : PathStr);
        PROCEDURE ErrorMessage(ErrCode  : Byte);
        PROCEDURE SearchEngineAll(path  : PathStr; Mask : FullNameStr; Attr : Byte; Proc : ProcType; VAR ErrorCode : Byte);

        (************************)
        (**) IMPLEMENTATION   (**)
        (************************)

    VAR
        EngineMask : FullNameStr;
        EngineAttr : Byte;
        EngineProc : ProcType;
        EngineCode : Byte;

        PROCEDURE SearchEngine(Mask : PathStr; Attr : Byte; Proc : ProcType; VAR ErrorCode : Byte);

        VAR
           S : SearchRec;
           P : PathStr;
           Ext : ExtStr;

        BEGIN
           FSplit(Mask, P, Mask, Ext);
           Mask := Mask + Ext;
           FindFirst(P + Mask, Attr, S);
           IF DosError <> 0 THEN
              BEGIN
                   ErrorCode := DosError;
                   Exit;
              END;

        WHILE DosError = 0 DO
              BEGIN
                   Proc(S, P);
                   FindNext(S);
              END;
        IF DosError = 18 THEN ErrorCode := 0
        ELSE ErrorCode := DosError;
    END;

    FUNCTION GoodDirectory(S : SearchRec) : Boolean;
    BEGIN
        GoodDirectory := (S.name <> '.') AND (S.name <> '..') AND (S.Attr AND Directory = Directory);
    END;

    PROCEDURE ShrinkPath(VAR path : PathStr);
    VAR P : Byte;
        Dummy : NameStr;
    BEGIN
        FSplit(path, path, Dummy, Dummy);
        Dec(path[0]);
    END;

    {$F+} PROCEDURE SearchOneDir(VAR S : SearchRec; P : PathStr); {$F-}
          {Recursive procedure to search one directory}
    BEGIN
        IF GoodDirectory(S) THEN
           BEGIN
                P := P + S.name;
                SearchEngine(P + '\' + EngineMask, EngineAttr, EngineProc, EngineCode);
                SearchEngine(P + '\*.*',Directory OR Archive, SearchOneDir, EngineCode);
           END;
    END;

    PROCEDURE SearchEngineAll(path : PathStr; Mask : FullNameStr; Attr : Byte; Proc : ProcType; VAR ErrorCode : Byte);

    BEGIN
        (* Set up Unit global variables for use in recursive directory search procedure *)
        EngineMask := Mask;
        EngineProc := Proc;
        EngineAttr := Attr;
        SearchEngine(path + Mask, Attr, Proc, ErrorCode);
        SearchEngine(path + '*.*', Directory OR Attr, SearchOneDir, ErrorCode);
        ErrorCode := EngineCode;
    END;

    PROCEDURE ErrorMessage(ErrCode : Byte);
    BEGIN
        CASE ErrCode OF
             0 : ;                              {OK -- no error}
             2 : WriteLn('File not found');
             3 : WriteLn('Path not found');
             5 : WriteLn('Access denied');
             6 : WriteLn('Invalid handle');
             8 : WriteLn('Not enough memory');
             10 : WriteLn('Invalid environment');
             11 : WriteLn('Invalid format');
             18 : ;                    {OK -- merely no more files}
        ELSE WriteLN('ERROR #', ErrCode);
        END;
    END;

    END.

    { ===============================   DEMO     ==============================}

    {$R-,S+,I+,D+,F-,V-,B-,N-,L+ }
    {$M 2048,0,0 }
    PROGRAM DirSum;
            (*******************************************************)
            (* Uses SearchEngine to write the names of all files   *)
            (* in the current directory and display the total disk *)
            (* space that they occupy.                             *)
            (*******************************************************)
    USES DOS,ENGINE;

    VAR
       Template  : PathStr;
       ErrorCode : Byte;
       Total     : LongInt;

    {$F+} PROCEDURE WriteIt(VAR S : SearchRec; P : PathStr);  {$F-}
    BEGIN   WriteLn(S.name); Total := Total + S.Size END;

    BEGIN
         Total := 0;
         GetDir(0, Template);
         IF Length(Template) = 3 THEN Dec(Template[0]);
         {^Avoid ending up with "C:\\*.*"!}
         Template := Template + '\*.*';
         SearchEngine(Template, AnyFile, WriteIt, ErrorCode);
         IF ErrorCode <> 0 THEN ErrorMessage(ErrorCode) ELSE
            WriteLn('Total size of displayed files: ', Total : 8);
    END.

[Back to DIRS SWAG index] [Back to Main SWAG index] [Original]