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

Pascal/Delphi Source File | 1990-04-07 | 12.6 KB | 383 lines

{//////////////////////////////////////////////////////////////////////////////
///                                                                         ///
///              Turbo-Pascal Multi-Tasking Subsystem V2.10                 ///
///                    Demonstration der Unit MtPipe                        ///
///                                                                         ///
///             (c) Christian Philipps Software-Technik, Moers              ///
///                            im April 1990                                ///
///                                                                         ///
///                Dieses System erfordert Turbo-Pascal V5.x                ///
///                sowie das Multi-Tasking Subsystem V2.10                  ///
///                                                                         ///
///////////////////////////////////////////////////////////////////////////////
///                                                                         ///
///  Das Programm Finder durchsucht eine oder mehrere Platten anhand einer  ///
///  oder mehrerer Suchmuster, die als Befehlszeilenparameter übergeben     ///
///  werden.                                                                ///
///  Je Suchmuster wird eine separate Task gestartet, so daß die einzel-    ///
///  nen Suchabläufe parallel laufen.                                       ///
///  Es sind maximal 10 Suchmuster auf der Befehlszeile angebbar.           ///
///  Nach jeweils einem Bildschirminhalt, wartet Finder auf einen Tasten-   ///
///  druck. Während dieser Zeit, laufen jedoch die Hintergrundprozesse,     ///
///  die die Platten durchsuchen weiter, sofern die Pipe noch nicht voll-   ///
///  ständig gefüllt ist.                                                   ///
///                                                                         ///
//////////////////////////////////////////////////////////////////////////////}

{$I-,R-,S-,D-,F-,V-,B-,N-,L- }

PROGRAM Finder;

{ Autor: Christian Philipps
         Düsseldorfer Str. 316

         4130 Moers 1

 Stand:  Sep. 1989
}

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 {SafeFindFirst}
  SemWait(FindSem);
  FindFirst(Path,Attr,S);
  SemSignal(FindSem);
END;  {SafeFindFirst}

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

PROCEDURE SafeFindNext(VAR S:SearchRec);

BEGIN {SafeFindNext}
  SemWait(FindSem);
  FindNext(S);
  SemSignal(FindSem);
END;  {SafeFindNext}

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

PROCEDURE FinderError(Err:ErrorType);

BEGIN {FinderError}
  Write(^G'Finder: ');
  CASE Err OF
    ErrCreateSem:  Writeln('Fehler bei CreateSem');
    ErrRemoveSem:  Writeln('Fehler bei RemoveSem');
    ErrCreateTask: Writeln('Fehler bei CreateTask');
    ErrAssignPipe: Writeln('Fehler bei AssignPipe');
    ErrRewrite:    Writeln('Fehler bei Rewrite Pipe');
    ErrReset:      Writeln('Fehler bei Reset Pipe');
  ELSE
    Writeln('Unbekannter Fehler (',Byte(Err),')!');
  END;
  Halt(1);
END;  {FinderError}

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

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

{ Ausgabe von Statusmeldungen über eine Pipe.
  Die Nachricht besteht aus 3 zusammengehörigen Teilen, wodurch die
  gesamte Ausgabe zu einer "atomic action" wird. Durch die Semaphoren-
  Operationen zu Beginn und am Ende der Prozedur wird sichergestellt,
  daß stets alle 3 Teile einer Nachricht zusammenhängend hintereinander
  ausgegeben werden.
}

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

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

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

{ Durchsuchen eines Verzeichnisses }

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);

{ Rekursives Durchsuchen eines Verzeichnisbaumes }

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);

{ Dies ist der Taskrumpf der Finder-Tasks.
  Jede Task eröffnet einen eigenen Kommunikationskanal zur Pipe "Finder".
  Alsdann durchsucht sie rekursiv die Platte anhand des angegebenen
  Suchmusters. Die Statusmeldungen werden mittels der Prozedur "Display"
  an das Hauptprogramm (via Pipe) weitergeleitet.

  Nach erfolgreichem Abschluß der Arbeit schließt die Task ihre Seite der
  Pipe wieder und beendet sich. Haben sich alle Finder-Tasks, d. h. alle
  schreibenden Prozesse beendet (und somit die Pipe geschlossen), wird
  das Hauptprogramm, welches die Leseseite der Pipe bildet, einen
  Zugriffsfehler gemeldet bekommen, sobald es versucht, eine weitere Nachricht
  aus der vollständig entleerten Pipe zu lesen.
}

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

BEGIN {FindTask}
  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,'--- Fertig! ---',Pipe);
  Close(Pipe);
END;  {FindTask}
{$F-}

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

FUNCTION StartFinder:Byte;

{ Für jeden Befehlszeilenparameter wird ein separater Prozeß gestartet.
  Die Prozedur FindTask bildet den Taskrumpf für ALLE diese Prozesse.
  StartFinder erzeugt außerdem eine Semaphore, die für die Synchronisation
  des Zugriffs auf die Prozedur "Display" erforderlich ist.
  StartFinder liefert als Funktionswert die Nummer der ersten gestarteten
  Task. Dieser Wert wird für die Berechnung der Ausgabepositionen inner-
  halb von "ProcessOutput" benötigt.
}

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

BEGIN {StartFinder}
  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                                    {melde Nummer der 1. Task}
       THEN StartFinder := T;
    SemWait(Ready);
  END;
  IF RemoveSem(Parms.Ready) <> Sem_OK
     THEN FinderError(ErrRemoveSem);
END;  {StartFinder}

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

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

{ Diese Prozedur ließt die Nachrichten, die ihr über die Pipe zugeleitet
  werden aus und zeigt sie am Bildschirm an.
  Jede Nachricht besteht aus 3 Bestandteilen.
  1. Ein Kennbuchstabe; Tpy der Nachricht (D)irectory (F)ile
  2. Die Nummer der Task, die die Nachricht abgesandt hat
  3. Ein Pfadname
  Die einzelnen Bestandteile sind durch jeweils eine Leerstelle voneinander
  getrennt. (siehe auch Prozdur "Display")

  In einer Schleife wird der gesamte Inhalt der Pipe gelesen, bis durch
  einen Fehler beim Lesen des Kennbuchstabens angezeigt wird, daß die
  Finder-Tasks alle bereits die Pipe auf ihrer Seite geschlossen haben, d. h.
  keine Daten mehr liefern werden.
}

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

BEGIN {ProcessOutput}
  Hits  := 0;
  Ende  := False;

  ClrScr;
  TextColor(0);
  TextBackground(7);
  GotoXY(1,1);
  ClrEol;
  GotoXY(17,1);
  Write('>> Finder V1.00 (c) Ch. Philipps im 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(' Weiter mit Return - Abbruch mit ESC! ');
                        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,' Treffer - Weiter mit jeder Taste! ');
  IF ReadKey = #0 THEN;
END;  {ProcessOutput}

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

BEGIN {Main}
  IF ParamCount < 1
     THEN BEGIN
            Writeln('Finder V1.00 / Ch. Philipps / Sep. 1989');
            Writeln('> Finder Suchmuster [...]');
            Writeln;
            Writeln('Finder durchsucht die Platte nach den angegebenen');
            Writeln('Mustern. Enthält ein Suchmuster keine Pfad, so wird');
            Writeln('die gesamte Platte durchsucht!');
            Writeln('Maximal ',MaxFinders,' Suchmuster können auf der Befehlszeile');
            Writeln('angegeben werden.');
            Writeln;
            Writeln('Beispiel: Finder C:*.sys D:*.sys');
            Writeln('Funktion: Durchsuche die Platten C und D beginnend mit');
            Writeln('          dem Root-Directory nach Dateien, deren Exten-');
            Writeln('          sion .SYS lautet.');
            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.  {Main}