home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / w3_syst / inctrl.arj / FILESRCH.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-04-01  |  2.9 KB  |  105 lines
  1. {$X+}
  2. UNIT FileSrch;
  3. (**) INTERFACE (**)
  4. USES WinDos, Strings;
  5. TYPE
  6.     {-SearchProc must return 0 if Ok, > 127 if error-}
  7.   SearchProc = FUNCTION(VAR S : TSearchRec; P : Pchar) : Byte;
  8.  
  9.   FUNCTION Searcher(Mask : PChar;
  10.                     Attr : Byte;
  11.                     SP   : SearchProc) : Byte;
  12.   FUNCTION AllSearcher(Mask : PChar;
  13.                        Attr : Byte;
  14.                        SP   : SearchProc) : Byte;
  15.  
  16. (**) IMPLEMENTATION (**)
  17.  
  18.   FUNCTION Searcher(Mask : PChar;
  19.                     Attr : Byte;
  20.                     SP   : SearchProc) : Byte;
  21.   VAR
  22.     SR  : TSearchRec;
  23.     Ds  : ARRAY[0..65] OF Char;
  24.     Ns  : ARRAY[0..8] OF Char;
  25.     Es  : ARRAY[0..3] OF Char;
  26.     Err : Byte;
  27.   BEGIN
  28.     FindFirst(Mask, Attr, SR);
  29.     IF DosError <> 0 THEN Searcher := DosError
  30.     ELSE
  31.       BEGIN
  32.         Err := 0;
  33.         FileSplit(Mask, Ds, Ns, Es);
  34.         WHILE (DosError = 0) AND (Err = 0) DO
  35.           BEGIN
  36.             Err := SP(SR, Ds);
  37.             FindNext(SR);
  38.           END;
  39.         IF Err <> 0 THEN Searcher := Err
  40.         ELSE IF DosError = 18 THEN Searcher := 0
  41.         ELSE Searcher := DosError;
  42.       END;
  43.   END;
  44.  
  45. VAR
  46.   GlobalSearchDirMask : Array[0..12] OF Char;
  47.   GlobalSearchDirAttr : Byte;
  48.   GlobalSearchDirProc : SearchProc;
  49.  
  50.   FUNCTION SearchDir(VAR S:TSearchRec; P:PChar) : Byte; FAR;
  51.   VAR
  52.     NuP : ARRAY[0..79] OF Char;
  53.     Err : Byte;
  54.   BEGIN
  55.     Err := 0;
  56.     IF (S.name[0] <> '.') AND
  57.        (S.Attr AND faDirectory > 0) THEN
  58.       BEGIN
  59.         StrCopy(NuP, P);
  60.         StrCat(NuP, S.Name);
  61.         {- handle individual files -}
  62.         StrCat(NuP, '\');
  63.         StrCat(NuP, GlobalSearchDirMask);
  64.         Err := Searcher(NuP,
  65.                         GlobalSearchDirAttr,
  66.                         GlobalSearchDirProc);
  67.         IF Err = 0 THEN
  68.           BEGIN
  69.             {- handle any subdirectories -}
  70.             StrCopy(NuP, P);
  71.             StrCat(NuP, S.Name);
  72.             StrCat(NuP, '\*.*');
  73.             Err := Searcher(NuP,
  74.                             faDirectory OR faArchive,
  75.                             SearchDir)
  76.           END;
  77.       END;
  78.     SearchDir := Err;
  79.   END;
  80.  
  81.   FUNCTION AllSearcher(Mask : PChar;
  82.                        Attr : Byte;
  83.                        SP   : SearchProc) : Byte;
  84.   VAR
  85.     Ds  : ARRAY[0..65] OF Char;
  86.     Ns  : ARRAY[0..8] OF Char;
  87.     Es  : ARRAY[0..3] OF Char;
  88.     Err : Byte;
  89.   BEGIN
  90.     FileSplit(Mask, Ds, Ns, Es);
  91.     StrCopy(GlobalSearchDirMask, Ns);
  92.     StrCat(GlobalSearchDirmask, Es);
  93.     GlobalSearchDirAttr := Attr;
  94.     GlobalSearchDirProc := SP;
  95.     {- handle individual files -}
  96.     Err := Searcher(Mask, Attr, SP);
  97.     StrCat(Ds, '*.*');
  98.     IF (Err = 0) OR (Err = 18) THEN
  99.       {- handle any subdirectories -}
  100.       AllSearcher := Searcher(Ds,
  101.                               faDirectory OR faArchive,
  102.                               SearchDir)
  103.     ELSE AllSearcher := Err;
  104.   END;
  105. END.