home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / multtsk / cpm25d / finder.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-28  |  11KB  |  367 lines
  1. {$I cpmswitc.inc}
  2.  
  3. {--------------------------------------------------------------------------
  4.  
  5. FINDER.PAS (Demonstration of the unit MTPipe)
  6.  
  7. This program requires the CPMULTI Multitasking Toolkit and Turbo Pascal
  8. 5.0 or later.
  9.  
  10. January 1994
  11.  
  12. Copyright (C) 1994 (USA)        Copyright (C) 1989-1994
  13. Hypermetrics                    Christian Philipps Software-Technik
  14. PO Box 9700 Suite 363           Duesseldorfer Str. 316
  15. Austin, TX  78758-9700          D-47447 Moers
  16.                                 Germany
  17.                                                                     
  18. The program Finder searches one or more disks with one or more search 
  19. patterns given as command line parameters. For each pattern a separate
  20. task is started, so that individual searches run in parallel. There is a
  21. maximum of 10 search patterns which can be specified on the command line.
  22.  
  23. Finder waits for a keystroke after each screenful of matches. During this 
  24. time, however, the searches continue in the background so long as the pipe
  25. buffer is not yet full.
  26.  
  27. --------------------------------------------------------------------------- }
  28.  
  29. PROGRAM Finder;
  30.  
  31. USES DOS, CRT, CPMulti, CPMisc, MTPipe;
  32.  
  33. TYPE  FileType       = (Directory, NonDirectory);
  34.       FMaskType      = String[12];
  35.       ErrorType      = (ErrCreateSem, ErrAssignPipe,
  36.                         ErrRemoveSem, ErrCreateTask,
  37.                         ErrRewrite,   ErrReset);
  38.       ParmType       = RECORD
  39.                          Ready     : Pointer;
  40.                          Path      : String;
  41.                          Mask      : FMaskType;
  42.                        END;
  43.       ParmPtr        = ^ParmType;
  44.  
  45. CONST FinderStackSize = 8000;
  46.       PipeSize        = 10000;
  47.       MaxFinders      = 10;
  48.  
  49. VAR   MainPipe       : TEXT;
  50.       DispSem        : Pointer;
  51.       FindSem        : Pointer;
  52.  
  53. {-----------------------------------------------------------------------------}
  54.  
  55. PROCEDURE SafeFindFirst(Path:String; Attr:Word; VAR S:SearchRec);
  56. BEGIN
  57.   SemWait(FindSem);
  58.   FindFirst(Path,Attr,S);
  59.   SemSignal(FindSem);
  60. END;
  61.  
  62. {-----------------------------------------------------------------------------}
  63.  
  64. PROCEDURE SafeFindNext(VAR S:SearchRec);
  65. BEGIN
  66.   SemWait(FindSem);
  67.   FindNext(S);
  68.   SemSignal(FindSem);
  69. END;
  70.  
  71. {-----------------------------------------------------------------------------}
  72.  
  73. PROCEDURE FinderError(Err:ErrorType);
  74. BEGIN
  75.   Write(^G'Finder: ');
  76.   CASE Err OF
  77.     ErrCreateSem:  Writeln('Error in CreateSem');
  78.     ErrRemoveSem:  Writeln('Error in RemoveSem');
  79.     ErrCreateTask: Writeln('Error in CreateTask');
  80.     ErrAssignPipe: Writeln('Error in AssignPipe');
  81.     ErrRewrite:    Writeln('Error in Rewrite Pipe');
  82.     ErrReset:      Writeln('Error in Reset Pipe');
  83.   ELSE
  84.     Writeln('Unknown error (',Byte(Err),')!');
  85.   END;
  86.   Halt(1);
  87. END;
  88.  
  89. {-----------------------------------------------------------------------------}
  90.  
  91. PROCEDURE Display(FType:FileType; FName:String; VAR Pipe:TEXT);
  92.  
  93. { Output of status messages over a pipe. The message consists of 3
  94.   interrelated parts which makes the whole output operation atomic.
  95.   Semaphore operation at the beginning and end of the procedure
  96.   ensure that all 3 parts of the message are output together and in
  97.   sequence.
  98.  
  99.   Note: This procedure uses standard PASCAL operations to write into
  100.         the pipe. Things could be done simple by using the direct
  101.         access functions.
  102. }
  103.  
  104. BEGIN
  105.   SemWait(DispSem);
  106.   IF FType = Directory
  107.      THEN Write(Pipe,'D ')
  108.      ELSE Write(Pipe,'F ');
  109.   WriteLn(Pipe,GetPID,' ',Fname);
  110.   SemSignal(DispSem);
  111. END;
  112.  
  113. {-----------------------------------------------------------------------------}
  114.  
  115. PROCEDURE ScanFiles(Path:String; FileMask:FMaskType; VAR Pipe:TEXT);
  116.  
  117. { Scan a directory for matching filenames }
  118.  
  119. VAR  S : SearchRec;
  120. BEGIN
  121.   SafeFindFirst(Path+FileMask,$27,S);
  122.   WHILE DosError=0 DO
  123.   BEGIN
  124.     Display(NonDirectory,Path+S.Name,Pipe);
  125.     SafeFindNext(S);
  126.   END;
  127. END;
  128.  
  129. {-----------------------------------------------------------------------------}
  130.  
  131. PROCEDURE ScanDirs(Path:String; FileMask:FMaskType; VAR Pipe:TEXT);
  132.  
  133. { Recursively scan the whole directory tree }
  134.  
  135. VAR  S : SearchRec;
  136. BEGIN
  137.   SafeFindFirst(Path+'*.*',$10,S);
  138.   WHILE DosError=0 DO
  139.   BEGIN
  140.     IF (S.Name[1] <> '.') AND (S.Attr = $10)
  141.        THEN BEGIN
  142.               Display(Directory,Path+S.Name,Pipe);
  143.               ScanFiles(Path+S.Name+'\',FileMask,Pipe);
  144.               ScanDirs(Path+S.Name+'\',FileMask,Pipe);
  145.             END;
  146.     SafeFindNext(S);
  147.   END;
  148. END;
  149.  
  150. {-----------------------------------------------------------------------------}
  151.  
  152. {$F+}
  153. PROCEDURE FindTask(P:Pointer);
  154.  
  155. { This is the task body for the search tasks.
  156.   Each task opens its own communication channel through the pipe "Finder."
  157.   After that it recursively scans the directory tree with the given
  158.   search pattern. Status messages are passed to the output process
  159.   by means of the procedure "Diskplay" in the main program (via pipe).
  160.  
  161.   After successful completion of the work, the task closes its side of the
  162.   pipe and terminates. After all writing tasks, i. e. all search tasks
  163.   have terminated, the main program which is reading the pipe will return
  164.   an error return which signals EOF.
  165. }
  166.  
  167. VAR  Parms: ParmPtr absolute P;
  168.      Pipe : TEXT;
  169.      Path : String;
  170.      Mask : FMaskType;
  171.  
  172. BEGIN
  173.   IF Not AssignPipe(Pipe,'Finder',0,0,NoWait)
  174.      THEN FinderError(ErrAssignPipe);
  175.   Rewrite(Pipe);
  176.   IF IoResult <> 0
  177.      THEN FinderError(ErrRewrite);
  178.   Path := Parms^.Path;
  179.   Mask := Parms^.Mask;
  180.   SemSignal(Parms^.Ready);
  181.   ScanFiles(Path,Mask,Pipe);
  182.   ScanDirs(Path,Mask,Pipe);
  183.   Display(Directory,'--- Finished! ---',Pipe);
  184.   Close(Pipe);
  185. END;
  186. {$F-}
  187.  
  188. {-----------------------------------------------------------------------------}
  189.  
  190. FUNCTION StartFinder:Byte;
  191.  
  192. { For every command line parameter, a separate process is started.
  193.   The procedure FindTask comprises the task body for ALL of these processes.
  194.   StartFinder also creates a semaphore necessary (to the procedure
  195.   "Display") for access synchronization.
  196.   StartFinder returns as a function value the number of the first task started.
  197.   This value is needed for the calculation of the output positions inside
  198.   "ProcessOutput."
  199. }
  200.  
  201. VAR  N     : Byte;
  202.      P     : Byte;
  203.      Parms : ParmType;
  204.      T     : TaskNoType;
  205.  
  206. BEGIN
  207.   IF CreateSem(DispSem) <> Sem_OK
  208.      THEN FinderError(ErrCreateSem);
  209.  
  210.   IF CreateSem(FindSem) <> Sem_OK
  211.      THEN FinderError(ErrCreateSem);
  212.  
  213.   IF CreateSem(Parms.Ready) <> Sem_OK
  214.      THEN FinderError(ErrCreateSem);
  215.   FOR N := 1 TO Min(ParamCount,MaxFinders) DO
  216.   WITH Parms DO
  217.   BEGIN
  218.     Path := ParamStr(n);
  219.     P    := Byte(Path[0]);
  220.     WHILE (P > 0) AND (Path[P] <> '\') AND (Path[P] <> ':') DO
  221.       Dec(P);
  222.     IF P = 0
  223.        THEN BEGIN
  224.               Mask := Path;
  225.               Path := '\';
  226.             END
  227.        ELSE BEGIN
  228.               Mask := Copy(Path,P+1,255);
  229.               Delete(Path,P+1,255);
  230.               IF Path[P] = ':'
  231.                  THEN Path := Path+'\';
  232.             END;
  233.     SemClear(Ready);
  234.     T := CreateTask(FindTask,@Parms,Pri_User,FinderStackSize);
  235.     IF T < 0
  236.        THEN FinderError(ErrCreateTask);
  237.     IF N = 1                                     { return ID of first task }
  238.        THEN StartFinder := T;
  239.     SemWait(Ready);
  240.   END;
  241.   IF RemoveSem(Parms.Ready) <> Sem_OK
  242.      THEN FinderError(ErrRemoveSem);
  243. END;
  244.  
  245. {-----------------------------------------------------------------------------}
  246.  
  247. PROCEDURE ProcessOutput(BaseNo:TaskNoType; NoOfTasks:Byte);
  248.  
  249. { This procedure reads messages from the pipe and displays them on
  250.   the screen.
  251.   Each message consists of three parts:
  252.   1. A letter giving the type of message: (D)irectory or (F)ile
  253.   2. The ID of the sender
  254.   3. A Pathname of a currently searched directory or a matching file
  255.   These message segments are separated by a blank (see also "Display").
  256.  
  257.   The whole content of the pipe is read inside the main loop of this
  258.   procedure. An error return from the read of the first message segment
  259.   indicates that no more writing processes exist.
  260. }
  261.  
  262. VAR  N    : Byte;
  263.      BotL : Byte;
  264.      Typ  : Char;
  265.      Task : Byte;
  266.      Path : String;
  267.      Hits : Word;
  268.      Sep  : String[80];
  269.      C    : Char;
  270.      Ende : Boolean;
  271.  
  272. BEGIN
  273.   Hits  := 0;
  274.   Ende  := False;
  275.  
  276.   ClrScr;
  277.   TextColor(0);
  278.   TextBackground(7);
  279.   GotoXY(1,1);
  280.   ClrEol;
  281.   GotoXY(17,1);
  282.   Write('>> Finder V1.0 (c) Christian Philipps, April 1990 <<');
  283.   TextColor(7);
  284.   TextBackground(0);
  285.  
  286.   BotL := 25-NoOfTasks-1;
  287.   FillChar(Sep,sizeof(Sep),'-');
  288.   Sep[0] := #80;
  289.   GotoXY(1,BotL+1);
  290.   Write(Sep);
  291.   Reset(MainPipe);
  292.   IF IoResult <> 0
  293.      THEN FinderError(ErrReset);
  294.   Read(MainPipe,Typ);
  295.   Read(MainPipe,Task);
  296.   ReadLn(MainPipe,Path);
  297.   Ende := IOResult <> 0;
  298.   WHILE NOT Ende DO
  299.   BEGIN
  300.     IF Typ = 'D'
  301.        THEN BEGIN
  302.               GotoXY(1,BotL+2+Task-BaseNo);
  303.               ClrEol;
  304.             END
  305.        ELSE BEGIN
  306.               Inc(Hits);
  307.               IF (Hits MOD BotL) = 0
  308.                  THEN BEGIN
  309.                         GotoXY(20,BotL+1);
  310.                         Write(' Press Return to continue, Escape to exit. ');
  311.                         REPEAT
  312.                           WHILE NOT Keypressed DO
  313.                             Sleep(1);
  314.                           C := ReadKey;
  315.                         UNTIL C IN [#27,#13];
  316.                         IF C = #27
  317.                            THEN Halt(1);
  318.                         GotoXY(1,BotL+1);
  319.                         Write(Sep);
  320.                       END;
  321.               GotoXY(1,2);
  322.               DelLine;
  323.               GotoXY(1,BotL);
  324.               InsLine;
  325.             END;
  326.     Write(Task:2,': ',Copy(Path,1,75));
  327.     Read(MainPipe,Typ);
  328.     Ende := IOResult <> 0;
  329.     IF NOT Ende
  330.        THEN BEGIN
  331.               Read(MainPipe,Task);
  332.               ReadLn(MainPipe,Path);
  333.             END;
  334.     END;
  335.   Close(MainPipe);
  336.   GotoXY(20,BotL+1);
  337.   Write(' ',Hits,' Matches! - Press any key to continue. ');
  338.   IF ReadKey = #0 THEN;
  339. END;
  340.  
  341. {-----------------------------------------------------------------------------}
  342.  
  343. BEGIN
  344.   IF ParamCount < 1
  345.      THEN BEGIN
  346.             Writeln('Finder V1.00 / Ch. Philipps');
  347.             Writeln('> Finder pattern [...]');
  348.             Writeln;
  349.             Writeln('Finder recursively scans the directory tree looking for');
  350.             Writeln('filenames matching the pattern. If no path is contained');
  351.             Writeln('in the pattern, the search starts at the root directory!');
  352.             Writeln('At max ',MaxFinders,' pattern may be given on the command line.');
  353.             Writeln;
  354.             Writeln('Example:  Finder C:*.sys D:*.sys');
  355.             Writeln('          Scan disks C and D starting at \ for files');
  356.             Writeln('          with the extension .SYS');
  357.             Halt(1);
  358.           END;
  359.  
  360.   SpeedUp(3);
  361.   TimeSlice(1,5);
  362.   SetPri(Pri_User+1);
  363.   IF Not AssignPipe(MainPipe,'Finder',PipeSize,0,NoWait)
  364.      THEN FinderError(ErrAssignPipe);
  365.   ProcessOutput(StartFinder,Min(ParamCount,MaxFinders));
  366. END.
  367.