The World of Computer Software/World_Of_Computer_Software-02-387-Vol-3of3.iso/m/msh_ut11.zip/RM.PAS

Pascal/Delphi Source File | 1992-05-09 | 5KB | 171 lines

PROGRAM RM;
{$V-,I-,S-,A+,R-}
{ A file-remove-program for use with the Mi-Shell }
{ You can always cancel the process by pressing   }
{ escape-key at (nearly) any time.                }
{ Written by Jens Pirnay in 1992                  }
{-----------------------------------------------------}
{ Jens Pirnay <[e-mail]> }
{ This file is subject to the copyleft-regulations    }
{ of the Free Software Foundation (the guys from GNU) }
{-----------------------------------------------------}

{ DEFINE German} { For german messages instead of english }

USES DOS, CRT, MSHSupport, MiniWindow;

VAR i, j  : WORD;
    Tmp   : STRING;
CONST doall     : BOOLEAN = FALSE;
      recursion : BOOLEAN = FALSE;

   PROCEDURE KillFiles (files : STRING; askdir : BOOLEAN);
   VAR S       : SearchRec;
       F       : FILE;
       BaseDir : STRING [127];
       doit    : BOOLEAN;
       Name    : STRING [8];
       Ext     : STRING [4];
       answer  : BYTE;
       doserr  : INTEGER;
   BEGIN
     FSplit (Files, BaseDir, Name, Ext);
     FINDFIRST (Files, AnyFile, S);
     doserr := DOSError;
     WHILE doserr = 0 DO
     BEGIN
       IF KEYPRESSED THEN
       BEGIN
         IF READKEY = #27 THEN
           HALT;
       END;
       WITH S DO
       BEGIN
         doit := TRUE;

         IF (S.Attr AND Directory <> 0) AND
            (S.Name <> '.') AND (S.Name <> '..')
            AND recursion THEN
         BEGIN
           IF askdir THEN
           BEGIN
           {$IFDEF German}
             answer :=  Alert ('Wollen Sie das Verzeichnis:||>> ' + S.Name +
                               ' <<||wirklich löschen', ' Ja |Nein|Rekursiv');
            {$ELSE}
             answer :=  Alert ('Do you really want to delete|this directory:||>> '
                              + S.Name + ' <<', 'Yes| No |Recursive');
            {$ENDIF}
            IF answer = 255 THEN HALT;
           END
           ELSE
             answer := 3;
           IF (answer = 1) OR (answer = 3) THEN
           BEGIN
             IF answer = 3 THEN
               KillFiles (BaseDir + S.Name + '\*.*', FALSE);
             RMDIR (BaseDir + S.Name);
             IF IORESULT <> 0 THEN ;
           END;
         END
         ELSE
         BEGIN
           IF (S.Attr AND ReadOnly <> 0) THEN
           BEGIN
             IF doall THEN
             BEGIN
               answer := 3;
             END
             ELSE
             BEGIN
             {$IFDEF German}
               answer :=
                Alert ('Folgende Datei ist schreibgeschützt:||>> ' +
                      S.Name + ' <<||Trotzdem löschen?', '  Ja  | Nein | Alle ');
              {$ELSE}
               answer :=
                Alert ('File is write-protected:||>> ' +
                      S.Name + ' <<||Delete anyway?', ' Yes | No | All ');
              {$ENDIF}
             END;
             IF answer = 255 THEN HALT; { Escape }
             IF answer = 3 THEN
               doall := TRUE;
             IF answer = 2 THEN
             BEGIN
               doit := FALSE;
             END
             ELSE
             BEGIN
               ASSIGN (F, BaseDir + S.Name);
               SETFATTR (F, Archive);
               CLOSE (F);
               IF IORESULT = 0 THEN ;
             END;
           END;
           IF doit THEN
           BEGIN
             ASSIGN (F, BaseDir + S.Name);
             ERASE (F);
             IF IORESULT = 0 THEN ;
           END;
       END;
       END;
       FINDNEXT (S);
       doserr := DOSError;
     END;
   END;

  PROCEDURE help;
  begin
   {$IFDEF German}
     WRITELN ('Aufruf: rm [-rf] Datei(en)');
     WRITELN ('  löscht auch Unterverzeichnisse,       falls "-r"');
     WRITELN ('  fragt nicht bei Verzeichnissen oder');
     WRITELN ('  schreibgeschützten Dateien nach,      falls "-f"');
   {$ELSE}
     WRITELN ('Usage: rm [-rf] file(s)');
     WRITELN ('  deletes even subdirectories,      if "-r"');
     WRITELN ('  does not confirm deletion for');
     WRITELN ('  directories or read-only files,   if "-f"');
   {$ENDIF}
  end;

  PROCEDURE Get_Param (VAR First_Param : WORD);
    VAR pc, psp : INTEGER;
        st      : STRING;

    PROCEDURE select ( ch : CHAR; st : STRING; VAR action : BOOLEAN );
    BEGIN
      IF (POS (ch, st) > 1) OR (POS (UPCASE (ch), st) > 1)
        THEN action := TRUE;
    END;

  BEGIN {Get_Param}
    pc  := MSHParamCount;
    psp := 1;
    st  := COPY (MSHParamStr (psp), 1, 1);
    WHILE (st [1] = '/') OR (st [1] = '-') DO BEGIN
      select ('r', MSHParamStr (psp), recursion);
      select ('f', MSHParamStr (psp), doall);
      INC (psp);
      IF pc < psp THEN help;
      st := COPY (MSHParamStr (psp), 1, 1);
    END;
    First_Param := psp;
  END; {Get_Param}

BEGIN
  IF MSHParamCount > 0 THEN
  BEGIN
    Get_param(j);
    FOR i := j TO MSHParamCount DO
    BEGIN
      tmp := MSHParamStr (i);
      KillFiles (tmp, NOT doall);  { ask if directory }
    END;
  END
  ELSE
    help;
END.