home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / turbopas / spoc88.arc / PASBUG.ARC / ENGINEB.PAS < prev   
Pascal/Delphi Source File  |  1988-07-13  |  4KB  |  144 lines
  1.   UNIT Engine;
  2.  
  3.   {$V-}
  4.  
  5.   (*********************************************************)
  6.   (*  SEARCH ENGINE                                        *)
  7.   (*     Input Parameters:                                 *)
  8.   (*       Mask : The file specification to search for     *)
  9.   (*              May contain wildcards                    *)
  10.   (*       Attr : File attribute to search for             *)
  11.   (*       Proc : Procedure to process each found file     *)
  12.   (*                                                       *)
  13.   (*     Ouput Parameters:                                 *)
  14.   (*       ErrorCode : Contains the final error code.      *)
  15.   (*                                                       *)
  16.   (*********************************************************)
  17.  
  18.   (**********************)
  19.   (**)   INTERFACE    (**)
  20.   (**********************)
  21.  
  22. USES DOS;
  23.  
  24. TYPE ProcType = PROCEDURE (VAR S : SearchRec; P : PathStr);
  25.  
  26.   PROCEDURE SearchEngine(Mask : PathStr;
  27.                           Attr : Byte;
  28.                           Proc : ProcType;
  29.                  VAR ErrorCode : Byte);
  30.  
  31.   FUNCTION GoodDirectory(S : SearchRec) : Boolean;
  32.   PROCEDURE ShrinkPath(VAR path  : PathStr);
  33.   PROCEDURE ErrorMessage(ErrCode : Byte);
  34.   PROCEDURE SearchEngineAll(path : PathStr;
  35.                             Mask : NameStr;
  36.                             Attr : Byte;
  37.                             Proc : ProcType;
  38.                             VAR ErrorCode : Byte);
  39.  
  40.   (**********************)
  41.   (**) IMPLEMENTATION (**)
  42.   (**********************)
  43.  
  44. VAR
  45.   EngineMask : NameStr;
  46.   EngineAttr : Byte;
  47.   EngineProc : ProcType;
  48.   EngineCode : Byte;
  49.  
  50.   PROCEDURE SearchEngine(Mask : PathStr;
  51.                          Attr : Byte;
  52.                          Proc : ProcType;
  53.                          VAR ErrorCode : Byte);
  54.   VAR
  55.     S : SearchRec;
  56.     P : PathStr;
  57.     Ext : ExtStr;
  58.  
  59. {procedure FSplit(Path: PathStr; var Dir: DirStr;
  60.   var Name: NameStr; var Ext: ExtStr);}
  61.  
  62.  
  63.   BEGIN
  64.     FSplit(Mask, P, Mask, Ext);
  65.     Mask := Mask + Ext;
  66.     FindFirst(P + Mask, Attr, S);
  67.     IF DosError <> 0 THEN
  68.       BEGIN
  69.         ErrorCode := DosError;
  70.         Exit;
  71.       END;
  72.     WHILE DosError = 0 DO
  73.       BEGIN
  74.         Proc(S, P);
  75.         FindNext(S);
  76.       END;
  77.     IF DosError = 18 THEN ErrorCode := 0
  78.     ELSE ErrorCode := DosError;
  79.   END;
  80.  
  81.   FUNCTION GoodDirectory(S : SearchRec) : Boolean;
  82.   BEGIN
  83.     GoodDirectory := (S.name <> '.') AND
  84.     (S.name <> '..') AND
  85.     (S.Attr AND Directory = Directory);
  86.   END;
  87.  
  88.   PROCEDURE ShrinkPath(VAR path : PathStr);
  89.   VAR P : Byte;
  90.     Dummy : NameStr;
  91.   BEGIN
  92.     FSplit(path, path, Dummy, Dummy);
  93.     Dec(path[0]);
  94.   END;
  95.  
  96.   {$F+} PROCEDURE SearchOneDir(VAR S : SearchRec; P : PathStr); {$F-}
  97.     {Recursive procedure to search one directory}
  98.   BEGIN
  99.     IF GoodDirectory(S) THEN
  100.       BEGIN
  101.         P := P + S.name;
  102.         SearchEngine(P + '\' + EngineMask, EngineAttr,
  103.                      EngineProc, EngineCode);
  104.         SearchEngine(P + '\*.*', Directory OR Archive,
  105.                      SearchOneDir, EngineCode);
  106.       END;
  107.   END;
  108.  
  109.   PROCEDURE SearchEngineAll(path : PathStr;
  110.                             Mask : NameStr;
  111.                             Attr : Byte;
  112.                             Proc : ProcType;
  113.                             VAR ErrorCode : Byte);
  114.   BEGIN
  115.     (*Set up Unit global variables for use in
  116.       recursive directory search procedure*)
  117.     EngineMask := Mask;
  118.     EngineProc := Proc;
  119.     EngineAttr := Attr;
  120.     SearchEngine(path + Mask, Attr, Proc, ErrorCode);
  121.     SearchEngine
  122.     (path + '*.*', Directory OR Attr, SearchOneDir, ErrorCode);
  123.     ErrorCode := EngineCode;
  124.   END;
  125.  
  126.   PROCEDURE ErrorMessage(ErrCode : Byte);
  127.   BEGIN
  128.     CASE ErrCode OF
  129.       0 : ;                  {OK -- no error}
  130.       2 : WriteLn('File not found');
  131.       3 : WriteLn('Path not found');
  132.       5 : WriteLn('Access denied');
  133.       6 : WriteLn('Invalid handle');
  134.       8 : WriteLn('Not enough memory');
  135.       10 : WriteLn('Invalid environment');
  136.       11 : WriteLn('Invalid format');
  137.       18 : ;                 {OK -- merely "no more files"}
  138.     ELSE WriteLn('ERROR #', ErrCode);
  139.     END;
  140.   END;
  141.  
  142.  
  143. END.
  144.