Power-Programmierung/CD1.mdf/pascal/library/dos/multtsk/cpm25d/finder.pas

Pascal/Delphi Source File | 1994-04-28 | 11.1 KB | 367 lines

{$I cpmswitc.inc}

{--------------------------------------------------------------------------

FINDER.PAS (Demonstration of the unit MTPipe)

This program requires the CPMULTI Multitasking Toolkit and Turbo Pascal
5.0 or later.

January 1994

Copyright (C) 1994 (USA)        Copyright (C) 1989-1994
Hypermetrics                    Christian Philipps Software-Technik
PO Box 9700 Suite 363           Duesseldorfer Str. 316
Austin, TX  78758-9700          D-47447 Moers
                                Germany

The program Finder searches one or more disks with one or more search
patterns given as command line parameters. For each pattern a separate
task is started, so that individual searches run in parallel. There is a
maximum of 10 search patterns which can be specified on the command line.

Finder waits for a keystroke after each screenful of matches. During this
time, however, the searches continue in the background so long as the pipe
buffer is not yet full.

--------------------------------------------------------------------------- }

PROGRAM Finder;

USES DOS, CRT, CPMulti, CPMisc, MTPipe;

TYPE  FileType       = (Directory, NonDirectory);
      FMaskType      = String[12];
      ErrorType      = (ErrCreateSem, ErrAssignPipe,
                        ErrRemoveSem, ErrCreateTask,
                        ErrRewrite,   ErrReset);
      ParmType       = RECORD
                         Ready     : Pointer;
                         Path      : String;
                         Mask      : FMaskType;
                       END;
      ParmPtr        = ^ParmType;

CONST FinderStackSize = 8000;
      PipeSize        = 10000;
      MaxFinders      = 10;

VAR   MainPipe       : TEXT;
      DispSem        : Pointer;
      FindSem        : Pointer;

{-----------------------------------------------------------------------------}

PROCEDURE SafeFindFirst(Path:String; Attr:Word; VAR S:SearchRec);
BEGIN
  SemWait(FindSem);
  FindFirst(Path,Attr,S);
  SemSignal(FindSem);
END;

{-----------------------------------------------------------------------------}

PROCEDURE SafeFindNext(VAR S:SearchRec);
BEGIN
  SemWait(FindSem);
  FindNext(S);
  SemSignal(FindSem);
END;

{-----------------------------------------------------------------------------}

PROCEDURE FinderError(Err:ErrorType);
BEGIN
  Write(^G'Finder: ');
  CASE Err OF
    ErrCreateSem:  Writeln('Error in CreateSem');
    ErrRemoveSem:  Writeln('Error in RemoveSem');
    ErrCreateTask: Writeln('Error in CreateTask');
    ErrAssignPipe: Writeln('Error in AssignPipe');
    ErrRewrite:    Writeln('Error in Rewrite Pipe');
    ErrReset:      Writeln('Error in Reset Pipe');
  ELSE
    Writeln('Unknown error (',Byte(Err),')!');
  END;
  Halt(1);
END;

{-----------------------------------------------------------------------------}

PROCEDURE Display(FType:FileType; FName:String; VAR Pipe:TEXT);

{ Output of status messages over a pipe. The message consists of 3
  interrelated parts which makes the whole output operation atomic.
  Semaphore operation at the beginning and end of the procedure
  ensure that all 3 parts of the message are output together and in
  sequence.

  Note: This procedure uses standard PASCAL operations to write into
        the pipe. Things could be done simple by using the direct
        access functions.
}

BEGIN
  SemWait(DispSem);
  IF FType = Directory
     THEN Write(Pipe,'D ')
     ELSE Write(Pipe,'F ');
  WriteLn(Pipe,GetPID,' ',Fname);
  SemSignal(DispSem);
END;

{-----------------------------------------------------------------------------}

PROCEDURE ScanFiles(Path:String; FileMask:FMaskType; VAR Pipe:TEXT);

{ Scan a directory for matching filenames }

VAR  S : SearchRec;
BEGIN
  SafeFindFirst(Path+FileMask,$27,S);
  WHILE DosError=0 DO
  BEGIN
    Display(NonDirectory,Path+S.Name,Pipe);
    SafeFindNext(S);
  END;
END;

{-----------------------------------------------------------------------------}

PROCEDURE ScanDirs(Path:String; FileMask:FMaskType; VAR Pipe:TEXT);

{ Recursively scan the whole directory tree }

VAR  S : SearchRec;
BEGIN
  SafeFindFirst(Path+'*.*',$10,S);
  WHILE DosError=0 DO
  BEGIN
    IF (S.Name[1] <> '.') AND (S.Attr = $10)
       THEN BEGIN
              Display(Directory,Path+S.Name,Pipe);
              ScanFiles(Path+S.Name+'\',FileMask,Pipe);
              ScanDirs(Path+S.Name+'\',FileMask,Pipe);
            END;
    SafeFindNext(S);
  END;
END;

{-----------------------------------------------------------------------------}

{$F+}
PROCEDURE FindTask(P:Pointer);

{ This is the task body for the search tasks.
  Each task opens its own communication channel through the pipe "Finder."
  After that it recursively scans the directory tree with the given
  search pattern. Status messages are passed to the output process
  by means of the procedure "Diskplay" in the main program (via pipe).

  After successful completion of the work, the task closes its side of the
  pipe and terminates. After all writing tasks, i. e. all search tasks
  have terminated, the main program which is reading the pipe will return
  an error return which signals EOF.
}

VAR  Parms: ParmPtr absolute P;
     Pipe : TEXT;
     Path : String;
     Mask : FMaskType;

BEGIN
  IF Not AssignPipe(Pipe,'Finder',0,0,NoWait)
     THEN FinderError(ErrAssignPipe);
  Rewrite(Pipe);
  IF IoResult <> 0
     THEN FinderError(ErrRewrite);
  Path := Parms^.Path;
  Mask := Parms^.Mask;
  SemSignal(Parms^.Ready);
  ScanFiles(Path,Mask,Pipe);
  ScanDirs(Path,Mask,Pipe);
  Display(Directory,'--- Finished! ---',Pipe);
  Close(Pipe);
END;
{$F-}

{-----------------------------------------------------------------------------}

FUNCTION StartFinder:Byte;

{ For every command line parameter, a separate process is started.
  The procedure FindTask comprises the task body for ALL of these processes.
  StartFinder also creates a semaphore necessary (to the procedure
  "Display") for access synchronization.
  StartFinder returns as a function value the number of the first task started.
  This value is needed for the calculation of the output positions inside
  "ProcessOutput."
}

VAR  N     : Byte;
     P     : Byte;
     Parms : ParmType;
     T     : TaskNoType;

BEGIN
  IF CreateSem(DispSem) <> Sem_OK
     THEN FinderError(ErrCreateSem);

  IF CreateSem(FindSem) <> Sem_OK
     THEN FinderError(ErrCreateSem);

  IF CreateSem(Parms.Ready) <> Sem_OK
     THEN FinderError(ErrCreateSem);
  FOR N := 1 TO Min(ParamCount,MaxFinders) DO
  WITH Parms DO
  BEGIN
    Path := ParamStr(n);
    P    := Byte(Path[0]);
    WHILE (P > 0) AND (Path[P] <> '\') AND (Path[P] <> ':') DO
      Dec(P);
    IF P = 0
       THEN BEGIN
              Mask := Path;
              Path := '\';
            END
       ELSE BEGIN
              Mask := Copy(Path,P+1,255);
              Delete(Path,P+1,255);
              IF Path[P] = ':'
                 THEN Path := Path+'\';
            END;
    SemClear(Ready);
    T := CreateTask(FindTask,@Parms,Pri_User,FinderStackSize);
    IF T < 0
       THEN FinderError(ErrCreateTask);
    IF N = 1                                     { return ID of first task }
       THEN StartFinder := T;
    SemWait(Ready);
  END;
  IF RemoveSem(Parms.Ready) <> Sem_OK
     THEN FinderError(ErrRemoveSem);
END;

{-----------------------------------------------------------------------------}

PROCEDURE ProcessOutput(BaseNo:TaskNoType; NoOfTasks:Byte);

{ This procedure reads messages from the pipe and displays them on
  the screen.
  Each message consists of three parts:
  1. A letter giving the type of message: (D)irectory or (F)ile
  2. The ID of the sender
  3. A Pathname of a currently searched directory or a matching file
  These message segments are separated by a blank (see also "Display").

  The whole content of the pipe is read inside the main loop of this
  procedure. An error return from the read of the first message segment
  indicates that no more writing processes exist.
}

VAR  N    : Byte;
     BotL : Byte;
     Typ  : Char;
     Task : Byte;
     Path : String;
     Hits : Word;
     Sep  : String[80];
     C    : Char;
     Ende : Boolean;

BEGIN
  Hits  := 0;
  Ende  := False;

  ClrScr;
  TextColor(0);
  TextBackground(7);
  GotoXY(1,1);
  ClrEol;
  GotoXY(17,1);
  Write('>> Finder V1.0 (c) Christian Philipps, April 1990 <<');
  TextColor(7);
  TextBackground(0);

  BotL := 25-NoOfTasks-1;
  FillChar(Sep,sizeof(Sep),'-');
  Sep[0] := #80;
  GotoXY(1,BotL+1);
  Write(Sep);
  Reset(MainPipe);
  IF IoResult <> 0
     THEN FinderError(ErrReset);
  Read(MainPipe,Typ);
  Read(MainPipe,Task);
  ReadLn(MainPipe,Path);
  Ende := IOResult <> 0;
  WHILE NOT Ende DO
  BEGIN
    IF Typ = 'D'
       THEN BEGIN
              GotoXY(1,BotL+2+Task-BaseNo);
              ClrEol;
            END
       ELSE BEGIN
              Inc(Hits);
              IF (Hits MOD BotL) = 0
                 THEN BEGIN
                        GotoXY(20,BotL+1);
                        Write(' Press Return to continue, Escape to exit. ');
                        REPEAT
                          WHILE NOT Keypressed DO
                            Sleep(1);
                          C := ReadKey;
                        UNTIL C IN [#27,#13];
                        IF C = #27
                           THEN Halt(1);
                        GotoXY(1,BotL+1);
                        Write(Sep);
                      END;
              GotoXY(1,2);
              DelLine;
              GotoXY(1,BotL);
              InsLine;
            END;
    Write(Task:2,': ',Copy(Path,1,75));
    Read(MainPipe,Typ);
    Ende := IOResult <> 0;
    IF NOT Ende
       THEN BEGIN
              Read(MainPipe,Task);
              ReadLn(MainPipe,Path);
            END;
    END;
  Close(MainPipe);
  GotoXY(20,BotL+1);
  Write(' ',Hits,' Matches! - Press any key to continue. ');
  IF ReadKey = #0 THEN;
END;

{-----------------------------------------------------------------------------}

BEGIN
  IF ParamCount < 1
     THEN BEGIN
            Writeln('Finder V1.00 / Ch. Philipps');
            Writeln('> Finder pattern [...]');
            Writeln;
            Writeln('Finder recursively scans the directory tree looking for');
            Writeln('filenames matching the pattern. If no path is contained');
            Writeln('in the pattern, the search starts at the root directory!');
            Writeln('At max ',MaxFinders,' pattern may be given on the command line.');
            Writeln;
            Writeln('Example:  Finder C:*.sys D:*.sys');
            Writeln('          Scan disks C and D starting at \ for files');
            Writeln('          with the extension .SYS');
            Halt(1);
          END;

  SpeedUp(3);
  TimeSlice(1,5);
  SetPri(Pri_User+1);
  IF Not AssignPipe(MainPipe,'Finder',PipeSize,0,NoWait)
     THEN FinderError(ErrAssignPipe);
  ProcessOutput(StartFinder,Min(ParamCount,MaxFinders));
END.